/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import tactic
import measure_theory.measurable_space
import measure_theory.integration
import measure_theory.borel_space
import measure_theory.lebesgue_measure
import topology.metric_space.basic
import topology.instances.real
import topology.instances.ennreal
import order.liminf_limsup
import portmanteau_limsup_lemmas
import portmanteau_topological_lemmas
import portmanteau_proba_lemmas

noncomputable theory
open set
open classical
open measure_theory
open measurable_space
open metric_space
open metric
open real
open borel_space
open filter
open order
open tactic.interactive
open_locale topological_space ennreal big_operators classical

namespace portmanteau

section portmanteau_metric_lemmas

variables {α : Type*} [metric_space α]
variables (G E F : set α)

/- ## Distance to a set, thickening, etc.
-/

abbreviation thickening_o (δ : ℝ) (E : set α) : set α :=
    {x : α | ((inf_dist x E) < δ) }

abbreviation thickening_c (δ : ℝ) (E : set α) : set α :=
    {x : α | ((inf_dist x E) ≤ δ) }

lemma thickening_o_def {δ : ℝ} {E : set α} :
  thickening_o δ E = {x : α | ((inf_dist x E) < δ) } := by refl

lemma thickening_c_def {δ : ℝ} {E : set α} :
  thickening_c δ E = {x : α | ((inf_dist x E) ≤ δ) } := by refl

lemma thickening_o_preimage {δ : ℝ} {E : set α} :
  thickening_o δ E = (λ (x : α) , (inf_dist x E))⁻¹' {u : ℝ | u < δ} := by refl

lemma thickening_c_preimage {δ : ℝ} {E : set α} :
  thickening_c δ E = (λ (x : α) , (inf_dist x E))⁻¹' {u : ℝ | u ≤ δ} := by refl

lemma thickening_o_subset_thickening_c (δ : ℝ) (E : set α) :
  thickening_o δ E ⊆ thickening_c δ E :=
begin
  intros x hx ,
  simp only [mem_set_of_eq] at * ,
  linarith ,
end

lemma thickening_c_subset_thickening_o {δ₁ δ₂ : ℝ} (h_lt : δ₁ < δ₂) (E : set α) :
  thickening_c δ₁ E ⊆ thickening_o δ₂ E :=
begin
  intros x hx ,
  simp only [mem_set_of_eq] at * ,
  linarith ,
end

lemma thickening_o_subset_thickening_o {δ₁ δ₂ : ℝ} (hle : δ₁ ≤ δ₂) (E : set α) :
  thickening_o δ₁ E ⊆ thickening_o δ₂ E :=
begin
  intros x hx ,
  simp only [mem_set_of_eq] at * ,
  linarith ,
end

lemma thickening_c_subset_thickening_c {δ₁ δ₂ : ℝ} (hle : δ₁ ≤ δ₂) (E : set α) :
  thickening_c δ₁ E ⊆ thickening_c δ₂ E :=
begin
  intros x hx ,
  simp only [mem_set_of_eq] at * ,
  linarith ,
end

lemma is_open_thickening_o {δ : ℝ} {E : set α} :
  is_open (thickening_o δ E) :=
begin
  have cont_dist := continuous_inf_dist_pt E ,
  have ival_open : is_open {u : ℝ | u < δ} := is_open_gt' _ ,
  have open_pre := continuous.is_open_preimage cont_dist {u : ℝ | u < δ} ival_open ,
  assumption ,
end

lemma is_closed_thickening_c {δ : ℝ} {E : set α} :
    is_closed (thickening_c δ E) :=
begin
  have cont_dist := continuous_inf_dist_pt E ,
  have ival_closed : is_closed {u : ℝ | u ≤ δ} := is_closed_le' _ ,
  have closed_pre := continuous_iff_is_closed.mp cont_dist {u : ℝ | u ≤ δ} ival_closed ,
  assumption ,
end

lemma closure_inter_thickening_c (E : set α) [non_emp : E.nonempty] :
  closure E = ⋂ δ ∈ {δ' : ℝ | 0 < δ'} , thickening_c δ E :=
begin
  have inter_zero_dist : ∀ (z : α) ,
      z ∈ ( ⋂ (δ > 0) , (thickening_c δ E)) ↔ (inf_dist z E = 0) ,
  { intros z ,
    split ; intro hz ,
    { simp only [gt_iff_lt, mem_Inter, mem_set_of_eq] at hz ,
      set r := inf_dist z E with hr ,
      have r_nn : 0 ≤ r := inf_dist_nonneg ,
      have r_np := le_of_forall_le_of_dense hz ,
      linarith , } ,
    { simp only [gt_iff_lt, mem_Inter, mem_set_of_eq] ,
      intros ε hε ,
      rw hz ,
      linarith , } ,
    } ,
  have closure_zero_dist : ∀ (z : α) ,
      z ∈ closure E ↔ (inf_dist z E = 0) ,
  { intros z ,
    apply mem_closure_iff_inf_dist_zero ,
    exact non_emp , } ,
  ext x ,
  exact iff.trans (closure_zero_dist x) (inter_zero_dist x).symm ,
end

example (E : set α) (nemp : E.nonempty) : E ≠ ∅ :=
begin
  exact nonempty.ne_empty nemp,
end

lemma closure_subset_thickening_c (δ : ℝ) (δ_pos : 0 < δ) (E : set α) :
  closure E ⊆ thickening_c δ E :=
begin
  by_cases E = ∅ ,
  { simp only [h, empty_subset, closure_empty] , } ,
  { have nonemp : E.nonempty := ne_empty_iff_nonempty.mp h,
    have key := @closure_inter_thickening_c _ _ E nonemp ,
    rw [key , subset_def ] ,
    tidy , } ,
end

lemma closure_subset_thickening_o (δ : ℝ) (δ_pos : 0 < δ) (E : set α) :
  closure E ⊆ thickening_o δ E :=
begin
  by_cases E = ∅ ,
  { simp only [h, empty_subset, closure_empty] , } ,
  { have key := closure_subset_thickening_c (δ/2) (by linarith) E ,
    have plot := @thickening_c_subset_thickening_o _ _ (δ/2) δ (by linarith) E ,
    exact subset.trans key plot , } ,
end

lemma closure_inter_thickening_o (E : set α) (non_emp : E.nonempty) :
  closure E = ⋂ δ ∈ {δ' : ℝ | 0 < δ'} , thickening_o δ E :=
begin
  apply subset.antisymm ,
  { have key : ∀ (δ : ℝ) , (0 < δ) → (closure E ⊆ thickening_o δ E) ,
    { intros δ hδ ,
      exact closure_subset_thickening_o δ hδ E, } ,
    exact subset_bInter key , } ,
  { rw @closure_inter_thickening_c _ _ E non_emp ,
    refine bInter_mono _ ,
    intros δ δ_pos' ,
    exact thickening_o_subset_thickening_c δ E , } ,
end

lemma closure_inter_seq_thickening_o (E : set α) (non_emp : E.nonempty)
  (δseq : ℕ → ℝ) (h_pos : ∀ n , 0 < δseq(n)) (hlim : lim_R δseq 0) :
  closure E = ⋂ n : ℕ , thickening_o (δseq(n)) E :=
begin
  apply subset.antisymm ,
  { have key' := (λ n , closure_subset_thickening_o (δseq(n)) (h_pos n) E ) ,
    exact subset_Inter key' , } ,
  { intros x hx ,
    rw closure_inter_thickening_o E non_emp ,
    rw mem_Inter at hx ,
    rw mem_Inter ,
    rintros ε T hTε ,
    simp only [exists_prop, mem_range, mem_set_of_eq] at hTε ,
    cases hTε with εpos hT ,
    have small : ( ∃ n , ∀ k , n ≤ k → δseq(k) ≤ ε ) ,
    { specialize hlim (Iic_mem_nhds εpos) ,
      tidy , } ,
    cases small with n hn ,
    specialize hn n (rfl.ge) ,
    specialize hx n ,
    rw ← hT ,
    apply thickening_o_subset_thickening_o hn E ,
    exact hx , } ,
end

def approx_indicator_seq_thickening_o (E : set α) (non_emp : E.nonempty)
  (δseq : ℕ → ℝ) (hpos : ∀ n , 0 < δseq(n))
  (hdecr : is_decreasing_seq δseq) (hlim : lim_R δseq 0) :
    ptwise_decr_mble_lim_ennreal (borel(α)) (indic (closure E)) :=
{
  funseq := (λ n , (indic (thickening_o (δseq(n)) E))) ,
  decr := begin
    intros n m hnm ,
    have plot := thickening_o_subset_thickening_o (hdecr hnm) E ,
    exact indic_mono _ _ plot ,
  end ,
  limit := begin
    have key := closure_inter_seq_thickening_o E non_emp δseq hpos hlim ,
    intros x ,
    by_cases x ∈ closure E ,
    { have hall : (λ n , (indic (thickening_o (δseq(n)) E) x)) = (λ n , 1) ,
      { funext n ,
        rw key at h ,
        rw mem_Inter at h ,
        exact (indic_val_one_iff _ x).mpr (h n) , } ,
      rw [ hall , ((indic_val_one_iff _ x).mpr h) ] ,
      exact tendsto_const_nhds , } ,
    { rw (indic_val_zero_iff _ x).mpr h ,
      have zero : (lim_enn (λ n , 0) 0) := tendsto_const_nhds ,
      apply lim_enn_of_ev_same (λ n , 0) _ _ zero ,
      rw key at h ,
      simp only [mem_Inter, not_lt, ge_iff_le, mem_set_of_eq, not_forall] at h,
      cases h with m hm ,
      use m ,
      intros k hk ,
      rw (indic_val_zero_iff _ x).mpr ,
      have plot := thickening_o_subset_thickening_o (hdecr hk) E ,
      rw thickening_o_def at * ,
      simp only [set_of_subset_set_of, not_lt, ge_iff_le, mem_set_of_eq] at * ,
      by_contradiction hcontra ,
      rw not_le at hcontra ,
      have wrong_way := plot x hcontra ,
      linarith , } ,
  end ,
  mble := begin
    intros n ,
    apply (@indic_mble_iff α (borel(α)) (thickening_o (δseq(n)) E)).mpr ,
    apply open_imp_borel ,
    exact is_open_thickening_o ,
  end ,
}

lemma approx_indicator_seq_thickening_o_def (E : set α) (non_emp : E.nonempty)
  (δseq : ℕ → ℝ) (hpos : ∀ n , 0 < δseq(n))
  (hdecr : is_decreasing_seq δseq) (hlim : lim_R δseq 0) :
    (approx_indicator_seq_thickening_o E non_emp δseq hpos hdecr hlim).funseq
    = (λ n , (indic (thickening_o (δseq(n)) E)))
      := by refl

lemma compl_union_infdist_level_sets (E : set α)
  (non_emp_E : E.nonempty) (closed_E : is_closed E) :
  Eᶜ = ⋃ (δ ∈ { δ' : ℝ | δ'>0}) , {x : α | ((inf_dist x E) = δ) } :=
begin
  ext x ,
  simp only [exists_prop, mem_Union, gt_iff_lt, mem_set_of_eq, exists_eq_right', mem_compl_eq] ,
  apply not_iff_not.mp ,
  simp only [not_lt, not_not_mem] ,
  rw ← closure_eq_iff_is_closed.mpr closed_E ,
  have dist_zero_cond : inf_dist x (closure E) ≤ 0 ↔ inf_dist x E = 0 ,
  { rw inf_dist_eq_closure ,
    have id_nn : inf_dist x E ≥ 0 := inf_dist_nonneg ,
    exact has_le.le.le_iff_eq id_nn , } ,
  rw dist_zero_cond ,
  exact mem_closure_iff_inf_dist_zero non_emp_E ,
end

lemma countably_many_infdist_level_sets_of_positive_measure
  (μ : @measure_theory.measure α (borel α)) [hfin : @probability_measure α (borel(α)) μ] (E : set α) :
    set.countable {δ : ℝ | δ > 0 ∧ μ {x : α | ((inf_dist x E) = δ) } > 0 } :=
begin
  have cont_dist := continuous_inf_dist_pt E ,
  have mble_dist := continuous.borel_measurable cont_dist ,
  set d := (λ x , inf_dist x E) with hd ,
  have sub : {δ : ℝ | δ > 0 ∧ μ ({x : α | inf_dist x E = δ}) > 0} ⊆ {y : ℝ | μ ( d⁻¹' {y}) > 0} ,
  { rintros δ ⟨ δ_pos , posmeas_δ ⟩ ,
    exact posmeas_δ , } ,
  apply countable.mono sub ,
  exact countably_many_level_sets_of_positive_measure _ mble_dist μ hfin ,
end

lemma frontier_thickening_c  (E : set α) (δ : ℝ) (δ_pos : 0 < δ) :
  frontier (thickening_c δ E) ⊆ {x : α | ((inf_dist x E) = δ) } :=
begin
  have cont := continuous_inf_dist_pt E ,
  set f := (λ x , inf_dist x E) with hf ,
  have lhs_preim : thickening_c δ E = f⁻¹' (Iic δ) := thickening_c_preimage ,
  rw lhs_preim ,
  have frontier_preim := @frontier_preimage α ℝ _ _ (Iic δ) f cont ,
  have frontier_interval : frontier (Iic δ) = {δ} := frontier_Iic ,
  have singleton_preim : {x : α | ((inf_dist x E) = δ) } = f⁻¹' {δ} := by refl ,
  rw [singleton_preim , ←frontier_interval ] ,
  apply frontier_preim ,
end

lemma frontier_thickening_o  (E : set α) (δ : ℝ) (δ_pos : 0 < δ) :
  frontier (thickening_o δ E) ⊆ {x : α | ((inf_dist x E) = δ) } :=
begin
  have cont := continuous_inf_dist_pt E ,
  set f := (λ x , inf_dist x E) with hf ,
  have lhs_preim : thickening_o δ E = f⁻¹' (Iio δ) := thickening_o_preimage ,
  rw lhs_preim ,
  have frontier_preim := @frontier_preimage α ℝ _ _ (Iio δ) f cont ,
  have frontier_interval : frontier (Iio δ) = {δ} := frontier_Iio ,
  have singleton_preim : {x : α | ((inf_dist x E) = δ) } = f⁻¹' {δ} := by refl ,
  rw [singleton_preim , ←frontier_interval ] ,
  apply frontier_preim ,
end

lemma closed_set_borel_proba_by_thickenings
  (μ : @measure_theory.measure α (borel α)) [hfin : @probability_measure α (borel(α)) μ]
  (F : set α) (clos_F : is_closed F) (nonemp : F.nonempty) (δseq : ℕ → ℝ)
  (δpos : ∀ n , δseq(n) > 0 ) (δdecr : is_decreasing_seq δseq)
  (δlim : lim_R δseq 0 ) :
    lim_enn (λ (n:ℕ) , ( μ (thickening_o (δseq(n)) F)) ) (μ(F)) :=
begin
  have F_eq_clos_F : closure F = F := is_closed.closure_eq clos_F ,
  have mble_F := closed_imp_borel clos_F ,
  have fseq_rw := approx_indicator_seq_thickening_o_def F nonemp δseq δpos δdecr δlim ,
  set appr := approx_indicator_seq_thickening_o F nonemp δseq δpos δdecr δlim with happr ,
  have f_rw : ∀ (n : ℕ) , appr.funseq n = indic (thickening_o (δseq(n)) F) ,
  { rw fseq_rw ,
    intros n ,
    refl , } ,
  have open_thick : ∀ (n : ℕ) , is_open (thickening_o (δseq(n)) F) := (λ n , is_open_thickening_o ),
  have mble_thick := (λ (n : ℕ) , open_imp_borel (open_thick n) ) ,
  have eq : (λ (n : ℕ) , @lintegral α (borel(α)) μ (appr.funseq(n)) ) = (λ (n : ℕ) , μ (thickening_o (δseq(n)) F) ) ,
  { funext n ,
    rw (f_rw n) ,
    exact integral_indic μ _ (mble_thick n) , } ,
  have fin_integr : @lintegral α (borel(α)) μ (appr.funseq(0)) < ⊤ ,
  { have eq_zero := congr_fun eq 0 ,
    dsimp at eq_zero ,
    rw eq_zero ,
    exact proba_finite μ _ , } ,
  rw ← F_eq_clos_F at mble_F ,
  have meas_eq : μ (closure F) = μ (F) := congr_arg ⇑μ F_eq_clos_F ,
  have key := measure_of_mble_decr_approx_indicator μ (closure F) mble_F appr fin_integr ,
  rwa [← eq , ← meas_eq ] ,
end

end portmanteau_metric_lemmas

end portmanteau


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.adjunction.default
import Mathlib.category_theory.limits.shapes.equalizers
import Mathlib.category_theory.limits.shapes.kernel_pair
import Mathlib.PostPort

universes v u l v₂ u₂

namespace Mathlib

/-!
# Reflexive coequalizers

We define reflexive pairs as a pair of morphisms which have a common section. We say a category has
reflexive coequalizers if it has coequalizers of all reflexive pairs.
Reflexive coequalizers often enjoy nicer properties than general coequalizers, and feature heavily
in some versions of the monadicity theorem.

We also give some examples of reflexive pairs: for an adjunction `F ⊣ G` with counit `ε`, the pair
`(FGε_B, ε_FGB)` is reflexive. If a pair `f,g` is a kernel pair for some morphism, then it is
reflexive.

# TODO
* If `C` has binary coproducts and reflexive coequalizers, then it has all coequalizers.
* If `T` is a monad on cocomplete category `C`, then `algebra T` is cocomplete iff it has reflexive
  coequalizers.
* If `C` is locally cartesian closed and has reflexive coequalizers, then it has images: in fact
  regular epi (and hence strong epi) images.
-/

namespace category_theory

/--
The pair `f g : A ⟶ B` is reflexive if there is a morphism `B ⟶ A` which is a section for both.
-/
class is_reflexive_pair {C : Type u} [category C] {A : C} {B : C} (f : A ⟶ B) (g : A ⟶ B)
where
  common_section : ∃ (s : B ⟶ A), s ≫ f = 𝟙 ∧ s ≫ g = 𝟙

/--
The pair `f g : A ⟶ B` is coreflexive if there is a morphism `B ⟶ A` which is a retraction for both.
-/
class is_coreflexive_pair {C : Type u} [category C] {A : C} {B : C} (f : A ⟶ B) (g : A ⟶ B)
where
  common_retraction : ∃ (s : B ⟶ A), f ≫ s = 𝟙 ∧ g ≫ s = 𝟙

theorem is_reflexive_pair.mk' {C : Type u} [category C] {A : C} {B : C} {f : A ⟶ B} {g : A ⟶ B} (s : B ⟶ A) (sf : s ≫ f = 𝟙) (sg : s ≫ g = 𝟙) : is_reflexive_pair f g :=
  is_reflexive_pair.mk (Exists.intro s { left := sf, right := sg })

theorem is_coreflexive_pair.mk' {C : Type u} [category C] {A : C} {B : C} {f : A ⟶ B} {g : A ⟶ B} (s : B ⟶ A) (fs : f ≫ s = 𝟙) (gs : g ≫ s = 𝟙) : is_coreflexive_pair f g :=
  is_coreflexive_pair.mk (Exists.intro s { left := fs, right := gs })

/-- Get the common section for a reflexive pair. -/
def common_section {C : Type u} [category C] {A : C} {B : C} (f : A ⟶ B) (g : A ⟶ B) [is_reflexive_pair f g] : B ⟶ A :=
  Exists.some (is_reflexive_pair.common_section f g)

@[simp] theorem section_comp_left_assoc {C : Type u} [category C] {A : C} {B : C} (f : A ⟶ B) (g : A ⟶ B) [is_reflexive_pair f g] {X' : C} (f' : B ⟶ X') : common_section f g ≫ f ≫ f' = f' := sorry

@[simp] theorem section_comp_right {C : Type u} [category C] {A : C} {B : C} (f : A ⟶ B) (g : A ⟶ B) [is_reflexive_pair f g] : common_section f g ≫ g = 𝟙 :=
  and.right (Exists.some_spec (is_reflexive_pair.common_section f g))

/-- Get the common retraction for a coreflexive pair. -/
def common_retraction {C : Type u} [category C] {A : C} {B : C} (f : A ⟶ B) (g : A ⟶ B) [is_coreflexive_pair f g] : B ⟶ A :=
  Exists.some (is_coreflexive_pair.common_retraction f g)

@[simp] theorem left_comp_retraction_assoc {C : Type u} [category C] {A : C} {B : C} (f : A ⟶ B) (g : A ⟶ B) [is_coreflexive_pair f g] {X' : C} (f' : A ⟶ X') : f ≫ common_retraction f g ≫ f' = f' := sorry

@[simp] theorem right_comp_retraction_assoc {C : Type u} [category C] {A : C} {B : C} (f : A ⟶ B) (g : A ⟶ B) [is_coreflexive_pair f g] {X' : C} (f' : A ⟶ X') : g ≫ common_retraction f g ≫ f' = f' := sorry

/-- If `f,g` is a kernel pair for some morphism `q`, then it is reflexive. -/
theorem is_kernel_pair.is_reflexive_pair {C : Type u} [category C] {A : C} {B : C} {R : C} {f : R ⟶ A} {g : R ⟶ A} {q : A ⟶ B} (h : is_kernel_pair q f g) : is_reflexive_pair f g :=
  is_reflexive_pair.mk' (subtype.val (is_kernel_pair.lift' h 𝟙 𝟙 rfl))
    (and.left (subtype.property (is_kernel_pair.lift' h 𝟙 𝟙 rfl)))
    (and.right (subtype.property (is_kernel_pair.lift' h 𝟙 𝟙 rfl)))

/-- If `f,g` is reflexive, then `g,f` is reflexive. -/
-- This shouldn't be an instance as it would instantly loop.

theorem is_reflexive_pair.swap {C : Type u} [category C] {A : C} {B : C} {f : A ⟶ B} {g : A ⟶ B} [is_reflexive_pair f g] : is_reflexive_pair g f :=
  is_reflexive_pair.mk' (common_section f g) (section_comp_right f g) (section_comp_left f g)

/-- If `f,g` is coreflexive, then `g,f` is coreflexive. -/
-- This shouldn't be an instance as it would instantly loop.

theorem is_coreflexive_pair.swap {C : Type u} [category C] {A : C} {B : C} {f : A ⟶ B} {g : A ⟶ B} [is_coreflexive_pair f g] : is_coreflexive_pair g f :=
  is_coreflexive_pair.mk' (common_retraction f g) (right_comp_retraction f g) (left_comp_retraction f g)

/-- For an adjunction `F ⊣ G` with counit `ε`, the pair `(FGε_B, ε_FGB)` is reflexive. -/
protected instance app.is_reflexive_pair {C : Type u} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) (B : D) : is_reflexive_pair (functor.map F (functor.map G (nat_trans.app (adjunction.counit adj) B)))
  (nat_trans.app (adjunction.counit adj) (functor.obj F (functor.obj G B))) :=
  is_reflexive_pair.mk' (functor.map F (nat_trans.app (adjunction.unit adj) (functor.obj G B)))
    (eq.mpr
      (id
        (Eq._oldrec
          (Eq.refl
            (functor.map F (nat_trans.app (adjunction.unit adj) (functor.obj G B)) ≫
                functor.map F (functor.map G (nat_trans.app (adjunction.counit adj) B)) =
              𝟙))
          (Eq.symm
            (functor.map_comp F (nat_trans.app (adjunction.unit adj) (functor.obj G B))
              (functor.map G (nat_trans.app (adjunction.counit adj) B))))))
      (eq.mpr
        (id
          (Eq._oldrec
            (Eq.refl
              (functor.map F
                  (nat_trans.app (adjunction.unit adj) (functor.obj G B) ≫
                    functor.map G (nat_trans.app (adjunction.counit adj) B)) =
                𝟙))
            (adjunction.right_triangle_components adj)))
        (functor.map_id F (functor.obj G (functor.obj 𝟭 B)))))
    (adjunction.left_triangle_components adj)

namespace limits

/-- `C` has reflexive coequalizers if it has coequalizers for every reflexive pair. -/
class has_reflexive_coequalizers (C : Type u) [category C]
where
  has_coeq : ∀ {A B : C} (f g : A ⟶ B) [_inst_3 : is_reflexive_pair f g], has_coequalizer f g

/-- `C` has coreflexive equalizers if it has equalizers for every coreflexive pair. -/
class has_coreflexive_equalizers (C : Type u) [category C]
where
  has_eq : ∀ {A B : C} (f g : A ⟶ B) [_inst_3 : is_coreflexive_pair f g], has_equalizer f g

theorem has_coequalizer_of_common_section (C : Type u) [category C] [has_reflexive_coequalizers C] {A : C} {B : C} {f : A ⟶ B} {g : A ⟶ B} (r : B ⟶ A) (rf : r ≫ f = 𝟙) (rg : r ≫ g = 𝟙) : has_coequalizer f g :=
  let _inst : is_reflexive_pair f g := is_reflexive_pair.mk' r rf rg;
  has_reflexive_coequalizers.has_coeq f g

theorem has_equalizer_of_common_retraction (C : Type u) [category C] [has_coreflexive_equalizers C] {A : C} {B : C} {f : A ⟶ B} {g : A ⟶ B} (r : B ⟶ A) (fr : f ≫ r = 𝟙) (gr : g ≫ r = 𝟙) : has_equalizer f g :=
  let _inst : is_coreflexive_pair f g := is_coreflexive_pair.mk' r fr gr;
  has_coreflexive_equalizers.has_eq f g

/-- If `C` has coequalizers, then it has reflexive coequalizers. -/
protected instance has_reflexive_coequalizers_of_has_coequalizers (C : Type u) [category C] [has_coequalizers C] : has_reflexive_coequalizers C :=
  has_reflexive_coequalizers.mk
    fun (A B : C) (f g : A ⟶ B) (i : is_reflexive_pair f g) =>
      limits.has_colimit_of_has_colimits_of_shape (parallel_pair f g)

/-- If `C` has equalizers, then it has coreflexive equalizers. -/
protected instance has_coreflexive_equalizers_of_has_equalizers (C : Type u) [category C] [has_equalizers C] : has_coreflexive_equalizers C :=
  has_coreflexive_equalizers.mk
    fun (A B : C) (f g : A ⟶ B) (i : is_coreflexive_pair f g) =>
      limits.has_limit_of_has_limits_of_shape (parallel_pair f g)


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.pi
import Mathlib.group_theory.group_action.default
import Mathlib.data.support
import Mathlib.data.finset.lattice
import Mathlib.PostPort

universes u_1 u_3 u_2 u_4 u_5

namespace Mathlib

/-!
# Indicator function

`indicator (s : set α) (f : α → β) (a : α)` is `f a` if `a ∈ s` and is `0` otherwise.

## Implementation note

In mathematics, an indicator function or a characteristic function is a function used to indicate
membership of an element in a set `s`, having the value `1` for all elements of `s` and the value `0`
otherwise. But since it is usually used to restrict a function to a certain set `s`, we let the
indicator function take the value `f x` for some function `f`, instead of `1`. If the usual indicator
function is needed, just set `f` to be the constant function `λx, 1`.

## Tags
indicator, characteristic
-/

namespace set

/-- `indicator s f a` is `f a` if `a ∈ s`, `0` otherwise.  -/
def indicator {α : Type u_1} {β : Type u_3} [HasZero β] (s : set α) (f : α → β) : α → β :=
  fun (x : α) => ite (x ∈ s) (f x) 0

@[simp] theorem piecewise_eq_indicator {α : Type u_1} {β : Type u_3} [HasZero β] {f : α → β}
    {s : set α} : piecewise s f 0 = indicator s f :=
  rfl

theorem indicator_apply {α : Type u_1} {β : Type u_3} [HasZero β] (s : set α) (f : α → β) (a : α) :
    indicator s f a = ite (a ∈ s) (f a) 0 :=
  rfl

@[simp] theorem indicator_of_mem {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α} {a : α}
    (h : a ∈ s) (f : α → β) : indicator s f a = f a :=
  if_pos h

@[simp] theorem indicator_of_not_mem {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α} {a : α}
    (h : ¬a ∈ s) (f : α → β) : indicator s f a = 0 :=
  if_neg h

theorem indicator_eq_zero_or_self {α : Type u_1} {β : Type u_3} [HasZero β] (s : set α) (f : α → β)
    (a : α) : indicator s f a = 0 ∨ indicator s f a = f a :=
  dite (a ∈ s) (fun (h : a ∈ s) => Or.inr (indicator_of_mem h f))
    fun (h : ¬a ∈ s) => Or.inl (indicator_of_not_mem h f)

/-- If an indicator function is nonzero at a point, that
point is in the set. -/
theorem mem_of_indicator_ne_zero {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α} {f : α → β}
    {a : α} (h : indicator s f a ≠ 0) : a ∈ s :=
  iff.mp not_imp_comm (fun (hn : ¬a ∈ s) => indicator_of_not_mem hn f) h

theorem eq_on_indicator {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α} {f : α → β} :
    eq_on (indicator s f) f s :=
  fun (x : α) (hx : x ∈ s) => indicator_of_mem hx f

theorem support_indicator {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α} {f : α → β} :
    function.support (indicator s f) ⊆ s :=
  fun (x : α) (hx : x ∈ function.support (indicator s f)) =>
    not.imp_symm (fun (h : ¬x ∈ s) => indicator_of_not_mem h f) hx

@[simp] theorem indicator_apply_eq_self {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α}
    {f : α → β} {a : α} : indicator s f a = f a ↔ ¬a ∈ s → f a = 0 :=
  iff.trans ite_eq_left_iff
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬a ∈ s → 0 = f a ↔ ¬a ∈ s → f a = 0)) (propext eq_comm)))
      (iff.refl (¬a ∈ s → 0 = f a)))

@[simp] theorem indicator_eq_self {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α}
    {f : α → β} : indicator s f = f ↔ function.support f ⊆ s :=
  sorry

@[simp] theorem indicator_support {α : Type u_1} {β : Type u_3} [HasZero β] {f : α → β} :
    indicator (function.support f) f = f :=
  iff.mpr indicator_eq_self (subset.refl (function.support f))

@[simp] theorem indicator_apply_eq_zero {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α}
    {f : α → β} {a : α} : indicator s f a = 0 ↔ a ∈ s → f a = 0 :=
  ite_eq_right_iff

@[simp] theorem indicator_eq_zero {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α}
    {f : α → β} : (indicator s f = fun (x : α) => 0) ↔ disjoint (function.support f) s :=
  sorry

@[simp] theorem indicator_eq_zero' {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α}
    {f : α → β} : indicator s f = 0 ↔ disjoint (function.support f) s :=
  indicator_eq_zero

@[simp] theorem indicator_range_comp {α : Type u_1} {β : Type u_3} [HasZero β] {ι : Sort u_2}
    (f : ι → α) (g : α → β) : indicator (range f) g ∘ f = g ∘ f :=
  piecewise_range_comp f (fun (x : α) => g x) fun (x : α) => 0

theorem indicator_congr {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α} {f : α → β}
    {g : α → β} (h : ∀ (a : α), a ∈ s → f a = g a) : indicator s f = indicator s g :=
  sorry

@[simp] theorem indicator_univ {α : Type u_1} {β : Type u_3} [HasZero β] (f : α → β) :
    indicator univ f = f :=
  iff.mpr indicator_eq_self (subset_univ (function.support f))

@[simp] theorem indicator_empty {α : Type u_1} {β : Type u_3} [HasZero β] (f : α → β) :
    indicator ∅ f = fun (a : α) => 0 :=
  iff.mpr indicator_eq_zero (disjoint_empty (function.support f))

@[simp] theorem indicator_zero {α : Type u_1} (β : Type u_3) [HasZero β] (s : set α) :
    (indicator s fun (x : α) => 0) = fun (x : α) => 0 :=
  sorry

@[simp] theorem indicator_zero' {α : Type u_1} (β : Type u_3) [HasZero β] {s : set α} :
    indicator s 0 = 0 :=
  indicator_zero β s

theorem indicator_indicator {α : Type u_1} {β : Type u_3} [HasZero β] (s : set α) (t : set α)
    (f : α → β) : indicator s (indicator t f) = indicator (s ∩ t) f :=
  sorry

theorem comp_indicator {α : Type u_1} {β : Type u_3} {γ : Type u_4} [HasZero β] (h : β → γ)
    (f : α → β) {s : set α} {x : α} :
    h (indicator s f x) = piecewise s (h ∘ f) (function.const α (h 0)) x :=
  comp_piecewise s h

theorem indicator_comp_right {α : Type u_1} {β : Type u_3} {γ : Type u_4} [HasZero β] {s : set α}
    (f : γ → α) {g : α → β} {x : γ} : indicator (f ⁻¹' s) (g ∘ f) x = indicator s g (f x) :=
  sorry

theorem indicator_comp_of_zero {α : Type u_1} {β : Type u_3} {γ : Type u_4} [HasZero β] {s : set α}
    {f : α → β} [HasZero γ] {g : β → γ} (hg : g 0 = 0) : indicator s (g ∘ f) = g ∘ indicator s f :=
  sorry

theorem indicator_preimage {α : Type u_1} {β : Type u_3} [HasZero β] (s : set α) (f : α → β)
    (B : set β) : indicator s f ⁻¹' B = s ∩ f ⁻¹' B ∪ sᶜ ∩ (fun (a : α) => 0) ⁻¹' B :=
  piecewise_preimage s f 0 B

theorem indicator_preimage_of_not_mem {α : Type u_1} {β : Type u_3} [HasZero β] (s : set α)
    (f : α → β) {t : set β} (ht : ¬0 ∈ t) : indicator s f ⁻¹' t = s ∩ f ⁻¹' t :=
  sorry

theorem mem_range_indicator {α : Type u_1} {β : Type u_3} [HasZero β] {r : β} {s : set α}
    {f : α → β} : r ∈ range (indicator s f) ↔ r = 0 ∧ s ≠ univ ∨ r ∈ f '' s :=
  sorry

theorem indicator_rel_indicator {α : Type u_1} {β : Type u_3} [HasZero β] {s : set α} {f : α → β}
    {g : α → β} {a : α} {r : β → β → Prop} (h0 : r 0 0) (ha : a ∈ s → r (f a) (g a)) :
    r (indicator s f a) (indicator s g a) :=
  sorry

/-- Consider a sum of `g i (f i)` over a `finset`.  Suppose `g` is a
function such as multiplication, which maps a second argument of 0 to
0.  (A typical use case would be a weighted sum of `f i * h i` or `f i
• h i`, where `f` gives the weights that are multiplied by some other
function `h`.)  Then if `f` is replaced by the corresponding indicator
function, the `finset` may be replaced by a possibly larger `finset`
without changing the value of the sum. -/
theorem sum_indicator_subset_of_eq_zero {α : Type u_1} {β : Type u_3} [HasZero β] {γ : Type u_2}
    [add_comm_monoid γ] (f : α → β) (g : α → β → γ) {s₁ : finset α} {s₂ : finset α} (h : s₁ ⊆ s₂)
    (hg : ∀ (a : α), g a 0 = 0) :
    (finset.sum s₁ fun (i : α) => g i (f i)) =
        finset.sum s₂ fun (i : α) => g i (indicator (↑s₁) f i) :=
  sorry

/-- Summing an indicator function over a possibly larger `finset` is
the same as summing the original function over the original
`finset`. -/
theorem sum_indicator_subset {α : Type u_1} {γ : Type u_2} [add_comm_monoid γ] (f : α → γ)
    {s₁ : finset α} {s₂ : finset α} (h : s₁ ⊆ s₂) :
    (finset.sum s₁ fun (i : α) => f i) = finset.sum s₂ fun (i : α) => indicator (↑s₁) f i :=
  sum_indicator_subset_of_eq_zero (fun (i : α) => f i) (fun (a : α) (b : γ) => b) h
    fun (_x : α) => rfl

theorem indicator_union_of_not_mem_inter {α : Type u_1} {β : Type u_3} [add_monoid β] {s : set α}
    {t : set α} {a : α} (h : ¬a ∈ s ∩ t) (f : α → β) :
    indicator (s ∪ t) f a = indicator s f a + indicator t f a :=
  sorry

theorem indicator_union_of_disjoint {α : Type u_1} {β : Type u_3} [add_monoid β] {s : set α}
    {t : set α} (h : disjoint s t) (f : α → β) :
    indicator (s ∪ t) f = fun (a : α) => indicator s f a + indicator t f a :=
  sorry

theorem indicator_add {α : Type u_1} {β : Type u_3} [add_monoid β] (s : set α) (f : α → β)
    (g : α → β) :
    (indicator s fun (a : α) => f a + g a) = fun (a : α) => indicator s f a + indicator s g a :=
  sorry

@[simp] theorem indicator_compl_add_self_apply {α : Type u_1} {β : Type u_3} [add_monoid β]
    (s : set α) (f : α → β) (a : α) : indicator (sᶜ) f a + indicator s f a = f a :=
  sorry

@[simp] theorem indicator_compl_add_self {α : Type u_1} {β : Type u_3} [add_monoid β] (s : set α)
    (f : α → β) : indicator (sᶜ) f + indicator s f = f :=
  funext (indicator_compl_add_self_apply s f)

@[simp] theorem indicator_self_add_compl_apply {α : Type u_1} {β : Type u_3} [add_monoid β]
    (s : set α) (f : α → β) (a : α) : indicator s f a + indicator (sᶜ) f a = f a :=
  sorry

@[simp] theorem indicator_self_add_compl {α : Type u_1} {β : Type u_3} [add_monoid β] (s : set α)
    (f : α → β) : indicator s f + indicator (sᶜ) f = f :=
  funext (indicator_self_add_compl_apply s f)

protected instance is_add_monoid_hom.indicator {α : Type u_1} (β : Type u_3) [add_monoid β]
    (s : set α) : is_add_monoid_hom fun (f : α → β) => indicator s f :=
  is_add_monoid_hom.mk (indicator_zero β s)

theorem indicator_smul {α : Type u_1} {β : Type u_3} [add_monoid β] {𝕜 : Type u_5} [monoid 𝕜]
    [distrib_mul_action 𝕜 β] (s : set α) (r : 𝕜) (f : α → β) :
    (indicator s fun (x : α) => r • f x) = fun (x : α) => r • indicator s f x :=
  sorry

theorem indicator_add_eq_left {α : Type u_1} {β : Type u_3} [add_monoid β] {f : α → β} {g : α → β}
    (h : univ ⊆ f ⁻¹' singleton 0 ∪ g ⁻¹' singleton 0) :
    indicator (f ⁻¹' singleton 0ᶜ) (f + g) = f :=
  sorry

theorem indicator_add_eq_right {α : Type u_1} {β : Type u_3} [add_monoid β] {f : α → β} {g : α → β}
    (h : univ ⊆ f ⁻¹' singleton 0 ∪ g ⁻¹' singleton 0) :
    indicator (g ⁻¹' singleton 0ᶜ) (f + g) = g :=
  sorry

protected instance is_add_group_hom.indicator {α : Type u_1} (β : Type u_3) [add_group β]
    (s : set α) : is_add_group_hom fun (f : α → β) => indicator s f :=
  is_add_group_hom.mk

theorem indicator_neg {α : Type u_1} {β : Type u_3} [add_group β] (s : set α) (f : α → β) :
    (indicator s fun (a : α) => -f a) = fun (a : α) => -indicator s f a :=
  (fun (this : indicator s (-f) = -indicator s f) => this)
    (is_add_group_hom.map_neg (indicator s) f)

theorem indicator_sub {α : Type u_1} {β : Type u_3} [add_group β] (s : set α) (f : α → β)
    (g : α → β) :
    (indicator s fun (a : α) => f a - g a) = fun (a : α) => indicator s f a - indicator s g a :=
  (fun (this : indicator s (f - g) = indicator s f - indicator s g) => this)
    (is_add_group_hom.map_sub (indicator s) f g)

theorem indicator_compl {α : Type u_1} {β : Type u_3} [add_group β] (s : set α) (f : α → β) :
    indicator (sᶜ) f = f - indicator s f :=
  eq_sub_of_add_eq (indicator_compl_add_self s f)

theorem indicator_finset_sum {α : Type u_1} {β : Type u_2} [add_comm_monoid β] {ι : Type u_3}
    (I : finset ι) (s : set α) (f : ι → α → β) :
    indicator s (finset.sum I fun (i : ι) => f i) = finset.sum I fun (i : ι) => indicator s (f i) :=
  sorry

theorem indicator_finset_bUnion {α : Type u_1} {β : Type u_2} [add_comm_monoid β] {ι : Type u_3}
    (I : finset ι) (s : ι → set α) {f : α → β} :
    (∀ (i : ι), i ∈ I → ∀ (j : ι), j ∈ I → i ≠ j → s i ∩ s j = ∅) →
        indicator (Union fun (i : ι) => Union fun (H : i ∈ I) => s i) f =
          fun (a : α) => finset.sum I fun (i : ι) => indicator (s i) f a :=
  sorry

theorem indicator_mul {α : Type u_1} {β : Type u_3} [mul_zero_class β] (s : set α) (f : α → β)
    (g : α → β) :
    (indicator s fun (a : α) => f a * g a) = fun (a : α) => indicator s f a * indicator s g a :=
  sorry

theorem indicator_mul_left {α : Type u_1} {β : Type u_3} [mul_zero_class β] {a : α} (s : set α)
    (f : α → β) (g : α → β) : indicator s (fun (a : α) => f a * g a) a = indicator s f a * g a :=
  sorry

theorem indicator_mul_right {α : Type u_1} {β : Type u_3} [mul_zero_class β] {a : α} (s : set α)
    (f : α → β) (g : α → β) : indicator s (fun (a : α) => f a * g a) a = f a * indicator s g a :=
  sorry

theorem indicator_prod_one {α : Type u_1} {α' : Type u_2} {β : Type u_3} [monoid_with_zero β]
    {s : set α} {t : set α'} {x : α} {y : α'} :
    indicator (set.prod s t) 1 (x, y) = indicator s 1 x * indicator t 1 y :=
  sorry

theorem indicator_nonneg' {α : Type u_1} {β : Type u_3} [HasZero β] [preorder β] {s : set α}
    {f : α → β} {a : α} (h : a ∈ s → 0 ≤ f a) : 0 ≤ indicator s f a :=
  sorry

theorem indicator_nonneg {α : Type u_1} {β : Type u_3} [HasZero β] [preorder β] {s : set α}
    {f : α → β} (h : ∀ (a : α), a ∈ s → 0 ≤ f a) (a : α) : 0 ≤ indicator s f a :=
  indicator_nonneg' (h a)

theorem indicator_nonpos' {α : Type u_1} {β : Type u_3} [HasZero β] [preorder β] {s : set α}
    {f : α → β} {a : α} (h : a ∈ s → f a ≤ 0) : indicator s f a ≤ 0 :=
  sorry

theorem indicator_nonpos {α : Type u_1} {β : Type u_3} [HasZero β] [preorder β] {s : set α}
    {f : α → β} (h : ∀ (a : α), a ∈ s → f a ≤ 0) (a : α) : indicator s f a ≤ 0 :=
  indicator_nonpos' (h a)

theorem indicator_le' {α : Type u_1} {β : Type u_3} [HasZero β] [preorder β] {s : set α} {f : α → β}
    {g : α → β} (hfg : ∀ (a : α), a ∈ s → f a ≤ g a) (hg : ∀ (a : α), ¬a ∈ s → 0 ≤ g a) :
    indicator s f ≤ g :=
  sorry

theorem indicator_le_indicator {α : Type u_1} {β : Type u_3} [HasZero β] [preorder β] {s : set α}
    {f : α → β} {g : α → β} {a : α} (h : f a ≤ g a) : indicator s f a ≤ indicator s g a :=
  indicator_rel_indicator (le_refl 0) fun (_x : a ∈ s) => h

theorem indicator_le_indicator_of_subset {α : Type u_1} {β : Type u_3} [HasZero β] [preorder β]
    {s : set α} {t : set α} {f : α → β} (h : s ⊆ t) (hf : ∀ (a : α), 0 ≤ f a) (a : α) :
    indicator s f a ≤ indicator t f a :=
  sorry

theorem indicator_le_self' {α : Type u_1} {β : Type u_3} [HasZero β] [preorder β] {s : set α}
    {f : α → β} (hf : ∀ (x : α), ¬x ∈ s → 0 ≤ f x) : indicator s f ≤ f :=
  indicator_le' (fun (_x : α) (_x_1 : _x ∈ s) => le_refl (f _x)) hf

theorem indicator_le_self {α : Type u_1} {β : Type u_2} [canonically_ordered_add_monoid β]
    (s : set α) (f : α → β) : indicator s f ≤ f :=
  indicator_le_self' fun (_x : α) (_x_1 : ¬_x ∈ s) => zero_le (f _x)

theorem indicator_le {α : Type u_1} {β : Type u_2} [canonically_ordered_add_monoid β] {s : set α}
    {f : α → β} {g : α → β} (hfg : ∀ (a : α), a ∈ s → f a ≤ g a) : indicator s f ≤ g :=
  indicator_le' hfg fun (_x : α) (_x_1 : ¬_x ∈ s) => zero_le (g _x)

theorem indicator_Union_apply {α : Type u_1} {ι : Sort u_2} {β : Type u_3} [complete_lattice β]
    [HasZero β] (h0 : ⊥ = 0) (s : ι → set α) (f : α → β) (x : α) :
    indicator (Union fun (i : ι) => s i) f x = supr fun (i : ι) => indicator (s i) f x :=
  sorry

end set

theorem add_monoid_hom.map_indicator {α : Type u_1} {M : Type u_2} {N : Type u_3} [add_monoid M]
    [add_monoid N] (f : M →+ N) (s : set α) (g : α → M) (x : α) :
    coe_fn f (set.indicator s g x) = set.indicator s (⇑f ∘ g) x :=
  congr_fun (Eq.symm (set.indicator_comp_of_zero (add_monoid_hom.map_zero f))) x

end Mathlib


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

Theory of topological rings with uniform structure.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.algebra.group_completion
import Mathlib.topology.algebra.ring
import Mathlib.PostPort

universes u_1 u_2 u

namespace Mathlib

namespace uniform_space.completion

protected instance has_one (α : Type u_1) [ring α] [uniform_space α] : HasOne (completion α) :=
  { one := ↑1 }

protected instance has_mul (α : Type u_1) [ring α] [uniform_space α] : Mul (completion α) :=
  { mul := function.curry (dense_inducing.extend sorry (coe ∘ function.uncurry Mul.mul)) }

theorem coe_one (α : Type u_1) [ring α] [uniform_space α] : ↑1 = 1 := rfl

theorem coe_mul {α : Type u_1} [ring α] [uniform_space α] [topological_ring α] (a : α) (b : α) :
    ↑(a * b) = ↑a * ↑b :=
  Eq.symm
    (dense_inducing.extend_eq (dense_inducing.prod dense_inducing_coe dense_inducing_coe)
      (continuous.comp (continuous_coe α) continuous_mul) (a, b))

theorem continuous_mul {α : Type u_1} [ring α] [uniform_space α] [topological_ring α]
    [uniform_add_group α] :
    continuous fun (p : completion α × completion α) => prod.fst p * prod.snd p :=
  sorry

theorem continuous.mul {α : Type u_1} [ring α] [uniform_space α] [topological_ring α]
    [uniform_add_group α] {β : Type u_2} [topological_space β] {f : β → completion α}
    {g : β → completion α} (hf : continuous f) (hg : continuous g) :
    continuous fun (b : β) => f b * g b :=
  continuous.comp continuous_mul (continuous.prod_mk hf hg)

protected instance ring {α : Type u_1} [ring α] [uniform_space α] [topological_ring α]
    [uniform_add_group α] : ring (completion α) :=
  ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg
    add_comm_group.sub sorry sorry Mul.mul sorry 1 sorry sorry sorry sorry

/-- The map from a uniform ring to its completion, as a ring homomorphism. -/
def coe_ring_hom {α : Type u_1} [ring α] [uniform_space α] [topological_ring α]
    [uniform_add_group α] : α →+* completion α :=
  ring_hom.mk coe (coe_one α) sorry sorry sorry

/-- The completion extension as a ring morphism. -/
def extension_hom {α : Type u_1} [ring α] [uniform_space α] [topological_ring α]
    [uniform_add_group α] {β : Type u} [uniform_space β] [ring β] [uniform_add_group β]
    [topological_ring β] (f : α →+* β) (hf : continuous ⇑f) [complete_space β] [separated_space β] :
    completion α →+* β :=
  (fun (hf : uniform_continuous ⇑f) =>
      ring_hom.mk (completion.extension ⇑f) sorry sorry sorry sorry)
    sorry

protected instance top_ring_compl {α : Type u_1} [ring α] [uniform_space α] [topological_ring α]
    [uniform_add_group α] : topological_ring (completion α) :=
  topological_ring.mk continuous_neg

/-- The completion map as a ring morphism. -/
def map_ring_hom {α : Type u_1} [ring α] [uniform_space α] [topological_ring α]
    [uniform_add_group α] {β : Type u} [uniform_space β] [ring β] [uniform_add_group β]
    [topological_ring β] (f : α →+* β) (hf : continuous ⇑f) : completion α →+* completion β :=
  extension_hom (ring_hom.comp coe_ring_hom f) sorry

protected instance comm_ring (R : Type u_2) [comm_ring R] [uniform_space R] [uniform_add_group R]
    [topological_ring R] : comm_ring (completion R) :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry
    ring.one sorry sorry sorry sorry sorry

end uniform_space.completion

namespace uniform_space

theorem ring_sep_rel (α : Type u_1) [comm_ring α] [uniform_space α] [uniform_add_group α]
    [topological_ring α] : separation_setoid α = submodule.quotient_rel (ideal.closure ⊥) :=
  setoid.ext fun (x y : α) => group_separation_rel x y

theorem ring_sep_quot (α : Type u_1) [r : comm_ring α] [uniform_space α] [uniform_add_group α]
    [topological_ring α] : quotient (separation_setoid α) = ideal.quotient (ideal.closure ⊥) :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (quotient (separation_setoid α) = ideal.quotient (ideal.closure ⊥)))
        (ring_sep_rel α)))
    (Eq.refl (quotient (submodule.quotient_rel (ideal.closure ⊥))))

/-- Given a topological ring `α` equipped with a uniform structure that makes subtraction uniformly
continuous, get an equivalence between the separated quotient of `α` and the quotient ring
corresponding to the closure of zero. -/
def sep_quot_equiv_ring_quot (α : Type u_1) [r : comm_ring α] [uniform_space α]
    [uniform_add_group α] [topological_ring α] :
    quotient (separation_setoid α) ≃ ideal.quotient (ideal.closure ⊥) :=
  quotient.congr_right sorry

/- TODO: use a form of transport a.k.a. lift definition a.k.a. transfer -/

protected instance comm_ring {α : Type u_1} [comm_ring α] [uniform_space α] [uniform_add_group α]
    [topological_ring α] : comm_ring (quotient (separation_setoid α)) :=
  eq.mpr sorry (ideal.quotient.comm_ring (ideal.closure ⊥))

protected instance topological_ring {α : Type u_1} [comm_ring α] [uniform_space α]
    [uniform_add_group α] [topological_ring α] :
    topological_ring (quotient (separation_setoid α)) :=
  sorry

end Mathlib


import group_theory.perm.sign
import group_theory.subgroup
import data.list.perm
import fin_group
import array_perm_group

open equiv
open equiv.perm

/-- The group of all possible ways to assemble a Rubik's cube. Not all positions are solvable. -/
@[derive group] def rubiks_cube_overgroup := array_perm 8 (fin' 3) × array_perm 12 (fin' 2)

section widget

  inductive colour : Type | white | green | red | blue | orange | yellow

  open colour

  instance : has_to_string colour :=
  ⟨
    λ c, match c with
      | white := "#ffffff"
      | green := "#00ff00"
      | red := "#ff0000"
      | blue := "#0000ff"
      | orange := "#ff7f00"
      | yellow := "#ffff00"
    end
  ⟩

  open vector

  def list.vec {α : Sort*} : Π a : list α, vector α (a.length)
    | [] := nil
    | (x :: xs) := cons x (xs.vec)

  def corner_map : vector (vector colour 3) 8 :=
  [
    [white, orange, blue].vec,
    [white, blue, red].vec,
    [white, red, green].vec,
    [white, green, orange].vec,
    [yellow, orange, green].vec,
    [yellow, green, red].vec,
    [yellow, red, blue].vec,
    [yellow, blue, orange].vec
  ].vec

  def edge_map : vector (vector colour 2) 12 :=
  [
    [white, blue].vec,
    [white, red].vec,
    [white, green].vec,
    [white, orange].vec,
    [yellow, green].vec,
    [yellow, red].vec,
    [yellow, blue].vec,
    [yellow, orange].vec,
    [blue, orange].vec,
    [blue, red].vec,
    [green, red].vec,
    [green, orange].vec
  ].vec

  variables (cube : rubiks_cube_overgroup) (i : fin 8)

  def corner_sticker (i : fin 8) (o : fin 3) (cube : rubiks_cube_overgroup) : colour :=
    nth (nth corner_map (cube.fst.snd.inv_fun i)) (((cube.fst.fst.read i)⁻¹ : fin' 3) + o)

  def edge_sticker (i : fin 12) (o : fin 2) (cube : rubiks_cube_overgroup) : colour :=
    nth (nth edge_map (cube.snd.snd.inv_fun i)) (((cube.snd.fst.read i)⁻¹ : fin' 2) + o)

  open widget

  meta def sticker (x y : ℕ) (colour : colour) : html empty :=
    h "div" [attr.style [("grid-column", to_string x), ("grid-row", to_string y), ("background-color", to_string colour)]] []

  meta def rubiks_cube_overgroup.to_html (cube : rubiks_cube_overgroup) : html empty :=
    h
    "div"
    [
      attr.style
      [
        ("display", "grid"),
        ("grid-template-columns", "repeat(12, 20px)"),
        ("grid-template-rows", "repeat(9, 20px)"),
        ("row-gap", "2px"),
        ("column-gap", "2px"),
        ("margin", "10px")
      ]
    ]
    [
      sticker 4 1 ∘ corner_sticker 0 0 $ cube,
      sticker 5 1 ∘ edge_sticker 0 0 $ cube,
      sticker 6 1 ∘ corner_sticker 1 0 $ cube,
      sticker 4 2 ∘ edge_sticker 3 0 $ cube,
      sticker 5 2 white,
      sticker 6 2 ∘ edge_sticker 1 0 $ cube,
      sticker 4 3 ∘ corner_sticker 3 0 $ cube,
      sticker 5 3 ∘ edge_sticker 2 0 $ cube,
      sticker 6 3 ∘ corner_sticker 2 0 $ cube,

      sticker 1 4 ∘ corner_sticker 0 1 $ cube,
      sticker 2 4 ∘ edge_sticker 3 1 $ cube,
      sticker 3 4 ∘ corner_sticker 3 2 $ cube,
      sticker 1 5 ∘ edge_sticker 8 1 $ cube,
      sticker 2 5 orange,
      sticker 3 5 ∘ edge_sticker 11 1 $ cube,
      sticker 1 6 ∘ corner_sticker 7 2 $ cube,
      sticker 2 6 ∘ edge_sticker 7 1 $ cube,
      sticker 3 6 ∘ corner_sticker 4 1 $ cube,

      sticker 4 4 ∘ corner_sticker 3 1 $ cube,
      sticker 5 4 ∘ edge_sticker 2 1 $ cube,
      sticker 6 4 ∘ corner_sticker 2 2 $ cube,
      sticker 4 5 ∘ edge_sticker 11 0 $ cube,
      sticker 5 5 green,
      sticker 6 5 ∘ edge_sticker 10 0 $ cube,
      sticker 4 6 ∘ corner_sticker 4 2 $ cube,
      sticker 5 6 ∘ edge_sticker 4 1 $ cube,
      sticker 6 6 ∘ corner_sticker 5 1 $ cube,

      sticker 7 4 ∘ corner_sticker 2 1 $ cube,
      sticker 8 4 ∘ edge_sticker 1 1 $ cube,
      sticker 9 4 ∘ corner_sticker 1 2 $ cube,
      sticker 7 5 ∘ edge_sticker 10 1 $ cube,
      sticker 8 5 red,
      sticker 9 5 ∘ edge_sticker 9 1 $ cube,
      sticker 7 6 ∘ corner_sticker 5 2 $ cube,
      sticker 8 6 ∘ edge_sticker 5 1 $ cube,
      sticker 9 6 ∘ corner_sticker 6 1 $ cube,

      sticker 10 4 ∘ corner_sticker 1 1 $ cube,
      sticker 11 4 ∘ edge_sticker 0 1 $ cube,
      sticker 12 4 ∘ corner_sticker 0 2 $ cube,
      sticker 10 5 ∘ edge_sticker 9 0 $ cube,
      sticker 11 5 blue,
      sticker 12 5 ∘ edge_sticker 8 0 $ cube,
      sticker 10 6 ∘ corner_sticker 6 2 $ cube,
      sticker 11 6 ∘ edge_sticker 6 1 $ cube,
      sticker 12 6 ∘ corner_sticker 7 1 $ cube,

      sticker 4 7 ∘ corner_sticker 4 0 $ cube,
      sticker 5 7 ∘ edge_sticker 4 0 $ cube,
      sticker 6 7 ∘ corner_sticker 5 0 $ cube,
      sticker 4 8 ∘ edge_sticker 7 0 $ cube,
      sticker 5 8 yellow,
      sticker 6 8 ∘ edge_sticker 5 0 $ cube,
      sticker 4 9 ∘ corner_sticker 7 0 $ cube,
      sticker 5 9 ∘ edge_sticker 6 0 $ cube,
      sticker 6 9 ∘ corner_sticker 6 0 $ cube
    ]

end widget

section face_turns

  private def cycle_impl {α : Type*} [decidable_eq α] : α → list α → perm α
    | _ [] := 1
    | a (x :: xs) := swap a x * cycle_impl x xs

  private def cycle {α : Type*} [decidable_eq α] : list α → perm α
    | [] := 1
    | (x :: xs) := cycle_impl x xs

  open array

  def wr {n m : ℕ} (i : fin n) (x : fin m) (a : array n (fin' m)) := write a i x

  def U : rubiks_cube_overgroup :=
    ⟨⟨1, cycle [0, 1, 2, 3]⟩, ⟨1, cycle [0, 1, 2, 3]⟩⟩
  def D : rubiks_cube_overgroup :=
    ⟨⟨1, cycle [4, 5, 6, 7]⟩, ⟨1, cycle [4, 5, 6, 7]⟩⟩
  def R : rubiks_cube_overgroup :=
    ⟨⟨wr 1 1 ∘ wr 6 2 ∘ wr 5 1 ∘ wr 2 2 $ 1, cycle [1, 6, 5, 2]⟩, ⟨1, cycle [1, 9, 5, 10]⟩⟩
  def L : rubiks_cube_overgroup :=
    ⟨⟨wr 0 2 ∘ wr 3 1 ∘ wr 4 2 ∘ wr 7 1 $ 1, cycle [0, 3, 4, 7]⟩, ⟨1, cycle [3, 11, 7, 8]⟩⟩
  def F : rubiks_cube_overgroup :=
    ⟨⟨wr 2 1 ∘ wr 5 2 ∘ wr 4 1 ∘ wr 3 2 $ 1, cycle [2, 5, 4, 3]⟩, ⟨wr 2 1 ∘ wr 10 1 ∘ wr 4 1 ∘ wr 11 1 $ 1, cycle [2, 10, 4, 11]⟩⟩
  def B : rubiks_cube_overgroup :=
    ⟨⟨wr 0 1 ∘ wr 7 2 ∘ wr 6 1 ∘ wr 1 2 $ 1, cycle [0, 7, 6, 1]⟩, ⟨wr 0 1 ∘ wr 8 1 ∘ wr 6 1 ∘ wr 9 1 $ 1, cycle [0, 8, 6, 9]⟩⟩
  def U2 := U^2
  def D2 := D^2
  def R2 := R^2
  def L2 := L^2
  def F2 := F^2
  def B2 := B^2
  def U' := U⁻¹
  def D' := D⁻¹
  def R' := R⁻¹
  def L' := L⁻¹
  def F' := F⁻¹
  def B' := B⁻¹

  instance : has_coe_to_fun rubiks_cube_overgroup := ⟨(λ a, rubiks_cube_overgroup → rubiks_cube_overgroup), λ x y, x * y⟩

end face_turns

/-- The set of all solvable Rubik's cubes. -/
def rubiks_cube : set rubiks_cube_overgroup := {c | c.fst.snd.sign = c.snd.snd.sign ∧ multiset.prod ⟦c.fst.fst.to_list⟧ = 1 ∧ multiset.prod ⟦c.snd.fst.to_list⟧ = 1}

namespace rubiks_cube

  section perm_to_list

    variables {α β : Type*}

    open list

    private lemma list_swap_lt {n m : ℕ} : 0 < n → n < m.succ → n - 1 < m :=
    begin
      intros h₁ h₂,
      cases n,
      {
        exfalso,
        apply nat.not_lt_zero,
        apply h₁,
      },
      rw [nat.sub_one, nat.pred_succ],
      apply nat.lt_of_succ_lt_succ,
      apply h₂,
    end

    @[simp] def list.swap : Π (l : list α) (i j : ℕ), i < j → j < l.length → list α
      | [] _ _ _ h := false.elim (nat.not_lt_zero _ h)
      | (x :: xs) _ 0 h _ := false.elim (nat.not_lt_zero _ h)
      | (x :: xs) 0 (j' + 1) h₁ h₂ := xs.nth_le j' (list_swap_lt h₁ h₂) :: xs.take j' ++ x :: xs.drop (j' + 1)
      | (x :: xs) (i' + 1) (j' + 1) h₁ h₂ := x :: xs.swap i' j' (nat.lt_of_succ_lt_succ h₁) (nat.lt_of_succ_lt_succ h₂)

    lemma list_perm_swap {l : list α} {i j h₁ h₂} : list.swap l i j h₁ h₂ ~ l :=
    begin
      revert i j,
      induction l,
      {
        intros i j _ h,
        exfalso,
        apply nat.not_lt_zero,
        apply h,
      },
      intros i j h₁ h₂,
      cases i, swap,
      {
        cases j,
        {
          exfalso,
          apply nat.not_lt_zero,
          apply h₁,
        },
        apply perm.cons,
        apply l_ih,
      },
      cases j,
      {
        exfalso,
        apply nat.not_lt_zero,
        apply h₁,
      },
      dsimp,
      rw [← cons_append, ← singleton_append, ← @singleton_append _ l_hd],
      apply perm_append_comm.trans,
      rw [singleton_append, cons_append],
      apply perm.cons,
      rw ← append_assoc,
      apply perm_append_comm.trans,
      apply (perm.append_left _ perm_append_comm).trans,
      apply eq.rec (perm.refl _),
      dsimp,
      rw ← drop_eq_nth_le_cons,
      apply take_append_drop,
    end

    @[simp] lemma list_swap_length {l : list α} {i j h₁ h₂} : (list.swap l i j h₁ h₂).length = l.length :=
    begin
      apply perm.length_eq,
      apply list_perm_swap,
    end

    private lemma swap_cases [de : decidable_eq α] {x y z : α} (p : α → Prop) : p x → p y → p z → p (swap x y z) :=
    begin
      intros h_x h_y h_z,
      cases de z x with z_ne_x z_eq_x, swap,
      {
        simp *,
      },
      cases de z y with z_ne_y z_eq_y, swap,
      {
        simp *,
      },
      rw swap_apply_of_ne_of_ne; assumption,
    end

    private lemma swap_map [de : decidable_eq α] [decidable_eq β] {x y z : α} {f : α → β} (inj : function.injective f) : swap (f x) (f y) (f z) = f (swap x y z) :=
    begin
      cases de z x, swap,
      {
        simp *,
      },
      cases de z y, swap,
      {
        simp *,
      },
      rw swap_apply_of_ne_of_ne, rotate,
      {
        simp *,
      },
      {
        simp *,
      },
      rw swap_apply_of_ne_of_ne; assumption,
    end

    lemma list_swap_nth_le {l : list α} {i j k h₁ h₂ h₃ h₄} : (list.swap l i j h₁ h₂).nth_le k h₃ = l.nth_le (swap i j k) h₄ :=
    begin
      revert i j k,
      induction l,
      {
        intros,
        exfalso,
        apply nat.not_lt_zero,
        apply h₂,
      },
      intros,
      cases j,
      {
        exfalso,
        apply nat.not_lt_zero,
        apply h₁,
      },
      cases i,
      {
        dsimp,
        cases k,
        {
          simp_rw swap_apply_left,
          refl,
        },
        cases nat.decidable_eq k j with k_ne_j k_eq_j,
        {
          have k_pos : k.succ ≠ 0,
          {
            intros,
            contradiction,
          },
          have k_ne_j' : k.succ ≠ j.succ,
          {
            intros h,
            apply k_ne_j,
            apply nat.succ.inj,
            apply h,
          },
          simp_rw swap_apply_of_ne_of_ne k_pos k_ne_j',
          dsimp,
          cases (lt_or_gt_of_ne k_ne_j) with k_lt_j k_gt_j,
          {
            rw nth_le_append, swap,
            {
              rw length_take,
              apply lt_min,
              {
                apply k_lt_j,
              },
              {
                apply lt_trans k_lt_j,
                apply nat.lt_of_succ_lt_succ,
                apply h₂,
              },
            },
            suffices : ∀ {l : list α} {n i h₁ h₂}, (take n l).nth_le i h₁ = l.nth_le i h₂,
            {
              rw this,
            },
            intros l,
            induction l with l_hd l l_ih,
            {
              intros n i h₁ h₂,
              exfalso,
              apply nat.not_lt_zero,
              apply h₂,
            },
            intros n i h₁ h₂,
            cases n,
            {
              exfalso,
              apply nat.not_lt_zero,
              apply h₁,
            },
            cases i,
            {
              refl,
            },
            apply l_ih,
          },
          {
            have take_length : (take j l_tl).length = j,
            {
              rw length_take,
              apply min_eq_left,
              apply le_of_lt,
              apply nat.lt_of_succ_lt_succ,
              apply h₂,
            },
            rw nth_le_append_right, swap,
            {
              rw take_length,
              apply le_of_lt,
              apply k_gt_j,
            },
            simp_rw take_length,
            cases k,
            {
              exfalso,
              apply nat.not_lt_zero,
              apply k_gt_j,
            },
            have k_ge_j : k ≥ j,
            {
              apply nat.le_of_lt_succ,
              apply k_gt_j,
            },
            simp_rw @nat.succ_sub k j k_ge_j,
            dsimp,
            rw nth_le_drop',
            congr,
            rw nat.succ_add,
            rw nat.add_sub_cancel',
            apply k_ge_j,
          },
        },
        {
          subst k,
          simp_rw swap_apply_right,
          dsimp,
          have : ∀ {l₁ l₂ : list α} {x : α} {i : ℕ} {h}, l₁.length = i → (l₁ ++ x :: l₂).nth_le i h = x,
          {
            intros l₁,
            induction l₁,
            {
              intros,
              subst i,
              refl,
            },
            intros l₂ x i h₁ h₂,
            cases i,
            {
              contradiction,
            },
            dsimp,
            rw l₁_ih,
            apply nat.succ.inj,
            apply h₂,
          },
          apply this,
          rw length_take,
          apply min_eq_left,
          apply nat.le_of_succ_le_succ,
          apply le_of_lt,
          apply h₂,
        },
      },
      {
        intros,
        dsimp,
        cases k,
        {
          dsimp,
          have i_pos : 0 ≠ i.succ,
          {
            intros h,
            contradiction,
          },
          have j_pos : 0 ≠ j.succ,
          {
            intros h,
            contradiction,
          },
          simp_rw swap_apply_of_ne_of_ne i_pos j_pos,
          simp,
        },
        dsimp,
        conv_rhs
        {
          congr, skip,
          rw swap_map nat.succ_injective,
        },
        dsimp,
        apply l_ih,
      },
    end

    lemma perm_array_swap_eq_to_list_swap {n : ℕ} {a : array n α} {i j h₁ h₂} : (perm_array a (swap i j)).to_list = list.swap a.to_list i j h₁ h₂ :=
    begin
      apply ext_le,
      {
        simp,
      },
      intros k h₃ h₄,
      rw array.to_list_nth_le, swap,
      {
        rwa array.to_list_length at h₃,
      },
      simp_rw perm_array_def,
      dsimp,
      have : equiv.symm (swap i j) = swap i j := rfl,
      rw this,
      clear this,
      rw array.to_list_length at *,
      rw list_swap_nth_le, swap,
      {
        rw array.to_list_length,
        apply swap_cases (< n),
        {
          apply lt.trans h₁,
          apply h₂,
        },
        {
          apply h₂,
        },
        {
          apply h₃,
        },
      },
      rw array.to_list_nth_le, swap,
      {
        apply swap_cases (< n),
        {
          apply lt.trans h₁,
          apply h₂,
        },
        {
          apply h₂,
        },
        {
          apply h₃,
        },
      },
      congr,
      apply fin.eq_of_veq,
      rw swap_apply_def,
      dsimp,
      rw swap_apply_def,
      cases fin.decidable_eq _ ⟨k, _⟩ i with k_ne_i k_eq_i,
      {
        rw if_neg, swap,
        {
          apply k_ne_i,
        },
        rw @if_neg (k = ↑i), swap,
        {
          intros h,
          apply k_ne_i,
          apply fin.eq_of_veq,
          apply h,
        },
        cases fin.decidable_eq _ ⟨k, _⟩ j with k_ne_j k_eq_j,
        {
          rw if_neg, swap,
          {
            apply k_ne_j,
          },
          rw if_neg, swap,
          {
            intros h,
            apply k_ne_j,
            apply fin.eq_of_veq,
            apply h,
          },
          refl,
        },
        rw if_pos, swap,
        {
          apply k_eq_j,
        },
        rw if_pos, swap,
        {
          rw ← k_eq_j,
          refl,
        },
      },
      rw if_pos, swap,
      {
        apply k_eq_i,
      },
      rw if_pos, swap,
      {
        rw ← k_eq_i,
        refl,
      },
    end

    theorem perm_to_list {n : ℕ} {a : array n α} {p : perm (fin n)} : (perm_array a p).to_list ~ a.to_list :=
    begin
      apply swap_induction_on p,
      {
        rw perm_array_perm_one,
      },
      clear p,
      intros p i j i_ne_j ih,
      apply perm.trans _ ih,
      clear ih,
      rw ← perm_array_comp,
      generalize : perm_array a p = l,
      clear a,
      wlog i_lt_j : i < j using i j,
      {
        apply lt_or_gt_of_ne,
        apply i_ne_j,
      },
      swap,
      {
        rw swap_comm,
        apply this,
        symmetry,
        apply i_ne_j,
      },
      rw perm_array_swap_eq_to_list_swap, rotate,
      {
        apply i_lt_j,
      },
      {
        rw array.to_list_length,
        apply fin.is_lt,
      },
      apply list_perm_swap,
    end

  end perm_to_list

  private lemma list.map₂_nth_le {α β γ : Type*} {a b} {f : α → β → γ} {i : ℕ} {h h₁ h₂} : (list.map₂ f a b).nth_le i h = f (a.nth_le i h₁) (b.nth_le i h₂) :=
  begin
    revert b i,
    induction a,
    {
      intros b i h h₁ h₂,
      exfalso,
      apply nat.not_lt_zero,
      apply h₁,
    },
    intros b,
    cases b,
    {
      intros i h h₁ h₂,
      exfalso,
      apply nat.not_lt_zero,
      apply h₂,
    },
    intros i h h₁ h₂,
    dsimp,
    cases i,
    {
      refl,
    },
    dsimp,
    apply a_ih,
  end

  lemma mul_to_list {α : Type*} [group α] {n : ℕ} {a b : array n α} : (a * b).to_list = list.map₂ (*) a.to_list b.to_list :=
  begin
    apply list.ext_le,
    {
      simp,
    },
    intros i h_i h_i₂,
    rw array.to_list_length at *,
    rw list.map₂_nth_le; try { rwa array.to_list_length },
    simp only [array.to_list_nth_le _ h_i, array.read_mul],
  end

  lemma inv_to_list {α : Type*} [group α] {n : ℕ} {a : array n α} : a⁻¹.to_list = list.map (has_inv.inv) a.to_list :=
  begin
    apply list.ext_le,
    {
      simp,
    },
    intros i h_i h_i₂,
    rw array.to_list_length at *,
    rw list.nth_le_map; try { rwa array.to_list_length },
    simp only [array.to_list_nth_le _ h_i],
    refl,
  end

  lemma mul_prod {α : Type*} [comm_group α] {a b : list α} : a.length = b.length → (list.map₂ (*) a b).prod = a.prod * b.prod :=
  begin
    revert b,
    induction a,
    {
      intros b h,
      rw list.eq_nil_of_length_eq_zero h.symm,
      simp,
    },
    intros b h,
    cases b,
    {
      contradiction,
    },
    dsimp,
    simp only [list.prod_cons],
    rw a_ih; injection h,
    apply mul_mul_mul_comm,
  end

  lemma inv_prod {α : Type*} [comm_group α] {a : list α} : (list.map (has_inv.inv) a).prod = a.prod⁻¹ :=
  begin
    induction a,
    {
      simp,
    },
    simp [list.prod_cons, mul_comm, *],
  end

  lemma perm_prod {α : Type*} [comm_group α] {n : ℕ} {a : array n α} {p : perm (fin n)} : (perm_array a p).to_list.prod = a.to_list.prod :=
  begin
    apply list.perm.prod_eq,
    apply perm_to_list,
  end

  lemma one_mem : (1 : rubiks_cube_overgroup) ∈ rubiks_cube :=
  begin
    split; try { split }; refl,
  end

  lemma mul_mem {a b : rubiks_cube_overgroup} : a ∈ rubiks_cube → b ∈ rubiks_cube → a * b ∈ rubiks_cube :=
  begin
    intros h_a h_b,
    split,
    {
      simp [h_a.left, h_b.left],
    },
    split;
    {
      dsimp,
      rw [mul_to_list, multiset.coe_prod, mul_prod],
      swap,
      {
        refl,
      },
      have : (perm_array a.fst.fst b.fst.snd).to_list.prod = a.fst.fst.to_list.prod,
      {
        apply list.perm.prod_eq,
        apply perm_to_list,
      },
      rw perm_prod,
      rcases h_a with ⟨_, h_a₁, h_a₂⟩,
      rcases h_b with ⟨_, h_b₁, h_b₂⟩,
      simp [multiset.coe_prod, *] at *,
    },
  end

  lemma inv_mem {x : rubiks_cube_overgroup} : x ∈ rubiks_cube → x⁻¹ ∈ rubiks_cube :=
  begin
    intros h,
    split,
    {
      simp [sign_inv, h.left],
    },
    split;
    {
      dsimp,
      rw [multiset.coe_prod, perm_prod, inv_to_list, inv_prod, one_inv.symm],
      apply inv_inj.mpr,
      rcases h with ⟨_, h₁, h₂⟩,
      simp [multiset.coe_prod, *] at *,
    },
  end

  protected def group : subgroup rubiks_cube_overgroup :=
  {
    carrier := rubiks_cube,
    one_mem' := one_mem,
    mul_mem' := @mul_mem,
    inv_mem' := @inv_mem,
  }

end rubiks_cube


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

import category_theory.limits.shapes.reflexive
import category_theory.limits.preserves.shapes.equalizers
import category_theory.limits.preserves.limits
import category_theory.monad.adjunction

/-!
# Special coequalizers associated to a monad

Associated to a monad `T : C ⥤ C` we have important coequalizer constructions:
Any algebra is a coequalizer (in the category of algebras) of free algebras. Furthermore, this
coequalizer is reflexive.
In `C`, this cofork diagram is a split coequalizer (in particular, it is still a coequalizer).
This split coequalizer is known as the Beck coequalizer (as it features heavily in Beck's
monadicity theorem).
-/
universes v₁ u₁

namespace category_theory
namespace monad
open limits

variables {C : Type u₁}
variables [category.{v₁} C]
variables {T : monad C} (X : algebra T)

/-!
Show that any algebra is a coequalizer of free algebras.
-/

/-- The top map in the coequalizer diagram we will construct. -/
@[simps]
def free_coequalizer.top_map : (monad.free T).obj (T.obj X.A) ⟶ (monad.free T).obj X.A :=
(monad.free T).map X.a

/-- The bottom map in the coequalizer diagram we will construct. -/
@[simps]
def free_coequalizer.bottom_map : (monad.free T).obj (T.obj X.A) ⟶ (monad.free T).obj X.A :=
{ f := T.μ.app X.A,
  h' := T.assoc X.A }

/-- The cofork map in the coequalizer diagram we will construct. -/
@[simps]
def free_coequalizer.π : (monad.free T).obj X.A ⟶ X :=
{ f := X.a,
  h' := X.assoc.symm }

lemma free_coequalizer.condition :
  free_coequalizer.top_map X ≫ free_coequalizer.π X =
  free_coequalizer.bottom_map X ≫ free_coequalizer.π X :=
algebra.hom.ext _ _ X.assoc.symm

instance : is_reflexive_pair (free_coequalizer.top_map X) (free_coequalizer.bottom_map X) :=
begin
  apply is_reflexive_pair.mk' _ _ _,
  apply (free T).map (T.η.app X.A),
  { ext,
    dsimp,
    rw [← functor.map_comp, X.unit, functor.map_id] },
  { ext,
    apply monad.right_unit }
end

/--
Construct the Beck cofork in the category of algebras. This cofork is reflexive as well as a
coequalizer.
-/
@[simps]
def beck_algebra_cofork : cofork (free_coequalizer.top_map X) (free_coequalizer.bottom_map X) :=
cofork.of_π _ (free_coequalizer.condition X)

/--
The cofork constructed is a colimit. This shows that any algebra is a (reflexive) coequalizer of
free algebras.
-/
def beck_algebra_coequalizer : is_colimit (beck_algebra_cofork X) :=
cofork.is_colimit.mk' _ $ λ s,
begin
  have h₁ : (T : C ⥤ C).map X.a ≫ s.π.f = T.μ.app X.A ≫ s.π.f :=
    congr_arg monad.algebra.hom.f s.condition,
  have h₂ : (T : C ⥤ C).map s.π.f ≫ s.X.a = T.μ.app X.A ≫ s.π.f := s.π.h,
  refine ⟨⟨T.η.app _ ≫ s.π.f, _⟩, _, _⟩,
  { dsimp,
    rw [functor.map_comp, category.assoc, h₂, monad.right_unit_assoc,
        (show X.a ≫ _ ≫ _ = _, from T.η.naturality_assoc _ _), h₁, monad.left_unit_assoc] },
  { ext,
    simpa [← T.η.naturality_assoc, T.left_unit_assoc] using T.η.app ((T : C ⥤ C).obj X.A) ≫= h₁ },
  { intros m hm,
    ext,
    dsimp only,
    rw ← hm,
    apply (X.unit_assoc _).symm }
end

/-- The Beck cofork is a split coequalizer. -/
def beck_split_coequalizer : is_split_coequalizer (T.map X.a) (T.μ.app _) X.a :=
⟨T.η.app _, T.η.app _, X.assoc.symm, X.unit, T.left_unit _, (T.η.naturality _).symm⟩

/-- This is the Beck cofork. It is a split coequalizer, in particular a coequalizer. -/
@[simps]
def beck_cofork : cofork (T.map X.a) (T.μ.app _) :=
(beck_split_coequalizer X).as_cofork

/-- The Beck cofork is a coequalizer. -/
def beck_coequalizer : is_colimit (beck_cofork X) :=
(beck_split_coequalizer X).is_coequalizer

end monad
end category_theory


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.distribution_semantics.defs.prob_event

/-!
# Probabilities for Computations Over Option Type

General lemmas about probability computations involving `option`
-/

namespace oracle_comp

variables {α β γ : Type} {spec spec' : oracle_spec}

section eval_dist

end eval_dist

section prob_event

variables (oa : oracle_comp spec (option α)) (e : set (option α))

lemma prob_event_option [decidable_eq α] (e : set (option α)) :
  ⁅e | oa⁆ = (e.indicator ⁅oa⁆ none) + ∑' (a : α), e.indicator ⁅oa⁆ (some a) :=
(prob_event_eq_tsum_indicator oa e).trans (ennreal.tsum_option _)

lemma prob_event_is_none : ⁅λ x, x.is_none | oa⁆ = ⁅oa⁆ none :=
prob_event_eq_eval_dist oa _ option.is_none_none
  (λ x hx hx', (hx $ option.eq_none_of_is_none hx').elim)

lemma prob_event_is_some [decidable_eq α] : ⁅λ x, x.is_some | oa⁆ = ∑' (a : α), ⁅oa⁆ (some a) :=
let e : set (option α) := λ x, x.is_some in
calc ⁅e | oa⁆
  = e.indicator ⁅oa⁆ none + ∑' (a : α), e.indicator ⁅oa⁆ (some a) : prob_event_option oa _
  ... = 0 + ∑' (a : α), e.indicator ⁅oa⁆ (some a) : begin
    congr,
    refine set.indicator_apply_eq_zero.2 (λ h, false.elim _),
    simpa only [option.is_some_none, coe_sort_ff] using (h : none.is_some),
  end
  ... = ∑' (a : α), e.indicator ⁅oa⁆ (some a) : zero_add _
  ... = ∑' (a : α), ⁅oa⁆ (some a) : begin
    refine tsum_congr (λ a, set.indicator_apply_eq_self.2 (λ h, false.elim $ h _)),
    show ((some a).is_some : Prop),
    simp only [option.is_some_some, coe_sort_tt]
  end

end prob_event

end oracle_comp


/-
Copyright (c) 2020 Hanting Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hanting Zhang, Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.default
import Mathlib.data.mv_polynomial.rename
import Mathlib.data.mv_polynomial.comm_ring
import Mathlib.PostPort

universes u_1 u_2 u_4 u_3

namespace Mathlib

/-!
# Symmetric Polynomials and Elementary Symmetric Polynomials

This file defines symmetric `mv_polynomial`s and elementary symmetric `mv_polynomial`s.
We also prove some basic facts about them.

## Main declarations

* `mv_polynomial.is_symmetric`

* `mv_polynomial.esymm`

## Notation

+ `esymm σ R n`, is the `n`th elementary symmetric polynomial in `mv_polynomial σ R`.

As in other polynomial files, we typically use the notation:

+ `σ τ : Type*` (indexing the variables)

+ `R S : Type*` `[comm_semiring R]` `[comm_semiring S]` (the coefficients)

+ `r : R` elements of the coefficient ring

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `φ ψ : mv_polynomial σ R`

-/

namespace mv_polynomial

/-- A mv_polynomial φ is symmetric if it is invariant under
permutations of its variables by the  `rename` operation -/
def is_symmetric {σ : Type u_1} {R : Type u_2} [comm_semiring R] (φ : mv_polynomial σ R) :=
  ∀ (e : equiv.perm σ), coe_fn (rename ⇑e) φ = φ

namespace is_symmetric

@[simp] theorem C {σ : Type u_1} {R : Type u_2} [comm_semiring R] (r : R) :
    is_symmetric (coe_fn C r) :=
  fun (e : equiv.perm σ) => rename_C (⇑e) r

@[simp] theorem zero {σ : Type u_1} {R : Type u_2} [comm_semiring R] : is_symmetric 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_symmetric 0)) (Eq.symm C_0))) (C 0)

@[simp] theorem one {σ : Type u_1} {R : Type u_2} [comm_semiring R] : is_symmetric 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_symmetric 1)) (Eq.symm C_1))) (C 1)

theorem add {σ : Type u_1} {R : Type u_2} [comm_semiring R] {φ : mv_polynomial σ R}
    {ψ : mv_polynomial σ R} (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ + ψ) :=
  sorry

theorem mul {σ : Type u_1} {R : Type u_2} [comm_semiring R] {φ : mv_polynomial σ R}
    {ψ : mv_polynomial σ R} (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ * ψ) :=
  sorry

theorem smul {σ : Type u_1} {R : Type u_2} [comm_semiring R] {φ : mv_polynomial σ R} (r : R)
    (hφ : is_symmetric φ) : is_symmetric (r • φ) :=
  fun (e : equiv.perm σ) =>
    eq.mpr
      (id
        (Eq._oldrec (Eq.refl (coe_fn (rename ⇑e) (r • φ) = r • φ))
          (alg_hom.map_smul (rename ⇑e) r φ)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (r • coe_fn (rename ⇑e) φ = r • φ)) (hφ e)))
        (Eq.refl (r • φ)))

@[simp] theorem map {σ : Type u_1} {R : Type u_2} {S : Type u_4} [comm_semiring R] [comm_semiring S]
    {φ : mv_polynomial σ R} (hφ : is_symmetric φ) (f : R →+* S) : is_symmetric (coe_fn (map f) φ) :=
  sorry

theorem neg {σ : Type u_1} {R : Type u_2} [comm_ring R] {φ : mv_polynomial σ R}
    (hφ : is_symmetric φ) : is_symmetric (-φ) :=
  fun (e : equiv.perm σ) =>
    eq.mpr
      (id (Eq._oldrec (Eq.refl (coe_fn (rename ⇑e) (-φ) = -φ)) (alg_hom.map_neg (rename ⇑e) φ)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (-coe_fn (rename ⇑e) φ = -φ)) (hφ e))) (Eq.refl (-φ)))

theorem sub {σ : Type u_1} {R : Type u_2} [comm_ring R] {φ : mv_polynomial σ R}
    {ψ : mv_polynomial σ R} (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ - ψ) :=
  sorry

end is_symmetric

/-- The `n`th elementary symmetric `mv_polynomial σ R`. -/
def esymm (σ : Type u_1) (R : Type u_2) [comm_semiring R] [fintype σ] (n : ℕ) : mv_polynomial σ R :=
  finset.sum (finset.powerset_len n finset.univ)
    fun (t : finset σ) => finset.prod t fun (i : σ) => X i

/-- We can define `esymm σ R n` by summing over a subtype instead of over `powerset_len`. -/
theorem esymm_eq_sum_subtype (σ : Type u_1) (R : Type u_2) [comm_semiring R] [fintype σ] (n : ℕ) :
    esymm σ R n =
        finset.sum finset.univ
          fun (t : Subtype fun (s : finset σ) => finset.card s = n) =>
            finset.prod ↑t fun (i : σ) => X i :=
  sorry

/-- We can define `esymm σ R n` as a sum over explicit monomials -/
theorem esymm_eq_sum_monomial (σ : Type u_1) (R : Type u_2) [comm_semiring R] [fintype σ] (n : ℕ) :
    esymm σ R n =
        finset.sum (finset.powerset_len n finset.univ)
          fun (t : finset σ) => monomial (finset.sum t fun (i : σ) => finsupp.single i 1) 1 :=
  sorry

@[simp] theorem esymm_zero (σ : Type u_1) (R : Type u_2) [comm_semiring R] [fintype σ] :
    esymm σ R 0 = 1 :=
  sorry

theorem map_esymm (σ : Type u_1) (R : Type u_2) {S : Type u_4} [comm_semiring R] [comm_semiring S]
    [fintype σ] (n : ℕ) (f : R →+* S) : coe_fn (map f) (esymm σ R n) = esymm σ S n :=
  sorry

theorem rename_esymm (σ : Type u_1) (R : Type u_2) {τ : Type u_3} [comm_semiring R] [fintype σ]
    [fintype τ] (n : ℕ) (e : σ ≃ τ) : coe_fn (rename ⇑e) (esymm σ R n) = esymm τ R n :=
  sorry

theorem esymm_is_symmetric (σ : Type u_1) (R : Type u_2) [comm_semiring R] [fintype σ] (n : ℕ) :
    is_symmetric (esymm σ R n) :=
  sorry

end Mathlib