/-
Copyright (c) 2021 Benjamin Davidson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Benjamin Davidson
-/
import algebra.field.opposite
import algebra.module.basic
import algebra.order.archimedean
import data.int.parity
import group_theory.coset

/-!
# Periodicity

In this file we define and then prove facts about periodic and antiperiodic functions.

## Main definitions

* `function.periodic`: A function `f` is *periodic* if `∀ x, f (x + c) = f x`.
  `f` is referred to as periodic with period `c` or `c`-periodic.

* `function.antiperiodic`: A function `f` is *antiperiodic* if `∀ x, f (x + c) = -f x`.
  `f` is referred to as antiperiodic with antiperiod `c` or `c`-antiperiodic.

Note that any `c`-antiperiodic function will necessarily also be `2*c`-periodic.

## Tags

period, periodic, periodicity, antiperiodic
-/

variables {α β γ : Type*} {f g : α → β} {c c₁ c₂ x : α}

open_locale big_operators

namespace function

/-! ### Periodicity -/

/-- A function `f` is said to be `periodic` with period `c` if for all `x`, `f (x + c) = f x`. -/
@[simp] def periodic [has_add α] (f : α → β) (c : α) : Prop :=
∀ x : α, f (x + c) = f x

lemma periodic.funext [has_add α]
  (h : periodic f c) :
  (λ x, f (x + c)) = f :=
funext h

lemma periodic.comp [has_add α]
  (h : periodic f c) (g : β → γ) :
  periodic (g ∘ f) c :=
by simp * at *

lemma periodic.comp_add_hom [has_add α] [has_add γ]
  (h : periodic f c) (g : add_hom γ α) (g_inv : α → γ) (hg : right_inverse g_inv g) :
  periodic (f ∘ g) (g_inv c) :=
λ x, by simp only [hg c, h (g x), add_hom.map_add, comp_app]

@[to_additive]
lemma periodic.mul [has_add α] [has_mul β]
  (hf : periodic f c) (hg : periodic g c) :
  periodic (f * g) c :=
by simp * at *

@[to_additive]
lemma periodic.div [has_add α] [has_div β]
  (hf : periodic f c) (hg : periodic g c) :
  periodic (f / g) c :=
by simp * at *

@[to_additive]
lemma _root_.list.periodic_prod [has_add α] [comm_monoid β]
  (l : list (α → β)) (hl : ∀ f ∈ l, periodic f c) :
  periodic l.prod c :=
begin
  induction l with g l ih hl,
  { simp, },
  { simp only [list.mem_cons_iff, forall_eq_or_imp] at hl,
    obtain ⟨hg, hl⟩ := hl,
    simp only [list.prod_cons],
    exact hg.mul (ih hl), },
end

@[to_additive]
lemma _root_.multiset.periodic_prod [has_add α] [comm_monoid β]
  (s : multiset (α → β)) (hs : ∀ f ∈ s, periodic f c) :
  periodic s.prod c :=
s.prod_to_list ▸ s.to_list.periodic_prod $ λ f hf, hs f $ (multiset.mem_to_list f s).mp hf

@[to_additive]
lemma _root_.finset.periodic_prod [has_add α] [comm_monoid β]
  {ι : Type*} {f : ι → α → β} (s : finset ι) (hs : ∀ i ∈ s, periodic (f i) c) :
  periodic (∏ i in s, f i) c :=
s.prod_to_list f ▸ (s.to_list.map f).periodic_prod (by simpa [-periodic])

@[to_additive]
lemma periodic.smul [has_add α] [has_scalar γ β] (h : periodic f c) (a : γ) :
  periodic (a • f) c :=
by simp * at *

lemma periodic.const_smul [add_monoid α] [group γ] [distrib_mul_action γ α]
  (h : periodic f c) (a : γ) :
  periodic (λ x, f (a • x)) (a⁻¹ • c) :=
λ x, by simpa only [smul_add, smul_inv_smul] using h (a • x)

lemma periodic.const_smul₀ [add_comm_monoid α] [division_ring γ] [module γ α]
  (h : periodic f c) (a : γ) :
  periodic (λ x, f (a • x)) (a⁻¹ • c) :=
begin
  intro x,
  by_cases ha : a = 0, { simp only [ha, zero_smul] },
  simpa only [smul_add, smul_inv_smul₀ ha] using h (a • x),
end

lemma periodic.const_mul [division_ring α]
  (h : periodic f c) (a : α) :
  periodic (λ x, f (a * x)) (a⁻¹ * c) :=
h.const_smul₀ a

lemma periodic.const_inv_smul [add_monoid α] [group γ] [distrib_mul_action γ α]
  (h : periodic f c) (a : γ) :
  periodic (λ x, f (a⁻¹ • x)) (a • c) :=
by simpa only [inv_inv] using h.const_smul a⁻¹

lemma periodic.const_inv_smul₀ [add_comm_monoid α] [division_ring γ] [module γ α]
  (h : periodic f c) (a : γ) :
  periodic (λ x, f (a⁻¹ • x)) (a • c) :=
by simpa only [inv_inv] using h.const_smul₀ a⁻¹

lemma periodic.const_inv_mul [division_ring α]
  (h : periodic f c) (a : α) :
  periodic (λ x, f (a⁻¹ * x)) (a * c) :=
h.const_inv_smul₀ a

lemma periodic.mul_const [division_ring α]
  (h : periodic f c) (a : α) :
  periodic (λ x, f (x * a)) (c * a⁻¹) :=
h.const_smul₀ $ mul_opposite.op a

lemma periodic.mul_const' [division_ring α]
  (h : periodic f c) (a : α) :
  periodic (λ x, f (x * a)) (c / a) :=
by simpa only [div_eq_mul_inv] using h.mul_const a

lemma periodic.mul_const_inv [division_ring α]
  (h : periodic f c) (a : α) :
  periodic (λ x, f (x * a⁻¹)) (c * a) :=
h.const_inv_smul₀ $ mul_opposite.op a

lemma periodic.div_const [division_ring α]
  (h : periodic f c) (a : α) :
  periodic (λ x, f (x / a)) (c * a) :=
by simpa only [div_eq_mul_inv] using h.mul_const_inv a

lemma periodic.add_period [add_semigroup α]
  (h1 : periodic f c₁) (h2 : periodic f c₂) :
  periodic f (c₁ + c₂) :=
by simp [*, ← add_assoc] at *

lemma periodic.sub_eq [add_group α]
  (h : periodic f c) (x : α) :
  f (x - c) = f x :=
by simpa only [sub_add_cancel] using (h (x - c)).symm

lemma periodic.sub_eq' [add_comm_group α]
  (h : periodic f c) :
  f (c - x) = f (-x) :=
by simpa only [sub_eq_neg_add] using h (-x)

lemma periodic.neg [add_group α]
  (h : periodic f c) :
  periodic f (-c) :=
by simpa only [sub_eq_add_neg, periodic] using h.sub_eq

lemma periodic.sub_period [add_comm_group α]
  (h1 : periodic f c₁) (h2 : periodic f c₂) :
  periodic f (c₁ - c₂) :=
let h := h2.neg in by simp [*, sub_eq_add_neg, add_comm c₁, ← add_assoc] at *

lemma periodic.nsmul [add_monoid α]
  (h : periodic f c) (n : ℕ) :
  periodic f (n • c) :=
by induction n; simp [nat.succ_eq_add_one, add_nsmul, ← add_assoc, zero_nsmul, *] at *

lemma periodic.nat_mul [semiring α]
  (h : periodic f c) (n : ℕ) :
  periodic f (n * c) :=
by simpa only [nsmul_eq_mul] using h.nsmul n

lemma periodic.neg_nsmul [add_group α]
  (h : periodic f c) (n : ℕ) :
  periodic f (-(n • c)) :=
(h.nsmul n).neg

lemma periodic.neg_nat_mul [ring α]
  (h : periodic f c) (n : ℕ) :
  periodic f (-(n * c)) :=
(h.nat_mul n).neg

lemma periodic.sub_nsmul_eq [add_group α]
  (h : periodic f c) (n : ℕ) :
  f (x - n • c) = f x :=
by simpa only [sub_eq_add_neg] using h.neg_nsmul n x

lemma periodic.sub_nat_mul_eq [ring α]
  (h : periodic f c) (n : ℕ) :
  f (x - n * c) = f x :=
by simpa only [nsmul_eq_mul] using h.sub_nsmul_eq n

lemma periodic.nsmul_sub_eq [add_comm_group α]
  (h : periodic f c) (n : ℕ) :
  f (n • c - x) = f (-x) :=
by simpa only [sub_eq_neg_add] using h.nsmul n (-x)

lemma periodic.nat_mul_sub_eq [ring α]
  (h : periodic f c) (n : ℕ) :
  f (n * c - x) = f (-x) :=
by simpa only [sub_eq_neg_add] using h.nat_mul n (-x)

lemma periodic.zsmul [add_group α]
  (h : periodic f c) (n : ℤ) :
  periodic f (n • c) :=
begin
  cases n,
  { simpa only [int.of_nat_eq_coe, coe_nat_zsmul] using h.nsmul n },
  { simpa only [zsmul_neg_succ_of_nat] using (h.nsmul n.succ).neg },
end

lemma periodic.sub_zsmul_eq [add_group α]
  (h : periodic f c) (n : ℤ) :
  f (x - n • c) = f x :=
(h.zsmul n).sub_eq x

lemma periodic.sub_int_mul_eq [ring α]
  (h : periodic f c) (n : ℤ) :
  f (x - n * c) = f x :=
(h.int_mul n).sub_eq x

lemma periodic.zsmul_sub_eq [add_comm_group α]
  (h : periodic f c) (n : ℤ) :
  f (n • c - x) = f (-x) :=
by simpa only [sub_eq_neg_add] using h.zsmul n (-x)

lemma periodic.int_mul_sub_eq [ring α]
  (h : periodic f c) (n : ℤ) :
  f (n * c - x) = f (-x) :=
by simpa only [sub_eq_neg_add] using h.int_mul n (-x)

lemma periodic.eq [add_zero_class α]
  (h : periodic f c) :
  f c = f 0 :=
by simpa only [zero_add] using h 0

lemma periodic.neg_eq [add_group α]
  (h : periodic f c) :
  f (-c) = f 0 :=
h.neg.eq

lemma periodic.nsmul_eq [add_monoid α]
  (h : periodic f c) (n : ℕ) :
  f (n • c) = f 0 :=
(h.nsmul n).eq

lemma periodic.nat_mul_eq [semiring α]
  (h : periodic f c) (n : ℕ) :
  f (n * c) = f 0 :=
(h.nat_mul n).eq

lemma periodic.zsmul_eq [add_group α]
  (h : periodic f c) (n : ℤ) :
  f (n • c) = f 0 :=
(h.zsmul n).eq

lemma periodic.int_mul_eq [ring α]
  (h : periodic f c) (n : ℤ) :
  f (n * c) = f 0 :=
(h.int_mul n).eq

/-- If a function `f` is `periodic` with positive period `c`, then for all `x` there exists some
  `y ∈ Ico 0 c` such that `f x = f y`. -/
lemma periodic.exists_mem_Ico₀ [linear_ordered_add_comm_group α] [archimedean α]
  (h : periodic f c) (hc : 0 < c) (x) :
  ∃ y ∈ set.Ico 0 c, f x = f y :=
let ⟨n, H, _⟩ := exists_unique_zsmul_near_of_pos' hc x in
⟨x - n • c, H, (h.sub_zsmul_eq n).symm⟩

/-- If a function `f` is `periodic` with positive period `c`, then for all `x` there exists some
  `y ∈ Ico a (a + c)` such that `f x = f y`. -/
lemma periodic.exists_mem_Ico [linear_ordered_add_comm_group α] [archimedean α]
  (h : periodic f c) (hc : 0 < c) (x a) :
  ∃ y ∈ set.Ico a (a + c), f x = f y :=
let ⟨n, H, _⟩ := exists_unique_add_zsmul_mem_Ico hc x a in
⟨x + n • c, H, (h.zsmul n x).symm⟩

/-- If a function `f` is `periodic` with positive period `c`, then for all `x` there exists some
  `y ∈ Ioc a (a + c)` such that `f x = f y`. -/
lemma periodic.exists_mem_Ioc [linear_ordered_add_comm_group α] [archimedean α]
  (h : periodic f c) (hc : 0 < c) (x a) :
  ∃ y ∈ set.Ioc a (a + c), f x = f y :=
let ⟨n, H, _⟩ := exists_unique_add_zsmul_mem_Ioc hc x a in
⟨x + n • c, H, (h.zsmul n x).symm⟩

lemma periodic.image_Ioc [linear_ordered_add_comm_group α] [archimedean α]
  (h : periodic f c) (hc : 0 < c) (a : α) :
  f '' set.Ioc a (a + c) = set.range f :=
(set.image_subset_range _ _).antisymm $ set.range_subset_iff.2 $ λ x,
  let ⟨y, hy, hyx⟩ := h.exists_mem_Ioc hc x a in ⟨y, hy, hyx.symm⟩

lemma periodic_with_period_zero [add_zero_class α]
  (f : α → β) :
  periodic f 0 :=
λ x, by rw add_zero

lemma periodic.map_vadd_zmultiples [add_comm_group α] (hf : periodic f c)
  (a : add_subgroup.zmultiples c) (x : α) :
  f (a +ᵥ x) = f x :=
by { rcases a with ⟨_, m, rfl⟩, simp [add_subgroup.vadd_def, add_comm _ x, hf.zsmul m x] }

lemma periodic.map_vadd_multiples [add_comm_monoid α] (hf : periodic f c)
  (a : add_submonoid.multiples c) (x : α) :
  f (a +ᵥ x) = f x :=
by { rcases a with ⟨_, m, rfl⟩, simp [add_submonoid.vadd_def, add_comm _ x, hf.nsmul m x] }

/-- Lift a periodic function to a function from the quotient group. -/
def periodic.lift [add_group α] (h : periodic f c) (x : α ⧸ add_subgroup.zmultiples c) : β :=
quotient.lift_on' x f $
  λ a b ⟨k, hk⟩, (h.zsmul k _).symm.trans $ congr_arg f $ add_eq_of_eq_neg_add hk

@[simp] lemma periodic.lift_coe [add_group α] (h : periodic f c) (a : α) :
  h.lift (a : α ⧸ add_subgroup.zmultiples c) = f a :=
rfl

/-! ### Antiperiodicity -/

/-- A function `f` is said to be `antiperiodic` with antiperiod `c` if for all `x`,
  `f (x + c) = -f x`. -/
@[simp] def antiperiodic [has_add α] [has_neg β] (f : α → β) (c : α) : Prop :=
∀ x : α, f (x + c) = -f x

lemma antiperiodic.funext [has_add α] [has_neg β]
  (h : antiperiodic f c) :
  (λ x, f (x + c)) = -f :=
funext h

lemma antiperiodic.funext' [has_add α] [add_group β]
  (h : antiperiodic f c) :
  (λ x, -f (x + c)) = f :=
(eq_neg_iff_eq_neg.mp h.funext).symm

/-- If a function is `antiperiodic` with antiperiod `c`, then it is also `periodic` with period
  `2 * c`. -/
lemma antiperiodic.periodic [semiring α] [add_group β]
  (h : antiperiodic f c) :
  periodic f (2 * c) :=
by simp [two_mul, ← add_assoc, h _]

lemma antiperiodic.eq [add_zero_class α] [has_neg β]
  (h : antiperiodic f c) : f c = -f 0 :=
by simpa only [zero_add] using h 0

lemma antiperiodic.nat_even_mul_periodic [semiring α] [add_group β]
  (h : antiperiodic f c) (n : ℕ) :
  periodic f (n * (2 * c)) :=
h.periodic.nat_mul n

lemma antiperiodic.nat_odd_mul_antiperiodic [semiring α] [add_group β]
  (h : antiperiodic f c) (n : ℕ) :
  antiperiodic f (n * (2 * c) + c) :=
λ x, by rw [← add_assoc, h, h.periodic.nat_mul]

lemma antiperiodic.int_even_mul_periodic [ring α] [add_group β]
  (h : antiperiodic f c) (n : ℤ) :
  periodic f (n * (2 * c)) :=
h.periodic.int_mul n

lemma antiperiodic.int_odd_mul_antiperiodic [ring α] [add_group β]
  (h : antiperiodic f c) (n : ℤ) :
  antiperiodic f (n * (2 * c) + c) :=
λ x, by rw [← add_assoc, h, h.periodic.int_mul]

lemma antiperiodic.nat_mul_eq_of_eq_zero [comm_semiring α] [add_group β]
  (h : antiperiodic f c) (hi : f 0 = 0) (n : ℕ) :
  f (n * c) = 0 :=
begin
  rcases nat.even_or_odd n with ⟨k, rfl⟩ | ⟨k, rfl⟩;
  have hk : (k : α) * (2 * c) = 2 * k * c := by rw [mul_left_comm, ← mul_assoc],
  { simpa [← two_mul, hk, hi] using (h.nat_even_mul_periodic k).eq },
  { simpa [add_mul, hk, hi] using (h.nat_odd_mul_antiperiodic k).eq },
end

lemma antiperiodic.int_mul_eq_of_eq_zero [comm_ring α] [add_group β]
  (h : antiperiodic f c) (hi : f 0 = 0) (n : ℤ) :
  f (n * c) = 0 :=
begin
  rcases int.even_or_odd n with ⟨k, rfl⟩ | ⟨k, rfl⟩;
  have hk : (k : α) * (2 * c) = 2 * k * c := by rw [mul_left_comm, ← mul_assoc],
  { simpa [← two_mul, hk, hi] using (h.int_even_mul_periodic k).eq },
  { simpa [add_mul, hk, hi] using (h.int_odd_mul_antiperiodic k).eq },
end

lemma antiperiodic.sub_eq [add_group α] [add_group β]
  (h : antiperiodic f c) (x : α) :
  f (x - c) = -f x :=
by simp only [eq_neg_iff_eq_neg.mp (h (x - c)), sub_add_cancel]

lemma antiperiodic.sub_eq' [add_comm_group α] [add_group β]
  (h : antiperiodic f c) :
  f (c - x) = -f (-x) :=
by simpa only [sub_eq_neg_add] using h (-x)

lemma antiperiodic.neg [add_group α] [add_group β]
  (h : antiperiodic f c) :
  antiperiodic f (-c) :=
by simpa only [sub_eq_add_neg, antiperiodic] using h.sub_eq

lemma antiperiodic.neg_eq [add_group α] [add_group β]
  (h : antiperiodic f c) :
  f (-c) = -f 0 :=
by simpa only [zero_add] using h.neg 0

lemma antiperiodic.smul [has_add α] [monoid γ] [add_group β] [distrib_mul_action γ β]
  (h : antiperiodic f c) (a : γ) :
  antiperiodic (a • f) c :=
by simp * at *

lemma antiperiodic.const_smul [add_monoid α] [has_neg β] [group γ] [distrib_mul_action γ α]
  (h : antiperiodic f c) (a : γ) :
  antiperiodic (λ x, f (a • x)) (a⁻¹ • c) :=
λ x, by simpa only [smul_add, smul_inv_smul] using h (a • x)

lemma antiperiodic.const_smul₀ [add_comm_monoid α] [has_neg β] [division_ring γ] [module γ α]
  (h : antiperiodic f c) {a : γ} (ha : a ≠ 0) :
  antiperiodic (λ x, f (a • x)) (a⁻¹ • c) :=
λ x, by simpa only [smul_add, smul_inv_smul₀ ha] using h (a • x)

lemma antiperiodic.const_mul [division_ring α] [has_neg β]
  (h : antiperiodic f c) {a : α} (ha : a ≠ 0) :
  antiperiodic (λ x, f (a * x)) (a⁻¹ * c) :=
h.const_smul₀ ha

lemma antiperiodic.const_inv_smul [add_monoid α] [has_neg β] [group γ] [distrib_mul_action γ α]
  (h : antiperiodic f c) (a : γ) :
  antiperiodic (λ x, f (a⁻¹ • x)) (a • c) :=
by simpa only [inv_inv] using h.const_smul a⁻¹

lemma antiperiodic.const_inv_smul₀ [add_comm_monoid α] [has_neg β] [division_ring γ] [module γ α]
  (h : antiperiodic f c) {a : γ} (ha : a ≠ 0) :
  antiperiodic (λ x, f (a⁻¹ • x)) (a • c) :=
by simpa only [inv_inv] using h.const_smul₀ (inv_ne_zero ha)

lemma antiperiodic.const_inv_mul [division_ring α] [has_neg β]
  (h : antiperiodic f c) {a : α} (ha : a ≠ 0) :
  antiperiodic (λ x, f (a⁻¹ * x)) (a * c) :=
h.const_inv_smul₀ ha

lemma antiperiodic.mul_const [division_ring α] [has_neg β]
  (h : antiperiodic f c) {a : α} (ha : a ≠ 0) :
  antiperiodic (λ x, f (x * a)) (c * a⁻¹) :=
h.const_smul₀ $ (mul_opposite.op_ne_zero_iff a).mpr ha

lemma antiperiodic.mul_const' [division_ring α] [has_neg β]
  (h : antiperiodic f c) {a : α} (ha : a ≠ 0) :
  antiperiodic (λ x, f (x * a)) (c / a) :=
by simpa only [div_eq_mul_inv] using h.mul_const ha

lemma antiperiodic.mul_const_inv [division_ring α] [has_neg β]
  (h : antiperiodic f c) {a : α} (ha : a ≠ 0) :
  antiperiodic (λ x, f (x * a⁻¹)) (c * a) :=
h.const_inv_smul₀ $ (mul_opposite.op_ne_zero_iff a).mpr ha

lemma antiperiodic.div_inv [division_ring α] [has_neg β]
  (h : antiperiodic f c) {a : α} (ha : a ≠ 0) :
  antiperiodic (λ x, f (x / a)) (c * a) :=
by simpa only [div_eq_mul_inv] using h.mul_const_inv ha

lemma antiperiodic.add [add_group α] [add_group β]
  (h1 : antiperiodic f c₁) (h2 : antiperiodic f c₂) :
  periodic f (c₁ + c₂) :=
by simp [*, ← add_assoc] at *

lemma antiperiodic.sub [add_comm_group α] [add_group β]
  (h1 : antiperiodic f c₁) (h2 : antiperiodic f c₂) :
  periodic f (c₁ - c₂) :=
let h := h2.neg in by simp [*, sub_eq_add_neg, add_comm c₁, ← add_assoc] at *

lemma periodic.add_antiperiod [add_group α] [add_group β]
  (h1 : periodic f c₁) (h2 : antiperiodic f c₂) :
  antiperiodic f (c₁ + c₂) :=
by simp [*, ← add_assoc] at *

lemma periodic.sub_antiperiod [add_comm_group α] [add_group β]
  (h1 : periodic f c₁) (h2 : antiperiodic f c₂) :
  antiperiodic f (c₁ - c₂) :=
let h := h2.neg in by simp [*, sub_eq_add_neg, add_comm c₁, ← add_assoc] at *

lemma periodic.add_antiperiod_eq [add_group α] [add_group β]
  (h1 : periodic f c₁) (h2 : antiperiodic f c₂) :
  f (c₁ + c₂) = -f 0 :=
(h1.add_antiperiod h2).eq

lemma periodic.sub_antiperiod_eq [add_comm_group α] [add_group β]
  (h1 : periodic f c₁) (h2 : antiperiodic f c₂) :
  f (c₁ - c₂) = -f 0 :=
(h1.sub_antiperiod h2).eq

lemma antiperiodic.mul [has_add α] [ring β]
  (hf : antiperiodic f c) (hg : antiperiodic g c) :
  periodic (f * g) c :=
by simp * at *

lemma antiperiodic.div [has_add α] [division_ring β]
  (hf : antiperiodic f c) (hg : antiperiodic g c) :
  periodic (f / g) c :=
by simp [*, neg_div_neg_eq] at *

end function


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Module.basic
import category_theory.linear
import category_theory.preadditive.additive_functor
import category_theory.preadditive.yoneda

/-!
# The Yoneda embedding for `R`-linear categories

The Yoneda embedding for `R`-linear categories `C`,
sends an object `X : C` to the `Module R`-valued presheaf on `C`,
with value on `Y : Cᵒᵖ` given by `Module.of R (unop Y ⟶ X)`.

TODO: `linear_yoneda R C` is `R`-linear.
TODO: In fact, `linear_yoneda` itself is additive and `R`-linear.
-/

universes w v u

open opposite

namespace category_theory

variables (R : Type w) [ring R] (C : Type u) [category.{v} C] [preadditive C] [linear R C]

/-- The Yoneda embedding for `R`-linear categories `C`,
sending an object `X : C` to the `Module R`-valued presheaf on `C`,
with value on `Y : Cᵒᵖ` given by `Module.of R (unop Y ⟶ X)`. -/
@[simps]
def linear_yoneda : C ⥤ Cᵒᵖ ⥤ Module R :=
{ obj := λ X,
  { obj := λ Y, Module.of R (unop Y ⟶ X),
    map := λ Y Y' f, linear.left_comp R _ f.unop,
    map_comp' := λ _ _ _ f g, begin ext, dsimp, erw [category.assoc] end,
    map_id' := λ Y, begin ext, dsimp, erw [category.id_comp] end },
  map := λ X X' f, { app := λ Y, linear.right_comp R _ f },
  map_id' := λ X, by { ext, simp }, -- `obviously` provides these, but slowly
  map_comp' := λ _ _ _ f g, by { ext, simp } }

/-- The Yoneda embedding for `R`-linear categories `C`,
sending an object `Y : Cᵒᵖ` to the `Module R`-valued copresheaf on `C`,
with value on `X : C` given by `Module.of R (unop Y ⟶ X)`. -/
@[simps]
def linear_coyoneda : Cᵒᵖ ⥤ C ⥤ Module R :=
{ obj := λ Y,
  { obj := λ X, Module.of R (unop Y ⟶ X),
    map := λ Y Y', linear.right_comp _ _,
    map_id' := λ Y, by { ext, exact category.comp_id _ },
    map_comp' := λ _ _ _ f g, by { ext, exact eq.symm (category.assoc _ _ _) } },
  map := λ Y Y' f, { app := λ X, linear.left_comp _ _ f.unop },
  map_id' := λ X, by { ext, simp }, -- `obviously` provides these, but slowly
  map_comp' := λ _ _ _ f g, by { ext, simp } }

instance linear_yoneda_obj_additive (X : C) : ((linear_yoneda R C).obj X).additive := {}
instance linear_coyoneda_obj_additive (Y : Cᵒᵖ) : ((linear_coyoneda R C).obj Y).additive := {}

@[simp] lemma whiskering_linear_yoneda : linear_yoneda R C ⋙
  (whiskering_right _ _ _).obj (forget (Module.{v} R)) = yoneda :=
rfl

@[simp] lemma whiskering_linear_yoneda₂ : linear_yoneda R C ⋙
  (whiskering_right _ _ _).obj (forget₂ (Module.{v} R) AddCommGroup.{v}) = preadditive_yoneda :=
rfl

@[simp] lemma whiskering_linear_coyoneda : linear_coyoneda R C ⋙
  (whiskering_right _ _ _).obj (forget (Module.{v} R)) = coyoneda :=
rfl

@[simp] lemma whiskering_linear_coyoneda₂ : linear_coyoneda R C ⋙
  (whiskering_right _ _ _).obj (forget₂ (Module.{v} R) AddCommGroup.{v}) = preadditive_coyoneda :=
rfl

instance linear_yoneda_full : full (linear_yoneda R C) :=
let yoneda_full : full (linear_yoneda R C ⋙
  (whiskering_right _ _ _).obj (forget (Module.{v} R))) := yoneda.yoneda_full in
by exactI full.of_comp_faithful (linear_yoneda R C)
  (((whiskering_right _ _ _)).obj (forget (Module.{v} R)))

instance linear_coyoneda_full : full (linear_coyoneda R C) :=
let coyoneda_full : full (linear_coyoneda R C ⋙
  (whiskering_right _ _ _).obj (forget (Module.{v} R))) := coyoneda.coyoneda_full in
by exactI full.of_comp_faithful (linear_coyoneda R C)
  (((whiskering_right _ _ _)).obj (forget (Module.{v} R)))

instance linear_yoneda_faithful : faithful (linear_yoneda R C) :=
faithful.of_comp_eq (whiskering_linear_yoneda R C)

instance linear_coyoneda_faithful : faithful (linear_coyoneda R C) :=
faithful.of_comp_eq (whiskering_linear_coyoneda R C)

end category_theory


/-
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, Mario Carneiro
-/

import algebra.indicator_function
import data.equiv.fin
import data.tprod
import group_theory.coset
import measure_theory.measurable_space_def
import measure_theory.tactic
import order.filter.lift

/-!
# Measurable spaces and measurable functions

This file provides properties of measurable spaces and the functions and isomorphisms
between them. The definition of a measurable space is in `measure_theory.measurable_space_def`.

A measurable space is a set equipped with a σ-algebra, a collection of
subsets closed under complementation and countable union. A function
between measurable spaces is measurable if the preimage of each
measurable subset is measurable.

σ-algebras on a fixed set `α` form a complete lattice. Here we order
σ-algebras by writing `m₁ ≤ m₂` if every set which is `m₁`-measurable is
also `m₂`-measurable (that is, `m₁` is a subset of `m₂`). In particular, any
collection of subsets of `α` generates a smallest σ-algebra which
contains all of them. A function `f : α → β` induces a Galois connection
between the lattices of σ-algebras on `α` and `β`.

A measurable equivalence between measurable spaces is an equivalence
which respects the σ-algebras, that is, for which both directions of
the equivalence are measurable functions.

We say that a filter `f` is measurably generated if every set `s ∈ f` includes a measurable
set `t ∈ f`. This property is useful, e.g., to extract a measurable witness of `filter.eventually`.

## Notation

* We write `α ≃ᵐ β` for measurable equivalences between the measurable spaces `α` and `β`.
  This should not be confused with `≃ₘ` which is used for diffeomorphisms between manifolds.

## Implementation notes

Measurability of a function `f : α → β` between measurable spaces is
defined in terms of the Galois connection induced by f.

## References

* <https://en.wikipedia.org/wiki/Measurable_space>
* <https://en.wikipedia.org/wiki/Sigma-algebra>
* <https://en.wikipedia.org/wiki/Dynkin_system>

## Tags

measurable space, σ-algebra, measurable function, measurable equivalence, dynkin system,
π-λ theorem, π-system
-/

open set encodable function equiv
open_locale classical filter

variables {α β γ δ δ' : Type*} {ι : Sort*} {s t u : set α}

namespace measurable_space

section functors
variables {m m₁ m₂ : measurable_space α} {m' : measurable_space β} {f : α → β} {g : β → α}

/-- The forward image of a measurable space under a function. `map f m` contains the sets
  `s : set β` whose preimage under `f` is measurable. -/
protected def map (f : α → β) (m : measurable_space α) : measurable_space β :=
{ measurable_set'      := λ s, m.measurable_set' $ f ⁻¹' s,
  measurable_set_empty := m.measurable_set_empty,
  measurable_set_compl := assume s hs, m.measurable_set_compl _ hs,
  measurable_set_Union := assume f hf, by { rw preimage_Union, exact m.measurable_set_Union _ hf }}

@[simp] lemma map_id : m.map id = m :=
measurable_space.ext $ assume s, iff.rfl

@[simp] lemma map_comp {f : α → β} {g : β → γ} : (m.map f).map g = m.map (g ∘ f) :=
measurable_space.ext $ assume s, iff.rfl

/-- The reverse image of a measurable space under a function. `comap f m` contains the sets
  `s : set α` such that `s` is the `f`-preimage of a measurable set in `β`. -/
protected def comap (f : α → β) (m : measurable_space β) : measurable_space α :=
{ measurable_set'      := λ s, ∃s', m.measurable_set' s' ∧ f ⁻¹' s' = s,
  measurable_set_empty := ⟨∅, m.measurable_set_empty, rfl⟩,
  measurable_set_compl := assume s ⟨s', h₁, h₂⟩, ⟨s'ᶜ, m.measurable_set_compl _ h₁, h₂ ▸ rfl⟩,
  measurable_set_Union := assume s hs,
    let ⟨s', hs'⟩ := classical.axiom_of_choice hs in
    ⟨⋃ i, s' i, m.measurable_set_Union _ (λ i, (hs' i).left), by simp [hs'] ⟩ }

@[simp] lemma comap_id : m.comap id = m :=
measurable_space.ext $ assume s, ⟨assume ⟨s', hs', h⟩, h ▸ hs', assume h, ⟨s, h, rfl⟩⟩

@[simp] lemma comap_comp {f : β → α} {g : γ → β} : (m.comap f).comap g = m.comap (f ∘ g) :=
measurable_space.ext $ assume s,
  ⟨assume ⟨t, ⟨u, h, hu⟩, ht⟩, ⟨u, h, ht ▸ hu ▸ rfl⟩, assume ⟨t, h, ht⟩, ⟨f ⁻¹' t, ⟨_, h, rfl⟩, ht⟩⟩

lemma comap_le_iff_le_map {f : α → β} : m'.comap f ≤ m ↔ m' ≤ m.map f :=
⟨assume h s hs, h _ ⟨_, hs, rfl⟩, assume h s ⟨t, ht, heq⟩, heq ▸ h _ ht⟩

lemma gc_comap_map (f : α → β) :
  galois_connection (measurable_space.comap f) (measurable_space.map f) :=
assume f g, comap_le_iff_le_map

lemma map_mono (h : m₁ ≤ m₂) : m₁.map f ≤ m₂.map f := (gc_comap_map f).monotone_u h
lemma monotone_map : monotone (measurable_space.map f) := assume a b h, map_mono h
lemma comap_mono (h : m₁ ≤ m₂) : m₁.comap g ≤ m₂.comap g := (gc_comap_map g).monotone_l h
lemma monotone_comap : monotone (measurable_space.comap g) := assume a b h, comap_mono h

@[simp] lemma comap_bot : (⊥ : measurable_space α).comap g = ⊥ := (gc_comap_map g).l_bot
@[simp] lemma comap_sup : (m₁ ⊔ m₂).comap g = m₁.comap g ⊔ m₂.comap g := (gc_comap_map g).l_sup
@[simp] lemma comap_supr {m : ι → measurable_space α} : (⨆i, m i).comap g = (⨆i, (m i).comap g) :=
(gc_comap_map g).l_supr

@[simp] lemma map_top : (⊤ : measurable_space α).map f = ⊤ := (gc_comap_map f).u_top
@[simp] lemma map_inf : (m₁ ⊓ m₂).map f = m₁.map f ⊓ m₂.map f := (gc_comap_map f).u_inf
@[simp] lemma map_infi {m : ι → measurable_space α} : (⨅i, m i).map f = (⨅i, (m i).map f) :=
(gc_comap_map f).u_infi

lemma comap_map_le : (m.map f).comap f ≤ m := (gc_comap_map f).l_u_le _
lemma le_map_comap : m ≤ (m.comap g).map g := (gc_comap_map g).le_u_l _

end functors

@[mono] lemma generate_from_mono {s t : set (set α)} (h : s ⊆ t) :
  generate_from s ≤ generate_from t :=
gi_generate_from.gc.monotone_l h

lemma generate_from_sup_generate_from {s t : set (set α)} :
  generate_from s ⊔ generate_from t = generate_from (s ∪ t) :=
(@gi_generate_from α).gc.l_sup.symm

lemma comap_generate_from {f : α → β} {s : set (set β)} :
  (generate_from s).comap f = generate_from (preimage f '' s) :=
le_antisymm
  (comap_le_iff_le_map.2 $ generate_from_le $ assume t hts,
    generate_measurable.basic _ $ mem_image_of_mem _ $ hts)
  (generate_from_le $ assume t ⟨u, hu, eq⟩, eq ▸ ⟨u, generate_measurable.basic _ hu, rfl⟩)

end measurable_space

section measurable_functions
open measurable_space

lemma measurable_iff_le_map {m₁ : measurable_space α} {m₂ : measurable_space β} {f : α → β} :
  measurable f ↔ m₂ ≤ m₁.map f :=
iff.rfl

alias measurable_iff_le_map ↔ measurable.le_map measurable.of_le_map

lemma measurable_iff_comap_le {m₁ : measurable_space α} {m₂ : measurable_space β} {f : α → β} :
  measurable f ↔ m₂.comap f ≤ m₁ :=
comap_le_iff_le_map.symm

alias measurable_iff_comap_le ↔ measurable.comap_le measurable.of_comap_le

lemma measurable.mono {ma ma' : measurable_space α} {mb mb' : measurable_space β} {f : α → β}
  (hf : @measurable α β ma mb f) (ha : ma ≤ ma') (hb : mb' ≤ mb) :
  @measurable α β ma' mb' f :=
λ t ht, ha _ $ hf $ hb _ ht

@[measurability]
lemma measurable_from_top [measurable_space β] {f : α → β} : @measurable _ _ ⊤ _ f :=
λ s hs, trivial

lemma measurable_generate_from [measurable_space α] {s : set (set β)} {f : α → β}
  (h : ∀ t ∈ s, measurable_set (f ⁻¹' t)) : @measurable _ _ _ (generate_from s) f :=
measurable.of_le_map $ generate_from_le h

variables [measurable_space α] [measurable_space β] [measurable_space γ]

@[measurability]
lemma measurable_set_preimage {f : α → β} {t : set β} (hf : measurable f) (ht : measurable_set t) :
  measurable_set (f ⁻¹' t) :=
hf ht

@[measurability] lemma measurable.iterate {f : α → α} (hf : measurable f) : ∀ n, measurable (f^[n])
| 0 := measurable_id
| (n+1) := (measurable.iterate n).comp hf

@[nontriviality, measurability]
lemma subsingleton.measurable [subsingleton α] {f : α → β} : measurable f :=
λ s hs, @subsingleton.measurable_set α _ _ _

@[nontriviality, measurability]
lemma measurable_of_subsingleton_codomain [subsingleton β] (f : α → β) : measurable f :=
λ s hs, subsingleton.set_cases measurable_set.empty measurable_set.univ s

@[measurability]
lemma measurable.piecewise {s : set α} {_ : decidable_pred (∈ s)} {f g : α → β}
  (hs : measurable_set s) (hf : measurable f) (hg : measurable g) :
  measurable (piecewise s f g) :=
begin
  intros t ht,
  rw piecewise_preimage,
  exact hs.ite (hf ht) (hg ht)
end

/-- this is slightly different from `measurable.piecewise`. It can be used to show
`measurable (ite (x=0) 0 1)` by
`exact measurable.ite (measurable_set_singleton 0) measurable_const measurable_const`,
but replacing `measurable.ite` by `measurable.piecewise` in that example proof does not work. -/
lemma measurable.ite {p : α → Prop} {_ : decidable_pred p} {f g : α → β}
  (hp : measurable_set {a : α | p a}) (hf : measurable f) (hg : measurable g) :
  measurable (λ x, ite (p x) (f x) (g x)) :=
measurable.piecewise hp hf hg

@[measurability]
lemma measurable.indicator [has_zero β] {s : set α} {f : α → β}
  (hf : measurable f) (hs : measurable_set s) : measurable (s.indicator f) :=
hf.piecewise hs measurable_const

@[to_additive]
lemma measurable_one [has_one α] : measurable (1 : β → α) := @measurable_const _ _ _ _ 1

lemma measurable_of_empty [is_empty α] (f : α → β) : measurable f :=
subsingleton.measurable

lemma measurable_of_empty_codomain [is_empty β] (f : α → β) : measurable f :=
by { haveI := function.is_empty f, exact measurable_of_empty f }

/-- A version of `measurable_const` that assumes `f x = f y` for all `x, y`. This version works
for functions between empty types. -/
lemma measurable_const' {f : β → α} (hf : ∀ x y, f x = f y) : measurable f :=
begin
  casesI is_empty_or_nonempty β,
  { exact measurable_of_empty f },
  { convert measurable_const, exact funext (λ x, hf x h.some) }
end

@[to_additive, measurability] lemma measurable_set_mul_support [has_one β]
  [measurable_singleton_class β] {f : α → β} (hf : measurable f) :
  measurable_set (mul_support f) :=
hf (measurable_set_singleton 1).compl

attribute [measurability] measurable_set_support

/-- If a function coincides with a measurable function outside of a countable set, it is
measurable. -/
lemma measurable.measurable_of_countable_ne [measurable_singleton_class α]
  {f g : α → β} (hf : measurable f) (h : countable {x | f x ≠ g x}) : measurable g :=
begin
  assume t ht,
  have : g ⁻¹' t = (g ⁻¹' t ∩ {x | f x = g x}ᶜ) ∪ (g ⁻¹' t ∩ {x | f x = g x}),
    by simp [← inter_union_distrib_left],
  rw this,
  apply measurable_set.union (h.mono (inter_subset_right _ _)).measurable_set,
  have : g ⁻¹' t ∩ {x : α | f x = g x} = f ⁻¹' t ∩ {x : α | f x = g x},
    by { ext x, simp {contextual := tt} },
  rw this,
  exact (hf ht).inter h.measurable_set.of_compl,
end

lemma measurable_of_fintype [fintype α] [measurable_singleton_class α] (f : α → β) :
  measurable f :=
λ s hs, (finite.of_fintype (f ⁻¹' s)).measurable_set

end measurable_functions

section constructions

variables [measurable_space α] [measurable_space β] [measurable_space γ]

instance : measurable_space empty := ⊤
instance : measurable_space punit := ⊤ -- this also works for `unit`
instance : measurable_space bool := ⊤
instance : measurable_space ℕ := ⊤
instance : measurable_space ℤ := ⊤
instance : measurable_space ℚ := ⊤

lemma measurable_to_encodable [encodable α] {f : β → α} (h : ∀ y, measurable_set (f ⁻¹' {f y})) :
  measurable f :=
begin
  assume s hs,
  rw [← bUnion_preimage_singleton],
  refine measurable_set.Union (λ y, measurable_set.Union_Prop $ λ hy, _),
  by_cases hyf : y ∈ range f,
  { rcases hyf with ⟨y, rfl⟩,
    apply h },
  { simp only [preimage_singleton_eq_empty.2 hyf, measurable_set.empty] }
end

@[measurability] lemma measurable_unit (f : unit → α) : measurable f :=
measurable_from_top

section nat

@[measurability] lemma measurable_from_nat {f : ℕ → α} : measurable f :=
measurable_from_top

lemma measurable_to_nat {f : α → ℕ} : (∀ y, measurable_set (f ⁻¹' {f y})) → measurable f :=
measurable_to_encodable

lemma measurable_find_greatest' {p : α → ℕ → Prop}
  {N : ℕ} (hN : ∀ k ≤ N, measurable_set {x | nat.find_greatest (p x) N = k}) :
  measurable (λ x, nat.find_greatest (p x) N) :=
measurable_to_nat $ λ x, hN _ N.find_greatest_le

lemma measurable_find_greatest {p : α → ℕ → Prop} {N} (hN : ∀ k ≤ N, measurable_set {x | p x k}) :
  measurable (λ x, nat.find_greatest (p x) N) :=
begin
  refine measurable_find_greatest' (λ k hk, _),
  simp only [nat.find_greatest_eq_iff, set_of_and, set_of_forall, ← compl_set_of],
  repeat { apply_rules [measurable_set.inter, measurable_set.const, measurable_set.Inter,
    measurable_set.Inter_Prop, measurable_set.compl, hN]; try { intros } }
end

lemma measurable_find {p : α → ℕ → Prop} (hp : ∀ x, ∃ N, p x N)
  (hm : ∀ k, measurable_set {x | p x k}) :
  measurable (λ x, nat.find (hp x)) :=
begin
  refine measurable_to_nat (λ x, _),
  rw [preimage_find_eq_disjointed],
  exact measurable_set.disjointed hm _
end

end nat

section quotient

instance {α} {r : α → α → Prop} [m : measurable_space α] : measurable_space (quot r) :=
m.map (quot.mk r)

instance {α} {s : setoid α} [m : measurable_space α] : measurable_space (quotient s) :=
m.map quotient.mk'

@[to_additive]
instance _root_.quotient_group.measurable_space {G} [group G] [measurable_space G]
  (S : subgroup G) : measurable_space (G ⧸ S) :=
quotient.measurable_space

lemma measurable_set_quotient {s : setoid α} {t : set (quotient s)} :
  measurable_set t ↔ measurable_set (quotient.mk' ⁻¹' t) :=
iff.rfl

lemma measurable_from_quotient {s : setoid α} {f : quotient s → β} :
  measurable f ↔ measurable (f ∘ quotient.mk') :=
iff.rfl

@[measurability] lemma measurable_quotient_mk [s : setoid α] :
  measurable (quotient.mk : α → quotient s) :=
λ s, id

@[measurability] lemma measurable_quotient_mk' {s : setoid α} :
  measurable (quotient.mk' : α → quotient s) :=
λ s, id

@[measurability] lemma measurable_quot_mk {r : α → α → Prop} :
  measurable (quot.mk r) :=
λ s, id

@[to_additive] lemma quotient_group.measurable_coe {G} [group G] [measurable_space G]
  {S : subgroup G} : measurable (coe : G → G ⧸ S) :=
measurable_quotient_mk'

attribute [measurability] quotient_group.measurable_coe quotient_add_group.measurable_coe

@[to_additive] lemma quotient_group.measurable_from_quotient {G} [group G] [measurable_space G]
  {S : subgroup G} {f : G ⧸ S → α} :
  measurable f ↔ measurable (f ∘ (coe : G → G ⧸ S)) :=
measurable_from_quotient

end quotient

section subtype

instance {α} {p : α → Prop} [m : measurable_space α] : measurable_space (subtype p) :=
m.comap (coe : _ → α)

@[measurability] lemma measurable_subtype_coe {p : α → Prop} : measurable (coe : subtype p → α) :=
measurable_space.le_map_comap

@[measurability] lemma measurable.subtype_coe {p : β → Prop} {f : α → subtype p}
  (hf : measurable f) :
  measurable (λ a : α, (f a : β)) :=
measurable_subtype_coe.comp hf

@[measurability]
lemma measurable.subtype_mk {p : β → Prop} {f : α → β} (hf : measurable f) {h : ∀ x, p (f x)} :
  measurable (λ x, (⟨f x, h x⟩ : subtype p)) :=
λ t ⟨s, hs⟩, hs.2 ▸ by simp only [← preimage_comp, (∘), subtype.coe_mk, hf hs.1]

lemma measurable_set.subtype_image {s : set α} {t : set s}
  (hs : measurable_set s) : measurable_set t → measurable_set ((coe : s → α) '' t)
| ⟨u, (hu : measurable_set u), (eq : coe ⁻¹' u = t)⟩ :=
  begin
    rw [← eq, subtype.image_preimage_coe],
    exact hu.inter hs
  end

lemma measurable_of_measurable_union_cover
  {f : α → β} (s t : set α) (hs : measurable_set s) (ht : measurable_set t) (h : univ ⊆ s ∪ t)
  (hc : measurable (λ a : s, f a)) (hd : measurable (λ a : t, f a)) :
  measurable f :=
begin
  intros u hu,
  convert (hs.subtype_image (hc hu)).union (ht.subtype_image (hd hu)),
  change f ⁻¹' u = coe '' (coe ⁻¹' (f ⁻¹' u) : set s) ∪ coe '' (coe ⁻¹' (f ⁻¹' u) : set t),
  rw [image_preimage_eq_inter_range, image_preimage_eq_inter_range, subtype.range_coe,
      subtype.range_coe, ← inter_distrib_left, univ_subset_iff.1 h, inter_univ],
end

lemma measurable_of_restrict_of_restrict_compl {f : α → β} {s : set α}
  (hs : measurable_set s) (h₁ : measurable (restrict f s)) (h₂ : measurable (restrict f sᶜ)) :
  measurable f :=
measurable_of_measurable_union_cover s sᶜ hs hs.compl (union_compl_self s).ge h₁ h₂

lemma measurable.dite [∀ x, decidable (x ∈ s)] {f : s → β} (hf : measurable f)
  {g : sᶜ → β} (hg : measurable g) (hs : measurable_set s) :
  measurable (λ x, if hx : x ∈ s then f ⟨x, hx⟩ else g ⟨x, hx⟩) :=
measurable_of_restrict_of_restrict_compl hs (by simpa) (by simpa)

instance {α} {p : α → Prop} [measurable_space α] [measurable_singleton_class α] :
  measurable_singleton_class (subtype p) :=
{ measurable_set_singleton := λ x,
  begin
    have : measurable_set {(x : α)} := measurable_set_singleton _,
    convert @measurable_subtype_coe α _ p _ this,
    ext y,
    simp [subtype.ext_iff],
  end }

lemma measurable_of_measurable_on_compl_finite [measurable_singleton_class α]
  {f : α → β} (s : set α) (hs : finite s) (hf : measurable (set.restrict f sᶜ)) :
  measurable f :=
begin
  letI : fintype s := finite.fintype hs,
  exact measurable_of_restrict_of_restrict_compl hs.measurable_set
    (measurable_of_fintype _) hf
end

lemma measurable_of_measurable_on_compl_singleton [measurable_singleton_class α]
  {f : α → β} (a : α) (hf : measurable (set.restrict f {x | x ≠ a})) :
  measurable f :=
measurable_of_measurable_on_compl_finite {a} (finite_singleton a) hf

end subtype

section prod

instance {α β} [m₁ : measurable_space α] [m₂ : measurable_space β] : measurable_space (α × β) :=
m₁.comap prod.fst ⊔ m₂.comap prod.snd

@[measurability] lemma measurable_fst : measurable (prod.fst : α × β → α) :=
measurable.of_comap_le le_sup_left

lemma measurable.fst {f : α → β × γ} (hf : measurable f) :
  measurable (λ a : α, (f a).1) :=
measurable_fst.comp hf

@[measurability] lemma measurable_snd : measurable (prod.snd : α × β → β) :=
measurable.of_comap_le le_sup_right

lemma measurable.snd {f : α → β × γ} (hf : measurable f) :
  measurable (λ a : α, (f a).2) :=
measurable_snd.comp hf

@[measurability] lemma measurable.prod {f : α → β × γ}
  (hf₁ : measurable (λ a, (f a).1)) (hf₂ : measurable (λ a, (f a).2)) : measurable f :=
measurable.of_le_map $ sup_le
  (by { rw [measurable_space.comap_le_iff_le_map, measurable_space.map_comp], exact hf₁ })
  (by { rw [measurable_space.comap_le_iff_le_map, measurable_space.map_comp], exact hf₂ })

lemma measurable_prod {f : α → β × γ} : measurable f ↔
  measurable (λ a, (f a).1) ∧ measurable (λ a, (f a).2) :=
⟨λ hf, ⟨measurable_fst.comp hf, measurable_snd.comp hf⟩, λ h, measurable.prod h.1 h.2⟩

lemma measurable.prod_mk {f : α → β} {g : α → γ} (hf : measurable f) (hg : measurable g) :
  measurable (λ a : α, (f a, g a)) :=
measurable.prod hf hg

lemma measurable_prod_mk_left {x : α} : measurable (@prod.mk _ β x) :=
measurable_const.prod_mk measurable_id

lemma measurable_prod_mk_right {y : β} : measurable (λ x : α, (x, y)) :=
measurable_id.prod_mk measurable_const

lemma measurable.prod_map [measurable_space δ] {f : α → β} {g : γ → δ} (hf : measurable f)
  (hg : measurable g) : measurable (prod.map f g) :=
(hf.comp measurable_fst).prod_mk (hg.comp measurable_snd)

lemma measurable.of_uncurry_left {f : α → β → γ} (hf : measurable (uncurry f)) {x : α} :
  measurable (f x) :=
hf.comp measurable_prod_mk_left

lemma measurable.of_uncurry_right {f : α → β → γ} (hf : measurable (uncurry f)) {y : β} :
  measurable (λ x, f x y) :=
hf.comp measurable_prod_mk_right

@[measurability] lemma measurable_swap : measurable (prod.swap : α × β → β × α) :=
measurable.prod measurable_snd measurable_fst

lemma measurable_swap_iff {f : α × β → γ} : measurable (f ∘ prod.swap) ↔ measurable f :=
⟨λ hf, by { convert hf.comp measurable_swap, ext ⟨x, y⟩, refl }, λ hf, hf.comp measurable_swap⟩

@[measurability]
lemma measurable_set.prod {s : set α} {t : set β} (hs : measurable_set s) (ht : measurable_set t) :
  measurable_set (s.prod t) :=
measurable_set.inter (measurable_fst hs) (measurable_snd ht)

lemma measurable_set_prod_of_nonempty {s : set α} {t : set β} (h : (s.prod t).nonempty) :
  measurable_set (s.prod t) ↔ measurable_set s ∧ measurable_set t :=
begin
  rcases h with ⟨⟨x, y⟩, hx, hy⟩,
  refine ⟨λ hst, _, λ h, h.1.prod h.2⟩,
  have : measurable_set ((λ x, (x, y)) ⁻¹' s.prod t) := measurable_id.prod_mk measurable_const hst,
  have : measurable_set (prod.mk x ⁻¹' s.prod t) := measurable_const.prod_mk measurable_id hst,
  simp * at *
end

lemma measurable_set_prod {s : set α} {t : set β} :
  measurable_set (s.prod t) ↔ (measurable_set s ∧ measurable_set t) ∨ s = ∅ ∨ t = ∅ :=
begin
  cases (s.prod t).eq_empty_or_nonempty with h h,
  { simp [h, prod_eq_empty_iff.mp h] },
  { simp [←not_nonempty_iff_eq_empty, prod_nonempty_iff.mp h, measurable_set_prod_of_nonempty h] }
end

lemma measurable_set_swap_iff {s : set (α × β)} :
  measurable_set (prod.swap ⁻¹' s) ↔ measurable_set s :=
⟨λ hs, by { convert measurable_swap hs, ext ⟨x, y⟩, refl }, λ hs, measurable_swap hs⟩

lemma measurable_from_prod_encodable [encodable β] [measurable_singleton_class β]
  {f : α × β → γ} (hf : ∀ y, measurable (λ x, f (x, y))) :
  measurable f :=
begin
  intros s hs,
  have : f ⁻¹' s = ⋃ y, ((λ x, f (x, y)) ⁻¹' s).prod {y},
  { ext1 ⟨x, y⟩,
    simp [and_assoc, and.left_comm] },
  rw this,
  exact measurable_set.Union (λ y, (hf y hs).prod (measurable_set_singleton y))
end

end prod

section pi

variables {π : δ → Type*}

instance measurable_space.pi [m : Π a, measurable_space (π a)] : measurable_space (Π a, π a) :=
⨆ a, (m a).comap (λ b, b a)

variables [Π a, measurable_space (π a)] [measurable_space γ]

lemma measurable_pi_iff {g : α → Π a, π a} :
  measurable g ↔ ∀ a, measurable (λ x, g x a) :=
by simp_rw [measurable_iff_comap_le, measurable_space.pi, measurable_space.comap_supr,
    measurable_space.comap_comp, function.comp, supr_le_iff]

@[measurability]
lemma measurable_pi_apply (a : δ) : measurable (λ f : Π a, π a, f a) :=
measurable.of_comap_le $ le_supr _ a

@[measurability]
lemma measurable.eval {a : δ} {g : α → Π a, π a}
  (hg : measurable g) : measurable (λ x, g x a) :=
(measurable_pi_apply a).comp hg

@[measurability]
lemma measurable_pi_lambda (f : α → Π a, π a) (hf : ∀ a, measurable (λ c, f c a)) :
  measurable f :=
measurable_pi_iff.mpr hf

/-- The function `update f a : π a → Π a, π a` is always measurable.
  This doesn't require `f` to be measurable.
  This should not be confused with the statement that `update f a x` is measurable. -/
@[measurability]
lemma measurable_update (f : Π (a : δ), π a) {a : δ} : measurable (update f a) :=
begin
  apply measurable_pi_lambda,
  intro x, by_cases hx : x = a,
  { cases hx, convert measurable_id, ext, simp },
  simp_rw [update_noteq hx], apply measurable_const,
end

/- Even though we cannot use projection notation, we still keep a dot to be consistent with similar
  lemmas, like `measurable_set.prod`. -/
@[measurability]
lemma measurable_set.pi {s : set δ} {t : Π i : δ, set (π i)} (hs : countable s)
  (ht : ∀ i ∈ s, measurable_set (t i)) :
  measurable_set (s.pi t) :=
by { rw [pi_def], exact measurable_set.bInter hs (λ i hi, measurable_pi_apply _ (ht i hi)) }

lemma measurable_set.univ_pi [encodable δ] {t : Π i : δ, set (π i)}
  (ht : ∀ i, measurable_set (t i)) : measurable_set (pi univ t) :=
measurable_set.pi (countable_encodable _) (λ i _, ht i)

lemma measurable_set_pi_of_nonempty {s : set δ} {t : Π i, set (π i)} (hs : countable s)
  (h : (pi s t).nonempty) : measurable_set (pi s t) ↔ ∀ i ∈ s, measurable_set (t i) :=
begin
  rcases h with ⟨f, hf⟩, refine ⟨λ hst i hi, _, measurable_set.pi hs⟩,
  convert measurable_update f hst, rw [update_preimage_pi hi], exact λ j hj _, hf j hj
end

lemma measurable_set_pi {s : set δ} {t : Π i, set (π i)} (hs : countable s) :
  measurable_set (pi s t) ↔ (∀ i ∈ s, measurable_set (t i)) ∨ pi s t = ∅ :=
begin
  cases (pi s t).eq_empty_or_nonempty with h h,
  { simp [h] },
  { simp [measurable_set_pi_of_nonempty hs, h, ← not_nonempty_iff_eq_empty] }
end

section
variable (π)

@[measurability]
lemma measurable_pi_equiv_pi_subtype_prod_symm (p : δ → Prop) [decidable_pred p] :
  measurable (equiv.pi_equiv_pi_subtype_prod p π).symm :=
begin
  apply measurable_pi_iff.2 (λ j, _),
  by_cases hj : p j,
  { simp only [hj, dif_pos, equiv.pi_equiv_pi_subtype_prod_symm_apply],
    have : measurable (λ (f : (Π (i : {x // p x}), π ↑i)), f ⟨j, hj⟩) :=
      measurable_pi_apply ⟨j, hj⟩,
    exact measurable.comp this measurable_fst },
  { simp only [hj, equiv.pi_equiv_pi_subtype_prod_symm_apply, dif_neg, not_false_iff],
    have : measurable (λ (f : (Π (i : {x // ¬ p x}), π ↑i)), f ⟨j, hj⟩) :=
      measurable_pi_apply ⟨j, hj⟩,
    exact measurable.comp this measurable_snd }
end

@[measurability]
lemma measurable_pi_equiv_pi_subtype_prod (p : δ → Prop) [decidable_pred p] :
  measurable (equiv.pi_equiv_pi_subtype_prod p π) :=
begin
  refine measurable_prod.2 _,
  split;
  { apply measurable_pi_iff.2 (λ j, _),
    simp only [pi_equiv_pi_subtype_prod_apply, measurable_pi_apply] }
end

end

section fintype

local attribute [instance] fintype.encodable

lemma measurable_set.pi_fintype [fintype δ] {s : set δ} {t : Π i, set (π i)}
  (ht : ∀ i ∈ s, measurable_set (t i)) : measurable_set (pi s t) :=
measurable_set.pi (countable_encodable _) ht

lemma measurable_set.univ_pi_fintype [fintype δ] {t : Π i, set (π i)}
  (ht : ∀ i, measurable_set (t i)) : measurable_set (pi univ t) :=
measurable_set.pi_fintype (λ i _, ht i)

end fintype
end pi

instance tprod.measurable_space (π : δ → Type*) [∀ x, measurable_space (π x)] :
  ∀ (l : list δ), measurable_space (list.tprod π l)
| []        := punit.measurable_space
| (i :: is) := @prod.measurable_space _ _ _ (tprod.measurable_space is)

section tprod

open list

variables {π : δ → Type*} [∀ x, measurable_space (π x)]

lemma measurable_tprod_mk (l : list δ) : measurable (@tprod.mk δ π l) :=
begin
  induction l with i l ih,
  { exact measurable_const },
  { exact (measurable_pi_apply i).prod_mk ih }
end

lemma measurable_tprod_elim : ∀ {l : list δ} {i : δ} (hi : i ∈ l),
  measurable (λ (v : tprod π l), v.elim hi)
| (i :: is) j hj := begin
  by_cases hji : j = i,
  { subst hji, simp [measurable_fst] },
  { rw [funext $ tprod.elim_of_ne _ hji],
    exact (measurable_tprod_elim (hj.resolve_left hji)).comp measurable_snd }
end

lemma measurable_tprod_elim' {l : list δ} (h : ∀ i, i ∈ l) :
  measurable (tprod.elim' h : tprod π l → Π i, π i) :=
measurable_pi_lambda _ (λ i, measurable_tprod_elim (h i))

lemma measurable_set.tprod (l : list δ) {s : ∀ i, set (π i)} (hs : ∀ i, measurable_set (s i)) :
  measurable_set (set.tprod l s) :=
by { induction l with i l ih, exact measurable_set.univ, exact (hs i).prod ih }

end tprod

instance {α β} [m₁ : measurable_space α] [m₂ : measurable_space β] : measurable_space (α ⊕ β) :=
m₁.map sum.inl ⊓ m₂.map sum.inr

section sum

@[measurability] lemma measurable_inl : measurable (@sum.inl α β) :=
measurable.of_le_map inf_le_left

@[measurability] lemma measurable_inr : measurable (@sum.inr α β) :=
measurable.of_le_map inf_le_right

lemma measurable_sum {f : α ⊕ β → γ}
  (hl : measurable (f ∘ sum.inl)) (hr : measurable (f ∘ sum.inr)) : measurable f :=
measurable.of_comap_le $ le_inf
  (measurable_space.comap_le_iff_le_map.2 $ hl)
  (measurable_space.comap_le_iff_le_map.2 $ hr)

@[measurability]
lemma measurable.sum_elim {f : α → γ} {g : β → γ} (hf : measurable f) (hg : measurable g) :
  measurable (sum.elim f g) :=
measurable_sum hf hg

lemma measurable_set.inl_image {s : set α} (hs : measurable_set s) :
  measurable_set (sum.inl '' s : set (α ⊕ β)) :=
⟨show measurable_set (sum.inl ⁻¹' _), by { rwa [preimage_image_eq], exact (λ a b, sum.inl.inj) },
  have sum.inr ⁻¹' (sum.inl '' s : set (α ⊕ β)) = ∅ :=
    eq_empty_of_subset_empty $ assume x ⟨y, hy, eq⟩, by contradiction,
  show measurable_set (sum.inr ⁻¹' _), by { rw [this], exact measurable_set.empty }⟩

lemma measurable_set_range_inl : measurable_set (range sum.inl : set (α ⊕ β)) :=
by { rw [← image_univ], exact measurable_set.univ.inl_image }

lemma measurable_set_inr_image {s : set β} (hs : measurable_set s) :
  measurable_set (sum.inr '' s : set (α ⊕ β)) :=
⟨ have sum.inl ⁻¹' (sum.inr '' s : set (α ⊕ β)) = ∅ :=
    eq_empty_of_subset_empty $ assume x ⟨y, hy, eq⟩, by contradiction,
  show measurable_set (sum.inl ⁻¹' _), by { rw [this], exact measurable_set.empty },
  show measurable_set (sum.inr ⁻¹' _), by { rwa [preimage_image_eq], exact λ a b, sum.inr.inj }⟩

lemma measurable_set_range_inr : measurable_set (range sum.inr : set (α ⊕ β)) :=
by { rw [← image_univ], exact measurable_set_inr_image measurable_set.univ }

end sum

instance {α} {β : α → Type*} [m : Πa, measurable_space (β a)] : measurable_space (sigma β) :=
⨅a, (m a).map (sigma.mk a)

end constructions

/-- A map `f : α → β` is called a *measurable embedding* if it is injective, measurable, and sends
measurable sets to measurable sets. The latter assumption can be replaced with “`f` has measurable
inverse `g : range f → α`”, see `measurable_embedding.measurable_range_splitting`,
`measurable_embedding.of_measurable_inverse_range`, and
`measurable_embedding.of_measurable_inverse`.

One more interpretation: `f` is a measurable embedding if it defines a measurable equivalence to its
range and the range is a measurable set. One implication is formalized as
`measurable_embedding.equiv_range`; the other one follows from
`measurable_equiv.measurable_embedding`, `measurable_embedding.subtype_coe`, and
`measurable_embedding.comp`. -/
@[protect_proj]
structure measurable_embedding {α β : Type*} [measurable_space α] [measurable_space β] (f : α → β) :
  Prop :=
(injective : injective f)
(measurable : measurable f)
(measurable_set_image' : ∀ ⦃s⦄, measurable_set s → measurable_set (f '' s))

namespace measurable_embedding

variables [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β} {g : β → γ}

lemma measurable_set_image (hf : measurable_embedding f) {s : set α} :
  measurable_set (f '' s) ↔ measurable_set s :=
⟨λ h, by simpa only [hf.injective.preimage_image] using hf.measurable h,
  λ h, hf.measurable_set_image' h⟩

lemma id : measurable_embedding (id : α → α) :=
⟨injective_id, measurable_id, λ s hs, by rwa image_id⟩

lemma comp (hg : measurable_embedding g) (hf : measurable_embedding f) :
  measurable_embedding (g ∘ f) :=
⟨hg.injective.comp hf.injective, hg.measurable.comp hf.measurable,
  λ s hs, by rwa [← image_image, hg.measurable_set_image, hf.measurable_set_image]⟩

lemma subtype_coe {s : set α} (hs : measurable_set s) : measurable_embedding (coe : s → α) :=
{ injective := subtype.coe_injective,
  measurable := measurable_subtype_coe,
  measurable_set_image' := λ _, measurable_set.subtype_image hs }

lemma measurable_set_range (hf : measurable_embedding f) : measurable_set (range f) :=
by { rw ← image_univ, exact hf.measurable_set_image' measurable_set.univ }

lemma measurable_set_preimage (hf : measurable_embedding f) {s : set β} :
  measurable_set (f ⁻¹' s) ↔ measurable_set (s ∩ range f) :=
by rw [← image_preimage_eq_inter_range, hf.measurable_set_image]

lemma measurable_range_splitting (hf : measurable_embedding f) :
  measurable (range_splitting f) :=
λ s hs, by rwa [preimage_range_splitting hf.injective,
  ← (subtype_coe hf.measurable_set_range).measurable_set_image, ← image_comp,
  coe_comp_range_factorization, hf.measurable_set_image]

lemma measurable_extend (hf : measurable_embedding f) {g : α → γ} {g' : β → γ}
  (hg : measurable g) (hg' : measurable g') :
  measurable (extend f g g') :=
begin
  refine measurable_of_restrict_of_restrict_compl hf.measurable_set_range _ _,
  { rw restrict_extend_range,
    simpa only [range_splitting] using hg.comp hf.measurable_range_splitting },
  { rw restrict_extend_compl_range, exact hg'.comp measurable_subtype_coe }
end

lemma exists_measurable_extend (hf : measurable_embedding f) {g : α → γ} (hg : measurable g)
  (hne : β → nonempty γ) :
  ∃ g' : β → γ, measurable g' ∧ g' ∘ f = g :=
⟨extend f g (λ x, classical.choice (hne x)),
  hf.measurable_extend hg (measurable_const' $ λ _ _, rfl),
  funext $ λ x, extend_apply hf.injective _ _ _⟩

lemma measurable_comp_iff (hg : measurable_embedding g) : measurable (g ∘ f) ↔ measurable f :=
begin
  refine ⟨λ H, _, hg.measurable.comp⟩,
  suffices : measurable ((range_splitting g ∘ range_factorization g) ∘ f),
    by rwa [(right_inverse_range_splitting hg.injective).comp_eq_id] at this,
  exact hg.measurable_range_splitting.comp H.subtype_mk
end

end measurable_embedding

lemma measurable_set.exists_measurable_proj [measurable_space α] {s : set α}
  (hs : measurable_set s) (hne : s.nonempty) : ∃ f : α → s, measurable f ∧ ∀ x : s, f x = x :=
let ⟨f, hfm, hf⟩ := (measurable_embedding.subtype_coe hs).exists_measurable_extend
  measurable_id (λ _, hne.to_subtype)
in ⟨f, hfm, congr_fun hf⟩

/-- Equivalences between measurable spaces. Main application is the simplification of measurability
statements along measurable equivalences. -/
structure measurable_equiv (α β : Type*) [measurable_space α] [measurable_space β] extends α ≃ β :=
(measurable_to_fun : measurable to_equiv)
(measurable_inv_fun : measurable to_equiv.symm)

infix ` ≃ᵐ `:25 := measurable_equiv

namespace measurable_equiv

variables (α β) [measurable_space α] [measurable_space β] [measurable_space γ] [measurable_space δ]

instance : has_coe_to_fun (α ≃ᵐ β) (λ _, α → β) := ⟨λ e, e.to_fun⟩

variables {α β}

@[simp] lemma coe_to_equiv (e : α ≃ᵐ β) : (e.to_equiv : α → β) = e := rfl

@[measurability]
protected lemma measurable (e : α ≃ᵐ β) : measurable (e : α → β) :=
e.measurable_to_fun

@[simp] lemma coe_mk (e : α ≃ β) (h1 : measurable e) (h2 : measurable e.symm) :
  ((⟨e, h1, h2⟩ : α ≃ᵐ β) : α → β) = e := rfl

/-- Any measurable space is equivalent to itself. -/
def refl (α : Type*) [measurable_space α] : α ≃ᵐ α :=
{ to_equiv := equiv.refl α,
  measurable_to_fun := measurable_id, measurable_inv_fun := measurable_id }

instance : inhabited (α ≃ᵐ α) := ⟨refl α⟩

/-- The composition of equivalences between measurable spaces. -/
def trans (ab : α ≃ᵐ β) (bc : β ≃ᵐ γ) :
  α ≃ᵐ γ :=
{ to_equiv := ab.to_equiv.trans bc.to_equiv,
  measurable_to_fun := bc.measurable_to_fun.comp ab.measurable_to_fun,
  measurable_inv_fun := ab.measurable_inv_fun.comp bc.measurable_inv_fun }

/-- The inverse of an equivalence between measurable spaces. -/
def symm (ab : α ≃ᵐ β) : β ≃ᵐ α :=
{ to_equiv := ab.to_equiv.symm,
  measurable_to_fun := ab.measurable_inv_fun,
  measurable_inv_fun := ab.measurable_to_fun }

@[simp] lemma coe_to_equiv_symm (e : α ≃ᵐ β) : (e.to_equiv.symm : β → α) = e.symm := rfl

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : α ≃ᵐ β) : α → β := h
/-- See Note [custom simps projection] -/
def simps.symm_apply (h : α ≃ᵐ β) : β → α := h.symm

initialize_simps_projections measurable_equiv
  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply)

lemma to_equiv_injective : injective (to_equiv : (α ≃ᵐ β) → (α ≃ β)) :=
by { rintro ⟨e₁, _, _⟩ ⟨e₂, _, _⟩ (rfl : e₁ = e₂), refl }

@[ext] lemma ext {e₁ e₂ : α ≃ᵐ β} (h : (e₁ : α → β) = e₂) : e₁ = e₂ :=
to_equiv_injective $ equiv.coe_fn_injective h

@[simp] lemma symm_mk (e : α ≃ β) (h1 : measurable e) (h2 : measurable e.symm) :
  (⟨e, h1, h2⟩ : α ≃ᵐ β).symm = ⟨e.symm, h2, h1⟩ := rfl

attribute [simps apply to_equiv] trans refl

@[simp] lemma symm_refl (α : Type*) [measurable_space α] : (refl α).symm = refl α := rfl

@[simp] theorem symm_comp_self (e : α ≃ᵐ β) : e.symm ∘ e = id := funext e.left_inv

@[simp] theorem self_comp_symm (e : α ≃ᵐ β) : e ∘ e.symm = id := funext e.right_inv

@[simp] theorem apply_symm_apply (e : α ≃ᵐ β) (y : β) : e (e.symm y) = y := e.right_inv y

@[simp] theorem symm_apply_apply (e : α ≃ᵐ β) (x : α) : e.symm (e x) = x := e.left_inv x

@[simp] theorem symm_trans_self (e : α ≃ᵐ β) : e.symm.trans e = refl β :=
ext e.self_comp_symm

@[simp] theorem self_trans_symm (e : α ≃ᵐ β) : e.trans e.symm = refl α :=
ext e.symm_comp_self

protected theorem surjective (e : α ≃ᵐ β) : surjective e := e.to_equiv.surjective
protected theorem bijective (e : α ≃ᵐ β) : bijective e := e.to_equiv.bijective
protected theorem injective (e : α ≃ᵐ β) : injective e := e.to_equiv.injective

@[simp] theorem symm_preimage_preimage (e : α ≃ᵐ β) (s : set β) : e.symm ⁻¹' (e ⁻¹' s) = s :=
e.to_equiv.symm_preimage_preimage s

theorem image_eq_preimage (e : α ≃ᵐ β) (s : set α) : e '' s = e.symm ⁻¹' s :=
e.to_equiv.image_eq_preimage s

@[simp] theorem measurable_set_preimage (e : α ≃ᵐ β) {s : set β} :
  measurable_set (e ⁻¹' s) ↔ measurable_set s :=
⟨λ h, by simpa only [symm_preimage_preimage] using e.symm.measurable h, λ h, e.measurable h⟩

@[simp] theorem measurable_set_image (e : α ≃ᵐ β) {s : set α} :
  measurable_set (e '' s) ↔ measurable_set s :=
by rw [image_eq_preimage, measurable_set_preimage]

/-- A measurable equivalence is a measurable embedding. -/
protected lemma measurable_embedding (e : α ≃ᵐ β) : measurable_embedding e :=
{ injective := e.injective,
  measurable := e.measurable,
  measurable_set_image' := λ s, e.measurable_set_image.2 }

/-- Equal measurable spaces are equivalent. -/
protected def cast {α β} [i₁ : measurable_space α] [i₂ : measurable_space β]
  (h : α = β) (hi : i₁ == i₂) : α ≃ᵐ β :=
{ to_equiv := equiv.cast h,
  measurable_to_fun  := by { substI h, substI hi, exact measurable_id },
  measurable_inv_fun := by { substI h, substI hi, exact measurable_id }}

protected lemma measurable_comp_iff {f : β → γ} (e : α ≃ᵐ β) :
  measurable (f ∘ e) ↔ measurable f :=
iff.intro
  (assume hfe,
    have measurable (f ∘ (e.symm.trans e).to_equiv) := hfe.comp e.symm.measurable,
    by rwa [coe_to_equiv, symm_trans_self] at this)
  (λ h, h.comp e.measurable)

/-- Any two types with unique elements are measurably equivalent. -/
def of_unique_of_unique (α β : Type*) [measurable_space α] [measurable_space β]
  [unique α] [unique β] : α ≃ᵐ β :=
{ to_equiv := equiv_of_unique_of_unique,
  measurable_to_fun := subsingleton.measurable,
  measurable_inv_fun := subsingleton.measurable }

/-- Products of equivalent measurable spaces are equivalent. -/
def prod_congr (ab : α ≃ᵐ β) (cd : γ ≃ᵐ δ) : α × γ ≃ᵐ β × δ :=
{ to_equiv := prod_congr ab.to_equiv cd.to_equiv,
  measurable_to_fun := (ab.measurable_to_fun.comp measurable_id.fst).prod_mk
    (cd.measurable_to_fun.comp measurable_id.snd),
  measurable_inv_fun := (ab.measurable_inv_fun.comp measurable_id.fst).prod_mk
    (cd.measurable_inv_fun.comp measurable_id.snd) }

/-- Products of measurable spaces are symmetric. -/
def prod_comm : α × β ≃ᵐ β × α :=
{ to_equiv := prod_comm α β,
  measurable_to_fun  := measurable_id.snd.prod_mk measurable_id.fst,
  measurable_inv_fun := measurable_id.snd.prod_mk measurable_id.fst }

/-- Products of measurable spaces are associative. -/
def prod_assoc : (α × β) × γ ≃ᵐ α × (β × γ) :=
{ to_equiv := prod_assoc α β γ,
  measurable_to_fun  := measurable_fst.fst.prod_mk $ measurable_fst.snd.prod_mk measurable_snd,
  measurable_inv_fun := (measurable_fst.prod_mk measurable_snd.fst).prod_mk measurable_snd.snd }

/-- Sums of measurable spaces are symmetric. -/
def sum_congr (ab : α ≃ᵐ β) (cd : γ ≃ᵐ δ) : α ⊕ γ ≃ᵐ β ⊕ δ :=
{ to_equiv := sum_congr ab.to_equiv cd.to_equiv,
  measurable_to_fun :=
    begin
      cases ab with ab' abm, cases ab', cases cd with cd' cdm, cases cd',
      refine measurable_sum (measurable_inl.comp abm) (measurable_inr.comp cdm)
    end,
  measurable_inv_fun :=
    begin
      cases ab with ab' _ abm, cases ab', cases cd with cd' _ cdm, cases cd',
      refine measurable_sum (measurable_inl.comp abm) (measurable_inr.comp cdm)
    end }

/-- `set.prod s t ≃ (s × t)` as measurable spaces. -/
def set.prod (s : set α) (t : set β) : s.prod t ≃ᵐ s × t :=
{ to_equiv := equiv.set.prod s t,
  measurable_to_fun := measurable_id.subtype_coe.fst.subtype_mk.prod_mk
    measurable_id.subtype_coe.snd.subtype_mk,
  measurable_inv_fun := measurable.subtype_mk $ measurable_id.fst.subtype_coe.prod_mk
    measurable_id.snd.subtype_coe }

/-- `univ α ≃ α` as measurable spaces. -/
def set.univ (α : Type*) [measurable_space α] : (univ : set α) ≃ᵐ α :=
{ to_equiv := equiv.set.univ α,
  measurable_to_fun := measurable_id.subtype_coe,
  measurable_inv_fun := measurable_id.subtype_mk }

/-- `{a} ≃ unit` as measurable spaces. -/
def set.singleton (a : α) : ({a} : set α) ≃ᵐ unit :=
{ to_equiv := equiv.set.singleton a,
  measurable_to_fun := measurable_const,
  measurable_inv_fun := measurable_const }

/-- A set is equivalent to its image under a function `f` as measurable spaces,
  if `f` is an injective measurable function that sends measurable sets to measurable sets. -/
noncomputable def set.image (f : α → β) (s : set α) (hf : injective f)
  (hfm : measurable f) (hfi : ∀ s, measurable_set s → measurable_set (f '' s)) : s ≃ᵐ (f '' s) :=
{ to_equiv := equiv.set.image f s hf,
  measurable_to_fun  := (hfm.comp measurable_id.subtype_coe).subtype_mk,
  measurable_inv_fun :=
    begin
      rintro t ⟨u, hu, rfl⟩, simp [preimage_preimage, set.image_symm_preimage hf],
      exact measurable_subtype_coe (hfi u hu)
    end }

/-- The domain of `f` is equivalent to its range as measurable spaces,
  if `f` is an injective measurable function that sends measurable sets to measurable sets. -/
noncomputable def set.range (f : α → β) (hf : injective f) (hfm : measurable f)
  (hfi : ∀ s, measurable_set s → measurable_set (f '' s)) :
  α ≃ᵐ (range f) :=
(measurable_equiv.set.univ _).symm.trans $
  (measurable_equiv.set.image f univ hf hfm hfi).trans $
  measurable_equiv.cast (by rw image_univ) (by rw image_univ)

/-- `α` is equivalent to its image in `α ⊕ β` as measurable spaces. -/
def set.range_inl : (range sum.inl : set (α ⊕ β)) ≃ᵐ α :=
{ to_fun    := λ ab, match ab with
    | ⟨sum.inl a, _⟩ := a
    | ⟨sum.inr b, p⟩ := have false, by { cases p, contradiction }, this.elim
    end,
  inv_fun   := λ a, ⟨sum.inl a, a, rfl⟩,
  left_inv  := by { rintro ⟨ab, a, rfl⟩, refl },
  right_inv := assume a, rfl,
  measurable_to_fun  := assume s (hs : measurable_set s),
    begin
      refine ⟨_, hs.inl_image, set.ext _⟩,
      rintros ⟨ab, a, rfl⟩,
      simp [set.range_inl._match_1]
    end,
  measurable_inv_fun := measurable.subtype_mk measurable_inl }

/-- `β` is equivalent to its image in `α ⊕ β` as measurable spaces. -/
def set.range_inr : (range sum.inr : set (α ⊕ β)) ≃ᵐ β :=
{ to_fun    := λ ab, match ab with
    | ⟨sum.inr b, _⟩ := b
    | ⟨sum.inl a, p⟩ := have false, by { cases p, contradiction }, this.elim
    end,
  inv_fun   := λ b, ⟨sum.inr b, b, rfl⟩,
  left_inv  := by { rintro ⟨ab, b, rfl⟩, refl },
  right_inv := assume b, rfl,
  measurable_to_fun  := assume s (hs : measurable_set s),
    begin
      refine ⟨_, measurable_set_inr_image hs, set.ext _⟩,
      rintros ⟨ab, b, rfl⟩,
      simp [set.range_inr._match_1]
    end,
  measurable_inv_fun := measurable.subtype_mk measurable_inr }

/-- Products distribute over sums (on the right) as measurable spaces. -/
def sum_prod_distrib (α β γ) [measurable_space α] [measurable_space β] [measurable_space γ] :
  (α ⊕ β) × γ ≃ᵐ (α × γ) ⊕ (β × γ) :=
{ to_equiv := sum_prod_distrib α β γ,
  measurable_to_fun  :=
  begin
    refine measurable_of_measurable_union_cover
      ((range sum.inl).prod univ)
      ((range sum.inr).prod univ)
      (measurable_set_range_inl.prod measurable_set.univ)
      (measurable_set_range_inr.prod measurable_set.univ)
      (by { rintro ⟨a|b, c⟩; simp [set.prod_eq] })
      _
      _,
    { refine (set.prod (range sum.inl) univ).symm.measurable_comp_iff.1 _,
      refine (prod_congr set.range_inl (set.univ _)).symm.measurable_comp_iff.1 _,
      dsimp [(∘)],
      convert measurable_inl,
      ext ⟨a, c⟩, refl },
    { refine (set.prod (range sum.inr) univ).symm.measurable_comp_iff.1 _,
      refine (prod_congr set.range_inr (set.univ _)).symm.measurable_comp_iff.1 _,
      dsimp [(∘)],
      convert measurable_inr,
      ext ⟨b, c⟩, refl }
  end,
  measurable_inv_fun :=
    measurable_sum
      ((measurable_inl.comp measurable_fst).prod_mk measurable_snd)
      ((measurable_inr.comp measurable_fst).prod_mk measurable_snd) }

/-- Products distribute over sums (on the left) as measurable spaces. -/
def prod_sum_distrib (α β γ) [measurable_space α] [measurable_space β] [measurable_space γ] :
  α × (β ⊕ γ) ≃ᵐ (α × β) ⊕ (α × γ) :=
prod_comm.trans $ (sum_prod_distrib _ _ _).trans $ sum_congr prod_comm prod_comm

/-- Products distribute over sums as measurable spaces. -/
def sum_prod_sum (α β γ δ)
  [measurable_space α] [measurable_space β] [measurable_space γ] [measurable_space δ] :
  (α ⊕ β) × (γ ⊕ δ) ≃ᵐ ((α × γ) ⊕ (α × δ)) ⊕ ((β × γ) ⊕ (β × δ)) :=
(sum_prod_distrib _ _ _).trans $ sum_congr (prod_sum_distrib _ _ _) (prod_sum_distrib _ _ _)

variables {π π' : δ' → Type*} [∀ x, measurable_space (π x)] [∀ x, measurable_space (π' x)]

/-- A family of measurable equivalences `Π a, β₁ a ≃ᵐ β₂ a` generates a measurable equivalence
  between  `Π a, β₁ a` and `Π a, β₂ a`. -/
def Pi_congr_right (e : Π a, π a ≃ᵐ π' a) : (Π a, π a) ≃ᵐ (Π a, π' a) :=
{ to_equiv := Pi_congr_right (λ a, (e a).to_equiv),
  measurable_to_fun :=
    measurable_pi_lambda _ (λ i, (e i).measurable_to_fun.comp (measurable_pi_apply i)),
  measurable_inv_fun :=
    measurable_pi_lambda _ (λ i, (e i).measurable_inv_fun.comp (measurable_pi_apply i)) }

/-- Pi-types are measurably equivalent to iterated products. -/
@[simps {fully_applied := ff}]
noncomputable def pi_measurable_equiv_tprod {l : list δ'} (hnd : l.nodup) (h : ∀ i, i ∈ l) :
  (Π i, π i) ≃ᵐ list.tprod π l :=
{ to_equiv := list.tprod.pi_equiv_tprod hnd h,
  measurable_to_fun := measurable_tprod_mk l,
  measurable_inv_fun := measurable_tprod_elim' h }

/-- If `α` has a unique term, then the type of function `α → β` is measurably equivalent to `β`. -/
@[simps {fully_applied := ff}] def fun_unique (α β : Type*) [unique α] [measurable_space β] :
  (α → β) ≃ᵐ β :=
{ to_equiv := equiv.fun_unique α β,
  measurable_to_fun := measurable_pi_apply _,
  measurable_inv_fun := measurable_pi_iff.2 $ λ b, measurable_id }

/-- The space `Π i : fin 2, α i` is measurably equivalent to `α 0 × α 1`. -/
@[simps {fully_applied := ff}] def pi_fin_two (α : fin 2 → Type*) [∀ i, measurable_space (α i)] :
  (Π i, α i) ≃ᵐ α 0 × α 1 :=
{ to_equiv := pi_fin_two_equiv α,
  measurable_to_fun := measurable.prod (measurable_pi_apply _) (measurable_pi_apply _),
  measurable_inv_fun := measurable_pi_iff.2 $
    fin.forall_fin_two.2 ⟨measurable_fst, measurable_snd⟩ }

/-- The space `fin 2 → α` is measurably equivalent to `α × α`. -/
@[simps {fully_applied := ff}] def fin_two_arrow : (fin 2 → α) ≃ᵐ α × α := pi_fin_two (λ _, α)

end measurable_equiv

namespace measurable_embedding

variables [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β}

/-- A measurable embedding defines a measurable equivalence between its domain
and its range. -/
noncomputable def equiv_range (f : α → β) (hf : measurable_embedding f) :
  α ≃ᵐ range f :=
{ to_equiv := equiv.of_injective f hf.injective,
  measurable_to_fun := hf.measurable.subtype_mk,
  measurable_inv_fun :=
    by { rw coe_of_injective_symm, exact hf.measurable_range_splitting } }

lemma of_measurable_inverse_on_range {g : range f → α} (hf₁ : measurable f)
  (hf₂ : measurable_set (range f)) (hg : measurable g)
  (H : left_inverse g (range_factorization f)) : measurable_embedding f :=
begin
  set e : α ≃ᵐ range f :=
    ⟨⟨range_factorization f, g, H, H.right_inverse_of_surjective surjective_onto_range⟩,
      hf₁.subtype_mk, hg⟩,
  exact (measurable_embedding.subtype_coe hf₂).comp e.measurable_embedding
end

lemma of_measurable_inverse {g : β → α} (hf₁ : measurable f)
  (hf₂ : measurable_set (range f)) (hg : measurable g)
  (H : left_inverse g f) : measurable_embedding f :=
of_measurable_inverse_on_range hf₁ hf₂ (hg.comp measurable_subtype_coe) H

end measurable_embedding

namespace filter

variables [measurable_space α]

/-- A filter `f` is measurably generates if each `s ∈ f` includes a measurable `t ∈ f`. -/
class is_measurably_generated (f : filter α) : Prop :=
(exists_measurable_subset : ∀ ⦃s⦄, s ∈ f → ∃ t ∈ f, measurable_set t ∧ t ⊆ s)

instance is_measurably_generated_bot : is_measurably_generated (⊥ : filter α) :=
⟨λ _ _, ⟨∅, mem_bot, measurable_set.empty, empty_subset _⟩⟩

instance is_measurably_generated_top : is_measurably_generated (⊤ : filter α) :=
⟨λ s hs, ⟨univ, univ_mem, measurable_set.univ, λ x _, hs x⟩⟩

lemma eventually.exists_measurable_mem {f : filter α} [is_measurably_generated f]
  {p : α → Prop} (h : ∀ᶠ x in f, p x) :
  ∃ s ∈ f, measurable_set s ∧ ∀ x ∈ s, p x :=
is_measurably_generated.exists_measurable_subset h

lemma eventually.exists_measurable_mem_of_lift' {f : filter α} [is_measurably_generated f]
  {p : set α → Prop} (h : ∀ᶠ s in f.lift' powerset, p s) :
  ∃ s ∈ f, measurable_set s ∧ p s :=
let ⟨s, hsf, hs⟩ := eventually_lift'_powerset.1 h,
  ⟨t, htf, htm, hts⟩ := is_measurably_generated.exists_measurable_subset hsf
in ⟨t, htf, htm, hs t hts⟩

instance inf_is_measurably_generated (f g : filter α) [is_measurably_generated f]
  [is_measurably_generated g] :
  is_measurably_generated (f ⊓ g) :=
begin
  refine ⟨_⟩,
  rintros t ⟨sf, hsf, sg, hsg, rfl⟩,
  rcases is_measurably_generated.exists_measurable_subset hsf with ⟨s'f, hs'f, hmf, hs'sf⟩,
  rcases is_measurably_generated.exists_measurable_subset hsg with ⟨s'g, hs'g, hmg, hs'sg⟩,
  refine ⟨s'f ∩ s'g, inter_mem_inf hs'f hs'g, hmf.inter hmg, _⟩,
  exact inter_subset_inter hs'sf hs'sg
end

lemma principal_is_measurably_generated_iff {s : set α} :
  is_measurably_generated (𝓟 s) ↔ measurable_set s :=
begin
  refine ⟨_, λ hs, ⟨λ t ht, ⟨s, mem_principal_self s, hs, ht⟩⟩⟩,
  rintros ⟨hs⟩,
  rcases hs (mem_principal_self s) with ⟨t, ht, htm, hts⟩,
  have : t = s := subset.antisymm hts ht,
  rwa ← this
end

alias principal_is_measurably_generated_iff ↔
  _ measurable_set.principal_is_measurably_generated

instance infi_is_measurably_generated {f : ι → filter α} [∀ i, is_measurably_generated (f i)] :
  is_measurably_generated (⨅ i, f i) :=
begin
  refine ⟨λ s hs, _⟩,
  rw [← equiv.plift.surjective.infi_comp, mem_infi] at hs,
  rcases hs with ⟨t, ht, ⟨V, hVf, rfl⟩⟩,
  choose U hUf hU using λ i, is_measurably_generated.exists_measurable_subset (hVf i),
  refine ⟨⋂ i : t, U i, _, _, _⟩,
  { rw [← equiv.plift.surjective.infi_comp, mem_infi],
    refine ⟨t, ht, U, hUf, rfl⟩ },
  { haveI := ht.countable.to_encodable,
    refine measurable_set.Inter (λ i, (hU i).1) },
  { exact Inter_subset_Inter (λ i, (hU i).2) }
end

end filter

/-- We say that a collection of sets is countably spanning if a countable subset spans the
  whole type. This is a useful condition in various parts of measure theory. For example, it is
  a needed condition to show that the product of two collections generate the product sigma algebra,
  see `generate_from_prod_eq`. -/
def is_countably_spanning (C : set (set α)) : Prop :=
∃ (s : ℕ → set α), (∀ n, s n ∈ C) ∧ (⋃ n, s n) = univ

lemma is_countably_spanning_measurable_set [measurable_space α] :
  is_countably_spanning {s : set α | measurable_set s} :=
⟨λ _, univ, λ _, measurable_set.univ, Union_const _⟩

namespace measurable_set

/-!
### Typeclasses on `subtype measurable_set`
-/

variables [measurable_space α]

instance : has_mem α (subtype (measurable_set : set α → Prop)) :=
⟨λ a s, a ∈ (s : set α)⟩

@[simp] lemma mem_coe (a : α) (s : subtype (measurable_set : set α → Prop)) :
  a ∈ (s : set α) ↔ a ∈ s := iff.rfl

instance : has_emptyc (subtype (measurable_set : set α → Prop)) :=
⟨⟨∅, measurable_set.empty⟩⟩

@[simp] lemma coe_empty : ↑(∅ : subtype (measurable_set : set α → Prop)) = (∅ : set α) := rfl

instance [measurable_singleton_class α] : has_insert α (subtype (measurable_set : set α → Prop)) :=
⟨λ a s, ⟨has_insert.insert a s, s.prop.insert a⟩⟩

@[simp] lemma coe_insert [measurable_singleton_class α] (a : α)
  (s : subtype (measurable_set : set α → Prop)) :
  ↑(has_insert.insert a s) = (has_insert.insert a s : set α) := rfl

instance : has_compl (subtype (measurable_set : set α → Prop)) :=
⟨λ x, ⟨xᶜ, x.prop.compl⟩⟩

@[simp] lemma coe_compl (s : subtype (measurable_set : set α → Prop)) : ↑(sᶜ) = (sᶜ : set α) := rfl

instance : has_union (subtype (measurable_set : set α → Prop)) :=
⟨λ x y, ⟨x ∪ y, x.prop.union y.prop⟩⟩

@[simp] lemma coe_union (s t : subtype (measurable_set : set α → Prop)) :
  ↑(s ∪ t) = (s ∪ t : set α) := rfl

instance : has_inter (subtype (measurable_set : set α → Prop)) :=
⟨λ x y, ⟨x ∩ y, x.prop.inter y.prop⟩⟩

@[simp] lemma coe_inter (s t : subtype (measurable_set : set α → Prop)) :
  ↑(s ∩ t) = (s ∩ t : set α) := rfl

instance : has_sdiff (subtype (measurable_set : set α → Prop)) :=
⟨λ x y, ⟨x \ y, x.prop.diff y.prop⟩⟩

@[simp] lemma coe_sdiff (s t : subtype (measurable_set : set α → Prop)) :
  ↑(s \ t) = (s \ t : set α) := rfl

instance : has_bot (subtype (measurable_set : set α → Prop)) :=
⟨⟨⊥, measurable_set.empty⟩⟩

@[simp] lemma coe_bot : ↑(⊥ : subtype (measurable_set : set α → Prop)) = (⊥ : set α) := rfl

instance : has_top (subtype (measurable_set : set α → Prop)) :=
⟨⟨⊤, measurable_set.univ⟩⟩

@[simp] lemma coe_top : ↑(⊤ : subtype (measurable_set : set α → Prop)) = (⊤ : set α) := rfl

instance : partial_order (subtype (measurable_set : set α → Prop)) :=
partial_order.lift _ subtype.coe_injective

instance : distrib_lattice (subtype (measurable_set : set α → Prop)) :=
{ sup := (∪),
  le_sup_left := λ a b, show (a : set α) ≤ a ⊔ b, from le_sup_left,
  le_sup_right := λ a b, show (b : set α) ≤ a ⊔ b, from le_sup_right,
  sup_le := λ a b c ha hb, show (a ⊔ b : set α) ≤ c, from sup_le ha hb,
  inf := (∩),
  inf_le_left := λ a b, show (a ⊓ b : set α) ≤ a, from inf_le_left,
  inf_le_right := λ a b, show (a ⊓ b : set α) ≤ b, from inf_le_right,
  le_inf := λ a b c ha hb, show (a : set α) ≤ b ⊓ c, from le_inf ha hb,
  le_sup_inf := λ x y z, show ((x ⊔ y) ⊓ (x ⊔ z) : set α) ≤ x ⊔ y ⊓ z, from le_sup_inf,
  .. measurable_set.subtype.partial_order }

instance : bounded_order (subtype (measurable_set : set α → Prop)) :=
{ top := ⊤,
  le_top := λ a, show (a : set α) ≤ ⊤, from le_top,
  bot := ⊥,
  bot_le := λ a, show (⊥ : set α) ≤ a, from bot_le }

instance : boolean_algebra (subtype (measurable_set : set α → Prop)) :=
{ sdiff := (\),
  sup_inf_sdiff := λ a b, subtype.eq $ sup_inf_sdiff a b,
  inf_inf_sdiff := λ a b, subtype.eq $ inf_inf_sdiff a b,
  compl := has_compl.compl,
  inf_compl_le_bot := λ a, boolean_algebra.inf_compl_le_bot (a : set α),
  top_le_sup_compl := λ a, boolean_algebra.top_le_sup_compl (a : set α),
  sdiff_eq := λ a b, subtype.eq $ sdiff_eq,
  .. measurable_set.subtype.bounded_order,
  .. measurable_set.subtype.distrib_lattice }

end measurable_set


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Joseph Myers.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.geometry.euclidean.basic
import Mathlib.tactic.interval_cases
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Triangles

This file proves basic geometrical results about distances and angles
in (possibly degenerate) triangles in real inner product spaces and
Euclidean affine spaces.  More specialized results, and results
developed for simplices in general rather than just for triangles, are
in separate files.  Definitions and results that make sense in more
general affine spaces rather than just in the Euclidean case go under
`linear_algebra.affine_space`.

## Implementation notes

Results in this file are generally given in a form with only those
non-degeneracy conditions needed for the particular result, rather
than requiring affine independence of the points of a triangle
unnecessarily.

## References

* https://en.wikipedia.org/wiki/Pythagorean_theorem
* https://en.wikipedia.org/wiki/Law_of_cosines
* https://en.wikipedia.org/wiki/Pons_asinorum
* https://en.wikipedia.org/wiki/Sum_of_angles_of_a_triangle

-/

namespace inner_product_geometry

/-!
### Geometrical results on triangles in real inner product spaces

This section develops some results on (possibly degenerate) triangles
in real inner product spaces, where those definitions and results can
most conveniently be developed in terms of vectors and then used to
deduce corresponding results for Euclidean affine spaces.
-/

/-- Pythagorean theorem, if-and-only-if vector angle form. -/
theorem norm_add_square_eq_norm_square_add_norm_square_iff_angle_eq_pi_div_two {V : Type u_1}
    [inner_product_space ℝ V] (x : V) (y : V) :
    norm (x + y) * norm (x + y) = norm x * norm x + norm y * norm y ↔
        angle x y = real.pi / bit0 1 :=
  sorry

/-- Pythagorean theorem, vector angle form. -/
theorem norm_add_square_eq_norm_square_add_norm_square' {V : Type u_1} [inner_product_space ℝ V]
    (x : V) (y : V) (h : angle x y = real.pi / bit0 1) :
    norm (x + y) * norm (x + y) = norm x * norm x + norm y * norm y :=
  iff.mpr (norm_add_square_eq_norm_square_add_norm_square_iff_angle_eq_pi_div_two x y) h

/-- Pythagorean theorem, subtracting vectors, if-and-only-if vector angle form. -/
theorem norm_sub_square_eq_norm_square_add_norm_square_iff_angle_eq_pi_div_two {V : Type u_1}
    [inner_product_space ℝ V] (x : V) (y : V) :
    norm (x - y) * norm (x - y) = norm x * norm x + norm y * norm y ↔
        angle x y = real.pi / bit0 1 :=
  sorry

/-- Pythagorean theorem, subtracting vectors, vector angle form. -/
theorem norm_sub_square_eq_norm_square_add_norm_square' {V : Type u_1} [inner_product_space ℝ V]
    (x : V) (y : V) (h : angle x y = real.pi / bit0 1) :
    norm (x - y) * norm (x - y) = norm x * norm x + norm y * norm y :=
  iff.mpr (norm_sub_square_eq_norm_square_add_norm_square_iff_angle_eq_pi_div_two x y) h

/-- Law of cosines (cosine rule), vector angle form. -/
theorem norm_sub_square_eq_norm_square_add_norm_square_sub_two_mul_norm_mul_norm_mul_cos_angle
    {V : Type u_1} [inner_product_space ℝ V] (x : V) (y : V) :
    norm (x - y) * norm (x - y) =
        norm x * norm x + norm y * norm y - bit0 1 * norm x * norm y * real.cos (angle x y) :=
  sorry

/-- Pons asinorum, vector angle form. -/
theorem angle_sub_eq_angle_sub_rev_of_norm_eq {V : Type u_1} [inner_product_space ℝ V] {x : V}
    {y : V} (h : norm x = norm y) : angle x (x - y) = angle y (y - x) :=
  sorry

/-- Converse of pons asinorum, vector angle form. -/
theorem norm_eq_of_angle_sub_eq_angle_sub_rev_of_angle_ne_pi {V : Type u_1}
    [inner_product_space ℝ V] {x : V} {y : V} (h : angle x (x - y) = angle y (y - x))
    (hpi : angle x y ≠ real.pi) : norm x = norm y :=
  sorry

/-- The cosine of the sum of two angles in a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
theorem cos_angle_sub_add_angle_sub_rev_eq_neg_cos_angle {V : Type u_1} [inner_product_space ℝ V]
    {x : V} {y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
    real.cos (angle x (x - y) + angle y (y - x)) = -real.cos (angle x y) :=
  sorry

/-- The sine of the sum of two angles in a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
theorem sin_angle_sub_add_angle_sub_rev_eq_sin_angle {V : Type u_1} [inner_product_space ℝ V]
    {x : V} {y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
    real.sin (angle x (x - y) + angle y (y - x)) = real.sin (angle x y) :=
  sorry

/-- The cosine of the sum of the angles of a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
theorem cos_angle_add_angle_sub_add_angle_sub_eq_neg_one {V : Type u_1} [inner_product_space ℝ V]
    {x : V} {y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
    real.cos (angle x y + angle x (x - y) + angle y (y - x)) = -1 :=
  sorry

/-- The sine of the sum of the angles of a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
theorem sin_angle_add_angle_sub_add_angle_sub_eq_zero {V : Type u_1} [inner_product_space ℝ V]
    {x : V} {y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
    real.sin (angle x y + angle x (x - y) + angle y (y - x)) = 0 :=
  sorry

/-- The sum of the angles of a possibly degenerate triangle (where the
two given sides are nonzero), vector angle form. -/
theorem angle_add_angle_sub_add_angle_sub_eq_pi {V : Type u_1} [inner_product_space ℝ V] {x : V}
    {y : V} (hx : x ≠ 0) (hy : y ≠ 0) : angle x y + angle x (x - y) + angle y (y - x) = real.pi :=
  sorry

end inner_product_geometry

namespace euclidean_geometry

/-!
### Geometrical results on triangles in Euclidean affine spaces

This section develops some geometrical definitions and results on
(possible degenerate) triangles in Euclidean affine spaces.
-/

/-- Pythagorean theorem, if-and-only-if angle-at-point form. -/
theorem dist_square_eq_dist_square_add_dist_square_iff_angle_eq_pi_div_two {V : Type u_1}
    {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (p1 : P)
    (p2 : P) (p3 : P) :
    dist p1 p3 * dist p1 p3 = dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 ↔
        angle p1 p2 p3 = real.pi / bit0 1 :=
  sorry

/-- Law of cosines (cosine rule), angle-at-point form. -/
theorem dist_square_eq_dist_square_add_dist_square_sub_two_mul_dist_mul_dist_mul_cos_angle
    {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
    (p1 : P) (p2 : P) (p3 : P) :
    dist p1 p3 * dist p1 p3 =
        dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 -
          bit0 1 * dist p1 p2 * dist p3 p2 * real.cos (angle p1 p2 p3) :=
  sorry

/-- Pons asinorum, angle-at-point form. -/
theorem angle_eq_angle_of_dist_eq {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V]
    [metric_space P] [normed_add_torsor V P] {p1 : P} {p2 : P} {p3 : P}
    (h : dist p1 p2 = dist p1 p3) : angle p1 p2 p3 = angle p1 p3 p2 :=
  sorry

/-- Converse of pons asinorum, angle-at-point form. -/
theorem dist_eq_of_angle_eq_angle_of_angle_ne_pi {V : Type u_1} {P : Type u_2}
    [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {p1 : P} {p2 : P} {p3 : P}
    (h : angle p1 p2 p3 = angle p1 p3 p2) (hpi : angle p2 p1 p3 ≠ real.pi) :
    dist p1 p2 = dist p1 p3 :=
  sorry

/-- The sum of the angles of a possibly degenerate triangle (where the
given vertex is distinct from the others), angle-at-point. -/
theorem angle_add_angle_add_angle_eq_pi {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V]
    [metric_space P] [normed_add_torsor V P] {p1 : P} {p2 : P} {p3 : P} (h2 : p2 ≠ p1)
    (h3 : p3 ≠ p1) : angle p1 p2 p3 + angle p2 p3 p1 + angle p3 p1 p2 = real.pi :=
  sorry

end Mathlib


import computability.regular_expressions
import computability.language
import extras.regular_expressions_extras
import extras.language_extras
import extras.list_extras

open sum prod
open regular_expression
open list

universes u
variables {α : Type u} {L L₁ : list (α × bool)} {L' L₁' : list ((α ⊕ unit) × bool)}

def pad_letter : (α × bool) → regular_expression ((α ⊕ unit) × bool)
| (x, tt) := (char (inl x, tt)) * (char (inr (), tt))
| (x, ff) := (star $ char (inr (), ff)) * (char (inl x, ff)) * (char (inr (), tt))

def pad_all (L : list (α × bool)) : regular_expression ((α ⊕ unit) × bool) :=
regular_expressions.prod (map (λ x, pad_letter x) L)

def pad_end (L : list (α × bool)) : regular_expression ((α ⊕ unit) × bool) :=
(pad_all L) * (star $ char (inr (), ff))

def paddings (L : list (α × bool)) : language ((α ⊕ unit) × bool) := (pad_end L).matches

def drop_unit : ((α ⊕ unit) × bool) → option (α × bool)
| (inl x, b) := some (x, b)
| (inr x, b) := none

def drop_units (L : list ((α ⊕ unit) × bool)) : list (α × bool) :=
list.reduce_option (list.map drop_unit L)

namespace paddings

@[simp]
private lemma drop_unit_inl {x : α} {b : bool} : drop_unit (inl x, b) = some (x, b) := rfl
@[simp]
private lemma drop_unit_inr  {b : bool} : drop_unit (@inr α unit (), b) = none := rfl

private lemma drop_units_hom :
∀ (x y : list ((α ⊕ unit) × bool)), drop_units (x ++ y) = drop_units x ++ drop_units y :=
(λ x y, by rw [drop_units, map_append, drop_units, drop_units, reduce_option_append])

private lemma drop_units_star :
drop_units '' ({[(@inr α unit (), ff)]} : language ((α ⊕ unit)× bool)).star = {[]} :=
begin
  ext,
  split,
  { intro h,
    simp at *,
    rcases h with ⟨x', hl, hr⟩,
    rw language.star_def at hl,
    simp at hl,
    rcases hl with ⟨S, hll, hlr⟩,
    subst_vars,
    rw drop_units,
    rw ← reduce_option_nil_iff,
    intros x hx,
    simp at *,
    rcases hx with ⟨a, hxl, hxr⟩,
    cases hxr,
    rcases hxr with ⟨x', h₁, h₂, h₃⟩,
    specialize hlr a hxl,
    subst_vars,
    simp at *,
    exact h₁,
    cases hxr_h with _ _,
    subst_vars,
    specialize hlr a hxl,
    subst_vars,
    simp at *,
    exact hxr_h_left,
    rcases hxr with ⟨b, h₁, h₂, h₃⟩,
    rw drop_unit at *,
    cases hxr_h with _ _,
    rw drop_unit at *,
    exact eq.symm hxr_h_right,
  },
  { intro h,
    simp at *,
    use ([(inr (), ff)]),
    split,
    rw language.star_def,
    simp,
    use ([[(inr (), ff)]]),
    split,
    simp,
    intros y hy,
    simp at *,
    exact hy,
    rw drop_units,
    simp,
    exact h.symm,
  }
end

private lemma drop_units_one : drop_units '' (1 : language ((α ⊕ unit) × bool)) = {[]} :=
begin
  ext,
  split,
  { intro h,
    simp at *,
    rw drop_units at *,
    simp at *,
    exact h.symm },
  { intro h,
    simp at *,
    rw drop_units,
    simp,
    exact h.symm }
end

lemma suffix_drop_units_suffix {s L : list ((α ⊕ unit) × bool)} : s <:+ L → drop_units s <:+ drop_units L :=
begin
  intro h,
  induction L,
  simp at *,
  subst_vars,
  rcases h with ⟨t, ht⟩,
  rw list.append_eq_cons_iff at ht,
  cases ht,
  { cases ht with hl hr,
    subst_vars },
  { rcases ht with ⟨a', hl, hr⟩,
    specialize L_ih (by use a'; rw hr),
    repeat {rw drop_units at *},
    simp,
    cases L_hd with a b,
    cases a,
    { simp,
      cases L_ih with t' ht',
      use (a, b) :: t',
      simp,
      exact ht' },
    { rw drop_unit,
      simp,
      exact L_ih } },
end

lemma nil_padding_nil : [] ∈ paddings ([] : list (α × bool)) :=
begin
  rw [paddings, pad_end, pad_all],
  simp only [foldl_nil, matches_mul,
             matches_epsilon, matches_star,
            matches_char, one_mul],
  rw [language.star_def],
  simp only [set.mem_singleton_iff, set.mem_set_of_eq],
  simp,
  use ({}),
  split,
  exact rfl,
  intros y hy,
  exact false.rec (y = [(inr (), ff)]) hy,
end

private lemma nil_not_pad_letter (x : α × bool) : [] ∉ (pad_letter x).matches :=
begin
  assume h',
  cases x with x b,
  cases b,
  repeat
  {
    rw pad_letter at *,
    simp at *,
    rw language.mem_mul at *,
    rcases h' with ⟨a, b, h₁, h₂, h₃⟩,
    simp at *,
    cases h₃ with hl hr,
    rw h₂ at *,
    simp at *,
    exact hr,
  },
end

private lemma nil_pad_all_iff : [] ∈ (pad_all L).matches ↔ L = [] :=
begin
  induction L,
  simp,
  {
    rw pad_all,
    simp,
  },
  { rw pad_all,
  simp,
  assume this,
  rw language.mem_mul at *,
  rcases this with ⟨a, b, h₁, h₂, h₃⟩,
  simp at *,
  cases h₃ with hl hr,
  subst_vars,
  have := nil_not_pad_letter L_hd,
  contradiction, }
end

lemma nil_padding_iff : [] ∈ paddings L ↔ L = [] :=
begin
  split,
  intro h,
  rw paddings at *,
  rw pad_end at *,
  rw pad_all at *,
  simp at *,
  rw language.mem_mul at *,
  rcases h with ⟨a, b, h₁, h₂, h₃⟩,
  simp at *,
  cases h₃ with hl hr,
  subst_vars,
  rw [← pad_all, nil_pad_all_iff] at h₁,
  exact h₁,
  intro h,
  rw h,
  exact nil_padding_nil,
end

lemma pad_all_append :
L' ∈ (pad_all L).matches → L₁' ∈ (pad_all L₁).matches →
(L' ++ L₁') ∈ (pad_all (L ++ L₁)).matches :=
begin
  intros h h₁,
  rw pad_all at *,
  simp,
  exact set.mem_image2_of_mem h h₁,
end

private lemma pad_letter_drop_units {x : α × bool} :
drop_units '' (pad_letter x).matches = {[x]} :=
begin
  cases x with a b,
  cases b,
  rw pad_letter,
  simp,
  rw [language.image_hom_mul_eq drop_units_hom,
      language.image_hom_mul_eq drop_units_hom],
  simp,
  rw [drop_units, drop_units],
  simp,
  rw language.mul_def,
  simp,
  {
    rw [drop_units_star, language.mul_def],
    simp,
  },
  rw pad_letter,
  simp,
  rw language.image_hom_mul_eq drop_units_hom,
  simp,
  rw [drop_units, drop_units],
  simp,
  rw language.mul_def,
  simp,
end

private lemma pad_all_drop_units {L : list (α × bool)} (H : L ≠ []):
drop_units '' ((pad_all L).matches) = {L} :=
begin
  induction L,
  rw pad_all,
  simp,
  contradiction,
  rw pad_all at *,
  simp at *,
  rw language.image_hom_mul_eq drop_units_hom,
  cases L_tl,
  simp,
  rw [pad_letter_drop_units, drop_units_one, language.mul_def],
  simp,
  specialize L_ih (cons_ne_nil _ _),
  rw [L_ih, pad_letter_drop_units, language.mul_def],
  simp,
end

private lemma pad_end_drop_units  {L : list (α × bool)} (H : L ≠ []):
drop_units '' ((pad_end L).matches) = {L} :=
begin
  rw pad_end,
  simp,
  rw [language.image_hom_mul_eq drop_units_hom,
  pad_all_drop_units H, drop_units_star,
  language.mul_def],
  simp,
end

lemma paddings_drop_units_eq (H : L ≠ []) :
L' ∈ paddings L → drop_units L' = L :=
begin
  intro h,
  rw paddings at *,
  have h₁ := pad_end_drop_units H,
  have h₂ : drop_units L' ∈ drop_units '' (pad_end L).matches :=
    set.mem_image_of_mem drop_units h,
  have h₃ : drop_units L' ∈ {L} := by rw ← h₁; exact h₂,
  simp at *,
  exact h₃,
end

lemma pad_all_drop_units_eq (H : L ≠ []) :
L' ∈ (pad_all L).matches → drop_units L' = L :=
begin
  intro h,
  have h₁ := pad_all_drop_units H,
  have h₂ : drop_units L' ∈ drop_units '' (pad_all L).matches :=
    set.mem_image_of_mem drop_units h,
  have h₃ : drop_units L' ∈ {L} := by rw ← h₁; exact h₂,
  simp at *,
  exact h₃,
end

lemma pad_letter_to_pad_all {x : α × bool} :
L' ∈ (pad_letter x).matches → L' ∈ (pad_all [x]).matches :=
begin
  intro h,
  rw pad_all,
  simp,
  exact h,
end

lemma pad_all_to_paddings :
L' ∈ (pad_all L).matches → L' ∈ paddings L :=
begin
  intro h,
  rw paddings,
  rw pad_end,
  simp,
  rw language.mem_mul,
  use L',
  use ([]),
  split,
  exact h,
  split,
  {
    rw language.mem_star,
    use ([]),
    split,
    simp,
    intros y hy,
    exact false.rec (y ∈ {[(inr (), ff)]}) hy,
  },
  simp,
end

lemma pad_all_append_paddings :
L' ∈ (pad_all L).matches → L₁' ∈ (paddings L₁) → L' ++ L₁' ∈ paddings (L ++ L₁) :=
begin
  intros h h₁,
  rw [paddings, pad_end] at *,
  simp at *,
  rw language.mem_mul at *,
  rcases h₁ with ⟨a, b, h₁, h₂, h₃⟩,
  use [L' ++ a, b],
  split,
  exact pad_all_append h h₁,
  split,
  exact h₂,
  subst_vars,
  rw list.append_assoc,
end

lemma paddings_append_neg :
L' ∈ paddings L → L' ++ [(@inr α unit (), ff)] ∈ paddings L :=
begin
  intro h,
  rw [paddings, pad_end] at *,
  simp at *,
  rw language.mem_mul at *,
  rcases h with ⟨a, b, h₁, h₂, h₃⟩,
  use a,

  use (b ++ [(@inr α unit (), ff)]),
  split,
  exact h₁,
  split,
  {
    rw language.mem_star at *,
    rcases h₂ with ⟨S, h₄, h₅⟩,
    use (S ++ [[(inr (), ff)]]),
    split,
    simp,
    rw h₄,
    intros y hy,
    simp at hy,
    cases hy,
    {
      exact h₅ y hy,
    },
    {
      simp,
      exact hy,
    },
  },
  rw [← list.append_assoc, h₃],
end

lemma split_pad_all:
L' ∈ (pad_all (L ++ L₁)).matches →
∃ L₂ L₃,
L₂ ∈ (pad_all L).matches ∧
L₃ ∈ (pad_all L₁).matches ∧
L' = L₂ ++ L₃ :=
begin
  intro h,
  rw pad_all at *,
  simp at *,
  rw language.mem_mul at *,
  rcases h with ⟨a, b, h₁, h₂, h₃⟩,
  use a,
  split,
  exact h₁,
  use b,
  split,
  exact h₂,
  exact h₃.symm,
end

lemma split_paddings :
L' ∈ paddings (L ++ L₁) →
∃ L₂ L₃ L₄,
L₂ ∈ (pad_all L).matches ∧
L₃ ∈ (pad_all L₁).matches ∧
L₄ ∈ (star $ char (@inr α unit (), ff)).matches ∧
L' = L₂ ++ L₃ ++ L₄ :=
begin
  intro h,
  rw paddings at *,
  rw pad_end at *,
  simp at *,
  rw language.mem_mul at *,
  rcases h with ⟨a, b, h₁, h₂, h₃⟩,
  have h₄ := split_pad_all h₁,
  rcases h₄ with ⟨L₂, L₃, h₄, h₅, h₆⟩,
  subst_vars,
  use L₂,
  split,
  exact h₄,
  use L₃,
  split,
  exact h₅,
  use b,
  split,
  exact h₂,
  rw list.append_assoc,
end

lemma split_paddings₁ :
L' ∈ paddings (L ++ L₁) →
∃ L₂ L₃,
L₂ ∈ (pad_all L).matches ∧
L₃ ∈ (paddings L₁) ∧
L' = L₂ ++ L₃ :=
begin
  intro h,
  rw paddings at *,
  rw pad_end at *,
  simp at *,
  rw language.mem_mul at *,
  rcases h with ⟨a, b, h₁, h₂, h₃⟩,
  have h₄ := split_pad_all h₁,
  rcases h₄ with ⟨L₂, L₃, h₄, h₅, h₆⟩,
  subst_vars,
  use L₂,
  split,
  exact h₄,
  use (L₃ ++ b),
  split,
  rw language.mem_mul,
  use [L₃, b],
  split,
  exact h₅,
  split,
  exact h₂,
  refl,
  rw ← list.append_assoc,
end

private lemma pad_all_neg_cons :
(inr (), ff) :: L' ∈ (pad_all L).matches →
∃ L₁ (x : α), L = (x, ff) :: L₁  :=
begin
  intro h,
  cases L,
  {simp at *,
  rw pad_all at *,
  simp at *,
  exact h,
  },
  {
    cases L_hd with x b,
    rw pad_all at *,
    simp at *,
    rw language.mem_mul at *,
    rcases h with ⟨c, d, h₁, h₂, h₃⟩,
    rw append_eq_cons_iff at *,
    cases h₃,
    {
      cases h₃ with hl hr,
      subst_vars,
      have := nil_not_pad_letter (x, b),
      contradiction,
    },
    {
      rcases h₃ with ⟨e, hl, hr⟩,
      subst_vars,
      cases b,
      refl,
      rw pad_letter at *,
      simp at *,
      rw language.mem_mul at *,
      rcases h₁ with ⟨a, b, h₁, h₂, h₃⟩,
      simp at *,
      subst_vars,
      simp at *,
      exact h₃,
    }
  }
end

lemma pad_neg_cons :
(inr (), ff) :: L' ∈ paddings L →
L = [] ∨ ∃ L₁ (x : α), L = (x, ff) :: L₁ :=
begin
  intro h,
  rw [paddings, pad_end, pad_all] at *,
  simp at *,
  rw language.mem_mul at *,
  rcases h with ⟨a, b, h₁, h₂, h₃⟩,
  rw append_eq_cons_iff at *,
  cases h₃,
  {
    cases h₃ with _ _,
    subst_vars,
    rw ← pad_all at *,
    rw nil_pad_all_iff at *,
    left,
    exact h₁,
  },
  {
    rcases h₃ with ⟨a', hl, hr⟩,
    subst_vars,
    rw ← pad_all at *,
    right,
    exact (pad_all_neg_cons h₁),
  }
end

private lemma pad_letter_end_pos {x : α} {b : bool} :
L' ∈ (pad_letter (x, b)).matches →
∃ L₁', L' = L₁' ++ [(inl x, b), (@inr α unit (), tt)]  :=
begin
  intro h,
  cases b,
  { rw pad_letter at h,
    simp at h,
    rw language.mem_mul at *,
    rcases h with ⟨a', b', h₁, h₂, h₃⟩,
    rw language.mem_mul at *,
    rcases h₁ with ⟨c', d', h₄, h₅, h₆⟩,
    subst_vars,
    simp at *,
    use (c'),
    subst_vars,
    simp },
  { rw pad_letter at h,
    simp at h,
    rw language.mem_mul at *,
    rcases h with ⟨a', b', h₁, h₂, h₃⟩,
    simp at *,
    subst_vars,
    use ([]),
    simp }
end

lemma pad_all_end_letter (H : L ≠ []):
L' ∈ (pad_all L).matches →
∃ L₁' (x : α) (b : bool), L' = L₁' ++ [(inl x, b), (@inr α unit (), tt)] :=
begin
  intro h,
  generalize eq₁: last L H = x,
  cases x with x b,
  have h₁ := list.last_split H,
  cases h₁ with L₁ h₁,
  rw eq₁ at *,
  rw h₁ at h,
  rw pad_all at *,
  simp at h,
  rw language.mem_mul at h,
  rcases h with ⟨a', b', h₂, h₃, h₄⟩,
  have h₅ := pad_letter_end_pos h₃,
  cases h₅ with c' h₅,
  use (a' ++ c'),
  use x,
  use b,
  subst_vars,
  simp,
end

lemma pad_all_end_pos (H : L ≠ []):
L' ∈ (pad_all L).matches →
∃ L₁', L' = L₁' ++ [(@inr α unit (), tt)] :=
begin
  intro h,
  have h₁ := pad_all_end_letter H h,
  rcases h₁ with ⟨L₁', x, b, h₁⟩,
  use L₁' ++  [(inl x, b)],
  simp,
  exact h₁,
end

lemma pad_all_append_neg_cons_is_pad_all {x : α ⊕ unit}:
L' ++ (x, ff) :: L₁' ∈ (pad_all L).matches →
L' ++ (inr (), ff) :: (x, ff) :: L₁' ∈ (pad_all L).matches :=
begin
  sorry,
end

lemma pad_append_neg_cons_is_padding {x : α ⊕ unit}:
L' ++ (x, ff) :: L₁' ∈ paddings L →
L' ++ (inr (), ff) :: (x, ff) :: L₁' ∈ paddings L :=
begin
  intro h,
  rw [paddings, pad_end, pad_all] at *,
  simp at *,
  rw language.mem_mul at h,
  rcases h with ⟨a, b, h₁, h₂, h₃⟩,
  rw language.mem_mul,
  rw append_eq_append_iff at h₃,
  cases h₃,
  {
    rcases h₃ with ⟨a', hl, hr⟩,
    use a,
    use (a' ++ [(inr (), ff), (x, ff)] ++ L₁'),
    split,
    exact h₁,
    split,
    {
      cases x,
      { rw language.mem_star at h₂,
        rcases h₂ with ⟨S, h₄, h₅⟩,
        rw hr at h₄,
        have h₆ : (inl x, ff) ∈ S.join, {
          rw ← h₄,
          simp,
        },
        rw mem_join at h₆,
        rcases h₆ with ⟨l, hl, hr⟩,
        specialize h₅ l hl,
        simp at *,
        rw h₅ at *,
        simp at *,
        contradiction,
      },
      {
        subst_vars,
        sorry,
      }
    },
    subst_vars,
    simp,
  },
  {
    rcases h₃ with ⟨c', hl, hr⟩,
    rw cons_eq_append_iff at hr,
    cases hr,
    {
      cases hr with hrl hrr,
      subst_vars,
      simp at *,
      use L',
      split,
      exact h₁,
      use ((inr (), ff) :: (x, ff) :: L₁'),
      split,
      sorry,
      refl,
    },
    {
      rcases hr with ⟨a', hrl, hrr⟩,
      subst_vars,
      rw ← pad_all at *,
      have := pad_all_append_neg_cons_is_pad_all h₁,
      use L' ++ (inr (), ff) :: (x, ff) :: a',
      use b,
      split,
      exact this,
      split,
      exact h₂,
      simp,
    }
  }
end

lemma pad_all_append_neg_cons_drop_units_exists :
L' ++ (inr (), ff) :: L₁' ∈ (pad_all L).matches →
∃ L₂ (x : α), drop_units L₁' = (x, ff) :: L₂ :=
begin
  sorry,
end

lemma pad_append_neg_cons_drop_units_nil_or_exists :
L' ++ (inr (), ff) :: L₁' ∈ paddings L →
drop_units L₁' = [] ∨ ∃ L₂ (x : α), drop_units L₁' = (x, ff) :: L₂ :=
begin
  intro h,
  rw paddings at *,
  rw pad_end at *,
  simp at *,
  rw language.mem_mul at *,
  rcases h with ⟨a, b, h₁, h₂, h₃⟩,
  rw append_eq_append_iff at h₃,
  cases h₃,
  {
    rcases h₃ with ⟨a', hl, hr⟩,
    left,
    sorry,
  },
  {
    rcases h₃ with ⟨c', hl, hr⟩,
    rw cons_eq_append_iff at hr,
    cases hr,
    {
      cases hr with hrl hrr,
      left,
      sorry,
    },
    {
      rcases hr with ⟨a', hrl, hrr⟩,
      subst_vars,
      right,
      have := pad_all_append_neg_cons_drop_units_exists h₁,
      rcases this with ⟨L₂, x, this⟩,
      use L₂,
      use x,
      sorry,
    }
  }
end

end paddings