/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.disjointed
import Mathlib.data.set.countable
import Mathlib.data.indicator_function
import Mathlib.data.equiv.encodable.lattice
import Mathlib.data.tprod
import Mathlib.order.filter.lift
import Mathlib.PostPort

universes u_7 l u_1 u_2 u_3 u_6 u_4 u_8 u_5

namespace Mathlib

/-!
# Measurable spaces and measurable functions

This file defines measurable spaces and the functions and isomorphisms
between them.

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

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

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

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

## Main statements

The main theorem of this file is Dynkin's π-λ theorem, which appears
here as an induction principle `induction_on_inter`. Suppose `s` is a
collection of subsets of `α` such that the intersection of two members
of `s` belongs to `s` whenever it is nonempty. Let `m` be the σ-algebra
generated by `s`. In order to check that a predicate `C` holds on every
member of `m`, it suffices to check that `C` holds on the members of `s` and
that `C` is preserved by complementation and *disjoint* countable
unions.

## Notation

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

## Implementation notes

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

## References

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

## Tags

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

/-- A measurable space is a space equipped with a σ-algebra. -/
class measurable_space (α : Type u_7)
where
  is_measurable' : set α → Prop
  is_measurable_empty : is_measurable' ∅
  is_measurable_compl : ∀ (s : set α), is_measurable' s → is_measurable' (sᶜ)
  is_measurable_Union : ∀ (f : ℕ → set α), (∀ (i : ℕ), is_measurable' (f i)) → is_measurable' (set.Union fun (i : ℕ) => f i)

protected instance order_dual.measurable_space {α : Type u_1} [h : measurable_space α] : measurable_space (order_dual α) :=
  h

/-- `is_measurable s` means that `s` is measurable (in the ambient measure space on `α`) -/
def is_measurable {α : Type u_1} [measurable_space α] : set α → Prop :=
  measurable_space.is_measurable' _inst_1

@[simp] theorem is_measurable.empty {α : Type u_1} [measurable_space α] : is_measurable ∅ :=
  measurable_space.is_measurable_empty _inst_1

theorem is_measurable.compl {α : Type u_1} {s : set α} [measurable_space α] : is_measurable s → is_measurable (sᶜ) :=
  measurable_space.is_measurable_compl _inst_1 s

theorem is_measurable.of_compl {α : Type u_1} {s : set α} [measurable_space α] (h : is_measurable (sᶜ)) : is_measurable s :=
  compl_compl s ▸ is_measurable.compl h

@[simp] theorem is_measurable.compl_iff {α : Type u_1} {s : set α} [measurable_space α] : is_measurable (sᶜ) ↔ is_measurable s :=
  { mp := is_measurable.of_compl, mpr := is_measurable.compl }

@[simp] theorem is_measurable.univ {α : Type u_1} [measurable_space α] : is_measurable set.univ :=
  eq.mpr (id (Eq.refl (is_measurable set.univ)))
    (eq.mp ((fun (ᾰ ᾰ_1 : set α) (e_2 : ᾰ = ᾰ_1) => congr_arg is_measurable e_2) (∅ᶜ) set.univ set.compl_empty)
      (is_measurable.compl is_measurable.empty))

theorem subsingleton.is_measurable {α : Type u_1} [measurable_space α] [subsingleton α] {s : set α} : is_measurable s :=
  subsingleton.set_cases is_measurable.empty is_measurable.univ s

theorem is_measurable.congr {α : Type u_1} [measurable_space α] {s : set α} {t : set α} (hs : is_measurable s) (h : s = t) : is_measurable t :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_measurable t)) (Eq.symm h))) hs

theorem is_measurable.bUnion_decode2 {α : Type u_1} {β : Type u_2} [measurable_space α] [encodable β] {f : β → set α} (h : ∀ (b : β), is_measurable (f b)) (n : ℕ) : is_measurable (set.Union fun (b : β) => set.Union fun (H : b ∈ encodable.decode2 β n) => f b) :=
  encodable.Union_decode2_cases is_measurable.empty h

theorem is_measurable.Union {α : Type u_1} {β : Type u_2} [measurable_space α] [encodable β] {f : β → set α} (h : ∀ (b : β), is_measurable (f b)) : is_measurable (set.Union fun (b : β) => f b) := sorry

theorem is_measurable.bUnion {α : Type u_1} {β : Type u_2} [measurable_space α] {f : β → set α} {s : set β} (hs : set.countable s) (h : ∀ (b : β), b ∈ s → is_measurable (f b)) : is_measurable (set.Union fun (b : β) => set.Union fun (H : b ∈ s) => f b) := sorry

theorem set.finite.is_measurable_bUnion {α : Type u_1} {β : Type u_2} [measurable_space α] {f : β → set α} {s : set β} (hs : set.finite s) (h : ∀ (b : β), b ∈ s → is_measurable (f b)) : is_measurable (set.Union fun (b : β) => set.Union fun (H : b ∈ s) => f b) :=
  is_measurable.bUnion (set.finite.countable hs) h

theorem finset.is_measurable_bUnion {α : Type u_1} {β : Type u_2} [measurable_space α] {f : β → set α} (s : finset β) (h : ∀ (b : β), b ∈ s → is_measurable (f b)) : is_measurable (set.Union fun (b : β) => set.Union fun (H : b ∈ s) => f b) :=
  set.finite.is_measurable_bUnion (finset.finite_to_set s) h

theorem is_measurable.sUnion {α : Type u_1} [measurable_space α] {s : set (set α)} (hs : set.countable s) (h : ∀ (t : set α), t ∈ s → is_measurable t) : is_measurable (⋃₀s) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_measurable (⋃₀s))) set.sUnion_eq_bUnion)) (is_measurable.bUnion hs h)

theorem set.finite.is_measurable_sUnion {α : Type u_1} [measurable_space α] {s : set (set α)} (hs : set.finite s) (h : ∀ (t : set α), t ∈ s → is_measurable t) : is_measurable (⋃₀s) :=
  is_measurable.sUnion (set.finite.countable hs) h

theorem is_measurable.Union_Prop {α : Type u_1} [measurable_space α] {p : Prop} {f : p → set α} (hf : ∀ (b : p), is_measurable (f b)) : is_measurable (set.Union fun (b : p) => f b) := sorry

theorem is_measurable.Inter {α : Type u_1} {β : Type u_2} [measurable_space α] [encodable β] {f : β → set α} (h : ∀ (b : β), is_measurable (f b)) : is_measurable (set.Inter fun (b : β) => f b) := sorry

theorem is_measurable.Union_fintype {α : Type u_1} {β : Type u_2} [measurable_space α] [fintype β] {f : β → set α} (h : ∀ (b : β), is_measurable (f b)) : is_measurable (set.Union fun (b : β) => f b) :=
  is_measurable.Union h

theorem is_measurable.Inter_fintype {α : Type u_1} {β : Type u_2} [measurable_space α] [fintype β] {f : β → set α} (h : ∀ (b : β), is_measurable (f b)) : is_measurable (set.Inter fun (b : β) => f b) :=
  is_measurable.Inter h

theorem is_measurable.bInter {α : Type u_1} {β : Type u_2} [measurable_space α] {f : β → set α} {s : set β} (hs : set.countable s) (h : ∀ (b : β), b ∈ s → is_measurable (f b)) : is_measurable (set.Inter fun (b : β) => set.Inter fun (H : b ∈ s) => f b) := sorry

theorem set.finite.is_measurable_bInter {α : Type u_1} {β : Type u_2} [measurable_space α] {f : β → set α} {s : set β} (hs : set.finite s) (h : ∀ (b : β), b ∈ s → is_measurable (f b)) : is_measurable (set.Inter fun (b : β) => set.Inter fun (H : b ∈ s) => f b) :=
  is_measurable.bInter (set.finite.countable hs) h

theorem finset.is_measurable_bInter {α : Type u_1} {β : Type u_2} [measurable_space α] {f : β → set α} (s : finset β) (h : ∀ (b : β), b ∈ s → is_measurable (f b)) : is_measurable (set.Inter fun (b : β) => set.Inter fun (H : b ∈ s) => f b) :=
  set.finite.is_measurable_bInter (finset.finite_to_set s) h

theorem is_measurable.sInter {α : Type u_1} [measurable_space α] {s : set (set α)} (hs : set.countable s) (h : ∀ (t : set α), t ∈ s → is_measurable t) : is_measurable (⋂₀s) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_measurable (⋂₀s))) set.sInter_eq_bInter)) (is_measurable.bInter hs h)

theorem set.finite.is_measurable_sInter {α : Type u_1} [measurable_space α] {s : set (set α)} (hs : set.finite s) (h : ∀ (t : set α), t ∈ s → is_measurable t) : is_measurable (⋂₀s) :=
  is_measurable.sInter (set.finite.countable hs) h

theorem is_measurable.Inter_Prop {α : Type u_1} [measurable_space α] {p : Prop} {f : p → set α} (hf : ∀ (b : p), is_measurable (f b)) : is_measurable (set.Inter fun (b : p) => f b) := sorry

@[simp] theorem is_measurable.union {α : Type u_1} [measurable_space α] {s₁ : set α} {s₂ : set α} (h₁ : is_measurable s₁) (h₂ : is_measurable s₂) : is_measurable (s₁ ∪ s₂) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_measurable (s₁ ∪ s₂))) set.union_eq_Union))
    (is_measurable.Union (iff.mpr bool.forall_bool { left := h₂, right := h₁ }))

@[simp] theorem is_measurable.inter {α : Type u_1} [measurable_space α] {s₁ : set α} {s₂ : set α} (h₁ : is_measurable s₁) (h₂ : is_measurable s₂) : is_measurable (s₁ ∩ s₂) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_measurable (s₁ ∩ s₂))) (set.inter_eq_compl_compl_union_compl s₁ s₂)))
    (is_measurable.compl (is_measurable.union (is_measurable.compl h₁) (is_measurable.compl h₂)))

@[simp] theorem is_measurable.diff {α : Type u_1} [measurable_space α] {s₁ : set α} {s₂ : set α} (h₁ : is_measurable s₁) (h₂ : is_measurable s₂) : is_measurable (s₁ \ s₂) :=
  is_measurable.inter h₁ (is_measurable.compl h₂)

@[simp] theorem is_measurable.disjointed {α : Type u_1} [measurable_space α] {f : ℕ → set α} (h : ∀ (i : ℕ), is_measurable (f i)) (n : ℕ) : is_measurable (set.disjointed f n) :=
  set.disjointed_induct (h n) fun (t : set α) (i : ℕ) (ht : is_measurable t) => is_measurable.diff ht (h i)

@[simp] theorem is_measurable.const {α : Type u_1} [measurable_space α] (p : Prop) : is_measurable (set_of fun (a : α) => p) := sorry

/-- Every set has a measurable superset. Declare this as local instance as needed. -/
theorem nonempty_measurable_superset {α : Type u_1} [measurable_space α] (s : set α) : Nonempty (Subtype fun (t : set α) => s ⊆ t ∧ is_measurable t) :=
  Nonempty.intro { val := set.univ, property := { left := set.subset_univ s, right := is_measurable.univ } }

theorem measurable_space.ext {α : Type u_1} {m₁ : measurable_space α} {m₂ : measurable_space α} : (∀ (s : set α), measurable_space.is_measurable' m₁ s ↔ measurable_space.is_measurable' m₂ s) → m₁ = m₂ := sorry

theorem measurable_space.ext_iff {α : Type u_1} {m₁ : measurable_space α} {m₂ : measurable_space α} : m₁ = m₂ ↔ ∀ (s : set α), measurable_space.is_measurable' m₁ s ↔ measurable_space.is_measurable' m₂ s :=
  { mp := fun (ᾰ : m₁ = m₂) => Eq._oldrec (fun (s : set α) => iff.refl (measurable_space.is_measurable' m₁ s)) ᾰ,
    mpr := measurable_space.ext }

/-- A typeclass mixin for `measurable_space`s such that each singleton is measurable. -/
class measurable_singleton_class (α : Type u_7) [measurable_space α]
where
  is_measurable_singleton : ∀ (x : α), is_measurable (singleton x)

theorem is_measurable_eq {α : Type u_1} [measurable_space α] [measurable_singleton_class α] {a : α} : is_measurable (set_of fun (x : α) => x = a) :=
  is_measurable_singleton a

theorem is_measurable.insert {α : Type u_1} [measurable_space α] [measurable_singleton_class α] {s : set α} (hs : is_measurable s) (a : α) : is_measurable (insert a s) :=
  is_measurable.union (is_measurable_singleton a) hs

@[simp] theorem is_measurable_insert {α : Type u_1} [measurable_space α] [measurable_singleton_class α] {a : α} {s : set α} : is_measurable (insert a s) ↔ is_measurable s := sorry

theorem set.finite.is_measurable {α : Type u_1} [measurable_space α] [measurable_singleton_class α] {s : set α} (hs : set.finite s) : is_measurable s :=
  set.finite.induction_on hs is_measurable.empty
    fun (a : α) (s : set α) (ha : ¬a ∈ s) (hsf : set.finite s) (hsm : is_measurable s) => is_measurable.insert hsm a

protected theorem finset.is_measurable {α : Type u_1} [measurable_space α] [measurable_singleton_class α] (s : finset α) : is_measurable ↑s :=
  set.finite.is_measurable (finset.finite_to_set s)

namespace measurable_space

protected instance partial_order {α : Type u_1} : partial_order (measurable_space α) :=
  partial_order.mk (fun (m₁ m₂ : measurable_space α) => is_measurable' m₁ ≤ is_measurable' m₂)
    (preorder.lt._default fun (m₁ m₂ : measurable_space α) => is_measurable' m₁ ≤ is_measurable' m₂) sorry sorry sorry

/-- The smallest σ-algebra containing a collection `s` of basic sets -/
inductive generate_measurable {α : Type u_1} (s : set (set α)) : set α → Prop
where
| basic : ∀ (u : set α), u ∈ s → generate_measurable s u
| empty : generate_measurable s ∅
| compl : ∀ (s_1 : set α), generate_measurable s s_1 → generate_measurable s (s_1ᶜ)
| union : ∀ (f : ℕ → set α), (∀ (n : ℕ), generate_measurable s (f n)) → generate_measurable s (set.Union fun (i : ℕ) => f i)

/-- Construct the smallest measure space containing a collection of basic sets -/
def generate_from {α : Type u_1} (s : set (set α)) : measurable_space α :=
  mk (generate_measurable s) generate_measurable.empty generate_measurable.compl generate_measurable.union

theorem is_measurable_generate_from {α : Type u_1} {s : set (set α)} {t : set α} (ht : t ∈ s) : is_measurable' (generate_from s) t :=
  generate_measurable.basic t ht

theorem generate_from_le {α : Type u_1} {s : set (set α)} {m : measurable_space α} (h : ∀ (t : set α), t ∈ s → is_measurable' m t) : generate_from s ≤ m := sorry

theorem generate_from_le_iff {α : Type u_1} {s : set (set α)} (m : measurable_space α) : generate_from s ≤ m ↔ s ⊆ set_of fun (t : set α) => is_measurable' m t :=
  { mp := fun (h : generate_from s ≤ m) (u : set α) (hu : u ∈ s) => h u (is_measurable_generate_from hu),
    mpr := fun (h : s ⊆ set_of fun (t : set α) => is_measurable' m t) => generate_from_le h }

@[simp] theorem generate_from_is_measurable {α : Type u_1} [measurable_space α] : generate_from (set_of fun (s : set α) => is_measurable s) = _inst_1 :=
  le_antisymm (generate_from_le fun (_x : set α) => id) fun (s : set α) => is_measurable_generate_from

/-- If `g` is a collection of subsets of `α` such that the `σ`-algebra generated from `g` contains
the same sets as `g`, then `g` was already a `σ`-algebra. -/
protected def mk_of_closure {α : Type u_1} (g : set (set α)) (hg : (set_of fun (t : set α) => is_measurable' (generate_from g) t) = g) : measurable_space α :=
  mk (fun (s : set α) => s ∈ g) sorry sorry sorry

theorem mk_of_closure_sets {α : Type u_1} {s : set (set α)} {hs : (set_of fun (t : set α) => is_measurable' (generate_from s) t) = s} : measurable_space.mk_of_closure s hs = generate_from s := sorry

/-- We get a Galois insertion between `σ`-algebras on `α` and `set (set α)` by using `generate_from`
  on one side and the collection of measurable sets on the other side. -/
def gi_generate_from {α : Type u_1} : galois_insertion generate_from fun (m : measurable_space α) => set_of fun (t : set α) => is_measurable t :=
  galois_insertion.mk
    (fun (g : set (set α)) (hg : (set_of fun (t : set α) => is_measurable t) ≤ g) =>
      measurable_space.mk_of_closure g sorry)
    sorry sorry sorry

protected instance complete_lattice {α : Type u_1} : complete_lattice (measurable_space α) :=
  galois_insertion.lift_complete_lattice gi_generate_from

protected instance inhabited {α : Type u_1} : Inhabited (measurable_space α) :=
  { default := ⊤ }

theorem is_measurable_bot_iff {α : Type u_1} {s : set α} : is_measurable s ↔ s = ∅ ∨ s = set.univ := sorry

@[simp] theorem is_measurable_top {α : Type u_1} {s : set α} : is_measurable s :=
  trivial

@[simp] theorem is_measurable_inf {α : Type u_1} {m₁ : measurable_space α} {m₂ : measurable_space α} {s : set α} : is_measurable s ↔ is_measurable s ∧ is_measurable s :=
  iff.rfl

@[simp] theorem is_measurable_Inf {α : Type u_1} {ms : set (measurable_space α)} {s : set α} : is_measurable s ↔ ∀ (m : measurable_space α), m ∈ ms → is_measurable s := sorry

@[simp] theorem is_measurable_infi {α : Type u_1} {ι : Sort u_2} {m : ι → measurable_space α} {s : set α} : is_measurable s ↔ ι → is_measurable s := sorry

theorem is_measurable_sup {α : Type u_1} {m₁ : measurable_space α} {m₂ : measurable_space α} {s : set α} : is_measurable s ↔ generate_measurable (is_measurable' m₁ ∪ is_measurable' m₂) s :=
  iff.refl (is_measurable s)

theorem is_measurable_Sup {α : Type u_1} {ms : set (measurable_space α)} {s : set α} : is_measurable s ↔
  generate_measurable (set_of fun (s : set α) => ∃ (m : measurable_space α), ∃ (H : m ∈ ms), is_measurable s) s := sorry

theorem is_measurable_supr {α : Type u_1} {ι : Sort u_2} {m : ι → measurable_space α} {s : set α} : is_measurable s ↔ generate_measurable (set_of fun (s : set α) => ∃ (i : ι), is_measurable s) s := sorry

/-- The forward image of a measure space under a function. `map f m` contains the sets `s : set β`
  whose preimage under `f` is measurable. -/
protected def map {α : Type u_1} {β : Type u_2} (f : α → β) (m : measurable_space α) : measurable_space β :=
  mk (fun (s : set β) => is_measurable' m (f ⁻¹' s)) (is_measurable_empty m) sorry sorry

@[simp] theorem map_id {α : Type u_1} {m : measurable_space α} : measurable_space.map id m = m :=
  ext fun (s : set α) => iff.rfl

@[simp] theorem map_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} {m : measurable_space α} {f : α → β} {g : β → γ} : measurable_space.map g (measurable_space.map f m) = measurable_space.map (g ∘ f) m :=
  ext fun (s : set γ) => iff.rfl

/-- The reverse image of a measure space under a function. `comap f m` contains the sets `s : set α`
  such that `s` is the `f`-preimage of a measurable set in `β`. -/
protected def comap {α : Type u_1} {β : Type u_2} (f : α → β) (m : measurable_space β) : measurable_space α :=
  mk (fun (s : set α) => ∃ (s' : set β), is_measurable' m s' ∧ f ⁻¹' s' = s) sorry sorry sorry

@[simp] theorem comap_id {α : Type u_1} {m : measurable_space α} : measurable_space.comap id m = m := sorry

@[simp] theorem comap_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} {m : measurable_space α} {f : β → α} {g : γ → β} : measurable_space.comap g (measurable_space.comap f m) = measurable_space.comap (f ∘ g) m := sorry

theorem comap_le_iff_le_map {α : Type u_1} {β : Type u_2} {m : measurable_space α} {m' : measurable_space β} {f : α → β} : measurable_space.comap f m' ≤ m ↔ m' ≤ measurable_space.map f m := sorry

theorem gc_comap_map {α : Type u_1} {β : Type u_2} (f : α → β) : galois_connection (measurable_space.comap f) (measurable_space.map f) :=
  fun (f_1 : measurable_space β) (g : measurable_space α) => comap_le_iff_le_map

theorem map_mono {α : Type u_1} {β : Type u_2} {m₁ : measurable_space α} {m₂ : measurable_space α} {f : α → β} (h : m₁ ≤ m₂) : measurable_space.map f m₁ ≤ measurable_space.map f m₂ :=
  galois_connection.monotone_u (gc_comap_map f) h

theorem monotone_map {α : Type u_1} {β : Type u_2} {f : α → β} : monotone (measurable_space.map f) :=
  fun (a b : measurable_space α) (h : a ≤ b) => map_mono h

theorem comap_mono {α : Type u_1} {β : Type u_2} {m₁ : measurable_space α} {m₂ : measurable_space α} {g : β → α} (h : m₁ ≤ m₂) : measurable_space.comap g m₁ ≤ measurable_space.comap g m₂ :=
  galois_connection.monotone_l (gc_comap_map g) h

theorem monotone_comap {α : Type u_1} {β : Type u_2} {g : β → α} : monotone (measurable_space.comap g) :=
  fun (a b : measurable_space α) (h : a ≤ b) => comap_mono h

@[simp] theorem comap_bot {α : Type u_1} {β : Type u_2} {g : β → α} : measurable_space.comap g ⊥ = ⊥ :=
  galois_connection.l_bot (gc_comap_map g)

@[simp] theorem comap_sup {α : Type u_1} {β : Type u_2} {m₁ : measurable_space α} {m₂ : measurable_space α} {g : β → α} : measurable_space.comap g (m₁ ⊔ m₂) = measurable_space.comap g m₁ ⊔ measurable_space.comap g m₂ :=
  galois_connection.l_sup (gc_comap_map g)

@[simp] theorem comap_supr {α : Type u_1} {β : Type u_2} {ι : Sort u_6} {g : β → α} {m : ι → measurable_space α} : measurable_space.comap g (supr fun (i : ι) => m i) = supr fun (i : ι) => measurable_space.comap g (m i) :=
  galois_connection.l_supr (gc_comap_map g)

@[simp] theorem map_top {α : Type u_1} {β : Type u_2} {f : α → β} : measurable_space.map f ⊤ = ⊤ :=
  galois_connection.u_top (gc_comap_map f)

@[simp] theorem map_inf {α : Type u_1} {β : Type u_2} {m₁ : measurable_space α} {m₂ : measurable_space α} {f : α → β} : measurable_space.map f (m₁ ⊓ m₂) = measurable_space.map f m₁ ⊓ measurable_space.map f m₂ :=
  galois_connection.u_inf (gc_comap_map f)

@[simp] theorem map_infi {α : Type u_1} {β : Type u_2} {ι : Sort u_6} {f : α → β} {m : ι → measurable_space α} : measurable_space.map f (infi fun (i : ι) => m i) = infi fun (i : ι) => measurable_space.map f (m i) :=
  galois_connection.u_infi (gc_comap_map f)

theorem comap_map_le {α : Type u_1} {β : Type u_2} {m : measurable_space α} {f : α → β} : measurable_space.comap f (measurable_space.map f m) ≤ m :=
  galois_connection.l_u_le (gc_comap_map f) m

theorem le_map_comap {α : Type u_1} {β : Type u_2} {m : measurable_space α} {g : β → α} : m ≤ measurable_space.map g (measurable_space.comap g m) :=
  galois_connection.le_u_l (gc_comap_map g) m

theorem generate_from_le_generate_from {α : Type u_1} {s : set (set α)} {t : set (set α)} (h : s ⊆ t) : generate_from s ≤ generate_from t :=
  galois_connection.monotone_l (galois_insertion.gc gi_generate_from) h

theorem generate_from_sup_generate_from {α : Type u_1} {s : set (set α)} {t : set (set α)} : generate_from s ⊔ generate_from t = generate_from (s ∪ t) :=
  Eq.symm (galois_connection.l_sup (galois_insertion.gc gi_generate_from))

theorem comap_generate_from {α : Type u_1} {β : Type u_2} {f : α → β} {s : set (set β)} : measurable_space.comap f (generate_from s) = generate_from (set.preimage f '' s) := sorry

end measurable_space

/-- A function `f` between measurable spaces is measurable if the preimage of every
  measurable set is measurable. -/
def measurable {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (f : α → β) :=
  ∀ {t : set β}, is_measurable t → is_measurable (f ⁻¹' t)

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

theorem measurable.of_le_map {α : Type u_1} {β : Type u_2} {m₁ : measurable_space α} {m₂ : measurable_space β} {f : α → β} : m₂ ≤ measurable_space.map f m₁ → measurable f :=
  iff.mpr measurable_iff_le_map

theorem measurable_iff_comap_le {α : Type u_1} {β : Type u_2} {m₁ : measurable_space α} {m₂ : measurable_space β} {f : α → β} : measurable f ↔ measurable_space.comap f m₂ ≤ m₁ :=
  iff.symm measurable_space.comap_le_iff_le_map

theorem measurable.comap_le {α : Type u_1} {β : Type u_2} {m₁ : measurable_space α} {m₂ : measurable_space β} {f : α → β} : measurable f → measurable_space.comap f m₂ ≤ m₁ :=
  iff.mp measurable_iff_comap_le

theorem measurable.mono {α : Type u_1} {β : Type u_2} {ma : measurable_space α} {ma' : measurable_space α} {mb : measurable_space β} {mb' : measurable_space β} {f : α → β} (hf : measurable f) (ha : ma ≤ ma') (hb : mb' ≤ mb) : measurable f :=
  fun (t : set β) (ht : is_measurable t) => ha (f ⁻¹' t) (hf (hb t ht))

theorem measurable_from_top {α : Type u_1} {β : Type u_2} [measurable_space β] {f : α → β} : measurable f :=
  fun (s : set β) (hs : is_measurable s) => trivial

theorem measurable_generate_from {α : Type u_1} {β : Type u_2} [measurable_space α] {s : set (set β)} {f : α → β} (h : ∀ (t : set β), t ∈ s → is_measurable (f ⁻¹' t)) : measurable f :=
  measurable.of_le_map (measurable_space.generate_from_le h)

theorem measurable_id {α : Type u_1} [measurable_space α] : measurable id :=
  fun (t : set α) => id

theorem measurable.comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {g : β → γ} {f : α → β} (hg : measurable g) (hf : measurable f) : measurable (g ∘ f) :=
  fun (t : set γ) (ht : is_measurable t) => hf (hg ht)

theorem subsingleton.measurable {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] [subsingleton α] {f : α → β} : measurable f :=
  fun (s : set β) (hs : is_measurable s) => subsingleton.is_measurable

theorem measurable.piecewise {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {s : set α} {_x : decidable_pred s} {f : α → β} {g : α → β} (hs : is_measurable s) (hf : measurable f) (hg : measurable g) : measurable (set.piecewise s f g) := sorry

/-- this is slightly different from `measurable.piecewise`. It can be used to show
`measurable (ite (x=0) 0 1)` by
`exact measurable.ite (is_measurable_singleton 0) measurable_const measurable_const`,
but replacing `measurable.ite` by `measurable.piecewise` in that example proof does not work. -/
theorem measurable.ite {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {p : α → Prop} {_x : decidable_pred p} {f : α → β} {g : α → β} (hp : is_measurable (set_of fun (a : α) => p a)) (hf : measurable f) (hg : measurable g) : measurable fun (x : α) => ite (p x) (f x) (g x) :=
  measurable.piecewise hp hf hg

@[simp] theorem measurable_const {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {a : α} : measurable fun (b : β) => a :=
  fun (s : set α) (hs : is_measurable s) => is_measurable.const (a ∈ s)

theorem measurable.indicator {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] [HasZero β] {s : set α} {f : α → β} (hf : measurable f) (hs : is_measurable s) : measurable (set.indicator s f) :=
  measurable.piecewise hs hf measurable_const

theorem measurable_zero {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] [HasZero α] : measurable 0 :=
  measurable_const

theorem measurable_of_not_nonempty {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (h : ¬Nonempty α) (f : α → β) : measurable f := sorry

protected instance empty.measurable_space : measurable_space empty :=
  ⊤

protected instance punit.measurable_space : measurable_space PUnit :=
  ⊤

protected instance bool.measurable_space : measurable_space Bool :=
  ⊤

protected instance nat.measurable_space : measurable_space ℕ :=
  ⊤

protected instance int.measurable_space : measurable_space ℤ :=
  ⊤

protected instance rat.measurable_space : measurable_space ℚ :=
  ⊤

theorem measurable_to_encodable {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] [encodable α] {f : β → α} (h : ∀ (y : β), is_measurable (f ⁻¹' singleton (f y))) : measurable f := sorry

theorem measurable_unit {α : Type u_1} [measurable_space α] (f : Unit → α) : measurable f :=
  measurable_from_top

theorem measurable_from_nat {α : Type u_1} [measurable_space α] {f : ℕ → α} : measurable f :=
  measurable_from_top

theorem measurable_to_nat {α : Type u_1} [measurable_space α] {f : α → ℕ} : (∀ (y : α), is_measurable (f ⁻¹' singleton (f y))) → measurable f :=
  measurable_to_encodable

theorem measurable_find_greatest' {α : Type u_1} [measurable_space α] {p : α → ℕ → Prop} {N : ℕ} (hN : ∀ (k : ℕ), k ≤ N → is_measurable (set_of fun (x : α) => nat.find_greatest (p x) N = k)) : measurable fun (x : α) => nat.find_greatest (p x) N :=
  measurable_to_nat fun (x : α) => hN (nat.find_greatest (p x) N) nat.find_greatest_le

theorem measurable_find_greatest {α : Type u_1} [measurable_space α] {p : α → ℕ → Prop} {N : ℕ} (hN : ∀ (k : ℕ), k ≤ N → is_measurable (set_of fun (x : α) => p x k)) : measurable fun (x : α) => nat.find_greatest (p x) N := sorry

theorem measurable_find {α : Type u_1} [measurable_space α] {p : α → ℕ → Prop} (hp : ∀ (x : α), ∃ (N : ℕ), p x N) (hm : ∀ (k : ℕ), is_measurable (set_of fun (x : α) => p x k)) : measurable fun (x : α) => nat.find (hp x) := sorry

protected instance subtype.measurable_space {α : Type u_1} {p : α → Prop} [m : measurable_space α] : measurable_space (Subtype p) :=
  measurable_space.comap coe m

theorem measurable_subtype_coe {α : Type u_1} [measurable_space α] {p : α → Prop} : measurable coe :=
  measurable_space.le_map_comap

theorem measurable.subtype_coe {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {p : β → Prop} {f : α → Subtype p} (hf : measurable f) : measurable fun (a : α) => ↑(f a) :=
  measurable.comp measurable_subtype_coe hf

theorem measurable.subtype_mk {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {p : β → Prop} {f : α → β} (hf : measurable f) {h : ∀ (x : α), p (f x)} : measurable fun (x : α) => { val := f x, property := h x } := sorry

theorem is_measurable.subtype_image {α : Type u_1} [measurable_space α] {s : set α} {t : set ↥s} (hs : is_measurable s) : is_measurable t → is_measurable (coe '' t) := sorry

theorem measurable_of_measurable_union_cover {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {f : α → β} (s : set α) (t : set α) (hs : is_measurable s) (ht : is_measurable t) (h : set.univ ⊆ s ∪ t) (hc : measurable fun (a : ↥s) => f ↑a) (hd : measurable fun (a : ↥t) => f ↑a) : measurable f := sorry

theorem measurable_of_measurable_on_compl_singleton {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] [measurable_singleton_class α] {f : α → β} (a : α) (hf : measurable (set.restrict f (set_of fun (x : α) => x ≠ a))) : measurable f :=
  measurable_of_measurable_union_cover (set_of fun (x : α) => x = a) ((set_of fun (x : α) => x = a)ᶜ) is_measurable_eq
    (is_measurable.compl is_measurable_eq)
    (fun (x : α) (hx : x ∈ set.univ) => classical.em (x ∈ set_of fun (x : α) => x = a)) subsingleton.measurable hf

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

theorem measurable_fst {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] : measurable prod.fst :=
  measurable.of_comap_le le_sup_left

theorem measurable.fst {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β × γ} (hf : measurable f) : measurable fun (a : α) => prod.fst (f a) :=
  measurable.comp measurable_fst hf

theorem measurable_snd {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] : measurable prod.snd :=
  measurable.of_comap_le le_sup_right

theorem measurable.snd {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β × γ} (hf : measurable f) : measurable fun (a : α) => prod.snd (f a) :=
  measurable.comp measurable_snd hf

theorem measurable.prod {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β × γ} (hf₁ : measurable fun (a : α) => prod.fst (f a)) (hf₂ : measurable fun (a : α) => prod.snd (f a)) : measurable f := sorry

theorem measurable_prod {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β × γ} : measurable f ↔ (measurable fun (a : α) => prod.fst (f a)) ∧ measurable fun (a : α) => prod.snd (f a) := sorry

theorem measurable.prod_mk {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β} {g : α → γ} (hf : measurable f) (hg : measurable g) : measurable fun (a : α) => (f a, g a) :=
  measurable.prod hf hg

theorem measurable_prod_mk_left {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {x : α} : measurable (Prod.mk x) :=
  measurable.prod_mk measurable_const measurable_id

theorem measurable_prod_mk_right {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {y : β} : measurable fun (x : α) => (x, y) :=
  measurable.prod_mk measurable_id measurable_const

theorem measurable.of_uncurry_left {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β → γ} (hf : measurable (function.uncurry f)) {x : α} : measurable (f x) :=
  measurable.comp hf measurable_prod_mk_left

theorem measurable.of_uncurry_right {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β → γ} (hf : measurable (function.uncurry f)) {y : β} : measurable fun (x : α) => f x y :=
  measurable.comp hf measurable_prod_mk_right

theorem measurable_swap {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] : measurable prod.swap :=
  measurable.prod measurable_snd measurable_fst

theorem measurable_swap_iff {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α × β → γ} : measurable (f ∘ prod.swap) ↔ measurable f := sorry

theorem is_measurable.prod {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {s : set α} {t : set β} (hs : is_measurable s) (ht : is_measurable t) : is_measurable (set.prod s t) :=
  is_measurable.inter (measurable_fst hs) (measurable_snd ht)

theorem is_measurable_prod_of_nonempty {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {s : set α} {t : set β} (h : set.nonempty (set.prod s t)) : is_measurable (set.prod s t) ↔ is_measurable s ∧ is_measurable t := sorry

theorem is_measurable_prod {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {s : set α} {t : set β} : is_measurable (set.prod s t) ↔ is_measurable s ∧ is_measurable t ∨ s = ∅ ∨ t = ∅ := sorry

theorem is_measurable_swap_iff {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {s : set (α × β)} : is_measurable (prod.swap ⁻¹' s) ↔ is_measurable s := sorry

protected instance measurable_space.pi {δ : Type u_4} {π : δ → Type u_7} [m : (a : δ) → measurable_space (π a)] : measurable_space ((a : δ) → π a) :=
  supr fun (a : δ) => measurable_space.comap (fun (b : (a : δ) → π a) => b a) (m a)

theorem measurable_pi_iff {α : Type u_1} {δ : Type u_4} [measurable_space α] {π : δ → Type u_7} [(a : δ) → measurable_space (π a)] {g : α → (a : δ) → π a} : measurable g ↔ ∀ (a : δ), measurable fun (x : α) => g x a := sorry

theorem measurable_pi_apply {δ : Type u_4} {π : δ → Type u_7} [(a : δ) → measurable_space (π a)] (a : δ) : measurable fun (f : (a : δ) → π a) => f a :=
  measurable.of_comap_le (le_supr (fun (a : δ) => measurable_space.comap (fun (f : (a : δ) → π a) => f a) (_inst_4 a)) a)

theorem measurable.eval {α : Type u_1} {δ : Type u_4} [measurable_space α] {π : δ → Type u_7} [(a : δ) → measurable_space (π a)] {a : δ} {g : α → (a : δ) → π a} (hg : measurable g) : measurable fun (x : α) => g x a :=
  measurable.comp (measurable_pi_apply a) hg

theorem measurable_pi_lambda {α : Type u_1} {δ : Type u_4} [measurable_space α] {π : δ → Type u_7} [(a : δ) → measurable_space (π a)] (f : α → (a : δ) → π a) (hf : ∀ (a : δ), measurable fun (c : α) => f c a) : measurable f :=
  iff.mpr measurable_pi_iff hf

/-- The function `update f a : π a → Π a, π a` is always measurable.
  This doesn't require `f` to be measurable.
  This should not be confused with the statement that `update f a x` is measurable. -/
theorem measurable_update {δ : Type u_4} {π : δ → Type u_7} [(a : δ) → measurable_space (π a)] (f : (a : δ) → π a) {a : δ} : measurable (function.update f a) := sorry

/- Even though we cannot use projection notation, we still keep a dot to be consistent with similar
  lemmas, like `is_measurable.prod`. -/

theorem is_measurable.pi {δ : Type u_4} {π : δ → Type u_7} [(a : δ) → measurable_space (π a)] {s : set δ} {t : (i : δ) → set (π i)} (hs : set.countable s) (ht : ∀ (i : δ), i ∈ s → is_measurable (t i)) : is_measurable (set.pi s t) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_measurable (set.pi s t))) (set.pi_def s t)))
    (is_measurable.bInter hs fun (i : δ) (hi : i ∈ s) => measurable_pi_apply i (ht i hi))

theorem is_measurable.pi_univ {δ : Type u_4} {π : δ → Type u_7} [(a : δ) → measurable_space (π a)] [encodable δ] {t : (i : δ) → set (π i)} (ht : ∀ (i : δ), is_measurable (t i)) : is_measurable (set.pi set.univ t) :=
  is_measurable.pi (set.countable_encodable set.univ) fun (i : δ) (_x : i ∈ set.univ) => ht i

theorem is_measurable_pi_of_nonempty {δ : Type u_4} {π : δ → Type u_7} [(a : δ) → measurable_space (π a)] {s : set δ} {t : (i : δ) → set (π i)} (hs : set.countable s) (h : set.nonempty (set.pi s t)) : is_measurable (set.pi s t) ↔ ∀ (i : δ), i ∈ s → is_measurable (t i) := sorry

theorem is_measurable_pi {δ : Type u_4} {π : δ → Type u_7} [(a : δ) → measurable_space (π a)] {s : set δ} {t : (i : δ) → set (π i)} (hs : set.countable s) : is_measurable (set.pi s t) ↔ (∀ (i : δ), i ∈ s → is_measurable (t i)) ∨ set.pi s t = ∅ := sorry

theorem is_measurable.pi_fintype {δ : Type u_4} {π : δ → Type u_7} [(a : δ) → measurable_space (π a)] [fintype δ] {s : set δ} {t : (i : δ) → set (π i)} (ht : ∀ (i : δ), i ∈ s → is_measurable (t i)) : is_measurable (set.pi s t) :=
  is_measurable.pi (set.countable_encodable s) ht

protected instance tprod.measurable_space {δ : Type u_4} (π : δ → Type u_1) [(x : δ) → measurable_space (π x)] (l : List δ) : measurable_space (list.tprod π l) :=
  sorry

theorem measurable_tprod_mk {δ : Type u_4} {π : δ → Type u_7} [(x : δ) → measurable_space (π x)] (l : List δ) : measurable (list.tprod.mk l) :=
  List.rec measurable_const
    (fun (i : δ) (l : List δ) (ih : measurable (list.tprod.mk l)) => measurable.prod_mk (measurable_pi_apply i) ih) l

theorem measurable_tprod_elim {δ : Type u_4} {π : δ → Type u_7} [(x : δ) → measurable_space (π x)] {l : List δ} {i : δ} (hi : i ∈ l) : measurable fun (v : list.tprod π l) => list.tprod.elim v hi := sorry

theorem measurable_tprod_elim' {δ : Type u_4} {π : δ → Type u_7} [(x : δ) → measurable_space (π x)] {l : List δ} (h : ∀ (i : δ), i ∈ l) : measurable (list.tprod.elim' h) :=
  measurable_pi_lambda (list.tprod.elim' h) fun (i : δ) => measurable_tprod_elim (h i)

theorem is_measurable.tprod {δ : Type u_4} {π : δ → Type u_7} [(x : δ) → measurable_space (π x)] (l : List δ) {s : (i : δ) → set (π i)} (hs : ∀ (i : δ), is_measurable (s i)) : is_measurable (set.tprod l s) :=
  List.rec is_measurable.univ
    (fun (i : δ) (l : List δ) (ih : is_measurable (set.tprod l s)) => is_measurable.prod (hs i) ih) l

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

theorem measurable_inl {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] : measurable sum.inl :=
  measurable.of_le_map inf_le_left

theorem measurable_inr {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] : measurable sum.inr :=
  measurable.of_le_map inf_le_right

theorem measurable_sum {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α ⊕ β → γ} (hl : measurable (f ∘ sum.inl)) (hr : measurable (f ∘ sum.inr)) : measurable f :=
  measurable.of_comap_le
    (le_inf (iff.mpr measurable_space.comap_le_iff_le_map hl) (iff.mpr measurable_space.comap_le_iff_le_map hr))

theorem measurable.sum_elim {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → γ} {g : β → γ} (hf : measurable f) (hg : measurable g) : measurable (sum.elim f g) :=
  measurable_sum hf hg

theorem is_measurable.inl_image {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {s : set α} (hs : is_measurable s) : is_measurable (sum.inl '' s) := sorry

theorem is_measurable_range_inl {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] : is_measurable (set.range sum.inl) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_measurable (set.range sum.inl))) (Eq.symm set.image_univ)))
    (is_measurable.inl_image is_measurable.univ)

theorem is_measurable_inr_image {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] {s : set β} (hs : is_measurable s) : is_measurable (sum.inr '' s) := sorry

theorem is_measurable_range_inr {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] : is_measurable (set.range sum.inr) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_measurable (set.range sum.inr))) (Eq.symm set.image_univ)))
    (is_measurable_inr_image is_measurable.univ)

protected instance sigma.measurable_space {α : Type u_1} {β : α → Type u_2} [m : (a : α) → measurable_space (β a)] : measurable_space (sigma β) :=
  infi fun (a : α) => measurable_space.map (sigma.mk a) (m a)

/-- Equivalences between measurable spaces. Main application is the simplification of measurability
statements along measurable equivalences. -/
structure measurable_equiv (α : Type u_7) (β : Type u_8) [measurable_space α] [measurable_space β]
extends α ≃ β
where
  measurable_to_fun : measurable (equiv.to_fun _to_equiv)
  measurable_inv_fun : measurable (equiv.inv_fun _to_equiv)

infixl:25 " ≃ᵐ " => Mathlib.measurable_equiv

namespace measurable_equiv

protected instance has_coe_to_fun (α : Type u_1) (β : Type u_2) [measurable_space α] [measurable_space β] : has_coe_to_fun (α ≃ᵐ β) :=
  has_coe_to_fun.mk (fun (_x : α ≃ᵐ β) => α → β) fun (e : α ≃ᵐ β) => ⇑(to_equiv e)

theorem coe_eq {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (e : α ≃ᵐ β) : ⇑e = ⇑(to_equiv e) :=
  rfl

protected theorem measurable {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (e : α ≃ᵐ β) : measurable ⇑e :=
  measurable_to_fun e

@[simp] theorem coe_mk {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (e : α ≃ β) (h1 : measurable ⇑e) (h2 : measurable ⇑(equiv.symm e)) : ⇑(mk e h1 h2) = ⇑e :=
  rfl

/-- Any measurable space is equivalent to itself. -/
def refl (α : Type u_1) [measurable_space α] : α ≃ᵐ α :=
  mk (equiv.refl α) measurable_id measurable_id

protected instance inhabited {α : Type u_1} [measurable_space α] : Inhabited (α ≃ᵐ α) :=
  { default := refl α }

/-- The composition of equivalences between measurable spaces. -/
def trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] (ab : α ≃ᵐ β) (bc : β ≃ᵐ γ) : α ≃ᵐ γ :=
  mk (equiv.trans (to_equiv ab) (to_equiv bc)) sorry sorry

/-- The inverse of an equivalence between measurable spaces. -/
@[simp] theorem symm_to_equiv {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (ab : α ≃ᵐ β) : to_equiv (symm ab) = equiv.symm (to_equiv ab) :=
  Eq.refl (to_equiv (symm ab))

@[simp] theorem coe_symm_mk {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (e : α ≃ β) (h1 : measurable ⇑e) (h2 : measurable ⇑(equiv.symm e)) : ⇑(symm (mk e h1 h2)) = ⇑(equiv.symm e) :=
  rfl

@[simp] theorem symm_comp_self {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (e : α ≃ᵐ β) : ⇑(symm e) ∘ ⇑e = id :=
  funext (equiv.left_inv (to_equiv e))

@[simp] theorem self_comp_symm {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (e : α ≃ᵐ β) : ⇑e ∘ ⇑(symm e) = id :=
  funext (equiv.right_inv (to_equiv e))

/-- Equal measurable spaces are equivalent. -/
protected def cast {α : Type u_1} {β : Type u_1} [i₁ : measurable_space α] [i₂ : measurable_space β] (h : α = β) (hi : i₁ == i₂) : α ≃ᵐ β :=
  mk (equiv.cast h) sorry sorry

protected theorem measurable_coe_iff {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] {f : β → γ} (e : α ≃ᵐ β) : measurable (f ∘ ⇑e) ↔ measurable f := sorry

/-- Products of equivalent measurable spaces are equivalent. -/
def prod_congr {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} [measurable_space α] [measurable_space β] [measurable_space γ] [measurable_space δ] (ab : α ≃ᵐ β) (cd : γ ≃ᵐ δ) : α × γ ≃ᵐ β × δ :=
  mk (equiv.prod_congr (to_equiv ab) (to_equiv cd)) sorry sorry

/-- Products of measurable spaces are symmetric. -/
def prod_comm {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] : α × β ≃ᵐ β × α :=
  mk (equiv.prod_comm α β) sorry sorry

/-- Products of measurable spaces are associative. -/
def prod_assoc {α : Type u_1} {β : Type u_2} {γ : Type u_3} [measurable_space α] [measurable_space β] [measurable_space γ] : (α × β) × γ ≃ᵐ α × β × γ :=
  mk (equiv.prod_assoc α β γ) sorry sorry

/-- Sums of measurable spaces are symmetric. -/
def sum_congr {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} [measurable_space α] [measurable_space β] [measurable_space γ] [measurable_space δ] (ab : α ≃ᵐ β) (cd : γ ≃ᵐ δ) : α ⊕ γ ≃ᵐ β ⊕ δ :=
  mk (equiv.sum_congr (to_equiv ab) (to_equiv cd)) sorry sorry

/-- `set.prod s t ≃ (s × t)` as measurable spaces. -/
def set.prod {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (s : set α) (t : set β) : ↥(set.prod s t) ≃ᵐ ↥s × ↥t :=
  mk (equiv.set.prod s t) sorry sorry

/-- `univ α ≃ α` as measurable spaces. -/
def set.univ (α : Type u_1) [measurable_space α] : ↥set.univ ≃ᵐ α :=
  mk (equiv.set.univ α) sorry sorry

/-- `{a} ≃ unit` as measurable spaces. -/
def set.singleton {α : Type u_1} [measurable_space α] (a : α) : ↥(singleton a) ≃ᵐ Unit :=
  mk (equiv.set.singleton a) sorry sorry

/-- A set is equivalent to its image under a function `f` as measurable spaces,
  if `f` is an injective measurable function that sends measurable sets to measurable sets. -/
def set.image {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (f : α → β) (s : set α) (hf : function.injective f) (hfm : measurable f) (hfi : ∀ (s : set α), is_measurable s → is_measurable (f '' s)) : ↥s ≃ᵐ ↥(f '' s) :=
  mk (equiv.set.image f s hf) sorry sorry

/-- The domain of `f` is equivalent to its range as measurable spaces,
  if `f` is an injective measurable function that sends measurable sets to measurable sets. -/
def set.range {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] (f : α → β) (hf : function.injective f) (hfm : measurable f) (hfi : ∀ (s : set α), is_measurable s → is_measurable (f '' s)) : α ≃ᵐ ↥(set.range f) :=
  trans (symm (set.univ α)) (trans (set.image f set.univ hf hfm hfi) (measurable_equiv.cast sorry sorry))

/-- `α` is equivalent to its image in `α ⊕ β` as measurable spaces. -/
def set.range_inl {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] : ↥(set.range sum.inl) ≃ᵐ α :=
  mk
    (equiv.mk (fun (ab : ↥(set.range sum.inl)) => sorry) (fun (a : α) => { val := sum.inl a, property := sorry }) sorry
      sorry)
    sorry sorry

/-- `β` is equivalent to its image in `α ⊕ β` as measurable spaces. -/
def set.range_inr {α : Type u_1} {β : Type u_2} [measurable_space α] [measurable_space β] : ↥(set.range sum.inr) ≃ᵐ β :=
  mk
    (equiv.mk (fun (ab : ↥(set.range sum.inr)) => sorry) (fun (b : β) => { val := sum.inr b, property := sorry }) sorry
      sorry)
    sorry sorry

/-- Products distribute over sums (on the right) as measurable spaces. -/
def sum_prod_distrib (α : Type u_1) (β : Type u_2) (γ : Type u_3) [measurable_space α] [measurable_space β] [measurable_space γ] : (α ⊕ β) × γ ≃ᵐ α × γ ⊕ β × γ :=
  mk (equiv.sum_prod_distrib α β γ) sorry sorry

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

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

/-- A family of measurable equivalences `Π a, β₁ a ≃ᵐ β₂ a` generates a measurable equivalence
  between  `Π a, β₁ a` and `Π a, β₂ a`. -/
def Pi_congr_right {δ' : Type u_5} {π : δ' → Type u_7} {π' : δ' → Type u_8} [(x : δ') → measurable_space (π x)] [(x : δ') → measurable_space (π' x)] (e : (a : δ') → π a ≃ᵐ π' a) : ((a : δ') → π a) ≃ᵐ ((a : δ') → π' a) :=
  mk (equiv.Pi_congr_right fun (a : δ') => to_equiv (e a)) sorry sorry

/-- Pi-types are measurably equivalent to iterated products. -/
def pi_measurable_equiv_tprod {δ' : Type u_5} {π : δ' → Type u_7} [(x : δ') → measurable_space (π x)] {l : List δ'} (hnd : list.nodup l) (h : ∀ (i : δ'), i ∈ l) : ((i : δ') → π i) ≃ᵐ list.tprod π l :=
  mk (list.tprod.pi_equiv_tprod hnd h) sorry sorry

end measurable_equiv

/-- A pi-system is a collection of subsets of `α` that is closed under intersections of sets that
  are not disjoint. Usually it is also required that the collection is nonempty, but we don't do
  that here. -/
def is_pi_system {α : Type u_1} (C : set (set α)) :=
  ∀ (s t : set α), s ∈ C → t ∈ C → set.nonempty (s ∩ t) → s ∩ t ∈ C

namespace measurable_space

theorem is_pi_system_is_measurable {α : Type u_1} [measurable_space α] : is_pi_system (set_of fun (s : set α) => is_measurable s) :=
  fun (s t : set α) (hs : s ∈ set_of fun (s : set α) => is_measurable s)
    (ht : t ∈ set_of fun (s : set α) => is_measurable s) (_x : set.nonempty (s ∩ t)) => is_measurable.inter hs ht

/-- A Dynkin system is a collection of subsets of a type `α` that contains the empty set,
  is closed under complementation and under countable union of pairwise disjoint sets.
  The disjointness condition is the only difference with `σ`-algebras.

  The main purpose of Dynkin systems is to provide a powerful induction rule for σ-algebras
  generated by intersection stable set systems.

  A Dynkin system is also known as a "λ-system" or a "d-system".
-/
structure dynkin_system (α : Type u_7)
where
  has : set α → Prop
  has_empty : has ∅
  has_compl : ∀ {a : set α}, has a → has (aᶜ)
  has_Union_nat : ∀ {f : ℕ → set α}, pairwise (disjoint on f) → (∀ (i : ℕ), has (f i)) → has (set.Union fun (i : ℕ) => f i)

namespace dynkin_system

theorem ext {α : Type u_1} {d₁ : dynkin_system α} {d₂ : dynkin_system α} : (∀ (s : set α), has d₁ s ↔ has d₂ s) → d₁ = d₂ := sorry

theorem has_compl_iff {α : Type u_1} (d : dynkin_system α) {a : set α} : has d (aᶜ) ↔ has d a := sorry

theorem has_univ {α : Type u_1} (d : dynkin_system α) : has d set.univ := sorry

theorem has_Union {α : Type u_1} (d : dynkin_system α) {β : Type u_2} [encodable β] {f : β → set α} (hd : pairwise (disjoint on f)) (h : ∀ (i : β), has d (f i)) : has d (set.Union fun (i : β) => f i) := sorry

theorem has_union {α : Type u_1} (d : dynkin_system α) {s₁ : set α} {s₂ : set α} (h₁ : has d s₁) (h₂ : has d s₂) (h : s₁ ∩ s₂ ⊆ ∅) : has d (s₁ ∪ s₂) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (has d (s₁ ∪ s₂))) set.union_eq_Union))
    (has_Union d (iff.mpr pairwise_disjoint_on_bool h) (iff.mpr bool.forall_bool { left := h₂, right := h₁ }))

theorem has_diff {α : Type u_1} (d : dynkin_system α) {s₁ : set α} {s₂ : set α} (h₁ : has d s₁) (h₂ : has d s₂) (h : s₂ ⊆ s₁) : has d (s₁ \ s₂) := sorry

protected instance partial_order {α : Type u_1} : partial_order (dynkin_system α) :=
  partial_order.mk (fun (m₁ m₂ : dynkin_system α) => has m₁ ≤ has m₂)
    (preorder.lt._default fun (m₁ m₂ : dynkin_system α) => has m₁ ≤ has m₂) sorry sorry sorry

/-- Every measurable space (σ-algebra) forms a Dynkin system -/
def of_measurable_space {α : Type u_1} (m : measurable_space α) : dynkin_system α :=
  mk (is_measurable' m) (is_measurable_empty m) (is_measurable_compl m) sorry

theorem of_measurable_space_le_of_measurable_space_iff {α : Type u_1} {m₁ : measurable_space α} {m₂ : measurable_space α} : of_measurable_space m₁ ≤ of_measurable_space m₂ ↔ m₁ ≤ m₂ :=
  iff.rfl

/-- The least Dynkin system containing a collection of basic sets.
  This inductive type gives the underlying collection of sets. -/
inductive generate_has {α : Type u_1} (s : set (set α)) : set α → Prop
where
| basic : ∀ (t : set α), t ∈ s → generate_has s t
| empty : generate_has s ∅
| compl : ∀ {a : set α}, generate_has s a → generate_has s (aᶜ)
| Union : ∀ {f : ℕ → set α},
  pairwise (disjoint on f) → (∀ (i : ℕ), generate_has s (f i)) → generate_has s (set.Union fun (i : ℕ) => f i)

theorem generate_has_compl {α : Type u_1} {C : set (set α)} {s : set α} : generate_has C (sᶜ) ↔ generate_has C s := sorry

/-- The least Dynkin system containing a collection of basic sets. -/
def generate {α : Type u_1} (s : set (set α)) : dynkin_system α :=
  mk (generate_has s) generate_has.empty sorry sorry

theorem generate_has_def {α : Type u_1} {C : set (set α)} : has (generate C) = generate_has C :=
  rfl

protected instance inhabited {α : Type u_1} : Inhabited (dynkin_system α) :=
  { default := generate set.univ }

/-- If a Dynkin system is closed under binary intersection, then it forms a `σ`-algebra. -/
def to_measurable_space {α : Type u_1} (d : dynkin_system α) (h_inter : ∀ (s₁ s₂ : set α), has d s₁ → has d s₂ → has d (s₁ ∩ s₂)) : measurable_space α :=
  mk (has d) (has_empty d) sorry sorry

theorem of_measurable_space_to_measurable_space {α : Type u_1} (d : dynkin_system α) (h_inter : ∀ (s₁ s₂ : set α), has d s₁ → has d s₂ → has d (s₁ ∩ s₂)) : of_measurable_space (to_measurable_space d h_inter) = d :=
  ext fun (s : set α) => iff.rfl

/-- If `s` is in a Dynkin system `d`, we can form the new Dynkin system `{s ∩ t | t ∈ d}`. -/
def restrict_on {α : Type u_1} (d : dynkin_system α) {s : set α} (h : has d s) : dynkin_system α :=
  mk (fun (t : set α) => has d (t ∩ s)) sorry sorry sorry

theorem generate_le {α : Type u_1} (d : dynkin_system α) {s : set (set α)} (h : ∀ (t : set α), t ∈ s → has d t) : generate s ≤ d := sorry

theorem generate_has_subset_generate_measurable {α : Type u_1} {C : set (set α)} {s : set α} (hs : has (generate C) s) : is_measurable' (generate_from C) s :=
  generate_le (of_measurable_space (generate_from C)) (fun (t : set α) => is_measurable_generate_from) s hs

theorem generate_inter {α : Type u_1} {s : set (set α)} (hs : is_pi_system s) {t₁ : set α} {t₂ : set α} (ht₁ : has (generate s) t₁) (ht₂ : has (generate s) t₂) : has (generate s) (t₁ ∩ t₂) := sorry

/--
  If we have a collection of sets closed under binary intersections, then the Dynkin system it
  generates is equal to the σ-algebra it generates.
  This result is known as the π-λ theorem.
  A collection of sets closed under binary intersection is called a "π-system" if it is non-empty.
-/
theorem generate_from_eq {α : Type u_1} {s : set (set α)} (hs : is_pi_system s) : generate_from s = to_measurable_space (generate s) fun (t₁ t₂ : set α) => generate_inter hs := sorry

end dynkin_system

theorem induction_on_inter {α : Type u_1} {C : set α → Prop} {s : set (set α)} [m : measurable_space α] (h_eq : m = generate_from s) (h_inter : is_pi_system s) (h_empty : C ∅) (h_basic : ∀ (t : set α), t ∈ s → C t) (h_compl : ∀ (t : set α), is_measurable t → C t → C (tᶜ)) (h_union : ∀ (f : ℕ → set α),
  pairwise (disjoint on f) → (∀ (i : ℕ), is_measurable (f i)) → (∀ (i : ℕ), C (f i)) → C (set.Union fun (i : ℕ) => f i)) {t : set α} : is_measurable t → C t := sorry

end measurable_space

namespace filter

/-- A filter `f` is measurably generates if each `s ∈ f` includes a measurable `t ∈ f`. -/
class is_measurably_generated {α : Type u_1} [measurable_space α] (f : filter α)
where
  exists_measurable_subset : ∀ {s : set α}, s ∈ f → ∃ (t : set α), ∃ (H : t ∈ f), is_measurable t ∧ t ⊆ s

protected instance is_measurably_generated_bot {α : Type u_1} [measurable_space α] : is_measurably_generated ⊥ :=
  is_measurably_generated.mk
    fun (_x : set α) (_x_1 : _x ∈ ⊥) =>
      Exists.intro ∅ (Exists.intro mem_bot_sets { left := is_measurable.empty, right := set.empty_subset _x })

protected instance is_measurably_generated_top {α : Type u_1} [measurable_space α] : is_measurably_generated ⊤ :=
  is_measurably_generated.mk
    fun (s : set α) (hs : s ∈ ⊤) =>
      Exists.intro set.univ
        (Exists.intro univ_mem_sets { left := is_measurable.univ, right := fun (x : α) (_x : x ∈ set.univ) => hs x })

theorem eventually.exists_measurable_mem {α : Type u_1} [measurable_space α] {f : filter α} [is_measurably_generated f] {p : α → Prop} (h : filter.eventually (fun (x : α) => p x) f) : ∃ (s : set α), ∃ (H : s ∈ f), is_measurable s ∧ ∀ (x : α), x ∈ s → p x :=
  is_measurably_generated.exists_measurable_subset h

theorem eventually.exists_measurable_mem_of_lift' {α : Type u_1} [measurable_space α] {f : filter α} [is_measurably_generated f] {p : set α → Prop} (h : filter.eventually (fun (s : set α) => p s) (filter.lift' f set.powerset)) : ∃ (s : set α), ∃ (H : s ∈ f), is_measurable s ∧ p s := sorry

protected instance inf_is_measurably_generated {α : Type u_1} [measurable_space α] (f : filter α) (g : filter α) [is_measurably_generated f] [is_measurably_generated g] : is_measurably_generated (f ⊓ g) := sorry

theorem principal_is_measurably_generated_iff {α : Type u_1} [measurable_space α] {s : set α} : is_measurably_generated (principal s) ↔ is_measurable s := sorry

theorem Mathlib.is_measurable.principal_is_measurably_generated {α : Type u_1} [measurable_space α] {s : set α} : is_measurable s → is_measurably_generated (principal s) :=
  iff.mpr principal_is_measurably_generated_iff

protected instance infi_is_measurably_generated {α : Type u_1} {ι : Sort u_6} [measurable_space α] {f : ι → filter α} [∀ (i : ι), is_measurably_generated (f i)] : is_measurably_generated (infi fun (i : ι) => f i) := sorry

end filter

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

theorem is_countably_spanning_is_measurable {α : Type u_1} [measurable_space α] : is_countably_spanning (set_of fun (s : set α) => is_measurable s) :=
  Exists.intro (fun (_x : ℕ) => set.univ)
    { left := fun (_x : ℕ) => is_measurable.univ, right := set.Union_const set.univ }


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Scott Morrison
-/
import category_theory.abelian.injective_resolution
import algebra.homology.additive
import category_theory.limits.constructions.epi_mono
import category_theory.abelian.homology
import category_theory.abelian.exact

/-!
# Right-derived functors

We define the right-derived functors `F.right_derived n : C ⥤ D` for any additive functor `F`
out of a category with injective resolutions.

The definition is
```
injective_resolutions C ⋙ F.map_homotopy_category _ ⋙ homotopy_category.homology_functor D _ n
```
that is, we pick an injective resolution (thought of as an object of the homotopy category),
we apply `F` objectwise, and compute `n`-th homology.

We show that these right-derived functors can be calculated
on objects using any choice of injective resolution,
and on morphisms by any choice of lift to a cochain map between chosen injective resolutions.

Similarly we define natural transformations between right-derived functors coming from
natural transformations between the original additive functors,
and show how to compute the components.

## Main results
* `category_theory.functor.right_derived_obj_injective_zero`: the `0`-th derived functor of `F` on
  an injective object `X` is isomorphic to `F.obj X`.
* `category_theory.functor.right_derived_obj_injective_succ`: injective objects have no higher
  right derived functor.
* `category_theory.nat_trans.right_derived`: the natural isomorphism between right derived functors
  induced by natural transformation.

Now, we assume `preserves_finite_limits F`, then
* `category_theory.abelian.functor.preserves_exact_of_preserves_finite_limits_of_mono`: if `f` is
  mono and `exact f g`, then `exact (F.map f) (F.map g)`.
* `category_theory.abelian.functor.right_derived_zero_iso_self`: if there are enough injectives,
  then there is a natural isomorphism `(F.right_derived 0) ≅ F`.
-/

noncomputable theory

open category_theory
open category_theory.limits

namespace category_theory
universes v u
variables {C : Type u} [category.{v} C] {D : Type*} [category D]
variables [abelian C] [has_injective_resolutions C] [abelian D]

/-- The right derived functors of an additive functor. -/
def functor.right_derived (F : C ⥤ D) [F.additive] (n : ℕ) : C ⥤ D :=
injective_resolutions C ⋙ F.map_homotopy_category _ ⋙ homotopy_category.homology_functor D _ n

/-- We can compute a right derived functor using a chosen injective resolution. -/
@[simps]
def functor.right_derived_obj_iso (F : C ⥤ D) [F.additive] (n : ℕ)
  {X : C} (P : InjectiveResolution X) :
  (F.right_derived n).obj X ≅
    (homology_functor D _ n).obj ((F.map_homological_complex _).obj P.cocomplex) :=
(homotopy_category.homology_functor D _ n).map_iso
  (homotopy_category.iso_of_homotopy_equiv
    (F.map_homotopy_equiv (InjectiveResolution.homotopy_equiv _ P)))
  ≪≫ (homotopy_category.homology_factors D _ n).app _

/-- The 0-th derived functor of `F` on an injective object `X` is just `F.obj X`. -/
@[simps]
def functor.right_derived_obj_injective_zero (F : C ⥤ D) [F.additive]
  (X : C) [injective X] :
  (F.right_derived 0).obj X ≅ F.obj X :=
F.right_derived_obj_iso 0 (InjectiveResolution.self X) ≪≫
  (homology_functor _ _ _).map_iso ((cochain_complex.single₀_map_homological_complex F).app X) ≪≫
  (cochain_complex.homology_functor_0_single₀ D).app (F.obj X)

open_locale zero_object

/-- The higher derived functors vanish on injective objects. -/
@[simps inv]
def functor.right_derived_obj_injective_succ (F : C ⥤ D) [F.additive] (n : ℕ)
  (X : C) [injective X] :
  (F.right_derived (n+1)).obj X ≅ 0 :=
F.right_derived_obj_iso (n+1) (InjectiveResolution.self X) ≪≫
  (homology_functor _ _ _).map_iso ((cochain_complex.single₀_map_homological_complex F).app X) ≪≫
  (cochain_complex.homology_functor_succ_single₀ D n).app (F.obj X) ≪≫
  (functor.zero_obj _).iso_zero
/--
We can compute a right derived functor on a morphism using a descent of that morphism
to a cochain map between chosen injective resolutions.
-/
lemma functor.right_derived_map_eq (F : C ⥤ D) [F.additive] (n : ℕ) {X Y : C} (f : Y ⟶ X)
  {P : InjectiveResolution X} {Q : InjectiveResolution Y} (g : Q.cocomplex ⟶ P.cocomplex)
  (w : Q.ι ≫ g = (cochain_complex.single₀ C).map f ≫ P.ι) :
  (F.right_derived n).map f =
  (F.right_derived_obj_iso n Q).hom ≫
    (homology_functor D _ n).map ((F.map_homological_complex _).map g) ≫
    (F.right_derived_obj_iso n P).inv :=
begin
  dsimp only [functor.right_derived, functor.right_derived_obj_iso],
  dsimp, simp only [category.comp_id, category.id_comp],
  rw [←homology_functor_map, homotopy_category.homology_functor_map_factors],
  simp only [←functor.map_comp],
  congr' 1,
  apply homotopy_category.eq_of_homotopy,
  apply functor.map_homotopy,
  apply homotopy.trans,
  exact homotopy_category.homotopy_out_map _,
  apply InjectiveResolution.desc_homotopy f,
  { simp, },
  { simp only [InjectiveResolution.homotopy_equiv_hom_ι_assoc],
    rw [←category.assoc, w, category.assoc],
    simp only [InjectiveResolution.homotopy_equiv_inv_ι], },
end

/-- The natural transformation between right-derived functors induced by a natural transformation.-/
@[simps]
def nat_trans.right_derived {F G : C ⥤ D} [F.additive] [G.additive] (α : F ⟶ G) (n : ℕ) :
  F.right_derived n ⟶ G.right_derived n :=
whisker_left (injective_resolutions C)
  (whisker_right (nat_trans.map_homotopy_category α _)
    (homotopy_category.homology_functor D _ n))

@[simp] lemma nat_trans.right_derived_id (F : C ⥤ D) [F.additive] (n : ℕ) :
  nat_trans.right_derived (𝟙 F) n = 𝟙 (F.right_derived n) :=
by { simp [nat_trans.right_derived], refl, }

@[simp, nolint simp_nf] lemma nat_trans.right_derived_comp
  {F G H : C ⥤ D} [F.additive] [G.additive] [H.additive]
  (α : F ⟶ G) (β : G ⟶ H) (n : ℕ) :
  nat_trans.right_derived (α ≫ β) n = nat_trans.right_derived α n ≫ nat_trans.right_derived β n :=
by simp [nat_trans.right_derived]

/--
A component of the natural transformation between right-derived functors can be computed
using a chosen injective resolution.
-/
lemma nat_trans.right_derived_eq {F G : C ⥤ D} [F.additive] [G.additive] (α : F ⟶ G) (n : ℕ)
  {X : C} (P : InjectiveResolution X) :
  (nat_trans.right_derived α n).app X =
    (F.right_derived_obj_iso n P).hom ≫
      (homology_functor D _ n).map ((nat_trans.map_homological_complex α _).app P.cocomplex) ≫
        (G.right_derived_obj_iso n P).inv :=
begin
  symmetry,
  dsimp [nat_trans.right_derived, functor.right_derived_obj_iso],
  simp only [category.comp_id, category.id_comp],
  rw [←homology_functor_map, homotopy_category.homology_functor_map_factors],
  simp only [←functor.map_comp],
  congr' 1,
  apply homotopy_category.eq_of_homotopy,
  simp only [nat_trans.map_homological_complex_naturality_assoc,
    ←functor.map_comp],
  apply homotopy.comp_left_id,
  rw [←functor.map_id],
  apply functor.map_homotopy,
  apply homotopy_equiv.homotopy_hom_inv_id,
end

end category_theory

section

universes w v u

open category_theory.limits category_theory category_theory.functor

variables {C : Type u} [category.{w} C] {D : Type u} [category.{w} D]
variables (F : C ⥤ D) {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z}

namespace category_theory.abelian.functor

open category_theory.preadditive

variables [abelian C] [abelian D] [additive F]

/-- If `preserves_finite_limits F` and `mono f`, then `exact (F.map f) (F.map g)` if
`exact f g`. -/
lemma preserves_exact_of_preserves_finite_limits_of_mono [preserves_finite_limits F] [mono f]
  (ex : exact f g) : exact (F.map f) (F.map g) :=
abelian.exact_of_is_kernel _ _ (by simp [← functor.map_comp, ex.w]) $
  limits.is_limit_fork_map_of_is_limit' _ ex.w (abelian.is_limit_of_exact_of_mono _ _ ex)

/-- Given `P : InjectiveResolution X`, a morphism `(F.right_derived 0).obj X ⟶ F.obj X` given
`preserves_finite_limits F`. -/
def right_derived_zero_to_self_app [enough_injectives C] [preserves_finite_limits F] {X : C}
  (P : InjectiveResolution X) :
  (F.right_derived 0).obj X ⟶ F.obj X :=
(right_derived_obj_iso F 0 P).hom ≫ (homology_iso_kernel_desc _ _ _).hom ≫
  kernel.map _ _ (cokernel.desc _ (𝟙 _) (by simp)) (𝟙 _) (by { ext, simp }) ≫
  (as_iso (kernel.lift _ _ (exact_of_map_injective_resolution F P).w)).inv

/-- Given `P : InjectiveResolution X`, a morphism `F.obj X ⟶ (F.right_derived 0).obj X`. -/
def right_derived_zero_to_self_app_inv [enough_injectives C] {X : C}
  (P : InjectiveResolution X) :
  F.obj X ⟶ (F.right_derived 0).obj X :=
homology.lift _ _ _ (F.map (P.ι.f 0) ≫ cokernel.π _) begin
  have : (complex_shape.up ℕ).rel 0 1 := rfl,
  rw [category.assoc, cokernel.π_desc, homological_complex.d_from_eq _ this,
    map_homological_complex_obj_d, ← category.assoc, ← functor.map_comp],
  simp only [InjectiveResolution.ι_f_zero_comp_complex_d, functor.map_zero, zero_comp],
end ≫ (right_derived_obj_iso F 0 P).inv

lemma right_derived_zero_to_self_app_comp_inv [enough_injectives C] [preserves_finite_limits F]
  {X : C} (P : InjectiveResolution X) : right_derived_zero_to_self_app F P ≫
  right_derived_zero_to_self_app_inv F P = 𝟙 _ :=
begin
  dsimp [right_derived_zero_to_self_app, right_derived_zero_to_self_app_inv],
  rw [← category.assoc, iso.comp_inv_eq, category.id_comp, category.assoc, category.assoc,
    ← iso.eq_inv_comp, iso.inv_hom_id],
  ext,
  rw [category.assoc, category.assoc, homology.lift_ι, category.id_comp,
    homology.π'_ι, category.assoc, ←category.assoc _ _ (cokernel.π _), abelian.kernel.lift.inv,
    ← category.assoc, ← category.assoc _ (kernel.ι _), limits.kernel.lift_ι, category.assoc,
    category.assoc, ← category.assoc (homology_iso_kernel_desc _ _ _).hom _ _, ← homology.ι,
    ←category.assoc, homology.π'_ι, category.assoc, ←category.assoc (cokernel.π _), cokernel.π_desc,
    whisker_eq],
  convert category.id_comp (cokernel.π _),
end

lemma right_derived_zero_to_self_app_inv_comp [enough_injectives C] [preserves_finite_limits F]
  {X : C} (P : InjectiveResolution X) : right_derived_zero_to_self_app_inv F P ≫
  right_derived_zero_to_self_app F P = 𝟙 _ :=
begin
  dsimp [right_derived_zero_to_self_app, right_derived_zero_to_self_app_inv],
  rw [← category.assoc _ (F.right_derived_obj_iso 0 P).hom,
    category.assoc _ _ (F.right_derived_obj_iso 0 P).hom, iso.inv_hom_id, category.comp_id,
    ← category.assoc, ← category.assoc, is_iso.comp_inv_eq, category.id_comp],
  ext,
  simp only [limits.kernel.lift_ι_assoc, category.assoc, limits.kernel.lift_ι, homology.lift],
  rw [← category.assoc, ← category.assoc, category.assoc _ _ (homology_iso_kernel_desc _ _ _).hom],
  simp,
end

/-- Given `P : InjectiveResolution X`, the isomorphism `(F.right_derived 0).obj X ≅ F.obj X` if
`preserves_finite_limits F`. -/
def right_derived_zero_to_self_app_iso [enough_injectives C] [preserves_finite_limits F]
  {X : C} (P : InjectiveResolution X) : (F.right_derived 0).obj X ≅ F.obj X :=
{ hom := right_derived_zero_to_self_app _ P,
  inv := right_derived_zero_to_self_app_inv _ P,
  hom_inv_id' := right_derived_zero_to_self_app_comp_inv _ P,
  inv_hom_id' := right_derived_zero_to_self_app_inv_comp _ P }

/-- Given `P : InjectiveResolution X` and `Q : InjectiveResolution Y` and a morphism `f : X ⟶ Y`,
naturality of the square given by `right_derived_zero_to_self_natural`. -/
lemma right_derived_zero_to_self_natural [enough_injectives C]
  {X : C} {Y : C} (f : X ⟶ Y)
  (P : InjectiveResolution X) (Q : InjectiveResolution Y) :
  F.map f ≫ right_derived_zero_to_self_app_inv F Q =
  right_derived_zero_to_self_app_inv F P ≫ (F.right_derived 0).map f :=
begin
  dsimp [right_derived_zero_to_self_app_inv],
  simp only [category_theory.functor.map_id, category.id_comp, ← category.assoc],
  rw [iso.comp_inv_eq, right_derived_map_eq F 0 f (InjectiveResolution.desc f Q P) (by simp),
    category.assoc, category.assoc, category.assoc, category.assoc, iso.inv_hom_id,
    category.comp_id, ← category.assoc (F.right_derived_obj_iso 0 P).inv, iso.inv_hom_id,
    category.id_comp],
  dsimp only [homology_functor_map],
  ext,
  rw [category.assoc, homology.lift_ι, category.assoc, homology.map_ι,
    ←category.assoc (homology.lift _ _ _ _ _) _ _, homology.lift_ι, category.assoc, cokernel.π_desc,
    ←category.assoc, ← functor.map_comp, ← category.assoc, homological_complex.hom.sq_from_left,
    map_homological_complex_map_f, ← functor.map_comp,
    show f ≫ Q.ι.f 0 = P.ι.f 0 ≫ (InjectiveResolution.desc f Q P).f 0,
    from homological_complex.congr_hom (InjectiveResolution.desc_commutes f Q P).symm 0],
end

/-- Given `preserves_finite_limits F`, the natural isomorphism `(F.right_derived 0) ≅ F`. -/
def right_derived_zero_iso_self [enough_injectives C] [preserves_finite_limits F] :
  (F.right_derived 0) ≅ F := iso.symm $
nat_iso.of_components (λ X, (right_derived_zero_to_self_app_iso _ (InjectiveResolution.of X)).symm)
  (λ X Y f, right_derived_zero_to_self_natural _ _ _ _)

end category_theory.abelian.functor

end


import algebra.ofe.pi

/-!
# Logic of bunched implications
-/

universe u

/--
Contains the logical connectives for bundled implications.
-/
class bi_struct (ℙ : Type u) :=
(entails : ℙ → ℙ → Prop)
(empty : ℙ)
(pure : Prop → ℙ)
(and : ℙ → ℙ → ℙ)
(or : ℙ → ℙ → ℙ)
(implies : ℙ → ℙ → ℙ)
(for_all (A : Type u) : (A → ℙ) → ℙ)
(there_exists (A : Type u) : (A → ℙ) → ℙ)
(sep : ℙ → ℙ → ℙ)
(wand : ℙ → ℙ → ℙ)
(persistently : ℙ → ℙ)
(later : ℙ → ℙ)

infixr ` ⊢ `:26 := bi_struct.entails
notation `⌜`:1 p:200 `⌝` := bi_struct.pure p
infixr ` ⋀ `:35 := bi_struct.and
infixr ` ⋁ `:30 := bi_struct.or
infixr ` => `:28 := bi_struct.implies
notation `∀'` binders `, ` r:(scoped f, bi_struct.for_all _ f) := r
notation `∃'` binders `, ` r:(scoped f, bi_struct.there_exists _ f) := r
infixl ` ∗ `:80 := bi_struct.sep
infixr ` -∗ `:90 := bi_struct.wand
prefix `▷ `:100 := bi_struct.later

export bi_struct (persistently)

def bi.empty {ℙ : Type u} [bi_struct ℙ] : ℙ := bi_struct.empty
def bi.true {ℙ : Type u} [bi_struct ℙ] : ℙ := ⌜true⌝
def bi.false {ℙ : Type u} [bi_struct ℙ] : ℙ := ⌜false⌝

/-- Laws for `⊢`. -/
class bi_entails (ℙ : Type u) [bi_struct ℙ] :=
(entails_preorder : is_preorder ℙ (⊢))
(propext {P Q : ℙ} : P ⊢ Q → Q ⊢ P → P = Q)

-- TODO: Is `bi_mixin_pure_ne` required given Lean's `propext`?

/-- Nonexpansivity laws. -/
class bi_nonexpansive (ℙ : Type u) [ofe ℙ] [bi_struct ℙ] :=
(and_nonexpansive : is_nonexpansive (function.uncurry ((⋀) : ℙ → ℙ → ℙ)))
(or_nonexpansive : is_nonexpansive (function.uncurry ((⋁) : ℙ → ℙ → ℙ)))
(implies_nonexpansive : is_nonexpansive (function.uncurry ((=>) : ℙ → ℙ → ℙ)))
(forall_nonexpansive (A : Type u) : is_nonexpansive (bi_struct.for_all A : (A → ℙ) → ℙ))
(exists_nonexpansive (A : Type u) : is_nonexpansive (bi_struct.there_exists A : (A → ℙ) → ℙ))
(sep_nonexpansive : is_nonexpansive (function.uncurry ((∗) : ℙ → ℙ → ℙ)))
(wand_nonexpansive : is_nonexpansive (function.uncurry ((-∗) : ℙ → ℙ → ℙ)))
(persistently_nonexpansive : is_nonexpansive (bi_struct.persistently : ℙ → ℙ))

/-- Laws for higher-order logic. -/
class bi_hol (ℙ : Type u) [bi_struct ℙ] :=
(pure_intro {p : Prop} {P : ℙ} : p → P ⊢ ⌜p⌝)
(pure_elim {p : Prop} {P : ℙ} : (p → bi.true ⊢ P) → ⌜p⌝ ⊢ P)
(and_intro {P Q R : ℙ} : P ⊢ Q → P ⊢ R → P ⊢ Q ⋀ R)
(and_elim_left {P Q : ℙ} : P ⋀ Q ⊢ P)
(and_elim_right {P Q : ℙ} : P ⋀ Q ⊢ Q)
(or_intro_left {P Q : ℙ} : P ⊢ P ⋁ Q)
(or_intro_right {P Q : ℙ} : Q ⊢ P ⋁ Q)
(or_elim {P Q R : ℙ} : P ⊢ R → Q ⊢ R → P ⋁ Q ⊢ R)
(implies_intro {P Q R : ℙ} : P ⋀ Q ⊢ R → P ⊢ Q => R)
(implies_elim {P Q R : ℙ} : P ⊢ Q => R → P ⋀ Q ⊢ R)
(forall_intro {A : Type u} {P : ℙ} {Q : A → ℙ} : (∀ a, P ⊢ Q a) → P ⊢ ∀' a, Q a)
(forall_elim {A : Type u} {Φ : A → ℙ} {a : A} : (∀' a, Φ a) ⊢ Φ a)
(exists_intro {A : Type u} {Φ : A → ℙ} {a : A} : Φ a ⊢ ∃' a, Φ a)
(exists_elim {A : Type u} {P : ℙ} {Q : A → ℙ} : (∀ a, Q a ⊢ P) → (∃' a, Q a) ⊢ P)

/-- Laws for separating conjunction. -/
class bi_connectives (ℙ : Type u) [bi_struct ℙ] :=
(sep_mono {P Q R S : ℙ} : P ⊢ Q → R ⊢ S → P ∗ R ⊢ Q ∗ S)
(empty_sep {P : ℙ} : P ⊢ bi.empty ∗ P)
(sep_empty {P : ℙ} : P ⊢ P ∗ bi.empty)
(sep_comm {P Q : ℙ} : P ∗ Q ⊢ Q ∗ P)
(sep_assoc {P Q R : ℙ} : P ∗ Q ∗ R ⊢ P ∗ (Q ∗ R))
(wand_intro {P Q R : ℙ} : P ∗ Q ⊢ R → P ⊢ Q -∗ R)
(wand_elim {P Q R : ℙ} : P ⊢ Q -∗ R → P ∗ Q ⊢ R)

class bi_persistently (ℙ : Type u) [bi_struct ℙ] :=
(persistently_mono {P Q : ℙ} : P ⊢ Q → persistently P ⊢ persistently Q)
(persistently_persistently {P : ℙ} : persistently P ⊢ persistently (persistently P))
(persistently_empty : (bi.empty : ℙ) ⊢ persistently bi.empty)
(persistently_and {P Q : ℙ} : persistently P ⋀ persistently Q ⊢ persistently (P ⋀ Q))
(persistently_exists {A : Type u} {Φ : A → ℙ} :
  persistently (∃' a, Φ a) ⊢ ∃' a, persistently (Φ a))
(persistently_sep {P Q : ℙ} : persistently (P ∗ Q) ⊢ persistently P)
(persistently_and_sep_elim {P Q : ℙ} : persistently (P ⋀ Q) ⊢ P ∗ Q)

class bi_later (ℙ : Type u) [ofe ℙ] [bi_struct ℙ] :=
(later_nonexpansive : is_nonexpansive (bi_struct.later : ℙ → ℙ))
(later_mono {P Q : ℙ} : P ⊢ Q → ▷ P ⊢ ▷ Q)
(later_intro {P : ℙ} : P ⊢ ▷ P)
(forall_later {A : Type u} {Φ : A → ℙ} : (∀' a, ▷ Φ a) ⊢ ▷ ∀' a, Φ a)
(later_exists_false {A : Type u} {Φ : A → ℙ} : (▷ ∃' a, Φ a) ⊢ ▷ bi.false ⋁ (∃' a, ▷ Φ a))
(later_sep {P Q : ℙ} : ▷ (P ∗ Q) ⊢ ▷ P ∗ ▷ Q)
(later_sep' {P Q : ℙ} : ▷ P ∗ ▷ Q ⊢ ▷ (P ∗ Q))
(persistently_later {P : ℙ} : ▷ persistently P ⊢ persistently ▷ P)
(later_persistently {P : ℙ} : persistently ▷ P ⊢ ▷ persistently P)
(later_false_em {P : ℙ} : ▷ P ⊢ ▷ bi.false ⋁ (▷ bi.false => P))

class bi (ℙ : Type u) [ofe ℙ] [bi_struct ℙ] extends
  bi_entails ℙ, bi_nonexpansive ℙ, bi_hol ℙ, bi_connectives ℙ, bi_persistently ℙ, bi_later ℙ

namespace bi

variables {ℙ : Type u} [ofe ℙ] [bi_struct ℙ] [bi ℙ]
variables {n : ℕ} {p : Prop} {A : Type u} {P Q R S : ℙ} {Φ Ψ : A → ℙ}

/-!
# Laws for `⊢`
-/

@[refl] lemma entails_refl (P : ℙ) : P ⊢ P := bi_entails.entails_preorder.1.refl P
lemma entails_rfl {P : ℙ} : P ⊢ P := entails_refl P
/-- The cut law. -/
@[trans] lemma entails_trans : P ⊢ Q → Q ⊢ R → P ⊢ R := bi_entails.entails_preorder.2.trans P Q R
lemma propext : P ⊢ Q → Q ⊢ P → P = Q := bi_entails.propext

lemma propext_iff : P = Q ↔ (P ⊢ Q) ∧ (Q ⊢ P) :=
begin
  split,
  { rintro rfl, split; refl, },
  { intro h, exact propext h.1 h.2, },
end

/-!
# Nonexpansivity laws
-/

lemma and_eq_at : P =[n] R → Q =[n] S → (P ⋀ Q) =[n] (R ⋀ S) :=
begin
  intros h₁ h₂,
  have := bi_nonexpansive.and_nonexpansive,
  exact @this n ⟨P, Q⟩ ⟨R, S⟩ ⟨h₁, h₂⟩,
  apply_instance,
end

lemma or_eq_at : P =[n] R → Q =[n] S → (P ⋁ Q) =[n] (R ⋁ S) :=
begin
  intros h₁ h₂,
  have := bi_nonexpansive.or_nonexpansive,
  exact @this n ⟨P, Q⟩ ⟨R, S⟩ ⟨h₁, h₂⟩,
  apply_instance,
end

lemma implies_eq_at : P =[n] R → Q =[n] S → (P => Q) =[n] (R => S) :=
begin
  intros h₁ h₂,
  have := bi_nonexpansive.implies_nonexpansive,
  exact @this n ⟨P, Q⟩ ⟨R, S⟩ ⟨h₁, h₂⟩,
  apply_instance,
end

lemma forall_eq_at : (∀ a, Φ a =[n] Ψ a) → (∀' a, Φ a) =[n] (∀' a, Ψ a) :=
λ h, bi_nonexpansive.forall_nonexpansive A h

lemma exists_eq_at : (∀ a, Φ a =[n] Ψ a) → (∃' a, Φ a) =[n] (∃' a, Ψ a) :=
λ h, bi_nonexpansive.exists_nonexpansive A h

lemma sep_eq_at : P =[n] R → Q =[n] S → (P ∗ Q) =[n] (R ∗ S) :=
begin
  intros h₁ h₂,
  have := bi_nonexpansive.sep_nonexpansive,
  exact @this n ⟨P, Q⟩ ⟨R, S⟩ ⟨h₁, h₂⟩,
  apply_instance,
end

lemma wand_eq_at : P =[n] R → Q =[n] S → (P -∗ Q) =[n] (R -∗ S) :=
begin
  intros h₁ h₂,
  have := bi_nonexpansive.wand_nonexpansive,
  exact @this n ⟨P, Q⟩ ⟨R, S⟩ ⟨h₁, h₂⟩,
  apply_instance,
end

lemma persistently_eq_at : P =[n] Q → persistently P =[n] persistently Q :=
λ h, bi_nonexpansive.persistently_nonexpansive h

/-!
# Higher order logic
We show that `bi` induces a Heyting algebra.
-/

lemma pure_intro : p → P ⊢ ⌜p⌝ := bi_hol.pure_intro
lemma pure_elim : (p → true ⊢ P) → ⌜p⌝ ⊢ P := bi_hol.pure_elim
lemma entails_true : P ⊢ true := pure_intro trivial
lemma false_entails : false ⊢ P := pure_elim false.elim

/-! ## Basic logical laws -/

lemma and_intro : P ⊢ Q → P ⊢ R → P ⊢ Q ⋀ R := bi_hol.and_intro
lemma and_elim_left : P ⋀ Q ⊢ P := bi_hol.and_elim_left
lemma and_elim_right : P ⋀ Q ⊢ Q := bi_hol.and_elim_right

lemma or_intro_left : P ⊢ P ⋁ Q := bi_hol.or_intro_left
lemma or_intro_right : Q ⊢ P ⋁ Q := bi_hol.or_intro_right
lemma or_elim : P ⊢ R → Q ⊢ R → P ⋁ Q ⊢ R := bi_hol.or_elim

lemma implies_intro : P ⋀ Q ⊢ R → P ⊢ Q => R := bi_hol.implies_intro
lemma implies_elim : P ⊢ Q => R → P ⋀ Q ⊢ R := bi_hol.implies_elim
lemma implies_iff : P ⊢ Q => R ↔ P ⋀ Q ⊢ R := ⟨implies_elim, implies_intro⟩

lemma forall_intro : (∀ a, P ⊢ Φ a) → P ⊢ ∀' a, Φ a := bi_hol.forall_intro
lemma forall_elim (Φ : A → ℙ) (a : A) : (∀' a, Φ a) ⊢ Φ a := bi_hol.forall_elim

lemma exists_intro (Φ : A → ℙ) (a : A) : Φ a ⊢ ∃' a, Φ a := bi_hol.exists_intro
lemma exists_elim : (∀ a, Φ a ⊢ P) → (∃' a, Φ a) ⊢ P := bi_hol.exists_elim

/-!
## Heyting algebra

We show `ℙ` forms a Heyting algebra and a complete lattice.
We can deduce many logical laws from these typeclasses.
-/

instance : lattice ℙ := {
  sup := (⋁),
  inf := (⋀),
  le := (⊢),
  le_refl := entails_refl,
  le_trans := λ _ _ _, entails_trans,
  le_antisymm := λ _ _, propext,
  le_sup_left := λ _ _, or_intro_left,
  le_sup_right := λ _ _, or_intro_right,
  sup_le := λ _ _ _, or_elim,
  inf_le_left := λ _ _, and_elim_left,
  inf_le_right := λ _ _, and_elim_right,
  le_inf := λ _ _ _, and_intro,
}

instance : heyting_algebra ℙ := {
  top := true,
  himp := (=>),
  le_top := λ _, entails_true,
  le_himp_iff := λ _ _ _, implies_iff,
  bot := false,
  compl := λ P, P => false,
  bot_le := λ _, false_entails,
  himp_bot := λ _, rfl,
  ..bi.lattice
}

instance : complete_lattice ℙ := {
  Sup := λ S, ∃' P : S, P,
  le_Sup := λ S P hP, exists_intro (λ p : S, (p : ℙ)) (⟨P, hP⟩ : S),
  Sup_le := λ S P h, exists_elim (λ Q, h Q Q.prop),
  Inf := λ S, ∀' P : S, P,
  Inf_le := λ S P hP, forall_elim (λ p : S, (p : ℙ)) (⟨P, hP⟩ : S),
  le_Inf := λ S P h, forall_intro (λ Q, h Q Q.prop),
  ..bi.heyting_algebra
}

instance : distrib_lattice ℙ := generalized_heyting_algebra.to_distrib_lattice

lemma and_or_distrib_left : (P ⋀ (Q ⋁ R)) = (P ⋀ Q ⋁ P ⋀ R) := inf_sup_left
lemma and_or_distrib_right : ((P ⋁ Q) ⋀ R) = (P ⋀ R ⋁ Q ⋀ R) := inf_sup_right
lemma or_and_distrib_left : (P ⋁ (Q ⋀ R)) = ((P ⋁ Q) ⋀ (P ⋁ R)) := sup_inf_left
lemma or_and_distrib_right : ((P ⋀ Q) ⋁ R) = ((P ⋁ R) ⋀ (Q ⋁ R)) := sup_inf_right

/-!
## Bunched implication connectives

We prove facts about separating conjunction and magic wand.
-/

lemma sep_mono : P ⊢ Q → R ⊢ S → P ∗ R ⊢ Q ∗ S := bi_connectives.sep_mono
lemma empty_sep : P ⊢ empty ∗ P := bi_connectives.empty_sep
lemma sep_empty : P ⊢ P ∗ empty := bi_connectives.sep_empty
lemma sep_comm : P ∗ Q = Q ∗ P := propext bi_connectives.sep_comm bi_connectives.sep_comm
lemma sep_assoc : P ∗ Q ∗ R = P ∗ (Q ∗ R) :=
begin
  refine propext bi_connectives.sep_assoc _,
  rw sep_comm,
  refine entails_trans bi_connectives.sep_assoc _,
  rw sep_comm,
  refine entails_trans bi_connectives.sep_assoc _,
  rw sep_comm,
end
lemma entails_wand : (P ⊢ Q -∗ R) ↔ (P ∗ Q ⊢ R) :=
⟨bi_connectives.wand_elim, bi_connectives.wand_intro⟩

/-!
## Persistently
-/

lemma persistently_mono : P ⊢ Q → persistently P ⊢ persistently Q :=
bi_persistently.persistently_mono

lemma persistently_persistently : persistently P ⊢ persistently (persistently P) :=
bi_persistently.persistently_persistently

lemma persistently_empty : (empty : ℙ) ⊢ persistently empty :=
bi_persistently.persistently_empty

lemma persistently_and : persistently P ⋀ persistently Q ⊢ persistently (P ⋀ Q) :=
bi_persistently.persistently_and

lemma persistently_exists : persistently (∃' a, Φ a) ⊢ ∃' a, persistently (Φ a) :=
bi_persistently.persistently_exists

lemma persistently_sep : persistently (P ∗ Q) ⊢ persistently P :=
bi_persistently.persistently_sep

lemma persistently_and_sep_elim : persistently (P ⋀ Q) ⊢ P ∗ Q :=
bi_persistently.persistently_and_sep_elim

/-!
# Later
-/

lemma later_nonexpansive : is_nonexpansive (bi_struct.later : ℙ → ℙ) :=
bi_later.later_nonexpansive

lemma later_mono : P ⊢ Q → ▷ P ⊢ ▷ Q :=
bi_later.later_mono

lemma later_intro : P ⊢ ▷ P :=
bi_later.later_intro

lemma forall_later : (∀' a, ▷ Φ a) ⊢ ▷ ∀' a, Φ a :=
bi_later.forall_later

lemma later_exists_false : (▷ ∃' a, Φ a) ⊢ ▷ false ⋁ (∃' a, ▷ Φ a) :=
bi_later.later_exists_false

lemma later_sep : (▷ (P ∗ Q)) = (▷ P ∗ ▷ Q) :=
propext bi_later.later_sep bi_later.later_sep'

lemma persistently_later : (▷ persistently P) = (persistently ▷ P) :=
propext bi_later.persistently_later bi_later.later_persistently

lemma later_false_em : ▷ P ⊢ ▷ false ⋁ (▷ false => P) :=
bi_later.later_false_em

/-!
# Derived connectives
-/

def iff (P Q : ℙ) : ℙ := (P => Q) ⋀ (Q => P)
infixr ` <=> `:28 := iff

def wand_iff (P Q : ℙ) : ℙ := (P -∗ Q) ⋀ (Q -∗ P)
infixr ` ∗-∗ `:90 := wand_iff

class persistent (P : ℙ) : Prop :=
(entails_persistently : P ⊢ persistently P)

def affinely (P : ℙ) := empty ⋀ P

class affine (P : ℙ) : Prop :=
(entails_empty : P ⊢ empty)

def absorbingly (P : ℙ) := true ∗ P

class absorbing (P : ℙ) : Prop :=
(absorbingly_entails : absorbingly P ⊢ P)

def intuitionistically : ℙ → ℙ := affinely ∘ persistently
prefix `□ `:100 := intuitionistically

def persistently_if (p : Prop) [decidable p] (P : ℙ) :=
if p then persistently P else P

def affinely_if (p : Prop) [decidable p] (P : ℙ) :=
if p then affinely P else P

def absorbingly_if (p : Prop) [decidable p] (P : ℙ) :=
if p then absorbingly P else P

def intuitionistically_if (p : Prop) [decidable p] (P : ℙ) :=
if p then □ P else P

def latern : Π (n : ℕ) (P : ℙ), ℙ
| 0 P := P
| (n + 1) P := ▷ latern n P

def except_zero (P : ℙ) := ▷ false ⋁ P
prefix `◇ `:100 := except_zero

class timeless (P : ℙ) : Prop :=
(later_entails_except_zero : ▷ P ⊢ ◇ P)

/-!
# Extensions

Definitions for various extensions to the BI interface.
-/

class bi_affine (ℙ : Type u) [ofe ℙ] [bi_struct ℙ] [bi ℙ] : Prop :=
(is_affine (P : ℙ) : affine P)

class bi_positive (ℙ : Type u) [ofe ℙ] [bi_struct ℙ] [bi ℙ] : Prop :=
(affinely_sep (P Q : ℙ) : affinely (P ∗ Q) ⊢ affinely P ∗ Q)

class bi_loeb (ℙ : Type u) [ofe ℙ] [bi_struct ℙ] [bi ℙ] : Prop :=
(true_entails (P : ℙ) : ▷ P ⊢ P → true ⊢ P)

class bi_later_contractive (ℙ : Type u) [ofe ℙ] [bi_struct ℙ] [bi ℙ] : Prop :=
(later_contractive : is_contractive (bi_struct.later : ℙ → ℙ))

class bi_persistently_forall (ℙ : Type u) [ofe ℙ] [bi_struct ℙ] [bi ℙ] : Prop :=
(persistently_forall {A : Type u} {Φ : A → ℙ} : (∀' a, persistently (Φ a)) ⊢ persistently ∀' a, Φ a)

class bi_pure_forall (ℙ : Type u) [ofe ℙ] [bi_struct ℙ] [bi ℙ] : Prop :=
(pure_forall {A : Type u} {Φ : A → Prop} : (∀' a, ⌜Φ a⌝ : ℙ) ⊢ ⌜∀ a, Φ a⌝)

end bi


import tactic
import data.nat.parity
import data.multiset.basic

open finset
open function
open list

namespace aux_walk

def rmv_unt_aux {A : Type} [decidable_eq A] : A → list A → list A
  | a [] := []
  | a (x::xs) := ite (a ∈ (x::xs)) (rmv_unt_aux a xs) (x::xs)

lemma rmv_aux_not_a {A : Type} [decidable_eq A] : ∀ a : A, ∀ l : list A,
a ∉ rmv_unt_aux a l :=
begin
  intros a l,
  induction l with x xs hxs,
  unfold rmv_unt_aux,
  exact not_mem_nil a,
  unfold rmv_unt_aux,
  split_ifs,
  exact hxs,
  exact h,
end

lemma rmv_aux_inf_count {A : Type} [decidable_eq A] : ∀ a b: A, ∀ l : list A,
count b (rmv_unt_aux a l) ≤ count b l :=
begin
  intros a b l,
  induction l with x xs hxs,
  unfold rmv_unt_aux,
  unfold rmv_unt_aux,
  split_ifs,
  transitivity (count b xs),
  exact hxs,
  exact count_le_count_cons b x xs,
  refl,
end

lemma rmv_aux_smaller {A : Type} [decidable_eq A] : ∀ a: A, ∀ l : list A,
length (rmv_unt_aux a l) ≤ length l :=
begin
  intros a l,
  induction l with x xs hxs,
  unfold rmv_unt_aux,
  unfold rmv_unt_aux,
  split_ifs,
  transitivity (xs.length),
  exact hxs,
  rw length_cons,
  linarith,
  refl,
end

lemma rmv_aux_in {A : Type} [decidable_eq A] : ∀ a b: A, ∀ l : list A,
b ∈ (rmv_unt_aux a l) → b ∈ l :=
begin
  intros a b l,
  induction l with x xs hxs,
  {
    unfold rmv_unt_aux,
    intro hb, exact hb,
  },
  {
    intro hb,
    unfold rmv_unt_aux at hb,
    split_ifs at hb,
    specialize hxs hb,
    exact mem_cons_of_mem x hxs,
    exact hb,
  }
end

lemma rmv_aux_suffix {A : Type} [decidable_eq A] : ∀ a : A, ∀ l : list A,
(rmv_unt_aux a l) = l ∨ (a ::(rmv_unt_aux a l)) <:+ l :=
begin
  intros a l,
  induction l with x xs hxs,
  {
    left,
    unfold rmv_unt_aux,
  },
  {
    repeat {unfold rmv_unt_aux},
    split_ifs, swap,
    {
      left,
      split;refl,
    },
    {
      right,
      rw suffix_cons_iff,
      cases hxs with hxs hxs,
      {
        repeat {rw hxs},
        left,
        congr,
        rw mem_cons_iff at h,
        cases h with h h, exact h,
        induction xs with y ys hys,
        {
          exfalso,
          exact not_mem_nil a h,
        },
        {
          unfold rmv_unt_aux at hxs,
          split_ifs at hxs,
          exfalso,
          apply_fun list.length at hxs,
          simp at hxs,
          have hxs' := rmv_aux_smaller a ys,
          linarith,
        }
      },
      {
        right,
        exact hxs,
      }
    }

  }
end

lemma rmv_aux_eq {A : Type} [decidable_eq A] : ∀ a : A, ∀ l : list A,
(rmv_unt_aux a l) = l ↔ (a ∉ l) :=
begin
  intros a l,
  have hal := rmv_aux_suffix a l,
  cases hal with hal hal, swap,
  {
    split,
    intro h,
    exfalso,
    rw h at hal,
    replace hal := length_le_of_sublist (sublist_of_suffix hal),
    rw length_cons at hal,
    linarith,
    intro h,
    exfalso,
    apply h,
    replace hal := sublist_of_suffix hal,
    replace hal := sublist.subset hal,
    apply hal,
    exact mem_cons_self a (rmv_unt_aux a l),
  },
  {
    rw hal,
    simp,
    induction l with x xs hxs,
    exact not_mem_nil a,
    unfold rmv_unt_aux at hal,
    split_ifs at hal, swap, exact h,
    exfalso,
    apply_fun list.length at hal,
    have hal' := rmv_aux_smaller a xs,
    rw length_cons at hal,
    linarith,
  }

end

lemma rmv_aux_empty {A : Type} [decidable_eq A] [inhabited A] : ∀ a : A, ∀ l : list A,
(rmv_unt_aux a l) = nil ↔ l = nil ∨ l.ilast = a :=
begin
  intros a l,
  split,
  {
    intro h,
    induction l with x xs hxs,
    {
      left,
      refl,
    },
    {
      right,
      unfold rmv_unt_aux at h,
      split_ifs at h,
      {
        specialize hxs h,
        cases hxs with hxs hxs,
        rw hxs at *,
        finish,
      },
      {

      }
    }
  }
end
def rmv_unt {A : Type} [decidable_eq A] : list A → list A
  | [] := []
  | (x::xs) := have (rmv_unt_aux x xs).sizeof < 1 + xs.sizeof :=
  begin
    induction xs with y ys hys,
    {
      unfold rmv_unt_aux,
      linarith,
    },
    {
      unfold rmv_unt_aux,
      split_ifs,
      {
        unfold list.sizeof,
        linarith,
      },
      {
        linarith,
      }
    }
  end,
  x::rmv_unt(rmv_unt_aux x xs)

lemma rmv_in {A : Type} [decidable_eq A] : ∀ b: A, ∀ l : list A,
 b ∈ (rmv_unt l) → b ∈ l  :=
begin
  intros b l,
  obtain ⟨n, hn⟩ : {n : ℕ // l.length = n} := ⟨_, rfl⟩,
  revert l,
  apply nat.strong_induction_on n,
  intros m hm l hl hb,
  induction l with x xs hxs,
  {
    unfold rmv_unt at hb,
    exact hb,
  },
  {
    unfold rmv_unt at hb,
    rw mem_cons_iff at hb ⊢,
    simp at hl,
    cases hb with hb hb,
    {
      left,
      exact hb,
    },
    {
      right,
      apply rmv_aux_in x,
      apply hm (rmv_unt_aux x xs).length,
      rw ← hl,
      have hl' := rmv_aux_smaller x xs,
      linarith,
      refl,
      exact hb,
    }
  }
end

lemma rmv_nodup {A : Type} [decidable_eq A] : ∀ l : list A,
nodup (rmv_unt l) :=
begin
  intros l,
  obtain ⟨n, hn⟩ : {n : ℕ // l.length = n} := ⟨_, rfl⟩,
  revert l,
  apply nat.strong_induction_on n,
  intros m hm l hl,
  induction l with x xs hxs,
  {
    unfold rmv_unt,
    exact nodup_nil,
  },
  {
    unfold rmv_unt,
    clear hxs,
    rw nodup_cons,
    split,
    {
      intro hx,
      apply rmv_aux_not_a x xs,
      apply rmv_in,
      exact hx,
    },
    {
      apply hm, swap 3,
      exact (rmv_unt_aux x xs).length,
      rw ← hl,
      rw length_cons,
      have hxs := rmv_aux_smaller x xs,
      linarith,
      refl,
    }
  }
end

lemma rmv_empty {A : Type} [decidable_eq A] : ∀ l : list A,
l = nil ↔ rmv_unt l = nil :=
begin
  intro l,
  split,
  {
    intro h,
    rw h,
    unfold rmv_unt,
  },
  {
    intro h,
    induction l with x xs hxs,
    refl,
    exfalso,
    unfold rmv_unt at h,
    contradiction,
  }
end

lemma rmv_head {A : Type} [decidable_eq A] [inhabited A] : ∀ l : list A,
(l ≠ nil) → (l.head = list.head (rmv_unt l)) :=
begin
  intros l hl,
  induction l with x xs hxs,
  tauto,
  unfold rmv_unt,
  simp,
end

lemma rmv_last {A : Type} [decidable_eq A] [inhabited A] : ∀ l : list A,
(l ≠ nil) → (l.ilast = list.ilast (rmv_unt l)) :=
begin
  intros l hl,
  induction l with x xs hxs,
  tauto,
  unfold rmv_unt,
  by_cases hs : xs = nil,
  {
    rw hs,
    unfold rmv_unt_aux rmv_unt,
  },
  {
    specialize hxs hs,
    repeat {rw ilast_eq_last'},
    have h1 := last'_append_of_ne_nil [x] hs,
  }
end
end aux_walk


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

universes u u_1

namespace Mathlib

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

namespace AddCommGroup

/--
Construct limit data for a binary product in `AddCommGroup`, using `AddCommGroup.of (G × H)`.
-/
def binary_product_limit_cone (G : AddCommGroup) (H : AddCommGroup) :
    category_theory.limits.limit_cone (category_theory.limits.pair G H) :=
  category_theory.limits.limit_cone.mk
    (category_theory.limits.cone.mk (of (↥G × ↥H))
      (category_theory.nat_trans.mk
        fun (j : category_theory.discrete category_theory.limits.walking_pair) =>
          category_theory.limits.walking_pair.cases_on j (add_monoid_hom.fst ↥G ↥H)
            (add_monoid_hom.snd ↥G ↥H)))
    (category_theory.limits.is_limit.mk
      fun (s : category_theory.limits.cone (category_theory.limits.pair G H)) =>
        add_monoid_hom.prod
          (category_theory.nat_trans.app (category_theory.limits.cone.π s)
            category_theory.limits.walking_pair.left)
          (category_theory.nat_trans.app (category_theory.limits.cone.π s)
            category_theory.limits.walking_pair.right))

protected instance has_binary_product (G : AddCommGroup) (H : AddCommGroup) :
    category_theory.limits.has_binary_product G H :=
  category_theory.limits.has_limit.mk (binary_product_limit_cone G H)

protected instance category_theory.limits.has_binary_biproduct (G : AddCommGroup)
    (H : AddCommGroup) : category_theory.limits.has_binary_biproduct G H :=
  category_theory.limits.has_binary_biproduct.of_has_binary_product G H

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

-- Furthermore, our biproduct will automatically function as a coproduct.

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 {J : Type u} (F : category_theory.discrete J ⥤ AddCommGroup)
    (s : category_theory.limits.cone F) :
    category_theory.limits.cone.X s ⟶
        of ((j : category_theory.discrete J) → ↥(category_theory.functor.obj F j)) :=
  add_monoid_hom.mk
    (fun (x : ↥(category_theory.limits.cone.X s)) (j : category_theory.discrete J) =>
      coe_fn (category_theory.nat_trans.app (category_theory.limits.cone.π s) j) x)
    sorry sorry

@[simp] theorem lift_apply {J : Type u} (F : category_theory.discrete J ⥤ AddCommGroup)
    (s : category_theory.limits.cone F) (x : ↥(category_theory.limits.cone.X s)) (j : J) :
    coe_fn (lift F s) x j =
        coe_fn (category_theory.nat_trans.app (category_theory.limits.cone.π s) j) x :=
  rfl

/--
Construct limit data for a product in `AddCommGroup`, using `AddCommGroup.of (Π j, F.obj j)`.
-/
def product_limit_cone {J : Type u} (F : category_theory.discrete J ⥤ AddCommGroup) :
    category_theory.limits.limit_cone F :=
  category_theory.limits.limit_cone.mk
    (category_theory.limits.cone.mk
      (of ((j : category_theory.discrete J) → ↥(category_theory.functor.obj F j)))
      (category_theory.discrete.nat_trans
        fun (j : category_theory.discrete J) =>
          add_monoid_hom.apply
            (fun (j : category_theory.discrete J) => ↥(category_theory.functor.obj F j)) j))
    (category_theory.limits.is_limit.mk (lift F))

end has_limit

protected instance category_theory.limits.has_biproduct {J : Type u} [DecidableEq J] [fintype J]
    (f : J → AddCommGroup) : category_theory.limits.has_biproduct f :=
  category_theory.limits.has_biproduct.of_has_product f

/--
We verify that the biproduct we've just defined is isomorphic to the AddCommGroup structure
on the dependent function type
-/
def biproduct_iso_pi {J : Type u} [DecidableEq J] [fintype J] (f : J → AddCommGroup) :
    ⨁ f ≅ of ((j : J) → ↥(f j)) :=
  category_theory.limits.is_limit.cone_point_unique_up_to_iso
    (category_theory.limits.biproduct.is_limit f)
    (category_theory.limits.limit_cone.is_limit
      (has_limit.product_limit_cone (category_theory.discrete.functor f)))

protected instance category_theory.limits.has_finite_biproducts :
    category_theory.limits.has_finite_biproducts AddCommGroup :=
  category_theory.limits.has_finite_biproducts.mk
    fun (J : Type u_1) (_x : DecidableEq J) (_x_1 : fintype J) =>
      category_theory.limits.has_biproducts_of_shape.mk
        fun (f : J → AddCommGroup) => category_theory.limits.has_biproduct f

end Mathlib