/-
Copyright (c) 2019 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo, Bhavik Mehta, Yaël Dillies
-/
import analysis.normed_space.basic

/-!
# Local convexity

This file defines absorbent and balanced sets.

An absorbent set is one that "surrounds" the origin. The idea is made precise by requiring that any
point belongs to all large enough scalings of the set. This is the vector world analog of a
topological neighborhood of the origin.

A balanced set is one that is everywhere around the origin. This means that `a • s ⊆ s` for all `a`
of norm less than `1`.

## Main declarations

For a module over a normed ring:
* `absorbs`: A set `s` absorbs a set `t` if all large scalings of `s` contain `t`.
* `absorbent`: A set `s` is absorbent if every point eventually belongs to all large scalings of
  `s`.
* `balanced`: A set `s` is balanced if `a • s ⊆ s` for all `a` of norm less than `1`.

## References

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

## Tags

absorbent, balanced, locally convex, LCTVS
-/

open set
open_locale pointwise topological_space

variables {𝕜 𝕝 E ι : Type*}

section semi_normed_ring
variables [semi_normed_ring 𝕜]

section has_smul
variables (𝕜) [has_smul 𝕜 E]

/-- A set `A` absorbs another set `B` if `B` is contained in all scalings of `A` by elements of
sufficiently large norm. -/
def absorbs (A B : set E) := ∃ r, 0 < r ∧ ∀ a : 𝕜, r ≤ ∥a∥ → B ⊆ a • A

variables {𝕜} {s t u v A B : set E}

@[simp] lemma absorbs_empty {s : set E}: absorbs 𝕜 s (∅ : set E) :=
⟨1, one_pos, λ a ha, set.empty_subset _⟩

lemma absorbs.mono (hs : absorbs 𝕜 s u) (hst : s ⊆ t) (hvu : v ⊆ u) : absorbs 𝕜 t v :=
let ⟨r, hr, h⟩ := hs in ⟨r, hr, λ a ha, hvu.trans $ (h _ ha).trans $ smul_set_mono hst⟩

lemma absorbs.mono_left (hs : absorbs 𝕜 s u) (h : s ⊆ t) : absorbs 𝕜 t u := hs.mono h subset.rfl
lemma absorbs.mono_right (hs : absorbs 𝕜 s u) (h : v ⊆ u) : absorbs 𝕜 s v := hs.mono subset.rfl h

lemma absorbs.union (hu : absorbs 𝕜 s u) (hv : absorbs 𝕜 s v) : absorbs 𝕜 s (u ∪ v) :=
begin
  obtain ⟨a, ha, hu⟩ := hu,
  obtain ⟨b, hb, hv⟩ := hv,
  exact ⟨max a b, lt_max_of_lt_left ha,
    λ c hc, union_subset (hu _ $ le_of_max_le_left hc) (hv _ $ le_of_max_le_right hc)⟩,
end

@[simp] lemma absorbs_union : absorbs 𝕜 s (u ∪ v) ↔ absorbs 𝕜 s u ∧ absorbs 𝕜 s v :=
⟨λ h, ⟨h.mono_right $ subset_union_left _ _, h.mono_right $ subset_union_right _ _⟩,
  λ h, h.1.union h.2⟩

lemma absorbs_Union_finset {s : set E} {t : finset ι} {f : ι → set E} :
  absorbs 𝕜 s (⋃ (i ∈ t), f i) ↔ ∀ i ∈ t, absorbs 𝕜 s (f i) :=
begin
  classical,
  induction t using finset.induction_on with i t ht hi,
  { simp only [finset.not_mem_empty, set.Union_false, set.Union_empty, absorbs_empty,
    forall_false_left, implies_true_iff] },
  rw [finset.set_bUnion_insert, absorbs_union, hi],
  split; intro h,
  { refine λ _ hi', (finset.mem_insert.mp hi').elim _ (h.2 _),
    exact (λ hi'', by { rw hi'', exact h.1 }) },
  exact ⟨h i (finset.mem_insert_self i t), λ i' hi', h i' (finset.mem_insert_of_mem hi')⟩,
end

lemma set.finite.absorbs_Union {s : set E} {t : set ι} {f : ι → set E} (hi : t.finite) :
  absorbs 𝕜 s (⋃ (i : ι) (hy : i ∈ t), f i) ↔ ∀ i ∈ t, absorbs 𝕜 s (f i) :=
begin
  lift t to finset ι using hi,
  simp only [finset.mem_coe],
  exact absorbs_Union_finset,
end

variables (𝕜)

/-- A set is absorbent if it absorbs every singleton. -/
def absorbent (A : set E) := ∀ x, ∃ r, 0 < r ∧ ∀ a : 𝕜, r ≤ ∥a∥ → x ∈ a • A

variables {𝕜}

lemma absorbent.subset (hA : absorbent 𝕜 A) (hAB : A ⊆ B) : absorbent 𝕜 B :=
begin
  refine forall_imp (λ x, _) hA,
  exact Exists.imp (λ r, and.imp_right $ forall₂_imp $ λ a ha hx, set.smul_set_mono hAB hx),
end

lemma absorbent_iff_forall_absorbs_singleton : absorbent 𝕜 A ↔ ∀ x, absorbs 𝕜 A {x} :=
by simp_rw [absorbs, absorbent, singleton_subset_iff]

lemma absorbent.absorbs (hs : absorbent 𝕜 s) {x : E} : absorbs 𝕜 s {x} :=
absorbent_iff_forall_absorbs_singleton.1 hs _

lemma absorbent_iff_nonneg_lt : absorbent 𝕜 A ↔ ∀ x, ∃ r, 0 ≤ r ∧ ∀ ⦃a : 𝕜⦄, r < ∥a∥ → x ∈ a • A :=
forall_congr $ λ x, ⟨λ ⟨r, hr, hx⟩, ⟨r, hr.le, λ a ha, hx a ha.le⟩, λ ⟨r, hr, hx⟩,
  ⟨r + 1, add_pos_of_nonneg_of_pos hr zero_lt_one,
    λ a ha, hx ((lt_add_of_pos_right r zero_lt_one).trans_le ha)⟩⟩

lemma absorbent.absorbs_finite {s : set E} (hs : absorbent 𝕜 s) {v : set E} (hv : v.finite) :
  absorbs 𝕜 s v :=
begin
  rw ←set.bUnion_of_singleton v,
  exact hv.absorbs_Union.mpr (λ _ _, hs.absorbs),
end

variables (𝕜)

/-- A set `A` is balanced if `a • A` is contained in `A` whenever `a` has norm at most `1`. -/
def balanced (A : set E) := ∀ a : 𝕜, ∥a∥ ≤ 1 → a • A ⊆ A

variables {𝕜}

lemma balanced_iff_smul_mem : balanced 𝕜 s ↔ ∀ ⦃a : 𝕜⦄, ∥a∥ ≤ 1 → ∀ ⦃x : E⦄, x ∈ s → a • x ∈ s :=
forall₂_congr $ λ a ha, smul_set_subset_iff

alias balanced_iff_smul_mem ↔ balanced.smul_mem _

lemma balanced_univ : balanced 𝕜 (univ : set E) := λ a ha, subset_univ _

lemma balanced.union (hA : balanced 𝕜 A) (hB : balanced 𝕜 B) : balanced 𝕜 (A ∪ B) :=
begin
  intros a ha t ht,
  rw smul_set_union at ht,
  exact ht.imp (λ x, hA _ ha x) (λ x, hB _ ha x),
end

lemma balanced.inter (hA : balanced 𝕜 A) (hB : balanced 𝕜 B) : balanced 𝕜 (A ∩ B) :=
begin
  rintro a ha _ ⟨x, ⟨hx₁, hx₂⟩, rfl⟩,
  exact ⟨hA _ ha ⟨_, hx₁, rfl⟩, hB _ ha ⟨_, hx₂, rfl⟩⟩,
end

end has_smul

section add_comm_monoid
variables [add_comm_monoid E] [module 𝕜 E] {s s' t t' u v A B : set E}

lemma absorbs.add (h : absorbs 𝕜 s t) (h' : absorbs 𝕜 s' t') : absorbs 𝕜 (s + s') (t + t') :=
begin
  rcases h with ⟨r, hr, h⟩,
  rcases h' with ⟨r', hr', h'⟩,
  refine ⟨max r r', lt_max_of_lt_left hr, λ a ha, _⟩,
  rw smul_add,
  exact set.add_subset_add (h a (le_of_max_le_left ha)) (h' a (le_of_max_le_right ha)),
end

lemma balanced.add (hA₁ : balanced 𝕜 A) (hA₂ : balanced 𝕜 B) : balanced 𝕜 (A + B) :=
begin
  rintro a ha _ ⟨_, ⟨x, y, hx, hy, rfl⟩, rfl⟩,
  rw smul_add,
  exact add_mem_add (hA₁ _ ha ⟨_, hx, rfl⟩) (hA₂ _ ha ⟨_, hy, rfl⟩),
end

lemma balanced_zero : balanced 𝕜 (0 : set E) := λ a ha, (smul_zero _).subset

end add_comm_monoid
end semi_normed_ring

section normed_comm_ring
variables [normed_comm_ring 𝕜] [add_comm_monoid E] [module 𝕜 E] {A B : set E} (a : 𝕜)

lemma balanced.smul (hA : balanced 𝕜 A) : balanced 𝕜 (a • A) :=
begin
  rintro b hb _ ⟨_, ⟨x, hx, rfl⟩, rfl⟩,
  exact ⟨b • x, hA _ hb ⟨_, hx, rfl⟩, smul_comm _ _ _⟩,
end

end normed_comm_ring

section normed_field
variables [normed_field 𝕜] [normed_ring 𝕝] [normed_space 𝕜 𝕝] [add_comm_group E] [module 𝕜 E]
  [smul_with_zero 𝕝 E] [is_scalar_tower 𝕜 𝕝 E] {s t u v A B : set E} {a b : 𝕜}

/-- Scalar multiplication (by possibly different types) of a balanced set is monotone. -/
lemma balanced.smul_mono (hs : balanced 𝕝 s) {a : 𝕝} {b : 𝕜} (h : ∥a∥ ≤ ∥b∥) : a • s ⊆ b • s :=
begin
  obtain rfl | hb := eq_or_ne b 0,
  { rw norm_zero at h,
    rw norm_eq_zero.1 (h.antisymm $ norm_nonneg _),
    obtain rfl | h := s.eq_empty_or_nonempty,
    { simp_rw [smul_set_empty] },
    { simp_rw [zero_smul_set h] } },
  rintro _ ⟨x, hx, rfl⟩,
  refine ⟨b⁻¹ • a • x, _, smul_inv_smul₀ hb _⟩,
  rw ←smul_assoc,
  refine hs _ _ (smul_mem_smul_set hx),
  rw [norm_smul, norm_inv, ←div_eq_inv_mul],
  exact div_le_one_of_le h (norm_nonneg _),
end

/-- A balanced set absorbs itself. -/
lemma balanced.absorbs_self (hA : balanced 𝕜 A) : absorbs 𝕜 A A :=
begin
  refine ⟨1, zero_lt_one, λ a ha x hx, _⟩,
  rw mem_smul_set_iff_inv_smul_mem₀ (norm_pos_iff.1 $ zero_lt_one.trans_le ha),
  refine hA a⁻¹ _ (smul_mem_smul_set hx),
  rw norm_inv,
  exact inv_le_one ha,
end

lemma balanced.subset_smul (hA : balanced 𝕜 A) (ha : 1 ≤ ∥a∥) : A ⊆ a • A :=
begin
  refine (subset_set_smul_iff₀ _).2 (hA (a⁻¹) _),
  { rintro rfl,
    rw norm_zero at ha,
    exact zero_lt_one.not_le ha },
  { rw norm_inv,
    exact inv_le_one ha }
end

lemma balanced.smul_eq (hA : balanced 𝕜 A) (ha : ∥a∥ = 1) : a • A = A :=
(hA _ ha.le).antisymm $ hA.subset_smul ha.ge

lemma absorbs.inter (hs : absorbs 𝕜 s u) (ht : absorbs 𝕜 t u) : absorbs 𝕜 (s ∩ t) u :=
begin
  obtain ⟨a, ha, hs⟩ := hs,
  obtain ⟨b, hb, ht⟩ := ht,
  have h : 0 < max a b := lt_max_of_lt_left ha,
  refine ⟨max a b, lt_max_of_lt_left ha, λ c hc, _⟩,
  rw smul_set_inter₀ (norm_pos_iff.1 $ h.trans_le hc),
  exact subset_inter (hs _ $ le_of_max_le_left hc) (ht _ $ le_of_max_le_right hc),
end

@[simp] lemma absorbs_inter : absorbs 𝕜 (s ∩ t) u ↔ absorbs 𝕜 s u ∧ absorbs 𝕜 t u :=
⟨λ h, ⟨h.mono_left $ inter_subset_left _ _, h.mono_left $ inter_subset_right _ _⟩,
  λ h, h.1.inter h.2⟩

lemma absorbent_univ : absorbent 𝕜 (univ : set E) :=
begin
  refine λ x, ⟨1, zero_lt_one, λ a ha, _⟩,
  rw smul_set_univ₀ (norm_pos_iff.1 $ zero_lt_one.trans_le ha),
  exact trivial,
end

variables [topological_space E] [has_continuous_smul 𝕜 E]

/-- Every neighbourhood of the origin is absorbent. -/
lemma absorbent_nhds_zero (hA : A ∈ 𝓝 (0 : E)) : absorbent 𝕜 A :=
begin
  intro x,
  obtain ⟨w, hw₁, hw₂, hw₃⟩ := mem_nhds_iff.mp hA,
  have hc : continuous (λ t : 𝕜, t • x) := continuous_id.smul continuous_const,
  obtain ⟨r, hr₁, hr₂⟩ := metric.is_open_iff.mp (hw₂.preimage hc) 0
    (by rwa [mem_preimage, zero_smul]),
  have hr₃ := inv_pos.mpr (half_pos hr₁),
  refine ⟨(r / 2)⁻¹, hr₃, λ a ha₁, _⟩,
  have ha₂ : 0 < ∥a∥ := hr₃.trans_le ha₁,
  refine (mem_smul_set_iff_inv_smul_mem₀ (norm_pos_iff.mp ha₂) _ _).2 (hw₁ $ hr₂ _),
  rw [metric.mem_ball, dist_zero_right, norm_inv],
  calc ∥a∥⁻¹ ≤ r/2 : (inv_le (half_pos hr₁) ha₂).mp ha₁
  ...       < r : half_lt_self hr₁,
end

/-- The union of `{0}` with the interior of a balanced set is balanced. -/
lemma balanced_zero_union_interior (hA : balanced 𝕜 A) : balanced 𝕜 ((0 : set E) ∪ interior A) :=
begin
  intros a ha,
  obtain rfl | h := eq_or_ne a 0,
  { rw zero_smul_set,
    exacts [subset_union_left _ _, ⟨0, or.inl rfl⟩] },
  { rw [←image_smul, image_union],
    apply union_subset_union,
    { rw [image_zero, smul_zero],
      refl },
    { calc a • interior A ⊆ interior (a • A) : (is_open_map_smul₀ h).image_interior_subset A
                      ... ⊆ interior A       : interior_mono (hA _ ha) } }
end

/-- The interior of a balanced set is balanced if it contains the origin. -/
lemma balanced.interior (hA : balanced 𝕜 A) (h : (0 : E) ∈ interior A) : balanced 𝕜 (interior A) :=
begin
  rw ←union_eq_self_of_subset_left (singleton_subset_iff.2 h),
  exact balanced_zero_union_interior hA,
end

lemma balanced.closure (hA : balanced 𝕜 A) : balanced 𝕜 (closure A) :=
λ a ha,
  (image_closure_subset_closure_image $ continuous_id.const_smul _).trans $ closure_mono $ hA _ ha

end normed_field

section nondiscrete_normed_field
variables [nondiscrete_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] {s : set E}

lemma absorbs_zero_iff : absorbs 𝕜 s 0 ↔ (0 : E) ∈ s :=
begin
  refine ⟨_, λ h, ⟨1, zero_lt_one, λ a _, zero_subset.2 $ zero_mem_smul_set h⟩⟩,
  rintro ⟨r, hr, h⟩,
  obtain ⟨a, ha⟩ := normed_space.exists_lt_norm 𝕜 𝕜 r,
  have := h _ ha.le,
  rwa [zero_subset, zero_mem_smul_set_iff] at this,
  exact norm_ne_zero_iff.1 (hr.trans ha).ne',
end

lemma absorbent.zero_mem (hs : absorbent 𝕜 s) : (0 : E) ∈ s :=
absorbs_zero_iff.1 $ absorbent_iff_forall_absorbs_singleton.1 hs _

end nondiscrete_normed_field


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import logic.relation
import combinatorics.simplicial_complex.closure

namespace affine
open set relation
open_locale classical
variables {a b m n : ℕ} {E : Type*} [normed_group E] [normed_space ℝ E]
  {S S' S₁ S₂ : simplicial_complex E} {X Y Z : finset E}

--to add to mathlib?
lemma curry_eq_of_symmetric_transitive {α : Type*} {R : α → α → Prop} {a b : α}
  (hRsymm : symmetric R) (hRtrans : transitive R) (hab : R a b) :
  R a = R b :=
funext $ λ c, propext ⟨hRtrans (hRsymm hab), hRtrans hab⟩

def adjacent (X Y : finset E) :
  Prop :=
X.card = (X ∩ Y).card + 1 ∧ Y.card = (X ∩ Y).card + 1

lemma adjacent.symmetric :
  symmetric (adjacent : finset E → finset E → Prop) :=
begin
  rintro X Y ⟨hX, hY⟩,
  rw finset.inter_comm at hX hY,
  exact ⟨hY, hX⟩,
end

lemma adjacent.symm :
  adjacent X Y ↔ adjacent Y X :=
begin
  split;
  apply adjacent.symmetric,
end

lemma card_eq_of_adjacent (hX : X ∈ S.faces) (hY : adjacent X Y) :
  Y.card = X.card :=
eq.trans hY.2 hY.1.symm

def simplicial_complex.glued (S : simplicial_complex E) :
  finset E → finset E → Prop :=
refl_trans_gen (λ X Y, adjacent X Y ∧ X ∈ S.facets ∧ Y ∈ S.facets)

lemma glued.refl :
  S.glued X X :=
refl_trans_gen.refl

lemma glued.symmetric :
  symmetric S.glued :=
begin
  apply refl_trans_gen.symmetric,
  rintro X Y ⟨hXY, hX, hY⟩,
  rw adjacent.symm at hXY,
  exact ⟨hXY, hY, hX⟩,
end

lemma glued.symm :
  S.glued X Y ↔ S.glued Y X :=
begin
  split;
  apply glued.symmetric,
end

lemma glued.transitive :
  transitive S.glued :=
transitive_refl_trans_gen

lemma glued.trans (hXY : S.glued X Y) (hYZ : S.glued Y Z) :
  S.glued X Z :=
transitive_refl_trans_gen hXY hYZ

instance : is_equiv (finset E) S.glued :=
{ refl := reflexive_refl_trans_gen,
  trans := transitive_refl_trans_gen,
  symm := glued.symmetric }

lemma face_of_glued (hX : X ∈ S.faces) (hXY : S.glued X Y) :
  Y ∈ S.faces :=
begin
  cases refl_trans_gen.cases_tail hXY,
  { rw h,
    exact hX },
  { obtain ⟨W, _, _, _, hY⟩ := h,
    exact hY.1 }
end

lemma facet_of_glued (hX : X ∈ S.facets) (hXY : S.glued X Y) :
  Y ∈ S.facets :=
begin
  cases refl_trans_gen.cases_tail hXY,
  { rw h,
    exact hX },
  { obtain ⟨W, _, _, _, hY⟩ := h,
    exact hY }
end

lemma card_eq_of_glued (hY : S.glued X Y) :
  Y.card = X.card :=
refl_trans_gen.trans_induction_on hY
  (λ _, rfl)
  (λ X Y ⟨hXY, hX, _⟩, card_eq_of_adjacent hX.1 hXY)
  (λ X Y Z _ _ hYX hZY, eq.trans hZY hYX)

lemma setof_glued_subset (hX : X ∈ S.faces) :
  set_of (S.glued X) ⊆ S.faces :=
λ Y hY, face_of_glued hX hY

lemma setof_glued_attop ⦃Y Z : finset E⦄ (hY : Y ∈ set_of (S.glued X))
  (hZ : Z ∈ set_of (S.glued X)) (hYZ : Y ⊆ Z) :
  Y = Z :=
begin
  apply finset.eq_of_subset_of_card_le hYZ (le_of_eq _),
  rw [card_eq_of_glued hY, card_eq_of_glued hZ],
end

def simplicial_complex.pure_decomp (S : simplicial_complex E) :
  set (simplicial_complex E) :=
(λ X, S.closure (set_of (S.glued X))) '' S.facets

lemma pure_decomp_faces_subset (hS : S' ∈ S.pure_decomp) :
  S'.faces ⊆ S.faces :=
begin
  obtain ⟨_, _, rfl⟩ := hS,
  exact λ X hX, closure_subset hX,
end

lemma card_le_of_mem_element_pure_decomp (hY : Y ∈ (S.closure (set_of (S.glued X))).faces) :
  Y.card ≤ X.card :=
begin
  obtain ⟨hY, Z, hZ, hYZ⟩ := hY,
  rw ←card_eq_of_glued hZ,
  exact finset.card_le_of_subset hYZ,
end

lemma facet_pure_decomp_self (hX : X ∈ S.faces) :
  X ∈ (S.closure (set_of (S.glued X))).facets :=
⟨⟨hX, ⟨X, glued.refl, finset.subset.refl _⟩⟩, (λ Y hY hXY, finset.eq_of_subset_of_card_le hXY
  (card_le_of_mem_element_pure_decomp hY))⟩

lemma mem_pure_decomp_facets_iff (hX : X ∈ S.faces) :
  Y ∈ (S.closure (set_of (S.glued X))).facets ↔ S.glued X Y :=
by rw [closure_facets_eq (setof_glued_subset hX) setof_glued_attop, mem_set_of_eq]

lemma pure_decomp_facet_iff (hS : S' ∈ S.pure_decomp) :
  X ∈ S'.facets ↔ X ∈ S.faces ∧ S' = S.closure (set_of (S.glued X)) :=
begin
  split,
  { rintro hX,
    obtain ⟨Y, hY, rfl⟩ := hS,
    use closure_subset (facets_subset hX),
    rw mem_pure_decomp_facets_iff hY.1 at hX,
    rw ←curry_eq_of_symmetric_transitive glued.symmetric glued.transitive hX },
  { rintro ⟨hX, rfl⟩,
    exact ⟨faces_subset_closure ⟨hX, glued.refl⟩, (λ Y hY hXY,
      finset.eq_of_subset_of_card_le hXY (card_le_of_mem_element_pure_decomp hY))⟩ }
end

lemma pure_decomp_cover_facets (hX : X ∈ S.facets) :
  ∃ {S' : simplicial_complex E}, S' ∈ S.pure_decomp ∧ X ∈ S'.facets :=
begin
  use S.closure (set_of (S.glued X)),
  split,
  { use [X, hX] },
  use [faces_subset_closure ⟨hX.1, glued.refl⟩],
  rintro Y hY hXY,
  exact hX.2 (closure_subset hY) hXY,
end

lemma pure_decomp_disjoint_facets (hS₁ : S₁ ∈ S.pure_decomp)
  (hS₂ : S₂ ∈ S.pure_decomp) (hX : X ∈ S.facets) (hX₁ : X ∈ S₁.facets) (hX₂ : X ∈ S₂.facets) :
  S₁ = S₂ :=
begin
  obtain ⟨Y₁, hY₁, rfl⟩ := hS₁,
  obtain ⟨Y₂, hY₂, rfl⟩ := hS₂,
  simp at ⊢ hX₁ hX₂,
  rw mem_pure_decomp_facets_iff hY₁.1 at hX₁,
  rw mem_pure_decomp_facets_iff hY₂.1 at hX₂,
  rw ←curry_eq_of_symmetric_transitive glued.symmetric glued.transitive
    (glued.trans hX₁ (glued.symmetric hX₂)),
end

lemma pure_decomp_cover [finite_dimensional ℝ E] (hX : X ∈ S.faces) :
  ∃ {S' : simplicial_complex E}, S' ∈ S.pure_decomp ∧ X ∈ S'.faces :=
begin
  obtain ⟨Y, hY, hXY⟩ := subfacet hX,
  obtain ⟨S', hS', hYS'⟩ := pure_decomp_cover_facets hY,
  exact ⟨S', hS', S'.down_closed hYS'.1 hXY⟩,
end

lemma pure_decomp_facets_subset (hS : S' ∈ S.pure_decomp) (hX : X ∈ S'.facets) :
  X ∈ S.facets :=
begin
  obtain ⟨Y, hY, rfl⟩ := hS,
  exact facet_of_glued hY ((mem_pure_decomp_facets_iff hY.1).1 hX),
end

--lemma pure_decomp_facets_partition :

lemma pure_of_mem_pure_decomp (hS : S' ∈ S.pure_decomp) :
  S'.pure :=
begin
  obtain ⟨Y, hY, rfl⟩ := hS,
  exact ⟨Y.card, (λ X hX, card_eq_of_glued ((mem_pure_decomp_facets_iff hY.1).1 hX))⟩,
end

lemma pure_of_pure_decomp_singleton (hS : S.pure_decomp = {S}) :
  S.pure :=
begin
  refine pure_of_mem_pure_decomp (_ : S ∈ S.pure_decomp),
  rw hS,
  exact mem_singleton _,
end

lemma pure_decomp_space_subset_space :
  (⋃ (S' ∈ S.pure_decomp), (S' : simplicial_complex E).space) ⊆ S.space :=
begin
  rintro x hx,
  rw mem_bUnion_iff at hx,
  obtain ⟨S', hS', hx⟩ := hx,
  obtain ⟨X, hX, hxX⟩ := mem_space_iff.1 hx,
  exact mem_space_iff.2 ⟨X, pure_decomp_faces_subset hS' hX, hxX⟩,
end

lemma pure_decomp_space_eq_space [finite_dimensional ℝ E] :
  (⋃ (S' ∈ S.pure_decomp), (S' : simplicial_complex E).space) = S.space :=
begin
  apply subset.antisymm pure_decomp_space_subset_space,
  rintro x hx,
  obtain ⟨X, hX, hxX⟩ := mem_space_iff.1 hx,
  obtain ⟨S', hS', hx⟩ := pure_decomp_cover hX,
  exact mem_bUnion hS' (mem_space_iff.2 ⟨X, hx, hxX⟩),
end

end affine


import tactic
import data.real.basic
import data.set.prod
import algebra.big_operators.finprod

namespace set

lemma inter_idem {α : Type*} (A : set α)
  : A ∩ A = A := inf_idem

lemma inter_eq_inter_inter {α : Type*} (A B : set α)
  : A ∩ B ∩ B = A ∩ B := by rw [inter_assoc, inter_idem]

lemma disjoint_inter_inter_compl {α : Type*} (A B : set α)
  : disjoint (A ∩ B) (A ∩ Bᶜ) :=
begin
  apply disjoint.inter_left',
  apply disjoint.inter_right',
  rw [disjoint_iff_inter_eq_empty, inter_compl_self]
end

lemma disjoint_diff_diff {α : Type*} (A B : set α) : disjoint (A \ B) (B \ A)
  := disjoint_of_subset_left (diff_subset A B) disjoint_diff

lemma disjoint_diff_union_diff_inter {α : Type*} (A B : set α) : disjoint (A \ B ∪ B \ A) (A ∩ B)
  :=
begin
  rw disjoint_union_left,
  split;
  [ apply disjoint_of_subset_right (inter_subset_right  A B),
    apply disjoint_of_subset_right (inter_subset_left   A B)];
  { rw disjoint.comm, apply disjoint_diff }
end

theorem disjoint_bUnion_left {α : Type*} {t : set α} {ι : Sort*} {I : set ι} {s : ι → set α} :
disjoint (⋃ i ∈ I, s i) t ↔ ∀ i ∈ I, disjoint (s i) t :=
begin
  rw disjoint_Union_left, split; intros H i; specialize H i,
  { rwa disjoint_Union_left at H },
  { rwa disjoint_Union_left }
end

lemma nat_ico_range_succ_eq_union (n : ℕ) : Ico 0 (n + 1) = insert n (Ico 0 n) :=
begin
  ext, rw [mem_insert_iff, mem_Ico, mem_Ico, nat.lt_succ_iff_lt_or_eq], finish
end

lemma nat_ico_range_nmem (n : ℕ) : n ∉ Ico 0 n := by apply right_mem_Ico.mp

lemma nat_ico_range_finite (n : ℕ) : (Ico 0 n).finite :=
begin
  induction n with n ih,
  { rw Ico_self, apply finite_empty },
  { rw nat_ico_range_succ_eq_union,
    apply set.finite.insert _ ih
  }
end

lemma bUnion_range_succ {X : Type*} (A : ℕ → set X) (n : ℕ) :
  (⋃ i ∈ Ico 0 (n + 1), A i) = (⋃ (i ∈ Ico 0 n), A i) ∪ A n :=
begin
  rw [nat_ico_range_succ_eq_union, bUnion_insert, union_comm]
end

end set

open_locale big_operators

open set

theorem finsum_mem_nonneg {α : Sort*} {M : Type*} {s : set α} [ordered_add_comm_monoid M] {f : α → M} (hf : ∀ i ∈ s, 0 ≤ f i) :
0 ≤ ∑ᶠ i ∈ s, f i := finsum_mem_induction _ (le_refl _) (λ _ _ _ _, add_nonneg (by assumption) (by assumption)) hf

theorem finsum_range_succ {β : Type*} [add_comm_monoid β] (f : ℕ → β) (n : ℕ) : ∑ᶠ i ∈ Ico 0 (n + 1), f i = ∑ᶠ i ∈ set.Ico 0 n, f i + f n := by rw [nat_ico_range_succ_eq_union, finsum_mem_insert _ (nat_ico_range_nmem _) (nat_ico_range_finite _), add_comm]

lemma function.support_mul₂ {α : Type*} {β : Type*} {R : Type*} [semiring R] [no_zero_divisors R] (f : α → R) (g : β → R)
: function.support (λ (xy : α × β), f xy.fst * g xy.snd) = ((function.support f) ×ˢ (function.support g)) :=
begin
  ext,
  simp only [set.mem_inter_eq, function.support_mul, set.mem_prod, function.mem_support]
end

lemma function.support_mul_finite_of_supports_finite {α : Type*} {β : Type*} {R : Type*} [semiring R] [no_zero_divisors R] {f : α → R} {g : β → R} (hf : (function.support f).finite) (hg : (function.support g).finite)
: (function.support (λ (xy : α × β), f xy.fst * g xy.snd)).finite :=
begin
  rw function.support_mul₂,
  apply set.finite.prod hf hg
end

lemma finsum_sum_mul {α : Type*} {β : Type*} {R : Type*} [semiring R] [no_zero_divisors R] {f : α → R} {g : β → R} (hf : (function.support f).finite) (hg : (function.support g).finite) : ∑ᶠ (x : α) (y : β), f x * g y = (∑ᶠ x : α, f x) * (∑ᶠ y : β, g y) :=
begin
  rw finsum_mul _ _ hf,
  rw finsum_congr, intro _,
  rw mul_finsum _ _ hg
end

lemma finsum_sum_mul_curry {α : Type*} {β : Type*} {R : Type*} [semiring R] [no_zero_divisors R] {f : α → R} {g : β → R} (hf : (function.support f).finite) (hg : (function.support g).finite) : ∑ᶠ xy : (α × β), f xy.fst * g xy.snd = (∑ᶠ x : α, f x) * (∑ᶠ y : β, g y) :=
begin
  rw finsum_curry _ (function.support_mul_finite_of_supports_finite hf hg),
  rw finsum_sum_mul hf hg
end

lemma finsum_sum_mul_curry_ish_ish {α : Type*} {β : Type*} {M : Type*} [add_comm_monoid M] {f : α → β → M} (hf : (function.support f).finite) : ∑ᶠ xy, f xy = ∑ᶠ yx, (λ yx : β × α, f (yx.snd, yx.fst)) yx :=
begin
  rw finsum_eq_of_bijective, rotate, rotate,library_search,
end

lemma finsum_sum_mul_curry_ish {α : Type*} {β : Type*} {M : Type*} [add_comm_monoid M] {f : α → β → M} (hf : (function.support f).finite) : ∑ᶠ (x : α) (y : β), f x y = ∑ᶠ (y : β) (x : α) , f x y :=
begin
  rw finsum_sum_mul_curry_ish_ish hf,
  rw ← finsum_curry (function.curry f),
end


/-
Copyright (c) 2020 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Devon Tuma
-/
import measure_theory.probability_mass_function.basic

/-!
# Monad Operations for Probability Mass Functions

This file constructs two operations on `pmf` that give it a monad structure.
`pure a` is the distribution where a single value `a` has probability `1`.
`bind pa pb : pmf β` is the distribution given by sampling `a : α` from `pa : pmf α`,
and then sampling from `pb a : pmf β` to get a final result `b : β`.

`bind_on_support` generalizes `bind` to allow binding to a partial function,
so that the second argument only needs to be defined on the support of the first argument.

-/

noncomputable theory
variables {α β γ : Type*}
open_locale classical big_operators nnreal ennreal

namespace pmf

section pure

/-- The pure `pmf` is the `pmf` where all the mass lies in one point.
  The value of `pure a` is `1` at `a` and `0` elsewhere. -/
def pure (a : α) : pmf α := ⟨λ a', if a' = a then 1 else 0, has_sum_ite_eq _ _⟩

variables (a a' : α)

@[simp] lemma pure_apply : pure a a' = (if a' = a then 1 else 0) := rfl

@[simp] lemma support_pure : (pure a).support = {a} := set.ext (λ a', by simp [mem_support_iff])

lemma mem_support_pure_iff: a' ∈ (pure a).support ↔ a' = a := by simp

instance [inhabited α] : inhabited (pmf α) := ⟨pure default⟩

section measure

variable (s : set α)

lemma to_outer_measure_pure_apply : (pure a).to_outer_measure s = if a ∈ s then 1 else 0 :=
begin
  refine (to_outer_measure_apply' (pure a) s).trans _,
  split_ifs with ha ha,
  { refine ennreal.coe_eq_one.2 ((tsum_congr (λ b, _)).trans (tsum_ite_eq a 1)),
    exact ite_eq_left_iff.2 (λ hb, symm (ite_eq_right_iff.2 (λ h, (hb $ h.symm ▸ ha).elim))) },
  { refine ennreal.coe_eq_zero.2 ((tsum_congr (λ b, _)).trans (tsum_zero)),
    exact ite_eq_right_iff.2 (λ hb, ite_eq_right_iff.2 (λ h, (ha $ h ▸ hb).elim)) }
end

/-- The measure of a set under `pure a` is `1` for sets containing `a` and `0` otherwise -/
lemma to_measure_pure_apply [measurable_space α] (hs : measurable_set s) :
  (pure a).to_measure s = if a ∈ s then 1 else 0 :=
(to_measure_apply_eq_to_outer_measure_apply (pure a) s hs).trans (to_outer_measure_pure_apply a s)

end measure

end pure

section bind

protected lemma bind.summable (p : pmf α) (f : α → pmf β) (b : β) :
  summable (λ a : α, p a * f a b) :=
begin
  refine nnreal.summable_of_le (assume a, _) p.summable_coe,
  suffices : p a * f a b ≤ p a * 1, { simpa },
  exact mul_le_mul_of_nonneg_left ((f a).coe_le_one _) (p a).2
end

/-- The monadic bind operation for `pmf`. -/
def bind (p : pmf α) (f : α → pmf β) : pmf β :=
⟨λ b, ∑'a, p a * f a b,
  begin
    apply ennreal.has_sum_coe.1,
    simp only [ennreal.coe_tsum (bind.summable p f _)],
    rw [ennreal.summable.has_sum_iff, ennreal.tsum_comm],
    simp [ennreal.tsum_mul_left, (ennreal.coe_tsum (f _).summable_coe).symm,
      (ennreal.coe_tsum p.summable_coe).symm]
  end⟩

variables (p : pmf α) (f : α → pmf β) (g : β → pmf γ)

@[simp] lemma bind_apply (b : β) : p.bind f b = ∑'a, p a * f a b := rfl

@[simp] lemma support_bind : (p.bind f).support = {b | ∃ a ∈ p.support, b ∈ (f a).support} :=
set.ext (λ b, by simp [mem_support_iff, tsum_eq_zero_iff (bind.summable p f b), not_or_distrib])

lemma mem_support_bind_iff (b : β) : b ∈ (p.bind f).support ↔ ∃ a ∈ p.support, b ∈ (f a).support :=
by simp

lemma coe_bind_apply (b : β) : (p.bind f b : ℝ≥0∞) = ∑'a, p a * f a b :=
eq.trans (ennreal.coe_tsum $ bind.summable p f b) $ by simp

@[simp] lemma pure_bind (a : α) : (pure a).bind f = f a :=
have ∀ b a', ite (a' = a) 1 0 * f a' b = ite (a' = a) (f a b) 0, from
  assume b a', by split_ifs; simp; subst h; simp,
by ext b; simp [this]

@[simp] lemma bind_pure : p.bind pure = p :=
have ∀ a a', (p a * ite (a' = a) 1 0) = ite (a = a') (p a') 0, from
  assume a a', begin split_ifs; try { subst a }; try { subst a' }; simp * at * end,
by ext b; simp [this]

@[simp] lemma bind_bind : (p.bind f).bind g = p.bind (λ a, (f a).bind g) :=
begin
  ext1 b,
  simp only [ennreal.coe_eq_coe.symm, coe_bind_apply, ennreal.tsum_mul_left.symm,
             ennreal.tsum_mul_right.symm],
  rw [ennreal.tsum_comm],
  simp [mul_assoc, mul_left_comm, mul_comm]
end

lemma bind_comm (p : pmf α) (q : pmf β) (f : α → β → pmf γ) :
  p.bind (λ a, q.bind (f a)) = q.bind (λ b, p.bind (λ a, f a b)) :=
begin
  ext1 b,
  simp only [ennreal.coe_eq_coe.symm, coe_bind_apply, ennreal.tsum_mul_left.symm,
             ennreal.tsum_mul_right.symm],
  rw [ennreal.tsum_comm],
  simp [mul_assoc, mul_left_comm, mul_comm]
end

section measure

variable (s : set β)

lemma to_outer_measure_bind_apply :
  (p.bind f).to_outer_measure s = ∑' (a : α), (p a : ℝ≥0∞) * (f a).to_outer_measure s :=
calc (p.bind f).to_outer_measure s
  = ∑' (b : β), if b ∈ s then (↑(∑' (a : α), p a * f a b) : ℝ≥0∞) else 0 :
    by simp [to_outer_measure_apply, set.indicator_apply]
  ... = ∑' (b : β), ↑(∑' (a : α), p a * (if b ∈ s then f a b else 0)) :
    tsum_congr (λ b, by split_ifs; simp)
  ... = ∑' (b : β) (a : α), ↑(p a * (if b ∈ s then f a b else 0)) :
    tsum_congr (λ b, ennreal.coe_tsum $
      nnreal.summable_of_le (by split_ifs; simp) (bind.summable p f b))
  ... = ∑' (a : α) (b : β), ↑(p a) * ↑(if b ∈ s then f a b else 0) :
    ennreal.tsum_comm.trans (tsum_congr $ λ a, tsum_congr $ λ b, ennreal.coe_mul)
  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), ↑(if b ∈ s then f a b else 0) :
    tsum_congr (λ a, ennreal.tsum_mul_left)
  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), if b ∈ s then ↑(f a b) else (0 : ℝ≥0∞) :
    tsum_congr (λ a, congr_arg (λ x, ↑(p a) * x) $ tsum_congr (λ b, by split_ifs; refl))
  ... = ∑' (a : α), ↑(p a) * (f a).to_outer_measure s :
    tsum_congr (λ a, by rw [to_outer_measure_apply, set.indicator])

/-- The measure of a set under `p.bind f` is the sum over `a : α`
  of the probability of `a` under `p` times the measure of the set under `f a` -/
lemma to_measure_bind_apply [measurable_space β] (hs : measurable_set s) :
  (p.bind f).to_measure s = ∑' (a : α), (p a : ℝ≥0∞) * (f a).to_measure s :=
(to_measure_apply_eq_to_outer_measure_apply (p.bind f) s hs).trans
  ((to_outer_measure_bind_apply p f s).trans (tsum_congr (λ a, congr_arg (λ x, p a * x)
  (to_measure_apply_eq_to_outer_measure_apply (f a) s hs).symm)))

end measure

end bind

instance : monad pmf :=
{ pure := λ A a, pure a,
  bind := λ A B pa pb, pa.bind pb }

section bind_on_support

protected lemma bind_on_support.summable (p : pmf α) (f : Π a ∈ p.support, pmf β) (b : β) :
  summable (λ a : α, p a * if h : p a = 0 then 0 else f a h b) :=
begin
  refine nnreal.summable_of_le (assume a, _) p.summable_coe,
  split_ifs,
  { refine (mul_zero (p a)).symm ▸ le_of_eq h.symm },
  { suffices : p a * f a h b ≤ p a * 1, { simpa },
    exact mul_le_mul_of_nonneg_left ((f a h).coe_le_one _) (p a).2 }
end

/-- Generalized version of `bind` allowing `f` to only be defined on the support of `p`.
  `p.bind f` is equivalent to `p.bind_on_support (λ a _, f a)`, see `bind_on_support_eq_bind` -/
def bind_on_support (p : pmf α) (f : Π a ∈ p.support, pmf β) : pmf β :=
⟨λ b, ∑' a, p a * if h : p a = 0 then 0 else f a h b,
ennreal.has_sum_coe.1 begin
  simp only [ennreal.coe_tsum (bind_on_support.summable p f _)],
  rw [ennreal.summable.has_sum_iff, ennreal.tsum_comm],
  simp only [ennreal.coe_mul, ennreal.coe_one, ennreal.tsum_mul_left],
  have : ∑' (a : α), (p a : ennreal) = 1 :=
    by simp only [←ennreal.coe_tsum p.summable_coe, ennreal.coe_one, tsum_coe],
  refine trans (tsum_congr (λ a, _)) this,
  split_ifs with h,
  { simp [h] },
  { simp [← ennreal.coe_tsum (f a h).summable_coe, (f a h).tsum_coe] }
end⟩

variables {p : pmf α} (f : Π a ∈ p.support, pmf β)

@[simp] lemma bind_on_support_apply (b : β) :
  p.bind_on_support f b = ∑' a, p a * if h : p a = 0 then 0 else f a h b :=
rfl

@[simp] lemma support_bind_on_support :
  (p.bind_on_support f).support = {b | ∃ (a : α) (h : a ∈ p.support), b ∈ (f a h).support} :=
begin
  refine set.ext (λ b, _),
  simp only [tsum_eq_zero_iff (bind_on_support.summable p f b), not_or_distrib, mem_support_iff,
    bind_on_support_apply, ne.def, not_forall, mul_eq_zero],
  exact ⟨λ hb, let ⟨a, ⟨ha, ha'⟩⟩ := hb in ⟨a, ha, by simpa [ha] using ha'⟩,
    λ hb, let ⟨a, ha, ha'⟩ := hb in ⟨a, ⟨ha, by simpa [(mem_support_iff _ a).1 ha] using ha'⟩⟩⟩
end

lemma mem_support_bind_on_support_iff (b : β) :
  b ∈ (p.bind_on_support f).support ↔ ∃ (a : α) (h : a ∈ p.support), b ∈ (f a h).support :=
by simp

/-- `bind_on_support` reduces to `bind` if `f` doesn't depend on the additional hypothesis -/
@[simp] lemma bind_on_support_eq_bind (p : pmf α) (f : α → pmf β) :
  p.bind_on_support (λ a _, f a) = p.bind f :=
begin
  ext b,
  simp only [bind_on_support_apply (λ a _, f a), p.bind_apply f,
    dite_eq_ite, nnreal.coe_eq, mul_ite, mul_zero],
  refine congr_arg _ (funext (λ a, _)),
  split_ifs with h; simp [h],
end

lemma coe_bind_on_support_apply (b : β) :
  (p.bind_on_support f b : ℝ≥0∞) = ∑' a, p a * if h : p a = 0 then 0 else f a h b :=
by simp only [bind_on_support_apply, ennreal.coe_tsum (bind_on_support.summable p f b),
    dite_cast, ennreal.coe_mul, ennreal.coe_zero]

lemma bind_on_support_eq_zero_iff (b : β) :
  p.bind_on_support f b = 0 ↔ ∀ a (ha : p a ≠ 0), f a ha b = 0 :=
begin
  simp only [bind_on_support_apply, tsum_eq_zero_iff (bind_on_support.summable p f b),
    mul_eq_zero, or_iff_not_imp_left],
  exact ⟨λ h a ha, trans (dif_neg ha).symm (h a ha), λ h a ha, trans (dif_neg ha) (h a ha)⟩,
end

@[simp] lemma pure_bind_on_support (a : α) (f : Π (a' : α) (ha : a' ∈ (pure a).support), pmf β) :
  (pure a).bind_on_support f = f a ((mem_support_pure_iff a a).mpr rfl) :=
begin
  refine pmf.ext (λ b, _),
  simp only [nnreal.coe_eq, bind_on_support_apply, pure_apply],
  refine trans (tsum_congr (λ a', _)) (tsum_ite_eq a _),
  by_cases h : (a' = a); simp [h],
end

lemma bind_on_support_pure (p : pmf α) :
  p.bind_on_support (λ a _, pure a) = p :=
by simp only [pmf.bind_pure, pmf.bind_on_support_eq_bind]

@[simp] lemma bind_on_support_bind_on_support (p : pmf α)
  (f : ∀ a ∈ p.support, pmf β)
  (g : ∀ (b ∈ (p.bind_on_support f).support), pmf γ) :
  (p.bind_on_support f).bind_on_support g =
    p.bind_on_support (λ a ha, (f a ha).bind_on_support
      (λ b hb, g b ((mem_support_bind_on_support_iff f b).mpr ⟨a, ha, hb⟩))) :=
begin
  refine pmf.ext (λ a, _),
  simp only [ennreal.coe_eq_coe.symm, coe_bind_on_support_apply, ← tsum_dite_right,
    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm],
  simp only [ennreal.tsum_eq_zero, ennreal.coe_eq_coe, ennreal.coe_eq_zero, ennreal.coe_zero,
    dite_eq_left_iff, mul_eq_zero],
  refine ennreal.tsum_comm.trans (tsum_congr (λ a', tsum_congr (λ b, _))),
  split_ifs,
  any_goals { ring1 },
  { have := h_1 a', simp [h] at this, contradiction },
  { simp [h_2], },
end

lemma bind_on_support_comm (p : pmf α) (q : pmf β)
  (f : ∀ (a ∈ p.support) (b ∈ q.support), pmf γ) :
  p.bind_on_support (λ a ha, q.bind_on_support (f a ha)) =
    q.bind_on_support (λ b hb, p.bind_on_support (λ a ha, f a ha b hb)) :=
begin
  apply pmf.ext, rintro c,
  simp only [ennreal.coe_eq_coe.symm, coe_bind_on_support_apply, ← tsum_dite_right,
    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm],
  refine trans (ennreal.tsum_comm) (tsum_congr (λ b, tsum_congr (λ a, _))),
  split_ifs with h1 h2 h2; ring,
end

section measure

variable (s : set β)

lemma to_outer_measure_bind_on_support_apply :
  (p.bind_on_support f).to_outer_measure s =
    ∑' (a : α), (p a : ℝ≥0) * if h : p a = 0 then 0 else (f a h).to_outer_measure s :=
let g : α → β → ℝ≥0 := λ a b, if h : p a = 0 then 0 else f a h b in
calc (p.bind_on_support f).to_outer_measure s
  = ∑' (b : β), if b ∈ s then ↑(∑' (a : α), p a * g a b) else 0 :
    by simp [to_outer_measure_apply, set.indicator_apply]
  ... = ∑' (b : β), ↑(∑' (a : α), p a * (if b ∈ s then g a b else 0)) :
    tsum_congr (λ b, by split_ifs; simp)
  ... = ∑' (b : β) (a : α), ↑(p a * (if b ∈ s then g a b else 0)) :
    tsum_congr (λ b, ennreal.coe_tsum $
      nnreal.summable_of_le (by split_ifs; simp) (bind_on_support.summable p f b))
  ... = ∑' (a : α) (b : β), ↑(p a) * ↑(if b ∈ s then g a b else 0) :
    ennreal.tsum_comm.trans (tsum_congr $ λ a, tsum_congr $ λ b, ennreal.coe_mul)
  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), ↑(if b ∈ s then g a b else 0) :
    tsum_congr (λ a, ennreal.tsum_mul_left)
  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), if b ∈ s then ↑(g a b) else (0 : ℝ≥0∞) :
    tsum_congr (λ a, congr_arg (λ x, ↑(p a) * x) $ tsum_congr (λ b, by split_ifs; refl))
  ... = ∑' (a : α), ↑(p a) * if h : p a = 0 then 0 else (f a h).to_outer_measure s :
    tsum_congr (λ a, congr_arg (has_mul.mul ↑(p a)) begin
      split_ifs with h h,
      { exact ennreal.tsum_eq_zero.mpr (λ x,
          (by simp [g, h] : (0 : ℝ≥0∞) = ↑(g a x)) ▸ (if_t_t (x ∈ s) 0)) },
      { simp [to_outer_measure_apply, g, h, set.indicator_apply] }
    end)

/-- The measure of a set under `p.bind_on_support f` is the sum over `a : α`
  of the probability of `a` under `p` times the measure of the set under `f a _`.
  The additional if statement is needed since `f` is only a partial function -/
lemma to_measure_bind_on_support_apply [measurable_space β] (hs : measurable_set s) :
  (p.bind_on_support f).to_measure s =
    ∑' (a : α), (p a : ℝ≥0∞) * if h : p a = 0 then 0 else (f a h).to_measure s :=
(to_measure_apply_eq_to_outer_measure_apply (p.bind_on_support f) s hs).trans
  ((to_outer_measure_bind_on_support_apply f s).trans
  (tsum_congr $ λ a, congr_arg (has_mul.mul ↑(p a)) (congr_arg (dite (p a = 0) (λ _, 0))
    $ funext (λ h, symm $ to_measure_apply_eq_to_outer_measure_apply (f a h) s hs))))

end measure

end bind_on_support

end pmf


import group_theory.order_of_element
import tactic

#print classes
#print instances inhabited

class cyclic_group (G : Type*) extends group G :=
(has_generator:  ∃ g : G, ∀ x : G, ∃ n : ℤ, x = g^n)

/-
zpow_add : ∀ {G : Type u_1} [group G] (a : G) (m n : ℤ), a ^ (m + n) = a ^ m * a ^ n
add_comm : ∀ {G : Type u_1} [add_comm_semigroup G] (a b : G), a + b = b + a
-/

lemma mul_comm_of_cyclic
  {G : Type*}
  [hc: cyclic_group G]
  (g : G)
: ∀ a b : G, a * b = b * a :=
begin
  have has_generator := hc.has_generator,
  sorry,
end


lemma succ_mul (a b : mynat) : succ a * b = a * b + b :=
begin
induction b with h hd,
repeat {rw mul_zero},
refl,
rw mul_succ,
rw mul_succ,
rw hd,
rw add_succ,
rw add_succ,
rw add_right_comm,
refl,
end


import data.set.finite
import data.set.function

open function set

variable (α : Type)

lemma useful
  {X : set α}
  (h: ∃ (f : ℕ → α), injective f ∧ range f ⊆ X)
  : X.infinite :=
begin
  rcases h with ⟨f, hfi, hfX⟩,
  apply infinite_of_injective_forall_mem hfi,
  exact range_subset_iff.mp hfX,
end


/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import ideles_K
import galois

/-!
# Main Theorem of Global Class Field Theory
We state the main theorem of global class field theory for number fields.
Given a number field `K`, denote by `G_K_ab` the topological abelianization of its absolute Galois
group. The main theorem of global class field theory states that `G_K_ab` is isomorphic to the
quotient `C_K_1` of the idèle class group of `K` by its identity component, as topological groups.
-/

noncomputable theory

variables (K : Type) [field K] [number_field K]

/-- The first part of the theorem is the claim that `G_K_ab` is isomorphic to `C_K_1` as groups.-/
theorem main_theorem_of_global_CFT.group_isomorphism :
  (number_field.C_K K) ⧸ (subgroup.connected_component_of_one (number_field.C_K K)) ≃* (G_K_ab K) :=
sorry

/-- The second part claims that the above isomorphism of abstract groups is also a homeomorphism,
and hence it is an isomorphism of topological groups. -/
theorem main_theorem_of_global_CFT.homeomorph :
  homeomorph ((number_field.C_K K) ⧸ (subgroup.connected_component_of_one (number_field.C_K K)))
    (G_K_ab K) :=
{ continuous_to_fun  := sorry,
  continuous_inv_fun := sorry,
  ..(main_theorem_of_global_CFT.group_isomorphism K) }


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

! This file was ported from Lean 3 source module algebra.category.Module.abelian
! leanprover-community/mathlib commit 09f981f72d43749f1fa072deade828d9c1e185bb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Isomorphisms
import Mathbin.Algebra.Category.Module.Kernels
import Mathbin.Algebra.Category.Module.Limits
import Mathbin.CategoryTheory.Abelian.Exact

/-!
# The category of left R-modules is abelian.

Additionally, two linear maps are exact in the categorical sense iff `range f = ker g`.
-/

open CategoryTheory

open CategoryTheory.Limits

noncomputable section

universe w v u

namespace ModuleCat

variable {R : Type u} [Ring R] {M N : ModuleCat.{v} R} (f : M ⟶ N)

/-- In the category of modules, every monomorphism is normal. -/
def normalMono (hf : Mono f) : NormalMono f
    where
  z := of R (N ⧸ f.range)
  g := f.range.mkQ
  w := LinearMap.range_mkQ_comp _
  IsLimit :=/- The following [invalid Lean code](https://github.com/leanprover-community/lean/issues/341)
                might help you understand what's going on here:
                ```
                calc
                M   ≃ₗ[R] f.ker.quotient  : (submodule.quot_equiv_of_eq_bot _ (ker_eq_bot_of_mono _)).symm
                ... ≃ₗ[R] f.range         : linear_map.quot_ker_equiv_range f
                ... ≃ₗ[R] r.range.mkq.ker : linear_equiv.of_eq _ _ (submodule.ker_mkq _).symm
                ```
              -/
        IsKernel.isoKernel
        _ _ (kernelIsLimit _)
        (LinearEquiv.toModuleIso'
          ((Submodule.quotEquivOfEqBot _ (ker_eq_bot_of_mono _)).symm ≪≫ₗ
            (LinearMap.quotKerEquivRange f ≪≫ₗ LinearEquiv.ofEq _ _ (Submodule.ker_mkQ _).symm))) <|
      by
      ext
      rfl
#align Module.normal_mono ModuleCat.normalMono

/-- In the category of modules, every epimorphism is normal. -/
def normalEpi (hf : Epi f) : NormalEpi f
    where
  w := of R f.ker
  g := f.ker.Subtype
  w := LinearMap.comp_ker_subtype _
  IsColimit :=/- The following invalid Lean code might help you understand what's going on here:
                ```
                calc f.ker.subtype.range.quotient
                    ≃ₗ[R] f.ker.quotient : submodule.quot_equiv_of_eq _ _ (submodule.range_subtype _)
                ... ≃ₗ[R] f.range        : linear_map.quot_ker_equiv_range f
                ... ≃ₗ[R] N              : linear_equiv.of_top _ (range_eq_top_of_epi _)
                ```
              -/
        IsCokernel.cokernelIso
        _ _ (cokernelIsColimit _)
        (LinearEquiv.toModuleIso'
          (Submodule.quotEquivOfEq _ _ (Submodule.range_subtype _) ≪≫ₗ
              LinearMap.quotKerEquivRange f ≪≫ₗ
            LinearEquiv.ofTop _ (range_eq_top_of_epi _))) <|
      by
      ext
      rfl
#align Module.normal_epi ModuleCat.normalEpi

/-- The category of R-modules is abelian. -/
instance abelian : Abelian (ModuleCat R)
    where
  HasFiniteProducts := ⟨fun n => Limits.hasLimitsOfShapeOfHasLimits⟩
  HasKernels := Limits.hasKernels_of_hasEqualizers (ModuleCat R)
  HasCokernels := hasCokernels_moduleCat
  normalMonoOfMono X Y := normalMono
  normalEpiOfEpi X Y := normalEpi
#align Module.abelian ModuleCat.abelian

section ReflectsLimits

/- We need to put this in this weird spot because we need to know that the category of modules
    is balanced. -/
instance forgetReflectsLimitsOfSize :
    ReflectsLimitsOfSize.{v, v} (forget (ModuleCat.{max v w} R)) :=
  reflectsLimitsOfReflectsIsomorphisms
#align Module.forget_reflects_limits_of_size ModuleCat.forgetReflectsLimitsOfSize

instance forget₂ReflectsLimitsOfSize :
    ReflectsLimitsOfSize.{v, v} (forget₂ (ModuleCat.{max v w} R) AddCommGroupCat.{max v w}) :=
  reflectsLimitsOfReflectsIsomorphisms
#align Module.forget₂_reflects_limits_of_size ModuleCat.forget₂ReflectsLimitsOfSize

instance forgetReflectsLimits : ReflectsLimits (forget (ModuleCat.{v} R)) :=
  ModuleCat.forgetReflectsLimitsOfSize.{v, v}
#align Module.forget_reflects_limits ModuleCat.forgetReflectsLimits

instance forget₂ReflectsLimits : ReflectsLimits (forget₂ (ModuleCat.{v} R) AddCommGroupCat.{v}) :=
  ModuleCat.forget₂ReflectsLimitsOfSize.{v, v}
#align Module.forget₂_reflects_limits ModuleCat.forget₂ReflectsLimits

end ReflectsLimits

variable {O : ModuleCat.{v} R} (g : N ⟶ O)

open LinearMap

attribute [local instance] preadditive.has_equalizers_of_has_kernels

theorem exact_iff : Exact f g ↔ f.range = g.ker :=
  by
  rw [abelian.exact_iff' f g (kernel_is_limit _) (cokernel_is_colimit _)]
  exact
    ⟨fun h => le_antisymm (range_le_ker_iff.2 h.1) (ker_le_range_iff.2 h.2), fun h =>
      ⟨range_le_ker_iff.1 <| le_of_eq h, ker_le_range_iff.1 <| le_of_eq h.symm⟩⟩
#align Module.exact_iff ModuleCat.exact_iff

end ModuleCat


import data.complex.basic
variable z : ℂ
theorem Q7 (H : z^2=-1) : z=complex.I ∨ z = -complex.I := sorry