/-
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
-/
import measure_theory.measure.content
import measure_theory.group.prod

/-!
# Haar measure

In this file we prove the existence 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.

## 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 theory

open set has_inv function topological_space measurable_space
open_locale nnreal classical ennreal pointwise topological_space

variables {G : Type*} [group G]

namespace measure_theory
namespace measure

/-! 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, (λ h, g * h) ⁻¹' V }

@[to_additive add_index_empty]
lemma index_empty {V : set G} : index ∅ V = 0 :=
begin
  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],
end

variables [topological_space 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.1 U : ℝ) / index K₀ U

@[to_additive]
lemma prehaar_empty (K₀ : positive_compacts G) {U : set G} : prehaar K₀.1 U ⊥ = 0 :=
by { simp only [prehaar, compacts.bot_val, index_empty, nat.cast_zero, zero_div] }

@[to_additive]
lemma prehaar_nonneg (K₀ : positive_compacts G) {U : set G} (K : compacts G) :
  0 ≤ prehaar K₀.1 U K :=
by apply div_nonneg; norm_cast; apply zero_le

/-- `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 haar_product (K₀ : set G) : set (compacts G → ℝ) :=
pi univ (λ K, Icc 0 $ index K.1 K₀)

@[simp, to_additive]
lemma mem_prehaar_empty {K₀ : set G} {f : compacts G → ℝ} :
  f ∈ haar_product K₀ ↔ ∀ K : compacts G, f K ∈ Icc (0 : ℝ) (index K.1 K₀) :=
by simp only [haar_product, pi, forall_prop_of_true, mem_univ, mem_set_of_eq]

/-- 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 cl_prehaar (K₀ : set G) (V : open_nhds_of (1 : G)) : set (compacts G → ℝ) :=
closure $ prehaar K₀ '' { U : set G | U ⊆ V.1 ∧ is_open U ∧ (1 : G) ∈ U }

variables [topological_group 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]
lemma index_defined {K V : set G} (hK : is_compact K) (hV : (interior V).nonempty) :
  ∃ n : ℕ, n ∈ finset.card '' {t : finset G | K ⊆ ⋃ g ∈ t, (λ h, g * h) ⁻¹' V } :=
by { rcases compact_covered_by_mul_left_translates hK hV with ⟨t, ht⟩, exact ⟨t.card, t, ht, rfl⟩ }

@[to_additive add_index_elim]
lemma index_elim {K V : set G} (hK : is_compact K) (hV : (interior V).nonempty) :
  ∃ (t : finset G), K ⊆ (⋃ g ∈ t, (λ h, g * h) ⁻¹' V) ∧ finset.card t = index K V :=
by { have := nat.Inf_mem (index_defined hK hV), rwa [mem_image] at this }

@[to_additive le_add_index_mul]
lemma le_index_mul (K₀ : positive_compacts G) (K : compacts G) {V : set G}
  (hV : (interior V).nonempty) : index K.1 V ≤ index K.1 K₀.1 * index K₀.1 V :=
begin
  rcases index_elim K.2 K₀.2.2 with ⟨s, h1s, h2s⟩,
  rcases index_elim K₀.2.1 hV with ⟨t, h1t, h2t⟩,
  rw [← h2s, ← h2t, mul_comm],
  refine le_trans _ finset.mul_card_le,
  apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq], refine subset.trans h1s _,
  apply bUnion_subset, intros g₁ hg₁, rw preimage_subset_iff, intros 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
end

@[to_additive add_index_pos]
lemma index_pos (K : positive_compacts G) {V : set G} (hV : (interior V).nonempty) :
  0 < index K.1 V :=
begin
  unfold index, rw [nat.Inf_def, nat.find_pos, mem_image],
  { rintro ⟨t, h1t, h2t⟩, rw [finset.card_eq_zero] at h2t, subst h2t,
    cases K.2.2 with g hg,
    show g ∈ (∅ : set G), convert h1t (interior_subset hg), symmetry, apply bUnion_empty },
  { exact index_defined K.2.1 hV }
end

@[to_additive add_index_mono]
lemma index_mono {K K' V : set G} (hK' : is_compact K') (h : K ⊆ K')
  (hV : (interior V).nonempty) : index K V ≤ index K' V :=
begin
  rcases index_elim hK' hV with ⟨s, h1s, h2s⟩,
  apply nat.Inf_le, rw [mem_image], refine ⟨s, subset.trans h h1s, h2s⟩
end

@[to_additive add_index_union_le]
lemma 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 :=
begin
  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;
    intros g hg; simp only [mem_def] at hg;
    simp only [mem_def, multiset.mem_union, finset.union_val, hg, or_true, true_or]
end

@[to_additive add_index_union_eq]
lemma 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 :=
begin
  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, (λ h, g * h) ⁻¹' V) →
    index K V ≤ (s.filter (λ g, ((λ (h : G), g * h) ⁻¹' V ∩ K).nonempty)).card,
  { intros K hK, apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq],
    intros g hg, rcases hK hg with ⟨_, ⟨g₀, rfl⟩, _, ⟨h1g₀, rfl⟩, h2g₀⟩,
    simp only [mem_preimage] at h2g₀,
    simp only [mem_Union], use g₀, split,
    { simp only [finset.mem_filter, h1g₀, true_and], use g,
      simp only [hg, h2g₀, mem_inter_eq, mem_preimage, and_self] },
    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₂,
  apply @h g₁⁻¹,
  split; simp only [set.mem_inv, set.mem_mul, exists_exists_and_eq_and, exists_and_distrib_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] }
end

@[to_additive add_left_add_index_le]
lemma mul_left_index_le {K : set G} (hK : is_compact K) {V : set G} (hV : (interior V).nonempty)
  (g : G) : index ((λ h, g * h) '' K) V ≤ index K V :=
begin
  rcases index_elim hK hV with ⟨s, h1s, h2s⟩, rw [← h2s],
  apply nat.Inf_le, rw [mem_image],
  refine ⟨s.map (equiv.mul_right g⁻¹).to_embedding, _, 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_mul_right, exists_exists_and_eq_and, mem_preimage, equiv.to_embedding_apply],
    refine ⟨_, hg₂, _⟩, simp only [mul_assoc, hg₁, inv_mul_cancel_left] }
end

@[to_additive is_left_invariant_add_index]
lemma is_left_invariant_index {K : set G} (hK : is_compact K) (g : G) {V : set G}
  (hV : (interior V).nonempty) : index ((λ h, g * h) '' K) V = index K V :=
begin
  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], symmetry, convert image_id' _, ext h, apply inv_mul_cancel_left
end

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

@[to_additive add_prehaar_le_add_index]
lemma prehaar_le_index (K₀ : positive_compacts G) {U : set G} (K : compacts G)
  (hU : (interior U).nonempty) : prehaar K₀.1 U K ≤ index K.1 K₀.1 :=
begin
  unfold prehaar, rw [div_le_iff]; norm_cast,
  { apply le_index_mul K₀ K hU },
  { exact index_pos K₀ hU }
end

@[to_additive]
lemma prehaar_pos (K₀ : positive_compacts G) {U : set G} (hU : (interior U).nonempty)
  {K : set G} (h1K : is_compact K) (h2K : (interior K).nonempty) : 0 < prehaar K₀.1 U ⟨K, h1K⟩ :=
by { apply div_pos; norm_cast, apply index_pos ⟨K, h1K, h2K⟩ hU, exact index_pos K₀ hU }

@[to_additive]
lemma prehaar_mono {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty)
  {K₁ K₂ : compacts G} (h : K₁.1 ⊆ K₂.1) : prehaar K₀.1 U K₁ ≤ prehaar K₀.1 U K₂ :=
begin
  simp only [prehaar], rw [div_le_div_right], exact_mod_cast index_mono K₂.2 h hU,
  exact_mod_cast index_pos K₀ hU
end

@[to_additive]
lemma prehaar_self {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty) :
  prehaar K₀.1 U ⟨K₀.1, K₀.2.1⟩ = 1 :=
by { simp only [prehaar], rw [div_self], apply ne_of_gt, exact_mod_cast index_pos K₀ hU }

@[to_additive]
lemma prehaar_sup_le {K₀ : positive_compacts G} {U : set G} (K₁ K₂ : compacts G)
  (hU : (interior U).nonempty) : prehaar K₀.1 U (K₁ ⊔ K₂) ≤ prehaar K₀.1 U K₁ + prehaar K₀.1 U K₂ :=
begin
  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
end

@[to_additive]
lemma prehaar_sup_eq {K₀ : positive_compacts G} {U : set G} {K₁ K₂ : compacts G}
  (hU : (interior U).nonempty) (h : disjoint (K₁.1 * U⁻¹) (K₂.1 * U⁻¹)) :
  prehaar K₀.1 U (K₁ ⊔ K₂) = prehaar K₀.1 U K₁ + prehaar K₀.1 U K₂ :=
by { simp only [prehaar], rw [div_add_div_same], congr', exact_mod_cast index_union_eq K₁ K₂ hU h }

@[to_additive]
lemma is_left_invariant_prehaar {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty)
  (g : G) (K : compacts G) : prehaar K₀.1 U (K.map _ $ continuous_mul_left g) = prehaar K₀.1 U K :=
by simp only [prehaar, compacts.map_val, is_left_invariant_index K.2 _ hU]

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

@[to_additive]
lemma prehaar_mem_haar_product (K₀ : positive_compacts G) {U : set G}
  (hU : (interior U).nonempty) : prehaar K₀.1 U ∈ haar_product K₀.1 :=
by { rintro ⟨K, hK⟩ h2K, rw [mem_Icc], exact ⟨prehaar_nonneg K₀ _, prehaar_le_index K₀ _ hU⟩ }

@[to_additive]

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

/-- This is the "limit" of `prehaar K₀.1 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.1) ≤ chaar K₀ K ≤ haar_measure K₀ K.1`. -/
@[to_additive add_chaar "additive version of `measure_theory.measure.haar.chaar`"]
def chaar (K₀ : positive_compacts G) (K : compacts G) : ℝ :=
classical.some (nonempty_Inter_cl_prehaar K₀) K

@[to_additive add_chaar_mem_add_haar_product]
lemma chaar_mem_haar_product (K₀ : positive_compacts G) : chaar K₀ ∈ haar_product K₀.1 :=
(classical.some_spec (nonempty_Inter_cl_prehaar K₀)).1

@[to_additive add_chaar_mem_cl_add_prehaar]
lemma chaar_mem_cl_prehaar (K₀ : positive_compacts G) (V : open_nhds_of (1 : G)) :
  chaar K₀ ∈ cl_prehaar K₀.1 V :=
by { have := (classical.some_spec (nonempty_Inter_cl_prehaar K₀)).2, rw [mem_Inter] at this,
     exact this V }

@[to_additive add_chaar_nonneg]
lemma chaar_nonneg (K₀ : positive_compacts 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 }

@[to_additive add_chaar_empty]
lemma chaar_empty (K₀ : positive_compacts G) : chaar K₀ ⊥ = 0 :=
begin
  let eval : (compacts G → ℝ) → ℝ := λ f, f ⊥,
  have : continuous eval := continuous_apply ⊥,
  show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)},
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
  unfold cl_prehaar, rw is_closed.closure_subset_iff,
  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, apply prehaar_empty },
  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton },
end

@[to_additive add_chaar_self]
lemma chaar_self (K₀ : positive_compacts G) : chaar K₀ ⟨K₀.1, K₀.2.1⟩ = 1 :=
begin
  let eval : (compacts G → ℝ) → ℝ := λ f, f ⟨K₀.1, K₀.2.1⟩,
  have : continuous eval := continuous_apply _,
  show chaar K₀ ∈ eval ⁻¹' {(1 : ℝ)},
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
  unfold cl_prehaar, rw is_closed.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 is_closed_singleton }
end

@[to_additive add_chaar_mono]
lemma chaar_mono {K₀ : positive_compacts G} {K₁ K₂ : compacts G} (h : K₁.1 ⊆ K₂.1) :
  chaar K₀ K₁ ≤ chaar K₀ K₂ :=
begin
  let eval : (compacts G → ℝ) → ℝ := λ 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₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
  unfold cl_prehaar, rw is_closed.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 is_closed_Ici },
end

@[to_additive add_chaar_sup_le]
lemma chaar_sup_le {K₀ : positive_compacts G} (K₁ K₂ : compacts G) :
  chaar K₀ (K₁ ⊔ K₂) ≤ chaar K₀ K₁ + chaar K₀ K₂ :=
begin
  let eval : (compacts G → ℝ) → ℝ := λ 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₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
  unfold cl_prehaar, rw is_closed.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 is_closed_Ici },
end

@[to_additive add_chaar_sup_eq]
lemma chaar_sup_eq [t2_space G] {K₀ : positive_compacts G} {K₁ K₂ : compacts G}
  (h : disjoint K₁.1 K₂.1) : chaar K₀ (K₁ ⊔ K₂) = chaar K₀ K₁ + chaar K₀ K₂ :=
begin
  rcases compact_compact_separated K₁.2 K₂.2 (disjoint_iff.mp h) with
    ⟨U₁, U₂, h1U₁, h1U₂, h2U₁, h2U₂, hU⟩,
  rw [← disjoint_iff_inter_eq_empty] at hU,
  rcases compact_open_separated_mul K₁.2 h1U₁ h2U₁ with ⟨V₁, h1V₁, h2V₁, h3V₁⟩,
  rcases compact_open_separated_mul K₂.2 h1U₂ h2U₂ with ⟨V₂, h1V₂, h2V₂, h3V₂⟩,
  let eval : (compacts G → ℝ) → ℝ := λ 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⁻¹, (is_open.inter h1V₁ h1V₂).preimage continuous_inv,
    by simp only [mem_inv, one_inv, h2V₁, h2V₂, V, mem_inter_eq, true_and]⟩),
  unfold cl_prehaar, rw is_closed.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 _) h3V₁,
        exact subset.trans (inv_subset.mpr h1U) (inter_subset_left _ _) },
      { refine subset.trans (mul_subset_mul subset.rfl _) h3V₂,
        exact subset.trans (inv_subset.mpr h1U) (inter_subset_right _ _) }}},
  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton },
end

@[to_additive is_left_invariant_add_chaar]
lemma is_left_invariant_chaar {K₀ : positive_compacts G} (g : G) (K : compacts G) :
  chaar K₀ (K.map _ $ continuous_mul_left g) = chaar K₀ K :=
begin
  let eval : (compacts G → ℝ) → ℝ := λ 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₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
  unfold cl_prehaar, rw is_closed.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 is_closed_singleton },
end

variable [t2_space G]

/-- The function `chaar` interpreted in `ℝ≥0`, as a content -/
@[to_additive "additive version of `measure_theory.measure.haar.haar_content`"]
def haar_content (K₀ : positive_compacts G) : content G :=
{ to_fun        := λ 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], refl },
  sup_le'       := λ K₁ K₂,
    by simp only [←nnreal.coe_le_coe, nnreal.coe_add, subtype.coe_mk, chaar_sup_le] }

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

@[to_additive]
lemma haar_content_apply (K₀ : positive_compacts G) (K : compacts G) :
  haar_content K₀ K = show nnreal, from ⟨chaar K₀ K, chaar_nonneg _ _⟩ := rfl

/-- The variant of `chaar_self` for `haar_content` -/
@[to_additive]
lemma haar_content_self {K₀ : positive_compacts G} : haar_content K₀ ⟨K₀.1, K₀.2.1⟩ = 1 :=
by { simp_rw [← ennreal.coe_one, haar_content_apply, ennreal.coe_eq_coe, chaar_self], refl }

/-- The variant of `is_left_invariant_chaar` for `haar_content` -/
@[to_additive]
lemma is_left_invariant_haar_content {K₀ : positive_compacts G} (g : G) (K : compacts G) :
  haar_content K₀ (K.map _ $ continuous_mul_left g) = haar_content K₀ K :=
by simpa only [ennreal.coe_eq_coe, ←nnreal.coe_eq, haar_content_apply]
  using is_left_invariant_chaar g K

@[to_additive]
lemma haar_content_outer_measure_self_pos {K₀ : positive_compacts G} :
  0 < (haar_content K₀).outer_measure K₀.1 :=
begin
  apply ennreal.zero_lt_one.trans_le,
  rw [content.outer_measure_eq_infi],
  refine le_binfi _,
  intros U hU,
  refine le_infi _,
  intros h2U,
  refine le_trans (le_of_eq _) (le_bsupr ⟨K₀.1, K₀.2.1⟩ h2U),
  exact haar_content_self.symm
end

end haar
open haar

/-!
### The Haar measure
-/

variables [topological_space G] [t2_space G] [topological_group G] [measurable_space G]
  [borel_space 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`,
scaled so that `add_haar_measure K₀ K₀ = 1`."]
def haar_measure (K₀ : positive_compacts G) : measure G :=
((haar_content K₀).outer_measure K₀.1)⁻¹ • (haar_content K₀).measure

@[to_additive]
lemma haar_measure_apply {K₀ : positive_compacts G} {s : set G} (hs : measurable_set s) :
  haar_measure K₀ s = (haar_content K₀).outer_measure s / (haar_content K₀).outer_measure K₀.1 :=
begin
  change (((haar_content K₀).outer_measure) K₀.val)⁻¹ * (haar_content K₀).measure s = _,
  simp only [hs, div_eq_mul_inv, mul_comm, content.measure_apply],
end

@[to_additive]
lemma is_mul_left_invariant_haar_measure (K₀ : positive_compacts G) :
  is_mul_left_invariant (haar_measure K₀) :=
begin
  intros 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,
end

@[to_additive]
lemma haar_measure_self {K₀ : positive_compacts G} :
  haar_measure K₀ K₀.1 = 1 :=
begin
  haveI : locally_compact_space G := K₀.locally_compact_space_of_group,
  rw [haar_measure_apply K₀.2.1.measurable_set, ennreal.div_self],
  { rw [← pos_iff_ne_zero], exact haar_content_outer_measure_self_pos },
  { exact ne_of_lt (content.outer_measure_lt_top_of_is_compact _ K₀.2.1) }
end

/-- The Haar measure is regular. -/
@[to_additive]
instance regular_haar_measure {K₀ : positive_compacts G} :
  (haar_measure K₀).regular :=
begin
  haveI : locally_compact_space G := K₀.locally_compact_space_of_group,
  apply regular.smul,
  rw ennreal.inv_ne_top,
  exact haar_content_outer_measure_self_pos.ne',
end

/-- The Haar measure is sigma-finite in a second countable group. -/
@[to_additive]
instance sigma_finite_haar_measure [second_countable_topology G] {K₀ : positive_compacts G} :
  sigma_finite (haar_measure K₀) :=
by { haveI : locally_compact_space G := K₀.locally_compact_space_of_group, apply_instance, }

/-- 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]
instance is_haar_measure_haar_measure (K₀ : positive_compacts G) :
  is_haar_measure (haar_measure K₀) :=
begin
  apply is_haar_measure_of_is_compact_nonempty_interior _ (is_mul_left_invariant_haar_measure K₀)
    K₀.1 K₀.2.1 K₀.2.2,
  { simp only [haar_measure_self], exact one_ne_zero },
  { simp only [haar_measure_self], exact ennreal.coe_ne_top },
end

/-- `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
additive group."]
def haar [locally_compact_space G] : measure G :=
haar_measure $ classical.choice (topological_space.nonempty_positive_compacts G)

section unique

variables [second_countable_topology G] {μ : measure G} [sigma_finite μ]

/-- The Haar measure is unique up to scaling. More precisely: every σ-finite left invariant measure
  is a scalar multiple of the Haar measure. -/
@[to_additive]
theorem haar_measure_unique (hμ : is_mul_left_invariant μ)
  (K₀ : positive_compacts G) : μ = μ K₀.1 • haar_measure K₀ :=
begin
  ext1 s hs,
  have := measure_mul_measure_eq hμ (is_mul_left_invariant_haar_measure K₀) K₀.2.1 hs,
  rw [haar_measure_self, one_mul] at this,
  rw [← this (by norm_num), smul_apply],
end

@[to_additive]
theorem regular_of_is_mul_left_invariant (hμ : is_mul_left_invariant μ) {K} (hK : is_compact K)
  (h2K : (interior K).nonempty) (hμK : μ K ≠ ∞) :
  regular μ :=
begin
  rw [haar_measure_unique hμ ⟨K, hK, h2K⟩],
  exact regular.smul hμK
end

end unique

@[to_additive is_add_haar_measure_eq_smul_is_add_haar_measure]
theorem is_haar_measure_eq_smul_is_haar_measure
  [locally_compact_space G] [second_countable_topology G]
  (μ ν : measure G) [is_haar_measure μ] [is_haar_measure ν] :
  ∃ (c : ℝ≥0∞), (c ≠ 0) ∧ (c ≠ ∞) ∧ (μ = c • ν) :=
begin
  have K : positive_compacts G := classical.choice (topological_space.nonempty_positive_compacts G),
  have νpos : 0 < ν K.1 := haar_pos_of_nonempty_interior _ K.2.2,
  have νlt : ν K.1 < ∞ := is_compact.haar_lt_top _ K.2.1,
  refine ⟨μ K.1 / ν K.1, _, _, _⟩,
  { simp only [νlt.ne, (μ.haar_pos_of_nonempty_interior K.property.right).ne', ne.def,
      ennreal.div_zero_iff, not_false_iff, or_self] },
  { simp only [div_eq_mul_inv, νpos.ne', (is_compact.haar_lt_top μ K.property.left).ne, or_self,
      ennreal.inv_eq_top, with_top.mul_eq_top_iff, ne.def, not_false_iff, and_false, false_and] },
  { calc
    μ = μ K.1 • haar_measure K : haar_measure_unique (is_mul_left_invariant_haar μ) K
    ... = (μ K.1 / ν K.1) • (ν K.1 • haar_measure K) :
      by rw [smul_smul, div_eq_mul_inv, mul_assoc, ennreal.inv_mul_cancel νpos.ne' νlt.ne, mul_one]
    ... = (μ K.1 / ν K.1) • ν : by rw ← haar_measure_unique (is_mul_left_invariant_haar ν) K }
end

/-- Any Haar measure is invariant under inversion in a commutative group. -/
@[to_additive]
lemma map_haar_inv
  {G : Type*} [comm_group G] [topological_space G] [topological_group G] [t2_space G]
  [measurable_space G] [borel_space G] [locally_compact_space G] [second_countable_topology G]
  (μ : measure G) [is_haar_measure μ] :
  measure.map has_inv.inv μ = μ :=
begin
  -- 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`.
  haveI : is_haar_measure (measure.map has_inv.inv μ) :=
    is_haar_measure_map μ (mul_equiv.inv G) continuous_inv continuous_inv,
  obtain ⟨c, cpos, clt, hc⟩ : ∃ (c : ℝ≥0∞), (c ≠ 0) ∧ (c ≠ ∞) ∧ (measure.map has_inv.inv μ = c • μ)
    := is_haar_measure_eq_smul_is_haar_measure _ _,
  have : map has_inv.inv (map has_inv.inv μ) = c^2 • μ,
    by simp only [hc, smul_smul, pow_two, linear_map.map_smul],
  have μeq : μ = c^2 • μ,
  { rw [map_map continuous_inv.measurable continuous_inv.measurable] at this,
    { simpa only [inv_involutive, involutive.comp_self, map_id] },
    all_goals { apply_instance } },
  have K : positive_compacts G := classical.choice (topological_space.nonempty_positive_compacts G),
  have : c^2 * μ K.1 = 1^2 * μ K.1,
    by { conv_rhs { rw μeq },
         -- use `change` instead of `simp` to avoid `to_additive` issues
         change c ^ 2 * μ K.1 = 1 ^ 2 * (c ^ 2 * μ K.1),
         rw [one_pow, one_mul] },
  have : c^2 = 1^2 :=
    (ennreal.mul_eq_mul_right (haar_pos_of_nonempty_interior _ K.2.2).ne'
      (is_compact.haar_lt_top _ K.2.1).ne).1 this,
  have : c = 1 := (ennreal.pow_strict_mono two_ne_zero).injective this,
  rw [hc, this, one_smul]
end

@[simp, to_additive] lemma haar_preimage_inv
  {G : Type*} [comm_group G] [topological_space G] [topological_group G] [t2_space G]
  [measurable_space G] [borel_space G] [locally_compact_space G] [second_countable_topology G]
  (μ : measure G) [is_haar_measure μ] (s : set G) :
  μ (s⁻¹) = μ s :=
calc μ (s⁻¹) = measure.map (has_inv.inv) μ s :
  ((homeomorph.inv G).to_measurable_equiv.map_apply s).symm
... = μ s : by rw map_haar_inv

end measure
end measure_theory


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

/-!
# Monotone finite sequences

In this file we prove `simp` lemmas that allow to simplify propositions like `monotone ![a, b, c]`.
-/

open set fin matrix function
variables {α : Type*}

lemma lift_fun_vec_cons {n : ℕ} (r : α → α → Prop) [is_trans α r] {f : fin (n + 1) → α} {a : α} :
  ((<) ⇒ r) (vec_cons a f) (vec_cons a f) ↔ r a (f 0) ∧ ((<) ⇒ r) f f :=
by simp only [lift_fun_iff_succ r, forall_fin_succ, cons_val_succ, cons_val_zero, ← succ_cast_succ,
  cast_succ_zero]

variables [preorder α] {n : ℕ} {f : fin (n + 1) → α} {a : α}

@[simp] lemma strict_mono_vec_cons : strict_mono (vec_cons a f) ↔ a < f 0 ∧ strict_mono f :=
lift_fun_vec_cons (<)

@[simp] lemma monotone_vec_cons : monotone (vec_cons a f) ↔ a ≤ f 0 ∧ monotone f :=
by simpa only [monotone_iff_forall_lt] using @lift_fun_vec_cons α n (≤) _ f a

@[simp] lemma strict_anti_vec_cons : strict_anti (vec_cons a f) ↔ f 0 < a ∧ strict_anti f :=
lift_fun_vec_cons (>)

@[simp] lemma antitone_vec_cons : antitone (vec_cons a f) ↔ f 0 ≤ a ∧ antitone f :=
@monotone_vec_cons αᵒᵈ _ _ _ _

lemma strict_mono.vec_cons (hf : strict_mono f) (ha : a < f 0) :
  strict_mono (vec_cons a f) :=
strict_mono_vec_cons.2 ⟨ha, hf⟩

lemma strict_anti.vec_cons (hf : strict_anti f) (ha : f 0 < a) :
  strict_anti (vec_cons a f) :=
strict_anti_vec_cons.2 ⟨ha, hf⟩

lemma monotone.vec_cons (hf : monotone f) (ha : a ≤ f 0) :
  monotone (vec_cons a f) :=
monotone_vec_cons.2 ⟨ha, hf⟩

lemma antitone.vec_cons (hf : antitone f) (ha : f 0 ≤ a) :
  antitone (vec_cons a f) :=
antitone_vec_cons.2 ⟨ha, hf⟩

example : monotone ![1, 2, 2, 3] := by simp [subsingleton.monotone]


/-
This defines additional operations that could go into Lean's nat definitions.
-/
namespace Nat

theorem succ_pred {x:Nat} (p:x > 0) : succ (pred x) = x := by
  cases x with
  | succ x => rfl
  | zero => contradiction

section BasicSubtraction

protected
theorem zero_sub (n : Nat) : 0 - n = 0 := by
  induction n with
  | zero => rfl
  | succ n ind => simp [sub_succ, ind]

theorem succ_sub {x y :Nat} (p:y ≤ x) : Nat.succ (x - y) = Nat.succ x - y := by
  revert x
  induction y with
  | zero =>
    intro x
    simp [Nat.sub_zero]
  | succ y ind =>
    intro x p
    match x with
    | 0 =>
      contradiction
    | succ x =>
      simp only [succ_sub_succ]
      apply ind (le_of_succ_le_succ p)

end BasicSubtraction

section BasicLe

theorem succ_le_zero (m:Nat) : succ m ≤ 0 ↔ False :=
  Iff.intro (not_succ_le_zero m) False.elim

theorem succ_le_succ_simp (m n:Nat) : succ m ≤ succ n ↔ m ≤ n :=
  Iff.intro le_of_succ_le_succ succ_le_succ

theorem succ_le_pred (m n:Nat) : succ m ≤ pred n ↔ succ (succ m) ≤ n :=
  match n with
  | 0 => by
    simp only [succ_le_zero, pred]
  | succ n => by
    simp only [pred, succ_le_succ_simp, iff_self]

theorem succ_le_sub (m n p:Nat) : succ m ≤ n - p ↔ succ (m + p) ≤ n := by
  revert m n
  have h : zero = 0 := rfl
  induction p with
  | zero =>
    intro m n
    simp only [h, Nat.sub_zero, Nat.add_zero]
    apply Iff.intro id id
  | succ p ind =>
    intro m n
    cases n with
    | zero =>
      simp only [h, Nat.zero_sub, succ_le_zero]
    | succ n =>
      rw [succ_sub_succ, succ_le_succ_simp]
      apply ind

protected
theorem sub_is_zero_is_le (m n : Nat) : m - n = 0 ↔ m ≤ n := by
  revert m
  induction n with
  | zero =>
    intros m
    cases m with
    | zero =>
      simp [Nat.le.refl]
    | succ m =>
      simp
      intro p
      cases p
  | succ n ind =>
    intros m
    cases m with
    | zero =>
      simp [Nat.zero_sub, Nat.zero_le]
    | succ m =>
      simp [succ_sub_succ]
      simp [ind, succ_le_succ_simp]

protected
theorem sub_is_zero {m n:Nat} (p : m ≤ n) : m - n = 0 :=
  (Nat.sub_is_zero_is_le _ _).mpr p

theorem lt_of_sub_succ {n m k:Nat} (p:n - m = Nat.succ k) : m < n := by
  revert n
  induction m with
  | zero =>
    intros n p
    simp at p
    simp [p]
    exact Nat.succ_le_succ (Nat.zero_le _)
  | succ m ind =>
    intros n p
    cases n with
    | zero =>
      simp [Nat.zero_sub] at p
    | succ n =>
      simp [succ_sub_succ] at p
      exact Nat.succ_lt_succ (ind p)

end BasicLe

-- These theorems are intended to rewrite to a mixture of additions and
-- subtractions into one sum minus another sum.
section SubAddRewriting

protected
theorem sub_sub_left (x y z:Nat) : (x - y) - z = x - (y + z) := by
  revert y z
  induction x with
  | zero =>
    intro y z
    simp [Nat.zero_sub]
  | succ x ind =>
    intro y z
    match y with
    | 0 =>
      simp [Nat.sub_zero]
    | succ y =>
      simp [succ_sub_succ, succ_add]
      exact ind _ _

protected
theorem sub_sub_right {y z:Nat} (p:y >= z) (x:Nat) : x - (y - z) = (x + z) - y := by
  revert x y
  induction z with
  | zero =>
    intro y p x
    rfl
  | succ z ind =>
    intro y p x
    cases y with
    | zero =>
      contradiction
    | succ y =>
      simp only [Nat.add_succ, Nat.succ_sub_succ]
      exact ind (Nat.le_of_succ_le_succ p) _

protected
theorem add_sub_left {x y:Nat} (p:x >= y) (z:Nat) : (x - y) + z = (x + z) - y := by
  revert x z
  induction y with
  | zero =>
    intro x p z
    rfl
  | succ y ind =>
    intro x p z
    cases x with
    | zero =>
      contradiction
    | succ x =>
      simp only [Nat.succ_add, Nat.succ_sub_succ]
      apply ind (Nat.le_of_succ_le_succ p)

protected
theorem add_sub_right {y z:Nat} (p:y >= z) (x:Nat) : x + (y - z) = x + y - z := by
  simp only [Nat.add_comm x (y - z), Nat.add_sub_left p, Nat.add_comm y x]

protected
theorem mul_sub (x y z:Nat) : x * (y - z) = x * y - x * z := by
  cases Nat.lt_or_ge y z with
  | inl y_lt_z =>
    have g : y ≤ z := Nat.le_of_lt y_lt_z
    have h : x * y ≤ x * z := Nat.mul_le_mul_left x g
    simp only [Nat.sub_is_zero g, Nat.sub_is_zero h, Nat.mul_zero]
  | inr y_ge_z =>
    induction x with
    | zero =>
      have h : ∀x, zero * x = 0 := Nat.zero_mul
      simp only [h]
    | succ x ind =>
      simp only [Nat.succ_mul, ind]
      have ge : x * y ≥ x * z := Nat.mul_le_mul_left x y_ge_z
      simp only [Nat.add_sub_left ge]
      simp only [Nat.add_sub_right y_ge_z]
      simp only [Nat.sub_sub_left, Nat.add_comm]

end SubAddRewriting

protected
theorem add_sub_add_self (x y z : Nat) : (x + z) - (y + z) = x - y := by
  rw [Nat.add_comm y z, (Nat.sub_sub_left _ _ _).symm]
  rw [(Nat.sub_sub_right (@Nat.le.refl z) x).symm]
  rw [Nat.sub_self, Nat.sub_zero]

protected
theorem le_sub_simp {n p:Nat} (g:n ≥ p) (m:Nat) : m ≤ n - p ↔ m + p ≤ n := by
  simp only [(Nat.sub_is_zero_is_le _ _).symm]
  simp only [Nat.sub_sub_right g, iff_self]

protected
theorem sub_le_simp (m n p:Nat) : m - n ≤ p ↔ m ≤ n + p := by
  simp only [(Nat.sub_is_zero_is_le _ _).symm]
  simp only [Nat.sub_sub_left, iff_self]

protected
theorem sub_lt_simp {m n:Nat} (a:m ≥ n) (p:Nat) : m - n < p ↔ m < n + p := by
  have lt_is_le : ∀(x y:Nat), x < y ↔ Nat.succ x ≤ y := fun x y => Iff.intro id id
  simp only [lt_is_le, Nat.succ_sub a]
  simp only [Nat.sub_le_simp, iff_self]

end Nat


/-
Copyright (c) 2022 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/

import topology.algebra.module.character_space
import analysis.normed_space.weak_dual
import analysis.normed_space.spectrum

/-!
# Normed algebras

This file contains basic facts about normed algebras.

## Main results

* We show that the character space of a normed algebra is compact using the Banach-Alaoglu theorem.

## TODO

* Show compactness for topological vector spaces; this requires the TVS version of Banach-Alaoglu.

## Tags

normed algebra, character space, continuous functional calculus

-/

variables {𝕜 : Type*} {A : Type*}

namespace weak_dual
namespace character_space

variables [nontrivially_normed_field 𝕜] [normed_ring A]
  [normed_algebra 𝕜 A] [complete_space A]

lemma norm_le_norm_one (φ : character_space 𝕜 A) :
  ‖to_normed_dual (φ : weak_dual 𝕜 A)‖ ≤ ‖(1 : A)‖ :=
continuous_linear_map.op_norm_le_bound _ (norm_nonneg (1 : A)) $
  λ a, mul_comm (‖a‖) (‖(1 : A)‖) ▸ spectrum.norm_le_norm_mul_of_mem (apply_mem_spectrum φ a)

instance [proper_space 𝕜] : compact_space (character_space 𝕜 A) :=
begin
  rw [←is_compact_iff_compact_space],
  have h : character_space 𝕜 A ⊆ to_normed_dual ⁻¹' metric.closed_ball 0 (‖(1 : A)‖),
  { intros φ hφ,
    rw [set.mem_preimage, mem_closed_ball_zero_iff],
    exact (norm_le_norm_one ⟨φ, ⟨hφ.1, hφ.2⟩⟩ : _), },
  exact is_compact_of_is_closed_subset (is_compact_closed_ball 𝕜 0 _) character_space.is_closed h,
end

end character_space
end weak_dual


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

! This file was ported from Lean 3 source module group_theory.commuting_probability
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.ConjFinite
import Mathlib.GroupTheory.Abelianization
import Mathlib.GroupTheory.GroupAction.ConjAct
import Mathlib.GroupTheory.GroupAction.Quotient
import Mathlib.GroupTheory.Index

/-!
# Commuting Probability
This file introduces the commuting probability of finite groups.

## Main definitions
* `commProb`: The commuting probability of a finite type with a multiplication operation.

## Todo
* Neumann's theorem.
-/
noncomputable section

open Classical

open BigOperators

open Fintype

variable (M : Type _) [Mul M]

/-- The commuting probability of a finite type with a multiplication operation. -/
def commProb : ℚ :=
  Nat.card { p : M × M // p.1 * p.2 = p.2 * p.1 } / (Nat.card M : ℚ) ^ 2
#align comm_prob commProb

theorem commProb_def :
    commProb M = Nat.card { p : M × M // p.1 * p.2 = p.2 * p.1 } / (Nat.card M : ℚ) ^ 2 :=
  rfl
#align comm_prob_def commProb_def

variable [Finite M]

theorem commProb_pos [h : Nonempty M] : 0 < commProb M :=
  h.elim fun x ↦
    div_pos (Nat.cast_pos.mpr (Finite.card_pos_iff.mpr ⟨⟨(x, x), rfl⟩⟩))
      (pow_pos (Nat.cast_pos.mpr Finite.card_pos) 2)
#align comm_prob_pos commProb_pos

theorem commProb_le_one : commProb M ≤ 1 := by
  refine' div_le_one_of_le _ (sq_nonneg (Nat.card M : ℚ))
  rw [← Nat.cast_pow, Nat.cast_le, sq, ← Nat.card_prod]
  apply Finite.card_subtype_le
#align comm_prob_le_one commProb_le_one

variable {M}

theorem commProb_eq_one_iff [h : Nonempty M] :
    commProb M = 1 ↔ Commutative ((· * ·) : M → M → M) := by
  haveI := Fintype.ofFinite M
  rw [commProb, ← Set.coe_setOf, Nat.card_eq_fintype_card, Nat.card_eq_fintype_card]
  rw [div_eq_one_iff_eq, ← Nat.cast_pow, Nat.cast_inj, sq, ← card_prod,
    set_fintype_card_eq_univ_iff, Set.eq_univ_iff_forall]
  · exact ⟨fun h x y ↦ h (x, y), fun h x ↦ h x.1 x.2⟩
  · exact pow_ne_zero 2 (Nat.cast_ne_zero.mpr card_ne_zero)
#align comm_prob_eq_one_iff commProb_eq_one_iff

variable (G : Type _) [Group G] [Finite G]

theorem card_comm_eq_card_conjClasses_mul_card :
    Nat.card { p : G × G // p.1 * p.2 = p.2 * p.1 } = Nat.card (ConjClasses G) * Nat.card G := by
  haveI := Fintype.ofFinite G
  simp only [Nat.card_eq_fintype_card]
  -- Porting note: Changed `calc` proof into a `rw` proof.
  rw [card_congr (Equiv.subtypeProdEquivSigmaSubtype fun g h : G ↦ g * h = h * g), card_sigma,
    sum_equiv ConjAct.toConjAct.toEquiv (fun a ↦ card { b // a * b = b * a })
      (fun g ↦ card (MulAction.fixedBy (ConjAct G) G g))
      fun g ↦ card_congr' <| congr_arg _ <| funext fun h ↦ mul_inv_eq_iff_eq_mul.symm.to_eq,
    MulAction.sum_card_fixedBy_eq_card_orbits_mul_card_group, ConjAct.card,
    (Setoid.ext fun g h ↦ (Setoid.comm' _).trans isConj_iff.symm :
      MulAction.orbitRel (ConjAct G) G = IsConj.setoid G),
    @card_congr' (Quotient (IsConj.setoid G)) (ConjClasses G) _ _ rfl]

#align card_comm_eq_card_conj_classes_mul_card card_comm_eq_card_conjClasses_mul_card

theorem commProb_def' : commProb G = Nat.card (ConjClasses G) / Nat.card G := by
  rw [commProb, card_comm_eq_card_conjClasses_mul_card, Nat.cast_mul, sq]
  exact mul_div_mul_right _ _ (Nat.cast_ne_zero.mpr Finite.card_pos.ne')
#align comm_prob_def' commProb_def'

-- porting note: inserted [Group G]
variable {G} [Group G] (H : Subgroup G)

theorem Subgroup.commProb_subgroup_le : commProb H ≤ commProb G * (H.index : ℚ) ^ 2 := by
  /- After rewriting with `commProb_def`, we reduce to showing that `G` has at least as many
      commuting pairs as `H`. -/
  rw [commProb_def, commProb_def, div_le_iff, mul_assoc, ← mul_pow, ← Nat.cast_mul,
    mul_comm H.index, H.card_mul_index, div_mul_cancel, Nat.cast_le]
  · refine' Finite.card_le_of_injective (fun p ↦ ⟨⟨p.1.1, p.1.2⟩, Subtype.ext_iff.mp p.2⟩) _
    exact fun p q h ↦ by simpa only [Subtype.ext_iff, Prod.ext_iff] using h
  · exact pow_ne_zero 2 (Nat.cast_ne_zero.mpr Finite.card_pos.ne')
  · exact pow_pos (Nat.cast_pos.mpr Finite.card_pos) 2
#align subgroup.comm_prob_subgroup_le Subgroup.commProb_subgroup_le

theorem Subgroup.commProb_quotient_le [H.Normal] : commProb (G ⧸ H) ≤ commProb G * Nat.card H := by
  /- After rewriting with `commProb_def'`, we reduce to showing that `G` has at least as many
      conjugacy classes as `G ⧸ H`. -/
  rw [commProb_def', commProb_def', div_le_iff, mul_assoc, ← Nat.cast_mul, ← Subgroup.index,
    H.card_mul_index, div_mul_cancel, Nat.cast_le]
  · apply Finite.card_le_of_surjective
    show Function.Surjective (ConjClasses.map (QuotientGroup.mk' H))
    exact ConjClasses.map_surjective Quotient.surjective_Quotient_mk''
  · exact Nat.cast_ne_zero.mpr Finite.card_pos.ne'
  · exact Nat.cast_pos.mpr Finite.card_pos
#align subgroup.comm_prob_quotient_le Subgroup.commProb_quotient_le

variable (G)

theorem inv_card_commutator_le_commProb : (↑(Nat.card (commutator G)))⁻¹ ≤ commProb G :=
  (inv_pos_le_iff_one_le_mul (Nat.cast_pos.mpr Finite.card_pos)).mpr
    (le_trans (ge_of_eq (commProb_eq_one_iff.mpr (Abelianization.commGroup G).mul_comm))
      (commutator G).commProb_quotient_le)
#align inv_card_commutator_le_comm_prob inv_card_commutator_le_commProb


/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Lu-Ming Zhang.
-/
import field_theory.finite.basic
import group_theory.quotient_group
import monoid_hom
import set_finset_fintype

import tactic.gptf

/-!
# Finite fields

This file supplements basic results about finite field that are missing in mathlib.
As well, this files defines quadratic residues and the quadratic character,
and contains basic results about them.
Throughout most of this file, `F` denotes a finite field,
and `q` is notation for the cardinality of `F`, and `p` is the character of `F`.

## Main results
1. `finite_field.is_quad_residue`: a proposition predicating whether a given `a : F` is a quadratic residue in `F`.
   `finite_field.is_quad_residue a` is defined to be `a ≠ 0 ∧ ∃ b, a = b^2`.
2. `finite_field.is_non_residue`: a proposition predicating whether a given `a : F` is a quadratic non-residue in `F`.
   `finite_field.is_non_residue a` is defined to be `a ≠ 0 ∧ ¬ ∃ b, a = b^2`.

3. `finite_field.quad_residues`: the subtype of `F` containing quadratic residues.
4. `finite_field.quad_residues_set`: the set containing quadratic residues of `F`.
5. `finite_field.non_residues`: the subtype of `F` containing quadratic non-residues.
6. `finite_field.non_residues_set`: the set containing quadratic non-residues of `F`.

7. `finite_field.sq`: the square function from `units F` to `units F`, defined as a group homomorphism.

8. `finite_filed.non_residue_mul`: is the map `_ * b` given a non-residue `b` defined on `{a : F // is_quad_residue a}`.

9. `finite_field.quad_char`: defines the quadratic character of `a` in a finite field `F`.
   - `χ a = 0 ` if `a = 0`
   - `χ a = 1` if `a ≠ 0` and  `a` is a square
   - `χ a = -1` otherwise

## Notation

Throughout most of this file, `F` denotes a finite field,
and `q` is notation for the cardinality of `F`, and `p` is the character of `F`.
`χ a` denotes the quadratic character of `a : F`.

-/

--local attribute [instance] set_fintype
--local attribute [-instance] set.fintype_univ

set_option pp.beta true

open_locale big_operators
open finset fintype monoid_hom nat.modeq function

namespace finite_field

variables {F : Type*} [field F] [fintype F] {p : ℕ} [char_p F p]
local notation `q` := fintype.card F -- declares `q` as a notation

/- ## basic -/
section basic

/-- `|F| = |units F| + 1`. The `+` version of `finite_field.card_units`. -/
lemma card_units' :
fintype.card F = fintype.card (units F) + 1 :=
begin
  simp [card_units],
  have h : 0 < fintype.card F := fintype.card_pos_iff.2 ⟨0⟩,
  rw [nat.sub_add_cancel h]
end

variables (p)
/-- If `n` is a prime number and `↑n = 0` in `F`, then `p = n`. -/
lemma char_eq_of_prime_eq_zero
{n : ℕ} (h₁ : nat.prime n) (h₂ : ↑n = (0 : F)) : p = n :=
begin
  have g₁ : nat.prime p, {obtain ⟨n, h1, h2⟩:= finite_field.card F p, assumption},
  have g₂ := (char_p.cast_eq_zero_iff F p n).1 h₂,
  exact (nat.prime_dvd_prime_iff_eq g₁ h₁).1 g₂,
end

lemma char_ne_two_of :
q ≡ 1 [MOD 4] ∨ q ≡ 3 [MOD 4] → p ≠ 2 :=
begin
  obtain ⟨n, p_prime, g⟩:= finite_field.card F p,
  rw g,
  rintro (h | h),
  any_goals
  { rw nat.modeq_iff_dvd at h,
    rintro hp, rw hp at h,
    rcases h with ⟨k, h⟩,
    simp at h,
    have : 2 ∣ 4 * k + 2 ^ ↑n,
    { use (2 * k + (2 : ℤ) ^ n.1.pred),
      simp [mul_add], congr' 1,
      ring,
      have : (2 : ℤ) * 2 ^ (n : ℕ).pred = 2 ^ ((n : ℕ).pred + 1), {refl},
      convert this.symm,
      clear this,
      convert (nat.succ_pred_eq_of_pos _).symm,
      exact n.2 },
  },
  { have g := eq_add_of_sub_eq h, rw ← g at this, revert this, dec_trivial },
  { have g := eq_add_of_sub_eq h, rw ← g at this, revert this, dec_trivial },
end

lemma char_ne_two_of' :
q ≡ 3 [MOD 4] → p ≠ 2 ∧ ¬ q ≡ 1 [MOD 4] :=
begin
  intros h,
  refine ⟨char_ne_two_of p (or.inr h), _⟩,
  intro h',
  have g := h'.symm.trans  h,
  simp [nat.modeq_iff_dvd] at g,
  rcases g with ⟨k, g⟩,
  norm_num at g,
  have : 2 / 4 = (4 * k) / 4, {rw ← g},
  norm_num at this,
  simp [← this] at g,
  assumption
end

/-- For non-zero `a : F`, `to_unit` converts `a` to an instance of `units F`. -/
@[simp] def to_unit {a : F} (h : a ≠ 0): units F :=
by refine {val := a, inv := a⁻¹, ..}; simp* at *

/-- The order of `a : units F` equals the order of `a` coerced in `F`. -/
lemma order_of_unit_eq (a : units F) : order_of a = order_of (a : F) :=
begin
  convert (@order_of_injective (units F) _ F _ (units.coe_hom F) _ a).symm,
  intros i j h,
  simp[*, units.ext_iff] at *,
end

variables (F) {p}

@[simp]
lemma two_eq_zero (hp : p = 2) : (2 : F) = 0 :=
by convert (char_p.cast_eq_zero_iff F p 2).2 _; simp [hp]

@[simp]
lemma neg_one_eq_one_of (hp : p = 2) : (-1 : F) = 1 :=
calc (-1 : F) = (-1 : F) + 0 : by simp
          ... = (-1 : F) + (1 + 1)  : by {congr, norm_num [two_eq_zero F hp]}
          ... = 1 : by simp

@[simp]
lemma neg_one_eq_one_of' (hp: p = 2) : (-1 : units F) = 1 :=
by simp [units.ext_iff, neg_one_eq_one_of F hp]

/-- If the character of `F` is not `2`, `-1` is not equal to `1` in `F`. -/
lemma neg_one_ne_one_of (hp: p ≠ 2) : (-1 : F) ≠ 1 :=
begin
  intros h,
  have h' := calc ↑(2 : ℕ) = (2 : F)     : by simp
                      ... = (1 : F) + 1  : by ring
                      ... = (-1 : F) + 1 : by nth_rewrite 0 ←h
                      ... = 0            : by ring,
  have hp' := char_eq_of_prime_eq_zero p nat.prime_two h',
  contradiction
end

/-- If the character of `F` is not `2`, `-1` is not equal to `1` in `units F`. -/
lemma neg_one_ne_one_of' (hp: p ≠ 2) : (-1 : units F) ≠ 1 :=
by simp [units.ext_iff, neg_one_ne_one_of F hp]

variable {F}

/-- For `x : F`, `x^2 = 1 ↔ x = 1 ∨ x = -1`. -/
lemma sq_eq_one_iff_eq_one_or_eq_neg_one (x : F) :
x^2 = 1 ↔ x = 1 ∨ x = -1 :=
begin
  rw [sub_eq_zero.symm],
  have h: x ^ 2 - 1 = (x - 1) * (x + 1), {ring},
  rw [h, mul_eq_zero, sub_eq_zero, add_eq_zero_iff_eq_neg]
end

/-- For `x : units F`, `x^2 = 1 ↔ x = 1 ∨ x = -1`. -/
lemma sq_eq_one_iff_eq_one_or_eq_neg_one' (x : units F) :
x^2 = 1 ↔ x = 1 ∨ x = -1 :=
begin
  simp only [units.ext_iff],
  convert sq_eq_one_iff_eq_one_or_eq_neg_one (x : F),
  simp,
end

/-- If the character of `F` is not `2`, `-1` is the only order 2 element in `F`. -/
lemma order_of_eq_two_iff (hp: p ≠ 2) (x : F) : order_of x = 2 ↔ x = -1 :=
begin
  have g := pow_order_of_eq_one x, -- g: x ^ order_of x = 1
  split, -- splits into `order_of x = 2 → x = -1` and `x = -1 → order_of x = 2`
  any_goals {intros h},
  { rw [h, sq_eq_one_iff_eq_one_or_eq_neg_one] at g, -- g : x = 1 ∨ x = -1
    have : x ≠ 1, { intro hx, rw ←order_of_eq_one_iff at hx, linarith },
    exact or_iff_not_imp_left.1 g this },
  { have hx : x^2 = 1, {rw h, ring},
    have inst : fact (nat.prime 2),
    {exact ⟨nat.prime_two⟩},
    resetI, -- resets the instance cache.
    convert order_of_eq_prime hx _,
    rw [h],
    exact neg_one_ne_one_of F hp }
end

/-- The "units" version of `order_of_eq_two_iff`. -/
lemma order_of_eq_two_iff' (hp: p ≠ 2) (x : units F) : order_of x = 2 ↔ x = -1 :=
by simp [units.ext_iff]; rw [← order_of_eq_two_iff hp (x : F), order_of_unit_eq x]

lemma card_eq_one_mod_n_iff_n_divide_card_units (n : ℕ):
q ≡ 1 [MOD n] ↔ n ∣ fintype.card (units F) :=
begin
  rw [finite_field.card_units, nat.modeq.comm],
  convert nat.modeq_iff_dvd' (card_pos_iff.mpr ⟨(0 : F)⟩),
end

/-- `-1` is a square in `units F` iff the cardinal `q ≡ 1 [MOD 4]`. -/
theorem neg_one_eq_sq_iff' (hp: p ≠ 2) :
(∃ a : units F, -1 = a^2) ↔ q ≡ 1 [MOD 4] :=
begin
  -- rewrites the RHS to `4 ∣ fintype.card (units F)`
  rw card_eq_one_mod_n_iff_n_divide_card_units,
  split, -- splits the goal into two directions
  -- the `→` direction
  { rintros ⟨a, h'⟩,
    -- h: a ^ 4 = 1
    have h := calc a^4 = a^2 * a^2 : by group
                 ... = 1: by simp [← h'],
    -- h₀: order_of a ∣ 4
    have h₀ := order_of_dvd_of_pow_eq_one h,
    -- au: order_of a ≤ 4
    have au := nat.le_of_dvd dec_trivial h₀,
    -- g₁ : a ≠ 1
    have g₁ : a ≠ 1,
    { rintro rfl, simp at h',
      exact absurd h' (neg_one_ne_one_of' F hp) },
    -- h₁ : order_of a ≠ 1
    have h₁ := mt order_of_eq_one_iff.1 g₁,
    -- g₂ : a ≠ -1
    have g₂ : a ≠ -1,
    { rintro rfl, simp [pow_two] at h',
      exact absurd h' (neg_one_ne_one_of' F hp) },
    -- h₂ : order_of a ≠ 2
    have h₂ := mt (order_of_eq_two_iff' hp a).1 g₂,
    -- ha : order_of a = 4
    have ha : order_of a = 4,
    { revert h₀ h₁ h₂,
      interval_cases (order_of a),
      any_goals {rw h_1, norm_num} },
    simp [← ha, order_of_dvd_card_univ] },
  -- the `←` direction
  { rintro ⟨k, hF⟩, -- hF : |units F| = 4 * k
    -- `hg'` is a proof that `g` generates `units F`
    obtain ⟨g, hg'⟩ := is_cyclic.exists_generator (units F),
    -- hg : g ^ |units F| = 1
    have hg := @pow_card_eq_one (units F) g _ _,
    have eq : 4 * k = k * 2 * 2, {ring},
    -- rewrite `hg` to `hg : g ^ (k * 2) = 1 ∨ g ^ (k * 2) = -1`
    rw [hF, eq, pow_mul, sq_eq_one_iff_eq_one_or_eq_neg_one'] at hg,
    rcases hg with (hg | hg), -- splits into two cases
    -- case `g ^ (k * 2) = 1`
    { have hk₁ := card_pos_iff.mpr ⟨(1 : units F)⟩,
      have o₁ := order_of_eq_card_of_forall_mem_gpowers hg',
      have o₂ := order_of_dvd_of_pow_eq_one hg,
      have le := nat.le_of_dvd (by linarith) o₂,
      rw [o₁, hF] at *,
      exfalso, linarith },
    -- case `g ^ (k * 2) = -1`
    { use g ^ k, simp [← hg, pow_mul] } },
end

/-- `-1` is a square in `F` iff the cardinal `q ≡ 1 [MOD 4]`. -/
lemma neg_one_eq_sq_iff (hp: p ≠ 2) :
(∃ a : F, -1 = a^2) ↔ fintype.card F ≡ 1 [MOD 4] :=
begin
  rw [←neg_one_eq_sq_iff' hp],
  -- the current goal is
  -- `(∃ (a : F), -1 = a ^ 2) ↔ ∃ (a : units F), -1 = a ^ 2`
  split, -- splits into two directions
  any_goals {rintros ⟨a, ha⟩},
  -- the `→` direction
  { have ha' : a ≠ 0,
    {rintros rfl, simp* at *},
    use (to_unit ha'),
    simpa [units.ext_iff] },
  -- the `←` direction
  { use a, simp [units.ext_iff] at ha, assumption },
  assumption
end

variables (F)

lemma disjoint_units_zero : disjoint {a : F | a ≠ 0} {0} :=
by simp

lemma units_union_zero : {a : F | a ≠ 0} ∪ {0} = @set.univ F :=
by {tidy, tauto}

end basic
/- ## end basic -/

/- ## quad_residues -/
section quad_residues

variables {F p}

/-- A proposition predicating whether a given `a : F` is a quadratic residue in `F`.
    `finite_field.is_quad_residue a` is defined to be `a ≠ 0 ∧ ∃ b, a = b^2`. -/
--@[derive decidable]
def is_quad_residue (a : F) : Prop := a ≠ 0 ∧ ∃ b, a = b^2

/-- A proposition predicating whether a given `a : F` is a quadratic non-residue in `F`.
    `finite_field.is_non_residue a` is defined to be `a ≠ 0 ∧ ¬ ∃ b, a = b^2`. -/
--@[derive decidable]
def is_non_residue (a : F) : Prop := a ≠ 0 ∧ ¬ ∃ b, a = b^2

instance [decidable_eq F] (a : F) : decidable (is_quad_residue a) :=
by {unfold is_quad_residue, apply_instance}

instance [decidable_eq F] (a : F) : decidable (is_non_residue a) :=
by {unfold is_non_residue, apply_instance}

variables {F p}

lemma not_residue_iff_is_non_residue
{a : F} (h : a ≠ 0) :
¬ is_quad_residue a ↔ is_non_residue a :=
by simp [is_quad_residue, is_non_residue, *] at *

lemma is_non_residue_of_not_residue
{a : F} (h : a ≠ 0) (g : ¬ is_quad_residue a) :
is_non_residue a :=
(not_residue_iff_is_non_residue h).1 g

lemma not_non_residue_iff_is_residue
{a : F} (h : a ≠ 0) :
¬ is_non_residue a ↔ is_quad_residue a :=
by simp [is_quad_residue, is_non_residue, *] at *

lemma is_residue_of_not_non_residue
{a : F} (h : a ≠ 0) (g : ¬ is_non_residue a) :
is_quad_residue a :=
(not_non_residue_iff_is_residue h).1 g

lemma residue_or_non_residue
{a : F} (h : a ≠ 0) :
is_quad_residue a ∨  is_non_residue a :=
begin
  by_cases g: is_quad_residue a,
  exact or.inl g,
  exact or.inr (is_non_residue_of_not_residue h g),
end

/-- `-1` is a residue if `q ≡ 1 [MOD 4]`. -/
lemma neg_one_is_residue_of (hF : q ≡ 1 [MOD 4]) :
is_quad_residue (-1 : F) :=
begin
  obtain ⟨p, inst⟩ := char_p.exists F, -- derive the char p of F
  resetI, -- resets the instance cache
  have hp := char_ne_two_of p (or.inl hF), -- hp: p ≠ 2
  have h := (neg_one_eq_sq_iff hp).2 hF, -- h : -1 is a square
  refine ⟨by tidy, h⟩
end

/-- `-1` is a non-residue if `q ≡ 3 [MOD 4]`. -/
lemma neg_one_is_non_residue_of (hF : q ≡ 3 [MOD 4]) :
is_non_residue (-1 : F) :=
begin
  obtain ⟨p, inst⟩ := char_p.exists F, -- derive the char p of F
  resetI, -- resets the instance cache
  -- hp: p ≠ 2, hF': ¬fintype.card F ≡ 1 [MOD 4]
  obtain ⟨hp, hF'⟩ := char_ne_two_of' p hF,
  -- h: ¬∃ (a : F), -1 = a ^ 2
  have h := mt (neg_one_eq_sq_iff hp).1 hF',
  refine ⟨by tidy, h⟩
end

variable (F)

@[simp] lemma eq_residues :
{j // ¬j = 0 ∧ ∃ (b : F), j = b ^ 2} =
{a : F // is_quad_residue a} := rfl

@[simp] lemma eq_non_residues :
{j // ¬j = 0 ∧ ¬∃ (x : F), j = x ^ 2} =
{a : F // is_non_residue a} := rfl

@[simp] lemma eq_non_residues' :
{j // ¬j = 0 ∧ ∀ (x : F), ¬j = x ^ 2} =
{a : F // is_non_residue a} := by simp [is_non_residue]

/-- `|F| = 1 + |{a : F // is_quad_residue a}| + |{a : F // is_non_residue a}|` -/
lemma eq_one_add_card_residues_add_card_non_residues
[decidable_eq F]:
q = 1 + fintype.card {a : F // is_quad_residue a} +
        fintype.card {a : F // is_non_residue a} :=
begin
  rw [fintype.card_split (λ a : F, a = 0),
      fintype.card_split' (λ a : F, a ≠ 0) (λ a, ∃ b, a = b^2)],
  simp [add_assoc],
end

/- ### sq_function -/
section sq_function

open quotient_group

variables (F) -- re-declares `F` as an explicit variable

/-- `sq` is the square function from `units F` to `units F`,
    defined as a group homomorphism. -/
def sq : (units F) →* (units F) :=
⟨λ a, a * a, by simp, (λ x y, by simp [units.ext_iff]; ring)⟩

/-- `|units F| = |(sq F).range| * |(sq F).ker|` -/
theorem sq.iso [decidable_eq F] :
fintype.card (units F) = fintype.card (sq F).range * fintype.card (sq F).ker :=
begin
  have iso := quotient_ker_equiv_range (sq F),
  have eq := fintype.card_congr (mul_equiv.to_equiv iso),
  rw [subgroup.card_eq_card_quotient_mul_card_subgroup (sq F).ker, eq]
end

/-- `sq.range_equiv` constructs the natural equivalence between
    the `(sq F).range` and `{a : F // is_quad_residue a}`. -/
def sq.range_equiv : (sq F).range ≃ {a : F // is_quad_residue a} :=
⟨
 λ a, ⟨a, by {have h := a.2, simp [sq] at h, rcases h with ⟨b, h⟩,
              simp [is_quad_residue, ← h], use b, ring }⟩,
 λ a, ⟨to_unit (a.2).1, by {obtain ⟨h, ⟨b, hab⟩⟩:= a.2,
                            have hb : b ≠ 0, {rintros rfl, simp* at *},
                            use to_unit hb, simp [units.ext_iff, sq, ← pow_two, ← hab] }⟩,
 λ a, by simp [units.ext_iff],
 λ a, by simp
⟩

/-- `|(sq F).range| = |{a : F // is_quad_residue a}|` -/
theorem sq.card_range_eq [decidable_eq F] :
fintype.card (sq F).range = fintype.card {a : F // is_quad_residue a} :=
by apply fintype.card_congr (sq.range_equiv F)

--lemma test : ↥(sq F).ker = {a : units F // a = 1 ∨ a = -1} := sorry

lemma sq.ker_carrier_eq :
(sq F).ker.carrier = {1, -1} :=
begin
  ext,
  simp [sq, mem_ker, ←pow_two, sq_eq_one_iff_eq_one_or_eq_neg_one' x],
end

lemma sq.ker_carrier_eq_of_char_eq_two (hp: p = 2):
(sq F).ker.carrier = {1} :=
by simp [sq.ker_carrier_eq, neg_one_eq_one_of' F hp]

lemma sq.card_ker_carrier_eq_of_char_ne_two [decidable_eq F] (hp: p ≠ 2) :
fintype.card (sq F).ker.carrier = 2 :=
begin
  simp [sq.ker_carrier_eq F],
  convert @set.card_insert _ (1 : units F) {-1} _ _ _; simp,
  exact ne.symm (neg_one_ne_one_of' F hp),
end

/-- `|(sq F).ker| = 2` if `p ≠ 2` -/
theorem sq.card_ker_eq_of_char_ne_two [decidable_eq F] (hp: p ≠ 2) :
fintype.card (sq F).ker = 2 :=
by rw [←sq.card_ker_carrier_eq_of_char_ne_two F hp]; refl

lemma sq.card_ker_carrier_eq_of_char_eq_two [decidable_eq F] (hp: p = 2) :
fintype.card (sq F).ker.carrier = 1 :=
by simp [sq.ker_carrier_eq_of_char_eq_two F hp]

/-- `|(sq F).ker| = 1` if `p = 2` -/
theorem sq.card_ker_eq_of_char_eq_two [decidable_eq F] (hp: p = 2) :
fintype.card (sq F).ker = 1 :=
by rw [←sq.card_ker_carrier_eq_of_char_eq_two F hp]; refl

end sq_function
/- ### end sq_function -/

variable (F)

/-- `|units F| = |{a : F // is_quad_residue a}| * 2` if `p ≠ 2` -/
theorem card_units_eq_card_residues_mul_two [decidable_eq F] (hp: p ≠ 2) :
fintype.card (units F) = fintype.card {a : F // is_quad_residue a} * 2 :=
by rwa [sq.iso, sq.card_range_eq, sq.card_ker_eq_of_char_ne_two F hp]

/-- `|units F| = |{a : F // is_quad_residue a}|` if `p = 2` -/
theorem card_units_eq_card_residues [decidable_eq F] (hp: p = 2) :
fintype.card (units F) = fintype.card {a : F // is_quad_residue a}:=
by simp [sq.iso, sq.card_range_eq, sq.card_ker_eq_of_char_eq_two F hp]

/-- `|{a : F // is_quad_residue a}| = |{a : F // is_non_residue a}|`-/
theorem card_residues_eq_card_non_residues
[decidable_eq F] (hp : p ≠ 2):
fintype.card {a : F // is_quad_residue a} =
fintype.card {a : F // is_non_residue a} :=
begin
  have eq := eq_one_add_card_residues_add_card_non_residues F,
  simp [card_units', card_units_eq_card_residues_mul_two F hp] at eq,
  linarith
end

/-- unfolded version of `card_residues_eq_card_non_residues` -/
theorem card_residues_eq_card_non_residues'
[decidable_eq F] (hp : p ≠ 2):
(@univ {a : F // is_quad_residue a} _).card =
(@univ {a : F // is_non_residue a} _).card :=
by convert card_residues_eq_card_non_residues F hp

variable {F} -- re-declares `F` as an implicit variable

lemma false_of_char_eq_two_of_is_non_residue
(hp : p = 2) {a : F} (ha: is_non_residue a) : false :=
begin
  classical,
  have h := eq_one_add_card_residues_add_card_non_residues F,
  rw [card_units', card_units_eq_card_residues F hp, add_comm _ 1, add_assoc] at h,
  have g : fintype.card {a // is_non_residue a} = 0 :=
           add_right_eq_self.mp (congr_fun (congr_arg (+) ((add_right_inj 1).mp h).symm) _),
  clear h,
  rw [card_eq_zero_iff] at g,
  apply g.false,
  exact ⟨a, ha⟩,
end

lemma is_quad_residue_of_char_eq_two (hp : p = 2) {a : F} (ha : a ≠ 0) :
  is_quad_residue a :=
begin
  by_contra,
  exact false_of_char_eq_two_of_is_non_residue hp (is_non_residue_of_not_residue ha h),
end

example : (0 : F)⁻¹ = 0 := by simp

/-- `a⁻¹` is a residue if and only if `a` is. -/
theorem inv_is_residue_iff {a : F} :
is_quad_residue a⁻¹ ↔ is_quad_residue a :=
begin
  split, -- splits into two directions
  any_goals {rintro ⟨h, b, g⟩, refine ⟨by tidy, b⁻¹, by simp [←g]⟩},
end

/-- `a⁻¹` is a non residue if and only if `a` is. -/
theorem inv_is_non_residue_iff {a : F} :
is_non_residue a⁻¹ ↔ is_non_residue a :=
begin
  by_cases h : a = 0,
  {simp* at *}, -- when `a = 0`
  have h' : a⁻¹ ≠ 0 := by simp [h],
  simp [←not_residue_iff_is_non_residue, *, inv_is_residue_iff]
end

theorem residue_mul_residue_is_residue
{a b : F} (ha : is_quad_residue a) (hb : is_quad_residue b) :
is_quad_residue (a * b) :=
begin
  obtain ⟨ha, c, rfl⟩ := ha,
  obtain ⟨hb, d, rfl⟩ := hb,
  refine ⟨mul_ne_zero ha hb, c*d, _⟩,
  ring
end

theorem non_residue_mul_residue_is_non_residue
{a b : F} (ha : is_non_residue a) (hb : is_quad_residue b) :
is_non_residue (a * b) :=
begin
  obtain ⟨hb, c, rfl⟩ := hb,
  refine ⟨mul_ne_zero ha.1 hb, _⟩,
  rintro ⟨d, h⟩,
  convert ha.2 ⟨(d * c⁻¹), _⟩,
  field_simp [← h],
end

theorem residue_mul_non_residue_is_non_residue
{a b : F} (ha : is_quad_residue a) (hb : is_non_residue b):
is_non_residue (a * b) :=
by simp [mul_comm a, non_residue_mul_residue_is_non_residue hb ha]

/-- `finite_filed.non_residue_mul` is the map `a * _` given a non-residue `a`
    defined on `{b : F // is_quad_residue b}`. -/
def non_residue_mul {a: F} (ha : is_non_residue a) :
{b : F // is_quad_residue b} → {b : F // is_non_residue b} :=
λ b, ⟨a * b, non_residue_mul_residue_is_non_residue ha b.2⟩

open function

/-- proves that `a * _` is injective from residues for a non-residue `a` -/
lemma is_non_residue.mul_is_injective
{a: F} (ha : is_non_residue a) :
injective (non_residue_mul ha):=
begin
  intros b₁ b₂ h,
  simp [non_residue_mul] at h,
  ext,
  convert or.resolve_right h ha.1,
end

/-- proves that `a * _` is surjective onto non-residues for a non-residue `a` -/
lemma is_non_residue.mul_is_surjective
[decidable_eq F] (hp : p ≠ 2) {a: F} (ha : is_non_residue a) :
surjective (non_residue_mul ha):=
begin
  by_contra, -- prove by contradtiction
  have lt := card_lt_of_injective_not_surjective
    (non_residue_mul ha) (ha.mul_is_injective) h,
  have eq := card_residues_eq_card_non_residues F hp,
  linarith
end

theorem non_residue_mul_non_residue_is_residue
[decidable_eq F] {a b : F} (ha : is_non_residue a) (hb : is_non_residue b):
is_quad_residue (a * b) :=
begin
  obtain ⟨p, inst⟩ := char_p.exists F, -- derive the char p of F
  resetI, -- resets the instance cache
  by_cases hp : p = 2,
  {apply is_quad_residue_of_char_eq_two hp, simp [ha.1, hb.1], assumption},
  by_contra h, -- prove by contradtiction
  -- rw `h` to `is_non_residue (a * b)`
  rw [not_residue_iff_is_non_residue (mul_ne_zero ha.1 hb.1)] at h,
  -- surj : `a * _` is surjective onto non-residues from residues
  have surj := ha.mul_is_surjective hp,
  simp [function.surjective] at surj,
  -- in particular, non-residue `a * b` is in the range of `a * _`
  specialize surj (a * b) h,
  -- say `a * b' = a * b` and `hb' : is_quad_residue b'`
  rcases surj with ⟨b', hb', eq⟩,
  simp [non_residue_mul, ha.1] at eq, -- `eq: b' = b`
  rw [eq] at hb',
  exact absurd hb'.2 hb.2,
end

end quad_residues

/- ## end quad_residues -/

/- ## quad_char -/

section quad_char

variables {F} [decidable_eq F]

/-- `finite_field.quad_char` defines the quadratic character of `a` in a finite field `F`. -/
def quad_char (a : F) : ℚ :=
if a = 0            then 0 else
if ∃ b : F, a = b^2 then 1 else
                        -1.

notation `χ` := quad_char  -- declare the notation for `quad_char`

@[simp] lemma quad_char_zero_eq_zero : χ (0 : F) = 0 := by simp [quad_char]

@[simp] lemma quad_char_one_eq_one : χ (1 : F) = 1 :=
by {simp [quad_char], intros h, specialize h 1, simp* at *}

@[simp] lemma quad_char_ne_zero_of_ne_zero {a : F} (h : a ≠ 0) :
χ a ≠ 0 :=
by by_cases (∃ (b : F), a = b ^ 2); simp [quad_char, *] at *

@[simp] lemma quad_char_eq_zero_iff_eq_zero (a : F) :
χ a = 0 ↔ a = 0 :=
begin
  split,
  {contrapose, exact quad_char_ne_zero_of_ne_zero},
  {rintro rfl, exact quad_char_zero_eq_zero}
end

@[simp] lemma quad_char_i_sub_j_eq_zero_iff_i_eq_j (i j : F) :
χ (i - j) = 0 ↔ i = j :=
by simp [sub_eq_zero]

@[simp] lemma quad_char_eq_one_or_neg_one_of_char_ne_zero {a : F} (h : χ a ≠ 0) :
(χ a = 1) ∨ (χ a = -1) :=
by by_cases (∃ (b : F), a = b ^ 2); simp [quad_char, *] at *

@[simp] lemma quad_char_eq_neg_one_or_one_of_ne_zero' {a : F} (h : χ a ≠ 0) :
(χ a = -1) ∨ (χ a = 1) :=
or.swap (quad_char_eq_one_or_neg_one_of_char_ne_zero h)

@[simp] lemma quad_char_eq_one_or_neg_one_of_ne_zero {a : F} (h : a ≠ 0) :
(χ a = 1) ∨ (χ a = -1) :=
quad_char_eq_one_or_neg_one_of_char_ne_zero (quad_char_ne_zero_of_ne_zero h)

@[simp] lemma quad_char_suqare_eq_one_of_ne_zero {a : F} (h : a ≠ 0) :
χ a * χ a = 1 :=
by by_cases (∃ (b : F), a = b ^ 2); simp [quad_char, *] at *

@[simp] lemma quad_char_eq_one_of {a : F} (h : a ≠ 0) (h' : ∃ (b : F), a = b ^ 2) :
χ a = 1 :=
by simp [quad_char, *] at *

@[simp] lemma quad_char_eq_neg_one_of {a : F} (h : a ≠ 0) (h' : ¬ ∃ (b : F), a = b ^ 2) :
χ a = -1 :=
by simp [quad_char, *] at *

@[simp] lemma quad_char_eq_one_of_quad_residue {a : F} (h : is_quad_residue a) :
χ a = 1 := quad_char_eq_one_of h.1 h.2

@[simp] lemma quad_char_eq_neg_one_of_non_residue {a : F} (h : is_non_residue a) :
χ a = -1 := quad_char_eq_neg_one_of h.1 h.2

@[simp] lemma nonzero_quad_char_eq_one_or_neg_one' {a b : F} (h : a ≠ b) :
(χ (a - b) = 1) ∨ (χ (a - b) = -1) :=
by {have h':= sub_ne_zero.mpr h, simp* at *}

variables {F p}

theorem quad_char_inv (a : F) : χ a⁻¹ = χ a :=
begin
  by_cases ha: a = 0,
  {simp [ha]}, -- case `a=0`
  -- splits into cases if `a` is a residue
  obtain (ga | ga) := residue_or_non_residue ha,
  -- case 1: `a` is a residue
  {have g':= inv_is_residue_iff.2 ga, simp*},
  -- case 2: `a` is a non-residue
  {have g':= inv_is_non_residue_iff.2 ga, simp*},
end

theorem quad_char_mul (a b : F) : χ (a * b) = χ a * χ b :=
begin
  by_cases ha: a = 0,
  any_goals {by_cases hb : b = 0},
  any_goals {simp*}, -- closes cases when `a = 0` or `b =0`
  -- splits into cases if `a` is a residue
  obtain (ga | ga) := residue_or_non_residue ha,
  -- splits into cases if `b` is a residue
  any_goals {obtain (gb | gb) := residue_or_non_residue hb},
  -- case 1 : `a` is, `b` is
  { have g:= residue_mul_residue_is_residue ga gb, simp* },
  -- case 2 : `a` is, `b` is not
  { have g:= residue_mul_non_residue_is_non_residue ga gb, simp* },
  -- case 1 : `a` is not, `b` is
  { have g:= non_residue_mul_residue_is_non_residue ga gb, simp* },
  -- case 4 : `a` is not, `b` is not
  { have g:= non_residue_mul_non_residue_is_residue ga gb, simp* },
end

/-- `χ (-1) = 1` if `q ≡ 1 [MOD 4]`. -/
@[simp] theorem char_neg_one_eq_one_of (hF : q ≡ 1 [MOD 4]) :
χ (-1 : F) = 1 :=
by simp [neg_one_is_residue_of hF]

/-- `χ (-1) = -1` if `q ≡ 3 [MOD 4]`. -/
@[simp] theorem char_neg_one_eq_neg_one_of (hF : q ≡ 3 [MOD 4]) :
χ (-1 : F) = -1 :=
by simp [neg_one_is_non_residue_of hF]

/-- `χ (-i) = χ i` if `q ≡ 1 [MOD 4]`. -/
theorem quad_char_is_sym_of (hF : q ≡ 1 [MOD 4]) (i : F) :
χ (-i) = χ i :=
begin
  have h := char_neg_one_eq_one_of hF, -- h: χ (-1) = 1
  -- χ (-i) = 1 * χ (-i) = χ (-1) * χ (-i) = χ ((-1) * (-i))
  rw [← one_mul (χ (-i)), ← h, ← quad_char_mul],
  simp,
end

/-- another form of `quad_char_is_sym_of` -/
theorem quad_char_is_sym_of' (hF : q ≡ 1 [MOD 4]) (i j : F) :
χ (j - i) = χ (i - j) :=
by convert quad_char_is_sym_of hF (i - j); ring

/-- `χ (-i) = - χ i` if `q ≡ 3 [MOD 4]`. -/
theorem quad_char_is_skewsym_of (hF : q ≡ 3 [MOD 4]) (i : F) :
χ (-i) = - χ i :=
begin
  have h := char_neg_one_eq_neg_one_of hF, -- h: χ (-1) = 1
  rw [← neg_one_mul (χ i), ← h, ← quad_char_mul],
  simp,
end

/-- another form of `quad_char_is_skewsym_of` -/
theorem quad_char_is_skewsym_of' (hF : q ≡ 3 [MOD 4]) (i j : F) :
χ (j - i) = - χ (i - j) :=
by convert quad_char_is_skewsym_of hF (i - j); ring

variable (F) -- use `F` as an explicit parameter

/-- `∑ a : {a : F // a ≠ 0}, χ (a : F) = 0` if `p ≠ 2`. -/
lemma quad_char.sum_in_non_zeros_eq_zero (hp : p ≠ 2):
∑ a : {a : F // a ≠ 0}, χ (a : F) = 0 :=
begin
  simp [fintype.sum_split' (λ a : F, a ≠ 0) (λ a : F, ∃ b, a = b^2)],
  suffices h :
  ∑ (j : {j // j ≠ 0 ∧ ∃ (b : F), j = b ^ 2}), χ (j : F) =
  ∑ a : {a : F // is_quad_residue a} , 1,
  suffices g :
  ∑ (j : {j // j ≠ 0 ∧ ¬∃ (b : F), j = b ^ 2}), χ (j : F) =
  ∑ a : {a : F // is_non_residue a} , -1,
  simp [h, g, sum_neg_distrib,
        card_residues_eq_card_non_residues' F hp],
  any_goals
  {apply fintype.sum_congr, intros a, have := a.2, simp* at *},
end

/-- `∑ (a : F), χ a = 0` if `p ≠ 2`. -/
theorem quad_char.sum_eq_zero (hp : p ≠ 2):
∑ (a : F), χ a = 0 :=
by simp [fintype.sum_split (λ b, b = (0 : F)),
         quad_char.sum_in_non_zeros_eq_zero F hp, default]

variable {F} -- use `F` as an implicit parameter

/-- another form of `quad_char.sum_eq_zero` -/
@[simp] lemma quad_char.sum_eq_zero_reindex_1 (hp : p ≠ 2) {a : F}:
∑ (b : F), χ (a - b) = 0 :=
begin
  rw ← quad_char.sum_eq_zero F hp,
  refine fintype.sum_equiv ((equiv.sub_right a).trans (equiv.neg _)) _ _ (by simp),
end

/-- another form of `quad_char.sum_eq_zero` -/
@[simp] lemma quad_char.sum_eq_zero_reindex_2 (hp : p ≠ 2) {b : F}:
∑ (a : F), χ (a - b) = 0 :=
begin
  rw ← quad_char.sum_eq_zero F hp,
  refine fintype.sum_equiv (equiv.sub_right b) _ _ (by simp),
end

variable {F} -- use `F` as an implicit parameter

/-- helper of `quad_char.sum_mul'`: reindex the terms in the summation -/
lemma quad_char.sum_mul'_aux {b : F} (hb : b ≠ 0) :
∑ (a : F) in filter (λ (a : F), ¬a = 0) univ, χ (1 + a⁻¹ * b) =
∑ (c : F) in filter (λ (c : F), ¬c = 1) univ, χ (c) :=
begin
  refine finset.sum_bij (λ a ha, 1 + a⁻¹ * b) (λ a ha, _)
    (λ a ha, rfl) (λ a₁ a₂ h1 h2 h, _) (λ c hc, _),
  { simp at ha, simp* },
  { simp at h1 h2, field_simp at h, rw (mul_right_inj' hb).1 h.symm },
  { simp at hc, use b * (c - 1)⁻¹,
    simp [*, mul_inv_rev', sub_ne_zero.2 hc] }
end

/-- If `b ≠ 0` and `p ≠ 2`, `∑ a : F, χ (a) * χ (a + b) = -1`. -/
theorem quad_char.sum_mul' {b : F} (hb : b ≠ 0) (hp : p ≠ 2):
∑ a : F, χ (a) * χ (a + b) = -1 :=
begin
  rw [finset.sum_split _ (λ a, a = (0 : F))],
  simp,
  have h : ∑ (a : F) in filter (λ (a : F), ¬a = 0) univ, χ a * χ (a + b) =
           ∑ (a : F) in filter (λ (a : F), ¬a = 0) univ, χ (1 + a⁻¹ * b),
  { apply finset.sum_congr rfl,
    intros a ha, simp at ha,
    simp [←quad_char_inv a, ←quad_char_mul a⁻¹],
    field_simp },
  rw [h, quad_char.sum_mul'_aux hb],
  have g:= @finset.sum_split _ _ _ (@finset.univ F _) (χ) (λ a : F, a = 1) _,
  simp [quad_char.sum_eq_zero F hp] at g,
  linarith
end

/-- another form of `quad_char.sum_mul'` -/
theorem quad_char.sum_mul {b c : F} (hbc : b ≠ c) (hp : p ≠ 2):
∑ a : F, χ (b - a) * χ (c - a) = -1 :=
begin
  rw ← quad_char.sum_mul' (sub_ne_zero.2 (ne.symm hbc)) hp,
  refine fintype.sum_equiv ((equiv.sub_right b).trans (equiv.neg _)) _ _ (by simp),
end

end quad_char
/- ## end quad_char -/

end finite_field


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.convex.basic
import analysis.normed_space.pointwise
import analysis.seminorm
import data.is_R_or_C.basic
import tactic.congrm

/-!
# The Minkowksi functional

This file defines the Minkowski functional, aka gauge.

The Minkowski functional of a set `s` is the function which associates each point to how much you
need to scale `s` for `x` to be inside it. When `s` is symmetric, convex and absorbent, its gauge is
a seminorm. Reciprocally, any seminorm arises as the gauge of some set, namely its unit ball. This
induces the equivalence of seminorms and locally convex topological vector spaces.

## Main declarations

For a real vector space,
* `gauge`: Aka Minkowksi functional. `gauge s x` is the least (actually, an infimum) `r` such
  that `x ∈ r • s`.
* `gauge_seminorm`: The Minkowski functional as a seminorm, when `s` is symmetric, convex and
  absorbent.

## References

* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]

## Tags

Minkowski functional, gauge
-/

open normed_field set
open_locale pointwise

noncomputable theory

variables {𝕜 E F : Type*}

section add_comm_group
variables [add_comm_group E] [module ℝ E]

/--The Minkowski functional. Given a set `s` in a real vector space, `gauge s` is the functional
which sends `x : E` to the smallest `r : ℝ` such that `x` is in `s` scaled by `r`. -/
def gauge (s : set E) (x : E) : ℝ := Inf {r : ℝ | 0 < r ∧ x ∈ r • s}

variables {s t : set E} {a : ℝ} {x : E}

lemma gauge_def : gauge s x = Inf {r ∈ set.Ioi 0 | x ∈ r • s} := rfl

/-- An alternative definition of the gauge using scalar multiplication on the element rather than on
the set. -/
lemma gauge_def' : gauge s x = Inf {r ∈ set.Ioi 0 | r⁻¹ • x ∈ s} :=
begin
  congrm Inf (λ r, _),
  exact and_congr_right (λ hr, mem_smul_set_iff_inv_smul_mem₀ hr.ne' _ _),
end

private lemma gauge_set_bdd_below : bdd_below {r : ℝ | 0 < r ∧ x ∈ r • s} := ⟨0, λ r hr, hr.1.le⟩

/-- If the given subset is `absorbent` then the set we take an infimum over in `gauge` is nonempty,
which is useful for proving many properties about the gauge.  -/
lemma absorbent.gauge_set_nonempty (absorbs : absorbent ℝ s) :
  {r : ℝ | 0 < r ∧ x ∈ r • s}.nonempty :=
let ⟨r, hr₁, hr₂⟩ := absorbs x in ⟨r, hr₁, hr₂ r (real.norm_of_nonneg hr₁.le).ge⟩

lemma gauge_mono (hs : absorbent ℝ s) (h : s ⊆ t) : gauge t ≤ gauge s :=
λ x, cInf_le_cInf gauge_set_bdd_below hs.gauge_set_nonempty $ λ r hr, ⟨hr.1, smul_set_mono h hr.2⟩

lemma exists_lt_of_gauge_lt (absorbs : absorbent ℝ s) (h : gauge s x < a) :
  ∃ b, 0 < b ∧ b < a ∧ x ∈ b • s :=
begin
  obtain ⟨b, ⟨hb, hx⟩, hba⟩ := exists_lt_of_cInf_lt absorbs.gauge_set_nonempty h,
  exact ⟨b, hb, hba, hx⟩,
end

/-- The gauge evaluated at `0` is always zero (mathematically this requires `0` to be in the set `s`
but, the real infimum of the empty set in Lean being defined as `0`, it holds unconditionally). -/
@[simp] lemma gauge_zero : gauge s 0 = 0 :=
begin
  rw gauge_def',
  by_cases (0 : E) ∈ s,
  { simp only [smul_zero, sep_true, h, cInf_Ioi] },
  { simp only [smul_zero, sep_false, h, real.Inf_empty] }
end

@[simp] lemma gauge_zero' : gauge (0 : set E) = 0 :=
begin
  ext,
  rw gauge_def',
  obtain rfl | hx := eq_or_ne x 0,
  { simp only [cInf_Ioi, mem_zero, pi.zero_apply, eq_self_iff_true, sep_true, smul_zero] },
  { simp only [mem_zero, pi.zero_apply, inv_eq_zero, smul_eq_zero],
    convert real.Inf_empty,
    exact eq_empty_iff_forall_not_mem.2 (λ r hr, hr.2.elim (ne_of_gt hr.1) hx) }
end

@[simp] lemma gauge_empty : gauge (∅ : set E) = 0 :=
by { ext, simp only [gauge_def', real.Inf_empty, mem_empty_iff_false, pi.zero_apply, sep_false] }

lemma gauge_of_subset_zero (h : s ⊆ 0) : gauge s = 0 :=
by { obtain rfl | rfl := subset_singleton_iff_eq.1 h, exacts [gauge_empty, gauge_zero'] }

/-- The gauge is always nonnegative. -/
lemma gauge_nonneg (x : E) : 0 ≤ gauge s x := real.Inf_nonneg _ $ λ x hx, hx.1.le

lemma gauge_neg (symmetric : ∀ x ∈ s, -x ∈ s) (x : E) : gauge s (-x) = gauge s x :=
begin
  have : ∀ x, -x ∈ s ↔ x ∈ s := λ x, ⟨λ h, by simpa using symmetric _ h, symmetric x⟩,
  simp_rw [gauge_def', smul_neg, this]
end

lemma gauge_neg_set_neg (x : E) : gauge (-s) (-x) = gauge s x :=
by simp_rw [gauge_def', smul_neg, neg_mem_neg]

lemma gauge_neg_set_eq_gauge_neg (x : E) : gauge (-s) x = gauge s (-x) :=
by rw [← gauge_neg_set_neg, neg_neg]

lemma gauge_le_of_mem (ha : 0 ≤ a) (hx : x ∈ a • s) : gauge s x ≤ a :=
begin
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [mem_singleton_iff.1 (zero_smul_set_subset _ hx), gauge_zero] },
  { exact cInf_le gauge_set_bdd_below ⟨ha', hx⟩ }
end

lemma gauge_le_eq (hs₁ : convex ℝ s) (hs₀ : (0 : E) ∈ s) (hs₂ : absorbent ℝ s) (ha : 0 ≤ a) :
  {x | gauge s x ≤ a} = ⋂ (r : ℝ) (H : a < r), r • s :=
begin
  ext,
  simp_rw [set.mem_Inter, set.mem_set_of_eq],
  refine ⟨λ h r hr, _, λ h, le_of_forall_pos_lt_add (λ ε hε, _)⟩,
  { have hr' := ha.trans_lt hr,
    rw mem_smul_set_iff_inv_smul_mem₀ hr'.ne',
    obtain ⟨δ, δ_pos, hδr, hδ⟩ := exists_lt_of_gauge_lt hs₂ (h.trans_lt hr),
    suffices : (r⁻¹ * δ) • δ⁻¹ • x ∈ s,
    { rwa [smul_smul, mul_inv_cancel_right₀ δ_pos.ne'] at this },
    rw mem_smul_set_iff_inv_smul_mem₀ δ_pos.ne' at hδ,
    refine hs₁.smul_mem_of_zero_mem hs₀ hδ ⟨by positivity, _⟩,
    rw [inv_mul_le_iff hr', mul_one],
    exact hδr.le },
  { have hε' := (lt_add_iff_pos_right a).2 (half_pos hε),
    exact (gauge_le_of_mem (ha.trans hε'.le) $ h _ hε').trans_lt
      (add_lt_add_left (half_lt_self hε) _) }
end

lemma gauge_lt_eq' (absorbs : absorbent ℝ s) (a : ℝ) :
  {x | gauge s x < a} = ⋃ (r : ℝ) (H : 0 < r) (H : r < a), r • s :=
begin
  ext,
  simp_rw [mem_set_of_eq, mem_Union, exists_prop],
  exact ⟨exists_lt_of_gauge_lt absorbs,
    λ ⟨r, hr₀, hr₁, hx⟩, (gauge_le_of_mem hr₀.le hx).trans_lt hr₁⟩,
end

lemma gauge_lt_eq (absorbs : absorbent ℝ s) (a : ℝ) :
  {x | gauge s x < a} = ⋃ (r ∈ set.Ioo 0 (a : ℝ)), r • s :=
begin
  ext,
  simp_rw [mem_set_of_eq, mem_Union, exists_prop, mem_Ioo, and_assoc],
  exact ⟨exists_lt_of_gauge_lt absorbs,
    λ ⟨r, hr₀, hr₁, hx⟩, (gauge_le_of_mem hr₀.le hx).trans_lt hr₁⟩,
end

lemma gauge_lt_one_subset_self (hs : convex ℝ s) (h₀ : (0 : E) ∈ s) (absorbs : absorbent ℝ s) :
  {x | gauge s x < 1} ⊆ s :=
begin
  rw gauge_lt_eq absorbs,
  refine set.Union₂_subset (λ r hr _, _),
  rintro ⟨y, hy, rfl⟩,
  exact hs.smul_mem_of_zero_mem h₀ hy (Ioo_subset_Icc_self hr),
end

lemma gauge_le_one_of_mem {x : E} (hx : x ∈ s) : gauge s x ≤ 1 :=
gauge_le_of_mem zero_le_one $ by rwa one_smul

lemma self_subset_gauge_le_one : s ⊆ {x | gauge s x ≤ 1} := λ x, gauge_le_one_of_mem

lemma convex.gauge_le (hs : convex ℝ s) (h₀ : (0 : E) ∈ s) (absorbs : absorbent ℝ s) (a : ℝ) :
  convex ℝ {x | gauge s x ≤ a} :=
begin
  by_cases ha : 0 ≤ a,
  { rw gauge_le_eq hs h₀ absorbs ha,
    exact convex_Inter (λ i, convex_Inter (λ hi, hs.smul _)) },
  { convert convex_empty,
    exact eq_empty_iff_forall_not_mem.2 (λ x hx, ha $ (gauge_nonneg _).trans hx) }
end

lemma balanced.star_convex (hs : balanced ℝ s) : star_convex ℝ 0 s :=
star_convex_zero_iff.2 $ λ x hx a ha₀ ha₁,
  hs _ (by rwa real.norm_of_nonneg ha₀) (smul_mem_smul_set hx)

lemma le_gauge_of_not_mem (hs₀ : star_convex ℝ 0 s) (hs₂ : absorbs ℝ s {x}) (hx : x ∉ a • s) :
  a ≤ gauge s x :=
begin
  rw star_convex_zero_iff at hs₀,
  obtain ⟨r, hr, h⟩ := hs₂,
  refine le_cInf ⟨r, hr, singleton_subset_iff.1 $ h _ (real.norm_of_nonneg hr.le).ge⟩ _,
  rintro b ⟨hb, x, hx', rfl⟩,
  refine not_lt.1 (λ hba, hx _),
  have ha := hb.trans hba,
  refine ⟨(a⁻¹ * b) • x, hs₀ hx' (by positivity) _, _⟩,
  { rw ←div_eq_inv_mul,
    exact div_le_one_of_le hba.le ha.le },
  { rw [←mul_smul, mul_inv_cancel_left₀ ha.ne'] }
end

lemma one_le_gauge_of_not_mem (hs₁ : star_convex ℝ 0 s) (hs₂ : absorbs ℝ s {x}) (hx : x ∉ s) :
  1 ≤ gauge s x :=
le_gauge_of_not_mem hs₁ hs₂ $ by rwa one_smul

section linear_ordered_field
variables {α : Type*} [linear_ordered_field α] [mul_action_with_zero α ℝ] [ordered_smul α ℝ]

lemma gauge_smul_of_nonneg [mul_action_with_zero α E] [is_scalar_tower α ℝ (set E)] {s : set E}
  {a : α} (ha : 0 ≤ a) (x : E) :
  gauge s (a • x) = a • gauge s x :=
begin
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul, gauge_zero, zero_smul] },
  rw [gauge_def', gauge_def', ←real.Inf_smul_of_nonneg ha],
  congr' 1,
  ext r,
  simp_rw [set.mem_smul_set, set.mem_sep_iff],
  split,
  { rintro ⟨hr, hx⟩,
    simp_rw mem_Ioi at ⊢ hr,
    rw ←mem_smul_set_iff_inv_smul_mem₀ hr.ne' at hx,
    have := smul_pos (inv_pos.2 ha') hr,
    refine ⟨a⁻¹ • r, ⟨this, _⟩, smul_inv_smul₀ ha'.ne' _⟩,
    rwa [←mem_smul_set_iff_inv_smul_mem₀ this.ne', smul_assoc,
      mem_smul_set_iff_inv_smul_mem₀ (inv_ne_zero ha'.ne'), inv_inv] },
  { rintro ⟨r, ⟨hr, hx⟩, rfl⟩,
    rw mem_Ioi at ⊢ hr,
    rw ←mem_smul_set_iff_inv_smul_mem₀ hr.ne' at hx,
    have := smul_pos ha' hr,
    refine ⟨this, _⟩,
    rw [←mem_smul_set_iff_inv_smul_mem₀ this.ne', smul_assoc],
    exact smul_mem_smul_set hx }
end

lemma gauge_smul_left_of_nonneg [mul_action_with_zero α E] [smul_comm_class α ℝ ℝ]
  [is_scalar_tower α ℝ ℝ] [is_scalar_tower α ℝ E] {s : set E} {a : α} (ha : 0 ≤ a) :
  gauge (a • s) = a⁻¹ • gauge s :=
begin
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [inv_zero, zero_smul, gauge_of_subset_zero (zero_smul_set_subset _)] },
  ext,
  rw [gauge_def', pi.smul_apply, gauge_def', ←real.Inf_smul_of_nonneg (inv_nonneg.2 ha)],
  congr' 1,
  ext r,
  simp_rw [set.mem_smul_set, set.mem_sep_iff],
  split,
  { rintro ⟨hr, y, hy, h⟩,
    simp_rw [mem_Ioi] at ⊢ hr,
    refine ⟨a • r, ⟨smul_pos ha' hr, _⟩, inv_smul_smul₀ ha'.ne' _⟩,
    rwa [smul_inv₀, smul_assoc, ←h, inv_smul_smul₀ ha'.ne'] },
  { rintro ⟨r, ⟨hr, hx⟩, rfl⟩,
    rw mem_Ioi at ⊢ hr,
    have := smul_pos ha' hr,
    refine ⟨smul_pos (inv_pos.2 ha') hr, r⁻¹ • x, hx, _⟩,
    rw [smul_inv₀, smul_assoc, inv_inv] }
end

lemma gauge_smul_left [module α E] [smul_comm_class α ℝ ℝ] [is_scalar_tower α ℝ ℝ]
  [is_scalar_tower α ℝ E] {s : set E} (symmetric : ∀ x ∈ s, -x ∈ s) (a : α) :
  gauge (a • s) = |a|⁻¹ • gauge s :=
begin
  rw ←gauge_smul_left_of_nonneg (abs_nonneg a),
  obtain h | h := abs_choice a,
  { rw h },
  { rw [h, set.neg_smul_set, ←set.smul_set_neg],
    congr,
    ext y,
    refine ⟨symmetric _, λ hy, _⟩,
    rw ←neg_neg y,
    exact symmetric _ hy },
  { apply_instance }
end

end linear_ordered_field

section is_R_or_C
variables [is_R_or_C 𝕜] [module 𝕜 E] [is_scalar_tower ℝ 𝕜 E]

lemma gauge_norm_smul (hs : balanced 𝕜 s) (r : 𝕜) (x : E) : gauge s (‖r‖ • x) = gauge s (r • x) :=
begin
  rw @is_R_or_C.real_smul_eq_coe_smul 𝕜,
  obtain rfl | hr := eq_or_ne r 0,
  { simp only [norm_zero, is_R_or_C.of_real_zero] },
  unfold gauge,
  congr' with θ,
  refine and_congr_right (λ hθ, (hs.smul _).mem_smul_iff _),
  rw [is_R_or_C.norm_of_real, norm_norm],
end

/-- If `s` is balanced, then the Minkowski functional is ℂ-homogeneous. -/
lemma gauge_smul (hs : balanced 𝕜 s) (r : 𝕜) (x : E) : gauge s (r • x) = ‖r‖ * gauge s x :=
by { rw [←smul_eq_mul, ←gauge_smul_of_nonneg (norm_nonneg r), gauge_norm_smul hs], apply_instance }

end is_R_or_C

section topological_space
variables [topological_space E] [has_continuous_smul ℝ E]

lemma interior_subset_gauge_lt_one (s : set E) : interior s ⊆ {x | gauge s x < 1} :=
begin
  intros x hx,
  let f : ℝ → E := λ t, t • x,
  have hf : continuous f,
  { continuity },
  let s' := f ⁻¹' (interior s),
  have hs' : is_open s' := hf.is_open_preimage _ is_open_interior,
  have one_mem : (1 : ℝ) ∈ s',
  { simpa only [s', f, set.mem_preimage, one_smul] },
  obtain ⟨ε, hε₀, hε⟩ := (metric.nhds_basis_closed_ball.1 _).1
    (is_open_iff_mem_nhds.1 hs' 1 one_mem),
  rw real.closed_ball_eq_Icc at hε,
  have hε₁ : 0 < 1 + ε := hε₀.trans (lt_one_add ε),
  have : (1 + ε)⁻¹ < 1,
  { rw inv_lt_one_iff,
    right,
    linarith },
  refine (gauge_le_of_mem (inv_nonneg.2 hε₁.le) _).trans_lt this,
  rw mem_inv_smul_set_iff₀ hε₁.ne',
  exact interior_subset
    (hε ⟨(sub_le_self _ hε₀.le).trans ((le_add_iff_nonneg_right _).2 hε₀.le), le_rfl⟩),
end

lemma gauge_lt_one_eq_self_of_open (hs₁ : convex ℝ s) (hs₀ : (0 : E) ∈ s) (hs₂ : is_open s) :
  {x | gauge s x < 1} = s :=
begin
  refine (gauge_lt_one_subset_self hs₁ ‹_› $ absorbent_nhds_zero $ hs₂.mem_nhds hs₀).antisymm _,
  convert interior_subset_gauge_lt_one s,
  exact hs₂.interior_eq.symm,
end

lemma gauge_lt_one_of_mem_of_open (hs₁ : convex ℝ s) (hs₀ : (0 : E) ∈ s) (hs₂ : is_open s)
  {x : E} (hx : x ∈ s) :
  gauge s x < 1 :=
by rwa ←gauge_lt_one_eq_self_of_open hs₁ hs₀ hs₂ at hx

lemma gauge_lt_of_mem_smul (x : E) (ε : ℝ) (hε : 0 < ε) (hs₀ : (0 : E) ∈ s)
  (hs₁ : convex ℝ s) (hs₂ : is_open s) (hx : x ∈ ε • s) :
  gauge s x < ε :=
begin
  have : ε⁻¹ • x ∈ s,
  { rwa ←mem_smul_set_iff_inv_smul_mem₀ hε.ne' },
  have h_gauge_lt := gauge_lt_one_of_mem_of_open hs₁ hs₀ hs₂ this,
  rwa [gauge_smul_of_nonneg (inv_nonneg.2 hε.le), smul_eq_mul, inv_mul_lt_iff hε, mul_one]
    at h_gauge_lt,
  apply_instance
end

end topological_space

lemma gauge_add_le (hs : convex ℝ s) (absorbs : absorbent ℝ s) (x y : E) :
  gauge s (x + y) ≤ gauge s x + gauge s y :=
begin
  refine le_of_forall_pos_lt_add (λ ε hε, _),
  obtain ⟨a, ha, ha', hx⟩ := exists_lt_of_gauge_lt absorbs
    (lt_add_of_pos_right (gauge s x) (half_pos hε)),
  obtain ⟨b, hb, hb', hy⟩ := exists_lt_of_gauge_lt absorbs
    (lt_add_of_pos_right (gauge s y) (half_pos hε)),
  rw mem_smul_set_iff_inv_smul_mem₀ ha.ne' at hx,
  rw mem_smul_set_iff_inv_smul_mem₀ hb.ne' at hy,
  suffices : gauge s (x + y) ≤ a + b,
  { linarith },
  have hab : 0 < a + b := add_pos ha hb,
  apply gauge_le_of_mem hab.le,
  have := convex_iff_div.1 hs hx hy ha.le hb.le hab,
  rwa [smul_smul, smul_smul, ←mul_div_right_comm, ←mul_div_right_comm, mul_inv_cancel ha.ne',
    mul_inv_cancel hb.ne', ←smul_add, one_div, ←mem_smul_set_iff_inv_smul_mem₀ hab.ne'] at this,
end

section is_R_or_C
variables [is_R_or_C 𝕜] [module 𝕜 E] [is_scalar_tower ℝ 𝕜 E]

/-- `gauge s` as a seminorm when `s` is  balanced, convex and absorbent. -/
@[simps] def gauge_seminorm (hs₀ : balanced 𝕜 s)  (hs₁ : convex ℝ s) (hs₂ : absorbent ℝ s) :
  seminorm 𝕜 E :=
seminorm.of (gauge s) (gauge_add_le hs₁ hs₂) (gauge_smul hs₀)

variables {hs₀ : balanced 𝕜 s} {hs₁ : convex ℝ s} {hs₂ : absorbent ℝ s} [topological_space E]
  [has_continuous_smul ℝ E]

lemma gauge_seminorm_lt_one_of_open (hs : is_open s) {x : E} (hx : x ∈ s) :
  gauge_seminorm hs₀ hs₁ hs₂ x < 1 :=
gauge_lt_one_of_mem_of_open hs₁ hs₂.zero_mem hs hx

lemma gauge_seminorm_ball_one (hs : is_open s) :
  (gauge_seminorm hs₀ hs₁ hs₂).ball 0 1 = s :=
begin
  rw seminorm.ball_zero_eq,
  exact gauge_lt_one_eq_self_of_open hs₁ hs₂.zero_mem hs
end

end is_R_or_C

/-- Any seminorm arises as the gauge of its unit ball. -/
@[simp] protected lemma seminorm.gauge_ball (p : seminorm ℝ E) : gauge (p.ball 0 1) = p :=
begin
  ext,
  obtain hp | hp := {r : ℝ | 0 < r ∧ x ∈ r • p.ball 0 1}.eq_empty_or_nonempty,
  { rw [gauge, hp, real.Inf_empty],
    by_contra,
    have hpx : 0 < p x := (map_nonneg _ _).lt_of_ne h,
    have hpx₂ : 0 < 2 * p x := mul_pos zero_lt_two hpx,
    refine hp.subset ⟨hpx₂, (2 * p x)⁻¹ • x, _, smul_inv_smul₀ hpx₂.ne' _⟩,
    rw [p.mem_ball_zero, map_smul_eq_mul, real.norm_eq_abs, abs_of_pos (inv_pos.2 hpx₂),
      inv_mul_lt_iff hpx₂, mul_one],
    exact lt_mul_of_one_lt_left hpx one_lt_two },
  refine is_glb.cInf_eq ⟨λ r, _, λ r hr, le_of_forall_pos_le_add $ λ ε hε, _⟩ hp,
  { rintro ⟨hr, y, hy, rfl⟩,
    rw p.mem_ball_zero at hy,
    rw [map_smul_eq_mul, real.norm_eq_abs, abs_of_pos hr],
    exact mul_le_of_le_one_right hr.le hy.le },
  { have hpε : 0 < p x + ε := by positivity,
    refine hr ⟨hpε, (p x + ε)⁻¹ • x, _, smul_inv_smul₀ hpε.ne' _⟩,
    rw [p.mem_ball_zero, map_smul_eq_mul, real.norm_eq_abs, abs_of_pos (inv_pos.2 hpε),
      inv_mul_lt_iff hpε, mul_one],
    exact lt_add_of_pos_right _ hε }
end

lemma seminorm.gauge_seminorm_ball (p : seminorm ℝ E) :
  gauge_seminorm (p.balanced_ball_zero 1) (p.convex_ball 0 1)
    (p.absorbent_ball_zero zero_lt_one) = p := fun_like.coe_injective p.gauge_ball

end add_comm_group

section norm
variables [seminormed_add_comm_group E] [normed_space ℝ E] {s : set E} {r : ℝ} {x : E}

lemma gauge_unit_ball (x : E) : gauge (metric.ball (0 : E) 1) x = ‖x‖ :=
begin
  obtain rfl | hx := eq_or_ne x 0,
  { rw [norm_zero, gauge_zero] },
  refine (le_of_forall_pos_le_add $ λ ε hε, _).antisymm _,
  { have : 0 < ‖x‖ + ε := by positivity,
    refine gauge_le_of_mem this.le _,
    rw [smul_ball this.ne', smul_zero, real.norm_of_nonneg this.le, mul_one, mem_ball_zero_iff],
    exact lt_add_of_pos_right _ hε },
  refine le_gauge_of_not_mem balanced_ball_zero.star_convex
    (absorbent_ball_zero zero_lt_one).absorbs (λ h, _),
  obtain hx' | hx' := eq_or_ne (‖x‖) 0,
  { rw hx' at h,
    exact hx (zero_smul_set_subset _ h) },
  { rw [mem_smul_set_iff_inv_smul_mem₀ hx', mem_ball_zero_iff, norm_smul, norm_inv, norm_norm,
      inv_mul_cancel hx'] at h,
    exact lt_irrefl _ h }
end

lemma gauge_ball (hr : 0 < r) (x : E) : gauge (metric.ball (0 : E) r) x = ‖x‖ / r :=
begin
  rw [←smul_unit_ball_of_pos hr, gauge_smul_left, pi.smul_apply, gauge_unit_ball, smul_eq_mul,
    abs_of_nonneg hr.le, div_eq_inv_mul],
  simp_rw [mem_ball_zero_iff, norm_neg],
  exact λ _, id,
end

lemma mul_gauge_le_norm (hs : metric.ball (0 : E) r ⊆ s) : r * gauge s x ≤ ‖x‖ :=
begin
  obtain hr | hr := le_or_lt r 0,
  { exact (mul_nonpos_of_nonpos_of_nonneg hr $ gauge_nonneg _).trans (norm_nonneg _) },
  rw [mul_comm, ←le_div_iff hr, ←gauge_ball hr],
  exact gauge_mono (absorbent_ball_zero hr) hs x,
end

end norm