-- Inverso_del_producto.lean
-- Si G es un grupo y a, b ∈ G entonces (a * b)⁻¹ = b⁻¹ * a⁻¹
-- José A. Alonso Jiménez
-- Sevilla, 19-septiembre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si G un grupo y a, b ∈ G, entonces
--    (a * b)⁻¹ = b⁻¹ * a⁻¹
-- ---------------------------------------------------------------------

import algebra.group
variables {G : Type*} [group G]
variables a b : G

-- 1ª demostración
-- ===============

example : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  apply mul_eq_one_iff_inv_eq.mp,
  calc a * b * (b⁻¹ * a⁻¹)
       = ((a * b) * b⁻¹) * a⁻¹ : (mul_assoc _ _ _).symm
   ... = (a * (b * b⁻¹)) * a⁻¹ : congr_arg (* a⁻¹) (mul_assoc a _ _)
   ... = (a * 1) * a⁻¹         : congr_arg2 _ (congr_arg _ (mul_inv_self b)) rfl
   ... = a * a⁻¹               : congr_arg (* a⁻¹) (mul_one a)
   ... = 1                     : mul_inv_self a
end

-- 2ª demostración
-- ===============

example : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  apply mul_eq_one_iff_inv_eq.mp,
  calc a * b * (b⁻¹ * a⁻¹)
       = ((a * b) * b⁻¹) * a⁻¹ : by simp only [mul_assoc]
   ... = (a * (b * b⁻¹)) * a⁻¹ : by simp only [mul_assoc]
   ... = (a * 1) * a⁻¹         : by simp only [mul_inv_self]
   ... = a * a⁻¹               : by simp only [mul_one]
   ... = 1                     : by simp only [mul_inv_self]
end

-- 3ª demostración
-- ===============

example : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  apply mul_eq_one_iff_inv_eq.mp,
  calc a * b * (b⁻¹ * a⁻¹)
       = ((a * b) * b⁻¹) * a⁻¹ : by simp [mul_assoc]
   ... = (a * (b * b⁻¹)) * a⁻¹ : by simp
   ... = (a * 1) * a⁻¹         : by simp
   ... = a * a⁻¹               : by simp
   ... = 1                     : by simp,
end

-- 4ª demostración
-- ===============

example : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
-- by library_search
mul_inv_rev a b

-- 5ª demostración
-- ===============

example : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
by simp


/-
Copyright (c) 2021 Jon Eugster. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jon Eugster, Eric Wieser
-/
import algebra.char_p.basic
import ring_theory.localization.fraction_ring
import algebra.free_algebra

/-!
# Characteristics of algebras

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

In this file we describe the characteristic of `R`-algebras.

In particular we are interested in the characteristic of free algebras over `R`
and the fraction field `fraction_ring R`.

## Main results

- `char_p_of_injective_algebra_map` If `R →+* A` is an injective algebra map
  then `A` has the same characteristic as `R`.

Instances constructed from this result:
- Any `free_algebra R X` has the same characteristic as `R`.
- The `fraction_ring R` of an integral domain `R` has the same characteristic as `R`.

-/

/-- If the algebra map `R →+* A` is injective then `A` has the same characteristic as `R`. -/
lemma char_p_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  (h : function.injective (algebra_map R A)) (p : ℕ) [char_p R p] : char_p A p :=
{ cast_eq_zero_iff := λx,
  begin
    rw ←char_p.cast_eq_zero_iff R p x,
    change algebra_map ℕ A x = 0 ↔ algebra_map ℕ R x = 0,
    rw is_scalar_tower.algebra_map_apply ℕ R A x,
    refine iff.trans _ h.eq_iff,
    rw ring_hom.map_zero,
  end }

lemma char_p_of_injective_algebra_map' (R A : Type*) [field R] [semiring A] [algebra R A]
  [nontrivial A] (p : ℕ) [char_p R p] : char_p A p :=
char_p_of_injective_algebra_map (algebra_map R A).injective p

/-- If the algebra map `R →+* A` is injective and `R` has characteristic zero then so does `A`. -/
lemma char_zero_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  (h : function.injective (algebra_map R A)) [char_zero R] : char_zero A :=
{ cast_injective := λ x y hxy,
  begin
    change algebra_map ℕ A x = algebra_map ℕ A y at hxy,
    rw is_scalar_tower.algebra_map_apply ℕ R A x at hxy,
    rw is_scalar_tower.algebra_map_apply ℕ R A y at hxy,
    exact char_zero.cast_injective (h hxy),
  end }
-- `char_p.char_p_to_char_zero A _ (char_p_of_injective_algebra_map h 0)` does not work
-- here as it would require `ring A`.

/-!
As an application, a `ℚ`-algebra has characteristic zero.
-/
section Q_algebra

variables (R : Type*) [nontrivial R]

/-- A nontrivial `ℚ`-algebra has `char_p` equal to zero.

This cannot be a (local) instance because it would immediately form a loop with the
instance `algebra_rat`. It's probably easier to go the other way: prove `char_zero R` and
automatically receive an `algebra ℚ R` instance.
-/
lemma algebra_rat.char_p_zero [semiring R] [algebra ℚ R] : char_p R 0 :=
char_p_of_injective_algebra_map (algebra_map ℚ R).injective 0

/-- A nontrivial `ℚ`-algebra has characteristic zero.

This cannot be a (local) instance because it would immediately form a loop with the
instance `algebra_rat`. It's probably easier to go the other way: prove `char_zero R` and
automatically receive an `algebra ℚ R` instance.
-/
lemma algebra_rat.char_zero [ring R] [algebra ℚ R] : char_zero R :=
@char_p.char_p_to_char_zero R _ (algebra_rat.char_p_zero R)

end Q_algebra

/-!
An algebra over a field has the same characteristic as the field.
-/
section

variables (K L : Type*) [field K] [comm_semiring L] [nontrivial L] [algebra K L]

lemma algebra.char_p_iff (p : ℕ) : char_p K p ↔ char_p L p :=
(algebra_map K L).char_p_iff_char_p p

lemma algebra.ring_char_eq : ring_char K = ring_char L :=
by { rw [ring_char.eq_iff, algebra.char_p_iff K L], apply ring_char.char_p }

end

namespace free_algebra

variables {R X : Type*} [comm_semiring R] (p : ℕ)

/-- If `R` has characteristic `p`, then so does `free_algebra R X`. -/
instance char_p [char_p R p] : char_p (free_algebra R X) p :=
char_p_of_injective_algebra_map free_algebra.algebra_map_left_inverse.injective p

/-- If `R` has characteristic `0`, then so does `free_algebra R X`. -/
instance char_zero [char_zero R] : char_zero (free_algebra R X) :=
char_zero_of_injective_algebra_map free_algebra.algebra_map_left_inverse.injective

end free_algebra

namespace is_fraction_ring

variables (R : Type*) {K : Type*} [comm_ring R]
  [field K] [algebra R K] [is_fraction_ring R K]
variables (p : ℕ)

/-- If `R` has characteristic `p`, then so does Frac(R). -/

/-- If `R` has characteristic `0`, then so does Frac(R). -/
lemma char_zero_of_is_fraction_ring [char_zero R] : char_zero K :=
@char_p.char_p_to_char_zero K _ (char_p_of_is_fraction_ring R 0)

variables [is_domain R]

/-- If `R` has characteristic `p`, then so does `fraction_ring R`. -/
instance char_p [char_p R p] : char_p (fraction_ring R) p :=
char_p_of_is_fraction_ring R p

/-- If `R` has characteristic `0`, then so does `fraction_ring R`. -/
instance char_zero [char_zero R] : char_zero (fraction_ring R) :=
char_zero_of_is_fraction_ring R

end is_fraction_ring


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

! This file was ported from Lean 3 source module data.countable.defs
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finite.Defs
import Mathlib.Tactic.MkIffOfInductiveProp

/-!
# Countable types

In this file we define a typeclass saying that a given `Sort _` is countable. See also `Encodable`
for a version that singles out a specific encoding of elements of `α` by natural numbers.

This file also provides a few instances of this typeclass. More instances can be found in other
files.
-/

open Function

universe u v

variable {α : Sort u} {β : Sort v}

/-!
### Definition and basic properties
-/

/-- A type `α` is countable if there exists an injective map `α → ℕ`. -/
@[mk_iff countable_iff_exists_injective]
class Countable (α : Sort u) : Prop where
  /-- A type `α` is countable if there exists an injective map `α → ℕ`. -/
  exists_injective_nat' : ∃ f : α → ℕ, Injective f
#align countable Countable
#align countable_iff_exists_injective countable_iff_exists_injective

lemma Countable.exists_injective_nat (α : Sort u) [Countable α] :
  ∃ f : α → ℕ, Injective f :=
Countable.exists_injective_nat'

instance : Countable ℕ :=
  ⟨⟨id, injective_id⟩⟩

export Countable (exists_injective_nat)

protected theorem Function.Injective.countable [Countable β] {f : α → β} (hf : Injective f) :
  Countable α :=
  let ⟨g, hg⟩ := exists_injective_nat β
  ⟨⟨g ∘ f, hg.comp hf⟩⟩
#align function.injective.countable Function.Injective.countable

protected theorem Function.Surjective.countable [Countable α] {f : α → β} (hf : Surjective f) :
  Countable β :=
  (injective_surjInv hf).countable
#align function.surjective.countable Function.Surjective.countable

theorem exists_surjective_nat (α : Sort u) [Nonempty α] [Countable α] : ∃ f : ℕ → α, Surjective f :=
  let ⟨f, hf⟩ := exists_injective_nat α
  ⟨invFun f, invFun_surjective hf⟩
#align exists_surjective_nat exists_surjective_nat

theorem countable_iff_exists_surjective [Nonempty α] : Countable α ↔ ∃ f : ℕ → α, Surjective f :=
  ⟨@exists_surjective_nat _ _, fun ⟨_, hf⟩ ↦ hf.countable⟩
#align countable_iff_exists_surjective countable_iff_exists_surjective

theorem Countable.of_equiv (α : Sort _) [Countable α] (e : α ≃ β) : Countable β :=
  e.symm.injective.countable
#align countable.of_equiv Countable.of_equiv

theorem Equiv.countable_iff (e : α ≃ β) : Countable α ↔ Countable β :=
  ⟨fun h => @Countable.of_equiv _ _ h e, fun h => @Countable.of_equiv _ _ h e.symm⟩
#align equiv.countable_iff Equiv.countable_iff

instance {β : Type v} [Countable β] : Countable (ULift.{u} β) :=
  Countable.of_equiv _ Equiv.ulift.symm

/-!
### Operations on `Sort _`s
-/

instance [Countable α] : Countable (PLift α) :=
  Equiv.plift.injective.countable

instance (priority := 100) Subsingleton.to_countable [Subsingleton α] : Countable α :=
  ⟨⟨fun _ => 0, fun x y _ => Subsingleton.elim x y⟩⟩

instance (priority := 500) Subtype.countable [Countable α] {p : α → Prop} :
    Countable { x // p x } :=
  Subtype.val_injective.countable

instance {n : ℕ} : Countable (Fin n) :=
  Function.Injective.countable (@Fin.eq_of_veq n)

instance (priority := 100) Finite.to_countable [Finite α] : Countable α :=
  let ⟨_, ⟨e⟩⟩ := Finite.exists_equiv_fin α
  Countable.of_equiv _ e.symm

instance : Countable PUnit.{u} :=
  Subsingleton.to_countable

instance (priority := 100) Prop.countable (p : Prop) : Countable p :=
  Subsingleton.to_countable

instance Bool.countable : Countable Bool :=
  ⟨⟨fun b => cond b 0 1, Bool.injective_iff.2 Nat.one_ne_zero⟩⟩

instance Prop.countable' : Countable Prop :=
  Countable.of_equiv Bool Equiv.propEquivBool.symm

instance (priority := 500) Quotient.countable [Countable α] {r : α → α → Prop} :
    Countable (Quot r) :=
  (surjective_quot_mk r).countable

instance (priority := 500) [Countable α] {s : Setoid α} : Countable (Quotient s) :=
  (inferInstance : Countable (@Quot α _))


/-
Copyright (c) 2021 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez
-/
import data.fintype.card_embedding

/-!
# Birthday Problem

This file proves Theorem 93 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/).

As opposed to the standard probabilistic statement, we instead state the birthday problem
in terms of injective functions. The general result about `fintype.card (α ↪ β)` which this proof
uses is `fintype.card_embedding_eq`.
-/

local notation `‖` x `‖` := fintype.card x

/-- **Birthday Problem** -/
theorem birthday :
  2 * ‖fin 23 ↪ fin 365‖ < ‖fin 23 → fin 365‖ ∧ 2 * ‖fin 22 ↪ fin 365‖ > ‖fin 22 → fin 365‖ :=
begin
  simp only [nat.desc_factorial, fintype.card_fin, fintype.card_embedding_eq, fintype.card_fun],
  norm_num
end


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import geometry.euclidean.angle.oriented.right_angle
import geometry.euclidean.circumcenter

/-!
# Angles in circles and sphere.

This file proves results about angles in circles and spheres.

-/

noncomputable theory

open finite_dimensional complex
open_locale euclidean_geometry real real_inner_product_space complex_conjugate

namespace orientation

variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V]
variables [fact (finrank ℝ V = 2)] (o : orientation ℝ V (fin 2))

/-- Angle at center of a circle equals twice angle at circumference, oriented vector angle
form. -/
lemma oangle_eq_two_zsmul_oangle_sub_of_norm_eq {x y z : V} (hxyne : x ≠ y) (hxzne : x ≠ z)
  (hxy : ‖x‖ = ‖y‖) (hxz : ‖x‖ = ‖z‖) : o.oangle y z = (2 : ℤ) • o.oangle (y - x) (z - x) :=
begin
  have hy : y ≠ 0,
  { rintro rfl,
    rw [norm_zero, norm_eq_zero] at hxy,
    exact hxyne hxy },
  have hx : x ≠ 0 := norm_ne_zero_iff.1 (hxy.symm ▸ norm_ne_zero_iff.2 hy),
  have hz : z ≠ 0 := norm_ne_zero_iff.1 (hxz ▸ norm_ne_zero_iff.2 hx),
  calc o.oangle y z = o.oangle x z - o.oangle x y : (o.oangle_sub_left hx hy hz).symm
       ...           = (π - (2 : ℤ) • o.oangle (x - z) x) -
                       (π - (2 : ℤ) • o.oangle (x - y) x) :
         by rw [o.oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq hxzne.symm hxz.symm,
                o.oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq hxyne.symm hxy.symm]
       ...           = (2 : ℤ) • (o.oangle (x - y) x - o.oangle (x - z) x) : by abel
       ...           = (2 : ℤ) • o.oangle (x - y) (x - z) :
         by rw o.oangle_sub_right (sub_ne_zero_of_ne hxyne) (sub_ne_zero_of_ne hxzne) hx
       ...           = (2 : ℤ) • o.oangle (y - x) (z - x) :
         by rw [←oangle_neg_neg, neg_sub, neg_sub]
end

/-- Angle at center of a circle equals twice angle at circumference, oriented vector angle
form with radius specified. -/
lemma oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real {x y z : V} (hxyne : x ≠ y) (hxzne : x ≠ z)
  {r : ℝ} (hx : ‖x‖ = r) (hy : ‖y‖ = r) (hz : ‖z‖ = r) :
  o.oangle y z = (2 : ℤ) • o.oangle (y - x) (z - x) :=
o.oangle_eq_two_zsmul_oangle_sub_of_norm_eq hxyne hxzne (hy.symm ▸ hx) (hz.symm ▸ hx)

/-- Oriented vector angle version of "angles in same segment are equal" and "opposite angles of
a cyclic quadrilateral add to π", for oriented angles mod π (for which those are the same
result), represented here as equality of twice the angles. -/
lemma two_zsmul_oangle_sub_eq_two_zsmul_oangle_sub_of_norm_eq {x₁ x₂ y z : V} (hx₁yne : x₁ ≠ y)
  (hx₁zne : x₁ ≠ z) (hx₂yne : x₂ ≠ y) (hx₂zne : x₂ ≠ z) {r : ℝ} (hx₁ : ‖x₁‖ = r) (hx₂ : ‖x₂‖ = r)
  (hy : ‖y‖ = r) (hz : ‖z‖ = r) :
  (2 : ℤ) • o.oangle (y - x₁) (z - x₁) = (2 : ℤ) • o.oangle (y - x₂) (z - x₂) :=
o.oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real hx₁yne hx₁zne hx₁ hy hz ▸
  o.oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real hx₂yne hx₂zne hx₂ hy hz

end orientation

namespace euclidean_geometry

variables {V : Type*} {P : Type*}
  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
  [hd2 : fact (finrank ℝ V = 2)] [module.oriented ℝ V (fin 2)]
include hd2

local notation `o` := module.oriented.positive_orientation

namespace sphere

/-- Angle at center of a circle equals twice angle at circumference, oriented angle version. -/
lemma oangle_center_eq_two_zsmul_oangle {s : sphere P} {p₁ p₂ p₃ : P} (hp₁ : p₁ ∈ s)
  (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₂p₁ : p₂ ≠ p₁) (hp₂p₃ : p₂ ≠ p₃) :
  ∡ p₁ s.center p₃ = (2 : ℤ) • ∡ p₁ p₂ p₃ :=
begin
  rw [mem_sphere, @dist_eq_norm_vsub V] at hp₁ hp₂ hp₃,
  rw [oangle, oangle, (o).oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real _ _ hp₂ hp₁ hp₃];
    simp [hp₂p₁, hp₂p₃]
end

/-- Oriented angle version of "angles in same segment are equal" and "opposite angles of a
cyclic quadrilateral add to π", for oriented angles mod π (for which those are the same result),
represented here as equality of twice the angles. -/
lemma two_zsmul_oangle_eq {s : sphere P} {p₁ p₂ p₃ p₄ : P} (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s)
  (hp₃ : p₃ ∈ s) (hp₄ : p₄ ∈ s) (hp₂p₁ : p₂ ≠ p₁) (hp₂p₄ : p₂ ≠ p₄) (hp₃p₁ : p₃ ≠ p₁)
  (hp₃p₄ : p₃ ≠ p₄) : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄ :=
begin
  rw [mem_sphere, @dist_eq_norm_vsub V] at hp₁ hp₂ hp₃ hp₄,
  rw [oangle, oangle, ←vsub_sub_vsub_cancel_right p₁ p₂ s.center,
      ←vsub_sub_vsub_cancel_right p₄ p₂ s.center,
      (o).two_zsmul_oangle_sub_eq_two_zsmul_oangle_sub_of_norm_eq _ _ _ _ hp₂ hp₃ hp₁ hp₄];
    simp [hp₂p₁, hp₂p₄, hp₃p₁, hp₃p₄]
end

end sphere

/-- Oriented angle version of "angles in same segment are equal" and "opposite angles of a
cyclic quadrilateral add to π", for oriented angles mod π (for which those are the same result),
represented here as equality of twice the angles. -/
lemma cospherical.two_zsmul_oangle_eq {p₁ p₂ p₃ p₄ : P}
  (h : cospherical ({p₁, p₂, p₃, p₄} : set P)) (hp₂p₁ : p₂ ≠ p₁) (hp₂p₄ : p₂ ≠ p₄)
  (hp₃p₁ : p₃ ≠ p₁) (hp₃p₄ : p₃ ≠ p₄) : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄ :=
begin
  obtain ⟨s, hs⟩ := cospherical_iff_exists_sphere.1 h,
  simp_rw [set.insert_subset, set.singleton_subset_iff, sphere.mem_coe] at hs,
  exact sphere.two_zsmul_oangle_eq hs.1 hs.2.1 hs.2.2.1 hs.2.2.2 hp₂p₁ hp₂p₄ hp₃p₁ hp₃p₄
end

namespace sphere

/-- The angle at the apex of an isosceles triangle is `π` minus twice a base angle, oriented
angle-at-point form where the apex is given as the center of a circle. -/
lemma oangle_eq_pi_sub_two_zsmul_oangle_center_left {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
  (hp₂ : p₂ ∈ s) (h : p₁ ≠ p₂) : ∡ p₁ s.center p₂ = π - (2 : ℤ) • ∡ s.center p₂ p₁ :=
by rw [oangle_eq_pi_sub_two_zsmul_oangle_of_dist_eq h.symm
  (dist_center_eq_dist_center_of_mem_sphere' hp₂ hp₁)]

/-- The angle at the apex of an isosceles triangle is `π` minus twice a base angle, oriented
angle-at-point form where the apex is given as the center of a circle. -/
lemma oangle_eq_pi_sub_two_zsmul_oangle_center_right {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
  (hp₂ : p₂ ∈ s) (h : p₁ ≠ p₂) : ∡ p₁ s.center p₂ = π - (2 : ℤ) • ∡ p₂ p₁ s.center :=
by rw [oangle_eq_pi_sub_two_zsmul_oangle_center_left hp₁ hp₂ h,
       oangle_eq_oangle_of_dist_eq (dist_center_eq_dist_center_of_mem_sphere' hp₂ hp₁)]

/-- Twice a base angle of an isosceles triangle with apex at the center of a circle, plus twice
the angle at the apex of a triangle with the same base but apex on the circle, equals `π`. -/
lemma two_zsmul_oangle_center_add_two_zsmul_oangle_eq_pi {s : sphere P} {p₁ p₂ p₃ : P}
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₂p₁ : p₂ ≠ p₁) (hp₂p₃ : p₂ ≠ p₃)
  (hp₁p₃ : p₁ ≠ p₃) : (2 : ℤ) • ∡ p₃ p₁ s.center + (2 : ℤ) • ∡ p₁ p₂ p₃ = π :=
by rw [←oangle_center_eq_two_zsmul_oangle hp₁ hp₂ hp₃ hp₂p₁ hp₂p₃,
       oangle_eq_pi_sub_two_zsmul_oangle_center_right hp₁ hp₃ hp₁p₃, add_sub_cancel'_right]

/-- A base angle of an isosceles triangle with apex at the center of a circle is acute. -/
lemma abs_oangle_center_left_to_real_lt_pi_div_two {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
  (hp₂ : p₂ ∈ s) : |(∡ s.center p₂ p₁).to_real| < π / 2 :=
abs_oangle_right_to_real_lt_pi_div_two_of_dist_eq
  (dist_center_eq_dist_center_of_mem_sphere' hp₂ hp₁)

/-- A base angle of an isosceles triangle with apex at the center of a circle is acute. -/
lemma abs_oangle_center_right_to_real_lt_pi_div_two {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
  (hp₂ : p₂ ∈ s) : |(∡ p₂ p₁ s.center).to_real| < π / 2 :=
abs_oangle_left_to_real_lt_pi_div_two_of_dist_eq
  (dist_center_eq_dist_center_of_mem_sphere' hp₂ hp₁)

/-- Given two points on a circle, the center of that circle may be expressed explicitly as a
multiple (by half the tangent of the angle between the chord and the radius at one of those
points) of a `π / 2` rotation of the vector between those points, plus the midpoint of those
points. -/
lemma tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_center {s : sphere P} {p₁ p₂ : P}
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (h : p₁ ≠ p₂) :
  (real.angle.tan (∡ p₂ p₁ s.center) / 2) • ((o).rotation (π / 2 : ℝ) (p₂ -ᵥ p₁)) +ᵥ
    midpoint ℝ p₁ p₂ = s.center :=
begin
  obtain ⟨r, hr⟩ := (dist_eq_iff_eq_smul_rotation_pi_div_two_vadd_midpoint h).1
    (dist_center_eq_dist_center_of_mem_sphere hp₁ hp₂),
  rw [←hr, ←oangle_midpoint_rev_left, oangle, vadd_vsub_assoc],
  nth_rewrite 0 (show p₂ -ᵥ p₁ = (2 : ℝ) • (midpoint ℝ p₁ p₂ -ᵥ p₁), by simp),
  rw [map_smul, smul_smul, add_comm, (o).tan_oangle_add_right_smul_rotation_pi_div_two,
      mul_div_cancel _ (two_ne_zero' ℝ)],
  simpa using h.symm
end

/-- Given three points on a circle, the center of that circle may be expressed explicitly as a
multiple (by half the inverse of the tangent of the angle at one of those points) of a `π / 2`
rotation of the vector between the other two points, plus the midpoint of those points. -/
lemma inv_tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_center {s : sphere P}
  {p₁ p₂ p₃ : P} (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₁p₂ : p₁ ≠ p₂) (hp₁p₃ : p₁ ≠ p₃)
  (hp₂p₃ : p₂ ≠ p₃) :
  ((real.angle.tan (∡ p₁ p₂ p₃))⁻¹ / 2) • ((o).rotation (π / 2 : ℝ) (p₃ -ᵥ p₁)) +ᵥ
    midpoint ℝ p₁ p₃ = s.center :=
begin
  convert tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_center hp₁ hp₃ hp₁p₃,
  convert (real.angle.tan_eq_inv_of_two_zsmul_add_two_zsmul_eq_pi _).symm,
  rw [add_comm,
      two_zsmul_oangle_center_add_two_zsmul_oangle_eq_pi hp₁ hp₂ hp₃ hp₁p₂.symm hp₂p₃ hp₁p₃]
end

/-- Given two points on a circle, the radius of that circle may be expressed explicitly as half
the distance between those two points divided by the cosine of the angle between the chord and
the radius at one of those points. -/
lemma dist_div_cos_oangle_center_div_two_eq_radius {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
  (hp₂ : p₂ ∈ s) (h : p₁ ≠ p₂) : dist p₁ p₂ / real.angle.cos (∡ p₂ p₁ s.center) / 2 = s.radius :=
begin
  rw [div_right_comm, div_eq_mul_inv _ (2 : ℝ), mul_comm,
      (show (2 : ℝ)⁻¹ * dist p₁ p₂ = dist p₁ (midpoint ℝ p₁ p₂), by simp), ←mem_sphere.1 hp₁,
      ←tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_center hp₁ hp₂ h,
      ←oangle_midpoint_rev_left, oangle, vadd_vsub_assoc,
      (show p₂ -ᵥ p₁ = (2 : ℝ) • (midpoint ℝ p₁ p₂ -ᵥ p₁), by simp), map_smul, smul_smul,
      div_mul_cancel _ (two_ne_zero' ℝ), @dist_eq_norm_vsub' V, @dist_eq_norm_vsub' V,
      vadd_vsub_assoc, add_comm, (o).oangle_add_right_smul_rotation_pi_div_two,
      real.angle.cos_coe, real.cos_arctan, one_div, div_inv_eq_mul,
      ←mul_self_inj (mul_nonneg (norm_nonneg _) (real.sqrt_nonneg _)) (norm_nonneg _),
      norm_add_sq_eq_norm_sq_add_norm_sq_real ((o).inner_smul_rotation_pi_div_two_right _ _),
      ←mul_assoc, mul_comm, mul_comm _ (real.sqrt _), ←mul_assoc, ←mul_assoc,
      real.mul_self_sqrt (add_nonneg zero_le_one (sq_nonneg _)), norm_smul,
      linear_isometry_equiv.norm_map],
  swap, { simpa using h.symm },
  conv_rhs { rw [←mul_assoc, mul_comm _ ‖real.angle.tan _‖, ←mul_assoc, real.norm_eq_abs,
                 abs_mul_abs_self] },
  ring
end

/-- Given two points on a circle, twice the radius of that circle may be expressed explicitly as
the distance between those two points divided by the cosine of the angle between the chord and
the radius at one of those points. -/
lemma dist_div_cos_oangle_center_eq_two_mul_radius {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
  (hp₂ : p₂ ∈ s) (h : p₁ ≠ p₂) : dist p₁ p₂ / real.angle.cos (∡ p₂ p₁ s.center) = 2 * s.radius :=
by rw [←dist_div_cos_oangle_center_div_two_eq_radius hp₁ hp₂ h,
       mul_div_cancel' _ (two_ne_zero' ℝ)]

/-- Given three points on a circle, the radius of that circle may be expressed explicitly as half
the distance between two of those points divided by the absolute value of the sine of the angle
at the third point (a version of the law of sines or sine rule). -/
lemma dist_div_sin_oangle_div_two_eq_radius {s : sphere P} {p₁ p₂ p₃ : P} (hp₁ : p₁ ∈ s)
  (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₁p₂ : p₁ ≠ p₂) (hp₁p₃ : p₁ ≠ p₃) (hp₂p₃ : p₂ ≠ p₃) :
  dist p₁ p₃ / |real.angle.sin (∡ p₁ p₂ p₃)| / 2 = s.radius :=
begin
  convert dist_div_cos_oangle_center_div_two_eq_radius hp₁ hp₃ hp₁p₃,
  rw [←real.angle.abs_cos_eq_abs_sin_of_two_zsmul_add_two_zsmul_eq_pi
        (two_zsmul_oangle_center_add_two_zsmul_oangle_eq_pi
          hp₁ hp₂ hp₃ hp₁p₂.symm hp₂p₃ hp₁p₃),
      _root_.abs_of_nonneg (real.angle.cos_nonneg_iff_abs_to_real_le_pi_div_two.2 _)],
  exact (abs_oangle_center_right_to_real_lt_pi_div_two hp₁ hp₃).le
end

/-- Given three points on a circle, twice the radius of that circle may be expressed explicitly as
the distance between two of those points divided by the absolute value of the sine of the angle
at the third point (a version of the law of sines or sine rule). -/
lemma dist_div_sin_oangle_eq_two_mul_radius {s : sphere P} {p₁ p₂ p₃ : P} (hp₁ : p₁ ∈ s)
  (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₁p₂ : p₁ ≠ p₂) (hp₁p₃ : p₁ ≠ p₃) (hp₂p₃ : p₂ ≠ p₃) :
  dist p₁ p₃ / |real.angle.sin (∡ p₁ p₂ p₃)| = 2 * s.radius :=
by rw [←dist_div_sin_oangle_div_two_eq_radius hp₁ hp₂ hp₃ hp₁p₂ hp₁p₃ hp₂p₃,
       mul_div_cancel' _ (two_ne_zero' ℝ)]

end sphere

end euclidean_geometry

namespace affine
namespace triangle

open euclidean_geometry

variables {V : Type*} {P : Type*}
  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
  [hd2 : fact (finrank ℝ V = 2)] [module.oriented ℝ V (fin 2)]
include hd2

local notation `o` := module.oriented.positive_orientation

/-- The circumcenter of a triangle may be expressed explicitly as a multiple (by half the inverse
of the tangent of the angle at one of the vertices) of a `π / 2` rotation of the vector between
the other two vertices, plus the midpoint of those vertices. -/
lemma inv_tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_circumcenter (t : triangle ℝ P)
  {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
  ((real.angle.tan (∡ (t.points i₁) (t.points i₂) (t.points i₃)))⁻¹ / 2) •
    ((o).rotation (π / 2 : ℝ) (t.points i₃ -ᵥ t.points i₁)) +ᵥ
    midpoint ℝ (t.points i₁) (t.points i₃) = t.circumcenter :=
sphere.inv_tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_center
  (t.mem_circumsphere _) (t.mem_circumsphere _) (t.mem_circumsphere _)
  (t.independent.injective.ne h₁₂) (t.independent.injective.ne h₁₃) (t.independent.injective.ne h₂₃)

/-- The circumradius of a triangle may be expressed explicitly as half the length of a side
divided by the absolute value of the sine of the angle at the third point (a version of the law
of sines or sine rule). -/
lemma dist_div_sin_oangle_div_two_eq_circumradius (t : triangle ℝ P) {i₁ i₂ i₃ : fin 3}
  (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
  dist (t.points i₁) (t.points i₃) /
    |real.angle.sin (∡ (t.points i₁) (t.points i₂) (t.points i₃))| / 2 = t.circumradius :=
sphere.dist_div_sin_oangle_div_two_eq_radius (t.mem_circumsphere _) (t.mem_circumsphere _)
  (t.mem_circumsphere _) (t.independent.injective.ne h₁₂) (t.independent.injective.ne h₁₃)
  (t.independent.injective.ne h₂₃)

/-- Twice the circumradius of a triangle may be expressed explicitly as the length of a side
divided by the absolute value of the sine of the angle at the third point (a version of the law
of sines or sine rule). -/
lemma dist_div_sin_oangle_eq_two_mul_circumradius (t : triangle ℝ P) {i₁ i₂ i₃ : fin 3}
  (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
  dist (t.points i₁) (t.points i₃) /
    |real.angle.sin (∡ (t.points i₁) (t.points i₂) (t.points i₃))| = 2 * t.circumradius :=
sphere.dist_div_sin_oangle_eq_two_mul_radius (t.mem_circumsphere _) (t.mem_circumsphere _)
  (t.mem_circumsphere _) (t.independent.injective.ne h₁₂) (t.independent.injective.ne h₁₃)
  (t.independent.injective.ne h₂₃)

/-- The circumsphere of a triangle may be expressed explicitly in terms of two points and the
angle at the third point. -/
lemma circumsphere_eq_of_dist_of_oangle (t : triangle ℝ P) {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂)
  (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
  t.circumsphere = ⟨((real.angle.tan (∡ (t.points i₁) (t.points i₂) (t.points i₃)))⁻¹ / 2) •
      ((o).rotation (π / 2 : ℝ) (t.points i₃ -ᵥ t.points i₁)) +ᵥ
      midpoint ℝ (t.points i₁) (t.points i₃),
    dist (t.points i₁) (t.points i₃) /
      |real.angle.sin (∡ (t.points i₁) (t.points i₂) (t.points i₃))| / 2⟩ :=
t.circumsphere.ext _
  (t.inv_tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_circumcenter h₁₂ h₁₃ h₂₃).symm
  (t.dist_div_sin_oangle_div_two_eq_circumradius h₁₂ h₁₃ h₂₃).symm

/-- If two triangles have two points the same, and twice the angle at the third point the same,
they have the same circumsphere. -/
lemma circumsphere_eq_circumsphere_of_eq_of_eq_of_two_zsmul_oangle_eq {t₁ t₂ : triangle ℝ P}
  {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃)
  (h₁ : t₁.points i₁ = t₂.points i₁) (h₃ : t₁.points i₃ = t₂.points i₃)
  (h₂ : (2 : ℤ) • ∡ (t₁.points i₁) (t₁.points i₂) (t₁.points i₃) =
    (2 : ℤ) • ∡ (t₂.points i₁) (t₂.points i₂) (t₂.points i₃)) :
  t₁.circumsphere = t₂.circumsphere :=
begin
  rw [t₁.circumsphere_eq_of_dist_of_oangle h₁₂ h₁₃ h₂₃,
      t₂.circumsphere_eq_of_dist_of_oangle h₁₂ h₁₃ h₂₃],
  congrm ⟨((_ : ℝ)⁻¹ / 2) • _ +ᵥ _, _ / _ / 2⟩,
  { exact real.angle.tan_eq_of_two_zsmul_eq h₂ },
  { rw [h₁, h₃] },
  { rw [h₁, h₃] },
  { rw [h₁, h₃] },
  { exact real.angle.abs_sin_eq_of_two_zsmul_eq h₂ }
end

/-- Given a triangle, and a fourth point such that twice the angle between two points of the
triangle at that fourth point equals twice the third angle of the triangle, the fourth point
lies in the circumsphere of the triangle. -/
lemma mem_circumsphere_of_two_zsmul_oangle_eq {t : triangle ℝ P} {p : P} {i₁ i₂ i₃ : fin 3}
  (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃)
  (h : (2 : ℤ) • ∡ (t.points i₁) p (t.points i₃) =
    (2 : ℤ) • ∡ (t.points i₁) (t.points i₂) (t.points i₃)) : p ∈ t.circumsphere :=
begin
  let t'p : fin 3 → P := function.update t.points i₂ p,
  have h₁ : t'p i₁ = t.points i₁, { simp [t'p, h₁₂] },
  have h₂ : t'p i₂ = p, { simp [t'p] },
  have h₃ : t'p i₃ = t.points i₃, { simp [t'p, h₂₃.symm] },
  have ha : affine_independent ℝ t'p,
  { rw [affine_independent_iff_not_collinear_of_ne h₁₂ h₁₃ h₂₃, h₁, h₂, h₃,
        collinear_iff_of_two_zsmul_oangle_eq h,
        ←affine_independent_iff_not_collinear_of_ne h₁₂ h₁₃ h₂₃],
    exact t.independent },
  let t' : triangle ℝ P := ⟨t'p, ha⟩,
  have h₁' : t'.points i₁ = t.points i₁ := h₁,
  have h₂' : t'.points i₂ = p := h₂,
  have h₃' : t'.points i₃ = t.points i₃ := h₃,
  have h' : (2 : ℤ) • ∡ (t'.points i₁) (t'.points i₂) (t'.points i₃) =
    (2 : ℤ) • ∡ (t.points i₁) (t.points i₂) (t.points i₃), { rwa [h₁', h₂', h₃'] },
  rw [←circumsphere_eq_circumsphere_of_eq_of_eq_of_two_zsmul_oangle_eq h₁₂ h₁₃ h₂₃ h₁' h₃' h',
      ←h₂'],
  exact simplex.mem_circumsphere _ _
end

end triangle
end affine

namespace euclidean_geometry

variables {V : Type*} {P : Type*}
  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
  [hd2 : fact (finrank ℝ V = 2)] [module.oriented ℝ V (fin 2)]
include hd2

local notation `o` := module.oriented.positive_orientation

/-- Converse of "angles in same segment are equal" and "opposite angles of a cyclic quadrilateral
add to π", for oriented angles mod π. -/
lemma cospherical_of_two_zsmul_oangle_eq_of_not_collinear {p₁ p₂ p₃ p₄ : P}
  (h : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄) (hn : ¬collinear ℝ ({p₁, p₂, p₄} : set P)) :
  cospherical ({p₁, p₂, p₃, p₄} : set P) :=
begin
  have hn' : ¬collinear ℝ ({p₁, p₃, p₄} : set P), { rwa ←collinear_iff_of_two_zsmul_oangle_eq h },
  let t₁ : affine.triangle ℝ P := ⟨![p₁, p₂, p₄], affine_independent_iff_not_collinear_set.2 hn⟩,
  let t₂ : affine.triangle ℝ P := ⟨![p₁, p₃, p₄], affine_independent_iff_not_collinear_set.2 hn'⟩,
  rw cospherical_iff_exists_sphere,
  refine ⟨t₂.circumsphere, _⟩,
  simp_rw [set.insert_subset, set.singleton_subset_iff],
  refine ⟨t₂.mem_circumsphere 0, _, t₂.mem_circumsphere 1, t₂.mem_circumsphere 2⟩,
  rw affine.triangle.circumsphere_eq_circumsphere_of_eq_of_eq_of_two_zsmul_oangle_eq
    (dec_trivial : (0 : fin 3) ≠ 1) (dec_trivial: (0 : fin 3) ≠ 2) dec_trivial
    (show t₂.points 0 = t₁.points 0, from rfl) rfl h.symm,
  exact t₁.mem_circumsphere 1
end

/-- Converse of "angles in same segment are equal" and "opposite angles of a cyclic quadrilateral
add to π", for oriented angles mod π, with a "concyclic" conclusion. -/
lemma concyclic_of_two_zsmul_oangle_eq_of_not_collinear {p₁ p₂ p₃ p₄ : P}
  (h : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄) (hn : ¬collinear ℝ ({p₁, p₂, p₄} : set P)) :
  concyclic ({p₁, p₂, p₃, p₄} : set P) :=
⟨cospherical_of_two_zsmul_oangle_eq_of_not_collinear h hn, coplanar_of_fact_finrank_eq_two _⟩

/-- Converse of "angles in same segment are equal" and "opposite angles of a cyclic quadrilateral
add to π", for oriented angles mod π, with a "cospherical or collinear" conclusion. -/
lemma cospherical_or_collinear_of_two_zsmul_oangle_eq {p₁ p₂ p₃ p₄ : P}
  (h : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄) :
  cospherical ({p₁, p₂, p₃, p₄} : set P) ∨ collinear ℝ ({p₁, p₂, p₃, p₄} : set P) :=
begin
  by_cases hc : collinear ℝ ({p₁, p₂, p₄} : set P),
  { by_cases he : p₁ = p₄,
    { rw [he, set.insert_eq_self.2 (set.mem_insert_of_mem _ (set.mem_insert_of_mem _
            (set.mem_singleton _)))],
      by_cases hl : collinear ℝ ({p₂, p₃, p₄} : set P), { exact or.inr hl },
      rw or_iff_left hl,
      let t : affine.triangle ℝ P := ⟨![p₂, p₃, p₄], affine_independent_iff_not_collinear_set.2 hl⟩,
      rw cospherical_iff_exists_sphere,
      refine ⟨t.circumsphere, _⟩,
      simp_rw [set.insert_subset, set.singleton_subset_iff],
      exact ⟨t.mem_circumsphere 0, t.mem_circumsphere 1, t.mem_circumsphere 2⟩ },
    have hc' : collinear ℝ ({p₁, p₃, p₄} : set P),
    { rwa [←collinear_iff_of_two_zsmul_oangle_eq h] },
    refine or.inr _,
    rw set.insert_comm p₁ p₂ at hc,
    rwa [set.insert_comm p₁ p₂, hc'.collinear_insert_iff_of_ne (set.mem_insert _ _)
           (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_singleton _))) he] },
  { exact or.inl (cospherical_of_two_zsmul_oangle_eq_of_not_collinear h hc) }
end

/-- Converse of "angles in same segment are equal" and "opposite angles of a cyclic quadrilateral
add to π", for oriented angles mod π, with a "concyclic or collinear" conclusion. -/
lemma concyclic_or_collinear_of_two_zsmul_oangle_eq {p₁ p₂ p₃ p₄ : P}
  (h : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄) :
  concyclic ({p₁, p₂, p₃, p₄} : set P) ∨ collinear ℝ ({p₁, p₂, p₃, p₄} : set P) :=
begin
  rcases cospherical_or_collinear_of_two_zsmul_oangle_eq h with hc | hc,
  { exact or.inl ⟨hc, coplanar_of_fact_finrank_eq_two _⟩ },
  { exact or.inr hc }
end

end euclidean_geometry


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import analysis.normed_space.lp_space
import analysis.normed_space.pi_Lp
import topology.continuous_function.bounded

/-!
# Equivalences among $L^p$ spaces

In this file we collect a variety of equivalences among various $L^p$ spaces.  In particular,
when `α` is a `fintype`, given `E : α → Type u` and `p : ℝ≥0∞`, there is a natural linear isometric
equivalence `lp_pi_Lpₗᵢ : lp E p ≃ₗᵢ pi_Lp p E`. In addition, when `α` is a discrete topological
space, the bounded continuous functions `α →ᵇ β` correspond exactly to `lp (λ _, β) ∞`. Here there
can be more structure, including ring and algebra structures, and we implement these equivalences
accordingly as well.

We keep this as a separate file so that the various $L^p$ space files don't import the others.

Recall that `pi_Lp` is just a type synonym for `Π i, E i` but given a different metric and norm
structure, although the topological, uniform and bornological structures coincide definitionally.
These structures are only defined on `pi_Lp` for `fintype α`, so there are no issues of convergence
to consider.

While `pre_lp` is also a type synonym for `Π i, E i`, it allows for infinite index types. On this
type there is a predicate `mem_ℓp` which says that the relevant `p`-norm is finite and `lp E p` is
the subtype of `pre_lp` satisfying `mem_ℓp`.

## TODO

* Equivalence between `lp` and `measure_theory.Lp`, for `f : α → E` (i.e., functions rather than
  pi-types) and the counting measure on `α`

-/

open_locale ennreal

section lp_pi_Lp

variables {α : Type*} {E : α → Type*} [Π i, normed_add_comm_group (E i)] {p : ℝ≥0∞}

/-- When `α` is `finite`, every `f : pre_lp E p` satisfies `mem_ℓp f p`. -/
lemma mem_ℓp.all [finite α] (f : Π i, E i) : mem_ℓp f p :=
begin
  rcases p.trichotomy with (rfl | rfl | h),
  { exact mem_ℓp_zero_iff.mpr {i : α | f i ≠ 0}.to_finite, },
  { exact mem_ℓp_infty_iff.mpr (set.finite.bdd_above (set.range (λ (i : α), ‖f i‖)).to_finite) },
  { casesI nonempty_fintype α, exact mem_ℓp_gen ⟨finset.univ.sum _, has_sum_fintype _⟩ }
end

variables [fintype α]

/-- The canonical `equiv` between `lp E p ≃ pi_Lp p E` when `E : α → Type u` with `[fintype α]`. -/
def equiv.lp_pi_Lp : lp E p ≃ pi_Lp p E :=
{ to_fun := λ f, f,
  inv_fun := λ f, ⟨f, mem_ℓp.all f⟩,
  left_inv := λ f, lp.ext $ funext $ λ x, rfl,
  right_inv := λ f, funext $ λ x, rfl }

lemma coe_equiv_lp_pi_Lp (f : lp E p) : equiv.lp_pi_Lp f = f := rfl
lemma coe_equiv_lp_pi_Lp_symm (f : pi_Lp p E) : (equiv.lp_pi_Lp.symm f : Π i, E i) = f :=  rfl

lemma equiv_lp_pi_Lp_norm (f : lp E p) : ‖equiv.lp_pi_Lp f‖ = ‖f‖ :=
begin
  unfreezingI { rcases p.trichotomy with (rfl | rfl | h) },
  { rw [pi_Lp.norm_eq_card, lp.norm_eq_card_dsupport], refl },
  { rw [pi_Lp.norm_eq_csupr, lp.norm_eq_csupr], refl },
  { rw [pi_Lp.norm_eq_sum h, lp.norm_eq_tsum_rpow h, tsum_fintype], refl },
end

/-- The canonical `add_equiv` between `lp E p` and `pi_Lp p E` when `E : α → Type u` with
`[fintype α]` and `[fact (1 ≤ p)]`. -/
def add_equiv.lp_pi_Lp [fact (1 ≤ p)] : lp E p ≃+ pi_Lp p E :=
{ map_add' := λ f g, rfl,
  .. equiv.lp_pi_Lp }

lemma coe_add_equiv_lp_pi_Lp [fact (1 ≤ p)] (f : lp E p) :
  add_equiv.lp_pi_Lp f = f := rfl
lemma coe_add_equiv_lp_pi_Lp_symm [fact (1 ≤ p)] (f : pi_Lp p E) :
  (add_equiv.lp_pi_Lp.symm f : Π i, E i) = f :=  rfl

section equivₗᵢ
variables (𝕜 : Type*) [nontrivially_normed_field 𝕜] [Π i, normed_space 𝕜 (E i)]

/-- The canonical `linear_isometry_equiv` between `lp E p` and `pi_Lp p E` when `E : α → Type u`
with `[fintype α]` and `[fact (1 ≤ p)]`. -/
noncomputable def lp_pi_Lpₗᵢ [fact (1 ≤ p)] : lp E p ≃ₗᵢ[𝕜] pi_Lp p E :=
{ map_smul' := λ k f, rfl,
  norm_map' := equiv_lp_pi_Lp_norm,
  .. add_equiv.lp_pi_Lp }

variables {𝕜}

lemma coe_lp_pi_Lpₗᵢ [fact (1 ≤ p)] (f : lp E p) :
  lp_pi_Lpₗᵢ 𝕜 f = f := rfl
lemma coe_lp_pi_Lpₗᵢ_symm [fact (1 ≤ p)] (f : pi_Lp p E) :
  ((lp_pi_Lpₗᵢ 𝕜).symm f : Π i, E i) = f :=  rfl

end equivₗᵢ

end lp_pi_Lp

section lp_bcf

open_locale bounded_continuous_function
open bounded_continuous_function

-- note: `R` and `A` are explicit because otherwise Lean has elaboration problems
variables {α E : Type*} (R A 𝕜 : Type*) [topological_space α] [discrete_topology α]
variables [normed_ring A] [norm_one_class A] [nontrivially_normed_field 𝕜] [normed_algebra 𝕜 A]
variables [normed_add_comm_group E] [normed_space 𝕜 E] [non_unital_normed_ring R]

section normed_add_comm_group

/-- The canonical map between `lp (λ (_ : α), E) ∞` and `α →ᵇ E` as an `add_equiv`. -/
noncomputable def add_equiv.lp_bcf :
  lp (λ (_ : α), E) ∞ ≃+ (α →ᵇ E) :=
{ to_fun := λ f, of_normed_add_comm_group_discrete f (‖f‖) $ le_csupr (mem_ℓp_infty_iff.mp f.prop),
  inv_fun := λ f, ⟨f, f.bdd_above_range_norm_comp⟩,
  left_inv := λ f, lp.ext rfl,
  right_inv := λ f, ext $ λ x, rfl,
  map_add' := λ f g, ext $ λ x, rfl }

lemma coe_add_equiv_lp_bcf (f : lp (λ (_ : α), E) ∞) :
  (add_equiv.lp_bcf f : α → E) = f := rfl
lemma coe_add_equiv_lp_bcf_symm (f : α →ᵇ E) : (add_equiv.lp_bcf.symm f : α → E) = f := rfl

/-- The canonical map between `lp (λ (_ : α), E) ∞` and `α →ᵇ E` as a `linear_isometry_equiv`. -/
noncomputable def lp_bcfₗᵢ : lp (λ (_ : α), E) ∞ ≃ₗᵢ[𝕜] (α →ᵇ E) :=
{ map_smul' := λ k f, rfl,
  norm_map' := λ f, by { simp only [norm_eq_supr_norm, lp.norm_eq_csupr], refl },
  .. add_equiv.lp_bcf }

variables {𝕜}

lemma coe_lp_bcfₗᵢ (f : lp (λ (_ : α), E) ∞) : (lp_bcfₗᵢ 𝕜 f : α → E) = f := rfl
lemma coe_lp_bcfₗᵢ_symm (f : α →ᵇ E) : ((lp_bcfₗᵢ 𝕜).symm f : α → E) = f :=  rfl

end normed_add_comm_group

section ring_algebra

/-- The canonical map between `lp (λ (_ : α), R) ∞` and `α →ᵇ R` as a `ring_equiv`. -/
noncomputable def ring_equiv.lp_bcf : lp (λ (_ : α), R) ∞ ≃+* (α →ᵇ R) :=
{ map_mul' := λ f g, ext $ λ x, rfl, .. @add_equiv.lp_bcf _ R _ _ _ }

variables {R}
lemma coe_ring_equiv_lp_bcf (f : lp (λ (_ : α), R) ∞) :
  (ring_equiv.lp_bcf R f : α → R) = f := rfl
lemma coe_ring_equiv_lp_bcf_symm (f : α →ᵇ R) :
  ((ring_equiv.lp_bcf R).symm f : α → R) = f := rfl

variables (α) -- even `α` needs to be explicit here for elaboration

-- the `norm_one_class A` shouldn't really be necessary, but currently it is for
-- `one_mem_ℓp_infty` to get the `ring` instance on `lp`.
/-- The canonical map between `lp (λ (_ : α), A) ∞` and `α →ᵇ A` as an `alg_equiv`. -/
noncomputable def alg_equiv.lp_bcf : lp (λ (_ : α), A) ∞ ≃ₐ[𝕜] (α →ᵇ A) :=
{ commutes' := λ k, rfl, .. ring_equiv.lp_bcf A }

variables {α A 𝕜}
lemma coe_alg_equiv_lp_bcf (f : lp (λ (_ : α), A) ∞) :
  (alg_equiv.lp_bcf α A 𝕜 f : α → A) = f := rfl
lemma coe_alg_equiv_lp_bcf_symm (f : α →ᵇ A) :
  ((alg_equiv.lp_bcf α A 𝕜).symm f : α → A) = f := rfl

end ring_algebra

end lp_bcf


import MyNat.Definition
import MyNat.Addition -- add_succ
import MyNat.Multiplication -- mul_succ
import AdvancedAdditionWorld.Level9 -- succ_ne_zero
import Mathlib.Tactic.LeftRight
namespace MyNat
open MyNat

/-!
# Advanced Multiplication World

## Level 2: `eq_zero_or_eq_zero_of_mul_eq_zero`

A variant on the previous level.

## Theorem
If `ab = 0`, then at least one of `a` or `b` is equal to zero.
-/
theorem eq_zero_or_eq_zero_of_mul_eq_zero (a b : MyNat) (h : a * b = 0) :
  a = 0 ∨ b = 0 := by
  cases a with
  | zero =>
    left
    rfl
  | succ a' =>
    cases b with
    | zero =>
      right
      rfl
    | succ b' =>
      exfalso
      rw [mul_succ] at h
      rw [add_succ] at h
      exact succ_ne_zero _ h
/-!

Next up [Level 3](./Level3.lean.md)
-/


import xenalib.nat_stuff
import chris_hughes_various.zmod

/- Here is my memory of the situation Clara and Jason were faced with -/
--set_option pp.all true
--set_option pp.notation false
example (a : ℕ) (p : ℕ) [pos_nat p] (Hodd : 2 ∣ (p - 1)) (x : ℤ)
  (H1 : ↑(a ^ (p - 1)) - 1 ≡ 0 [ZMOD ↑p])
  (H2 : x ≡ (↑a)^2 [ZMOD ↑p]) :
x ^ ((p-1) / 2) ≡ 1 [ZMOD ↑p] :=
-- A mathematician would just say "substitute x = a^2 and we're done"
-- Lean says "naturals aren't integers, and congruence is not equality, so no"
-- I say "that's OK, we just explain to Lean exactly why things which are
-- "obviously equal" are equal"
begin
  rw nat.cast_pow' a 2 at H2,
  rw ←zmod.eq_iff_modeq_int at H2,
  -- H2 now an equality in the ring Z/pZ
  rw ←zmod.eq_iff_modeq_int,
  rw ←int.cast_pow,
  -- we can finally rewrite!
  rw H2,
  -- we now have to convince Lean that this is just H1
  rw int.cast_pow,
  rw nat.cast_pow',
  rw nat.pow_pow,
  rw nat.mul_div (show 2 ≠ 0, from dec_trivial) Hodd,
  apply eq_of_sub_eq_zero,
  rw ←int.cast_sub,
  rw ←zmod.eq_iff_modeq_int at H1,
  exact H1
end


/-
Copyright (c) 2021 Adrián Doña Mateo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adrián Doña Mateo
-/

import data.real.basic
import data.real.sqrt

/-!
# IMO 2017 Q2

Let `ℝ` be the set of real numbers. Determine all functions `f : ℝ → ℝ` such that, for
all real numbers `x` and `y`,

  `f (f x * f y) + f (x + y) = f (x * y)`.

This solution is a translation of the official solution, which may be found as the
solution to problem A6 [here](https://www.imo-official.org/problems/IMO2017SL.pdf).
-/

open real

/-- A predicate defining what it means for a function to be a solution. -/
def sol (f : ℝ → ℝ) : Prop := ∀ x y, f (f x * f y) + f (x + y) = f (x * y)

/-- The negation of a function. -/
def neg (f : ℝ → ℝ) : ℝ → ℝ := λ x, - f x

lemma neg_neg_f (f : ℝ → ℝ) : neg (neg f) = f := by simp [neg]

/-- The negation of a solution is also a solution. -/
theorem sol_of_neg_sol {f : ℝ → ℝ} (h : sol f) : sol (neg f) :=
λ x y,
calc - f ((- f x) * (- f y)) + (- f (x + y))
    = - (f (f x * f y) + f (x + y)) : by rw [neg_mul_neg, neg_add]
... = - f (x * y)                   : by rw h

lemma sol_mul_eq_zero {f : ℝ → ℝ} (hf : sol f) (x : ℝ) (hx : x ≠ 1) :
  f (f x * f (x / (x - 1))) = 0 :=
have hxy : x + x / (x - 1) = x * (x / (x - 1)) :=
  calc x + x / (x - 1)
      = (x * (x - 1) + x) / (x - 1) : by { rw add_div', intro h,
                                        rw sub_eq_zero.mp h at hx, contradiction }
  ... = (x * x) / (x - 1)           : by ring
  ... = x * (x / (x - 1))           : by rw mul_div_assoc,
by rw [← add_sub_cancel (f _) (f (x + x / (x - 1))), hf, hxy, sub_self]

/-- A solution has a root at `(f 0)²`. -/
theorem sol_has_zero {f : ℝ → ℝ} (hf : sol f) : f (f 0 ^ 2) = 0 :=
by { convert sol_mul_eq_zero hf 0 (by norm_num), simp [pow_two] }

theorem zero_of_zero_at_zero {f : ℝ → ℝ} (hf : sol f) (h0 : f 0 = 0) : f = λ _, 0 :=
funext $ λ x,
  calc f x
      = f (f x * f 0) + f (x + 0) : by simp [h0]
  ... = f 0                       : by rw [hf, mul_zero]
  ... = 0                         : h0

/-
From here on, we work on the consequences of assuming that `f 0 < 0`.
This is enough, because if `f` is a solution and `f 0 > 0`, then `g = neg f` is a solution with `g 0 < 0`.
-/

/-- If a solution `f` is negative at `0`, it has a unique root at `1` and `f 0 = -1`. -/
theorem of_neg_at_zero {f : ℝ → ℝ} (hf : sol f) (h0 : f 0 < 0) :
  f 1 = 0 ∧ (∀ a, f a = 0 → a = 1) ∧ f 0 = -1 :=
begin
  have ha : ∀ a, f a = 0 → a = 1,
  { intros a ha, by_contradiction,
    apply ne_of_lt h0,
    convert sol_mul_eq_zero hf a h,
    rw [ha, zero_mul] },
  have hf02 : f 0 ^ 2 = 1 := ha _ (sol_has_zero hf),
  use [by rw [← hf02, sol_has_zero hf], ha],
  rw [pow_two, mul_self_eq_one_iff] at hf02,
  cases hf02 with h1 hn1,
  { linarith },
  { assumption },
end

/-- If a solution `f` is negative at `0`, for each integer `n` it satisfies the equation
  `f (x + n) = f x + n`. -/
theorem sol_at_add_n {f : ℝ → ℝ} (hf : sol f) (h0 : f 0 < 0) : ∀ x (n : ℤ), f (x + n) = f x + n :=
begin
  rcases of_neg_at_zero hf h0 with ⟨hf1, _, hf0⟩,
  have hadd1 : ∀ x, f (x + 1) = f x + 1 :=
    λ x,
    calc f (x + 1)
        = f (f x * f 1) + f (x + 1) + 1 : by simp [hf0, hf1]
    ... = f x + 1                       : by rw [hf, mul_one],
  have haddn : ∀ x (n : ℕ), f (x + n) = f x + n,
  { intros x n, induction n with n ih, { simp },
    simp, rw [← add_assoc, hadd1, ih, add_assoc] },
  intros x n,
  cases n with n n,
  {	exact haddn x n },
  dsimp,
  rw [← sub_eq_add_neg, ← sub_eq_add_neg, eq_sub_iff_add_eq],
  convert (haddn _ (n + 1)).symm, simp,
end

/-- This lemma is equivalent to saying that a polynomial `x² + ax + b` has roots `x` and `y`
  whenever `0 ≤ a² - 4b`. -/
lemma root_of_nonneg_disc {a b : ℝ} (h : 0 ≤ a * a - 4 * b) :
  ∃ x y, x + y = a ∧ x * y = b :=
begin
  let d := a * a - 4 * b,
  use [(a + sqrt d) / 2, (a - sqrt d) / 2],
  split, { ring },
  rw div_mul_div,
  calc (a + sqrt d) * (a - sqrt d) / (2 * 2)
      = (a * a - (sqrt d) * (sqrt d)) / 4 : by ring
  ... = (a * a - (a * a - 4 * b)) / 4     : by rw [mul_self_sqrt h]
  ... = b                                 : by ring,
end

/-- If a solution `f` is negative at `0`, it must be injective. -/
theorem f_injective {f : ℝ → ℝ} (hf : sol f) (h0 : f 0 < 0) : function.injective f :=
begin
  intros a b hfab, by_contradiction,
  have haddN : ∀ N : ℤ, f (a + N + 1) = f (b + N) + 1 := λ N,
    calc f (a + N + 1)
        = f (a + N + ↑(1 : ℤ)) : by rw int.cast_one
    ...	= f (a + ↑(N + 1))     : by rw [add_assoc, int.cast_add]
    ... = f a + ↑(N + 1)       : by rw sol_at_add_n hf h0
    ... = f b + ↑(N + 1)       : by rw hfab
    ... = f b + N + 1          : by { rw [int.cast_add, ← add_assoc], norm_cast }
    ... = f (b + N) + 1        : by rw ← sol_at_add_n hf h0,
  let N := ⌈-b - 1⌉,
  have hN : ↑N < -b := by { simp [N], convert ceil_lt_add_one (-b - 1), ring },
  have habN : 0 ≤ (a + N + 1) * (a + N + 1) - 4 * (b + N),
  {	rw sub_eq_add_neg, apply add_nonneg,
    {	exact mul_self_nonneg _ }, linarith },
  rcases root_of_nonneg_disc habN with ⟨x, y, hxy1, hxy2⟩,
  have hfxy : f x * f y = 0,
  { rw [← add_sub_cancel (f x * f y) 1, sub_eq_zero],
    apply (of_neg_at_zero hf h0).2.1,
    have : _ :=
    calc f (f x * f y + ↑(1 : ℤ))
        = f (f x * f y) + 1                           : by { rw sol_at_add_n hf h0 _ 1, simp }
    ... = (f (f x * f y) + f (x + y) - f (x + y)) + 1 : by rw add_sub_cancel
    ... = (f (x * y) - f (x + y)) + 1                 : by rw hf
    ... = f (x * y) + 1 - f (x + y)                   : by ring
    ... = f (b + N) + 1 - f (a + N + 1)               : by rw [hxy1, hxy2]
    ... = f (a + N + 1) - f (a + N + 1)               : by rw haddN N
    ... = 0                                           : by rw sub_self,
    convert this, norm_cast },
  have hx1 : x ≠ 1,
  {	intro hx, rw [hx, one_mul] at hxy2, rw [hx, hxy2] at hxy1,
    have : a = b := by linarith, exact h this },
  have hy1 : y ≠ 1,
  { intro hy, rw [hy, mul_one] at hxy2, rw [hy, hxy2] at hxy1,
    have : a = b := by linarith, exact h this },
  cases mul_eq_zero.mp hfxy with hx0 hy0,
  {	exact hx1 ((of_neg_at_zero hf h0).2.1 _ hx0) },
  {	exact hy1 ((of_neg_at_zero hf h0).2.1 _ hy0) },
end

lemma mul_sol_at_neg {f : ℝ → ℝ} (hf : sol f) (h0 : f 0 < 0) :
  ∀ t, f t * f (-t) = -t * t + 1 :=
λ t, f_injective hf h0 $
    calc f (f t * f (-t))
        = f (f t * f (-t)) + f 0 + 1        : by simp [(of_neg_at_zero hf h0).2.2]
    ... = f (f t * f (-t)) + f (t + -t) + 1 : by rw add_neg_self
    ... = f (t * -t) + 1                    : by rw hf
    ... = f (-t * t) + (1 : ℤ)              : by rw [mul_comm, int.cast_one]
    ... = f (-t * t + 1)                    : by rw [← sol_at_add_n hf h0 _ 1, int.cast_one]

lemma mul_sol_at_one_sub {f : ℝ → ℝ} (hf : sol f) (h0 : f 0 < 0) :
  ∀ t, f t * f (1 - t) = t * (1 - t) :=
λ t, f_injective hf h0 $
  calc f (f t * f (1 - t))
      = f (f t * f (1 - t)) + 0               : by rw add_zero
  ... = f (f t * f (1 - t)) + f 1             : by rw (of_neg_at_zero hf h0).1
  ... = f (f t * f (1 - t)) + f (t + (1 - t)) : by rw add_sub_cancel'_right
  ... = f (t * (1 - t))                       : by rw hf

theorem sol_of_neg_at_zero {f : ℝ → ℝ} (hf : sol f) (h0 : f 0 < 0) :
  f = λ t, t - 1 :=
funext $ λ t,
  calc f t
      = f t + (-t * t + 1) - (-t * t + 1)        : by rw add_sub_cancel
  ... = f t + f t * f (-t) - (-t * t + 1)        : by rw mul_sol_at_neg hf h0
  ... = f t * (1 + f (-t)) - (-t * t + 1)        : by ring
  ... = f t * (f (-t) + ↑(1 : ℤ)) - (-t * t + 1) : by simp [add_comm]
  ... = f t * f (-t + ↑(1 : ℤ)) - (-t * t + 1)   : by rw ← sol_at_add_n hf h0 _ 1
  ... = f t * f (1 - t) - (-t * t + 1)           : by simp [add_comm, ← sub_eq_add_neg]
  ... = t * (1 - t) - (-t * t + 1)               : by rw mul_sol_at_one_sub hf h0
  ... = t - 1                                    : by ring

/-- We have now found all solutions:
  1. λ x, 0,      2. λ x, x - 1,     and      3. λ x, 1 - x. -/
theorem imo2017_q2 (f : ℝ → ℝ) : sol f ↔ f = (λ _, 0) ∨ f = (λ x, x - 1) ∨ f = (λ x, 1 - x) :=
begin
  split, swap,
  {	intro h, rcases h with rfl | rfl | rfl;
    {	intros x y, simp, try { ring } } },
  rcases lt_trichotomy (f 0) 0 with hneg | h0 | hpos,
  {	intro hf, right, left, exact sol_of_neg_at_zero hf hneg },
  {	intro hf, left, exact zero_of_zero_at_zero hf h0 },
  { intro hf, right, right,
    have hnegf : sol (neg f) := sol_of_neg_sol hf,
    have hnegf0 : neg f 0 < 0 := by simpa [neg],
    have : neg f = λ x, x - 1 := sol_of_neg_at_zero hnegf hnegf0,
    rw [← neg_neg_f f, this], simp [neg] },
end


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

/-!
# Fundamental domain of a group action

A set `s` is said to be a *fundamental domain* of an action of a group `G` on a measurable space `α`
with respect to a measure `μ` if

* `s` is a measurable set;

* the sets `g • s` over all `g : G` cover almost all points of the whole space;

* the sets `g • s`, are pairwise a.e. disjoint, i.e., `μ (g₁ • s ∩ g₂ • s) = 0` whenever `g₁ ≠ g₂`;
  we require this for `g₂ = 1` in the definition, then deduce it for any two `g₁ ≠ g₂`.

In this file we prove that in case of a countable group `G` and a measure preserving action, any two
fundamental domains have the same measure, and for a `G`-invariant function, its integrals over any
two fundamental domains are equal to each other.

We also generate additive versions of all theorems in this file using the `to_additive` attribute.

## Main declarations

* `measure_theory.is_fundamental_domain`: Predicate for a set to be a fundamental domain of the
  action of a group
* `measure_theory.fundamental_frontier`: Fundamental frontier of a set under the action of a group.
  Elements of `s` that belong to some other translate of `s`.
* `measure_theory.fundamental_interior`: Fundamental interior of a set under the action of a group.
  Elements of `s` that do not belong to any other translate of `s`.
-/

open_locale ennreal pointwise topology nnreal ennreal measure_theory
open measure_theory measure_theory.measure set function topological_space filter

namespace measure_theory

/-- A measurable set `s` is a *fundamental domain* for an additive action of an additive group `G`
on a measurable space `α` with respect to a measure `α` if the sets `g +ᵥ s`, `g : G`, are pairwise
a.e. disjoint and cover the whole space. -/
@[protect_proj] structure is_add_fundamental_domain (G : Type*) {α : Type*} [has_zero G]
  [has_vadd G α] [measurable_space α] (s : set α) (μ : measure α . volume_tac) : Prop :=
(null_measurable_set : null_measurable_set s μ)
(ae_covers : ∀ᵐ x ∂μ, ∃ g : G, g +ᵥ x ∈ s)
(ae_disjoint : pairwise $ ae_disjoint μ on λ g : G, g +ᵥ s)

/-- A measurable set `s` is a *fundamental domain* for an action of a group `G` on a measurable
space `α` with respect to a measure `α` if the sets `g • s`, `g : G`, are pairwise a.e. disjoint and
cover the whole space. -/
@[protect_proj, to_additive is_add_fundamental_domain]
structure is_fundamental_domain (G : Type*) {α : Type*} [has_one G] [has_smul G α]
  [measurable_space α] (s : set α) (μ : measure α . volume_tac) : Prop :=
(null_measurable_set : null_measurable_set s μ)
(ae_covers : ∀ᵐ x ∂μ, ∃ g : G, g • x ∈ s)
(ae_disjoint : pairwise $ ae_disjoint μ on λ g : G, g • s)

variables {G H α β E : Type*}

namespace is_fundamental_domain
variables [group G] [group H] [mul_action G α] [measurable_space α] [mul_action H β]
  [measurable_space β] [normed_add_comm_group E] {s t : set α} {μ : measure α}

/-- If for each `x : α`, exactly one of `g • x`, `g : G`, belongs to a measurable set `s`, then `s`
is a fundamental domain for the action of `G` on `α`. -/
@[to_additive "If for each `x : α`, exactly one of `g +ᵥ x`, `g : G`, belongs to a measurable set
`s`, then `s` is a fundamental domain for the additive action of `G` on `α`."]
lemma mk' (h_meas : null_measurable_set s μ) (h_exists : ∀ x : α, ∃! g : G, g • x ∈ s) :
  is_fundamental_domain G s μ :=
{ null_measurable_set := h_meas,
  ae_covers := eventually_of_forall $ λ x, (h_exists x).exists,
  ae_disjoint := λ a b hab, disjoint.ae_disjoint $ disjoint_left.2 $ λ x hxa hxb,
    begin
      rw mem_smul_set_iff_inv_smul_mem at hxa hxb,
      exact hab (inv_injective $ (h_exists x).unique hxa hxb),
    end }

/-- For `s` to be a fundamental domain, it's enough to check `ae_disjoint (g • s) s` for `g ≠ 1`. -/
@[to_additive "For `s` to be a fundamental domain, it's enough to check `ae_disjoint (g +ᵥ s) s` for
`g ≠ 0`."]
lemma mk'' (h_meas : null_measurable_set s μ) (h_ae_covers : ∀ᵐ x ∂μ, ∃ g : G, g • x ∈ s)
  (h_ae_disjoint : ∀ g ≠ (1 : G), ae_disjoint μ (g • s) s)
  (h_qmp : ∀ (g : G), quasi_measure_preserving ((•) g : α → α) μ μ) :
  is_fundamental_domain G s μ :=
{ null_measurable_set := h_meas,
  ae_covers := h_ae_covers,
  ae_disjoint := pairwise_ae_disjoint_of_ae_disjoint_forall_ne_one h_ae_disjoint h_qmp }

/-- If a measurable space has a finite measure `μ` and a countable group `G` acts
quasi-measure-preservingly, then to show that a set `s` is a fundamental domain, it is sufficient
to check that its translates `g • s` are (almost) disjoint and that the sum `∑' g, μ (g • s)` is
sufficiently large. -/
@[to_additive measure_theory.is_add_fundamental_domain.mk_of_measure_univ_le "
If a measurable space has a finite measure `μ` and a countable additive group `G` acts
quasi-measure-preservingly, then to show that a set `s` is a fundamental domain, it is sufficient
to check that its translates `g +ᵥ s` are (almost) disjoint and that the sum `∑' g, μ (g +ᵥ s)` is
sufficiently large."]
lemma mk_of_measure_univ_le [is_finite_measure μ] [countable G]
  (h_meas : null_measurable_set s μ)
  (h_ae_disjoint : ∀ g ≠ (1 : G), ae_disjoint μ (g • s) s)
  (h_qmp : ∀ (g : G), quasi_measure_preserving ((•) g : α → α) μ μ)
  (h_measure_univ_le : μ (univ : set α) ≤ ∑' (g : G), μ (g • s)) :
  is_fundamental_domain G s μ :=
have ae_disjoint : pairwise (ae_disjoint μ on (λ (g : G), g • s)) :=
  pairwise_ae_disjoint_of_ae_disjoint_forall_ne_one h_ae_disjoint h_qmp,
{ null_measurable_set := h_meas,
  ae_disjoint := ae_disjoint,
  ae_covers :=
  begin
    replace h_meas : ∀ (g : G), null_measurable_set (g • s) μ :=
      λ g, by { rw [← inv_inv g, ← preimage_smul], exact h_meas.preimage (h_qmp g⁻¹), },
    have h_meas' : null_measurable_set {a | ∃ (g : G), g • a ∈ s} μ,
    { rw ← Union_smul_eq_set_of_exists, exact null_measurable_set.Union h_meas, },
    rw [ae_iff_measure_eq h_meas', ← Union_smul_eq_set_of_exists],
    refine le_antisymm (measure_mono $ subset_univ _) _,
    rw measure_Union₀ ae_disjoint h_meas,
    exact h_measure_univ_le,
  end }

@[to_additive] lemma Union_smul_ae_eq (h : is_fundamental_domain G s μ) :
  (⋃ g : G, g • s) =ᵐ[μ] univ :=
eventually_eq_univ.2 $ h.ae_covers.mono $ λ x ⟨g, hg⟩, mem_Union.2 ⟨g⁻¹, _, hg, inv_smul_smul _ _⟩

@[to_additive] lemma mono (h : is_fundamental_domain G s μ) {ν : measure α} (hle : ν ≪ μ) :
  is_fundamental_domain G s ν :=
⟨h.1.mono_ac hle, hle h.2, h.ae_disjoint.mono $ λ a b hab, hle hab⟩

@[to_additive] lemma preimage_of_equiv {ν : measure β} (h : is_fundamental_domain G s μ) {f : β → α}
  (hf : quasi_measure_preserving f ν μ) {e : G → H} (he : bijective e)
  (hef : ∀ g, semiconj f ((•) (e g)) ((•) g)) :
  is_fundamental_domain H (f ⁻¹' s) ν :=
{ null_measurable_set := h.null_measurable_set.preimage hf,
  ae_covers := (hf.ae h.ae_covers).mono $ λ x ⟨g, hg⟩, ⟨e g, by rwa [mem_preimage, hef g x]⟩,
  ae_disjoint := λ a b hab,
    begin
      lift e to G ≃ H using he,
      have : (e.symm a⁻¹)⁻¹ ≠ (e.symm b⁻¹)⁻¹, by simp [hab],
      convert (h.ae_disjoint this).preimage hf using 1,
      simp only [←preimage_smul_inv, preimage_preimage, ←hef _ _, e.apply_symm_apply, inv_inv],
    end }

@[to_additive] lemma image_of_equiv {ν : measure β} (h : is_fundamental_domain G s μ)
  (f : α ≃ β) (hf : quasi_measure_preserving f.symm ν μ)
  (e : H ≃ G) (hef : ∀ g, semiconj f ((•) (e g)) ((•) g)) :
  is_fundamental_domain H (f '' s) ν :=
begin
  rw f.image_eq_preimage,
  refine h.preimage_of_equiv hf e.symm.bijective (λ g x, _),
  rcases f.surjective x with ⟨x, rfl⟩,
  rw [← hef _ _, f.symm_apply_apply, f.symm_apply_apply, e.apply_symm_apply]
end

@[to_additive] lemma pairwise_ae_disjoint_of_ac {ν} (h : is_fundamental_domain G s μ) (hν : ν ≪ μ) :
  pairwise (λ g₁ g₂ : G, ae_disjoint ν (g₁ • s) (g₂ • s)) :=
h.ae_disjoint.mono $ λ g₁ g₂ H, hν H

@[to_additive] lemma smul_of_comm {G' : Type*} [group G'] [mul_action G' α] [measurable_space G']
  [has_measurable_smul G' α] [smul_invariant_measure G' α μ] [smul_comm_class G' G α]
  (h : is_fundamental_domain G s μ) (g : G') :
  is_fundamental_domain G (g • s) μ :=
h.image_of_equiv (mul_action.to_perm g) (measure_preserving_smul _ _).quasi_measure_preserving
  (equiv.refl _) $ smul_comm g

variables [measurable_space G] [has_measurable_smul G α] [smul_invariant_measure G α μ]

@[to_additive] lemma null_measurable_set_smul (h : is_fundamental_domain G s μ) (g : G) :
  null_measurable_set (g • s) μ :=
h.null_measurable_set.smul g

@[to_additive] lemma restrict_restrict (h : is_fundamental_domain G s μ) (g : G) (t : set α) :
  (μ.restrict t).restrict (g • s) = μ.restrict (g • s ∩ t) :=
restrict_restrict₀ ((h.null_measurable_set_smul g).mono restrict_le_self)

@[to_additive] lemma smul (h : is_fundamental_domain G s μ) (g : G) :
  is_fundamental_domain G (g • s) μ :=
h.image_of_equiv (mul_action.to_perm g) (measure_preserving_smul _ _).quasi_measure_preserving
  ⟨λ g', g⁻¹ * g' * g, λ g', g * g' * g⁻¹, λ g', by simp [mul_assoc], λ g', by simp [mul_assoc]⟩ $
  λ g' x, by simp [smul_smul, mul_assoc]

variables [countable G] {ν : measure α}

@[to_additive] lemma sum_restrict_of_ac (h : is_fundamental_domain G s μ) (hν : ν ≪ μ) :
  sum (λ g : G, ν.restrict (g • s)) = ν :=
by rw [← restrict_Union_ae (h.ae_disjoint.mono $ λ i j h, hν h)
    (λ g, (h.null_measurable_set_smul g).mono_ac hν),
  restrict_congr_set (hν h.Union_smul_ae_eq), restrict_univ]

@[to_additive] lemma lintegral_eq_tsum_of_ac (h : is_fundamental_domain G s μ) (hν : ν ≪ μ)
  (f : α → ℝ≥0∞) : ∫⁻ x, f x ∂ν = ∑' g : G, ∫⁻ x in g • s, f x ∂ν :=
by rw [← lintegral_sum_measure, h.sum_restrict_of_ac hν]

@[to_additive] lemma sum_restrict (h : is_fundamental_domain G s μ) :
  sum (λ g : G, μ.restrict (g • s)) = μ :=
h.sum_restrict_of_ac (refl _)

@[to_additive] lemma lintegral_eq_tsum (h : is_fundamental_domain G s μ) (f : α → ℝ≥0∞) :
  ∫⁻ x, f x ∂μ = ∑' g : G, ∫⁻ x in g • s, f x ∂μ :=
h.lintegral_eq_tsum_of_ac (refl _) f

@[to_additive] lemma lintegral_eq_tsum' (h : is_fundamental_domain G s μ) (f : α → ℝ≥0∞) :
  ∫⁻ x, f x ∂μ = ∑' g : G, ∫⁻ x in s, f (g⁻¹ • x) ∂μ :=
calc ∫⁻ x, f x ∂μ = ∑' g : G, ∫⁻ x in g • s, f x ∂μ : h.lintegral_eq_tsum f
... = ∑' g : G, ∫⁻ x in g⁻¹ • s, f x ∂μ : ((equiv.inv G).tsum_eq _).symm
... = ∑' g : G, ∫⁻ x in s, f (g⁻¹ • x) ∂μ :
  tsum_congr $ λ g, ((measure_preserving_smul g⁻¹ μ).set_lintegral_comp_emb
    (measurable_embedding_const_smul _) _ _).symm

@[to_additive] lemma set_lintegral_eq_tsum (h : is_fundamental_domain G s μ) (f : α → ℝ≥0∞)
  (t : set α) : ∫⁻ x in t, f x ∂μ = ∑' g : G, ∫⁻ x in t ∩ g • s, f x ∂μ :=
calc ∫⁻ x in t, f x ∂μ = ∑' g : G, ∫⁻ x in g • s, f x ∂(μ.restrict t) :
  h.lintegral_eq_tsum_of_ac restrict_le_self.absolutely_continuous _
... = ∑' g : G, ∫⁻ x in t ∩ g • s, f x ∂μ :
  by simp only [h.restrict_restrict, inter_comm]

@[to_additive] lemma set_lintegral_eq_tsum' (h : is_fundamental_domain G s μ) (f : α → ℝ≥0∞)
  (t : set α) :
  ∫⁻ x in t, f x ∂μ = ∑' g : G, ∫⁻ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :=
calc ∫⁻ x in t, f x ∂μ = ∑' g : G, ∫⁻ x in t ∩ g • s, f x ∂μ :
  h.set_lintegral_eq_tsum f t
... = ∑' g : G, ∫⁻ x in t ∩ g⁻¹ • s, f x ∂μ : ((equiv.inv G).tsum_eq _).symm
... = ∑' g : G, ∫⁻ x in g⁻¹ • (g • t ∩ s), f (x) ∂μ :
  by simp only [smul_set_inter, inv_smul_smul]
... = ∑' g : G, ∫⁻ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :
  tsum_congr $ λ g, ((measure_preserving_smul g⁻¹ μ).set_lintegral_comp_emb
    (measurable_embedding_const_smul _) _ _).symm

@[to_additive] lemma measure_eq_tsum_of_ac (h : is_fundamental_domain G s μ) (hν : ν ≪ μ)
  (t : set α) :
  ν t = ∑' g : G, ν (t ∩ g • s) :=
have H : ν.restrict t ≪ μ, from measure.restrict_le_self.absolutely_continuous.trans hν,
by simpa only [set_lintegral_one, pi.one_def,
    measure.restrict_apply₀ ((h.null_measurable_set_smul _).mono_ac H), inter_comm]
  using h.lintegral_eq_tsum_of_ac H 1

@[to_additive] lemma measure_eq_tsum' (h : is_fundamental_domain G s μ) (t : set α) :
  μ t = ∑' g : G, μ (t ∩ g • s) :=
h.measure_eq_tsum_of_ac absolutely_continuous.rfl t

@[to_additive] lemma measure_eq_tsum (h : is_fundamental_domain G s μ) (t : set α) :
  μ t = ∑' g : G, μ (g • t ∩ s) :=
by simpa only [set_lintegral_one] using h.set_lintegral_eq_tsum' (λ _, 1) t

@[to_additive] lemma measure_zero_of_invariant (h : is_fundamental_domain G s μ) (t : set α)
  (ht : ∀ g : G, g • t = t) (hts : μ (t ∩ s) = 0) :
  μ t = 0 :=
by simp [measure_eq_tsum h, ht, hts]

/-- Given a measure space with an action of a finite group `G`, the measure of any `G`-invariant set
is determined by the measure of its intersection with a fundamental domain for the action of `G`. -/
@[to_additive measure_eq_card_smul_of_vadd_ae_eq_self "Given a measure space with an action of a
finite additive group `G`, the measure of any `G`-invariant set is determined by the measure of its
intersection with a fundamental domain for the action of `G`."]
lemma measure_eq_card_smul_of_smul_ae_eq_self [finite G]
  (h : is_fundamental_domain G s μ) (t : set α) (ht : ∀ g : G, (g • t : set α) =ᵐ[μ] t) :
  μ t = nat.card G • μ (t ∩ s) :=
begin
  haveI : fintype G := fintype.of_finite G,
  rw h.measure_eq_tsum,
  replace ht : ∀ g : G, ((g • t) ∩ s : set α) =ᵐ[μ] (t ∩ s : set α) :=
    λ g, ae_eq_set_inter (ht g) (ae_eq_refl s),
  simp_rw [measure_congr (ht _), tsum_fintype, finset.sum_const, nat.card_eq_fintype_card,
    finset.card_univ],
end

@[to_additive] protected lemma set_lintegral_eq (hs : is_fundamental_domain G s μ)
  (ht : is_fundamental_domain G t μ) (f : α → ℝ≥0∞) (hf : ∀ (g : G) x, f (g • x) = f x) :
  ∫⁻ x in s, f x ∂μ = ∫⁻ x in t, f x ∂μ :=
calc ∫⁻ x in s, f x ∂μ = ∑' g : G, ∫⁻ x in s ∩ g • t, f x ∂μ : ht.set_lintegral_eq_tsum _ _
... = ∑' g : G, ∫⁻ x in g • t ∩ s, f (g⁻¹ • x) ∂μ            : by simp only [hf, inter_comm]
... = ∫⁻ x in t, f x ∂μ                                      : (hs.set_lintegral_eq_tsum' _ _).symm

@[to_additive] lemma measure_set_eq (hs : is_fundamental_domain G s μ)
  (ht : is_fundamental_domain G t μ) {A : set α} (hA₀ : measurable_set A)
  (hA : ∀ (g : G), (λ x, g • x) ⁻¹' A = A) :
  μ (A ∩ s) = μ (A ∩ t) :=
begin
  have : ∫⁻ x in s, A.indicator 1 x ∂μ = ∫⁻ x in t, A.indicator 1 x ∂μ,
  { refine hs.set_lintegral_eq ht (set.indicator A (λ _, 1)) _,
    intros g x,
    convert (set.indicator_comp_right (λ x : α, g • x)).symm,
    rw hA g },
  simpa [measure.restrict_apply hA₀, lintegral_indicator _ hA₀] using this
end

/-- If `s` and `t` are two fundamental domains of the same action, then their measures are equal. -/
@[to_additive "If `s` and `t` are two fundamental domains of the same action, then their measures
are equal."]
protected lemma measure_eq (hs : is_fundamental_domain G s μ)
  (ht : is_fundamental_domain G t μ) : μ s = μ t :=
by simpa only [set_lintegral_one] using hs.set_lintegral_eq ht (λ _, 1) (λ _ _, rfl)

@[to_additive] protected lemma ae_strongly_measurable_on_iff
  {β : Type*} [topological_space β] [pseudo_metrizable_space β]
  (hs : is_fundamental_domain G s μ) (ht : is_fundamental_domain G t μ) {f : α → β}
  (hf : ∀ (g : G) x, f (g • x) = f x) :
  ae_strongly_measurable f (μ.restrict s) ↔ ae_strongly_measurable f (μ.restrict t) :=
calc ae_strongly_measurable f (μ.restrict s)
    ↔ ae_strongly_measurable f (measure.sum $ λ g : G, (μ.restrict (g • t ∩ s))) :
  by simp only [← ht.restrict_restrict,
    ht.sum_restrict_of_ac restrict_le_self.absolutely_continuous]
... ↔ ∀ g : G, ae_strongly_measurable f (μ.restrict (g • (g⁻¹ • s ∩ t))) :
  by simp only [smul_set_inter, inter_comm, smul_inv_smul, ae_strongly_measurable_sum_measure_iff]
... ↔ ∀ g : G, ae_strongly_measurable f (μ.restrict (g⁻¹ • (g⁻¹⁻¹ • s ∩ t))) : inv_surjective.forall
... ↔ ∀ g : G, ae_strongly_measurable f (μ.restrict (g⁻¹ • (g • s ∩ t))) : by simp only [inv_inv]
... ↔ ∀ g : G, ae_strongly_measurable f (μ.restrict (g • s ∩ t)) :
  begin
    refine forall_congr (λ g, _),
    have he : measurable_embedding ((•) g⁻¹ : α → α) := measurable_embedding_const_smul _,
    rw [← image_smul,
    ← ((measure_preserving_smul g⁻¹ μ).restrict_image_emb he _).ae_strongly_measurable_comp_iff he],
    simp only [(∘), hf]
  end
... ↔ ae_strongly_measurable f (μ.restrict t) :
  by simp only [← ae_strongly_measurable_sum_measure_iff, ← hs.restrict_restrict,
    hs.sum_restrict_of_ac restrict_le_self.absolutely_continuous]

@[to_additive] protected lemma has_finite_integral_on_iff (hs : is_fundamental_domain G s μ)
  (ht : is_fundamental_domain G t μ) {f : α → E} (hf : ∀ (g : G) x, f (g • x) = f x) :
  has_finite_integral f (μ.restrict s) ↔ has_finite_integral f (μ.restrict t) :=
begin
  dunfold has_finite_integral,
  rw hs.set_lintegral_eq ht,
  intros g x, rw hf
end

@[to_additive] protected lemma integrable_on_iff (hs : is_fundamental_domain G s μ)
  (ht : is_fundamental_domain G t μ) {f : α → E} (hf : ∀ (g : G) x, f (g • x) = f x) :
  integrable_on f s μ ↔ integrable_on f t μ :=
and_congr (hs.ae_strongly_measurable_on_iff ht hf) (hs.has_finite_integral_on_iff ht hf)

variables [normed_space ℝ E] [complete_space E]

@[to_additive] lemma integral_eq_tsum_of_ac (h : is_fundamental_domain G s μ) (hν : ν ≪ μ)
  (f : α → E) (hf : integrable f ν) : ∫ x, f x ∂ν = ∑' g : G, ∫ x in g • s, f x ∂ν :=
begin
  rw [← measure_theory.integral_sum_measure, h.sum_restrict_of_ac hν],
  rw h.sum_restrict_of_ac hν, -- Weirdly, these rewrites seem not to be combinable
  exact hf,
end

@[to_additive] lemma integral_eq_tsum (h : is_fundamental_domain G s μ)
  (f : α → E) (hf : integrable f μ) : ∫ x, f x ∂μ = ∑' g : G, ∫ x in g • s, f x ∂μ :=
integral_eq_tsum_of_ac h (by refl) f hf

@[to_additive] lemma integral_eq_tsum' (h : is_fundamental_domain G s μ)
  (f : α → E) (hf : integrable f μ) : ∫ x, f x ∂μ = ∑' g : G, ∫ x in s, f (g⁻¹ • x) ∂μ :=
calc ∫ x, f x ∂μ = ∑' g : G, ∫ x in g • s, f x ∂μ : h.integral_eq_tsum f hf
... = ∑' g : G, ∫ x in g⁻¹ • s, f x ∂μ : ((equiv.inv G).tsum_eq _).symm
... = ∑' g : G, ∫ x in s, f (g⁻¹ • x) ∂μ :
  tsum_congr $ λ g, (measure_preserving_smul g⁻¹ μ).set_integral_image_emb
    (measurable_embedding_const_smul _) _ _

@[to_additive] lemma set_integral_eq_tsum (h : is_fundamental_domain G s μ) {f : α → E}
  {t : set α} (hf : integrable_on f t μ) :
  ∫ x in t, f x ∂μ = ∑' g : G, ∫ x in t ∩ g • s, f x ∂μ :=
calc ∫ x in t, f x ∂μ = ∑' g : G, ∫ x in g • s, f x ∂(μ.restrict t) :
  h.integral_eq_tsum_of_ac restrict_le_self.absolutely_continuous f hf
... = ∑' g : G, ∫ x in t ∩ g • s, f x ∂μ :
  by simp only [h.restrict_restrict, measure_smul, inter_comm]

@[to_additive] lemma set_integral_eq_tsum' (h : is_fundamental_domain G s μ) {f : α → E}
  {t : set α} (hf : integrable_on f t μ) :
  ∫ x in t, f x ∂μ = ∑' g : G, ∫ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :=
calc ∫ x in t, f x ∂μ = ∑' g : G, ∫ x in t ∩ g • s, f x ∂μ :
  h.set_integral_eq_tsum hf
... = ∑' g : G, ∫ x in t ∩ g⁻¹ • s, f x ∂μ : ((equiv.inv G).tsum_eq _).symm
... = ∑' g : G, ∫ x in g⁻¹ • (g • t ∩ s), f (x) ∂μ :
  by simp only [smul_set_inter, inv_smul_smul]
... = ∑' g : G, ∫ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :
  tsum_congr $ λ g, (measure_preserving_smul g⁻¹ μ).set_integral_image_emb
    (measurable_embedding_const_smul _) _ _

@[to_additive] protected lemma set_integral_eq (hs : is_fundamental_domain G s μ)
  (ht : is_fundamental_domain G t μ) {f : α → E} (hf : ∀ (g : G) x, f (g • x) = f x) :
  ∫ x in s, f x ∂μ = ∫ x in t, f x ∂μ :=
begin
  by_cases hfs : integrable_on f s μ,
  { have hft : integrable_on f t μ, by rwa ht.integrable_on_iff hs hf,
    calc ∫ x in s, f x ∂μ = ∑' g : G, ∫ x in s ∩ g • t, f x ∂μ : ht.set_integral_eq_tsum hfs
    ... = ∑' g : G, ∫ x in g • t ∩ s, f (g⁻¹ • x) ∂μ : by simp only [hf, inter_comm]
    ... = ∫ x in t, f x ∂μ : (hs.set_integral_eq_tsum' hft).symm, },
  { rw [integral_undef hfs, integral_undef],
    rwa [hs.integrable_on_iff ht hf] at hfs }
end

/-- If the action of a countable group `G` admits an invariant measure `μ` with a fundamental domain
`s`, then every null-measurable set `t` such that the sets `g • t ∩ s` are pairwise a.e.-disjoint
has measure at most `μ s`. -/
@[to_additive "If the additive action of a countable group `G` admits an invariant measure `μ` with
a fundamental domain `s`, then every null-measurable set `t` such that the sets `g +ᵥ t ∩ s` are
pairwise a.e.-disjoint has measure at most `μ s`."]
 lemma measure_le_of_pairwise_disjoint (hs : is_fundamental_domain G s μ)
  (ht : null_measurable_set t μ) (hd : pairwise (ae_disjoint μ on (λ g : G, g • t ∩ s))) :
  μ t ≤ μ s :=
calc μ t = ∑' g : G, μ (g • t ∩ s) : hs.measure_eq_tsum t
... = μ (⋃ g : G, g • t ∩ s) : eq.symm $ measure_Union₀ hd $
  λ g, (ht.smul _).inter hs.null_measurable_set
... ≤ μ s : measure_mono (Union_subset $ λ g, inter_subset_right _ _)

/-- If the action of a countable group `G` admits an invariant measure `μ` with a fundamental domain
`s`, then every null-measurable set `t` of measure strictly greater than `μ s` contains two
points `x y` such that `g • x = y` for some `g ≠ 1`. -/
@[to_additive "If the additive action of a countable group `G` admits an invariant measure `μ` with
a fundamental domain `s`, then every null-measurable set `t` of measure strictly greater than `μ s`
contains two points `x y` such that `g +ᵥ x = y` for some `g ≠ 0`."]
lemma exists_ne_one_smul_eq (hs : is_fundamental_domain G s μ) (htm : null_measurable_set t μ)
  (ht : μ s < μ t) : ∃ (x y ∈ t) (g ≠ (1 : G)), g • x = y :=
begin
  contrapose! ht,
  refine hs.measure_le_of_pairwise_disjoint htm (pairwise.ae_disjoint $ λ g₁ g₂ hne, _),
  dsimp [function.on_fun],
  refine (disjoint.inf_left _ _).inf_right _,
  rw set.disjoint_left,
  rintro _ ⟨x, hx, rfl⟩ ⟨y, hy, hxy⟩,
  refine ht x hx y hy (g₂⁻¹ * g₁) (mt inv_mul_eq_one.1 hne.symm) _,
  rw [mul_smul, ← hxy, inv_smul_smul]
end

/-- If `f` is invariant under the action of a countable group `G`, and `μ` is a `G`-invariant
  measure with a fundamental domain `s`, then the `ess_sup` of `f` restricted to `s` is the same as
  that of `f` on all of its domain. -/
@[to_additive "If `f` is invariant under the action of a countable additive group `G`, and `μ` is a
`G`-invariant measure with a fundamental domain `s`, then the `ess_sup` of `f` restricted to `s` is
the same as that of `f` on all of its domain."]
lemma ess_sup_measure_restrict (hs : is_fundamental_domain G s μ)
  {f : α → ℝ≥0∞} (hf : ∀ γ : G, ∀ x: α, f (γ • x) =  f x) :
  ess_sup f (μ.restrict s) = ess_sup f μ :=
begin
  refine le_antisymm (ess_sup_mono_measure' measure.restrict_le_self) _,
  rw [ess_sup_eq_Inf (μ.restrict s) f, ess_sup_eq_Inf μ f],
  refine Inf_le_Inf _,
  rintro a (ha : (μ.restrict s) {x : α | a < f x} = 0),
  rw measure.restrict_apply₀' hs.null_measurable_set at ha,
  refine measure_zero_of_invariant hs _ _ ha,
  intros γ,
  ext x,
  rw mem_smul_set_iff_inv_smul_mem,
  simp only [mem_set_of_eq, hf (γ⁻¹) x],
end

end is_fundamental_domain

/-! ### Interior/frontier of a fundamental domain -/

section measurable_space
variables (G) [group G] [mul_action G α] (s : set α) {x : α}

/-- The boundary of a fundamental domain, those points of the domain that also lie in a nontrivial
translate. -/
@[to_additive measure_theory.add_fundamental_frontier "The boundary of a fundamental domain, those
points of the domain that also lie in a nontrivial translate."]
def fundamental_frontier : set α := s ∩ ⋃ (g : G) (hg : g ≠ 1), g • s

/-- The interior of a fundamental domain, those points of the domain not lying in any translate. -/
@[to_additive measure_theory.add_fundamental_interior "The interior of a fundamental domain, those
points of the domain not lying in any translate."]
def fundamental_interior : set α := s \ ⋃ (g : G) (hg : g ≠ 1), g • s

variables {G s}

@[simp, to_additive measure_theory.mem_add_fundamental_frontier]
lemma mem_fundamental_frontier :
  x ∈ fundamental_frontier G s ↔ x ∈ s ∧ ∃ (g : G) (hg : g ≠ 1), x ∈ g • s :=
by simp [fundamental_frontier]

@[simp, to_additive measure_theory.mem_add_fundamental_interior]
lemma mem_fundamental_interior :
  x ∈ fundamental_interior G s ↔ x ∈ s ∧ ∀ (g : G) (hg : g ≠ 1), x ∉ g • s :=
by simp [fundamental_interior]

@[to_additive measure_theory.add_fundamental_frontier_subset]
lemma fundamental_frontier_subset : fundamental_frontier G s ⊆ s := inter_subset_left _ _

@[to_additive measure_theory.add_fundamental_interior_subset]
lemma fundamental_interior_subset : fundamental_interior G s ⊆ s := diff_subset _ _

variables (G s)

@[to_additive measure_theory.disjoint_add_fundamental_interior_add_fundamental_frontier]
lemma disjoint_fundamental_interior_fundamental_frontier :
  disjoint (fundamental_interior G s) (fundamental_frontier G s) :=
disjoint_sdiff_self_left.mono_right inf_le_right

@[simp, to_additive measure_theory.add_fundamental_interior_union_add_fundamental_frontier]
lemma fundamental_interior_union_fundamental_frontier :
  fundamental_interior G s ∪ fundamental_frontier G s = s :=
diff_union_inter _ _

@[simp, to_additive measure_theory.add_fundamental_interior_union_add_fundamental_frontier]
lemma fundamental_frontier_union_fundamental_interior :
  fundamental_frontier G s ∪ fundamental_interior G s = s :=
inter_union_diff _ _

@[simp, to_additive measure_theory.sdiff_add_fundamental_interior]
lemma sdiff_fundamental_interior : s \ fundamental_interior G s = fundamental_frontier G s :=
sdiff_sdiff_right_self

@[simp, to_additive measure_theory.sdiff_add_fundamental_frontier]
lemma sdiff_fundamental_frontier : s \ fundamental_frontier G s = fundamental_interior G s :=
diff_self_inter

@[simp, to_additive measure_theory.add_fundamental_frontier_vadd]
lemma fundamental_frontier_smul [group H] [mul_action H α] [smul_comm_class H G α] (g : H) :
  fundamental_frontier G (g • s) = g • fundamental_frontier G s :=
by simp_rw [fundamental_frontier, smul_set_inter, smul_set_Union, smul_comm g]

@[simp, to_additive measure_theory.add_fundamental_interior_vadd]
lemma fundamental_interior_smul [group H] [mul_action H α] [smul_comm_class H G α] (g : H) :
  fundamental_interior G (g • s) = g • fundamental_interior G s :=
by simp_rw [fundamental_interior, smul_set_sdiff, smul_set_Union, smul_comm g]

@[to_additive measure_theory.pairwise_disjoint_add_fundamental_interior]
lemma pairwise_disjoint_fundamental_interior :
  pairwise (disjoint on λ g : G, g • fundamental_interior G s) :=
begin
  refine λ a b hab, disjoint_left.2 _,
  rintro _ ⟨x, hx, rfl⟩ ⟨y, hy, hxy⟩,
  rw mem_fundamental_interior at hx hy,
  refine hx.2 (a⁻¹ * b) _ _,
  rwa [ne.def, inv_mul_eq_iff_eq_mul, mul_one, eq_comm],
  simpa [mul_smul, ←hxy, mem_inv_smul_set_iff] using hy.1,
end

variables [countable G] [measurable_space G] [measurable_space α] [has_measurable_smul G α]
  {μ : measure α} [smul_invariant_measure G α μ]

@[to_additive measure_theory.null_measurable_set.add_fundamental_frontier]
protected lemma null_measurable_set.fundamental_frontier (hs : null_measurable_set s μ) :
  null_measurable_set (fundamental_frontier G s) μ :=
hs.inter $ null_measurable_set.Union $ λ g, null_measurable_set.Union $ λ hg, hs.smul _

@[to_additive measure_theory.null_measurable_set.add_fundamental_interior]
protected lemma null_measurable_set.fundamental_interior (hs : null_measurable_set s μ) :
  null_measurable_set (fundamental_interior G s) μ :=
hs.diff $ null_measurable_set.Union $ λ g, null_measurable_set.Union $ λ hg, hs.smul _

end measurable_space

namespace is_fundamental_domain
section group
variables [countable G] [group G] [mul_action G α] [measurable_space α] {μ : measure α} {s : set α}
  (hs : is_fundamental_domain G s μ)
include hs

@[to_additive measure_theory.is_add_fundamental_domain.measure_add_fundamental_frontier]
lemma measure_fundamental_frontier : μ (fundamental_frontier G s) = 0 :=
by simpa only [fundamental_frontier, Union₂_inter, measure_Union_null_iff', one_smul,
  measure_Union_null_iff, inter_comm s, function.on_fun] using λ g (hg : g ≠ 1), hs.ae_disjoint hg

@[to_additive measure_theory.is_add_fundamental_domain.measure_add_fundamental_interior]
lemma measure_fundamental_interior : μ (fundamental_interior G s) = μ s :=
measure_diff_null' hs.measure_fundamental_frontier

end group

variables [countable G] [group G] [mul_action G α] [measurable_space α] {μ : measure α} {s : set α}
  (hs : is_fundamental_domain G s μ) [measurable_space G] [has_measurable_smul G α]
  [smul_invariant_measure G α μ]
include hs

protected lemma fundamental_interior : is_fundamental_domain G (fundamental_interior G s) μ :=
{ null_measurable_set := hs.null_measurable_set.fundamental_interior _ _,
  ae_covers := begin
    simp_rw [ae_iff, not_exists, ←mem_inv_smul_set_iff, set_of_forall, ←compl_set_of, set_of_mem_eq,
      ←compl_Union],
    have : (⋃ g : G, g⁻¹ • s) \ (⋃ g : G, g⁻¹ • fundamental_frontier G s) ⊆
      ⋃ g : G, g⁻¹ • fundamental_interior G s,
    { simp_rw [diff_subset_iff, ←Union_union_distrib, ←smul_set_union,
        fundamental_frontier_union_fundamental_interior] },
    refine eq_bot_mono (μ.mono $ compl_subset_compl.2 this) _,
    simp only [Union_inv_smul, outer_measure.measure_of_eq_coe, coe_to_outer_measure, compl_sdiff,
      ennreal.bot_eq_zero, himp_eq, sup_eq_union, @Union_smul_eq_set_of_exists _ _ _ _ s],
    exact measure_union_null
      (measure_Union_null $ λ _, measure_smul_null hs.measure_fundamental_frontier _) hs.ae_covers,
  end,
  ae_disjoint := (pairwise_disjoint_fundamental_interior _ _).mono $ λ _ _, disjoint.ae_disjoint }

end is_fundamental_domain
end measure_theory


import interior_world.definition -- hide

/- Axiom : A set A is the neighborhood of a point x if there is an open U such that $x \in U \subseteq A$.
is_neighborhood : ∃ U, is_open U ∧ x ∈ U ∧ U ⊆ A
-/

/- Axiom : A point x is an interior point of A if A is a neighborhood of x.
is_interior_point : is_neighborhood x A
-/

/- Axiom : The interior of a set A is the set of all its interior points.
interior : { x : X | is_interior_point x A }
-/

/-
In this world we will end up having three alternative definitions of the interior of a set.
This will be very useful, because at any point we will be able to choose the one that better fits our needs.

First of all we need to figure out what properties does the interior of an arbitrary set have... So we start with an easy one:

# Level 1: The interior is contained in the original set

-/
variables {X : Type} -- hide
variables [topological_space X] (x : X)  (A : set X) -- hide

namespace topological_space -- hide

@[simp]  -- hide
/- Lemma
The interior of any set A is contained in the set A.
-/
lemma interior_is_subset: interior A ⊆ A :=
begin
  rintros x ⟨_, _⟩,
  tauto,

end

end topological_space -- hide


import MyNat.Definition
import MyNat.Inequality -- le_iff_exists_add
import Mathlib.Tactic.Use -- use tactic
import AdvancedAdditionWorld.Level11 -- add_right_eq_zero
namespace MyNat
open MyNat
/-!

# Inequality world.

## Level 8: `succ_le_succ`

Another straightforward one.

## Lemma : succ_le_succ
For all naturals `a` and `b`, if `a ≤ b`, then `succ a ≤ succ b`.
-/
lemma succ_le_succ (a b : MyNat) (h : a ≤ b) : succ a ≤ succ b := by
  cases h with
  | _ c hc =>
    use c
    rw [hc]
    rw [succ_add]

/-!
Next up [Level 9](./Level9.lean.md)
-/


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

! This file was ported from Lean 3 source module data.set.enumerate
! leanprover-community/mathlib commit 92ca63f0fb391a9ca5f22d2409a6080e786d99f7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Order.Basic
import Mathlib.Data.Set.Basic
import Mathlib.Tactic.SwapVar

/-!
# Set enumeration
This file allows enumeration of sets given a choice function.
The definition does not assume `sel` actually is a choice function, i.e. `sel s ∈ s` and
`sel s = none ↔ s = ∅`. These assumptions are added to the lemmas needing them.
-/

noncomputable section

open Function

namespace Set

section Enumerate

/- porting note : The original used parameters -/
variable {α : Type _} (sel : Set α → Option α)

/-- Given a choice function `sel`, enumerates the elements of a set in the order
`a 0 = sel s`, `a 1 = sel (s \ {a 0})`, `a 2 = sel (s \ {a 0, a 1})`, ... and stops when
`sel (s \ {a 0, ..., a n}) = none`. Note that we don't require `sel` to be a choice function. -/
def enumerate : Set α → ℕ → Option α
  | s, 0 => sel s
  | s, n + 1 => do
    let a ← sel s
    enumerate (s \ {a}) n
#align set.enumerate Set.enumerate

theorem enumerate_eq_none_of_sel {s : Set α} (h : sel s = none) : ∀ {n}, enumerate sel s n = none
  | 0 => by simp [h, enumerate]
  | n + 1 => by simp [h, enumerate]; rfl
#align set.enumerate_eq_none_of_sel Set.enumerate_eq_none_of_sel

theorem enumerate_eq_none :
    ∀ {s n₁ n₂}, enumerate sel s n₁ = none → n₁ ≤ n₂ → enumerate sel s n₂ = none
  | s, 0, m => fun h _ ↦ enumerate_eq_none_of_sel sel h
  | s, n + 1, m => fun h hm ↦ by
    cases hs : sel s
    · exact enumerate_eq_none_of_sel sel hs
    · cases m
      case zero =>
        contradiction
      case succ m' =>
        simp [hs, enumerate] at h ⊢
        have hm : n ≤ m' := Nat.le_of_succ_le_succ hm
        exact enumerate_eq_none h hm
#align set.enumerate_eq_none Set.enumerate_eq_none

theorem enumerate_mem (h_sel : ∀ s a, sel s = some a → a ∈ s) :
    ∀ {s n a}, enumerate sel s n = some a → a ∈ s
  | s, 0, a => h_sel s a
  | s, n + 1, a => by
    cases h : sel s
    case none => simp [enumerate_eq_none_of_sel, h]
    case some a' =>
      simp [enumerate, h]
      exact fun h' : enumerate sel (s \ {a'}) n = some a ↦
        have : a ∈ s \ {a'} := enumerate_mem h_sel h'
        this.left
#align set.enumerate_mem Set.enumerate_mem

theorem enumerate_inj {n₁ n₂ : ℕ} {a : α} {s : Set α} (h_sel : ∀ s a, sel s = some a → a ∈ s)
    (h₁ : enumerate sel s n₁ = some a) (h₂ : enumerate sel s n₂ = some a) : n₁ = n₂ := by
  /- porting note : The `rcase, on_goal, all_goals` has been used instead of
     the not-yet-ported `wlog` -/
  rcases le_total n₁ n₂ with (hn|hn)
  on_goal 2 => swap_var n₁ ↔ n₂, h₁ ↔ h₂
  all_goals
    rcases Nat.le.dest hn with ⟨m, rfl⟩
    clear hn
    induction n₁ generalizing s
    case zero =>
      cases m
      case zero => rfl
      case succ m =>
        have h' : enumerate sel (s \ {a}) m = some a := by
          simp_all only [enumerate, Nat.zero_eq, Nat.add_eq, zero_add]; exact h₂
        have : a ∈ s \ {a} := enumerate_mem sel h_sel h'
        simp_all [Set.mem_diff_singleton]
    case succ k ih =>
      cases h : sel s
      /- porting note : The original covered both goals with just `simp_all <;> tauto` -/
      case none =>
        simp_all only [add_comm, self_eq_add_left, Nat.add_succ, enumerate_eq_none_of_sel _ h]
      case some _ =>
        simp_all only [add_comm, self_eq_add_left, enumerate, Option.some.injEq,
                       Nat.add_succ, enumerate._eq_2, Nat.succ.injEq]
        exact ih h₁ h₂
#align set.enumerate_inj Set.enumerate_inj

end Enumerate

end Set


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

import ..todo
import topology.subset_properties
import topology.separation
import topology.metric_space.basic

/-!
A formal roadmap for basic properties of paracompact spaces.

It contains the statements that compact spaces and metric spaces are paracompact,
and that paracompact t2 spaces are normal, as well as partially formalised proofs.

Any contributor should feel welcome to contribute complete proofs. When this happens,
we should also consider preserving the current file as an exemplar of a formal roadmap.
-/

open set filter

universe u

namespace roadmap

class paracompact_space (X : Type u) [topological_space X] : Prop :=
(locally_finite_refinement :
  ∀ {α : Type u} (u : α → set X) (uo : ∀ a, is_open (u a)) (uc : Union u = univ),
  ∃ {β : Type u} (v : β → set X) (vo : ∀ b, is_open (v b)) (vc : Union v = univ),
  locally_finite v ∧ ∀ b, ∃ a, v b ⊆ u a)

/-- Any open cover of a paracompact space has a locally finite *precise* refinement, that is,
 one indexed on the same type with each open set contained in the corresponding original one. -/
lemma paracompact_space.precise_refinement {X : Type u} [topological_space X] [paracompact_space X]
  {α : Type u} (u : α → set X) (uo : ∀ a, is_open (u a)) (uc : Union u = univ) :
  ∃ v : α → set X, (∀ a, is_open (v a)) ∧ Union v = univ ∧ locally_finite v ∧ (∀ a, v a ⊆ u a) :=
begin
  obtain ⟨β, w, wo, wc, lfw, wr⟩ := paracompact_space.locally_finite_refinement u uo uc,
  choose f hf using wr,
  refine ⟨λ a, ⋃₀ {s | ∃ b, f b = a ∧ s = w b}, λ a, _, _, _, λ a, _⟩,
  { apply is_open_sUnion _,
    rintros t ⟨b, rfl, rfl⟩,
    apply wo },
  { todo },
  { todo },
  { apply sUnion_subset,
    rintros t ⟨b, rfl, rfl⟩,
    apply hf }
end

lemma paracompact_of_compact {X : Type u} [topological_space X] [compact_space X] :
  paracompact_space X :=
begin
  refine ⟨λ α u uo uc, _⟩,
  obtain ⟨s, _, sf, sc⟩ :=
    is_compact_univ.elim_finite_subcover_image (λ a _, uo a) (by rwa [univ_subset_iff, bUnion_univ]),
  refine ⟨s, λ b, u b.val, λ b, uo b.val, _, _, λ b, ⟨b.val, subset.refl _⟩⟩,
  { todo },
  { intro x,
    refine ⟨univ, univ_mem, _⟩,
    todo },
end

lemma normal_of_paracompact_t2 {X : Type u} [topological_space X] [t2_space X]
  [paracompact_space X] : normal_space X :=
todo
/-
Similar to the proof of `generalized_tube_lemma`, but different enough not to merge them.
Lemma: if `s : set X` is closed and can be separated from any point by open sets,
then `s` can also be separated from any closed set by open sets. Apply twice.

See
* Bourbaki, General Topology, Chapter IX, §4.4
* https://ncatlab.org/nlab/show/paracompact+Hausdorff+spaces+are+normal
-/

lemma paracompact_of_metric {X : Type u} [metric_space X] : paracompact_space X :=
todo
/-
See Mary Ellen Rudin, A new proof that metric spaces are paracompact.
https://www.ams.org/journals/proc/1969-020-02/S0002-9939-1969-0236876-3/S0002-9939-1969-0236876-3.pdf
-/
end roadmap