import data.sigma.basic

namespace sigma
universes u v

section
variables {α : Type u} {β : α → Type v}

theorem eq_fst {s₁ s₂ : sigma β} : s₁ = s₂ → s₁.1 = s₂.1 :=
by cases s₁; cases s₂; cc

theorem eq_snd {s₁ s₂ : sigma β} : s₁ = s₂ → s₁.2 == s₂.2 :=
by cases s₁; cases s₂; cc

end

section
variables {α₁ α₂ : Type u} {β₁ : α₁ → Type v} {β₂ : α₂ → Type v}

/-- A function on `sigma`s that is functional on `fst`s (preserves equality from
argument to result). -/
def fst_functional (f : sigma β₁ → sigma β₂) : Prop :=
∀ ⦃s t : sigma β₁⦄, s.1 = t.1 → (f s).1 = (f t).1

/-- A function on `sigma`s that is injective on `fst`s (preserves equality from
result to argument). -/
def fst_injective (f : sigma β₁ → sigma β₂) : Prop :=
∀ ⦃s t : sigma β₁⦄, (f s).1 = (f t).1 → s.1 = t.1

end

/-- A function on `sigma`s bundled with its `fst`-injectivity property. -/
structure embedding {α₁ α₂ : Type u} (β₁ : α₁ → Type v) (β₂ : α₂ → Type v) :=
(to_fun  : sigma β₁ → sigma β₂)
(fst_inj : fst_injective to_fun)

infixr ` s↪ `:25 := embedding

namespace embedding
variables {α₁ α₂ : Type u} {β₁ : α₁ → Type v} {β₂ : α₂ → Type v}

instance : has_coe_to_fun (β₁ s↪ β₂) :=
⟨_, embedding.to_fun⟩

@[simp] theorem to_fun_eq_coe (f : β₁ s↪ β₂) : f.to_fun = f :=
rfl

@[simp] theorem coe_fn_mk (f : sigma β₁ → sigma β₂) (i : fst_injective f) :
  (mk f i : sigma β₁ → sigma β₂) = f :=
rfl

theorem fst_inj' : ∀ (f : β₁ s↪ β₂), fst_injective f
| ⟨_, h⟩ := h

end embedding

section map_id
variables {α : Type u} {β₁ β₂ : α → Type v}

@[simp] theorem map_id_eq_fst {s : sigma β₁} (f : ∀ a, β₁ a → β₂ a) :
  (s.map id f).1 = s.1 :=
by cases s; refl

theorem map_id_fst_functional (f : ∀ a, β₁ a → β₂ a) :
  fst_functional (map id f) :=
λ _ _, by simp only [map_id_eq_fst]; exact id

theorem map_id_fst_injective (f : ∀ a, β₁ a → β₂ a) :
  fst_injective (map id f) :=
λ _ _, by simp only [map_id_eq_fst]; exact id

/-- Construct an `embedding` with `id` on `fst`. -/
def embedding.mk₂ (f : ∀ a, β₁ a → β₂ a) : embedding β₁ β₂ :=
⟨_, map_id_fst_injective f⟩

end map_id

section
variables {α : Type u} {β : α → Type v} {R : α → α → Prop}

/-- A relation `R` on `fst` values lifted to the `sigma`. This is useful where
you might otherwise use the term `λ s₁ s₂, R s₁.1 s₂.1`. -/
def fst_rel (R : α → α → Prop) (s₁ s₂ : sigma β) : Prop :=
R s₁.1 s₂.1

@[simp] theorem fst_rel_def {s₁ s₂ : sigma β} : fst_rel R s₁ s₂ = R s₁.1 s₂.1 :=
rfl

instance fst_rel_decidable [d : decidable_rel R] : decidable_rel (@fst_rel _ β R)
| s₁ s₂ := @d s₁.1 s₂.1

theorem fst_rel.refl (h : reflexive R) : reflexive (@fst_rel _ β R) :=
λ s, h s.1

theorem fst_rel.symm (h : symmetric R) : symmetric (@fst_rel _ β R) :=
λ s₁ s₂ (p : R s₁.1 s₂.1), h p

theorem fst_rel.trans (h : transitive R) : transitive (@fst_rel _ β R) :=
λ s₁ s₂ s₃ (p : R s₁.1 s₂.1) (q : R s₂.1 s₃.1), h p q

end

section
variables {α : Type u} {β : α → Type v}

theorem fst_functional_id : fst_functional (@id (sigma β)) :=
λ s t h, h

theorem fst_injective_id : fst_injective (@id (sigma β)) :=
λ s t h, h

@[refl] protected def embedding.refl (β : α → Type v) : β s↪ β :=
⟨_, fst_injective_id⟩

@[simp] theorem embedding.refl_apply (s : sigma β) : embedding.refl β s = s :=
rfl

end

section
variables {α₁ α₂ α₃ : Type u}
variables {β₁ : α₁ → Type v} {β₂ : α₂ → Type v} {β₃ : α₃ → Type v}
variables {g : sigma β₂ → sigma β₃} {f : sigma β₁ → sigma β₂}

theorem fst_functional_comp (gf : fst_functional g) (ff : fst_functional f) :
  fst_functional (g ∘ f) :=
λ s t h, gf (ff h)

theorem fst_injective_comp (gi : fst_injective g) (fi : fst_injective f) :
  fst_injective (g ∘ f) :=
λ s t h, fi (gi h)

@[trans] protected def embedding.trans (f : β₁ s↪ β₂) (g : β₂ s↪ β₃) : β₁ s↪ β₃ :=
⟨_, fst_injective_comp g.fst_inj f.fst_inj⟩

@[simp] theorem embedding.trans_apply (f : β₁ s↪ β₂) (g : β₂ s↪ β₃) (s : sigma β₁) :
  (f.trans g) s = g (f s) :=
rfl

end

end sigma


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/

import measure_theory.function.l1_space
import analysis.normed_space.indicator_function

/-! # Functions integrable on a set and at a filter

We define `integrable_on f s μ := integrable f (μ.restrict s)` and prove theorems like
`integrable_on_union : integrable_on f (s ∪ t) μ ↔ integrable_on f s μ ∧ integrable_on f t μ`.

Next we define a predicate `integrable_at_filter (f : α → E) (l : filter α) (μ : measure α)`
saying that `f` is integrable at some set `s ∈ l` and prove that a measurable function is integrable
at `l` with respect to `μ` provided that `f` is bounded above at `l ⊓ μ.ae` and `μ` is finite
at `l`.

-/

noncomputable theory
open set filter topological_space measure_theory function
open_locale classical topological_space interval big_operators filter ennreal measure_theory

variables {α β E F : Type*} [measurable_space α]

section

variables [measurable_space β] {l l' : filter α} {f g : α → β} {μ ν : measure α}

/-- A function `f` is measurable at filter `l` w.r.t. a measure `μ` if it is ae-measurable
w.r.t. `μ.restrict s` for some `s ∈ l`. -/
def measurable_at_filter (f : α → β) (l : filter α) (μ : measure α . volume_tac) :=
∃ s ∈ l, ae_measurable f (μ.restrict s)

@[simp] lemma measurable_at_bot {f : α → β} : measurable_at_filter f ⊥ μ :=
⟨∅, mem_bot, by simp⟩

protected lemma measurable_at_filter.eventually (h : measurable_at_filter f l μ) :
  ∀ᶠ s in l.lift' powerset, ae_measurable f (μ.restrict s) :=
(eventually_lift'_powerset' $ λ s t, ae_measurable.mono_set).2 h

protected lemma measurable_at_filter.filter_mono (h : measurable_at_filter f l μ) (h' : l' ≤ l) :
  measurable_at_filter f l' μ :=
let ⟨s, hsl, hs⟩ := h in ⟨s, h' hsl, hs⟩

protected lemma ae_measurable.measurable_at_filter (h : ae_measurable f μ) :
  measurable_at_filter f l μ :=
⟨univ, univ_mem, by rwa measure.restrict_univ⟩

lemma ae_measurable.measurable_at_filter_of_mem {s} (h : ae_measurable f (μ.restrict s))
  (hl : s ∈ l) : measurable_at_filter f l μ :=
⟨s, hl, h⟩

protected lemma measurable.measurable_at_filter (h : measurable f) :
  measurable_at_filter f l μ :=
h.ae_measurable.measurable_at_filter

end

namespace measure_theory

section normed_group

lemma has_finite_integral_restrict_of_bounded [normed_group E] {f : α → E} {s : set α}
  {μ : measure α} {C}  (hs : μ s < ∞) (hf : ∀ᵐ x ∂(μ.restrict s), ∥f x∥ ≤ C) :
  has_finite_integral f (μ.restrict s) :=
by haveI : is_finite_measure (μ.restrict s) := ⟨by rwa [measure.restrict_apply_univ]⟩;
  exact has_finite_integral_of_bounded hf

variables [normed_group E] [measurable_space E] {f g : α → E} {s t : set α} {μ ν : measure α}

/-- A function is `integrable_on` a set `s` if it is almost everywhere measurable on `s` and if the
integral of its pointwise norm over `s` is less than infinity. -/
def integrable_on (f : α → E) (s : set α) (μ : measure α . volume_tac) : Prop :=
integrable f (μ.restrict s)

lemma integrable_on.integrable (h : integrable_on f s μ) :
  integrable f (μ.restrict s) := h

@[simp] lemma integrable_on_empty : integrable_on f ∅ μ :=
by simp [integrable_on, integrable_zero_measure]

@[simp] lemma integrable_on_univ : integrable_on f univ μ ↔ integrable f μ :=
by rw [integrable_on, measure.restrict_univ]

lemma integrable_on_zero : integrable_on (λ _, (0:E)) s μ := integrable_zero _ _ _

@[simp] lemma integrable_on_const {C : E} : integrable_on (λ _, C) s μ ↔ C = 0 ∨ μ s < ∞ :=
integrable_const_iff.trans $ by rw [measure.restrict_apply_univ]

lemma integrable_on.mono (h : integrable_on f t ν) (hs : s ⊆ t) (hμ : μ ≤ ν) :
  integrable_on f s μ :=
h.mono_measure $ measure.restrict_mono hs hμ

lemma integrable_on.mono_set (h : integrable_on f t μ) (hst : s ⊆ t) :
  integrable_on f s μ :=
h.mono hst (le_refl _)

lemma integrable_on.mono_measure (h : integrable_on f s ν) (hμ : μ ≤ ν) :
  integrable_on f s μ :=
h.mono (subset.refl _) hμ

lemma integrable_on.mono_set_ae (h : integrable_on f t μ) (hst : s ≤ᵐ[μ] t) :
  integrable_on f s μ :=
h.integrable.mono_measure $ measure.restrict_mono_ae hst

lemma integrable_on.congr_set_ae (h : integrable_on f t μ) (hst : s =ᵐ[μ] t) :
  integrable_on f s μ :=
h.mono_set_ae hst.le

lemma integrable.integrable_on (h : integrable f μ) : integrable_on f s μ :=
h.mono_measure $ measure.restrict_le_self

lemma integrable.integrable_on' (h : integrable f (μ.restrict s)) : integrable_on f s μ :=
h

lemma integrable_on.restrict (h : integrable_on f s μ) (hs : measurable_set s) :
  integrable_on f s (μ.restrict t) :=
by { rw [integrable_on, measure.restrict_restrict hs], exact h.mono_set (inter_subset_left _ _) }

lemma integrable_on.left_of_union (h : integrable_on f (s ∪ t) μ) : integrable_on f s μ :=
h.mono_set $ subset_union_left _ _

lemma integrable_on.right_of_union (h : integrable_on f (s ∪ t) μ) : integrable_on f t μ :=
h.mono_set $ subset_union_right _ _

lemma integrable_on.union (hs : integrable_on f s μ) (ht : integrable_on f t μ) :
  integrable_on f (s ∪ t) μ :=
(hs.add_measure ht).mono_measure $ measure.restrict_union_le _ _

@[simp] lemma integrable_on_union :
  integrable_on f (s ∪ t) μ ↔ integrable_on f s μ ∧ integrable_on f t μ :=
⟨λ h, ⟨h.left_of_union, h.right_of_union⟩, λ h, h.1.union h.2⟩

@[simp] lemma integrable_on_singleton_iff {x : α} [measurable_singleton_class α]:
  integrable_on f {x} μ ↔ f x = 0 ∨ μ {x} < ∞ :=
begin
  have : f =ᵐ[μ.restrict {x}] (λ y, f x),
  { filter_upwards [ae_restrict_mem (measurable_set_singleton x)],
    assume a ha,
    simp only [mem_singleton_iff.1 ha] },
  rw [integrable_on, integrable_congr this, integrable_const_iff],
  simp,
end

@[simp] lemma integrable_on_finite_Union {s : set β} (hs : finite s)
  {t : β → set α} : integrable_on f (⋃ i ∈ s, t i) μ ↔ ∀ i ∈ s, integrable_on f (t i) μ :=
begin
  apply hs.induction_on,
  { simp },
  { intros a s ha hs hf, simp [hf, or_imp_distrib, forall_and_distrib] }
end

@[simp] lemma integrable_on_finset_Union {s : finset β} {t : β → set α} :
  integrable_on f (⋃ i ∈ s, t i) μ ↔ ∀ i ∈ s, integrable_on f (t i) μ :=
integrable_on_finite_Union s.finite_to_set

@[simp] lemma integrable_on_fintype_Union [fintype β] {t : β → set α} :
  integrable_on f (⋃ i, t i) μ ↔ ∀ i, integrable_on f (t i) μ :=
by simpa using @integrable_on_finset_Union _ _ _ _ _ _ f μ finset.univ t

lemma integrable_on.add_measure (hμ : integrable_on f s μ) (hν : integrable_on f s ν) :
  integrable_on f s (μ + ν) :=
by { delta integrable_on, rw measure.restrict_add, exact hμ.integrable.add_measure hν }

@[simp] lemma integrable_on_add_measure :
  integrable_on f s (μ + ν) ↔ integrable_on f s μ ∧ integrable_on f s ν :=
⟨λ h, ⟨h.mono_measure (measure.le_add_right (le_refl _)),
  h.mono_measure (measure.le_add_left (le_refl _))⟩,
  λ h, h.1.add_measure h.2⟩

lemma _root_.measurable_embedding.integrable_on_map_iff [measurable_space β] {e : α → β}
  (he : measurable_embedding e) {f : β → E} {μ : measure α} {s : set β} :
  integrable_on f s (measure.map e μ) ↔ integrable_on (f ∘ e) (e ⁻¹' s) μ :=
by simp only [integrable_on, he.restrict_map, he.integrable_map_iff]

lemma integrable_on_map_equiv [measurable_space β] (e : α ≃ᵐ β) {f : β → E} {μ : measure α}
  {s : set β} :
  integrable_on f s (measure.map e μ) ↔ integrable_on (f ∘ e) (e ⁻¹' s) μ :=
by simp only [integrable_on, e.restrict_map, integrable_map_equiv e]

lemma measure_preserving.integrable_on_comp_preimage [measurable_space β] {e : α → β} {ν}
  (h₁ : measure_preserving e μ ν) (h₂ : measurable_embedding e) {f : β → E} {s : set β} :
  integrable_on (f ∘ e) (e ⁻¹' s) μ ↔ integrable_on f s ν :=
(h₁.restrict_preimage_emb h₂ s).integrable_comp_emb h₂

lemma measure_preserving.integrable_on_image [measurable_space β] {e : α → β} {ν}
  (h₁ : measure_preserving e μ ν) (h₂ : measurable_embedding e) {f : β → E} {s : set α} :
  integrable_on f (e '' s) ν ↔  integrable_on (f ∘ e) s μ :=
((h₁.restrict_image_emb h₂ s).integrable_comp_emb h₂).symm

lemma integrable_indicator_iff (hs : measurable_set s) :
  integrable (indicator s f) μ ↔ integrable_on f s μ :=
by simp [integrable_on, integrable, has_finite_integral, nnnorm_indicator_eq_indicator_nnnorm,
  ennreal.coe_indicator, lintegral_indicator _ hs, ae_measurable_indicator_iff hs]

lemma integrable_on.indicator (h : integrable_on f s μ) (hs : measurable_set s) :
  integrable (indicator s f) μ :=
(integrable_indicator_iff hs).2 h

lemma integrable.indicator (h : integrable f μ) (hs : measurable_set s) :
  integrable (indicator s f) μ :=
h.integrable_on.indicator hs

lemma integrable_indicator_const_Lp {E} [normed_group E] [measurable_space E] [borel_space E]
  [second_countable_topology E] {p : ℝ≥0∞} {s : set α} (hs : measurable_set s) (hμs : μ s ≠ ∞)
  (c : E) :
  integrable (indicator_const_Lp p hs hμs c) μ :=
begin
  rw [integrable_congr indicator_const_Lp_coe_fn, integrable_indicator_iff hs, integrable_on,
    integrable_const_iff, lt_top_iff_ne_top],
  right,
  simpa only [set.univ_inter, measurable_set.univ, measure.restrict_apply] using hμs,
end

lemma integrable_on_Lp_of_measure_ne_top {E} [normed_group E] [measurable_space E] [borel_space E]
  [second_countable_topology E] {p : ℝ≥0∞} {s : set α} (f : Lp E p μ) (hp : 1 ≤ p) (hμs : μ s ≠ ∞) :
  integrable_on f s μ :=
begin
  refine mem_ℒp_one_iff_integrable.mp _,
  have hμ_restrict_univ : (μ.restrict s) set.univ < ∞,
    by simpa only [set.univ_inter, measurable_set.univ, measure.restrict_apply, lt_top_iff_ne_top],
  haveI hμ_finite : is_finite_measure (μ.restrict s) := ⟨hμ_restrict_univ⟩,
  exact ((Lp.mem_ℒp _).restrict s).mem_ℒp_of_exponent_le hp,
end

/-- We say that a function `f` is *integrable at filter* `l` if it is integrable on some
set `s ∈ l`. Equivalently, it is eventually integrable on `s` in `l.lift' powerset`. -/
def integrable_at_filter (f : α → E) (l : filter α) (μ : measure α . volume_tac) :=
∃ s ∈ l, integrable_on f s μ

variables {l l' : filter α}

protected lemma integrable_at_filter.eventually (h : integrable_at_filter f l μ) :
  ∀ᶠ s in l.lift' powerset, integrable_on f s μ :=
by { refine (eventually_lift'_powerset' $ λ s t hst ht, _).2 h, exact ht.mono_set hst }

lemma integrable_at_filter.filter_mono (hl : l ≤ l') (hl' : integrable_at_filter f l' μ) :
  integrable_at_filter f l μ :=
let ⟨s, hs, hsf⟩ := hl' in ⟨s, hl hs, hsf⟩

lemma integrable_at_filter.inf_of_left (hl : integrable_at_filter f l μ) :
  integrable_at_filter f (l ⊓ l') μ :=
hl.filter_mono inf_le_left

lemma integrable_at_filter.inf_of_right (hl : integrable_at_filter f l μ) :
  integrable_at_filter f (l' ⊓ l) μ :=
hl.filter_mono inf_le_right

@[simp] lemma integrable_at_filter.inf_ae_iff {l : filter α} :
  integrable_at_filter f (l ⊓ μ.ae) μ ↔ integrable_at_filter f l μ :=
begin
  refine ⟨_, λ h, h.filter_mono inf_le_left⟩,
  rintros ⟨s, ⟨t, ht, u, hu, rfl⟩, hf⟩,
  refine ⟨t, ht, _⟩,
  refine hf.integrable.mono_measure (λ v hv, _),
  simp only [measure.restrict_apply hv],
  refine measure_mono_ae (mem_of_superset hu $ λ x hx, _),
  exact λ ⟨hv, ht⟩, ⟨hv, ⟨ht, hx⟩⟩
end

alias integrable_at_filter.inf_ae_iff ↔ measure_theory.integrable_at_filter.of_inf_ae _

/-- If `μ` is a measure finite at filter `l` and `f` is a function such that its norm is bounded
above at `l`, then `f` is integrable at `l`. -/
lemma measure.finite_at_filter.integrable_at_filter {l : filter α} [is_measurably_generated l]
  (hfm : measurable_at_filter f l μ) (hμ : μ.finite_at_filter l)
  (hf : l.is_bounded_under (≤) (norm ∘ f)) :
  integrable_at_filter f l μ :=
begin
  obtain ⟨C, hC⟩ : ∃ C, ∀ᶠ s in (l.lift' powerset), ∀ x ∈ s, ∥f x∥ ≤ C,
    from hf.imp (λ C hC, eventually_lift'_powerset.2 ⟨_, hC, λ t, id⟩),
  rcases (hfm.eventually.and (hμ.eventually.and hC)).exists_measurable_mem_of_lift'
    with ⟨s, hsl, hsm, hfm, hμ, hC⟩,
  refine ⟨s, hsl, ⟨hfm, has_finite_integral_restrict_of_bounded hμ _⟩⟩,
  exact C,
  rw [ae_restrict_eq hsm, eventually_inf_principal],
  exact eventually_of_forall hC
end

lemma measure.finite_at_filter.integrable_at_filter_of_tendsto_ae
  {l : filter α} [is_measurably_generated l] (hfm : measurable_at_filter f l μ)
  (hμ : μ.finite_at_filter l) {b} (hf : tendsto f (l ⊓ μ.ae) (𝓝 b)) :
  integrable_at_filter f l μ :=
(hμ.inf_of_left.integrable_at_filter (hfm.filter_mono inf_le_left)
  hf.norm.is_bounded_under_le).of_inf_ae

alias measure.finite_at_filter.integrable_at_filter_of_tendsto_ae ←
  filter.tendsto.integrable_at_filter_ae

lemma measure.finite_at_filter.integrable_at_filter_of_tendsto {l : filter α}
  [is_measurably_generated l] (hfm : measurable_at_filter f l μ) (hμ : μ.finite_at_filter l)
  {b} (hf : tendsto f l (𝓝 b)) :
  integrable_at_filter f l μ :=
hμ.integrable_at_filter hfm hf.norm.is_bounded_under_le

alias measure.finite_at_filter.integrable_at_filter_of_tendsto ← filter.tendsto.integrable_at_filter

variables [borel_space E] [second_countable_topology E]

lemma integrable_add_of_disjoint {f g : α → E}
  (h : disjoint (support f) (support g)) (hf : measurable f) (hg : measurable g) :
  integrable (f + g) μ ↔ integrable f μ ∧ integrable g μ :=
begin
  refine ⟨λ hfg, ⟨_, _⟩, λ h, h.1.add h.2⟩,
  { rw ← indicator_add_eq_left h, exact hfg.indicator (measurable_set_support hf) },
  { rw ← indicator_add_eq_right h, exact hfg.indicator (measurable_set_support hg) }
end

end normed_group

end measure_theory

open measure_theory

variables [measurable_space E] [normed_group E]

/-- If a function is integrable at `𝓝[s] x` for each point `x` of a compact set `s`, then it is
integrable on `s`. -/
lemma is_compact.integrable_on_of_nhds_within [topological_space α] {μ : measure α} {s : set α}
  (hs : is_compact s) {f : α → E} (hf : ∀ x ∈ s, integrable_at_filter f (𝓝[s] x) μ) :
  integrable_on f s μ :=
is_compact.induction_on hs integrable_on_empty (λ s t hst ht, ht.mono_set hst)
  (λ s t hs ht, hs.union ht) hf

/-- A function which is continuous on a set `s` is almost everywhere measurable with respect to
`μ.restrict s`. -/
lemma continuous_on.ae_measurable [topological_space α] [opens_measurable_space α]
  [measurable_space β] [topological_space β] [borel_space β]
  {f : α → β} {s : set α} {μ : measure α} (hf : continuous_on f s) (hs : measurable_set s) :
  ae_measurable f (μ.restrict s) :=
begin
  nontriviality α, inhabit α,
  have : piecewise s f (λ _, f (default α)) =ᵐ[μ.restrict s] f := piecewise_ae_eq_restrict hs,
  refine ⟨piecewise s f (λ _, f (default α)), _, this.symm⟩,
  apply measurable_of_is_open,
  assume t ht,
  obtain ⟨u, u_open, hu⟩ : ∃ (u : set α), is_open u ∧ f ⁻¹' t ∩ s = u ∩ s :=
    _root_.continuous_on_iff'.1 hf t ht,
  rw [piecewise_preimage, set.ite, hu],
  exact (u_open.measurable_set.inter hs).union ((measurable_const ht.measurable_set).diff hs)
end

lemma continuous_on.integrable_at_nhds_within
  [topological_space α] [opens_measurable_space α] [borel_space E]
  {μ : measure α} [is_locally_finite_measure μ] {a : α} {t : set α} {f : α → E}
  (hft : continuous_on f t) (ht : measurable_set t) (ha : a ∈ t) :
  integrable_at_filter f (𝓝[t] a) μ :=
by haveI : (𝓝[t] a).is_measurably_generated := ht.nhds_within_is_measurably_generated _;
exact (hft a ha).integrable_at_filter ⟨_, self_mem_nhds_within, hft.ae_measurable ht⟩
  (μ.finite_at_nhds_within _ _)

/-- A function `f` continuous on a compact set `s` is integrable on this set with respect to any
locally finite measure. -/
lemma continuous_on.integrable_on_compact
  [topological_space α] [opens_measurable_space α] [borel_space E]
  [t2_space α] {μ : measure α} [is_locally_finite_measure μ]
  {s : set α} (hs : is_compact s) {f : α → E} (hf : continuous_on f s) :
  integrable_on f s μ :=
hs.integrable_on_of_nhds_within $ λ x hx, hf.integrable_at_nhds_within hs.measurable_set hx

lemma continuous_on.integrable_on_Icc [borel_space E]
  [conditionally_complete_linear_order β] [topological_space β] [order_topology β]
  [measurable_space β] [opens_measurable_space β] {μ : measure β} [is_locally_finite_measure μ]
  {a b : β} {f : β → E} (hf : continuous_on f (Icc a b)) :
  integrable_on f (Icc a b) μ :=
hf.integrable_on_compact is_compact_Icc

lemma continuous_on.integrable_on_interval [borel_space E]
  [conditionally_complete_linear_order β] [topological_space β] [order_topology β]
  [measurable_space β] [opens_measurable_space β] {μ : measure β} [is_locally_finite_measure μ]
  {a b : β} {f : β → E} (hf : continuous_on f [a, b]) :
  integrable_on f [a, b] μ :=
hf.integrable_on_compact is_compact_interval

/-- A continuous function `f` is integrable on any compact set with respect to any locally finite
measure. -/
lemma continuous.integrable_on_compact
  [topological_space α] [opens_measurable_space α] [t2_space α]
  [borel_space E] {μ : measure α} [is_locally_finite_measure μ] {s : set α}
  (hs : is_compact s) {f : α → E} (hf : continuous f) :
  integrable_on f s μ :=
hf.continuous_on.integrable_on_compact hs

lemma continuous.integrable_on_Icc [borel_space E]
  [conditionally_complete_linear_order β] [topological_space β] [order_topology β]
  [measurable_space β] [opens_measurable_space β] {μ : measure β} [is_locally_finite_measure μ]
  {a b : β} {f : β → E} (hf : continuous f) :
  integrable_on f (Icc a b) μ :=
hf.integrable_on_compact is_compact_Icc

lemma continuous.integrable_on_Ioc [borel_space E]
  [conditionally_complete_linear_order β] [topological_space β] [order_topology β]
  [measurable_space β] [opens_measurable_space β] {μ : measure β} [is_locally_finite_measure μ]
  {a b : β} {f : β → E} (hf : continuous f) :
  integrable_on f (Ioc a b) μ :=
hf.integrable_on_Icc.mono_set Ioc_subset_Icc_self

lemma continuous.integrable_on_interval [borel_space E]
  [conditionally_complete_linear_order β] [topological_space β] [order_topology β]
  [measurable_space β] [opens_measurable_space β] {μ : measure β} [is_locally_finite_measure μ]
  {a b : β} {f : β → E} (hf : continuous f) :
  integrable_on f [a, b] μ :=
hf.integrable_on_compact is_compact_interval

lemma continuous.integrable_on_interval_oc [borel_space E]
  [conditionally_complete_linear_order β] [topological_space β] [order_topology β]
  [measurable_space β] [opens_measurable_space β] {μ : measure β} [is_locally_finite_measure μ]
  {a b : β} {f : β → E} (hf : continuous f) :
  integrable_on f (Ι a b) μ :=
hf.integrable_on_Ioc

/-- A continuous function with compact closure of the support is integrable on the whole space. -/
lemma continuous.integrable_of_compact_closure_support
  [topological_space α] [opens_measurable_space α] [t2_space α] [borel_space E]
  {μ : measure α} [is_locally_finite_measure μ] {f : α → E} (hf : continuous f)
  (hfc : is_compact (closure $ support f)) :
  integrable f μ :=
begin
  rw [← indicator_eq_self.2 (@subset_closure _ _ (support f)),
    integrable_indicator_iff is_closed_closure.measurable_set],
  { exact hf.integrable_on_compact hfc },
  { apply_instance }
end

section
variables [topological_space α] [opens_measurable_space α]
  {μ : measure α} {s t : set α} {f g : α → ℝ}

lemma measure_theory.integrable_on.mul_continuous_on_of_subset
  (hf : integrable_on f s μ) (hg : continuous_on g t)
  (hs : measurable_set s) (ht : is_compact t) (hst : s ⊆ t) :
  integrable_on (λ x, f x * g x) s μ :=
begin
  rcases is_compact.exists_bound_of_continuous_on ht hg with ⟨C, hC⟩,
  rw [integrable_on, ← mem_ℒp_one_iff_integrable] at hf ⊢,
  have : ∀ᵐ x ∂(μ.restrict s), ∥f x * g x∥ ≤ C * ∥f x∥,
  { filter_upwards [ae_restrict_mem hs],
    assume x hx,
    rw [real.norm_eq_abs, abs_mul, mul_comm, real.norm_eq_abs],
    apply mul_le_mul_of_nonneg_right (hC x (hst hx)) (abs_nonneg _) },
  exact mem_ℒp.of_le_mul hf (hf.ae_measurable.mul ((hg.mono hst).ae_measurable hs)) this,
end

lemma measure_theory.integrable_on.mul_continuous_on [t2_space α]
  (hf : integrable_on f s μ) (hg : continuous_on g s) (hs : is_compact s) :
  integrable_on (λ x, f x * g x) s μ :=
hf.mul_continuous_on_of_subset hg hs.measurable_set hs (subset.refl _)

lemma measure_theory.integrable_on.continuous_on_mul_of_subset
  (hf : integrable_on f s μ) (hg : continuous_on g t)
  (hs : measurable_set s) (ht : is_compact t) (hst : s ⊆ t) :
  integrable_on (λ x, g x * f x) s μ :=
by simpa [mul_comm] using hf.mul_continuous_on_of_subset hg hs ht hst

lemma measure_theory.integrable_on.continuous_on_mul [t2_space α]
  (hf : integrable_on f s μ) (hg : continuous_on g s) (hs : is_compact s) :
  integrable_on (λ x, g x * f x) s μ :=
hf.continuous_on_mul_of_subset hg hs.measurable_set hs (subset.refl _)

end

section monotone

variables
  [topological_space α] [borel_space α] [borel_space E]
  [conditionally_complete_linear_order α] [conditionally_complete_linear_order E]
  [order_topology α] [order_topology E] [second_countable_topology E]
  {μ : measure α} [is_locally_finite_measure μ] {s : set α} (hs : is_compact s) {f : α → E}

include hs

lemma monotone_on.integrable_on_compact (hmono : monotone_on f s) :
  integrable_on f s μ :=
begin
  obtain rfl | h := s.eq_empty_or_nonempty,
  { exact integrable_on_empty },
  have hbelow : bdd_below (f '' s) :=
    ⟨f (Inf s), λ x ⟨y, hy, hyx⟩, hyx ▸ hmono (hs.Inf_mem h) hy (cInf_le hs.bdd_below hy)⟩,
  have habove : bdd_above (f '' s) :=
    ⟨f (Sup s), λ x ⟨y, hy, hyx⟩, hyx ▸ hmono hy (hs.Sup_mem h) (le_cSup hs.bdd_above hy)⟩,
  have : metric.bounded (f '' s) := metric.bounded_of_bdd_above_of_bdd_below habove hbelow,
  rcases bounded_iff_forall_norm_le.mp this with ⟨C, hC⟩,
  exact integrable.mono' (continuous_const.integrable_on_compact hs)
    (ae_measurable_restrict_of_monotone_on hs.measurable_set hmono)
    ((ae_restrict_iff' hs.measurable_set).mpr $ ae_of_all _ $
      λ y hy, hC (f y) (mem_image_of_mem f hy)),
end

lemma antitone_on.integrable_on_compact (hanti : antitone_on f s) :
  integrable_on f s μ :=
@monotone_on.integrable_on_compact α (order_dual E) _ _ ‹_› _ _ ‹_› _ _ _ _ ‹_› _ _ _ hs _ hanti

lemma monotone.integrable_on_compact (hmono : monotone f) :
  integrable_on f s μ :=
monotone_on.integrable_on_compact hs (λ x y _ _ hxy, hmono hxy)

lemma antitone.integrable_on_compact (hanti : antitone f) :
  integrable_on f s μ :=
@monotone.integrable_on_compact α (order_dual E) _ _ ‹_› _ _ ‹_› _ _ _ _ ‹_› _ _ _ hs _ hanti

end monotone


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.invertible
import Mathlib.linear_algebra.affine_space.affine_equiv
import Mathlib.PostPort

universes u_1 u_2 u_4 u_3 u_5

namespace Mathlib

/-!
# Midpoint of a segment

## Main definitions

* `midpoint R x y`: midpoint of the segment `[x, y]`. We define it for `x` and `y`
  in a module over a ring `R` with invertible `2`.
* `add_monoid_hom.of_map_midpoint`: construct an `add_monoid_hom` given a map `f` such that
  `f` sends zero to zero and midpoints to midpoints.

## Main theorems

* `midpoint_eq_iff`: `z` is the midpoint of `[x, y]` if and only if `x + y = z + z`,
* `midpoint_unique`: `midpoint R x y` does not depend on `R`;
* `midpoint x y` is linear both in `x` and `y`;
* `point_reflection_midpoint_left`, `point_reflection_midpoint_right`:
  `equiv.point_reflection (midpoint R x y)` swaps `x` and `y`.

We do not mark most lemmas as `@[simp]` because it is hard to tell which side is simpler.

## Tags

midpoint, add_monoid_hom
-/

/-- `midpoint x y` is the midpoint of the segment `[x, y]`. -/
def midpoint (R : Type u_1) {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] [add_torsor V P] (x : P) (y : P) : P :=
  coe_fn (affine_map.line_map x y) ⅟

@[simp] theorem affine_map.map_midpoint {R : Type u_1} {V : Type u_2} {V' : Type u_3} {P : Type u_4}
    {P' : Type u_5} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V]
    [add_torsor V P] [add_comm_group V'] [semimodule R V'] [add_torsor V' P']
    (f : affine_map R P P') (a : P) (b : P) :
    coe_fn f (midpoint R a b) = midpoint R (coe_fn f a) (coe_fn f b) :=
  affine_map.apply_line_map f a b ⅟

@[simp] theorem affine_equiv.map_midpoint {R : Type u_1} {V : Type u_2} {V' : Type u_3}
    {P : Type u_4} {P' : Type u_5} [ring R] [invertible (bit0 1)] [add_comm_group V]
    [semimodule R V] [add_torsor V P] [add_comm_group V'] [semimodule R V'] [add_torsor V' P']
    (f : affine_equiv R P P') (a : P) (b : P) :
    coe_fn f (midpoint R a b) = midpoint R (coe_fn f a) (coe_fn f b) :=
  affine_equiv.apply_line_map f a b ⅟

@[simp] theorem affine_equiv.point_reflection_midpoint_left {R : Type u_1} {V : Type u_2}
    {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V]
    [add_torsor V P] (x : P) (y : P) :
    coe_fn (affine_equiv.point_reflection R (midpoint R x y)) x = y :=
  sorry

theorem midpoint_comm {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] [add_torsor V P] (x : P) (y : P) :
    midpoint R x y = midpoint R y x :=
  sorry

@[simp] theorem affine_equiv.point_reflection_midpoint_right {R : Type u_1} {V : Type u_2}
    {P : Type u_4} [ring R] [invertible (bit0 1)] [add_comm_group V] [semimodule R V]
    [add_torsor V P] (x : P) (y : P) :
    coe_fn (affine_equiv.point_reflection R (midpoint R x y)) y = x :=
  sorry

theorem midpoint_vsub_midpoint {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R]
    [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (p₁ : P) (p₂ : P)
    (p₃ : P) (p₄ : P) : midpoint R p₁ p₂ -ᵥ midpoint R p₃ p₄ = midpoint R (p₁ -ᵥ p₃) (p₂ -ᵥ p₄) :=
  affine_map.line_map_vsub_line_map p₁ p₂ p₃ p₄ ⅟

theorem midpoint_vadd_midpoint {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R]
    [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (v : V) (v' : V)
    (p : P) (p' : P) : midpoint R v v' +ᵥ midpoint R p p' = midpoint R (v +ᵥ p) (v' +ᵥ p') :=
  affine_map.line_map_vadd_line_map v v' p p' ⅟

theorem midpoint_eq_iff {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] [add_torsor V P] {x : P} {y : P} {z : P} :
    midpoint R x y = z ↔ coe_fn (affine_equiv.point_reflection R z) x = y :=
  sorry

@[simp] theorem midpoint_vsub_left {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R]
    [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (p₁ : P) (p₂ : P) :
    midpoint R p₁ p₂ -ᵥ p₁ = ⅟ • (p₂ -ᵥ p₁) :=
  affine_map.line_map_vsub_left p₁ p₂ ⅟

@[simp] theorem midpoint_vsub_right {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R]
    [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (p₁ : P) (p₂ : P) :
    midpoint R p₁ p₂ -ᵥ p₂ = ⅟ • (p₁ -ᵥ p₂) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (midpoint R p₁ p₂ -ᵥ p₂ = ⅟ • (p₁ -ᵥ p₂))) (midpoint_comm p₁ p₂)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (midpoint R p₂ p₁ -ᵥ p₂ = ⅟ • (p₁ -ᵥ p₂))) (midpoint_vsub_left p₂ p₁)))
      (Eq.refl (⅟ • (p₁ -ᵥ p₂))))

@[simp] theorem left_vsub_midpoint {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R]
    [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (p₁ : P) (p₂ : P) :
    p₁ -ᵥ midpoint R p₁ p₂ = ⅟ • (p₁ -ᵥ p₂) :=
  affine_map.left_vsub_line_map p₁ p₂ ⅟

@[simp] theorem right_vsub_midpoint {R : Type u_1} {V : Type u_2} {P : Type u_4} [ring R]
    [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (p₁ : P) (p₂ : P) :
    p₂ -ᵥ midpoint R p₁ p₂ = ⅟ • (p₂ -ᵥ p₁) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (p₂ -ᵥ midpoint R p₁ p₂ = ⅟ • (p₂ -ᵥ p₁))) (midpoint_comm p₁ p₂)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (p₂ -ᵥ midpoint R p₂ p₁ = ⅟ • (p₂ -ᵥ p₁))) (left_vsub_midpoint p₂ p₁)))
      (Eq.refl (⅟ • (p₂ -ᵥ p₁))))

@[simp] theorem midpoint_sub_left {R : Type u_1} {V : Type u_2} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] (v₁ : V) (v₂ : V) : midpoint R v₁ v₂ - v₁ = ⅟ • (v₂ - v₁) :=
  midpoint_vsub_left v₁ v₂

@[simp] theorem midpoint_sub_right {R : Type u_1} {V : Type u_2} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] (v₁ : V) (v₂ : V) : midpoint R v₁ v₂ - v₂ = ⅟ • (v₁ - v₂) :=
  midpoint_vsub_right v₁ v₂

@[simp] theorem left_sub_midpoint {R : Type u_1} {V : Type u_2} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] (v₁ : V) (v₂ : V) : v₁ - midpoint R v₁ v₂ = ⅟ • (v₁ - v₂) :=
  left_vsub_midpoint v₁ v₂

@[simp] theorem right_sub_midpoint {R : Type u_1} {V : Type u_2} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] (v₁ : V) (v₂ : V) : v₂ - midpoint R v₁ v₂ = ⅟ • (v₂ - v₁) :=
  right_vsub_midpoint v₁ v₂

theorem midpoint_eq_midpoint_iff_vsub_eq_vsub (R : Type u_1) {V : Type u_2} {P : Type u_4} [ring R]
    [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] {x : P} {x' : P}
    {y : P} {y' : P} : midpoint R x y = midpoint R x' y' ↔ x -ᵥ x' = y' -ᵥ y :=
  sorry

theorem midpoint_eq_iff' (R : Type u_1) {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] [add_torsor V P] {x : P} {y : P} {z : P} :
    midpoint R x y = z ↔ coe_fn (equiv.point_reflection z) x = y :=
  midpoint_eq_iff

/-- `midpoint` does not depend on the ring `R`. -/
theorem midpoint_unique (R : Type u_1) {V : Type u_2} {P : Type u_4} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] [add_torsor V P] (R' : Type u_3) [ring R']
    [invertible (bit0 1)] [semimodule R' V] (x : P) (y : P) : midpoint R x y = midpoint R' x y :=
  iff.mpr (midpoint_eq_iff' R) (iff.mp (midpoint_eq_iff' R') rfl)

@[simp] theorem midpoint_self (R : Type u_1) {V : Type u_2} {P : Type u_4} [ring R]
    [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (x : P) :
    midpoint R x x = x :=
  affine_map.line_map_same_apply x ⅟

@[simp] theorem midpoint_add_self (R : Type u_1) {V : Type u_2} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] (x : V) (y : V) : midpoint R x y + midpoint R x y = x + y :=
  sorry

theorem midpoint_zero_add (R : Type u_1) {V : Type u_2} [ring R] [invertible (bit0 1)]
    [add_comm_group V] [semimodule R V] (x : V) (y : V) : midpoint R 0 (x + y) = midpoint R x y :=
  sorry

theorem line_map_inv_two {R : Type u_1} {V : Type u_2} {P : Type u_3} [division_ring R]
    [char_zero R] [add_comm_group V] [semimodule R V] [add_torsor V P] (a : P) (b : P) :
    coe_fn (affine_map.line_map a b) (bit0 1⁻¹) = midpoint R a b :=
  rfl

theorem line_map_one_half {R : Type u_1} {V : Type u_2} {P : Type u_3} [division_ring R]
    [char_zero R] [add_comm_group V] [semimodule R V] [add_torsor V P] (a : P) (b : P) :
    coe_fn (affine_map.line_map a b) (1 / bit0 1) = midpoint R a b :=
  sorry

theorem homothety_inv_of_two {R : Type u_1} {V : Type u_2} {P : Type u_3} [comm_ring R]
    [invertible (bit0 1)] [add_comm_group V] [semimodule R V] [add_torsor V P] (a : P) (b : P) :
    coe_fn (affine_map.homothety a ⅟) b = midpoint R a b :=
  rfl

theorem homothety_inv_two {k : Type u_1} {V : Type u_2} {P : Type u_3} [field k] [char_zero k]
    [add_comm_group V] [semimodule k V] [add_torsor V P] (a : P) (b : P) :
    coe_fn (affine_map.homothety a (bit0 1⁻¹)) b = midpoint k a b :=
  rfl

theorem homothety_one_half {k : Type u_1} {V : Type u_2} {P : Type u_3} [field k] [char_zero k]
    [add_comm_group V] [semimodule k V] [add_torsor V P] (a : P) (b : P) :
    coe_fn (affine_map.homothety a (1 / bit0 1)) b = midpoint k a b :=
  sorry

@[simp] theorem pi_midpoint_apply {k : Type u_1} {ι : Type u_2} {V : ι → Type u_3}
    {P : ι → Type u_4} [field k] [invertible (bit0 1)] [(i : ι) → add_comm_group (V i)]
    [(i : ι) → semimodule k (V i)] [(i : ι) → add_torsor (V i) (P i)] (f : (i : ι) → P i)
    (g : (i : ι) → P i) (i : ι) : midpoint k f g i = midpoint k (f i) (g i) :=
  rfl

namespace add_monoid_hom

/-- A map `f : E → F` sending zero to zero and midpoints to midpoints is an `add_monoid_hom`. -/
def of_map_midpoint (R : Type u_1) (R' : Type u_2) {E : Type u_3} {F : Type u_4} [ring R]
    [invertible (bit0 1)] [add_comm_group E] [semimodule R E] [ring R'] [invertible (bit0 1)]
    [add_comm_group F] [semimodule R' F] (f : E → F) (h0 : f 0 = 0)
    (hm : ∀ (x y : E), f (midpoint R x y) = midpoint R' (f x) (f y)) : E →+ F :=
  mk f h0 sorry

@[simp] theorem coe_of_map_midpoint (R : Type u_1) (R' : Type u_2) {E : Type u_3} {F : Type u_4}
    [ring R] [invertible (bit0 1)] [add_comm_group E] [semimodule R E] [ring R']
    [invertible (bit0 1)] [add_comm_group F] [semimodule R' F] (f : E → F) (h0 : f 0 = 0)
    (hm : ∀ (x y : E), f (midpoint R x y) = midpoint R' (f x) (f y)) :
    ⇑(of_map_midpoint R R' f h0 hm) = f :=
  rfl

end Mathlib


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Group.limits
import algebra.category.Group.preadditive
import category_theory.limits.shapes.biproducts
import category_theory.limits.shapes.types
import algebra.group.pi

/-!
# The category of abelian groups has finite biproducts
-/

open category_theory
open category_theory.limits

open_locale big_operators

universe u

namespace AddCommGroup

/--
Construct limit data for a binary product in `AddCommGroup`, using `AddCommGroup.of (G × H)`.
-/
def binary_product_limit_cone (G H : AddCommGroup.{u}) : limits.limit_cone (pair G H) :=
{ cone :=
  { X := AddCommGroup.of (G × H),
    π := { app := λ j, walking_pair.cases_on j (add_monoid_hom.fst G H) (add_monoid_hom.snd G H) }},
  is_limit :=
  { lift := λ s, add_monoid_hom.prod (s.π.app walking_pair.left) (s.π.app walking_pair.right),
    fac' := begin rintros s (⟨⟩|⟨⟩); { ext x, simp, }, end,
    uniq' := λ s m w,
    begin
      ext; [rw ← w walking_pair.left, rw ← w walking_pair.right]; refl,
    end, } }

instance has_binary_product (G H : AddCommGroup.{u}) : has_binary_product G H :=
has_limit.mk (binary_product_limit_cone G H)

instance (G H : AddCommGroup.{u}) : has_binary_biproduct G H :=
has_binary_biproduct.of_has_binary_product _ _

/--
We verify that the biproduct in AddCommGroup is isomorphic to
the cartesian product of the underlying types:
-/
noncomputable
def biprod_iso_prod (G H : AddCommGroup.{u}) : (G ⊞ H : AddCommGroup) ≅ AddCommGroup.of (G × H) :=
is_limit.cone_point_unique_up_to_iso
  (binary_biproduct.is_limit G H)
  (binary_product_limit_cone G H).is_limit

-- Furthermore, our biproduct will automatically function as a coproduct.
example (G H : AddCommGroup.{u}) : has_colimit (pair G H) := by apply_instance

variables {J : Type u} (F : (discrete J) ⥤ AddCommGroup.{u})

namespace has_limit

/--
The map from an arbitrary cone over a indexed family of abelian groups
to the cartesian product of those groups.
-/
def lift (s : cone F) :
  s.X ⟶ AddCommGroup.of (Π j, F.obj j) :=
{ to_fun := λ x j, s.π.app j x,
  map_zero' := by { ext, simp },
  map_add' := λ x y, by { ext, simp }, }

@[simp] lemma lift_apply (s : cone F) (x : s.X) (j : J) : (lift F s) x j = s.π.app j x := rfl

/--
Construct limit data for a product in `AddCommGroup`, using `AddCommGroup.of (Π j, F.obj j)`.
-/
def product_limit_cone : limits.limit_cone F :=
{ cone :=
  { X := AddCommGroup.of (Π j, F.obj j),
    π := discrete.nat_trans (λ j, add_monoid_hom.apply (λ j, F.obj j) j), },
  is_limit :=
  { lift := lift F,
    fac' := λ s j, by { ext, simp, },
    uniq' := λ s m w,
    begin
      ext x j,
      dsimp only [has_limit.lift],
      simp only [add_monoid_hom.coe_mk],
      exact congr_arg (λ f : s.X ⟶ F.obj j, (f : s.X → F.obj j) x) (w j),
    end, }, }

end has_limit

section

open has_limit

variables [decidable_eq J] [fintype J]

instance (f : J → AddCommGroup.{u}) : has_biproduct f :=
has_biproduct.of_has_product _

/--
We verify that the biproduct we've just defined is isomorphic to the AddCommGroup structure
on the dependent function type
-/
noncomputable
def biproduct_iso_pi (f : J → AddCommGroup.{u}) :
  (⨁ f : AddCommGroup) ≅ AddCommGroup.of (Π j, f j) :=
is_limit.cone_point_unique_up_to_iso
  (biproduct.is_limit f)
  (product_limit_cone (discrete.functor f)).is_limit

end

instance : has_finite_biproducts AddCommGroup :=
⟨λ J _ _, by exactI { has_biproduct := λ f, by apply_instance }⟩

end AddCommGroup


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.basic
import Mathlib.Lean3Lib.data.stream
import Mathlib.Lean3Lib.data.lazy_list
import Mathlib.data.seq.computation
import Mathlib.PostPort

universes u u_1 v w

namespace Mathlib

/-
coinductive seq (α : Type u) : Type u
| nil : seq α
| cons : α → seq α → seq α
-/

/--
A stream `s : option α` is a sequence if `s.nth n = none` implies `s.nth (n + 1) = none`.
-/
def stream.is_seq {α : Type u} (s : stream (Option α)) :=
  ∀ {n : ℕ}, s n = none → s (n + 1) = none

/-- `seq α` is the type of possibly infinite lists (referred here as sequences).
  It is encoded as an infinite stream of options such that if `f n = none`, then
  `f m = none` for all `m ≥ n`. -/
def seq (α : Type u) :=
  Subtype fun (f : stream (Option α)) => stream.is_seq f

/-- `seq1 α` is the type of nonempty sequences. -/
def seq1 (α : Type u_1) :=
  α × seq α

namespace seq

/-- The empty sequence -/
def nil {α : Type u} : seq α :=
  { val := stream.const none, property := sorry }

protected instance inhabited {α : Type u} : Inhabited (seq α) :=
  { default := nil }

/-- Prepend an element to a sequence -/
def cons {α : Type u} (a : α) : seq α → seq α :=
  sorry

/-- Get the nth element of a sequence (if it exists) -/
def nth {α : Type u} : seq α → ℕ → Option α :=
  subtype.val

/-- A sequence has terminated at position `n` if the value at position `n` equals `none`. -/
def terminated_at {α : Type u} (s : seq α) (n : ℕ) :=
  nth s n = none

/-- It is decidable whether a sequence terminates at a given position. -/
protected instance terminated_at_decidable {α : Type u} (s : seq α) (n : ℕ) : Decidable (terminated_at s n) :=
  decidable_of_iff' ↥(option.is_none (nth s n)) sorry

/-- A sequence terminates if there is some position `n` at which it has terminated. -/
def terminates {α : Type u} (s : seq α) :=
  ∃ (n : ℕ), terminated_at s n

/-- Functorial action of the functor `option (α × _)` -/
@[simp] def omap {α : Type u} {β : Type v} {γ : Type w} (f : β → γ) : Option (α × β) → Option (α × γ) :=
  sorry

/-- Get the first element of a sequence -/
def head {α : Type u} (s : seq α) : Option α :=
  nth s 0

/-- Get the tail of a sequence (or `nil` if the sequence is `nil`) -/
def tail {α : Type u} : seq α → seq α :=
  sorry

protected def mem {α : Type u} (a : α) (s : seq α) :=
  some a ∈ subtype.val s

protected instance has_mem {α : Type u} : has_mem α (seq α) :=
  has_mem.mk seq.mem

theorem le_stable {α : Type u} (s : seq α) {m : ℕ} {n : ℕ} (h : m ≤ n) : nth s m = none → nth s n = none := sorry

/-- If a sequence terminated at position `n`, it also terminated at `m ≥ n `. -/
theorem terminated_stable {α : Type u} (s : seq α) {m : ℕ} {n : ℕ} (m_le_n : m ≤ n) (terminated_at_m : terminated_at s m) : terminated_at s n :=
  le_stable s m_le_n terminated_at_m

/--
If `s.nth n = some aₙ` for some value `aₙ`, then there is also some value `aₘ` such
that `s.nth = some aₘ` for `m ≤ n`.
-/
theorem ge_stable {α : Type u} (s : seq α) {aₙ : α} {n : ℕ} {m : ℕ} (m_le_n : m ≤ n) (s_nth_eq_some : nth s n = some aₙ) : ∃ (aₘ : α), nth s m = some aₘ := sorry

theorem not_mem_nil {α : Type u} (a : α) : ¬a ∈ nil := sorry

theorem mem_cons {α : Type u} (a : α) (s : seq α) : a ∈ cons a s :=
  subtype.cases_on s
    fun (s_val : stream (Option α)) (s_property : stream.is_seq s_val) =>
      idRhs (some a ∈ some a :: s_val) (stream.mem_cons (some a) s_val)

theorem mem_cons_of_mem {α : Type u} (y : α) {a : α} {s : seq α} : a ∈ s → a ∈ cons y s := sorry

theorem eq_or_mem_of_mem_cons {α : Type u} {a : α} {b : α} {s : seq α} : a ∈ cons b s → a = b ∨ a ∈ s := sorry

@[simp] theorem mem_cons_iff {α : Type u} {a : α} {b : α} {s : seq α} : a ∈ cons b s ↔ a = b ∨ a ∈ s := sorry

/-- Destructor for a sequence, resulting in either `none` (for `nil`) or
  `some (a, s)` (for `cons a s`). -/
def destruct {α : Type u} (s : seq α) : Option (seq1 α) :=
  (fun (a' : α) => (a', tail s)) <$> nth s 0

theorem destruct_eq_nil {α : Type u} {s : seq α} : destruct s = none → s = nil := sorry

theorem destruct_eq_cons {α : Type u} {s : seq α} {a : α} {s' : seq α} : destruct s = some (a, s') → s = cons a s' := sorry

@[simp] theorem destruct_nil {α : Type u} : destruct nil = none :=
  rfl

@[simp] theorem destruct_cons {α : Type u} (a : α) (s : seq α) : destruct (cons a s) = some (a, s) := sorry

theorem head_eq_destruct {α : Type u} (s : seq α) : head s = prod.fst <$> destruct s := sorry

@[simp] theorem head_nil {α : Type u} : head nil = none :=
  rfl

@[simp] theorem head_cons {α : Type u} (a : α) (s : seq α) : head (cons a s) = some a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (head (cons a s) = some a)) (head_eq_destruct (cons a s))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (prod.fst <$> destruct (cons a s) = some a)) (destruct_cons a s)))
      (Eq.refl (prod.fst <$> some (a, s))))

@[simp] theorem tail_nil {α : Type u} : tail nil = nil :=
  rfl

@[simp] theorem tail_cons {α : Type u} (a : α) (s : seq α) : tail (cons a s) = s := sorry

def cases_on {α : Type u} {C : seq α → Sort v} (s : seq α) (h1 : C nil) (h2 : (x : α) → (s : seq α) → C (cons x s)) : C s :=
  (fun (_x : Option (seq1 α)) (H : destruct s = _x) =>
      Option.rec (fun (H : destruct s = none) => eq.mpr sorry h1)
        (fun (v : seq1 α) (H : destruct s = some v) =>
          prod.cases_on v (fun (a : α) (s' : seq α) (H : destruct s = some (a, s')) => eq.mpr sorry (h2 a s')) H)
        _x H)
    (destruct s) sorry

theorem mem_rec_on {α : Type u} {C : seq α → Prop} {a : α} {s : seq α} (M : a ∈ s) (h1 : ∀ (b : α) (s' : seq α), a = b ∨ C s' → C (cons b s')) : C s := sorry

def corec.F {α : Type u} {β : Type v} (f : β → Option (α × β)) : Option β → Option α × Option β :=
  sorry

/-- Corecursor for `seq α` as a coinductive type. Iterates `f` to produce new elements
  of the sequence until `none` is obtained. -/
def corec {α : Type u} {β : Type v} (f : β → Option (α × β)) (b : β) : seq α :=
  { val := stream.corec' sorry (some b), property := sorry }

@[simp] theorem corec_eq {α : Type u} {β : Type v} (f : β → Option (α × β)) (b : β) : destruct (corec f b) = omap (corec f) (f b) := sorry

/-- Embed a list as a sequence -/
def of_list {α : Type u} (l : List α) : seq α :=
  { val := list.nth l, property := sorry }

protected instance coe_list {α : Type u} : has_coe (List α) (seq α) :=
  has_coe.mk of_list

@[simp] def bisim_o {α : Type u} (R : seq α → seq α → Prop) : Option (seq1 α) → Option (seq1 α) → Prop :=
  sorry

def is_bisimulation {α : Type u} (R : seq α → seq α → Prop) :=
  ∀ {s₁ s₂ : seq α}, R s₁ s₂ → bisim_o R (destruct s₁) (destruct s₂)

theorem eq_of_bisim {α : Type u} (R : seq α → seq α → Prop) (bisim : is_bisimulation R) {s₁ : seq α} {s₂ : seq α} (r : R s₁ s₂) : s₁ = s₂ := sorry

theorem coinduction {α : Type u} {s₁ : seq α} {s₂ : seq α} : head s₁ = head s₂ → (∀ (β : Type u) (fr : seq α → β), fr s₁ = fr s₂ → fr (tail s₁) = fr (tail s₂)) → s₁ = s₂ := sorry

theorem coinduction2 {α : Type u} {β : Type v} (s : seq α) (f : seq α → seq β) (g : seq α → seq β) (H : ∀ (s : seq α), bisim_o (fun (s1 s2 : seq β) => ∃ (s : seq α), s1 = f s ∧ s2 = g s) (destruct (f s)) (destruct (g s))) : f s = g s := sorry

/-- Embed an infinite stream as a sequence -/
def of_stream {α : Type u} (s : stream α) : seq α :=
  { val := stream.map some s, property := sorry }

protected instance coe_stream {α : Type u} : has_coe (stream α) (seq α) :=
  has_coe.mk of_stream

/-- Embed a `lazy_list α` as a sequence. Note that even though this
  is non-meta, it will produce infinite sequences if used with
  cyclic `lazy_list`s created by meta constructions. -/
def of_lazy_list {α : Type u} : lazy_list α → seq α :=
  corec fun (l : lazy_list α) => sorry

protected instance coe_lazy_list {α : Type u} : has_coe (lazy_list α) (seq α) :=
  has_coe.mk of_lazy_list

/-- Translate a sequence into a `lazy_list`. Since `lazy_list` and `list`
  are isomorphic as non-meta types, this function is necessarily meta. -/
/-- Translate a sequence to a list. This function will run forever if
  run on an infinite sequence. -/
/-- The sequence of natural numbers some 0, some 1, ... -/
def nats : seq ℕ :=
  ↑stream.nats

@[simp] theorem nats_nth (n : ℕ) : nth nats n = some n :=
  rfl

/-- Append two sequences. If `s₁` is infinite, then `s₁ ++ s₂ = s₁`,
  otherwise it puts `s₂` at the location of the `nil` in `s₁`. -/
def append {α : Type u} (s₁ : seq α) (s₂ : seq α) : seq α :=
  corec (fun (_x : seq α × seq α) => sorry) (s₁, s₂)

/-- Map a function over a sequence. -/
def map {α : Type u} {β : Type v} (f : α → β) : seq α → seq β :=
  sorry

/-- Flatten a sequence of sequences. (It is required that the
  sequences be nonempty to ensure productivity; in the case
  of an infinite sequence of `nil`, the first element is never
  generated.) -/
def join {α : Type u} : seq (seq1 α) → seq α :=
  corec fun (S : seq (seq1 α)) => sorry

/-- Remove the first `n` elements from the sequence. -/
@[simp] def drop {α : Type u} (s : seq α) : ℕ → seq α :=
  sorry

/-- Take the first `n` elements of the sequence (producing a list) -/
def take {α : Type u} : ℕ → seq α → List α :=
  sorry

/-- Split a sequence at `n`, producing a finite initial segment
  and an infinite tail. -/
def split_at {α : Type u} : ℕ → seq α → List α × seq α :=
  sorry

/-- Combine two sequences with a function -/
def zip_with {α : Type u} {β : Type v} {γ : Type w} (f : α → β → γ) : seq α → seq β → seq γ :=
  sorry

theorem zip_with_nth_some {α : Type u} {β : Type v} {γ : Type w} {s : seq α} {s' : seq β} {n : ℕ} {a : α} {b : β} (s_nth_eq_some : nth s n = some a) (s_nth_eq_some' : nth s' n = some b) (f : α → β → γ) : nth (zip_with f s s') n = some (f a b) := sorry

theorem zip_with_nth_none {α : Type u} {β : Type v} {γ : Type w} {s : seq α} {s' : seq β} {n : ℕ} (s_nth_eq_none : nth s n = none) (f : α → β → γ) : nth (zip_with f s s') n = none := sorry

theorem zip_with_nth_none' {α : Type u} {β : Type v} {γ : Type w} {s : seq α} {s' : seq β} {n : ℕ} (s'_nth_eq_none : nth s' n = none) (f : α → β → γ) : nth (zip_with f s s') n = none := sorry

/-- Pair two sequences into a sequence of pairs -/
def zip {α : Type u} {β : Type v} : seq α → seq β → seq (α × β) :=
  zip_with Prod.mk

/-- Separate a sequence of pairs into two sequences -/
def unzip {α : Type u} {β : Type v} (s : seq (α × β)) : seq α × seq β :=
  (map prod.fst s, map prod.snd s)

/-- Convert a sequence which is known to terminate into a list -/
def to_list {α : Type u} (s : seq α) (h : ∃ (n : ℕ), ¬↥(option.is_some (nth s n))) : List α :=
  take (nat.find h) s

/-- Convert a sequence which is known not to terminate into a stream -/
def to_stream {α : Type u} (s : seq α) (h : ∀ (n : ℕ), ↥(option.is_some (nth s n))) : stream α :=
  fun (n : ℕ) => option.get (h n)

/-- Convert a sequence into either a list or a stream depending on whether
  it is finite or infinite. (Without decidability of the infiniteness predicate,
  this is not constructively possible.) -/
def to_list_or_stream {α : Type u} (s : seq α) [Decidable (∃ (n : ℕ), ¬↥(option.is_some (nth s n)))] : List α ⊕ stream α :=
  dite (∃ (n : ℕ), ¬↥(option.is_some (nth s n)))
    (fun (h : ∃ (n : ℕ), ¬↥(option.is_some (nth s n))) => sum.inl (to_list s h))
    fun (h : ¬∃ (n : ℕ), ¬↥(option.is_some (nth s n))) => sum.inr (to_stream s sorry)

@[simp] theorem nil_append {α : Type u} (s : seq α) : append nil s = s := sorry

@[simp] theorem cons_append {α : Type u} (a : α) (s : seq α) (t : seq α) : append (cons a s) t = cons a (append s t) := sorry

@[simp] theorem append_nil {α : Type u} (s : seq α) : append s nil = s := sorry

@[simp] theorem append_assoc {α : Type u} (s : seq α) (t : seq α) (u : seq α) : append (append s t) u = append s (append t u) := sorry

@[simp] theorem map_nil {α : Type u} {β : Type v} (f : α → β) : map f nil = nil :=
  rfl

@[simp] theorem map_cons {α : Type u} {β : Type v} (f : α → β) (a : α) (s : seq α) : map f (cons a s) = cons (f a) (map f s) := sorry

@[simp] theorem map_id {α : Type u} (s : seq α) : map id s = s := sorry

@[simp] theorem map_tail {α : Type u} {β : Type v} (f : α → β) (s : seq α) : map f (tail s) = tail (map f s) := sorry

theorem map_comp {α : Type u} {β : Type v} {γ : Type w} (f : α → β) (g : β → γ) (s : seq α) : map (g ∘ f) s = map g (map f s) := sorry

@[simp] theorem map_append {α : Type u} {β : Type v} (f : α → β) (s : seq α) (t : seq α) : map f (append s t) = append (map f s) (map f t) := sorry

@[simp] theorem map_nth {α : Type u} {β : Type v} (f : α → β) (s : seq α) (n : ℕ) : nth (map f s) n = option.map f (nth s n) := sorry

protected instance functor : Functor seq :=
  { map := map, mapConst := fun (α β : Type u_1) => map ∘ function.const β }

protected instance is_lawful_functor : is_lawful_functor seq :=
  is_lawful_functor.mk map_id map_comp

@[simp] theorem join_nil {α : Type u} : join nil = nil :=
  destruct_eq_nil rfl

@[simp] theorem join_cons_nil {α : Type u} (a : α) (S : seq (seq1 α)) : join (cons (a, nil) S) = cons a (join S) := sorry

@[simp] theorem join_cons_cons {α : Type u} (a : α) (b : α) (s : seq α) (S : seq (seq1 α)) : join (cons (a, cons b s) S) = cons a (join (cons (b, s) S)) := sorry

@[simp] theorem join_cons {α : Type u} (a : α) (s : seq α) (S : seq (seq1 α)) : join (cons (a, s) S) = cons a (append s (join S)) := sorry

@[simp] theorem join_append {α : Type u} (S : seq (seq1 α)) (T : seq (seq1 α)) : join (append S T) = append (join S) (join T) := sorry

@[simp] theorem of_list_nil {α : Type u} : of_list [] = nil :=
  rfl

@[simp] theorem of_list_cons {α : Type u} (a : α) (l : List α) : of_list (a :: l) = cons a (of_list l) := sorry

@[simp] theorem of_stream_cons {α : Type u} (a : α) (s : stream α) : of_stream (a :: s) = cons a (of_stream s) := sorry

@[simp] theorem of_list_append {α : Type u} (l : List α) (l' : List α) : of_list (l ++ l') = append (of_list l) (of_list l') := sorry

@[simp] theorem of_stream_append {α : Type u} (l : List α) (s : stream α) : of_stream (l++ₛs) = append (of_list l) (of_stream s) := sorry

/-- Convert a sequence into a list, embedded in a computation to allow for
  the possibility of infinite sequences (in which case the computation
  never returns anything). -/
def to_list' {α : Type u_1} (s : seq α) : computation (List α) :=
  computation.corec (fun (_x : List α × seq α) => sorry) ([], s)

theorem dropn_add {α : Type u} (s : seq α) (m : ℕ) (n : ℕ) : drop s (m + n) = drop (drop s m) n := sorry

theorem dropn_tail {α : Type u} (s : seq α) (n : ℕ) : drop (tail s) n = drop s (n + 1) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (drop (tail s) n = drop s (n + 1))) (add_comm n 1))) (Eq.symm (dropn_add s 1 n))

theorem nth_tail {α : Type u} (s : seq α) (n : ℕ) : nth (tail s) n = nth s (n + 1) := sorry

protected theorem ext {α : Type u} (s : seq α) (s' : seq α) (hyp : ∀ (n : ℕ), nth s n = nth s' n) : s = s' := sorry

@[simp] theorem head_dropn {α : Type u} (s : seq α) (n : ℕ) : head (drop s n) = nth s n := sorry

theorem mem_map {α : Type u} {β : Type v} (f : α → β) {a : α} {s : seq α} : a ∈ s → f a ∈ map f s := sorry

theorem exists_of_mem_map {α : Type u} {β : Type v} {f : α → β} {b : β} {s : seq α} : b ∈ map f s → ∃ (a : α), a ∈ s ∧ f a = b := sorry

theorem of_mem_append {α : Type u} {s₁ : seq α} {s₂ : seq α} {a : α} (h : a ∈ append s₁ s₂) : a ∈ s₁ ∨ a ∈ s₂ := sorry

theorem mem_append_left {α : Type u} {s₁ : seq α} {s₂ : seq α} {a : α} (h : a ∈ s₁) : a ∈ append s₁ s₂ := sorry

end seq

namespace seq1

/-- Convert a `seq1` to a sequence. -/
def to_seq {α : Type u} : seq1 α → seq α :=
  sorry

protected instance coe_seq {α : Type u} : has_coe (seq1 α) (seq α) :=
  has_coe.mk to_seq

/-- Map a function on a `seq1` -/
def map {α : Type u} {β : Type v} (f : α → β) : seq1 α → seq1 β :=
  sorry

theorem map_id {α : Type u} (s : seq1 α) : map id s = s := sorry

/-- Flatten a nonempty sequence of nonempty sequences -/
def join {α : Type u} : seq1 (seq1 α) → seq1 α :=
  sorry

@[simp] theorem join_nil {α : Type u} (a : α) (S : seq (seq1 α)) : join ((a, seq.nil), S) = (a, seq.join S) :=
  rfl

@[simp] theorem join_cons {α : Type u} (a : α) (b : α) (s : seq α) (S : seq (seq1 α)) : join ((a, seq.cons b s), S) = (a, seq.join (seq.cons (b, s) S)) := sorry

/-- The `return` operator for the `seq1` monad,
  which produces a singleton sequence. -/
def ret {α : Type u} (a : α) : seq1 α :=
  (a, seq.nil)

protected instance inhabited {α : Type u} [Inhabited α] : Inhabited (seq1 α) :=
  { default := ret Inhabited.default }

/-- The `bind` operator for the `seq1` monad,
  which maps `f` on each element of `s` and appends the results together.
  (Not all of `s` may be evaluated, because the first few elements of `s`
  may already produce an infinite result.) -/
def bind {α : Type u} {β : Type v} (s : seq1 α) (f : α → seq1 β) : seq1 β :=
  join (map f s)

@[simp] theorem join_map_ret {α : Type u} (s : seq α) : seq.join (seq.map ret s) = s := sorry

@[simp] theorem bind_ret {α : Type u} {β : Type v} (f : α → β) (s : seq1 α) : bind s (ret ∘ f) = map f s := sorry

@[simp] theorem ret_bind {α : Type u} {β : Type v} (a : α) (f : α → seq1 β) : bind (ret a) f = f a := sorry

@[simp] theorem map_join' {α : Type u} {β : Type v} (f : α → β) (S : seq (seq1 α)) : seq.map f (seq.join S) = seq.join (seq.map (map f) S) := sorry

@[simp] theorem map_join {α : Type u} {β : Type v} (f : α → β) (S : seq1 (seq1 α)) : map f (join S) = join (map (map f) S) := sorry

@[simp] theorem join_join {α : Type u} (SS : seq (seq1 (seq1 α))) : seq.join (seq.join SS) = seq.join (seq.map join SS) := sorry

@[simp] theorem bind_assoc {α : Type u} {β : Type v} {γ : Type w} (s : seq1 α) (f : α → seq1 β) (g : β → seq1 γ) : bind (bind s f) g = bind s fun (x : α) => bind (f x) g := sorry

protected instance monad : Monad seq1 :=
  { toApplicative :=
      { toFunctor := { map := map, mapConst := fun (α β : Type u_1) => map ∘ function.const β },
        toPure := { pure := ret },
        toSeq := { seq := fun (α β : Type u_1) (f : seq1 (α → β)) (x : seq1 α) => bind f fun (_x : α → β) => map _x x },
        toSeqLeft :=
          { seqLeft :=
              fun (α β : Type u_1) (a : seq1 α) (b : seq1 β) =>
                (fun (α β : Type u_1) (f : seq1 (α → β)) (x : seq1 α) => bind f fun (_x : α → β) => map _x x) β α
                  (map (function.const β) a) b },
        toSeqRight :=
          { seqRight :=
              fun (α β : Type u_1) (a : seq1 α) (b : seq1 β) =>
                (fun (α β : Type u_1) (f : seq1 (α → β)) (x : seq1 α) => bind f fun (_x : α → β) => map _x x) β β
                  (map (function.const α id) a) b } },
    toBind := { bind := bind } }

protected instance is_lawful_monad : is_lawful_monad seq1 :=
  is_lawful_monad.mk ret_bind bind_assoc


/-
Copyright 2022 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    https://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

Authors: Moritz Firsching, Nick Kuhn
-/
import tactic
import data.set.basic
import data.fintype.card
import ring_theory.integral_domain
import ring_theory.subring.basic
import ring_theory.polynomial.cyclotomic.basic
import data.polynomial.ring_division
import algebra.group.conj
import linear_algebra.finite_dimensional
import linear_algebra.basis
import data.polynomial.basic
import data.complex.basic

open finset subring polynomial complex
open_locale big_operators nat polynomial
/-!
# Every finite division ring is a field

This is a TODO in `ring_theory.integral_domain`.
## TODO
  - statement
    - proof
      - Roots of unity
-/

--Define cyclotomic polynomials and check their basic properties

-- TODO: find the appropriate lemmas for use in the end of the proof...
example (i j : ℕ) (gj: 0 ≠ j) (h: i ∣ j): i ≤ j:=
begin
  dsimp [has_dvd.dvd] at h,
  cases h with c h₀,
  cases em (c = 0) with hc,
  { by_contradiction,
    rw hc at h₀,
    simp only [mul_zero] at h₀,
    exact gj (eq.symm h₀), },
  { calc
      i ≤ i*c : le_mul_of_le_of_one_le rfl.ge (zero_lt_iff.mpr h)
    ... = j: (eq.symm h₀),},
end

lemma le_abs_of_dvd {i j : ℤ} (gj: 0 ≠ j) (h: i ∣ j) : |i| ≤ |j| :=
begin
  dsimp [has_dvd.dvd] at h,
  cases h with c h₀,
  cases em (c = 0) with hc,
  { by_contradiction,
    rw hc at h₀,
    simp only [mul_zero] at h₀,
    exact gj (eq.symm h₀), },
  { calc
      |i| ≤ |i|*|c| :
        le_mul_of_le_of_one_le' rfl.ge (int.one_le_abs h) (abs_nonneg c) (abs_nonneg i)
      ... = |i*c| : eq.symm (abs_mul i c)
      ... = |j| : by { rw eq.symm h₀,}, },
end

noncomputable def phi (n : ℕ) : ℤ[X] := cyclotomic n ℤ

lemma phi_dvd (n : ℕ) : phi n ∣ X ^ n - 1 :=
begin
  rw phi,
  exact cyclotomic.dvd_X_pow_sub_one n ℤ,
end

lemma phi_div_2 (n : ℕ) (k : ℕ) (h₁ : 1 ≠ k) (h₂ : k ∣ n) (h₃ : k < n) :
  (X ^ k - 1) * (phi n)∣ (X ^ n - 1) :=
begin
  have h_proper_div : k ∈ n.proper_divisors := nat.mem_proper_divisors.mpr ⟨h₂, h₃⟩,
  exact X_pow_sub_one_mul_cyclotomic_dvd_X_pow_sub_one_of_dvd ℤ h_proper_div,
end

section wedderburn

variables {R : Type*}  [decidable_eq R] [division_ring R]

noncomputable theorem wedderburn (h: fintype R): is_field R :=
begin
  let Z := center R,
  haveI : fintype R := h,

  obtain ⟨n, h_card⟩ := vector_space.card_fintype Z R,
  have h_n : n ≠ 0 := by sorry,

  set q := fintype.card Z,

  --conjugacy classes with more than one element
  -- indexed from 1 to t in the book, here we use "S".
  let S := {A : conj_classes Rˣ | fintype.card A.carrier > 1}.to_finset,
  let n_k :conj_classes Rˣ → ℕ := λ A, fintype.card
    (set.centralizer ({(quotient.out' (A : conj_classes Rˣ))} : set Rˣ)),

  --class  formula (1)
  suffices : (q : ℤ) ^ n - 1 = q - 1  + ∑ A in S, (q ^ n - 1) / (q ^ (n_k A) - 1), by

  { have h_n_k_A_dvd: ∀ A : conj_classes Rˣ, (n_k A ∣ n) := sorry,

  --rest of proof
  have h_phi_dvd_q_sub_one : (phi n).eval q ∣ (q - 1) := by
  { have h₁_dvd : (phi n).eval q ∣ (X ^ n - 1).eval q  := by
    { refine eval_dvd _,
      exact phi_dvd n, },
    have h₂_dvd :
     (phi n).eval(q) ∣ ∑ A in S, (q ^ n - 1) / (q ^ (n_k A) - 1) := by
     { refine finset.dvd_sum _,
      intro A,
      intro hs,
      apply(int.dvd_div_of_mul_dvd _),
      have h_one_neq: 1 ≠ (n_k A) := by sorry,
      have h_k_n_lt_n: n_k A < n := by sorry,
      have h_noneval := phi_div_2 n (n_k A) h_one_neq (h_n_k_A_dvd A) h_k_n_lt_n,
      have := @eval_dvd ℤ _ _ _ q h_noneval,
      simp at this,
      exact this, },
    simp only [eval_sub, eval_pow, eval_X, eval_one] at h₁_dvd,
    rw this at h₁_dvd,
    refine (dvd_add_iff_left h₂_dvd).mpr h₁_dvd, },
  by_contradiction,

  have g : map (int.cast_ring_hom ℂ) (phi n) = ∏ lamb in (primitive_roots n ℂ), (X - C lamb) := by
  { dsimp [phi],
    simp [int_cyclotomic_spec n],
    dsimp [cyclotomic'],
    refl, },
  have h_lamb_gt_q_sub_one : ∀ (lamb : ℂ),
    lamb ∈ (primitive_roots n ℂ) → abs ((X - C lamb).eval (q : ℂ)) > q - 1 := by
    { intro lamb,
      let a := real_part lamb,
      let b := imaginary_part lamb,
      have h_lamb: lamb ≠ 1 := by sorry,
      have h_a_lt_one: ‖a‖ < 1 := by sorry,
      have h_ineq :=
        calc  (abs ((X - C lamb).eval (q : ℂ)))^2 = (abs ((q : ℂ) - lamb))^2 :
          by simp only [eval_sub, eval_X, eval_C]
        ... = (abs ((q : ℂ) - a - I*b))^2 : by sorry
        ... = (abs ((q : ℂ) - a))^2 + ‖b‖^2 : by sorry
        ... = q^2 - 2*‖a‖*q + ‖a‖^2 + ‖b‖^2 : by sorry
        ... > q^2 - 2*q + 1 : by sorry
        ... = (q - 1)^2 : by sorry,
      sorry, },
  have h_gt: |(phi n).eval q| > q - 1 := by
  { sorry, },
  have h_q_sub_one : 0 ≠ (q : ℤ) - 1 := by { sorry, },
  have h_q : |((q : ℤ) - 1)| = q - 1 := by { sorry, },
  have h_norm := le_abs_of_dvd h_q_sub_one h_phi_dvd_q_sub_one,
  rw h_q at h_norm,
  exact not_le_of_gt h_gt h_norm, },
  { --proof of class  formula
  sorry, },
end

end wedderburn


import algebra.camera.basic

inductive frac
| mk (a : ℚ) : 0 < a → a ≤ 1 → frac
| bot : frac

namespace frac

instance : ofe frac := {
  eq_at := λ _, (=),
  eq_at_reflexive := λ _, eq_equivalence.1,
  eq_at_symmetric := λ _, eq_equivalence.2.1,
  eq_at_transitive := λ _, eq_equivalence.2.2,
  eq_at_mono' := λ n m hmn a b h, h,
  eq_at_limit' := λ a b h, h 0,
}

@[simp] lemma eq_at_iff (n : ℕ) (a b : frac) : a =[n] b ↔ a = b := iff.rfl

def mul : frac → frac → frac
| (mk a ha _) (mk b hb _) :=
  if h : a + b ≤ 1 then mk (a + b) (add_pos ha hb) h else bot
| _ _ := bot

instance : comm_semigroup frac := {
  mul := mul,
  mul_assoc := begin
    rintros (⟨a, ha₁, ha₂⟩ | _) (⟨b, hb₁, hb₂⟩ | _) (⟨c, hc₁, hc₂⟩ | _);
    try { refl },
    { simp only [mul],
      split_ifs with h₁ h₂ h₂,
      simp only [mul],
      split_ifs with h₃ h₄ h₄,
      rw add_assoc,
      rw add_assoc at h₃, cases h₄ h₃,
      rw add_assoc at h₃, cases h₃ h₄,
      refl,
      simp only [mul], rw dif_neg, linarith,
      simp only [mul], rw dif_neg, linarith,
      refl, },
    { simp only [mul], split_ifs; refl, },
  end,
  mul_comm := begin
    rintros (⟨a, ha₁, ha₂⟩ | _) (⟨b, hb₁, hb₂⟩ | _); try { refl },
    simp only [has_mul.mul, mul],
    split_ifs with h₁ h₂ h₂,
    rw add_comm,
    rw add_comm at h₁, cases h₂ h₁,
    rw add_comm at h₁, cases h₁ h₂,
    refl,
  end,
}

lemma mk_mul_mk {a b : ℚ} (ha₁ : 0 < a) (ha₂ : a ≤ 1) (hb₁ : 0 < b) (hb₂ : b ≤ 1) :
  (mk a ha₁ ha₂) * (mk b hb₁ hb₂) =
    if h : a + b ≤ 1 then mk (a + b) (add_pos ha₁ hb₁) h else bot := rfl

def core : frac → option frac
| (mk a _ _) := none
| bot := some bot

instance : camera frac := {
  validn := ⟨λ a, sprop.const (a ≠ bot),
    by intros n a b h m hmn; rw frac.eq_at_iff at h; rw h⟩,
  core := ⟨core, λ n a b h, by cases h; refl⟩,
  extend := λ n a b₁ b₂ h₁ h₂, ⟨b₁, b₂⟩,
  mul_is_nonexpansive := begin
    rintros n a b ⟨h₁, h₂⟩,
    rw eq_at_iff at h₁ h₂ ⊢,
    rw prod.ext h₁ h₂,
  end,
  core_mul_self := λ a ca h, by cases a; cases h; refl,
  core_core := λ a ca h, by cases a; cases h; refl,
  core_mono_some := λ a b ca h₁ h₂, by cases a; cases h₁; cases h₂.some_spec; exact ⟨bot, rfl⟩,
  core_mono := λ a b ca h₁ h₂, by cases a; cases h₁; cases h₂.some_spec; exact ⟨some bot, rfl⟩,
  validn_mul := λ a b n h, by cases a; trivial,
  extend_mul_eq := λ n a b₁ b₂ h₁ h₂, h₂,
  extend_eq_at_left := λ n a b₁ b₂ h₁ h₂, by refl,
  extend_eq_at_right := λ n a b₁ b₂ h₁ h₂, by refl,
  ..frac.ofe,
  ..frac.comm_semigroup,
}

end frac


import tactic.push_neg
import basic_definitions.kernel_range
import basic_definitions.equiv
import basic_definitions.sub_module
import Reynold_operator.reynold
open Kernel range morphism
open stability open submodule linear_map
universe variables u v w w'

namespace morphism.from_irreductible
open  linear_map
variables {G : Type u} [group G] {R : Type v}[ring R]
variables {M1 : Type w}  [add_comm_group M1] [module R M1]
          {M2 : Type w'} [add_comm_group M2] [module R M2]
          { ρ1 : group_representation G R M1}
          {ρ2 : group_representation G R M2}
          (f : ρ1 ⟶ᵣ ρ2)

/--
    let `f : ρ1 ⟶ᵣ ρ2` with `Irreductible ρ1` : `ker f is trivial`.
-/
theorem ker_is_trivial  [Irreductible ρ1]  : (is_trivial (ker f.ℓ )) := Trivial ρ1 (ker f.ℓ)

/--
    Let `f : ρ1 ⟶ᵣ ρ2` with `Irreductible ρ2` then `is_trivial range f`
-/
theorem range_is_trivial [Irreductible ρ2]  :  is_trivial (range f.ℓ ) := Trivial ρ2 (range f.ℓ)

/--
     For  `f : ρ1 ⟶ᵣ ρ2`  with  `Irreductible ρ1` and `Irreductible ρ2`
     if `(∃ x : M1, (f.ℓ  x ≠ 0))` then   `(ker f.ℓ  = ⊥ ) ∧  range f.ℓ  = ⊤`
     so `f` is an `equivalence`
-/
theorem Schur₁ [Irreductible ρ1] [Irreductible ρ2] : (∃ x : M1, (f.ℓ  x ≠ 0)) →
(ker f.ℓ  = ⊥ ) ∧  range f.ℓ  = ⊤ :=
begin
    intros hyp_not_nul,
    rcases hyp_not_nul with ⟨x,hyp_not_nul⟩,
    split,
    {
        rcases Trivial ρ1 (ker f.ℓ ),swap,assumption,
        have : f.ℓ  x = 0,
            rw ←  mem_ker, rw h, trivial,
        trivial,
        },
    {
        rcases Trivial ρ2 ( range f.ℓ ),
        assumption,
        have  : f.ℓ x ∈ range (f.ℓ ),
            rw mem_range, use x,
        rw h at this, rw  mem_bot at this,
        trivial,
        },

end
end morphism.from_irreductible

namespace shur₁_comm_ring
open  morphism.from_irreductible equiv_morphism

open_locale classical

variables {G : Type u} [group G] {R : Type v}[comm_ring R]{M : Type w}[add_comm_group M] [module R M]
variables  {ρ : group_representation G R M}  {M2 : Type w'} [add_comm_group M2] [module R M2]

variables  {ρ' : group_representation G R  M2}
theorem morphism_are_zero (F : not_isomorphic ρ ρ')[Irreductible ρ ][Irreductible ρ'] : ∀ f : ρ ⟶ᵣ ρ', f = 0
:=
begin
    by_contradiction,
    push_neg at a,rcases a with ⟨ φ, hyp ⟩,
    have : ∃ x, φ x ≠  0,
        simp, by_contradiction, push_neg at a, have : φ = 0, apply morphism.ext,
        apply linear_map.ext, exact a, trivial,
    exact F (ker_im_equiv φ $ Schur₁ φ this),
end
open Reynold
variables [fintype G]

/--
    `F : not_isomorphic ρ ρ'  Irreductible ρ   Irreductible ρ'`
     The Reynold operator `Re ρ ρ'` is always zero.
-/
theorem Reynold_is_zero (F : not_isomorphic ρ ρ')[Irreductible ρ ][Irreductible ρ']:    Re ρ ρ' = 0 :=
begin
    apply linear_map.ext,
    intros f,
    apply morphism_are_zero F,
end
end shur₁_comm_ring

namespace Schur₂
open  morphism.from_irreductible equiv_morphism

open_locale classical
variables {G : Type u} [group G] {R : Type v}[comm_ring R]{M : Type w}[add_comm_group M] [module R M]
variables  {ρ : group_representation G R M}
theorem Schur₂(f : ρ ⟶ᵣ ρ) [Irreductible ρ](r : R)(m0 : M) :
         (m0 ≠ 0 ∧  f.ℓ m0 + r • m0 = 0) → (∀ m : M, f.ℓ m + r • m = 0) :=
begin
    rintros ⟨spec,spectral⟩,
    let g :=  f + r • 𝟙 ρ,
    have  certif_contra :   m0 ∈ ker g.ℓ ,
        rw mem_ker,  exact spectral,
    by_contra,
    push_neg at a,
    rcases a with ⟨ζ,hyp ⟩, change (g.ℓ ) ζ  ≠ 0 at hyp,
    let schur := (Schur₁ g) ⟨ζ, hyp⟩,
    rw [schur.1, mem_bot] at certif_contra, trivial,
end
end Schur₂

namespace Sche
variables {G : Type u} [group G] {R : Type v}[comm_ring R]{M : Type w}[add_comm_group M] [module R M]
variables  {ρ : group_representation G R M}
open  morphism.from_irreductible

theorem Schur₂1(f : ρ ⟶ᵣ ρ) [Irreductible ρ](r : R)(m0 : M) :
         (m0 ≠ 0 ∧  f.ℓ m0 + r • m0 = 0) → (∃ m : M, f.ℓ m + r • m ≠  0) → 0  = 1 :=
begin
    rintros ⟨spec,spectral⟩,
    rintros ⟨ζ ,hyp⟩,
    let g :=  f + r • 𝟙 ρ,
    have  certif_contra :   m0 ∈ ker g.ℓ ,
        rw mem_ker,  exact spectral,
    let schur := (Schur₁ g) ⟨ζ, hyp⟩,
    rw [schur.1, mem_bot] at  certif_contra, trivial,
    end
end Sche


import metaphysics.finitism
open set topological_space classical
set_option pp.generalized_field_notation true
local attribute [instance] prop_decidable
noncomputable theory

namespace ontology

-- WORK IN PROGRESS. WAS TRYING TO PROVE CONSISTENCY OF VIRTUAL FINITISM.
-- IT TURNS OUT TO BE INCONSISTENT. STILL CONCEPTS HERE MAY BE INTERESTING
-- IN THE FUTURE. SO FAR THEY DESCRIBE AN ONTOLOGICAL INTERPRETATION OF THE NATURAL NUMBERS.

namespace instances

  instance platonic_chain : topological_space ℕ := alexandroff₀_of infer_instance
  instance platonic_pyramid (layout : ℕ → ℕ := id) : topological_space (Σ n : ℕ, fin (layout n)) := sorry

  def Platonic_Chain : ontology :=
    { world := ℕ, t := instances.platonic_chain}

namespace Platonic_Chain
  def least : Platonic_Chain.entity → ℕ :=
    λ e, nat.find e.possible

  set_option pp.proofs true
  lemma entity_id : ∀ e : Platonic_Chain.entity, {k | nat.find e.possible ≤ k} = e.exists :=
    let upper := @upper₀ ℕ _ in
    begin
      intro e,
      ext n, constructor; intro h,
        simp at h,
        have c := e.existential,
        change (upper e.exists) at c,
        simp [upper, upper₀] at c,
        specialize c (nat.find e.possible) n,
        apply c h, clear c,
        exact nat.find_spec e.possible,
      apply nat.find_min'; assumption,
    end

  lemma least_inj : ∀ (n : ℕ), inj_on Platonic_Chain.least {e : Platonic_Chain.entity | e.exists n} :=
    begin
      intro n,
      simp [inj_on, least],
      intros x y h₁ h₂ h₃,
      rw ←(entity_id x),
      rw ←(entity_id y),
      rw h₃,
    end

  set_option pp.proofs false
  theorem ultrafin : Platonic_Chain.ultrafin :=
    begin
      simp [ultrafin, nbe, ext_iff, lsfinite],
      intro n, change (ℕ) at n,
      apply finite_of_finite_image (Platonic_Chain.least_inj n),
      suffices c : least '' {e : Platonic_Chain.entity | e.exists n} = {i | i ≤ n},
        rw c, exact finite_le_nat n,
      simp [least, image, ext_iff],
      intro m; constructor; intro h,
        obtain ⟨e, he₁, he₂⟩ := h,
        have c := nat.find_min' e.possible he₁,
        rwa he₂ at c,
      let e : Platonic_Chain.entity,
        refine ⟨{k  : ℕ| m ≤ k}, _, ⟨m, _⟩⟩, swap,
          change (m ≤ m), exact nat.le_refl m,
        change (upper₀ {k : ℕ | m ≤ k}),
        simp [upper₀],
        intros x y h₁ h₂,
        exact le_trans h₂ h₁,
      refine ⟨e, by simpa [e], _⟩,
      apply le_antisymm,
        apply @nat.find_min' {k : ℕ | m ≤ k} _ e.possible m,
        change (m ≤ m), exact nat.le_refl m,
      exact nat.find_spec e.possible,
    end

end Platonic_Chain

end instances

end ontology