/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.measure.measure_space

/-!
# Typeclasses for measurability of operations

In this file we define classes `has_measurable_mul` etc and prove dot-style lemmas
(`measurable.mul`, `ae_measurable.mul` etc). For binary operations we define two typeclasses:

- `has_measurable_mul` says that both left and right multiplication are measurable;
- `has_measurable_mul₂` says that `λ p : α × α, p.1 * p.2` is measurable,

and similarly for other binary operations. The reason for introducing these classes is that in case
of topological space `α` equipped with the Borel `σ`-algebra, instances for `has_measurable_mul₂`
etc require `α` to have a second countable topology.

We define separate classes for `has_measurable_div`/`has_measurable_sub`
because on some types (e.g., `ℕ`, `ℝ≥0∞`) division and/or subtraction are not defined as `a * b⁻¹` /
`a + (-b)`.

For instances relating, e.g., `has_continuous_mul` to `has_measurable_mul` see file
`measure_theory.borel_space`.

## Implementation notes

For the heuristics of `@[to_additive]` it is important that the type with a multiplication
(or another multiplicative operations) is the first (implicit) argument of all declarations.

## Tags

measurable function, arithmetic operator

## Todo

* Uniformize the treatment of `pow` and `smul`.
* Use `@[to_additive]` to send `has_measurable_pow` to `has_measurable_smul₂`.
* This might require changing the definition (swapping the arguments in the function that is
  in the conclusion of `measurable_smul`.)
-/

universes u v

open_locale big_operators pointwise
open measure_theory

/-!
### Binary operations: `(+)`, `(*)`, `(-)`, `(/)`
-/

/-- We say that a type `has_measurable_add` if `((+) c)` and `(+ c)` are measurable functions.
For a typeclass assuming measurability of `uncurry (+)` see `has_measurable_add₂`. -/
class has_measurable_add (M : Type*) [measurable_space M] [has_add M] : Prop :=
(measurable_const_add : ∀ c : M, measurable ((+) c))
(measurable_add_const : ∀ c : M, measurable (+ c))

/-- We say that a type `has_measurable_add` if `uncurry (+)` is a measurable functions.
For a typeclass assuming measurability of `((+) c)` and `(+ c)` see `has_measurable_add`. -/
class has_measurable_add₂ (M : Type*) [measurable_space M] [has_add M] : Prop :=
(measurable_add : measurable (λ p : M × M, p.1 + p.2))

export has_measurable_add₂ (measurable_add)
  has_measurable_add (measurable_const_add measurable_add_const)

/-- We say that a type `has_measurable_mul` if `((*) c)` and `(* c)` are measurable functions.
For a typeclass assuming measurability of `uncurry (*)` see `has_measurable_mul₂`. -/
@[to_additive]
class has_measurable_mul (M : Type*) [measurable_space M] [has_mul M] : Prop :=
(measurable_const_mul : ∀ c : M, measurable ((*) c))
(measurable_mul_const : ∀ c : M, measurable (* c))

/-- We say that a type `has_measurable_mul` if `uncurry (*)` is a measurable functions.
For a typeclass assuming measurability of `((*) c)` and `(* c)` see `has_measurable_mul`. -/
@[to_additive has_measurable_add₂]
class has_measurable_mul₂ (M : Type*) [measurable_space M] [has_mul M] : Prop :=
(measurable_mul : measurable (λ p : M × M, p.1 * p.2))

export has_measurable_mul₂ (measurable_mul)
  has_measurable_mul (measurable_const_mul measurable_mul_const)

section mul

variables {M α : Type*} [measurable_space M] [has_mul M] [measurable_space α]

@[to_additive, measurability]
lemma measurable.const_mul [has_measurable_mul M] {f : α → M} (hf : measurable f) (c : M) :
  measurable (λ x, c * f x) :=
(measurable_const_mul c).comp hf

@[to_additive, measurability]
lemma ae_measurable.const_mul [has_measurable_mul M] {f : α → M} {μ : measure α}
  (hf : ae_measurable f μ) (c : M) :
  ae_measurable (λ x, c * f x) μ :=
(has_measurable_mul.measurable_const_mul c).comp_ae_measurable hf

@[to_additive, measurability]
lemma measurable.mul_const [has_measurable_mul M] {f : α → M} (hf : measurable f) (c : M) :
  measurable (λ x, f x * c) :=
(measurable_mul_const c).comp hf

@[to_additive, measurability]
lemma ae_measurable.mul_const [has_measurable_mul M] {f : α → M} {μ : measure α}
  (hf : ae_measurable f μ) (c : M) :
  ae_measurable (λ x, f x * c) μ :=
(measurable_mul_const c).comp_ae_measurable hf

@[to_additive, measurability]
lemma measurable.mul' [has_measurable_mul₂ M] {f g : α → M} (hf : measurable f)
  (hg : measurable g) :
  measurable (f * g) :=
measurable_mul.comp (hf.prod_mk hg)

@[to_additive, measurability]
lemma measurable.mul [has_measurable_mul₂ M] {f g : α → M} (hf : measurable f) (hg : measurable g) :
  measurable (λ a, f a * g a) :=
measurable_mul.comp (hf.prod_mk hg)

@[to_additive, measurability]
lemma ae_measurable.mul' [has_measurable_mul₂ M] {μ : measure α} {f g : α → M}
  (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (f * g) μ :=
measurable_mul.comp_ae_measurable (hf.prod_mk hg)

@[to_additive, measurability]
lemma ae_measurable.mul [has_measurable_mul₂ M] {μ : measure α} {f g : α → M}
  (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (λ a, f a * g a) μ :=
measurable_mul.comp_ae_measurable (hf.prod_mk hg)

@[priority 100, to_additive]
instance has_measurable_mul₂.to_has_measurable_mul [has_measurable_mul₂ M] :
  has_measurable_mul M :=
⟨λ c, measurable_const.mul measurable_id, λ c, measurable_id.mul measurable_const⟩

attribute [measurability] measurable.add' measurable.add ae_measurable.add ae_measurable.add'
  measurable.const_add ae_measurable.const_add measurable.add_const ae_measurable.add_const

end mul

/-- This class assumes that the map `β × γ → β` given by `(x, y) ↦ x ^ y` is measurable. -/
class has_measurable_pow (β γ : Type*) [measurable_space β] [measurable_space γ] [has_pow β γ] :=
(measurable_pow : measurable (λ p : β × γ, p.1 ^ p.2))

export has_measurable_pow (measurable_pow)

instance has_measurable_mul.has_measurable_pow (M : Type*) [monoid M] [measurable_space M]
  [has_measurable_mul₂ M] : has_measurable_pow M ℕ :=
⟨begin
  haveI : measurable_singleton_class ℕ := ⟨λ _, trivial⟩,
  refine measurable_from_prod_encodable (λ n, _),
  induction n with n ih,
  { simp [pow_zero, measurable_one] },
  { simp only [pow_succ], exact measurable_id.mul ih }
end⟩

section pow

variables {β γ α : Type*} [measurable_space β] [measurable_space γ] [has_pow β γ]
  [has_measurable_pow β γ] [measurable_space α]

@[measurability]
lemma measurable.pow {f : α → β} {g : α → γ} (hf : measurable f) (hg : measurable g) :
  measurable (λ x, f x ^ g x) :=
measurable_pow.comp (hf.prod_mk hg)

@[measurability]
lemma ae_measurable.pow {μ : measure α} {f : α → β} {g : α → γ} (hf : ae_measurable f μ)
  (hg : ae_measurable g μ) :
  ae_measurable (λ x, f x ^ g x) μ :=
measurable_pow.comp_ae_measurable (hf.prod_mk hg)

@[measurability]
lemma measurable.pow_const {f : α → β} (hf : measurable f) (c : γ) :
  measurable (λ x, f x ^ c) :=
hf.pow measurable_const

@[measurability]
lemma ae_measurable.pow_const {μ : measure α} {f : α → β} (hf : ae_measurable f μ) (c : γ) :
  ae_measurable (λ x, f x ^ c) μ :=
hf.pow ae_measurable_const

@[measurability]
lemma measurable.const_pow {f : α → γ} (hf : measurable f) (c : β) :
  measurable (λ x, c ^ f x) :=
measurable_const.pow hf

@[measurability]
lemma ae_measurable.const_pow {μ : measure α} {f : α → γ} (hf : ae_measurable f μ) (c : β) :
  ae_measurable (λ x, c ^ f x) μ :=
ae_measurable_const.pow hf

end pow

/-- We say that a type `has_measurable_sub` if `(λ x, c - x)` and `(λ x, x - c)` are measurable
functions. For a typeclass assuming measurability of `uncurry (-)` see `has_measurable_sub₂`. -/
class has_measurable_sub (G : Type*) [measurable_space G] [has_sub G] : Prop :=
(measurable_const_sub : ∀ c : G, measurable (λ x, c - x))
(measurable_sub_const : ∀ c : G, measurable (λ x, x - c))

/-- We say that a type `has_measurable_sub` if `uncurry (-)` is a measurable functions.
For a typeclass assuming measurability of `((-) c)` and `(- c)` see `has_measurable_sub`. -/
class has_measurable_sub₂ (G : Type*) [measurable_space G] [has_sub G] : Prop :=
(measurable_sub : measurable (λ p : G × G, p.1 - p.2))

export has_measurable_sub₂ (measurable_sub)

/-- We say that a type `has_measurable_div` if `((/) c)` and `(/ c)` are measurable functions.
For a typeclass assuming measurability of `uncurry (/)` see `has_measurable_div₂`. -/
@[to_additive] class has_measurable_div (G₀: Type*) [measurable_space G₀] [has_div G₀] : Prop :=
(measurable_const_div : ∀ c : G₀, measurable ((/) c))
(measurable_div_const : ∀ c : G₀, measurable (/ c))

/-- We say that a type `has_measurable_div` if `uncurry (/)` is a measurable functions.
For a typeclass assuming measurability of `((/) c)` and `(/ c)` see `has_measurable_div`. -/
@[to_additive has_measurable_sub₂]
class has_measurable_div₂ (G₀: Type*) [measurable_space G₀] [has_div G₀] : Prop :=
(measurable_div : measurable (λ p : G₀× G₀, p.1 / p.2))

export has_measurable_div₂ (measurable_div)

section div

variables {G α : Type*} [measurable_space G] [has_div G] [measurable_space α]

@[to_additive, measurability]
lemma measurable.const_div [has_measurable_div G] {f : α → G} (hf : measurable f) (c : G) :
  measurable (λ x, c / f x) :=
(has_measurable_div.measurable_const_div c).comp hf

@[to_additive, measurability]
lemma ae_measurable.const_div [has_measurable_div G] {f : α → G} {μ : measure α}
  (hf : ae_measurable f μ) (c : G) :
  ae_measurable (λ x, c / f x) μ :=
(has_measurable_div.measurable_const_div c).comp_ae_measurable hf

@[to_additive, measurability]
lemma measurable.div_const [has_measurable_div G] {f : α → G} (hf : measurable f) (c : G) :
  measurable (λ x, f x / c) :=
(has_measurable_div.measurable_div_const c).comp hf

@[to_additive, measurability]
lemma ae_measurable.div_const [has_measurable_div G] {f : α → G} {μ : measure α}
  (hf : ae_measurable f μ) (c : G) :
  ae_measurable (λ x, f x / c) μ :=
(has_measurable_div.measurable_div_const c).comp_ae_measurable hf

@[to_additive, measurability]
lemma measurable.div' [has_measurable_div₂ G] {f g : α → G} (hf : measurable f)
  (hg : measurable g) :
  measurable (f / g) :=
measurable_div.comp (hf.prod_mk hg)

@[to_additive, measurability]
lemma measurable.div [has_measurable_div₂ G] {f g : α → G} (hf : measurable f) (hg : measurable g) :
  measurable (λ a, f a / g a) :=
measurable_div.comp (hf.prod_mk hg)

@[to_additive, measurability]
lemma ae_measurable.div' [has_measurable_div₂ G] {f g : α → G} {μ : measure α}
  (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (f / g) μ :=
measurable_div.comp_ae_measurable (hf.prod_mk hg)

@[to_additive, measurability]
lemma ae_measurable.div [has_measurable_div₂ G] {f g : α → G} {μ : measure α}
  (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (λ a, f a / g a) μ :=
measurable_div.comp_ae_measurable (hf.prod_mk hg)

@[priority 100, to_additive]
instance has_measurable_div₂.to_has_measurable_div [has_measurable_div₂ G] :
  has_measurable_div G :=
⟨λ c, measurable_const.div measurable_id, λ c, measurable_id.div measurable_const⟩

attribute [measurability] measurable.sub measurable.sub' ae_measurable.sub ae_measurable.sub'
  measurable.const_sub ae_measurable.const_sub measurable.sub_const ae_measurable.sub_const

@[measurability]
lemma measurable_set_eq_fun {E} [measurable_space E] [add_group E] [measurable_singleton_class E]
  [has_measurable_sub₂ E] {f g : α → E} (hf : measurable f) (hg : measurable g) :
  measurable_set {x | f x = g x} :=
begin
  suffices h_set_eq : {x : α | f x = g x} = {x | (f-g) x = (0 : E)},
  { rw h_set_eq,
    exact (hf.sub hg) measurable_set_eq, },
  ext,
  simp_rw [set.mem_set_of_eq, pi.sub_apply, sub_eq_zero],
end

lemma ae_eq_trim_of_measurable {α E} {m m0 : measurable_space α} {μ : measure α}
  [measurable_space E] [add_group E] [measurable_singleton_class E] [has_measurable_sub₂ E]
  (hm : m ≤ m0) {f g : α → E} (hf : @measurable _ _ m _ f) (hg : @measurable _ _ m _ g)
  (hfg : f =ᵐ[μ] g) :
  f =ᶠ[@measure.ae α m (μ.trim hm)] g :=
begin
  rwa [filter.eventually_eq, ae_iff, trim_measurable_set_eq hm _],
  exact (@measurable_set.compl α _ m (@measurable_set_eq_fun α m E _ _ _ _ _ _ hf hg)),
end

end div

/-- We say that a type `has_measurable_neg` if `x ↦ -x` is a measurable function. -/
class has_measurable_neg (G : Type*) [has_neg G] [measurable_space G] : Prop :=
(measurable_neg : measurable (has_neg.neg : G → G))

/-- We say that a type `has_measurable_inv` if `x ↦ x⁻¹` is a measurable function. -/
@[to_additive]
class has_measurable_inv (G : Type*) [has_inv G] [measurable_space G] : Prop :=
(measurable_inv : measurable (has_inv.inv : G → G))

export has_measurable_inv (measurable_inv) has_measurable_neg (measurable_neg)

@[priority 100, to_additive]
instance has_measurable_div_of_mul_inv (G : Type*) [measurable_space G]
  [div_inv_monoid G] [has_measurable_mul G] [has_measurable_inv G] :
  has_measurable_div G :=
{ measurable_const_div := λ c,
    by { convert (measurable_inv.const_mul c), ext1, apply div_eq_mul_inv },
  measurable_div_const := λ c,
    by { convert (measurable_id.mul_const c⁻¹), ext1, apply div_eq_mul_inv } }

section inv

variables {G α : Type*} [has_inv G] [measurable_space G] [has_measurable_inv G] [measurable_space α]

@[to_additive, measurability]
lemma measurable.inv {f : α → G} (hf : measurable f) :
  measurable (λ x, (f x)⁻¹) :=
measurable_inv.comp hf

@[to_additive, measurability]
lemma ae_measurable.inv {f : α → G} {μ : measure α} (hf : ae_measurable f μ) :
  ae_measurable (λ x, (f x)⁻¹) μ :=
measurable_inv.comp_ae_measurable hf

attribute [measurability] measurable.neg ae_measurable.neg

@[to_additive] lemma measurable_set.inv {s : set G} (hs : measurable_set s) : measurable_set s⁻¹ :=
measurable_inv hs

@[simp, to_additive] lemma measurable_inv_iff {G : Type*} [group G] [measurable_space G]
  [has_measurable_inv G] {f : α → G} : measurable (λ x, (f x)⁻¹) ↔ measurable f :=
⟨λ h, by simpa only [inv_inv] using h.inv, λ h, h.inv⟩

@[simp, to_additive] lemma ae_measurable_inv_iff {G : Type*} [group G] [measurable_space G]
  [has_measurable_inv G] {f : α → G} {μ : measure α} :
  ae_measurable (λ x, (f x)⁻¹) μ ↔ ae_measurable f μ :=
⟨λ h, by simpa only [inv_inv] using h.inv, λ h, h.inv⟩

@[simp] lemma measurable_inv_iff₀ {G₀ : Type*} [group_with_zero G₀]
  [measurable_space G₀] [has_measurable_inv G₀] {f : α → G₀} :
  measurable (λ x, (f x)⁻¹) ↔ measurable f :=
⟨λ h, by simpa only [inv_inv₀] using h.inv, λ h, h.inv⟩

@[simp] lemma ae_measurable_inv_iff₀ {G₀ : Type*} [group_with_zero G₀]
  [measurable_space G₀] [has_measurable_inv G₀] {f : α → G₀} {μ : measure α} :
  ae_measurable (λ x, (f x)⁻¹) μ ↔ ae_measurable f μ :=
⟨λ h, by simpa only [inv_inv₀] using h.inv, λ h, h.inv⟩

end inv

/- There is something extremely strange here: copy-pasting the proof of this lemma in the proof
of `has_measurable_zpow` fails, while `pp.all` does not show any difference in the goal.
Keep it as a separate lemmas as a workaround. -/
private lemma has_measurable_zpow_aux (G : Type u) [div_inv_monoid G] [measurable_space G]
  [has_measurable_mul₂ G] [has_measurable_inv G] (k : ℕ) :
  measurable (λ (x : G), x ^(-[1+ k])) :=
begin
  simp_rw [zpow_neg_succ_of_nat],
  exact (measurable_id.pow_const (k + 1)).inv
end

instance has_measurable_zpow (G : Type u) [div_inv_monoid G] [measurable_space G]
  [has_measurable_mul₂ G] [has_measurable_inv G] :
  has_measurable_pow G ℤ :=
begin
  letI : measurable_singleton_class ℤ := ⟨λ _, trivial⟩,
  constructor,
  refine measurable_from_prod_encodable (λ n, _),
  dsimp,
  apply int.cases_on n,
  { simpa using measurable_id.pow_const },
  { exact has_measurable_zpow_aux G }
end

@[priority 100, to_additive]
instance has_measurable_div₂_of_mul_inv (G : Type*) [measurable_space G]
  [div_inv_monoid G] [has_measurable_mul₂ G] [has_measurable_inv G] :
  has_measurable_div₂ G :=
⟨by { simp only [div_eq_mul_inv], exact measurable_fst.mul measurable_snd.inv }⟩

/-- We say that the action of `M` on `α` `has_measurable_vadd` if for each `c` the map `x ↦ c +ᵥ x`
is a measurable function and for each `x` the map `c ↦ c +ᵥ x` is a measurable function. -/
class has_measurable_vadd (M α : Type*) [has_vadd M α] [measurable_space M] [measurable_space α] :
  Prop :=
(measurable_const_vadd : ∀ c : M, measurable ((+ᵥ) c : α → α))
(measurable_vadd_const : ∀ x : α, measurable (λ c : M, c +ᵥ x))

/-- We say that the action of `M` on `α` `has_measurable_smul` if for each `c` the map `x ↦ c • x`
is a measurable function and for each `x` the map `c ↦ c • x` is a measurable function. -/
@[to_additive]
class has_measurable_smul (M α : Type*) [has_scalar M α] [measurable_space M] [measurable_space α] :
  Prop :=
(measurable_const_smul : ∀ c : M, measurable ((•) c : α → α))
(measurable_smul_const : ∀ x : α, measurable (λ c : M, c • x))

/-- We say that the action of `M` on `α` `has_measurable_vadd₂` if the map
`(c, x) ↦ c +ᵥ x` is a measurable function. -/
class has_measurable_vadd₂ (M α : Type*) [has_vadd M α] [measurable_space M]
  [measurable_space α] : Prop :=
(measurable_vadd : measurable (function.uncurry (+ᵥ) : M × α → α))

/-- We say that the action of `M` on `α` `has_measurable_smul₂` if the map
`(c, x) ↦ c • x` is a measurable function. -/
@[to_additive has_measurable_vadd₂]
class has_measurable_smul₂ (M α : Type*) [has_scalar M α] [measurable_space M]
  [measurable_space α] : Prop :=
(measurable_smul : measurable (function.uncurry (•) : M × α → α))

export has_measurable_smul (measurable_const_smul measurable_smul_const)
  has_measurable_smul₂ (measurable_smul)
export has_measurable_vadd (measurable_const_vadd measurable_vadd_const)
  has_measurable_vadd₂ (measurable_vadd)

@[to_additive]
instance has_measurable_smul_of_mul (M : Type*) [has_mul M] [measurable_space M]
  [has_measurable_mul M] :
  has_measurable_smul M M :=
⟨measurable_id.const_mul, measurable_id.mul_const⟩

@[to_additive]
instance has_measurable_smul₂_of_mul (M : Type*) [has_mul M] [measurable_space M]
  [has_measurable_mul₂ M] :
  has_measurable_smul₂ M M :=
⟨measurable_mul⟩

section smul

variables {M β α : Type*} [measurable_space M] [measurable_space β] [has_scalar M β]
  [measurable_space α]

@[measurability, to_additive]
lemma measurable.smul [has_measurable_smul₂ M β]
  {f : α → M} {g : α → β} (hf : measurable f) (hg : measurable g) :
  measurable (λ x, f x • g x) :=
measurable_smul.comp (hf.prod_mk hg)

@[measurability, to_additive]
lemma ae_measurable.smul [has_measurable_smul₂ M β]
  {f : α → M} {g : α → β} {μ : measure α} (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (λ x, f x • g x) μ :=
has_measurable_smul₂.measurable_smul.comp_ae_measurable (hf.prod_mk hg)

@[priority 100, to_additive]
instance has_measurable_smul₂.to_has_measurable_smul [has_measurable_smul₂ M β] :
  has_measurable_smul M β :=
⟨λ c, measurable_const.smul measurable_id, λ y, measurable_id.smul measurable_const⟩

variables [has_measurable_smul M β] {μ : measure α}

@[measurability, to_additive]
lemma measurable.smul_const {f : α → M} (hf : measurable f) (y : β) : measurable (λ x, f x • y) :=
(has_measurable_smul.measurable_smul_const y).comp hf

@[measurability, to_additive]
lemma ae_measurable.smul_const {f : α → M} (hf : ae_measurable f μ) (y : β) :
  ae_measurable (λ x, f x • y) μ :=
(has_measurable_smul.measurable_smul_const y).comp_ae_measurable hf

@[measurability, to_additive]
lemma measurable.const_smul' {f : α → β} (hf : measurable f) (c : M) :
  measurable (λ x, c • f x) :=
(has_measurable_smul.measurable_const_smul c).comp hf

@[measurability, to_additive]
lemma measurable.const_smul {f : α → β} (hf : measurable f) (c : M) :
  measurable (c • f) :=
hf.const_smul' c

@[measurability, to_additive]
lemma ae_measurable.const_smul' {f : α → β} (hf : ae_measurable f μ) (c : M) :
  ae_measurable (λ x, c • f x) μ :=
(has_measurable_smul.measurable_const_smul c).comp_ae_measurable hf

@[measurability, to_additive]
lemma ae_measurable.const_smul {f : α → β} (hf : ae_measurable f μ) (c : M) :
  ae_measurable (c • f) μ :=
hf.const_smul' c

end smul

section mul_action

variables {M β α : Type*} [measurable_space M] [measurable_space β] [monoid M] [mul_action M β]
  [has_measurable_smul M β] [measurable_space α] {f : α → β} {μ : measure α}

variables {G : Type*} [group G] [measurable_space G] [mul_action G β]
  [has_measurable_smul G β]

@[to_additive]
lemma measurable_const_smul_iff (c : G) :
  measurable (λ x, c • f x) ↔ measurable f :=
⟨λ h, by simpa only [inv_smul_smul] using h.const_smul' c⁻¹, λ h, h.const_smul c⟩

@[to_additive]
lemma ae_measurable_const_smul_iff (c : G) :
  ae_measurable (λ x, c • f x) μ ↔ ae_measurable f μ :=
⟨λ h, by simpa only [inv_smul_smul] using h.const_smul' c⁻¹, λ h, h.const_smul c⟩

@[to_additive]
instance : measurable_space (units M) := measurable_space.comap (coe : units M → M) ‹_›

@[to_additive]
instance units.has_measurable_smul : has_measurable_smul (units M) β :=
{ measurable_const_smul := λ c, (measurable_const_smul (c : M) : _),
  measurable_smul_const := λ x,
    (measurable_smul_const x : measurable (λ c : M, c • x)).comp measurable_space.le_map_comap, }

@[to_additive]
lemma is_unit.measurable_const_smul_iff {c : M} (hc : is_unit c) :
  measurable (λ x, c • f x) ↔ measurable f :=
let ⟨u, hu⟩ := hc in hu ▸ measurable_const_smul_iff u

@[to_additive]
lemma is_unit.ae_measurable_const_smul_iff {c : M} (hc : is_unit c) :
  ae_measurable (λ x, c • f x) μ ↔ ae_measurable f μ :=
let ⟨u, hu⟩ := hc in hu ▸ ae_measurable_const_smul_iff u

variables {G₀ : Type*} [group_with_zero G₀] [measurable_space G₀] [mul_action G₀ β]
  [has_measurable_smul G₀ β]

lemma measurable_const_smul_iff₀ {c : G₀} (hc : c ≠ 0) :
  measurable (λ x, c • f x) ↔ measurable f :=
(is_unit.mk0 c hc).measurable_const_smul_iff

lemma ae_measurable_const_smul_iff₀ {c : G₀} (hc : c ≠ 0) :
  ae_measurable (λ x, c • f x) μ ↔ ae_measurable f μ :=
(is_unit.mk0 c hc).ae_measurable_const_smul_iff

end mul_action

/-!
### Opposite monoid
-/

section opposite
open mul_opposite

instance {α : Type*} [h : measurable_space α] : measurable_space αᵐᵒᵖ := measurable_space.map op h

lemma measurable_op {α : Type*} [measurable_space α] : measurable (op : α → αᵐᵒᵖ) := λ s, id

lemma measurable_unop {α : Type*} [measurable_space α] : measurable (unop : αᵐᵒᵖ → α) := λ s, id

instance {M : Type*} [has_mul M] [measurable_space M] [has_measurable_mul M] :
  has_measurable_mul Mᵐᵒᵖ :=
⟨λ c, measurable_op.comp (measurable_unop.mul_const _),
  λ c, measurable_op.comp (measurable_unop.const_mul _)⟩

instance {M : Type*} [has_mul M] [measurable_space M] [has_measurable_mul₂ M] :
  has_measurable_mul₂ Mᵐᵒᵖ :=
⟨measurable_op.comp ((measurable_unop.comp measurable_snd).mul
  (measurable_unop.comp measurable_fst))⟩

instance has_measurable_smul_opposite_of_mul {M : Type*} [has_mul M] [measurable_space M]
  [has_measurable_mul M] : has_measurable_smul Mᵐᵒᵖ M :=
⟨λ c, measurable_mul_const (unop c), λ x, measurable_unop.const_mul x⟩

instance has_measurable_smul₂_opposite_of_mul {M : Type*} [has_mul M] [measurable_space M]
  [has_measurable_mul₂ M] : has_measurable_smul₂ Mᵐᵒᵖ M :=
⟨measurable_snd.mul (measurable_unop.comp measurable_fst)⟩

end opposite

/-!
### Big operators: `∏` and `∑`
-/

section monoid
variables {M α : Type*} [monoid M] [measurable_space M] [has_measurable_mul₂ M] [measurable_space α]

@[to_additive, measurability]
lemma list.measurable_prod' (l : list (α → M)) (hl : ∀ f ∈ l, measurable f) :
  measurable l.prod :=
begin
  induction l with f l ihl, { exact measurable_one },
  rw [list.forall_mem_cons] at hl,
  rw [list.prod_cons],
  exact hl.1.mul (ihl hl.2)
end

@[to_additive, measurability]
lemma list.ae_measurable_prod' {μ : measure α} (l : list (α → M))
  (hl : ∀ f ∈ l, ae_measurable f μ) : ae_measurable l.prod μ :=
begin
  induction l with f l ihl, { exact ae_measurable_one },
  rw [list.forall_mem_cons] at hl,
  rw [list.prod_cons],
  exact hl.1.mul (ihl hl.2)
end

@[to_additive, measurability]
lemma list.measurable_prod (l : list (α → M)) (hl : ∀ f ∈ l, measurable f) :
  measurable (λ x, (l.map (λ f : α → M, f x)).prod) :=
by simpa only [← pi.list_prod_apply] using l.measurable_prod' hl

@[to_additive, measurability]
lemma list.ae_measurable_prod {μ : measure α} (l : list (α → M)) (hl : ∀ f ∈ l, ae_measurable f μ) :
  ae_measurable (λ x, (l.map (λ f : α → M, f x)).prod) μ :=
by simpa only [← pi.list_prod_apply] using l.ae_measurable_prod' hl

end monoid

section comm_monoid
variables {M ι α : Type*} [comm_monoid M] [measurable_space M] [has_measurable_mul₂ M]
  [measurable_space α]

@[to_additive, measurability]
lemma multiset.measurable_prod' (l : multiset (α → M)) (hl : ∀ f ∈ l, measurable f) :
  measurable l.prod :=
by { rcases l with ⟨l⟩, simpa using l.measurable_prod' (by simpa using hl) }

@[to_additive, measurability]
lemma multiset.ae_measurable_prod' {μ : measure α} (l : multiset (α → M))
  (hl : ∀ f ∈ l, ae_measurable f μ) : ae_measurable l.prod μ :=
by { rcases l with ⟨l⟩, simpa using l.ae_measurable_prod' (by simpa using hl) }

@[to_additive, measurability]
lemma multiset.measurable_prod (s : multiset (α → M)) (hs : ∀ f ∈ s, measurable f) :
  measurable (λ x, (s.map (λ f : α → M, f x)).prod) :=
by simpa only [← pi.multiset_prod_apply] using s.measurable_prod' hs

@[to_additive, measurability]
lemma multiset.ae_measurable_prod {μ : measure α} (s : multiset (α → M))
  (hs : ∀ f ∈ s, ae_measurable f μ) : ae_measurable (λ x, (s.map (λ f : α → M, f x)).prod) μ :=
by simpa only [← pi.multiset_prod_apply] using s.ae_measurable_prod' hs

@[to_additive, measurability]
lemma finset.measurable_prod' {f : ι → α → M} (s : finset ι) (hf : ∀i ∈ s, measurable (f i)) :
  measurable (∏ i in s, f i) :=
finset.prod_induction _ _ (λ _ _, measurable.mul) (@measurable_one M _ _ _ _) hf

@[to_additive, measurability]
lemma finset.measurable_prod {f : ι → α → M} (s : finset ι) (hf : ∀i ∈ s, measurable (f i)) :
  measurable (λ a, ∏ i in s, f i a) :=
by simpa only [← finset.prod_apply] using s.measurable_prod' hf

@[to_additive, measurability]
lemma finset.ae_measurable_prod' {μ : measure α} {f : ι → α → M} (s : finset ι)
  (hf : ∀i ∈ s, ae_measurable (f i) μ) :
  ae_measurable (∏ i in s, f i) μ :=
multiset.ae_measurable_prod' _ $
  λ g hg, let ⟨i, hi, hg⟩ := multiset.mem_map.1 hg in (hg ▸ hf _ hi)

@[to_additive, measurability]
lemma finset.ae_measurable_prod {f : ι → α → M} {μ : measure α} (s : finset ι)
  (hf : ∀i ∈ s, ae_measurable (f i) μ) :
  ae_measurable (λ a, ∏ i in s, f i a) μ :=
by simpa only [← finset.prod_apply] using s.ae_measurable_prod' hf

end comm_monoid

attribute [measurability] list.measurable_sum' list.ae_measurable_sum' list.measurable_sum
  list.ae_measurable_sum multiset.measurable_sum' multiset.ae_measurable_sum'
  multiset.measurable_sum multiset.ae_measurable_sum finset.measurable_sum'
  finset.ae_measurable_sum' finset.measurable_sum finset.ae_measurable_sum


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.smodeq
import Mathlib.ring_theory.ideal.operations
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Completion of a module with respect to an ideal.

In this file we define the notions of Hausdorff, precomplete, and complete for an `R`-module `M`
with respect to an ideal `I`:

## Main definitions

- `is_Hausdorff I M`: this says that the intersection of `I^n M` is `0`.
- `is_precomplete I M`: this says that every Cauchy sequence converges.
- `is_adic_complete I M`: this says that `M` is Hausdorff and precomplete.
- `Hausdorffification I M`: this is the universal Hausdorff module with a map from `M`.
- `completion I M`: if `I` is finitely generated, then this is the universal complete module (TODO)
  with a map from `M`. This map is injective iff `M` is Hausdorff and surjective iff `M` is
  precomplete.

-/

/-- A module `M` is Hausdorff with respect to an ideal `I` if `⋂ I^n M = 0`. -/
def is_Hausdorff {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] :=
  ∀ (x : M), (∀ (n : ℕ), smodeq (I ^ n • ⊤) x 0) → x = 0

/-- A module `M` is precomplete with respect to an ideal `I` if every Cauchy sequence converges. -/
def is_precomplete {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] :=
  ∀ (f : ℕ → M), (∀ {m n : ℕ}, m ≤ n → smodeq (I ^ m • ⊤) (f m) (f n)) → ∃ (L : M), ∀ (n : ℕ), smodeq (I ^ n • ⊤) (f n) L

/-- A module `M` is `I`-adically complete if it is Hausdorff and precomplete. -/
def is_adic_complete {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] :=
  is_Hausdorff I M ∧ is_precomplete I M

/-- The Hausdorffification of a module with respect to an ideal. -/
def Hausdorffification {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] :=
  submodule.quotient (infi fun (n : ℕ) => I ^ n • ⊤)

/-- The completion of a module with respect to an ideal. This is not necessarily Hausdorff.
In fact, this is only complete if the ideal is finitely generated. -/
def adic_completion {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] : submodule R ((n : ℕ) → submodule.quotient (I ^ n • ⊤)) :=
  submodule.mk
    (set_of
      fun (f : (n : ℕ) → submodule.quotient (I ^ n • ⊤)) =>
        ∀ {m n : ℕ}, m ≤ n → coe_fn (submodule.liftq (I ^ n • ⊤) (submodule.mkq (I ^ m • ⊤)) sorry) (f n) = f m)
    sorry sorry sorry

namespace is_Hausdorff

protected instance bot {R : Type u_1} [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] : is_Hausdorff ⊥ M :=
  fun (x : M) (hx : ∀ (n : ℕ), smodeq (⊥ ^ n • ⊤) x 0) =>
    eq.mpr (id (Eq.refl (x = 0)))
      (eq.mp
        (Eq.trans
          ((fun (U U_1 : submodule R M) (e_1 : U = U_1) (x x_1 : M) (e_2 : x = x_1) (y y_1 : M) (e_3 : y = y_1) =>
              congr (congr (congr_arg smodeq e_1) e_2) e_3)
            (⊥ ^ 1 • ⊤) ⊥
            (Eq.trans
              ((fun (ᾰ ᾰ_1 : ideal R) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : submodule R M) (e_3 : ᾰ_2 = ᾰ_3) =>
                  congr (congr_arg has_scalar.smul e_2) e_3)
                (⊥ ^ 1) ⊥ (pow_one ⊥) ⊤ ⊤ (Eq.refl ⊤))
              (submodule.bot_smul ⊤))
            x x (Eq.refl x) 0 0 (Eq.refl 0))
          (propext smodeq.bot))
        (hx 1))

protected theorem subsingleton {R : Type u_1} [comm_ring R] {M : Type u_2} [add_comm_group M] [module R M] (h : is_Hausdorff ⊤ M) : subsingleton M := sorry

protected instance of_subsingleton {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] [subsingleton M] : is_Hausdorff I M :=
  fun (x : M) (_x : ∀ (n : ℕ), smodeq (I ^ n • ⊤) x 0) => subsingleton.elim x 0

theorem infi_pow_smul {R : Type u_1} [comm_ring R] {I : ideal R} {M : Type u_2} [add_comm_group M] [module R M] (h : is_Hausdorff I M) : (infi fun (n : ℕ) => I ^ n • ⊤) = ⊥ := sorry

end is_Hausdorff

namespace Hausdorffification

/-- The canonical linear map to the Hausdorffification. -/
def of {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] : linear_map R M (Hausdorffification I M) :=
  submodule.mkq (infi fun (n : ℕ) => I ^ n • ⊤)

theorem induction_on {R : Type u_1} [comm_ring R] {I : ideal R} {M : Type u_2} [add_comm_group M] [module R M] {C : Hausdorffification I M → Prop} (x : Hausdorffification I M) (ih : ∀ (x : M), C (coe_fn (of I M) x)) : C x :=
  quotient.induction_on' x ih

protected instance is_Hausdorff {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] : is_Hausdorff I (Hausdorffification I M) := sorry

/-- universal property of Hausdorffification: any linear map to a Hausdorff module extends to a
unique map from the Hausdorffification. -/
def lift {R : Type u_1} [comm_ring R] (I : ideal R) {M : Type u_2} [add_comm_group M] [module R M] {N : Type u_3} [add_comm_group N] [module R N] [h : is_Hausdorff I N] (f : linear_map R M N) : linear_map R (Hausdorffification I M) N :=
  submodule.liftq (infi fun (n : ℕ) => I ^ n • ⊤) f sorry

theorem lift_of {R : Type u_1} [comm_ring R] (I : ideal R) {M : Type u_2} [add_comm_group M] [module R M] {N : Type u_3} [add_comm_group N] [module R N] [h : is_Hausdorff I N] (f : linear_map R M N) (x : M) : coe_fn (lift I f) (coe_fn (of I M) x) = coe_fn f x :=
  rfl

theorem lift_comp_of {R : Type u_1} [comm_ring R] (I : ideal R) {M : Type u_2} [add_comm_group M] [module R M] {N : Type u_3} [add_comm_group N] [module R N] [h : is_Hausdorff I N] (f : linear_map R M N) : linear_map.comp (lift I f) (of I M) = f :=
  linear_map.ext fun (_x : M) => rfl

/-- Uniqueness of lift. -/
theorem lift_eq {R : Type u_1} [comm_ring R] (I : ideal R) {M : Type u_2} [add_comm_group M] [module R M] {N : Type u_3} [add_comm_group N] [module R N] [h : is_Hausdorff I N] (f : linear_map R M N) (g : linear_map R (Hausdorffification I M) N) (hg : linear_map.comp g (of I M) = f) : g = lift I f := sorry

end Hausdorffification

namespace is_precomplete

protected instance bot {R : Type u_1} [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] : is_precomplete ⊥ M :=
  fun (f : ℕ → M) (hf : ∀ {m n : ℕ}, m ≤ n → smodeq (⊥ ^ m • ⊤) (f m) (f n)) =>
    Exists.intro (f 1)
      fun (n : ℕ) =>
        nat.cases_on n
          (eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (⊥ ^ 0 • ⊤) (f 0) (f 1))) (pow_zero ⊥)))
            (eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (1 • ⊤) (f 0) (f 1))) ideal.one_eq_top))
              (eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (⊤ • ⊤) (f 0) (f 1))) (submodule.top_smul ⊤))) smodeq.top)))
          fun (n : ℕ) =>
            eq.mpr
              (id
                (Eq._oldrec (Eq.refl (smodeq (⊥ ^ Nat.succ n • ⊤) (f (Nat.succ n)) (f 1)))
                  (eq.mp (Eq._oldrec (Eq.refl (smodeq ⊥ (f 1) (f (n + 1)))) (propext smodeq.bot))
                    (eq.mp (Eq._oldrec (Eq.refl (smodeq (⊥ • ⊤) (f 1) (f (n + 1)))) (submodule.bot_smul ⊤))
                      (eq.mp (Eq._oldrec (Eq.refl (smodeq (⊥ ^ 1 • ⊤) (f 1) (f (n + 1)))) (pow_one ⊥))
                        (hf (nat.le_add_left 1 n)))))))
              smodeq.refl

protected instance top {R : Type u_1} [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] : is_precomplete ⊤ M :=
  fun (f : ℕ → M) (hf : ∀ {m n : ℕ}, m ≤ n → smodeq (⊤ ^ m • ⊤) (f m) (f n)) =>
    Exists.intro 0
      fun (n : ℕ) =>
        eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (⊤ ^ n • ⊤) (f n) 0)) (ideal.top_pow R n)))
          (eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (⊤ • ⊤) (f n) 0)) (submodule.top_smul ⊤))) smodeq.top)

protected instance of_subsingleton {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] [subsingleton M] : is_precomplete I M :=
  fun (f : ℕ → M) (hf : ∀ {m n : ℕ}, m ≤ n → smodeq (I ^ m • ⊤) (f m) (f n)) =>
    Exists.intro 0
      fun (n : ℕ) =>
        eq.mpr (id (Eq._oldrec (Eq.refl (smodeq (I ^ n • ⊤) (f n) 0)) (subsingleton.elim (f n) 0))) smodeq.refl

end is_precomplete

namespace adic_completion

/-- The canonical linear map to the completion. -/
def of {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] : linear_map R M ↥(adic_completion I M) :=
  linear_map.mk (fun (x : M) => { val := fun (n : ℕ) => coe_fn (submodule.mkq (I ^ n • ⊤)) x, property := sorry }) sorry
    sorry

@[simp] theorem of_apply {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] (x : M) (n : ℕ) : subtype.val (coe_fn (of I M) x) n = coe_fn (submodule.mkq (I ^ n • ⊤)) x :=
  rfl

/-- Linearly evaluating a sequence in the completion at a given input. -/
def eval {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] (n : ℕ) : linear_map R (↥(adic_completion I M)) (submodule.quotient (I ^ n • ⊤)) :=
  linear_map.mk (fun (f : ↥(adic_completion I M)) => subtype.val f n) sorry sorry

@[simp] theorem coe_eval {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] (n : ℕ) : ⇑(eval I M n) = fun (f : ↥(adic_completion I M)) => subtype.val f n :=
  rfl

theorem eval_apply {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] (n : ℕ) (f : ↥(adic_completion I M)) : coe_fn (eval I M n) f = subtype.val f n :=
  rfl

theorem eval_of {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] (n : ℕ) (x : M) : coe_fn (eval I M n) (coe_fn (of I M) x) = coe_fn (submodule.mkq (I ^ n • ⊤)) x :=
  rfl

@[simp] theorem eval_comp_of {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] (n : ℕ) : linear_map.comp (eval I M n) (of I M) = submodule.mkq (I ^ n • ⊤) :=
  rfl

@[simp] theorem range_eval {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] (n : ℕ) : linear_map.range (eval I M n) = ⊤ :=
  iff.mpr linear_map.range_eq_top
    fun (x : submodule.quotient (I ^ n • ⊤)) =>
      quotient.induction_on' x fun (x : M) => Exists.intro (coe_fn (of I M) x) rfl

theorem ext {R : Type u_1} [comm_ring R] {I : ideal R} {M : Type u_2} [add_comm_group M] [module R M] {x : ↥(adic_completion I M)} {y : ↥(adic_completion I M)} (h : ∀ (n : ℕ), coe_fn (eval I M n) x = coe_fn (eval I M n) y) : x = y :=
  subtype.eq (funext h)

protected instance is_Hausdorff {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] : is_Hausdorff I ↥(adic_completion I M) := sorry

end adic_completion

namespace is_adic_complete

protected instance bot {R : Type u_1} [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] : is_adic_complete ⊥ M :=
  { left := is_Hausdorff.bot M, right := is_precomplete.bot M }

protected theorem subsingleton {R : Type u_1} [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] (h : is_adic_complete ⊤ M) : subsingleton M :=
  is_Hausdorff.subsingleton (and.left h)

protected instance of_subsingleton {R : Type u_1} [comm_ring R] (I : ideal R) (M : Type u_2) [add_comm_group M] [module R M] [subsingleton M] : is_adic_complete I M :=
  { left := is_Hausdorff.of_subsingleton I M, right := is_precomplete.of_subsingleton I M }


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

/-!
# Probability Distributions of Monadic Oracle Constructions

This file defines additional lemmas about the distribution semantics of constructions
given by a composition of monad operations.
-/

namespace oracle_comp

open oracle_spec
open_locale big_operators ennreal

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

section return_bind

variables (a : α) (ob : α → oracle_comp spec β) (y : β)

lemma eval_dist_return_bind : ⁅return a >>= ob⁆ = ⁅ob a⁆ :=
by simp only [eval_dist_bind, eval_dist_return, pmf.pure_bind]

lemma eval_dist_return_bind_apply : ⁅return a >>= ob⁆ y = ⁅ob a⁆ y :=
by simp only [eval_dist_bind, eval_dist_return, pmf.pure_bind]

end return_bind

section bind_return

variables (oa : oracle_comp spec α) (f : α → β) (y : β)

@[simp] lemma eval_dist_bind_return : ⁅oa >>= λ x, return (f x)⁆ = ⁅oa⁆.map f :=
by simp_rw [eval_dist_bind, eval_dist_return, pmf.bind_pure_comp]

lemma eval_dist_bind_return_apply_eq_tsum [decidable_eq β] :
  ⁅oa >>= λ x, return (f x)⁆ y = ∑' x, ite (y = f x) (⁅oa⁆ x) 0 :=
begin
  rw [eval_dist_bind_return, pmf.map_apply],
  congr,
  refine funext (λ x, _),
  congr,
end

-- TODO: gross proof
lemma eval_dist_bind_return_apply_eq_tsum_indicator :
  ⁅oa >>= λ x, return (f x)⁆ y = ∑' x, (f ⁻¹' {y}).indicator ⁅oa⁆ x :=
begin
  rw [eval_dist_bind_apply_eq_tsum],
  refine tsum_congr (λ x, _),
  rw [eval_dist_return, pmf.pure_apply, set.indicator],
  rw [mul_ite, mul_one, mul_zero, @eq_comm _ y],
  congr,
end

lemma eval_dist_bind_return_apply_eq_sum [fintype α] [decidable_eq β] :
  ⁅oa >>= λ x, return (f x)⁆ y = ∑ x, ite (y = f x) (⁅oa⁆ x) 0 :=
(eval_dist_bind_return_apply_eq_tsum oa f y).trans
  (tsum_eq_sum (λ x hx, (hx $ finset.mem_univ x).elim))

lemma eval_dist_bind_return_apply_eq_sum_indicator [fintype α] [decidable_eq β] :
  ⁅oa >>= λ x, return (f x)⁆ y = ∑ x, (f ⁻¹' {y}).indicator ⁅oa⁆ x :=
(eval_dist_bind_return_apply_eq_tsum_indicator oa f y).trans
  (tsum_eq_sum (λ x hx, (hx $ finset.mem_univ x).elim))

lemma eval_dist_bind_return_apply_eq_sum_fin_support [oa.decidable] [decidable_eq β] :
  ⁅oa >>= λ x, return (f x)⁆ y = ∑ x in oa.fin_support, ite (y = f x) (⁅oa⁆ x) 0 :=
(eval_dist_bind_return_apply_eq_tsum oa f y).trans
  (tsum_eq_sum (λ x hx, by rw [eval_dist_eq_zero' hx, if_t_t]))

lemma eval_dist_bind_return_apply_eq_sum_fin_support_indicator [oa.decidable] [decidable_eq β] :
  ⁅oa >>= λ x, return (f x)⁆ y = ∑ x in oa.fin_support, (f ⁻¹' {y}).indicator ⁅oa⁆ x :=
(eval_dist_bind_return_apply_eq_tsum_indicator oa f y).trans
  (tsum_eq_sum (λ x hx, by simp_rw [set.indicator_apply_eq_zero,
    eval_dist_eq_zero_iff', hx, not_false_iff, imp_true_iff]))

@[simp] lemma eval_dist_bind_return_id : ⁅oa >>= return⁆ = ⁅oa⁆ :=
(eval_dist_bind_return oa id).trans (by rw [pmf.map_id])

lemma eval_dist_bind_return_apply_eq_single' (x : α) (hx : f x = y)
  (h : ∀ x' ∈ oa.support, f x' = y → x' = x) : ⁅oa >>= λ x, return (f x)⁆ y = ⁅oa⁆ x :=
begin
  rw [eval_dist_bind_return_apply_eq_tsum_indicator],
  refine trans (tsum_eq_single x $ λ x' hx', set.indicator_apply_eq_zero.2 _) _,
  { exact λ hx'', eval_dist_eq_zero (λ hxs, hx' (h x' hxs hx'')) },
  { simp only [set.mem_preimage, set.mem_singleton_iff, hx, set.indicator_of_mem] }
end

/-- If a function `f` returns `y` iff the input is `x`, then the probability of outputting
`y` after running a computation and applying `f` is the probability of outputting `x`-/
lemma eval_dist_bind_return_apply_eq_single (x : α) (hx : f ⁻¹' {y} = {x}) :
  ⁅oa >>= λ x, return (f x)⁆ y = ⁅oa⁆ x :=
begin
  simp only [eval_dist_bind_return_apply_eq_tsum_indicator, hx],
  refine trans (tsum_eq_single x _) (by simp only [set.indicator_of_mem, set.mem_singleton]),
  simp only [set.indicator_apply_eq_zero, eval_dist_eq_zero_iff],
  refine (λ _ h h', (h h').elim),
end

end bind_return

section map

variables (oa : oracle_comp spec α) (ob : α → oracle_comp spec β) (oc : β → oracle_comp spec γ)
  (f : α → β) (g : β → γ) (x : α) (y : β)

@[simp] lemma eval_dist_map : ⁅f <$> oa⁆ = ⁅oa⁆.map f := eval_dist_bind oa (pure ∘ f)

lemma eval_dist_map_comp' : ⁅g <$> (f <$> oa)⁆ = ⁅(g ∘ f) <$> oa⁆ :=
by simp only [eval_dist_map, pmf.map_comp]

lemma eval_dist_map_apply_eq_tsum [decidable_eq β] : ⁅f <$> oa⁆ y = ∑' x, ite (y = f x) (⁅oa⁆ x) 0 :=
eval_dist_bind_return_apply_eq_tsum oa f y

lemma eval_dist_map_apply_eq_tsum_indicator : ⁅f <$> oa⁆ y = ∑' x, (f ⁻¹' {y}).indicator ⁅oa⁆ x :=
eval_dist_bind_return_apply_eq_tsum_indicator oa f y

lemma eval_dist_map_apply_eq_sum [fintype α] [decidable_eq β] : ⁅f <$> oa⁆ y = ∑ x, ite (y = f x) (⁅oa⁆ x) 0 :=
eval_dist_bind_return_apply_eq_sum oa f y

lemma eval_dist_map_apply_eq_sum_indicator [fintype α] [decidable_eq β] :
  ⁅f <$> oa⁆ y = ∑ x, (f ⁻¹' {y}).indicator ⁅oa⁆ x :=
eval_dist_bind_return_apply_eq_sum_indicator oa f y

lemma eval_dist_map_apply_eq_sum_fin_support [oa.decidable] [decidable_eq β] :
  ⁅f <$> oa⁆ y = ∑ x in oa.fin_support, ite (y = f x) (⁅oa⁆ x) 0 :=
eval_dist_bind_return_apply_eq_sum_fin_support oa f y

lemma eval_dist_map_apply_eq_sum_fin_support_indicator [oa.decidable] [decidable_eq β] :
  ⁅f <$> oa⁆ y = ∑ x in oa.fin_support, (f ⁻¹' {y}).indicator ⁅oa⁆ x :=
eval_dist_bind_return_apply_eq_sum_fin_support_indicator oa f y

@[simp] lemma eval_dist_map_id : ⁅id <$> oa⁆ = ⁅oa⁆ := by rw [eval_dist_map, ⁅oa⁆.map_id]

lemma eval_dist_map_apply_eq_single' (x : α) (hx : f x = y)
  (h : ∀ x' ∈ oa.support, f x' = y → x' = x) : ⁅f <$> oa⁆ y = ⁅oa⁆ x :=
eval_dist_bind_return_apply_eq_single' oa f y x hx h

/-- If a function `f` returns `y` iff the input is `x`, then the probability of outputting
`y` after running a computation and applying `f` is the probability of outputting `x`-/
lemma eval_dist_map_apply_eq_single (x : α) (hx : f ⁻¹' {y} = {x}) :
  ⁅f <$> oa⁆ y = ⁅oa⁆ x := eval_dist_bind_return_apply_eq_single oa f y x hx

lemma eval_dist_map_apply_of_injective (x : α) (hf : f.injective) : ⁅f <$> oa⁆ (f x) = ⁅oa⁆ x :=
eval_dist_map_apply_eq_single' oa f (f x) x rfl (λ x' hx' hxf, hf hxf)

lemma map_equiv_congr {f f' : α → β} {oa : oracle_comp spec α} {oa' : oracle_comp spec' α}
  (hf : ∀ x, f x = f' x) (hoa : oa ≃ₚ oa') : (f <$> oa) ≃ₚ (f' <$> oa') :=
dist_equiv.ext (λ x, by simp only [eval_dist_map, hoa.eval_dist_eq, (funext hf : f = f')])

end map

section map_return

variables (a : α) (f : α → β)

lemma eval_dist_map_return : ⁅f <$> (return a : oracle_comp spec α)⁆ = pmf.pure (f a) :=
by simp [eval_dist_map, pmf.map_pure]

end map_return

section map_bind

variables (oa : oracle_comp spec α) (ob : α → oracle_comp spec β) (g : β → γ) (z : γ)

lemma eval_dist_map_bind : ⁅g <$> (oa >>= ob)⁆ = ⁅oa⁆.bind (λ x, ⁅ob x⁆.map g) :=
by simp only [eval_dist_map, eval_dist_bind, pmf.map_bind]

lemma eval_dist_map_bind' : ⁅g <$> (oa >>= ob)⁆ = ⁅oa >>= (λ x, g <$> (ob x))⁆ :=
by simp only [eval_dist_map, eval_dist_bind, pmf.map_bind]

lemma eval_dist_map_bind_apply_eq_tsum [decidable_eq γ] :
  ⁅g <$> (oa >>= ob)⁆ z = ∑' (x : α) (y : β), ⁅oa⁆ x * (ite (z = g y) (⁅ob x⁆ y) 0) :=
by simp only [eval_dist_map_bind', eval_dist_bind_apply_eq_tsum,
  eval_dist_map_apply_eq_tsum, ennreal.tsum_mul_left]

lemma eval_dist_map_bind_apply_eq_sum [fintype α] [fintype β] [decidable_eq γ] :
  ⁅g <$> (oa >>= ob)⁆ z = ∑ (x : α) (y : β), ⁅oa⁆ x * (ite (z = g y) (⁅ob x⁆ y) 0) :=
by simp_rw [eval_dist_map_bind', eval_dist_bind_apply_eq_sum,
  eval_dist_map_apply_eq_sum, ← finset.mul_sum]

lemma eval_dist_map_bind_apply_eq_sum_fin_support [decidable oa] [∀ x, decidable (ob x)] [decidable_eq γ] :
  ⁅g <$> (oa >>= ob)⁆ z = ∑ x in oa.fin_support, ∑ y in (ob x).fin_support, ⁅oa⁆ x * (ite (z = g y) (⁅ob x⁆ y) 0) :=
by simp_rw [eval_dist_map_bind', eval_dist_bind_apply_eq_sum_fin_support,
  eval_dist_map_apply_eq_sum_fin_support, ← finset.mul_sum]

end map_bind

section bind_map

variables (oa : oracle_comp spec α) (f : α → β) (oc : β → oracle_comp spec γ) (z : γ)

lemma eval_dist_bind_map : ⁅(f <$> oa) >>= oc⁆ = ⁅oa⁆.bind (λ y, ⁅oc (f y)⁆) :=
by simp only [eval_dist_bind, eval_dist_map, pmf.bind_map]

lemma eval_dist_bind_map' : ⁅(f <$> oa) >>= oc⁆ = ⁅oa >>= oc ∘ f⁆ :=
by simp only [eval_dist_bind, eval_dist_map, pmf.bind_map]

lemma eval_dist_bind_map_apply_eq_tsum :
  ⁅(f <$> oa) >>= oc⁆ z = ∑' (x : α), ⁅oa⁆ x * ⁅oc (f x)⁆ z :=
by rw [eval_dist_bind_map, pmf.bind_apply]

lemma eval_dist_bind_map_apply_eq_sum [fintype α] :
  ⁅(f <$> oa) >>= oc⁆ z = ∑ (x : α), ⁅oa⁆ x * ⁅oc (f x)⁆ z :=
begin
  rw [eval_dist_bind_map, pmf.bind_apply],
  exact tsum_eq_sum (λ _ h, (h $ finset.mem_univ _).elim),
end

lemma eval_dist_bind_map_apply_eq_sum_fin_support [decidable oa] :
  ⁅(f <$> oa) >>= oc⁆ z = ∑ x in oa.fin_support, ⁅oa⁆ x * ⁅oc (f x)⁆ z :=
begin
  rw [eval_dist_bind_map, pmf.bind_apply],
  refine tsum_eq_sum (λ x hx, _),
  simp only [mul_eq_zero, eval_dist_eq_zero_iff'],
  exact or.inl hx,
end

end bind_map

section query_bind

variables (i : spec.ι) (t : spec.domain i) (oa : spec.range i → oracle_comp spec α) (x : α)

lemma eval_dist_query_bind_apply_eq_tsum :
  ⁅query i t >>= oa⁆ x = (∑' u, ⁅oa u⁆ x) / (fintype.card $ spec.range i) :=
by simp_rw [eval_dist_bind_apply_eq_tsum, eval_dist_query_apply, div_eq_mul_inv,
  one_mul, ennreal.tsum_mul_left, mul_comm]

lemma eval_dist_query_bind_apply_eq_sum :
  ⁅query i t >>= oa⁆ x = (∑ u, ⁅oa u⁆ x) / (fintype.card $ spec.range i) :=
by simp_rw [eval_dist_bind_apply_eq_sum, eval_dist_query_apply, div_eq_mul_inv,
  one_mul, finset.sum_mul, mul_comm]

end query_bind

-- TODO: feels like the wrong file for this
section ite

variables (oa : oracle_comp spec α) (p : α → Prop) (f g : α → β) (x : α) (y : β)

lemma eval_dist_bind_ite_apply_eq_tsum_add_tsum [decidable_pred p] [decidable_eq β] :
  ⁅oa >>= λ a, return (if p a then f a else g a)⁆ y =
    (∑' x, ite (p x ∧ y = f x) (⁅oa⁆ x) 0) + (∑' x, ite (¬ p x ∧ y = g x) (⁅oa⁆ x) 0) :=
begin
  rw [eval_dist_bind_return_apply_eq_tsum, ← ennreal.tsum_add],
  refine tsum_congr (λ x, _),
  by_cases hpx : p x;
  simp only [hpx, if_true, true_and, not_true, false_and, if_false, add_zero,
    if_false, false_and, not_false_iff, true_and, zero_add]
end

lemma eval_dist_bind_ite_apply_eq_sum_add_sum [fintype α] [decidable_pred p] [decidable_eq β] :
  ⁅oa >>= λ a, return (if p a then f a else g a)⁆ y =
    (∑ x, ite (p x ∧ y = f x) (⁅oa⁆ x) 0) + (∑ x, ite (¬ p x ∧ y = g x) (⁅oa⁆ x) 0) :=
begin
  rw [eval_dist_bind_return_apply_eq_sum, ← finset.sum_add_distrib],
  refine finset.sum_congr rfl (λ x _, _),
  by_cases hpx : p x;
  simp only [hpx, if_true, true_and, not_true, false_and, if_false, add_zero,
    if_false, false_and, not_false_iff, true_and, zero_add],
end

end ite

end oracle_comp


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.int.modeq
import Mathlib.algebra.char_p.basic
import Mathlib.data.nat.totient
import Mathlib.ring_theory.ideal.operations
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Integers mod `n`

Definition of the integers mod n, and the field structure on the integers mod p.

## Definitions

* `zmod n`, which is for integers modulo a nat `n : ℕ`

* `val a` is defined as a natural number:
  - for `a : zmod 0` it is the absolute value of `a`
  - for `a : zmod n` with `0 < n` it is the least natural number in the equivalence class

* `val_min_abs` returns the integer closest to zero in the equivalence class.

* A coercion `cast` is defined from `zmod n` into any ring.
This is a ring hom if the ring has characteristic dividing `n`

-/

namespace fin

/-!
## Ring structure on `fin n`

We define a commutative ring structure on `fin n`, but we do not register it as instance.
Afterwords, when we define `zmod n` in terms of `fin n`, we use these definitions
to register the ring structure on `zmod n` as type class instance.
-/

/-- Negation on `fin n` -/
def has_neg (n : ℕ) : Neg (fin n) :=
  { neg := fun (a : fin n) => { val := int.nat_mod (-↑(subtype.val a)) ↑n, property := sorry } }

/-- Multiplicative commutative semigroup structure on `fin (n+1)`. -/
def comm_semigroup (n : ℕ) : comm_semigroup (fin (n + 1)) := comm_semigroup.mk Mul.mul sorry sorry

/-- Commutative ring structure on `fin (n+1)`. -/
def comm_ring (n : ℕ) : comm_ring (fin (n + 1)) :=
  comm_ring.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry Neg.neg
    (ring.sub._default add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry Neg.neg) sorry
    sorry comm_semigroup.mul sorry 1 fin.one_mul fin.mul_one (left_distrib_aux n) sorry sorry

end fin

/-- The integers modulo `n : ℕ`. -/
def zmod : ℕ → Type := sorry

namespace zmod

protected instance fintype (n : ℕ) [fact (0 < n)] : fintype (zmod n) := sorry

theorem card (n : ℕ) [fact (0 < n)] : fintype.card (zmod n) = n :=
  nat.cases_on n (fun [_inst_1 : fact (0 < 0)] => False._oldrec (nat.not_lt_zero 0 _inst_1))
    (fun (n : ℕ) => fintype.card_fin (n + 1)) _inst_1

protected instance decidable_eq (n : ℕ) : DecidableEq (zmod n) := sorry

protected instance has_repr (n : ℕ) : has_repr (zmod n) := sorry

protected instance comm_ring (n : ℕ) : comm_ring (zmod n) := sorry

protected instance inhabited (n : ℕ) : Inhabited (zmod n) := { default := 0 }

/-- `val a` is a natural number defined as:
  - for `a : zmod 0` it is the absolute value of `a`
  - for `a : zmod n` with `0 < n` it is the least natural number in the equivalence class

See `zmod.val_min_abs` for a variant that takes values in the integers.
-/
def val {n : ℕ} : zmod n → ℕ := sorry

theorem val_lt {n : ℕ} [fact (0 < n)] (a : zmod n) : val a < n :=
  nat.cases_on n
    (fun [_inst_1 : fact (0 < 0)] (a : zmod 0) => False._oldrec (nat.not_lt_zero 0 _inst_1))
    (fun (n : ℕ) (a : zmod (Nat.succ n)) => fin.is_lt a) _inst_1 a

@[simp] theorem val_zero {n : ℕ} : val 0 = 0 :=
  nat.cases_on n (idRhs (val 0 = val 0) rfl) fun (n : ℕ) => idRhs (val 0 = val 0) rfl

theorem val_cast_nat {n : ℕ} (a : ℕ) : val ↑a = a % n := sorry

protected instance char_p (n : ℕ) : char_p (zmod n) n := sorry

@[simp] theorem cast_self (n : ℕ) : ↑n = 0 := char_p.cast_eq_zero (zmod n) n

@[simp] theorem cast_self' (n : ℕ) : ↑n + 1 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n + 1 = 0)) (Eq.symm (nat.cast_add_one n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑(n + 1) = 0)) (cast_self (n + 1)))) (Eq.refl 0))

/-- Cast an integer modulo `n` to another semiring.
This function is a morphism if the characteristic of `R` divides `n`.
See `zmod.cast_hom` for a bundled version. -/
def cast {R : Type u_1} [HasZero R] [HasOne R] [Add R] [Neg R] {n : ℕ} : zmod n → R := sorry

-- see Note [coercion into rings]

protected instance has_coe_t {R : Type u_1} [HasZero R] [HasOne R] [Add R] [Neg R] (n : ℕ) :
    has_coe_t (zmod n) R :=
  has_coe_t.mk cast

@[simp] theorem cast_zero {n : ℕ} {R : Type u_1} [HasZero R] [HasOne R] [Add R] [Neg R] : ↑0 = 0 :=
  nat.cases_on n (Eq.refl ↑0) fun (n : ℕ) => Eq.refl ↑0

theorem nat_cast_surjective {n : ℕ} [fact (0 < n)] : function.surjective coe := sorry

theorem int_cast_surjective {n : ℕ} : function.surjective coe := sorry

theorem cast_val {n : ℕ} [fact (0 < n)] (a : zmod n) : ↑(val a) = a := sorry

@[simp] theorem cast_id (n : ℕ) (i : zmod n) : ↑i = i :=
  nat.cases_on n (fun (i : zmod 0) => idRhs (↑i = i) (int.cast_id i))
    (fun (n : ℕ) (i : zmod (Nat.succ n)) => idRhs (↑(val i) = i) (cast_val i)) i

@[simp] theorem nat_cast_val {n : ℕ} {R : Type u_1} [ring R] [fact (0 < n)] (i : zmod n) :
    ↑(val i) = ↑i :=
  nat.cases_on n
    (fun [_inst_2 : fact (0 < 0)] (i : zmod 0) => False._oldrec (nat.not_lt_zero 0 _inst_2))
    (fun (n : ℕ) (i : zmod (Nat.succ n)) => Eq.refl ↑(val i)) _inst_2 i

/-! If the characteristic of `R` divides `n`, then `cast` is a homomorphism. -/

@[simp] theorem cast_one {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) :
    ↑1 = 1 :=
  sorry

theorem cast_add {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) (a : zmod n)
    (b : zmod n) : ↑(a + b) = ↑a + ↑b :=
  sorry

theorem cast_mul {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n) (a : zmod n)
    (b : zmod n) : ↑(a * b) = ↑a * ↑b :=
  sorry

/-- The canonical ring homomorphism from `zmod n` to a ring of characteristic `n`. -/
def cast_hom {n : ℕ} {m : ℕ} (h : m ∣ n) (R : Type u_1) [ring R] [char_p R m] : zmod n →+* R :=
  ring_hom.mk coe (cast_one h) (cast_mul h) sorry (cast_add h)

@[simp] theorem cast_hom_apply {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] {h : m ∣ n}
    (i : zmod n) : coe_fn (cast_hom h R) i = ↑i :=
  rfl

@[simp] theorem cast_sub {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n)
    (a : zmod n) (b : zmod n) : ↑(a - b) = ↑a - ↑b :=
  ring_hom.map_sub (cast_hom h R) a b

@[simp] theorem cast_neg {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n)
    (a : zmod n) : ↑(-a) = -↑a :=
  ring_hom.map_neg (cast_hom h R) a

@[simp] theorem cast_pow {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n)
    (a : zmod n) (k : ℕ) : ↑(a ^ k) = ↑a ^ k :=
  ring_hom.map_pow (cast_hom h R) a k

@[simp] theorem cast_nat_cast {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n)
    (k : ℕ) : ↑↑k = ↑k :=
  ring_hom.map_nat_cast (cast_hom h R) k

@[simp] theorem cast_int_cast {n : ℕ} {R : Type u_1} [ring R] {m : ℕ} [char_p R m] (h : m ∣ n)
    (k : ℤ) : ↑↑k = ↑k :=
  ring_hom.map_int_cast (cast_hom h R) k

/-! Some specialised simp lemmas which apply when `R` has characteristic `n`. -/

@[simp] theorem cast_one' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] : ↑1 = 1 :=
  cast_one (dvd_refl n)

@[simp] theorem cast_add' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (a : zmod n) (b : zmod n) :
    ↑(a + b) = ↑a + ↑b :=
  cast_add (dvd_refl n) a b

@[simp] theorem cast_mul' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (a : zmod n) (b : zmod n) :
    ↑(a * b) = ↑a * ↑b :=
  cast_mul (dvd_refl n) a b

@[simp] theorem cast_sub' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (a : zmod n) (b : zmod n) :
    ↑(a - b) = ↑a - ↑b :=
  cast_sub (dvd_refl n) a b

@[simp] theorem cast_pow' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (a : zmod n) (k : ℕ) :
    ↑(a ^ k) = ↑a ^ k :=
  cast_pow (dvd_refl n) a k

@[simp] theorem cast_nat_cast' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (k : ℕ) : ↑↑k = ↑k :=
  cast_nat_cast (dvd_refl n) k

@[simp] theorem cast_int_cast' {n : ℕ} {R : Type u_1} [ring R] [char_p R n] (k : ℤ) : ↑↑k = ↑k :=
  cast_int_cast (dvd_refl n) k

protected instance algebra {n : ℕ} (R : Type u_1) [comm_ring R] [char_p R n] : algebra (zmod n) R :=
  ring_hom.to_algebra (cast_hom (dvd_refl n) R)

theorem cast_hom_injective {n : ℕ} (R : Type u_1) [ring R] [char_p R n] :
    function.injective ⇑(cast_hom (dvd_refl n) R) :=
  sorry

theorem cast_hom_bijective {n : ℕ} (R : Type u_1) [ring R] [char_p R n] [fintype R]
    (h : fintype.card R = n) : function.bijective ⇑(cast_hom (dvd_refl n) R) :=
  sorry

/-- The unique ring isomorphism between `zmod n` and a ring `R`
of characteristic `n` and cardinality `n`. -/
def ring_equiv {n : ℕ} (R : Type u_1) [ring R] [char_p R n] [fintype R] (h : fintype.card R = n) :
    zmod n ≃+* R :=
  ring_equiv.of_bijective (cast_hom (dvd_refl n) R) (cast_hom_bijective R h)

theorem int_coe_eq_int_coe_iff (a : ℤ) (b : ℤ) (c : ℕ) : ↑a = ↑b ↔ int.modeq (↑c) a b :=
  char_p.int_coe_eq_int_coe_iff (zmod c) c a b

theorem nat_coe_eq_nat_coe_iff (a : ℕ) (b : ℕ) (c : ℕ) : ↑a = ↑b ↔ nat.modeq c a b := sorry

theorem int_coe_zmod_eq_zero_iff_dvd (a : ℤ) (b : ℕ) : ↑a = 0 ↔ ↑b ∣ a := sorry

theorem nat_coe_zmod_eq_zero_iff_dvd (a : ℕ) (b : ℕ) : ↑a = 0 ↔ b ∣ a := sorry

@[simp] theorem cast_mod_int (a : ℤ) (b : ℕ) : ↑(a % ↑b) = ↑a :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (↑(a % ↑b) = ↑a)) (propext (int_coe_eq_int_coe_iff (a % ↑b) a b))))
    (int.modeq.mod_modeq a ↑b)

@[simp] theorem coe_to_nat (p : ℕ) {z : ℤ} (h : 0 ≤ z) : ↑(int.to_nat z) = ↑z := sorry

theorem val_injective (n : ℕ) [fact (0 < n)] : function.injective val :=
  nat.cases_on n
    (fun [_inst_1 : fact (0 < 0)] =>
      id fun (a₁ : zmod 0) => False._oldrec (nat.not_lt_zero 0 _inst_1))
    (fun (n : ℕ) => id fun (a b : zmod (Nat.succ n)) (h : val a = val b) => fin.ext h) _inst_1

theorem val_one_eq_one_mod (n : ℕ) : val 1 = 1 % n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (val 1 = 1 % n)) (Eq.symm nat.cast_one)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (val ↑1 = 1 % n)) (val_cast_nat 1))) (Eq.refl (1 % n)))

theorem val_one (n : ℕ) [fact (1 < n)] : val 1 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (val 1 = 1)) (val_one_eq_one_mod n))) (nat.mod_eq_of_lt _inst_1)

theorem val_add {n : ℕ} [fact (0 < n)] (a : zmod n) (b : zmod n) :
    val (a + b) = (val a + val b) % n :=
  nat.cases_on n
    (fun [_inst_1 : fact (0 < 0)] (a b : zmod 0) => False._oldrec (nat.not_lt_zero 0 _inst_1))
    (fun (n : ℕ) (a b : zmod (Nat.succ n)) => fin.val_add a b) _inst_1 a b

theorem val_mul {n : ℕ} (a : zmod n) (b : zmod n) : val (a * b) = val a * val b % n := sorry

protected instance nontrivial (n : ℕ) [fact (1 < n)] : nontrivial (zmod n) :=
  nontrivial.mk
    (Exists.intro 0
      (Exists.intro 1
        fun (h : 0 = 1) =>
          zero_ne_one
            (Eq.trans
              (Eq.trans (eq.mpr (id (Eq._oldrec (Eq.refl (0 = val 0)) val_zero)) (Eq.refl 0))
                (congr_arg val h))
              (val_one n))))

/-- The inversion on `zmod n`.
It is setup in such a way that `a * a⁻¹` is equal to `gcd a.val n`.
In particular, if `a` is coprime to `n`, and hence a unit, `a * a⁻¹ = 1`. -/
def inv (n : ℕ) : zmod n → zmod n := sorry

protected instance has_inv (n : ℕ) : has_inv (zmod n) := has_inv.mk (inv n)

theorem inv_zero (n : ℕ) : 0⁻¹ = 0 := sorry

theorem mul_inv_eq_gcd {n : ℕ} (a : zmod n) : a * (a⁻¹) = ↑(nat.gcd (val a) n) := sorry

@[simp] theorem cast_mod_nat (n : ℕ) (a : ℕ) : ↑(a % n) = ↑a := sorry

theorem eq_iff_modeq_nat (n : ℕ) {a : ℕ} {b : ℕ} : ↑a = ↑b ↔ nat.modeq n a b := sorry

theorem coe_mul_inv_eq_one {n : ℕ} (x : ℕ) (h : nat.coprime x n) : ↑x * (↑x⁻¹) = 1 := sorry

/-- `unit_of_coprime` makes an element of `units (zmod n)` given
  a natural number `x` and a proof that `x` is coprime to `n`  -/
def unit_of_coprime {n : ℕ} (x : ℕ) (h : nat.coprime x n) : units (zmod n) :=
  units.mk (↑x) (↑x⁻¹) (coe_mul_inv_eq_one x h) sorry

@[simp] theorem cast_unit_of_coprime {n : ℕ} (x : ℕ) (h : nat.coprime x n) :
    ↑(unit_of_coprime x h) = ↑x :=
  rfl

theorem val_coe_unit_coprime {n : ℕ} (u : units (zmod n)) : nat.coprime (val ↑u) n := sorry

@[simp] theorem inv_coe_unit {n : ℕ} (u : units (zmod n)) : ↑u⁻¹ = ↑(u⁻¹) := sorry

theorem mul_inv_of_unit {n : ℕ} (a : zmod n) (h : is_unit a) : a * (a⁻¹) = 1 := sorry

theorem inv_mul_of_unit {n : ℕ} (a : zmod n) (h : is_unit a) : a⁻¹ * a = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ * a = 1)) (mul_comm (a⁻¹) a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (a⁻¹) = 1)) (mul_inv_of_unit a h))) (Eq.refl 1))

/-- Equivalence between the units of `zmod n` and
the subtype of terms `x : zmod n` for which `x.val` is comprime to `n` -/
def units_equiv_coprime {n : ℕ} [fact (0 < n)] :
    units (zmod n) ≃ Subtype fun (x : zmod n) => nat.coprime (val x) n :=
  equiv.mk (fun (x : units (zmod n)) => { val := ↑x, property := val_coe_unit_coprime x })
    (fun (x : Subtype fun (x : zmod n) => nat.coprime (val x) n) =>
      unit_of_coprime (val (subtype.val x)) sorry)
    sorry sorry

@[simp] theorem card_units_eq_totient (n : ℕ) [fact (0 < n)] :
    fintype.card (units (zmod n)) = nat.totient n :=
  sorry

protected instance subsingleton_units : subsingleton (units (zmod (bit0 1))) :=
  subsingleton.intro
    fun (x y : units (zmod (bit0 1))) =>
      units.cases_on x
        fun (x xi : zmod (bit0 1)) (x_val_inv : x * xi = 1) (x_inv_val : xi * x = 1) =>
          units.cases_on y
            fun (y yi : zmod (bit0 1)) (y_val_inv : y * yi = 1) (y_inv_val : yi * y = 1) =>
              of_as_true trivial x y xi yi x_val_inv x_inv_val y_val_inv y_inv_val

theorem le_div_two_iff_lt_neg (n : ℕ) [hn : fact (n % bit0 1 = 1)] {x : zmod n} (hx0 : x ≠ 0) :
    val x ≤ n / bit0 1 ↔ n / bit0 1 < val (-x) :=
  sorry

theorem ne_neg_self (n : ℕ) [hn : fact (n % bit0 1 = 1)] {a : zmod n} (ha : a ≠ 0) : a ≠ -a := sorry

theorem neg_one_ne_one {n : ℕ} [fact (bit0 1 < n)] : -1 ≠ 1 := char_p.neg_one_ne_one (zmod n) n

@[simp] theorem neg_eq_self_mod_two (a : zmod (bit0 1)) : -a = a := of_as_true trivial

@[simp] theorem nat_abs_mod_two (a : ℤ) : ↑(int.nat_abs a) = ↑a := sorry

@[simp] theorem val_eq_zero {n : ℕ} (a : zmod n) : val a = 0 ↔ a = 0 := sorry

theorem val_cast_of_lt {n : ℕ} {a : ℕ} (h : a < n) : val ↑a = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (val ↑a = a)) (val_cast_nat a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a % n = a)) (nat.mod_eq_of_lt h))) (Eq.refl a))

theorem neg_val' {n : ℕ} [fact (0 < n)] (a : zmod n) : val (-a) = (n - val a) % n := sorry

theorem neg_val {n : ℕ} [fact (0 < n)] (a : zmod n) : val (-a) = ite (a = 0) 0 (n - val a) := sorry

/-- `val_min_abs x` returns the integer in the same equivalence class as `x` that is closest to `0`,
  The result will be in the interval `(-n/2, n/2]`. -/
def val_min_abs {n : ℕ} : zmod n → ℤ := sorry

@[simp] theorem val_min_abs_def_zero (x : zmod 0) : val_min_abs x = x := rfl

theorem val_min_abs_def_pos {n : ℕ} [fact (0 < n)] (x : zmod n) :
    val_min_abs x = ite (val x ≤ n / bit0 1) (↑(val x)) (↑(val x) - ↑n) :=
  nat.cases_on n
    (fun [_inst_1 : fact (0 < 0)] (x : zmod 0) => False._oldrec (nat.not_lt_zero 0 _inst_1))
    (fun (n : ℕ) (x : zmod (Nat.succ n)) => Eq.refl (val_min_abs x)) _inst_1 x

@[simp] theorem coe_val_min_abs {n : ℕ} (x : zmod n) : ↑(val_min_abs x) = x := sorry

theorem nat_abs_val_min_abs_le {n : ℕ} [fact (0 < n)] (x : zmod n) :
    int.nat_abs (val_min_abs x) ≤ n / bit0 1 :=
  sorry

@[simp] theorem val_min_abs_zero (n : ℕ) : val_min_abs 0 = 0 := sorry

@[simp] theorem val_min_abs_eq_zero {n : ℕ} (x : zmod n) : val_min_abs x = 0 ↔ x = 0 := sorry

theorem cast_nat_abs_val_min_abs {n : ℕ} [fact (0 < n)] (a : zmod n) :
    ↑(int.nat_abs (val_min_abs a)) = ite (val a ≤ n / bit0 1) a (-a) :=
  sorry

@[simp] theorem nat_abs_val_min_abs_neg {n : ℕ} (a : zmod n) :
    int.nat_abs (val_min_abs (-a)) = int.nat_abs (val_min_abs a) :=
  sorry

theorem val_eq_ite_val_min_abs {n : ℕ} [fact (0 < n)] (a : zmod n) :
    ↑(val a) = val_min_abs a + ite (val a ≤ n / bit0 1) 0 ↑n :=
  sorry

theorem prime_ne_zero (p : ℕ) (q : ℕ) [hp : fact (nat.prime p)] [hq : fact (nat.prime q)]
    (hpq : p ≠ q) : ↑q ≠ 0 :=
  sorry

end zmod

namespace zmod

/-- Field structure on `zmod p` if `p` is prime. -/
protected instance field (p : ℕ) [fact (nat.prime p)] : field (zmod p) :=
  field.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry
    comm_ring.mul sorry comm_ring.one sorry sorry sorry sorry sorry has_inv.inv sorry
    (mul_inv_cancel_aux p) (inv_zero p)

end zmod

theorem ring_hom.ext_zmod {n : ℕ} {R : Type u_1} [semiring R] (f : zmod n →+* R)
    (g : zmod n →+* R) : f = g :=
  sorry

namespace zmod

protected instance subsingleton_ring_hom {n : ℕ} {R : Type u_1} [semiring R] :
    subsingleton (zmod n →+* R) :=
  subsingleton.intro ring_hom.ext_zmod

protected instance subsingleton_ring_equiv {n : ℕ} {R : Type u_1} [semiring R] :
    subsingleton (zmod n ≃+* R) :=
  subsingleton.intro
    fun (f g : zmod n ≃+* R) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (f = g)) (propext (ring_equiv.coe_ring_hom_inj_iff f g))))
        (ring_hom.ext_zmod ↑f ↑g)

theorem ring_hom_surjective {n : ℕ} {R : Type u_1} [ring R] (f : R →+* zmod n) :
    function.surjective ⇑f :=
  sorry

theorem ring_hom_eq_of_ker_eq {n : ℕ} {R : Type u_1} [comm_ring R] (f : R →+* zmod n)
    (g : R →+* zmod n) (h : ring_hom.ker f = ring_hom.ker g) : f = g :=
  sorry

end Mathlib


-- yay
#eval "Hello, World!"

-- a mathetmatical object
-- let's run some trivial examples
#check 4 + 2 -- type ℕ

-- another mathetmatical object
def some_name (x : ℕ) := x + 3
#check some_name -- type ℕ → ℕ

-- a mathematical statement
def math_stat :=
  ∀ n : ℕ, 0 ≤ 2*n
#check math_stat -- Type : Prop

-- rfl is a proof for 8 = 2*4, we use the reflexivity of the equal sign
-- recall rfl : ∀ {α : Type} {a : α}, a = a (basic reflexivity of the equal sign)
-- theorem or def, it doesn't matter that much
theorem easy : 8 = 2*4 := rfl
#check easy -- a proof has a tyoe equal to the initial statement


open Function
theorem constApply {y : β} {x : α} : const α y x = y := rfl
example (p : Nat → Prop) (h : p 1) : p (const Nat 1 2) := by simp only [constApply]; trace_state; exact h -- simplifies
example (p : α → Prop) (h : p a) : p (const Nat a 2) := by simp only [constApply]; trace_state; exact h -- simplifies
example (f : α → α) (p : α → Prop) (h : p (f a)) : p (const Nat (f a) 2) := by simp only [constApply]; trace_state; exact h -- simplifies


import tactic
import data.rel
import ruby.defs
import ruby.blocks
import ruby.rewrite1

open rel

variables {α β γ δ ε φ ψ : Type}

lemma sspp_eq_spss (r : rel α β) (s : rel β γ) (t : rel δ ε) (u : rel ε φ) (v : rel ψ (α × δ))
  : v ;; [r, t] ;; [s, u] = v ;; [r ;; s, t ;; u] :=
begin
  rw rel_seq_assoc,
  apply seq_cong_left,
  exact par_seq_dist r s t u,
end

lemma seq_lsh_seq_rsh (r : rel α ((β × γ) × δ))
  : r ;; lsh ;; rsh = r :=
begin
  rw [rel_seq_assoc, rsh_inv_left, seq_id_right],
end

--lemma seq_lsh_rsh : lsh ;; rsh = rsh ;; lsh := sorry

lemma seq_rsh_seq_lsh (r : rel α (β × (γ × δ)))
  : r ;; rsh ;; lsh = r :=
begin
  rw [rel_seq_assoc, rsh_inv_right, seq_id_right],
end

lemma seq_rsh_lsh_seq (r : rel (α × (β × γ)) δ)
  : rsh ;; lsh ;; r = r :=
begin
  rw [rsh_inv_right, seq_id_left],
end

lemma id_eq_rsh_lsh : idd = rsh ;; (@lsh α β γ)
  := rsh_inv_right.symm

lemma rel_seq_assoc' (r : rel α β) (s : rel β γ) (t : rel γ δ) :
  r ;; (s ;; t) = (r ;; s) ;; t := (comp_assoc r s t).symm

namespace tactic.interactive

meta def ruby_nf : tactic unit := `[
  simp only [
    sspp_eq_spss,
    seq_lsh_seq_rsh,
    seq_rsh_seq_lsh,
    seq_rsh_lsh_seq,
    id_eq_rsh_lsh,
    par_seq_dist,
    conv_par,
    conv_seq,
    conv_conv,
    rel_seq_assoc']
  ]

end tactic.interactive

example (r : rel (α × β) γ) (s : rel α δ) (t : rel γ ε)
  : (r† ;; [s, idd])† ;; t = (idd ;; [s†, idd]) ;; (r ;; t) :=
begin
  ruby_nf,
  sorry
end