/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
prelude
import Fixtures.Termination.Init.Prelude
set_option linter.all false -- prevent error messages from runFrontend

/-!
# Coercion

Lean uses a somewhat elaborate system of typeclasses to drive the coercion system.
Here a *coercion* means an invisible function that is automatically inserted
to fix what would otherwise be a type error. For example, if we have:
```
def f (x : Nat) : Int := x
```
then this is clearly not type correct as is, because `x` has type `Nat` but
type `Int` is expected, and normally you will get an error message saying exactly that.
But before it shows that message, it will attempt to synthesize an instance of
`CoeT Nat x Int`, which will end up going through all the other typeclasses defined
below, to discover that there is an instance of `Coe Nat Int` defined.

This instance is defined as:
```
instance : Coe Nat Int := ⟨Int.ofNat⟩
```
so Lean will elaborate the original function `f` as if it said:
```
def f (x : Nat) : Int := Int.ofNat x
```
which is not a type error anymore.

You can also use the `↑` operator to explicitly indicate a coercion. Using `↑x`
instead of `x` in the example will result in the same output.

Because there are many polymorphic functions in Lean, it is often ambiguous where
the coercion can go. For example:
```
def f (x y : Nat) : Int := x + y
```
This could be either `↑x + ↑y` where `+` is the addition on `Int`, or `↑(x + y)`
where `+` is addition on `Nat`, or even `x + y` using a heterogeneous addition
with the type `Nat → Nat → Int`. You can use the `↑` operator to disambiguate
between these possibilities, but generally Lean will elaborate working from the
"outside in", meaning that it will first look at the expression `_ + _ : Int`
and assign the `+` to be the one for `Int`, and then need to insert coercions
for the subterms `↑x : Int` and `↑y : Int`, resulting in the `↑x + ↑y` version.

Note that unlike most operators like `+`, `↑` is always eagerly unfolded at
parse time into its definition. So if we look at the definition of `f` from
before, we see no trace of the `CoeT.coe` function:
```
def f (x : Nat) : Int := x
#print f
-- def f : Nat → Int :=
-- fun (x : Nat) => Int.ofNat x
```

## Important typeclasses

Lean resolves a coercion by either inserting a `CoeDep` instance
or chaining `CoeHead? CoeOut* Coe* CoeTail?` instances.
(That is, zero or one `CoeHead` instances, an arbitrary number of `CoeOut`
instances, etc.)

The `CoeHead? CoeOut*` instances are chained from the "left" side.
So if Lean looks for a coercion from `Nat` to `Int`, it starts by trying coerce
`Nat` using `CoeHead` by looking for a `CoeHead Nat ?α` instance, and then
continuing with `CoeOut`.  Similarly `Coe* CoeTail?` are chained from the "right".

These classes should be implemented for coercions:

* `Coe α β` is the most basic class, and the usual one you will want to use
  when implementing a coercion for your own types.
  The variables in the type `α` must be a subset of the variables in `β`
  (or out-params of type class parameters),
  because `Coe` is chained right-to-left.

* `CoeOut α β` is like `Coe α β` but chained left-to-right.
  Use this if the variables in the type `α` are a superset of the variables in `β`.

* `CoeTail α β` is like `Coe α β`, but only applied once.
  Use this for coercions that would cause loops, like `[Ring R] → CoeTail Nat R`.

* `CoeHead α β` is similar to `CoeOut α β`, but only applied once.
  Use this for coercions that would cause loops, like `[SetLike S α] → CoeHead S (Set α)`.

* `CoeDep α (x : α) β` allows `β` to depend not only on `α` but on the value
  `x : α` itself. This is useful when the coercion function is dependent.
  An example of a dependent coercion is the instance for `Prop → Bool`, because
  it only holds for `Decidable` propositions. It is defined as:
  ```
  instance (p : Prop) [Decidable p] : CoeDep Prop p Bool := ...
  ```

* `CoeFun α (γ : α → Sort v)` is a coercion to a function. `γ a` should be a
  (coercion-to-)function type, and this is triggered whenever an element
  `f : α` appears in an application like `f x` which would not make sense since
  `f` does not have a function type.
  `CoeFun` instances apply to `CoeOut` as well.

* `CoeSort α β` is a coercion to a sort. `β` must be a universe, and if
  `a : α` appears in a place where a type is expected, like `(x : a)` or `a → a`.
  `CoeSort` instances apply to `CoeOut` as well.

On top of these instances this file defines several auxiliary type classes:
  * `CoeTC := Coe*`
  * `CoeOTC := CoeOut* Coe*`
  * `CoeHTC := CoeHead? CoeOut* Coe*`
  * `CoeHTCT := CoeHead? CoeOut* Coe* CoeTail?`
  * `CoeDep := CoeHead? CoeOut* Coe* CoeTail? | CoeDep`

-/

universe u v w w'

/--
`Coe α β` is the typeclass for coercions from `α` to `β`. It can be transitively
chained with other `Coe` instances, and coercion is automatically used when
`x` has type `α` but it is used in a context where `β` is expected.
You can use the `↑x` operator to explicitly trigger coercion.
-/
class Coe (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] Coe.coe

/--
Auxiliary class implementing `Coe*`.
Users should generally not implement this directly.
-/
class CoeTC (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeTC.coe

instance [Coe β γ] [CoeTC α β] : CoeTC α γ where coe a := Coe.coe (CoeTC.coe a : β)
instance [Coe α β] : CoeTC α β where coe a := Coe.coe a
instance : CoeTC α α where coe a := a

/--
`CoeOut α β` is for coercions that are applied from left-to-right.
-/
class CoeOut (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeOut.coe

/--
Auxiliary class implementing `CoeOut* Coe*`.
Users should generally not implement this directly.
-/
class CoeOTC (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeOTC.coe

instance [CoeOut α β] [CoeOTC β γ] : CoeOTC α γ where coe a := CoeOTC.coe (CoeOut.coe a : β)
instance [CoeTC α β] : CoeOTC α β where coe a := CoeTC.coe a
instance : CoeOTC α α where coe a := a

-- Note: ^^ We add reflexivity instances for CoeOTC/etc. so that we avoid going
-- through a user-defined CoeTC/etc. instance.  (Instances like
-- `CoeTC F (A →+ B)` apply even when the two sides are defeq.)

/--
`CoeHead α β` is for coercions that are applied from left-to-right at most once
at beginning of the coercion chain.
-/
class CoeHead (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeHead.coe

/--
Auxiliary class implementing `CoeHead CoeOut* Coe*`.
Users should generally not implement this directly.
-/
class CoeHTC (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeHTC.coe

instance [CoeHead α β] [CoeOTC β γ] : CoeHTC α γ where coe a := CoeOTC.coe (CoeHead.coe a : β)
instance [CoeOTC α β] : CoeHTC α β where coe a := CoeOTC.coe a
instance : CoeHTC α α where coe a := a

/--
`CoeTail α β` is for coercions that can only appear at the end of a
sequence of coercions. That is, `α` can be further coerced via `Coe σ α` and
`CoeHead τ σ` instances but `β` will only be the expected type of the expression.
-/
class CoeTail (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeTail.coe

/--
Auxiliary class implementing `CoeHead* Coe* CoeTail?`.
Users should generally not implement this directly.
-/
class CoeHTCT (α : Sort u) (β : Sort v) where
  /-- Coerces a value of type `α` to type `β`. Accessible by the notation `↑x`,
  or by double type ascription `((x : α) : β)`. -/
  coe : α → β
attribute [coe_decl] CoeHTCT.coe

instance [CoeTail β γ] [CoeHTC α β] : CoeHTCT α γ where coe a := CoeTail.coe (CoeHTC.coe a : β)
instance [CoeHTC α β] : CoeHTCT α β where coe a := CoeHTC.coe a
instance : CoeHTCT α α where coe a := a

/--
`CoeDep α (x : α) β` is a typeclass for dependent coercions, that is, the type `β`
can depend on `x` (or rather, the value of `x` is available to typeclass search
so an instance that relates `β` to `x` is allowed).

Dependent coercions do not participate in the transitive chaining process of
regular coercions: they must exactly match the type mismatch on both sides.
-/
class CoeDep (α : Sort u) (_ : α) (β : Sort v) where
  /-- The resulting value of type `β`. The input `x : α` is a parameter to
  the type class, so the value of type `β` may possibly depend on additional
  typeclasses on `x`. -/
  coe : β
attribute [coe_decl] CoeDep.coe

/--
`CoeT` is the core typeclass which is invoked by Lean to resolve a type error.
It can also be triggered explicitly with the notation `↑x` or by double type
ascription `((x : α) : β)`.

A `CoeT` chain has the grammar `CoeHead? CoeOut* Coe* CoeTail? | CoeDep`.
-/
class CoeT (α : Sort u) (_ : α) (β : Sort v) where
  /-- The resulting value of type `β`. The input `x : α` is a parameter to
  the type class, so the value of type `β` may possibly depend on additional
  typeclasses on `x`. -/
  coe : β
attribute [coe_decl] CoeT.coe

instance [CoeHTCT α β] : CoeT α a β where coe := CoeHTCT.coe a
instance [CoeDep α a β] : CoeT α a β where coe := CoeDep.coe a
instance : CoeT α a α where coe := a

/--
`CoeFun α (γ : α → Sort v)` is a coercion to a function. `γ a` should be a
(coercion-to-)function type, and this is triggered whenever an element
`f : α` appears in an application like `f x` which would not make sense since
`f` does not have a function type. This is automatically turned into `CoeFun.coe f x`.
-/
class CoeFun (α : Sort u) (γ : outParam (α → Sort v)) where
  /-- Coerces a value `f : α` to type `γ f`, which should be either be a
  function type or another `CoeFun` type, in order to resolve a mistyped
  application `f x`. -/
  coe : (f : α) → γ f
attribute [coe_decl] CoeFun.coe

instance [CoeFun α fun _ => β] : CoeOut α β where coe a := CoeFun.coe a

/--
`CoeSort α β` is a coercion to a sort. `β` must be a universe, and if
`a : α` appears in a place where a type is expected, like `(x : a)` or `a → a`,
then it will be turned into `(x : CoeSort.coe a)`.
-/
class CoeSort (α : Sort u) (β : outParam (Sort v)) where
  /-- Coerces a value of type `α` to `β`, which must be a universe. -/
  coe : α → β
attribute [coe_decl] CoeSort.coe

instance [CoeSort α β] : CoeOut α β where coe a := CoeSort.coe a

/--
`↑x` represents a coercion, which converts `x` of type `α` to type `β`, using
typeclasses to resolve a suitable conversion function. You can often leave the
`↑` off entirely, since coercion is triggered implicitly whenever there is a
type error, but in ambiguous cases it can be useful to use `↑` to disambiguate
between e.g. `↑x + ↑y` and `↑(x + y)`.
-/
syntax:1024 (name := coeNotation) "↑" term:1024 : term

/-! # Basic instances -/

instance boolToProp : Coe Bool Prop where
  coe b := Eq b true

instance boolToSort : CoeSort Bool Prop where
  coe b := b

instance decPropToBool (p : Prop) [Decidable p] : CoeDep Prop p Bool where
  coe := decide p

instance optionCoe {α : Type u} : Coe α (Option α) where
  coe := some

instance subtypeCoe {α : Sort u} {p : α → Prop} : CoeOut (Subtype p) α where
  coe v := v.val

/-! # Coe bridge -/

/--
Helper definition used by the elaborator. It is not meant to be used directly by users.

This is used for coercions between monads, in the case where we want to apply
a monad lift and a coercion on the result type at the same time.
-/
@[inline, coe_decl] def Lean.Internal.liftCoeM {m : Type u → Type v} {n : Type u → Type w} {α β : Type u}
    [MonadLiftT m n] [∀ a, CoeT α a β] [Monad n] (x : m α) : n β := do
  let a ← liftM x
  pure (CoeT.coe a)

/--
Helper definition used by the elaborator. It is not meant to be used directly by users.

This is used for coercing the result type under a monad.
-/
@[inline, coe_decl] def Lean.Internal.coeM {m : Type u → Type v} {α β : Type u}
    [∀ a, CoeT α a β] [Monad m] (x : m α) : m β := do
  let a ← x
  pure (CoeT.coe a)


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.measure.measure_space

/-!
# Almost everywhere measurable functions

A function is almost everywhere measurable if it coincides almost everywhere with a measurable
function. This property, called `ae_measurable f μ`, is defined in the file `measure_space_def`.
We discuss several of its properties that are analogous to properties of measurable functions.
-/

open measure_theory measure_theory.measure filter set function
open_locale measure_theory filter classical ennreal interval

variables {ι α β γ δ R : Type*} {m0 : measurable_space α} [measurable_space β]
   [measurable_space γ] [measurable_space δ] {f g : α → β} {μ ν : measure α}

include m0

section

@[nontriviality, measurability]
lemma subsingleton.ae_measurable [subsingleton α] : ae_measurable f μ :=
subsingleton.measurable.ae_measurable

@[nontriviality, measurability]
lemma ae_measurable_of_subsingleton_codomain [subsingleton β] : ae_measurable f μ :=
(measurable_of_subsingleton_codomain f).ae_measurable

@[simp, measurability] lemma ae_measurable_zero_measure : ae_measurable f (0 : measure α) :=
begin
  nontriviality α, inhabit α,
  exact ⟨λ x, f default, measurable_const, rfl⟩
end

namespace ae_measurable

lemma mono_measure (h : ae_measurable f μ) (h' : ν ≤ μ) : ae_measurable f ν :=
⟨h.mk f, h.measurable_mk, eventually.filter_mono (ae_mono h') h.ae_eq_mk⟩

protected lemma mono' (h : ae_measurable f μ) (h' : ν ≪ μ) : ae_measurable f ν :=
⟨h.mk f, h.measurable_mk, h' h.ae_eq_mk⟩

lemma ae_mem_imp_eq_mk {s} (h : ae_measurable f (μ.restrict s)) :
  ∀ᵐ x ∂μ, x ∈ s → f x = h.mk f x :=
ae_imp_of_ae_restrict h.ae_eq_mk

lemma ae_inf_principal_eq_mk {s} (h : ae_measurable f (μ.restrict s)) :
  f =ᶠ[μ.ae ⊓ 𝓟 s] h.mk f :=
le_ae_restrict h.ae_eq_mk

@[measurability]
lemma sum_measure [countable ι] {μ : ι → measure α} (h : ∀ i, ae_measurable f (μ i)) :
  ae_measurable f (sum μ) :=
begin
  nontriviality β, inhabit β,
  set s : ι → set α := λ i, to_measurable (μ i) {x | f x ≠ (h i).mk f x},
  have hsμ : ∀ i, μ i (s i) = 0,
  { intro i, rw measure_to_measurable, exact (h i).ae_eq_mk },
  have hsm : measurable_set (⋂ i, s i),
    from measurable_set.Inter (λ i, measurable_set_to_measurable _ _),
  have hs : ∀ i x, x ∉ s i → f x = (h i).mk f x,
  { intros i x hx, contrapose! hx, exact subset_to_measurable _ _ hx },
  set g : α → β := (⋂ i, s i).piecewise (const α default) f,
  refine ⟨g, measurable_of_restrict_of_restrict_compl hsm _ _, ae_sum_iff.mpr $ λ i, _⟩,
  { rw [restrict_piecewise], simp only [set.restrict, const], exact measurable_const },
  { rw [restrict_piecewise_compl, compl_Inter],
    intros t ht,
    refine ⟨⋃ i, ((h i).mk f ⁻¹' t) ∩ (s i)ᶜ, measurable_set.Union $
      λ i, (measurable_mk _ ht).inter (measurable_set_to_measurable _ _).compl, _⟩,
    ext ⟨x, hx⟩,
    simp only [mem_preimage, mem_Union, subtype.coe_mk, set.restrict, mem_inter_iff,
      mem_compl_iff] at hx ⊢,
    split,
    { rintro ⟨i, hxt, hxs⟩, rwa hs _ _ hxs },
    { rcases hx with ⟨i, hi⟩, rw hs _ _ hi, exact λ h, ⟨i, h, hi⟩ } },
  { refine measure_mono_null (λ x (hx : f x ≠ g x), _) (hsμ i),
    contrapose! hx, refine (piecewise_eq_of_not_mem _ _ _ _).symm,
    exact λ h, hx (mem_Inter.1 h i) }
end

@[simp] lemma _root_.ae_measurable_sum_measure_iff [countable ι] {μ : ι → measure α} :
  ae_measurable f (sum μ) ↔ ∀ i, ae_measurable f (μ i) :=
⟨λ h i, h.mono_measure (le_sum _ _), sum_measure⟩

@[simp] lemma _root_.ae_measurable_add_measure_iff :
  ae_measurable f (μ + ν) ↔ ae_measurable f μ ∧ ae_measurable f ν :=
by { rw [← sum_cond, ae_measurable_sum_measure_iff, bool.forall_bool, and.comm], refl }

@[measurability]
lemma add_measure {f : α → β} (hμ : ae_measurable f μ) (hν : ae_measurable f ν) :
  ae_measurable f (μ + ν) :=
ae_measurable_add_measure_iff.2 ⟨hμ, hν⟩

@[measurability]
protected lemma Union [countable ι] {s : ι → set α} (h : ∀ i, ae_measurable f (μ.restrict (s i))) :
  ae_measurable f (μ.restrict (⋃ i, s i)) :=
(sum_measure h).mono_measure $ restrict_Union_le

@[simp] lemma _root_.ae_measurable_Union_iff [countable ι] {s : ι → set α} :
  ae_measurable f (μ.restrict (⋃ i, s i)) ↔ ∀ i, ae_measurable f (μ.restrict (s i)) :=
⟨λ h i, h.mono_measure $ restrict_mono (subset_Union _ _) le_rfl, ae_measurable.Union⟩

@[simp] lemma _root_.ae_measurable_union_iff {s t : set α} :
  ae_measurable f (μ.restrict (s ∪ t)) ↔
    ae_measurable f (μ.restrict s) ∧ ae_measurable f (μ.restrict t) :=
by simp only [union_eq_Union, ae_measurable_Union_iff, bool.forall_bool, cond, and.comm]

@[measurability]
lemma smul_measure [monoid R] [distrib_mul_action R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
  (h : ae_measurable f μ) (c : R) :
  ae_measurable f (c • μ) :=
⟨h.mk f, h.measurable_mk, ae_smul_measure h.ae_eq_mk c⟩

lemma comp_ae_measurable {f : α → δ} {g : δ → β}
  (hg : ae_measurable g (μ.map f)) (hf : ae_measurable f μ) : ae_measurable (g ∘ f) μ :=
⟨hg.mk g ∘ hf.mk f, hg.measurable_mk.comp hf.measurable_mk,
  (ae_eq_comp hf hg.ae_eq_mk).trans ((hf.ae_eq_mk).fun_comp (mk g hg))⟩

lemma comp_measurable {f : α → δ} {g : δ → β}
  (hg : ae_measurable g (μ.map f)) (hf : measurable f) : ae_measurable (g ∘ f) μ :=
hg.comp_ae_measurable hf.ae_measurable

lemma comp_quasi_measure_preserving {ν : measure δ} {f : α → δ} {g : δ → β} (hg : ae_measurable g ν)
  (hf : quasi_measure_preserving f μ ν) : ae_measurable (g ∘ f) μ :=
(hg.mono' hf.absolutely_continuous).comp_measurable hf.measurable

lemma map_map_of_ae_measurable {g : β → γ} {f : α → β}
  (hg : ae_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
  (μ.map f).map g = μ.map (g ∘ f) :=
begin
  ext1 s hs,
  let g' := hg.mk g,
  have A : map g (map f μ) = map g' (map f μ),
  { apply measure_theory.measure.map_congr,
    exact hg.ae_eq_mk },
  have B : map (g ∘ f) μ = map (g' ∘ f) μ,
  { apply measure_theory.measure.map_congr,
    exact ae_of_ae_map hf hg.ae_eq_mk },
  simp only [A, B, hs, hg.measurable_mk.ae_measurable.comp_ae_measurable hf, hg.measurable_mk,
    hg.measurable_mk hs, hf, map_apply, map_apply_of_ae_measurable],
  refl,
end

@[measurability]
lemma prod_mk {f : α → β} {g : α → γ} (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (λ x, (f x, g x)) μ :=
⟨λ a, (hf.mk f a, hg.mk g a), hf.measurable_mk.prod_mk hg.measurable_mk,
  eventually_eq.prod_mk hf.ae_eq_mk hg.ae_eq_mk⟩

lemma exists_ae_eq_range_subset (H : ae_measurable f μ) {t : set β} (ht : ∀ᵐ x ∂μ, f x ∈ t)
  (h₀ : t.nonempty) :
  ∃ g, measurable g ∧ range g ⊆ t ∧ f =ᵐ[μ] g :=
begin
  let s : set α := to_measurable μ {x | f x = H.mk f x ∧ f x ∈ t}ᶜ,
  let g : α → β := piecewise s (λ x, h₀.some) (H.mk f),
  refine ⟨g, _, _, _⟩,
  { exact measurable.piecewise (measurable_set_to_measurable _ _)
      measurable_const H.measurable_mk },
  { rintros _ ⟨x, rfl⟩,
    by_cases hx : x ∈ s,
    { simpa [g, hx] using h₀.some_mem },
    { simp only [g, hx, piecewise_eq_of_not_mem, not_false_iff],
      contrapose! hx,
      apply subset_to_measurable,
      simp only [hx, mem_compl_iff, mem_set_of_eq, not_and, not_false_iff, implies_true_iff]
        {contextual := tt} } },
  { have A : μ (to_measurable μ {x | f x = H.mk f x ∧ f x ∈ t}ᶜ) = 0,
    { rw [measure_to_measurable, ← compl_mem_ae_iff, compl_compl],
      exact H.ae_eq_mk.and ht },
    filter_upwards [compl_mem_ae_iff.2 A] with x hx,
    rw mem_compl_iff at hx,
    simp only [g, hx, piecewise_eq_of_not_mem, not_false_iff],
    contrapose! hx,
    apply subset_to_measurable,
    simp only [hx, mem_compl_iff, mem_set_of_eq, false_and, not_false_iff] }
end

lemma exists_measurable_nonneg {β} [preorder β] [has_zero β] {mβ : measurable_space β} {f : α → β}
  (hf : ae_measurable f μ) (f_nn : ∀ᵐ t ∂μ, 0 ≤ f t) :
  ∃ g, measurable g ∧ 0 ≤ g ∧ f =ᵐ[μ] g :=
begin
  obtain ⟨G, hG_meas, hG_mem, hG_ae_eq⟩ := hf.exists_ae_eq_range_subset f_nn ⟨0, le_rfl⟩,
  exact ⟨G, hG_meas, λ x, hG_mem (mem_range_self x), hG_ae_eq⟩,
end

lemma subtype_mk (h : ae_measurable f μ) {s : set β} {hfs : ∀ x, f x ∈ s} :
  ae_measurable (cod_restrict f s hfs) μ :=
begin
  nontriviality α, inhabit α,
  obtain ⟨g, g_meas, hg, fg⟩ : ∃ (g : α → β), measurable g ∧ range g ⊆ s ∧ f =ᵐ[μ] g :=
    h.exists_ae_eq_range_subset (eventually_of_forall hfs) ⟨_, hfs default⟩,
  refine ⟨cod_restrict g s (λ x, hg (mem_range_self _)), measurable.subtype_mk g_meas, _⟩,
  filter_upwards [fg] with x hx,
  simpa [subtype.ext_iff],
end

protected lemma null_measurable (h : ae_measurable f μ) : null_measurable f μ :=
let ⟨g, hgm, hg⟩ := h in hgm.null_measurable.congr hg.symm

end ae_measurable

lemma ae_measurable_const' (h : ∀ᵐ x y ∂μ, f x = f y) : ae_measurable f μ :=
begin
  rcases eq_or_ne μ 0 with rfl | hμ,
  { exact ae_measurable_zero_measure },
  { haveI := ae_ne_bot.2 hμ,
    rcases h.exists with ⟨x, hx⟩,
    exact ⟨const α (f x), measurable_const, eventually_eq.symm hx⟩ }
end

lemma ae_measurable_uIoc_iff [linear_order α] {f : α → β} {a b : α} :
  (ae_measurable f $ μ.restrict $ Ι a b) ↔
    (ae_measurable f $ μ.restrict $ Ioc a b) ∧ (ae_measurable f $ μ.restrict $ Ioc b a) :=
by rw [uIoc_eq_union, ae_measurable_union_iff]

lemma ae_measurable_iff_measurable [μ.is_complete] :
  ae_measurable f μ ↔ measurable f :=
⟨λ h, h.null_measurable.measurable_of_complete, λ h, h.ae_measurable⟩

lemma measurable_embedding.ae_measurable_map_iff {g : β → γ} (hf : measurable_embedding f) :
  ae_measurable g (μ.map f) ↔ ae_measurable (g ∘ f) μ :=
begin
  refine ⟨λ H, H.comp_measurable hf.measurable, _⟩,
  rintro ⟨g₁, hgm₁, heq⟩,
  rcases hf.exists_measurable_extend hgm₁ (λ x, ⟨g x⟩) with ⟨g₂, hgm₂, rfl⟩,
  exact ⟨g₂, hgm₂, hf.ae_map_iff.2 heq⟩
end

lemma measurable_embedding.ae_measurable_comp_iff {g : β → γ}
  (hg : measurable_embedding g) {μ : measure α} :
  ae_measurable (g ∘ f) μ ↔ ae_measurable f μ :=
begin
  refine ⟨λ H, _, hg.measurable.comp_ae_measurable⟩,
  suffices : ae_measurable ((range_splitting g ∘ range_factorization g) ∘ f) μ,
    by rwa [(right_inverse_range_splitting hg.injective).comp_eq_id] at this,
  exact hg.measurable_range_splitting.comp_ae_measurable H.subtype_mk
end

lemma ae_measurable_restrict_iff_comap_subtype {s : set α} (hs : measurable_set s)
  {μ : measure α} {f : α → β} :
  ae_measurable f (μ.restrict s) ↔ ae_measurable (f ∘ coe : s → β) (comap coe μ) :=
by rw [← map_comap_subtype_coe hs, (measurable_embedding.subtype_coe hs).ae_measurable_map_iff]

@[simp, to_additive] lemma ae_measurable_one [has_one β] : ae_measurable (λ a : α, (1 : β)) μ :=
measurable_one.ae_measurable

@[simp] lemma ae_measurable_smul_measure_iff {c : ℝ≥0∞} (hc : c ≠ 0) :
  ae_measurable f (c • μ) ↔ ae_measurable f μ :=
⟨λ h, ⟨h.mk f, h.measurable_mk, (ae_smul_measure_iff hc).1 h.ae_eq_mk⟩,
  λ h, ⟨h.mk f, h.measurable_mk, (ae_smul_measure_iff hc).2 h.ae_eq_mk⟩⟩

lemma ae_measurable_of_ae_measurable_trim {α} {m m0 : measurable_space α}
  {μ : measure α} (hm : m ≤ m0) {f : α → β} (hf : ae_measurable f (μ.trim hm)) :
  ae_measurable f μ :=
⟨hf.mk f, measurable.mono hf.measurable_mk hm le_rfl, ae_eq_of_ae_eq_trim hf.ae_eq_mk⟩

lemma ae_measurable_restrict_of_measurable_subtype {s : set α}
  (hs : measurable_set s) (hf : measurable (λ x : s, f x)) : ae_measurable f (μ.restrict s) :=
(ae_measurable_restrict_iff_comap_subtype hs).2 hf.ae_measurable

lemma ae_measurable_map_equiv_iff (e : α ≃ᵐ β) {f : β → γ} :
  ae_measurable f (μ.map e) ↔ ae_measurable (f ∘ e) μ :=
e.measurable_embedding.ae_measurable_map_iff

end

lemma ae_measurable.restrict (hfm : ae_measurable f μ) {s} :
  ae_measurable f (μ.restrict s) :=
⟨ae_measurable.mk f hfm, hfm.measurable_mk, ae_restrict_of_ae hfm.ae_eq_mk⟩

lemma ae_measurable_Ioi_of_forall_Ioc {β} {mβ : measurable_space β}
  [linear_order α] [(at_top : filter α).is_countably_generated] {x : α} {g : α → β}
  (g_meas : ∀ t > x, ae_measurable g (μ.restrict (Ioc x t))) :
  ae_measurable g (μ.restrict (Ioi x)) :=
begin
  haveI : nonempty α := ⟨x⟩,
  obtain ⟨u, hu_tendsto⟩ := exists_seq_tendsto (at_top : filter α),
  have Ioi_eq_Union : Ioi x = ⋃ n : ℕ, Ioc x (u n),
  { rw Union_Ioc_eq_Ioi_self_iff.mpr _,
    exact λ y _, (hu_tendsto.eventually (eventually_ge_at_top y)).exists },
  rw [Ioi_eq_Union, ae_measurable_Union_iff],
  intros n,
  cases lt_or_le x (u n),
  { exact g_meas (u n) h, },
  { rw [Ioc_eq_empty (not_lt.mpr h), measure.restrict_empty],
    exact ae_measurable_zero_measure, },
end

variables [has_zero β]

lemma ae_measurable_indicator_iff {s} (hs : measurable_set s) :
  ae_measurable (indicator s f) μ ↔ ae_measurable f (μ.restrict s) :=
begin
  split,
  { intro h,
    exact (h.mono_measure measure.restrict_le_self).congr (indicator_ae_eq_restrict hs) },
  { intro h,
    refine ⟨indicator s (h.mk f), h.measurable_mk.indicator hs, _⟩,
    have A : s.indicator f =ᵐ[μ.restrict s] s.indicator (ae_measurable.mk f h) :=
      (indicator_ae_eq_restrict hs).trans (h.ae_eq_mk.trans $ (indicator_ae_eq_restrict hs).symm),
    have B : s.indicator f =ᵐ[μ.restrict sᶜ] s.indicator (ae_measurable.mk f h) :=
      (indicator_ae_eq_restrict_compl hs).trans (indicator_ae_eq_restrict_compl hs).symm,
    exact ae_of_ae_restrict_of_ae_restrict_compl _ A B },
end

@[measurability]
lemma ae_measurable.indicator (hfm : ae_measurable f μ) {s} (hs : measurable_set s) :
  ae_measurable (s.indicator f) μ :=
(ae_measurable_indicator_iff hs).mpr hfm.restrict

lemma measure_theory.measure.restrict_map_of_ae_measurable
  {f : α → δ} (hf : ae_measurable f μ) {s : set δ} (hs : measurable_set s) :
  (μ.map f).restrict s = (μ.restrict $ f ⁻¹' s).map f :=
calc
(μ.map f).restrict s = (μ.map (hf.mk f)).restrict s :
  by { congr' 1, apply measure.map_congr hf.ae_eq_mk }
... = (μ.restrict $ (hf.mk f) ⁻¹' s).map (hf.mk f) :
  measure.restrict_map hf.measurable_mk hs
... = (μ.restrict $ (hf.mk f) ⁻¹' s).map f :
  measure.map_congr (ae_restrict_of_ae (hf.ae_eq_mk.symm))
... = (μ.restrict $ f ⁻¹' s).map f :
begin
  apply congr_arg,
  ext1 t ht,
  simp only [ht, measure.restrict_apply],
  apply measure_congr,
  apply (eventually_eq.refl _ _).inter (hf.ae_eq_mk.symm.preimage s)
end

lemma measure_theory.measure.map_mono_of_ae_measurable
  {f : α → δ} (h : μ ≤ ν) (hf : ae_measurable f ν) :
  μ.map f ≤ ν.map f :=
λ s hs, by simpa [hf, hs, hf.mono_measure h] using measure.le_iff'.1 h (f ⁻¹' s)


/-
Copyright (c) 2019 Jesse Han. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jesse Han

Some goodies for working with `omitted`

- `depends_omitted e` checks if `omitted` occurs in `e`. it will unfold one layer of
  proof terms (e.g. a propositional field of a structure being checked) and check if
  `omitted` occurs in those proof terms

- `omitted` tries to close a propositional goal with `exact omitted`

- `omit_proofs` tries to close any visible goals with the `omitted` tactic

- `tidy_omitted` runs `tidy` and lets it use `omitted` (and still produces proof traces).
  `tidy_omitted` will always attempt to split existential statements and sigma-types in the goal,   and will fill in as little data as possible (it is not allowed to use assumption,
   solve_by_elim, simp, or dsimp)

   if it has used `omitted`, `tidy` will emit a trace urging the user to replace
   the call to `tidy_omitted` with the proof trace generated by
   `tidy_omitted {trace_result := tt}
-/

import tactic.tidy ..basic tactic.explode

section omitted_tactics
open tactic

/-- Check if the goal is a proposition; if so, prove it using omitted.

    When called with "tidy using omitted", tidy will run as usual and fulfill all
    proof obligations using omitted, leaving it to the user to specify the data. -/
meta def tactic.interactive.omitted : tactic unit :=
  propositional_goal >> `[exact omitted] <|> tactic.fail "Goal is not a proposition and cannot be omitted"

meta def tactic.interactive.omit_proofs : tactic unit := `[all_goals {try {omitted}}]

meta def tactic.verbose_omitted : tactic string :=
tactic.interactive.omitted >> tactic.trace "`tidy` used `omitted`, please replace this call to `tidy_omitted` with the output of {trace_result := tt}"
                           >> return "omitted"

open tactic.tidy

meta def omitted_default_tactics : list (tactic string) :=
[ reflexivity                                 >> pure "refl",
  `[exact dec_trivial]                        >> pure "exact dec_trivial",
  -- propositional_goal >> assumption            >> pure "assumption",
  ext1_wrapper,
  intros1                                     >>= λ ns, pure ("intros " ++ (" ".intercalate (ns.map (λ e, e.to_string)))),
  auto_cases,
  `[apply_auto_param]                         >> pure "apply_auto_param",
  -- `[dsimp at *]                               >> pure "dsimp at *",
  -- `[simp at *]                                >> pure "simp at *",
  fsplit                                      >> pure "fsplit",
  injections_and_clear                        >> pure "injections_and_clear",
  -- propositional_goal >> (`[solve_by_elim])    >> pure "solve_by_elim",2

  `[unfold_aux]                               >> pure "unfold_aux",--
  -- tidy.run_tactics
  tactic.verbose_omitted ]

meta structure omitted_cfg :=
(trace_result : bool            := ff)
(trace_result_prefix : string   := "/- `tidy` says -/ ")
(tactics : list (tactic string) := omitted_default_tactics)

meta def cfg_of_omitted_cfg : omitted_cfg → cfg :=
λ X, { trace_result := X.trace_result,
  trace_result_prefix := X.trace_result_prefix,
  tactics := X.tactics }

/- Calls tidy, but with `omitted` thrown into the tactic list.

  tidy {trace_result := tt}` produces a proof trace as usual.-/
meta def tactic.interactive.tidy_omitted (cfg : omitted_cfg := {}): tactic unit :=
tidy (cfg_of_omitted_cfg cfg)

end omitted_tactics

section depends_omitted_cmd
open tactic expr

meta def extract_proof_names_aux : ∀(e : expr) (l : list name), tactic (list name)
| (const a b) l := do b <- infer_type (const a b) >>= is_prop,
                      if b then return (a::l) else return l
| e l := return l

meta def extract_proof_names (e : expr) : tactic $ list name :=
  e.mfold [] (λ e n l₁, extract_proof_names_aux e l₁)

meta def depends_omitted_aux (n : name) : tactic expr :=
do const n _ ← resolve_name n | fail "cannot resolve name",
  d ← get_decl n,
  e ← match d with
  | (declaration.defn _ _ _ e _ _) := return e
  | (declaration.thm _ _ _ e)      := return e.get
  | _                  := fail "not a definition"
  end, return e

meta def depends_omitted_aux' (n : name) : tactic expr :=
do const n _ ← resolve_name n | fail "cannot resolve name",
  d ← get_decl n,
  e ← (match d with
  | (declaration.defn _ _ _ e _ _) := return e
  | (declaration.thm _ _ _ e)      := return e.get
  | _                  := fail "not a definition"
  end) <|> return expr.inhabited.default, return e

meta def depends_omitted (n : name) : tactic unit :=
do e <- depends_omitted_aux n,
   o <- to_expr ``(omitted),
   ls <- (extract_proof_names e) >>= λ l, l.mmap depends_omitted_aux',
   b_l <- ls.mfoldr (λ e b, (kdepends_on e o) >>= return ∘ (bor b)) ff,
   b <- kdepends_on e o,
   if (bor b b_l) then trace (n ++ " directly depends on `omitted`") else
                       trace (n ++ " does not directly depend on `omitted`")

open interactive lean lean.parser interaction_monad.result

@[user_command] meta def depends_omitted_cmd (_ : parse $ tk "#depends_omitted") : lean.parser unit :=
do n ← ident,
  depends_omitted n

end depends_omitted_cmd

/- Tests -/
-- section test0
-- lemma test : 1 + 1 = 2 := by omitted

-- noncomputable def test' : ℕ := classical.choice $ by omitted

-- structure test_structure :=
-- (x : ℕ)

-- noncomputable def test'' : test_structure :=
-- ⟨test'⟩

-- #depends_omitted test
-- --test. directly depends on `omitted`

-- #depends_omitted test'
-- --test'. directly depends on `omitted`

-- #depends_omitted test''
-- --test''. does not directly depend on `omitted`

-- end test0

-- section test1

-- variable {α : Type*}
-- variable (P : α → Prop)
-- variable (a : α)

-- open vector

-- example : vector α 1 ≃ α :=
-- begin
--  split, omit_proofs,
--  from λ x, ⟨[x], dec_trivial⟩,
--  from λ x, x.head
-- end

-- /- In this example, (a : α) is in context, but `tidy_omitted` refuses to use it -/
-- include a
-- example : Σ' a : α, P a := -- by {tidy_omitted, exact a}
-- by {/- `tidy` says -/ fsplit, work_on_goal 1 { omitted }, exact a}
-- end test1

-- section test2
-- private def is_even (n : ℕ) := ∃ k, 2 * k = n

-- private lemma test : ∃ m : ℕ, is_even m :=
-- begin
--  tidy_omitted, exact 2
-- end

-- private lemma test'' : ∃ m, is_even m :=
-- by {use 2, use 1, refl}

-- -- #print test''

-- -- #print test
-- /-
-- 92:1: theorem test : ∃ (m : ℕ), is_even m :=
-- id (Exists.intro (2 * 2) (Exists.intro 2 (eq.refl (2 * 2))))
-- -/

-- private lemma test' : ∃ m, is_even m := by omitted

-- -- #print test'
-- /-
-- 100:1: theorem hewwo' : ∃ (m : ℕ), is_even m :=
-- omitted
-- -/

-- end test2


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.measure.measure_space

/-!
# Almost everywhere measurable functions

A function is almost everywhere measurable if it coincides almost everywhere with a measurable
function. This property, called `ae_measurable f μ`, is defined in the file `measure_space_def`.
We discuss several of its properties that are analogous to properties of measurable functions.
-/

open measure_theory measure_theory.measure filter set function
open_locale measure_theory filter classical ennreal interval

variables {ι α β γ δ R : Type*} {m0 : measurable_space α} [measurable_space β]
   [measurable_space γ] [measurable_space δ] {f g : α → β} {μ ν : measure α}

include m0

section

@[nontriviality, measurability]
lemma subsingleton.ae_measurable [subsingleton α] : ae_measurable f μ :=
subsingleton.measurable.ae_measurable

@[nontriviality, measurability]
lemma ae_measurable_of_subsingleton_codomain [subsingleton β] : ae_measurable f μ :=
(measurable_of_subsingleton_codomain f).ae_measurable

@[simp, measurability] lemma ae_measurable_zero_measure : ae_measurable f (0 : measure α) :=
begin
  nontriviality α, inhabit α,
  exact ⟨λ x, f default, measurable_const, rfl⟩
end

namespace ae_measurable

lemma mono_measure (h : ae_measurable f μ) (h' : ν ≤ μ) : ae_measurable f ν :=
⟨h.mk f, h.measurable_mk, eventually.filter_mono (ae_mono h') h.ae_eq_mk⟩

protected lemma mono' (h : ae_measurable f μ) (h' : ν ≪ μ) : ae_measurable f ν :=
⟨h.mk f, h.measurable_mk, h' h.ae_eq_mk⟩

lemma ae_mem_imp_eq_mk {s} (h : ae_measurable f (μ.restrict s)) :
  ∀ᵐ x ∂μ, x ∈ s → f x = h.mk f x :=
ae_imp_of_ae_restrict h.ae_eq_mk

lemma ae_inf_principal_eq_mk {s} (h : ae_measurable f (μ.restrict s)) :
  f =ᶠ[μ.ae ⊓ 𝓟 s] h.mk f :=
le_ae_restrict h.ae_eq_mk

@[measurability]
lemma sum_measure [encodable ι] {μ : ι → measure α} (h : ∀ i, ae_measurable f (μ i)) :
  ae_measurable f (sum μ) :=
begin
  nontriviality β, inhabit β,
  set s : ι → set α := λ i, to_measurable (μ i) {x | f x ≠ (h i).mk f x},
  have hsμ : ∀ i, μ i (s i) = 0,
  { intro i, rw measure_to_measurable, exact (h i).ae_eq_mk },
  have hsm : measurable_set (⋂ i, s i),
    from measurable_set.Inter (λ i, measurable_set_to_measurable _ _),
  have hs : ∀ i x, x ∉ s i → f x = (h i).mk f x,
  { intros i x hx, contrapose! hx, exact subset_to_measurable _ _ hx },
  set g : α → β := (⋂ i, s i).piecewise (const α default) f,
  refine ⟨g, measurable_of_restrict_of_restrict_compl hsm _ _, ae_sum_iff.mpr $ λ i, _⟩,
  { rw [restrict_piecewise], simp only [set.restrict, const], exact measurable_const },
  { rw [restrict_piecewise_compl, compl_Inter],
    intros t ht,
    refine ⟨⋃ i, ((h i).mk f ⁻¹' t) ∩ (s i)ᶜ, measurable_set.Union $
      λ i, (measurable_mk _ ht).inter (measurable_set_to_measurable _ _).compl, _⟩,
    ext ⟨x, hx⟩,
    simp only [mem_preimage, mem_Union, subtype.coe_mk, set.restrict, mem_inter_eq,
      mem_compl_iff] at hx ⊢,
    split,
    { rintro ⟨i, hxt, hxs⟩, rwa hs _ _ hxs },
    { rcases hx with ⟨i, hi⟩, rw hs _ _ hi, exact λ h, ⟨i, h, hi⟩ } },
  { refine measure_mono_null (λ x (hx : f x ≠ g x), _) (hsμ i),
    contrapose! hx, refine (piecewise_eq_of_not_mem _ _ _ _).symm,
    exact λ h, hx (mem_Inter.1 h i) }
end

@[simp] lemma _root_.ae_measurable_sum_measure_iff [encodable ι] {μ : ι → measure α} :
  ae_measurable f (sum μ) ↔ ∀ i, ae_measurable f (μ i) :=
⟨λ h i, h.mono_measure (le_sum _ _), sum_measure⟩

@[simp] lemma _root_.ae_measurable_add_measure_iff :
  ae_measurable f (μ + ν) ↔ ae_measurable f μ ∧ ae_measurable f ν :=
by { rw [← sum_cond, ae_measurable_sum_measure_iff, bool.forall_bool, and.comm], refl }

@[measurability]
lemma add_measure {f : α → β} (hμ : ae_measurable f μ) (hν : ae_measurable f ν) :
  ae_measurable f (μ + ν) :=
ae_measurable_add_measure_iff.2 ⟨hμ, hν⟩

@[measurability]
protected lemma Union [encodable ι] {s : ι → set α} (h : ∀ i, ae_measurable f (μ.restrict (s i))) :
  ae_measurable f (μ.restrict (⋃ i, s i)) :=
(sum_measure h).mono_measure $ restrict_Union_le

@[simp] lemma _root_.ae_measurable_Union_iff [encodable ι] {s : ι → set α} :
  ae_measurable f (μ.restrict (⋃ i, s i)) ↔ ∀ i, ae_measurable f (μ.restrict (s i)) :=
⟨λ h i, h.mono_measure $ restrict_mono (subset_Union _ _) le_rfl, ae_measurable.Union⟩

@[simp] lemma _root_.ae_measurable_union_iff {s t : set α} :
  ae_measurable f (μ.restrict (s ∪ t)) ↔
    ae_measurable f (μ.restrict s) ∧ ae_measurable f (μ.restrict t) :=
by simp only [union_eq_Union, ae_measurable_Union_iff, bool.forall_bool, cond, and.comm]

@[measurability]
lemma smul_measure [monoid R] [distrib_mul_action R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
  (h : ae_measurable f μ) (c : R) :
  ae_measurable f (c • μ) :=
⟨h.mk f, h.measurable_mk, ae_smul_measure h.ae_eq_mk c⟩

lemma comp_ae_measurable {f : α → δ} {g : δ → β}
  (hg : ae_measurable g (μ.map f)) (hf : ae_measurable f μ) : ae_measurable (g ∘ f) μ :=
⟨hg.mk g ∘ hf.mk f, hg.measurable_mk.comp hf.measurable_mk,
  (ae_eq_comp hf hg.ae_eq_mk).trans ((hf.ae_eq_mk).fun_comp (mk g hg))⟩

lemma comp_measurable {f : α → δ} {g : δ → β}
  (hg : ae_measurable g (μ.map f)) (hf : measurable f) : ae_measurable (g ∘ f) μ :=
hg.comp_ae_measurable hf.ae_measurable

lemma comp_measurable' {ν : measure δ} {f : α → δ} {g : δ → β} (hg : ae_measurable g ν)
  (hf : measurable f) (h : μ.map f ≪ ν) : ae_measurable (g ∘ f) μ :=
(hg.mono' h).comp_measurable hf

lemma map_map_of_ae_measurable {g : β → γ} {f : α → β}
  (hg : ae_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
  (μ.map f).map g = μ.map (g ∘ f) :=
begin
  ext1 s hs,
  let g' := hg.mk g,
  have A : map g (map f μ) = map g' (map f μ),
  { apply measure_theory.measure.map_congr,
    exact hg.ae_eq_mk },
  have B : map (g ∘ f) μ = map (g' ∘ f) μ,
  { apply measure_theory.measure.map_congr,
    exact ae_of_ae_map hf hg.ae_eq_mk },
  simp only [A, B, hs, hg.measurable_mk.ae_measurable.comp_ae_measurable hf, hg.measurable_mk,
    hg.measurable_mk hs, hf, map_apply, map_apply_of_ae_measurable],
  refl,
end

@[measurability]
lemma prod_mk {f : α → β} {g : α → γ} (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (λ x, (f x, g x)) μ :=
⟨λ a, (hf.mk f a, hg.mk g a), hf.measurable_mk.prod_mk hg.measurable_mk,
  eventually_eq.prod_mk hf.ae_eq_mk hg.ae_eq_mk⟩

lemma exists_ae_eq_range_subset (H : ae_measurable f μ) {t : set β} (ht : ∀ᵐ x ∂μ, f x ∈ t)
  (h₀ : t.nonempty) :
  ∃ g, measurable g ∧ range g ⊆ t ∧ f =ᵐ[μ] g :=
begin
  let s : set α := to_measurable μ {x | f x = H.mk f x ∧ f x ∈ t}ᶜ,
  let g : α → β := piecewise s (λ x, h₀.some) (H.mk f),
  refine ⟨g, _, _, _⟩,
  { exact measurable.piecewise (measurable_set_to_measurable _ _)
      measurable_const H.measurable_mk },
  { rintros _ ⟨x, rfl⟩,
    by_cases hx : x ∈ s,
    { simpa [g, hx] using h₀.some_mem },
    { simp only [g, hx, piecewise_eq_of_not_mem, not_false_iff],
      contrapose! hx,
      apply subset_to_measurable,
      simp only [hx, mem_compl_eq, mem_set_of_eq, not_and, not_false_iff, implies_true_iff]
        {contextual := tt} } },
  { have A : μ (to_measurable μ {x | f x = H.mk f x ∧ f x ∈ t}ᶜ) = 0,
    { rw [measure_to_measurable, ← compl_mem_ae_iff, compl_compl],
      exact H.ae_eq_mk.and ht },
    filter_upwards [compl_mem_ae_iff.2 A] with x hx,
    rw mem_compl_iff at hx,
    simp only [g, hx, piecewise_eq_of_not_mem, not_false_iff],
    contrapose! hx,
    apply subset_to_measurable,
    simp only [hx, mem_compl_eq, mem_set_of_eq, false_and, not_false_iff] }
end

lemma subtype_mk (h : ae_measurable f μ) {s : set β} {hfs : ∀ x, f x ∈ s} :
  ae_measurable (cod_restrict f s hfs) μ :=
begin
  nontriviality α, inhabit α,
  obtain ⟨g, g_meas, hg, fg⟩ : ∃ (g : α → β), measurable g ∧ range g ⊆ s ∧ f =ᵐ[μ] g :=
    h.exists_ae_eq_range_subset (eventually_of_forall hfs) ⟨_, hfs default⟩,
  refine ⟨cod_restrict g s (λ x, hg (mem_range_self _)), measurable.subtype_mk g_meas, _⟩,
  filter_upwards [fg] with x hx,
  simpa [subtype.ext_iff],
end

protected lemma null_measurable (h : ae_measurable f μ) : null_measurable f μ :=
let ⟨g, hgm, hg⟩ := h in hgm.null_measurable.congr hg.symm

end ae_measurable

lemma ae_measurable_interval_oc_iff [linear_order α] {f : α → β} {a b : α} :
  (ae_measurable f $ μ.restrict $ Ι a b) ↔
    (ae_measurable f $ μ.restrict $ Ioc a b) ∧ (ae_measurable f $ μ.restrict $ Ioc b a) :=
by rw [interval_oc_eq_union, ae_measurable_union_iff]

lemma ae_measurable_iff_measurable [μ.is_complete] :
  ae_measurable f μ ↔ measurable f :=
⟨λ h, h.null_measurable.measurable_of_complete, λ h, h.ae_measurable⟩

lemma measurable_embedding.ae_measurable_map_iff {g : β → γ} (hf : measurable_embedding f) :
  ae_measurable g (μ.map f) ↔ ae_measurable (g ∘ f) μ :=
begin
  refine ⟨λ H, H.comp_measurable hf.measurable, _⟩,
  rintro ⟨g₁, hgm₁, heq⟩,
  rcases hf.exists_measurable_extend hgm₁ (λ x, ⟨g x⟩) with ⟨g₂, hgm₂, rfl⟩,
  exact ⟨g₂, hgm₂, hf.ae_map_iff.2 heq⟩
end

lemma measurable_embedding.ae_measurable_comp_iff {g : β → γ}
  (hg : measurable_embedding g) {μ : measure α} :
  ae_measurable (g ∘ f) μ ↔ ae_measurable f μ :=
begin
  refine ⟨λ H, _, hg.measurable.comp_ae_measurable⟩,
  suffices : ae_measurable ((range_splitting g ∘ range_factorization g) ∘ f) μ,
    by rwa [(right_inverse_range_splitting hg.injective).comp_eq_id] at this,
  exact hg.measurable_range_splitting.comp_ae_measurable H.subtype_mk
end

lemma ae_measurable_restrict_iff_comap_subtype {s : set α} (hs : measurable_set s)
  {μ : measure α} {f : α → β} :
  ae_measurable f (μ.restrict s) ↔ ae_measurable (f ∘ coe : s → β) (comap coe μ) :=
by rw [← map_comap_subtype_coe hs, (measurable_embedding.subtype_coe hs).ae_measurable_map_iff]

@[simp, to_additive] lemma ae_measurable_one [has_one β] : ae_measurable (λ a : α, (1 : β)) μ :=
measurable_one.ae_measurable

@[simp] lemma ae_measurable_smul_measure_iff {c : ℝ≥0∞} (hc : c ≠ 0) :
  ae_measurable f (c • μ) ↔ ae_measurable f μ :=
⟨λ h, ⟨h.mk f, h.measurable_mk, (ae_smul_measure_iff hc).1 h.ae_eq_mk⟩,
  λ h, ⟨h.mk f, h.measurable_mk, (ae_smul_measure_iff hc).2 h.ae_eq_mk⟩⟩

lemma ae_measurable_of_ae_measurable_trim {α} {m m0 : measurable_space α}
  {μ : measure α} (hm : m ≤ m0) {f : α → β} (hf : ae_measurable f (μ.trim hm)) :
  ae_measurable f μ :=
⟨hf.mk f, measurable.mono hf.measurable_mk hm le_rfl, ae_eq_of_ae_eq_trim hf.ae_eq_mk⟩

lemma ae_measurable_restrict_of_measurable_subtype {s : set α}
  (hs : measurable_set s) (hf : measurable (λ x : s, f x)) : ae_measurable f (μ.restrict s) :=
(ae_measurable_restrict_iff_comap_subtype hs).2 hf.ae_measurable

lemma ae_measurable_map_equiv_iff (e : α ≃ᵐ β) {f : β → γ} :
  ae_measurable f (μ.map e) ↔ ae_measurable (f ∘ e) μ :=
e.measurable_embedding.ae_measurable_map_iff

end

lemma ae_measurable.restrict (hfm : ae_measurable f μ) {s} :
  ae_measurable f (μ.restrict s) :=
⟨ae_measurable.mk f hfm, hfm.measurable_mk, ae_restrict_of_ae hfm.ae_eq_mk⟩

variables [has_zero β]

lemma ae_measurable_indicator_iff {s} (hs : measurable_set s) :
  ae_measurable (indicator s f) μ ↔ ae_measurable f (μ.restrict s) :=
begin
  split,
  { intro h,
    exact (h.mono_measure measure.restrict_le_self).congr (indicator_ae_eq_restrict hs) },
  { intro h,
    refine ⟨indicator s (h.mk f), h.measurable_mk.indicator hs, _⟩,
    have A : s.indicator f =ᵐ[μ.restrict s] s.indicator (ae_measurable.mk f h) :=
      (indicator_ae_eq_restrict hs).trans (h.ae_eq_mk.trans $ (indicator_ae_eq_restrict hs).symm),
    have B : s.indicator f =ᵐ[μ.restrict sᶜ] s.indicator (ae_measurable.mk f h) :=
      (indicator_ae_eq_restrict_compl hs).trans (indicator_ae_eq_restrict_compl hs).symm,
    exact ae_of_ae_restrict_of_ae_restrict_compl _ A B },
end

@[measurability]
lemma ae_measurable.indicator (hfm : ae_measurable f μ) {s} (hs : measurable_set s) :
  ae_measurable (s.indicator f) μ :=
(ae_measurable_indicator_iff hs).mpr hfm.restrict

lemma measure_theory.measure.restrict_map_of_ae_measurable
  {f : α → δ} (hf : ae_measurable f μ) {s : set δ} (hs : measurable_set s) :
  (μ.map f).restrict s = (μ.restrict $ f ⁻¹' s).map f :=
calc
(μ.map f).restrict s = (μ.map (hf.mk f)).restrict s :
  by { congr' 1, apply measure.map_congr hf.ae_eq_mk }
... = (μ.restrict $ (hf.mk f) ⁻¹' s).map (hf.mk f) :
  measure.restrict_map hf.measurable_mk hs
... = (μ.restrict $ (hf.mk f) ⁻¹' s).map f :
  measure.map_congr (ae_restrict_of_ae (hf.ae_eq_mk.symm))
... = (μ.restrict $ f ⁻¹' s).map f :
begin
  apply congr_arg,
  ext1 t ht,
  simp only [ht, measure.restrict_apply],
  apply measure_congr,
  apply (eventually_eq.refl _ _).inter (hf.ae_eq_mk.symm.preimage s)
end

lemma measure_theory.measure.map_mono_of_ae_measurable
  {f : α → δ} (h : μ ≤ ν) (hf : ae_measurable f ν) :
  μ.map f ≤ ν.map f :=
λ s hs, by simpa [hf, hs, hf.mono_measure h] using measure.le_iff'.1 h (f ⁻¹' s)


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import category_theory.category

/-!
# Tools to reformulate category-theoretic axioms in a more associativity-friendly way

## The `reassoc` attribute

The `reassoc` attribute can be applied to a lemma

```lean
@[reassoc]
lemma some_lemma : foo ≫ bar = baz := ...
```

and produce

```lean
lemma some_lemma_assoc {Y : C} (f : X ⟶ Y) : foo ≫ bar ≫ f = baz ≫ f := ...
```

The name of the produced lemma can be specified with `@[reassoc other_lemma_name]`. If
`simp` is added first, the generated lemma will also have the `simp` attribute.

## The `reassoc_axiom` command

When declaring a class of categories, the axioms can be reformulated to be more amenable
to manipulation in right associated expressions:

```lean
class some_class (C : Type) [category C] :=
(foo : Π X : C, X ⟶ X)
(bar : ∀ {X Y : C} (f : X ⟶ Y), foo X ≫ f = f ≫ foo Y)

reassoc_axiom some_class.bar
```

Here too, the `reassoc` attribute can be used instead. It works well when combined with
`simp`:

```lean
attribute [simp, reassoc] some_class.bar
```
-/

namespace tactic

open interactive lean.parser category_theory

/-- From an expression `f ≫ g`, extract the expression representing the category instance. -/
meta def get_cat_inst : expr → tactic expr
| `(@category_struct.comp _ %%struct_inst _ _ _ _ _) := pure struct_inst
| _ := failed

/-- (internals for `@[reassoc]`)
Given a lemma of the form `∀ ..., f ≫ g = h`, proves a new lemma of the form
`h : ∀ ... {W} (k), f ≫ (g ≫ k) = h ≫ k`, and returns the type and proof of this lemma.
-/
meta def prove_reassoc (h : expr) : tactic (expr × expr) :=
do
   (vs,t) ← infer_type h >>= open_pis,
   (lhs,rhs) ← match_eq t,
   struct_inst ← get_cat_inst lhs <|> get_cat_inst rhs <|> fail "no composition found in statement",
   `(@quiver.hom _ %%hom_inst %%X %%Y) ← infer_type lhs,
   C ← infer_type X,
   X' ← mk_local' `X' binder_info.implicit C,
   ft ← to_expr ``(@quiver.hom _ %%hom_inst %%Y %%X'),
   f' ← mk_local_def `f' ft,
   t' ← to_expr ``(@category_struct.comp _ %%struct_inst _ _ _%%lhs %%f' =
                     @category_struct.comp _ %%struct_inst _ _ _ %%rhs %%f'),
   let c' := h.mk_app vs,
   (_,pr) ← solve_aux t' (rewrite_target c'; reflexivity),
   pr ← instantiate_mvars pr,
   let s := simp_lemmas.mk,
   s ← s.add_simp ``category.assoc,
   s ← s.add_simp ``category.id_comp,
   s ← s.add_simp ``category.comp_id,
   (t'', pr', _) ← simplify s [] t',
   pr' ← mk_eq_mp pr' pr,
   t'' ← pis (vs ++ [X',f']) t'',
   pr' ← lambdas (vs ++ [X',f']) pr',
   pure (t'',pr')

/-- (implementation for `@[reassoc]`)
Given a declaration named `n` of the form `∀ ..., f ≫ g = h`, proves a new lemma named `n'`
of the form `∀ ... {W} (k), f ≫ (g ≫ k) = h ≫ k`.
-/
meta def reassoc_axiom (n : name) (n' : name := n.append_suffix "_assoc") : tactic unit :=
do d ← get_decl n,
   let ls := d.univ_params.map level.param,
   let c := @expr.const tt n ls,
   (t'',pr') ← prove_reassoc c,
   add_decl $ declaration.thm n' d.univ_params t'' (pure pr'),
   copy_attribute `simp n n'

/--
The `reassoc` attribute can be applied to a lemma

```lean
@[reassoc]
lemma some_lemma : foo ≫ bar = baz := ...
```

to produce

```lean
lemma some_lemma_assoc {Y : C} (f : X ⟶ Y) : foo ≫ bar ≫ f = baz ≫ f := ...
```

The name of the produced lemma can be specified with `@[reassoc other_lemma_name]`. If
`simp` is added first, the generated lemma will also have the `simp` attribute.
-/
@[user_attribute]
meta def reassoc_attr : user_attribute unit (option name) :=
{ name := `reassoc,
  descr := "create a companion lemma for associativity-aware rewriting",
  parser := optional ident,
  after_set := some (λ n _ _,
    do some n' ← reassoc_attr.get_param n | reassoc_axiom n (n.append_suffix "_assoc"),
       reassoc_axiom n $ n.get_prefix ++ n' ) }

add_tactic_doc
{ name                     := "reassoc",
  category                 := doc_category.attr,
  decl_names               := [`tactic.reassoc_attr],
  tags                     := ["category theory"] }

/--
When declaring a class of categories, the axioms can be reformulated to be more amenable
to manipulation in right associated expressions:

```lean
class some_class (C : Type) [category C] :=
(foo : Π X : C, X ⟶ X)
(bar : ∀ {X Y : C} (f : X ⟶ Y), foo X ≫ f = f ≫ foo Y)

reassoc_axiom some_class.bar
```

The above will produce:

```lean
lemma some_class.bar_assoc {Z : C} (g : Y ⟶ Z) :
  foo X ≫ f ≫ g = f ≫ foo Y ≫ g := ...
```

Here too, the `reassoc` attribute can be used instead. It works well when combined with
`simp`:

```lean
attribute [simp, reassoc] some_class.bar
```
-/
@[user_command]
meta def reassoc_cmd (_ : parse $ tk "reassoc_axiom") : lean.parser unit :=
do n ← ident,
   of_tactic $
   do n ← resolve_constant n,
      reassoc_axiom n

add_tactic_doc
{ name                     := "reassoc_axiom",
  category                 := doc_category.cmd,
  decl_names               := [`tactic.reassoc_cmd],
  tags                     := ["category theory"] }

namespace interactive

setup_tactic_parser

/-- `reassoc h`, for assumption `h : x ≫ y = z`, creates a new assumption
`h : ∀ {W} (f : Z ⟶ W), x ≫ y ≫ f = z ≫ f`.
`reassoc! h`, does the same but deletes the initial `h` assumption.
(You can also add the attribute `@[reassoc]` to lemmas to generate new declarations generalized
in this way.)
-/
meta def reassoc (del : parse (tk "!")?) (ns : parse ident*) : tactic unit :=
do ns.mmap' (λ n,
   do h ← get_local n,
      (t,pr) ← prove_reassoc h,
      assertv n t pr,
      when del.is_some (tactic.clear h) )

end interactive

def calculated_Prop {α} (β : Prop) (hh : α) := β

meta def derive_reassoc_proof : tactic unit :=
do `(calculated_Prop %%v %%h) ← target,
   (t,pr) ← prove_reassoc h,
   unify v t,
   exact pr

end tactic

/-- With `h : x ≫ y ≫ z = x` (with universal quantifiers tolerated),
`reassoc_of h : ∀ {X'} (f : W ⟶ X'), x ≫ y ≫ z ≫ f = x ≫ f`.

The type and proof of `reassoc_of h` is generated by `tactic.derive_reassoc_proof`
which make `reassoc_of` meta-programming adjacent. It is not called as a tactic but as
an expression. The goal is to avoid creating assumptions that are dismissed after one use:

```lean
example (X Y Z W : C) (x : X ⟶ Y) (y : Y ⟶ Z) (z z' : Z ⟶ W) (w : X ⟶ Z)
  (h : x ≫ y = w)
  (h' : y ≫ z = y ≫ z') :
  x ≫ y ≫ z = w ≫ z' :=
begin
  rw [h',reassoc_of h],
end
```
-/
theorem category_theory.reassoc_of {α} (hh : α) {β}
  (x : tactic.calculated_Prop β hh . tactic.derive_reassoc_proof) : β := x

/--
`reassoc_of h` takes local assumption `h` and add a ` ≫ f` term on the right of
both sides of the equality. Instead of creating a new assumption from the result, `reassoc_of h`
stands for the proof of that reassociated statement. This keeps complicated assumptions that are
used only once or twice from polluting the local context.

In the following, assumption `h` is needed in a reassociated form. Instead of proving it as a new
goal and adding it as an assumption, we use `reassoc_of h` as a rewrite rule which works just as
well.

```lean
example (X Y Z W : C) (x : X ⟶ Y) (y : Y ⟶ Z) (z z' : Z ⟶ W) (w : X ⟶ Z)
  (h : x ≫ y = w)
  (h' : y ≫ z = y ≫ z') :
  x ≫ y ≫ z = w ≫ z' :=
begin
  -- reassoc_of h : ∀ {X' : C} (f : W ⟶ X'), x ≫ y ≫ f = w ≫ f
  rw [h',reassoc_of h],
end
```

Although `reassoc_of` is not a tactic or a meta program, its type is generated
through meta-programming to make it usable inside normal expressions.
-/
add_tactic_doc
{ name                     := "category_theory.reassoc_of",
  category                 := doc_category.tactic,
  decl_names               := [`category_theory.reassoc_of],
  tags                     := ["category theory"] }