/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Yury Kudryashov
-/
import algebra.group.type_tags
import algebra.hom.group
import algebra.opposites
import logic.embedding

/-!
# Definitions of group actions

This file defines a hierarchy of group action type-classes on top of the previously defined
notation classes `has_scalar` and its additive version `has_vadd`:

* `mul_action M α` and its additive version `add_action G P` are typeclasses used for
  actions of multiplicative and additive monoids and groups; they extend notation classes
  `has_scalar` and `has_vadd` that are defined in `algebra.group.defs`;
* `distrib_mul_action M A` is a typeclass for an action of a multiplicative monoid on
  an additive monoid such that `a • (b + c) = a • b + a • c` and `a • 0 = 0`.

The hierarchy is extended further by `module`, defined elsewhere.

Also provided are typeclasses for faithful and transitive actions, and typeclasses regarding the
interaction of different group actions,

* `smul_comm_class M N α` and its additive version `vadd_comm_class M N α`;
* `is_scalar_tower M N α` (no additive version).
* `is_central_scalar M α` (no additive version).

## Notation

- `a • b` is used as notation for `has_scalar.smul a b`.
- `a +ᵥ b` is used as notation for `has_vadd.vadd a b`.

## Implementation details

This file should avoid depending on other parts of `group_theory`, to avoid import cycles.
More sophisticated lemmas belong in `group_theory.group_action`.

## Tags

group action
-/

variables {M N G A B α β γ : Type*}

open function (injective surjective)

/-!
### Faithful actions
-/

/-- Typeclass for faithful actions. -/
class has_faithful_vadd (G : Type*) (P : Type*) [has_vadd G P] : Prop :=
(eq_of_vadd_eq_vadd : ∀ {g₁ g₂ : G}, (∀ p : P, g₁ +ᵥ p = g₂ +ᵥ p) → g₁ = g₂)

/-- Typeclass for faithful actions. -/
@[to_additive has_faithful_vadd]
class has_faithful_scalar (M : Type*) (α : Type*) [has_scalar M α] : Prop :=
(eq_of_smul_eq_smul : ∀ {m₁ m₂ : M}, (∀ a : α, m₁ • a = m₂ • a) → m₁ = m₂)

export has_faithful_scalar (eq_of_smul_eq_smul) has_faithful_vadd (eq_of_vadd_eq_vadd)

@[to_additive]
lemma smul_left_injective' [has_scalar M α] [has_faithful_scalar M α] :
  function.injective ((•) : M → α → α) :=
λ m₁ m₂ h, has_faithful_scalar.eq_of_smul_eq_smul (congr_fun h)

/-- See also `monoid.to_mul_action` and `mul_zero_class.to_smul_with_zero`. -/
@[priority 910, to_additive] -- see Note [lower instance priority]
instance has_mul.to_has_scalar (α : Type*) [has_mul α] : has_scalar α α := ⟨(*)⟩

@[simp, to_additive] lemma smul_eq_mul (α : Type*) [has_mul α] {a a' : α} : a • a' = a * a' := rfl

/-- Type class for additive monoid actions. -/
@[ext, protect_proj] class add_action (G : Type*) (P : Type*) [add_monoid G] extends has_vadd G P :=
(zero_vadd : ∀ p : P, (0 : G) +ᵥ p = p)
(add_vadd : ∀ (g₁ g₂ : G) (p : P), (g₁ + g₂) +ᵥ p = g₁ +ᵥ (g₂ +ᵥ p))

/-- Typeclass for multiplicative actions by monoids. This generalizes group actions. -/
@[ext, protect_proj, to_additive]
class mul_action (α : Type*) (β : Type*) [monoid α] extends has_scalar α β :=
(one_smul : ∀ b : β, (1 : α) • b = b)
(mul_smul : ∀ (x y : α) (b : β), (x * y) • b = x • y • b)

/-!
### (Pre)transitive action

`M` acts pretransitively on `α` if for any `x y` there is `g` such that `g • x = y` (or `g +ᵥ x = y`
for an additive action). A transitive action should furthermore have `α` nonempty.

In this section we define typeclasses `mul_action.is_pretransitive` and
`add_action.is_pretransitive` and provide `mul_action.exists_smul_eq`/`add_action.exists_vadd_eq`,
`mul_action.surjective_smul`/`add_action.surjective_vadd` as public interface to access this
property. We do not provide typeclasses `*_action.is_transitive`; users should assume
`[mul_action.is_pretransitive M α] [nonempty α]` instead. -/

/-- `M` acts pretransitively on `α` if for any `x y` there is `g` such that `g +ᵥ x = y`.
  A transitive action should furthermore have `α` nonempty. -/
class add_action.is_pretransitive (M α : Type*) [has_vadd M α] : Prop :=
(exists_vadd_eq : ∀ x y : α, ∃ g : M, g +ᵥ x = y)

/-- `M` acts pretransitively on `α` if for any `x y` there is `g` such that `g • x = y`.
  A transitive action should furthermore have `α` nonempty. -/
@[to_additive] class mul_action.is_pretransitive (M α : Type*) [has_scalar M α] : Prop :=
(exists_smul_eq : ∀ x y : α, ∃ g : M, g • x = y)

namespace mul_action

variables (M) {α} [has_scalar M α] [is_pretransitive M α]

@[to_additive] lemma exists_smul_eq (x y : α) : ∃ m : M, m • x = y :=
is_pretransitive.exists_smul_eq x y

@[to_additive] lemma surjective_smul (x : α) : surjective (λ c : M, c • x) := exists_smul_eq M x

/-- The regular action of a group on itself is transitive. -/
@[to_additive] instance regular.is_pretransitive [group G] : is_pretransitive G G :=
⟨λ x y, ⟨y * x⁻¹, inv_mul_cancel_right _ _⟩⟩

end mul_action

/-!
### Scalar tower and commuting actions
-/

/-- A typeclass mixin saying that two additive actions on the same space commute. -/
class vadd_comm_class (M N α : Type*) [has_vadd M α] [has_vadd N α] : Prop :=
(vadd_comm : ∀ (m : M) (n : N) (a : α), m +ᵥ (n +ᵥ a) = n +ᵥ (m +ᵥ a))

/-- A typeclass mixin saying that two multiplicative actions on the same space commute. -/
@[to_additive] class smul_comm_class (M N α : Type*) [has_scalar M α] [has_scalar N α] : Prop :=
(smul_comm : ∀ (m : M) (n : N) (a : α), m • n • a = n • m • a)

export mul_action (mul_smul) add_action (add_vadd) smul_comm_class (smul_comm)
  vadd_comm_class (vadd_comm)

/--
Frequently, we find ourselves wanting to express a bilinear map `M →ₗ[R] N →ₗ[R] P` or an
equivalence between maps `(M →ₗ[R] N) ≃ₗ[R] (M' →ₗ[R] N')` where the maps have an associated ring
`R`. Unfortunately, using definitions like these requires that `R` satisfy `comm_semiring R`, and
not just `semiring R`. Using `M →ₗ[R] N →+ P` and `(M →ₗ[R] N) ≃+ (M' →ₗ[R] N')` avoids this
problem, but throws away structure that is useful for when we _do_ have a commutative (semi)ring.

To avoid making this compromise, we instead state these definitions as `M →ₗ[R] N →ₗ[S] P` or
`(M →ₗ[R] N) ≃ₗ[S] (M' →ₗ[R] N')` and require `smul_comm_class S R` on the appropriate modules. When
the caller has `comm_semiring R`, they can set `S = R` and `smul_comm_class_self` will populate the
instance. If the caller only has `semiring R` they can still set either `R = ℕ` or `S = ℕ`, and
`add_comm_monoid.nat_smul_comm_class` or `add_comm_monoid.nat_smul_comm_class'` will populate
the typeclass, which is still sufficient to recover a `≃+` or `→+` structure.

An example of where this is used is `linear_map.prod_equiv`.
-/
library_note "bundled maps over different rings"

/-- Commutativity of actions is a symmetric relation. This lemma can't be an instance because this
would cause a loop in the instance search graph. -/
@[to_additive] lemma smul_comm_class.symm (M N α : Type*) [has_scalar M α] [has_scalar N α]
  [smul_comm_class M N α] : smul_comm_class N M α :=
⟨λ a' a b, (smul_comm a a' b).symm⟩

/-- Commutativity of additive actions is a symmetric relation. This lemma can't be an instance
because this would cause a loop in the instance search graph. -/
add_decl_doc vadd_comm_class.symm

@[to_additive] instance smul_comm_class_self (M α : Type*) [comm_monoid M] [mul_action M α] :
  smul_comm_class M M α :=
⟨λ a a' b, by rw [← mul_smul, mul_comm, mul_smul]⟩

/-- An instance of `is_scalar_tower M N α` states that the multiplicative
action of `M` on `α` is determined by the multiplicative actions of `M` on `N`
and `N` on `α`. -/
class is_scalar_tower (M N α : Type*) [has_scalar M N] [has_scalar N α] [has_scalar M α] : Prop :=
(smul_assoc : ∀ (x : M) (y : N) (z : α), (x • y) • z = x • (y • z))

@[simp] lemma smul_assoc {M N} [has_scalar M N] [has_scalar N α] [has_scalar M α]
  [is_scalar_tower M N α] (x : M) (y : N) (z : α) :
  (x • y) • z = x • y • z :=
is_scalar_tower.smul_assoc x y z

instance semigroup.is_scalar_tower [semigroup α] : is_scalar_tower α α α := ⟨mul_assoc⟩

/-- A typeclass indicating that the right (aka `mul_opposite`) and left actions by `M` on `α` are
equal, that is that `M` acts centrally on `α`. This can be thought of as a version of commutativity
for `•`. -/
class is_central_scalar (M α : Type*) [has_scalar M α] [has_scalar Mᵐᵒᵖ α] : Prop :=
(op_smul_eq_smul : ∀ (m : M) (a : α), mul_opposite.op m • a = m • a)

lemma is_central_scalar.unop_smul_eq_smul {M α : Type*} [has_scalar M α] [has_scalar Mᵐᵒᵖ α]
  [is_central_scalar M α] (m : Mᵐᵒᵖ) (a : α) : (mul_opposite.unop m) • a = m • a :=
mul_opposite.rec (by exact λ m, (is_central_scalar.op_smul_eq_smul _ _).symm) m

export is_central_scalar (op_smul_eq_smul unop_smul_eq_smul)

-- these instances are very low priority, as there is usually a faster way to find these instances

@[priority 50]
instance smul_comm_class.op_left [has_scalar M α] [has_scalar Mᵐᵒᵖ α]
  [is_central_scalar M α] [has_scalar N α] [smul_comm_class M N α] : smul_comm_class Mᵐᵒᵖ N α :=
⟨λ m n a, by rw [←unop_smul_eq_smul m (n • a), ←unop_smul_eq_smul m a, smul_comm]⟩

@[priority 50]
instance smul_comm_class.op_right [has_scalar M α] [has_scalar N α] [has_scalar Nᵐᵒᵖ α]
  [is_central_scalar N α] [smul_comm_class M N α] : smul_comm_class M Nᵐᵒᵖ α :=
⟨λ m n a, by rw [←unop_smul_eq_smul n (m • a), ←unop_smul_eq_smul n a, smul_comm]⟩

@[priority 50]
instance is_scalar_tower.op_left
  [has_scalar M α] [has_scalar Mᵐᵒᵖ α] [is_central_scalar M α]
  [has_scalar M N] [has_scalar Mᵐᵒᵖ N] [is_central_scalar M N]
  [has_scalar N α] [is_scalar_tower M N α] : is_scalar_tower Mᵐᵒᵖ N α :=
⟨λ m n a, by rw [←unop_smul_eq_smul m (n • a), ←unop_smul_eq_smul m n, smul_assoc]⟩

@[priority 50]
instance is_scalar_tower.op_right [has_scalar M α] [has_scalar M N]
  [has_scalar N α] [has_scalar Nᵐᵒᵖ α] [is_central_scalar N α]
  [is_scalar_tower M N α] : is_scalar_tower M Nᵐᵒᵖ α :=
⟨λ m n a, by rw [←unop_smul_eq_smul n a, ←unop_smul_eq_smul (m • n) a, mul_opposite.unop_smul,
                 smul_assoc]⟩

namespace has_scalar
variables [has_scalar M α]

/-- Auxiliary definition for `has_scalar.comp`, `mul_action.comp_hom`,
`distrib_mul_action.comp_hom`, `module.comp_hom`, etc. -/
@[simp, to_additive  /-" Auxiliary definition for `has_vadd.comp`, `add_action.comp_hom`, etc. "-/]
def comp.smul (g : N → M) (n : N) (a : α) : α :=
g n • a

variables (α)

/-- An action of `M` on `α` and a function `N → M` induces an action of `N` on `α`.

See note [reducible non-instances]. Since this is reducible, we make sure to go via
`has_scalar.comp.smul` to prevent typeclass inference unfolding too far. -/
@[reducible, to_additive /-" An additive action of `M` on `α` and a function `N → M` induces
  an additive action of `N` on `α` "-/]
def comp (g : N → M) : has_scalar N α :=
{ smul := has_scalar.comp.smul g }

variables {α}

/-- Given a tower of scalar actions `M → α → β`, if we use `has_scalar.comp`
to pull back both of `M`'s actions by a map `g : N → M`, then we obtain a new
tower of scalar actions `N → α → β`.

This cannot be an instance because it can cause infinite loops whenever the `has_scalar` arguments
are still metavariables.
-/
@[priority 100]
lemma comp.is_scalar_tower [has_scalar M β] [has_scalar α β] [is_scalar_tower M α β]
  (g : N → M) :
  (by haveI := comp α g; haveI := comp β g; exact is_scalar_tower N α β) :=
by exact {smul_assoc := λ n, @smul_assoc _ _ _ _ _ _ _ (g n) }

/--
This cannot be an instance because it can cause infinite loops whenever the `has_scalar` arguments
are still metavariables.
-/
@[priority 100]
lemma comp.smul_comm_class [has_scalar β α] [smul_comm_class M β α] (g : N → M) :
  (by haveI := comp α g; exact smul_comm_class N β α) :=
by exact {smul_comm := λ n, @smul_comm _ _ _ _ _ _ (g n) }

/--
This cannot be an instance because it can cause infinite loops whenever the `has_scalar` arguments
are still metavariables.
-/
@[priority 100]
lemma comp.smul_comm_class' [has_scalar β α] [smul_comm_class β M α] (g : N → M) :
  (by haveI := comp α g; exact smul_comm_class β N α) :=
by exact {smul_comm := λ _ n, @smul_comm _ _ _ _ _ _ _ (g n) }

end has_scalar

section

/-- Note that the `smul_comm_class α β β` typeclass argument is usually satisfied by `algebra α β`.
-/
@[to_additive]
lemma mul_smul_comm [has_mul β] [has_scalar α β] [smul_comm_class α β β] (s : α) (x y : β) :
  x * (s • y) = s • (x * y) :=
(smul_comm s x y).symm

/-- Note that the `is_scalar_tower α β β` typeclass argument is usually satisfied by `algebra α β`.
-/
lemma smul_mul_assoc [has_mul β] [has_scalar α β] [is_scalar_tower α β β] (r : α) (x y : β)  :
  (r • x) * y = r • (x * y) :=
smul_assoc r x y

variables [has_scalar M α]

lemma commute.smul_right [has_mul α] [smul_comm_class M α α] [is_scalar_tower M α α]
  {a b : α} (h : commute a b) (r : M) :
  commute a (r • b) :=
(mul_smul_comm _ _ _).trans ((congr_arg _ h).trans $ (smul_mul_assoc _ _ _).symm)

lemma commute.smul_left [has_mul α] [smul_comm_class M α α] [is_scalar_tower M α α]
  {a b : α} (h : commute a b) (r : M) :
  commute (r • a) b :=
(h.symm.smul_right r).symm

end

section ite
variables [has_scalar M α] (p : Prop) [decidable p]

@[to_additive] lemma ite_smul (a₁ a₂ : M) (b : α) : (ite p a₁ a₂) • b = ite p (a₁ • b) (a₂ • b) :=
by split_ifs; refl

@[to_additive] lemma smul_ite (a : M) (b₁ b₂ : α) : a • (ite p b₁ b₂) = ite p (a • b₁) (a • b₂) :=
by split_ifs; refl

end ite

section
variables [monoid M] [mul_action M α]

@[to_additive] lemma smul_smul (a₁ a₂ : M) (b : α) : a₁ • a₂ • b = (a₁ * a₂) • b :=
(mul_smul _ _ _).symm

variable (M)
@[simp, to_additive] theorem one_smul (b : α) : (1 : M) • b = b := mul_action.one_smul _

/-- `has_scalar` version of `one_mul_eq_id` -/
@[to_additive]
lemma one_smul_eq_id : ((•) (1 : M) : α → α) = id := funext $ one_smul _

/-- `has_scalar` version of `comp_mul_left` -/
@[to_additive]
lemma comp_smul_left (a₁ a₂ : M) : (•) a₁ ∘ (•) a₂ = ((•) (a₁ * a₂) : α → α) :=
funext $ λ _, (mul_smul _ _ _).symm

variables {M}

/-- Pullback a multiplicative action along an injective map respecting `•`.
See note [reducible non-instances]. -/
@[reducible, to_additive "Pullback an additive action along an injective map respecting `+ᵥ`."]
protected def function.injective.mul_action [has_scalar M β] (f : β → α)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_action M β :=
{ smul := (•),
  one_smul := λ x, hf $ (smul _ _).trans $ one_smul _ (f x),
  mul_smul := λ c₁ c₂ x, hf $ by simp only [smul, mul_smul] }

/-- Pushforward a multiplicative action along a surjective map respecting `•`.
See note [reducible non-instances]. -/
@[reducible, to_additive "Pushforward an additive action along a surjective map respecting `+ᵥ`."]
protected def function.surjective.mul_action [has_scalar M β] (f : α → β) (hf : surjective f)
  (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_action M β :=
{ smul := (•),
  one_smul := λ y, by { rcases hf y with ⟨x, rfl⟩, rw [← smul, one_smul] },
  mul_smul := λ c₁ c₂ y, by { rcases hf y with ⟨x, rfl⟩, simp only [← smul, mul_smul] } }

/-- Push forward the action of `R` on `M` along a compatible surjective map `f : R →* S`.

See also `function.surjective.distrib_mul_action_left` and `function.surjective.module_left`.
-/
@[reducible, to_additive "Push forward the action of `R` on `M` along a compatible
surjective map `f : R →+ S`."]
def function.surjective.mul_action_left {R S M : Type*} [monoid R] [mul_action R M]
  [monoid S] [has_scalar S M]
  (f : R →* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  mul_action S M :=
{ smul := (•),
  one_smul := λ b, by rw [← f.map_one, hsmul, one_smul],
  mul_smul := hf.forall₂.mpr $ λ a b x, by simp only [← f.map_mul, hsmul, mul_smul] }

section

variables (M)

/-- The regular action of a monoid on itself by left multiplication.

This is promoted to a module by `semiring.to_module`. -/
@[priority 910, to_additive] -- see Note [lower instance priority]
instance monoid.to_mul_action : mul_action M M :=
{ smul := (*),
  one_smul := one_mul,
  mul_smul := mul_assoc }

/-- The regular action of a monoid on itself by left addition.

This is promoted to an `add_torsor` by `add_group_is_add_torsor`. -/
add_decl_doc add_monoid.to_add_action

instance is_scalar_tower.left : is_scalar_tower M M α :=
⟨λ x y z, mul_smul x y z⟩

variables {M}

/-- Note that the `is_scalar_tower M α α` and `smul_comm_class M α α` typeclass arguments are
usually satisfied by `algebra M α`. -/
lemma smul_mul_smul [has_mul α] (r s : M) (x y : α)
  [is_scalar_tower M α α] [smul_comm_class M α α] :
  (r • x) * (s • y) = (r * s) • (x * y) :=
by rw [smul_mul_assoc, mul_smul_comm, ← smul_assoc, smul_eq_mul]

end

namespace mul_action

variables (M α)

/-- Embedding of `α` into functions `M → α` induced by a multiplicative action of `M` on `α`. -/
@[to_additive] def to_fun : α ↪ (M → α) :=
⟨λ y x, x • y, λ y₁ y₂ H, one_smul M y₁ ▸ one_smul M y₂ ▸ by convert congr_fun H 1⟩

/-- Embedding of `α` into functions `M → α` induced by an additive action of `M` on `α`. -/
add_decl_doc add_action.to_fun

variables {M α}

@[simp, to_additive] lemma to_fun_apply (x : M) (y : α) : mul_action.to_fun M α y x = x • y :=
rfl

variable (α)

/-- A multiplicative action of `M` on `α` and a monoid homomorphism `N → M` induce
a multiplicative action of `N` on `α`.

See note [reducible non-instances]. -/
@[reducible, to_additive] def comp_hom [monoid N] (g : N →* M) :
  mul_action N α :=
{ smul := has_scalar.comp.smul g,
  one_smul := by simp [g.map_one, mul_action.one_smul],
  mul_smul := by simp [g.map_mul, mul_action.mul_smul] }

/-- An additive action of `M` on `α` and an additive monoid homomorphism `N → M` induce
an additive action of `N` on `α`.

See note [reducible non-instances]. -/
add_decl_doc add_action.comp_hom

end mul_action

end

section compatible_scalar

@[simp] lemma smul_one_smul {M} (N) [monoid N] [has_scalar M N] [mul_action N α] [has_scalar M α]
  [is_scalar_tower M N α] (x : M) (y : α) :
  (x • (1 : N)) • y = x • y :=
by rw [smul_assoc, one_smul]

@[simp] lemma smul_one_mul {M N} [monoid N] [has_scalar M N] [is_scalar_tower M N N] (x : M)
  (y : N) : (x • 1) * y = x • y :=
smul_one_smul N x y

@[simp, to_additive] lemma mul_smul_one
  {M N} [mul_one_class N] [has_scalar M N] [smul_comm_class M N N] (x : M) (y : N) :
  y * (x • 1) = x • y :=
by rw [← smul_eq_mul, ← smul_comm, smul_eq_mul, mul_one]

lemma is_scalar_tower.of_smul_one_mul {M N} [monoid N] [has_scalar M N]
  (h : ∀ (x : M) (y : N), (x • (1 : N)) * y = x • y) :
  is_scalar_tower M N N :=
⟨λ x y z, by rw [← h, smul_eq_mul, mul_assoc, h, smul_eq_mul]⟩

@[to_additive] lemma smul_comm_class.of_mul_smul_one {M N} [monoid N] [has_scalar M N]
  (H : ∀ (x : M) (y : N), y * (x • (1 : N)) = x • y) : smul_comm_class M N N :=
⟨λ x y z, by rw [← H x z, smul_eq_mul, ← H, smul_eq_mul, mul_assoc]⟩

end compatible_scalar

/-- Typeclass for multiplicative actions on additive structures. This generalizes group modules. -/
@[ext] class distrib_mul_action (M : Type*) (A : Type*) [monoid M] [add_monoid A]
  extends mul_action M A :=
(smul_add : ∀(r : M) (x y : A), r • (x + y) = r • x + r • y)
(smul_zero : ∀(r : M), r • (0 : A) = 0)

section
variables [monoid M] [add_monoid A] [distrib_mul_action M A]

theorem smul_add (a : M) (b₁ b₂ : A) : a • (b₁ + b₂) = a • b₁ + a • b₂ :=
distrib_mul_action.smul_add _ _ _

@[simp] theorem smul_zero (a : M) : a • (0 : A) = 0 :=
distrib_mul_action.smul_zero _

/-- Pullback a distributive multiplicative action along an injective additive monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.distrib_mul_action [add_monoid B] [has_scalar M B] (f : B →+ A)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  distrib_mul_action M B :=
{ smul := (•),
  smul_add := λ c x y, hf $ by simp only [smul, f.map_add, smul_add],
  smul_zero := λ c, hf $ by simp only [smul, f.map_zero, smul_zero],
  .. hf.mul_action f smul }

/-- Pushforward a distributive multiplicative action along a surjective additive monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.distrib_mul_action [add_monoid B] [has_scalar M B] (f : A →+ B)
  (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  distrib_mul_action M B :=
{ smul := (•),
  smul_add := λ c x y, by { rcases hf x with ⟨x, rfl⟩, rcases hf y with ⟨y, rfl⟩,
    simp only [smul_add, ← smul, ← f.map_add] },
  smul_zero := λ c, by simp only [← f.map_zero, ← smul, smul_zero],
  .. hf.mul_action f smul }

/-- Push forward the action of `R` on `M` along a compatible surjective map `f : R →* S`.

See also `function.surjective.mul_action_left` and `function.surjective.module_left`.
-/
@[reducible]
def function.surjective.distrib_mul_action_left {R S M : Type*} [monoid R] [add_monoid M]
  [distrib_mul_action R M] [monoid S] [has_scalar S M]
  (f : R →* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  distrib_mul_action S M :=
{ smul := (•),
  smul_zero := hf.forall.mpr $ λ c, by rw [hsmul, smul_zero],
  smul_add := hf.forall.mpr $ λ c x y, by simp only [hsmul, smul_add],
  .. hf.mul_action_left f hsmul }

variable (A)

/-- Compose a `distrib_mul_action` with a `monoid_hom`, with action `f r' • m`.
See note [reducible non-instances]. -/
@[reducible] def distrib_mul_action.comp_hom [monoid N] (f : N →* M) :
  distrib_mul_action N A :=
{ smul := has_scalar.comp.smul f,
  smul_zero := λ x, smul_zero (f x),
  smul_add := λ x, smul_add (f x),
  .. mul_action.comp_hom A f }

/-- Each element of the monoid defines a additive monoid homomorphism. -/
@[simps]
def distrib_mul_action.to_add_monoid_hom (x : M) : A →+ A :=
{ to_fun := (•) x,
  map_zero' := smul_zero x,
  map_add' := smul_add x }

variables (M)

/-- Each element of the monoid defines an additive monoid homomorphism. -/
@[simps]
def distrib_mul_action.to_add_monoid_End : M →* add_monoid.End A :=
{ to_fun := distrib_mul_action.to_add_monoid_hom A,
  map_one' := add_monoid_hom.ext $ one_smul M,
  map_mul' := λ x y, add_monoid_hom.ext $ mul_smul x y }

end

section
variables [monoid M] [add_group A] [distrib_mul_action M A]

@[simp] theorem smul_neg (r : M) (x : A) : r • (-x) = -(r • x) :=
eq_neg_of_add_eq_zero $ by rw [← smul_add, neg_add_self, smul_zero]

theorem smul_sub (r : M) (x y : A) : r • (x - y) = r • x - r • y :=
by rw [sub_eq_add_neg, sub_eq_add_neg, smul_add, smul_neg]

end

/-- Typeclass for multiplicative actions on multiplicative structures. This generalizes
conjugation actions. -/
@[ext] class mul_distrib_mul_action (M : Type*) (A : Type*) [monoid M] [monoid A]
  extends mul_action M A :=
(smul_mul : ∀ (r : M) (x y : A), r • (x * y) = (r • x) * (r • y))
(smul_one : ∀ (r : M), r • (1 : A) = 1)

export mul_distrib_mul_action (smul_one)

section
variables [monoid M] [monoid A] [mul_distrib_mul_action M A]

theorem smul_mul' (a : M) (b₁ b₂ : A) : a • (b₁ * b₂) = (a • b₁) * (a • b₂) :=
mul_distrib_mul_action.smul_mul _ _ _

/-- Pullback a multiplicative distributive multiplicative action along an injective monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.mul_distrib_mul_action [monoid B] [has_scalar M B] (f : B →* A)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_distrib_mul_action M B :=
{ smul := (•),
  smul_mul := λ c x y, hf $ by simp only [smul, f.map_mul, smul_mul'],
  smul_one := λ c, hf $ by simp only [smul, f.map_one, smul_one],
  .. hf.mul_action f smul }

/-- Pushforward a multiplicative distributive multiplicative action along a surjective monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.mul_distrib_mul_action [monoid B] [has_scalar M B] (f : A →* B)
  (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_distrib_mul_action M B :=
{ smul := (•),
  smul_mul := λ c x y, by { rcases hf x with ⟨x, rfl⟩, rcases hf y with ⟨y, rfl⟩,
    simp only [smul_mul', ← smul, ← f.map_mul] },
  smul_one := λ c, by simp only [← f.map_one, ← smul, smul_one],
  .. hf.mul_action f smul }

variable (A)

/-- Compose a `mul_distrib_mul_action` with a `monoid_hom`, with action `f r' • m`.
See note [reducible non-instances]. -/
@[reducible] def mul_distrib_mul_action.comp_hom [monoid N] (f : N →* M) :
  mul_distrib_mul_action N A :=
{ smul := has_scalar.comp.smul f,
  smul_one := λ x, smul_one (f x),
  smul_mul := λ x, smul_mul' (f x),
  .. mul_action.comp_hom A f }

/-- Scalar multiplication by `r` as a `monoid_hom`. -/
def mul_distrib_mul_action.to_monoid_hom (r : M) : A →* A :=
{ to_fun := (•) r,
  map_one' := smul_one r,
  map_mul' := smul_mul' r }

variable {A}

@[simp] lemma mul_distrib_mul_action.to_monoid_hom_apply (r : M) (x : A) :
  mul_distrib_mul_action.to_monoid_hom A r x = r • x := rfl

variables (M A)

/-- Each element of the monoid defines a monoid homomorphism. -/
@[simps]
def mul_distrib_mul_action.to_monoid_End : M →* monoid.End A :=
{ to_fun := mul_distrib_mul_action.to_monoid_hom A,
  map_one' := monoid_hom.ext $ one_smul M,
  map_mul' := λ x y, monoid_hom.ext $ mul_smul x y }

end

section
variables [monoid M] [group A] [mul_distrib_mul_action M A]

@[simp] theorem smul_inv' (r : M) (x : A) : r • (x⁻¹) = (r • x)⁻¹ :=
(mul_distrib_mul_action.to_monoid_hom A r).map_inv x

theorem smul_div' (r : M) (x y : A) : r • (x / y) = (r • x) / (r • y) :=
(mul_distrib_mul_action.to_monoid_hom A r).map_div x y

end

variable (α)

/-- The monoid of endomorphisms.

Note that this is generalized by `category_theory.End` to categories other than `Type u`. -/
protected def function.End := α → α

instance : monoid (function.End α) :=
{ one := id,
  mul := (∘),
  mul_assoc := λ f g h, rfl,
  mul_one := λ f, rfl,
  one_mul := λ f, rfl, }

instance : inhabited (function.End α) := ⟨1⟩

variable {α}

/-- The tautological action by `function.End α` on `α`.

This is generalized to bundled endomorphisms by:
* `equiv.perm.apply_mul_action`
* `add_monoid.End.apply_distrib_mul_action`
* `add_aut.apply_distrib_mul_action`
* `mul_aut.apply_mul_distrib_mul_action`
* `ring_hom.apply_distrib_mul_action`
* `linear_equiv.apply_distrib_mul_action`
* `linear_map.apply_module`
* `ring_hom.apply_mul_semiring_action`
* `alg_equiv.apply_mul_semiring_action`
-/
instance function.End.apply_mul_action : mul_action (function.End α) α :=
{ smul := ($),
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] lemma function.End.smul_def (f : function.End α) (a : α) : f • a = f a := rfl

/-- `function.End.apply_mul_action` is faithful. -/
instance function.End.apply_has_faithful_scalar : has_faithful_scalar (function.End α) α :=
⟨λ x y, funext⟩

/-- The tautological action by `add_monoid.End α` on `α`.

This generalizes `function.End.apply_mul_action`. -/
instance add_monoid.End.apply_distrib_mul_action [add_monoid α] :
  distrib_mul_action (add_monoid.End α) α :=
{ smul := ($),
  smul_zero := add_monoid_hom.map_zero,
  smul_add := add_monoid_hom.map_add,
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] lemma add_monoid.End.smul_def [add_monoid α] (f : add_monoid.End α) (a : α) :
  f • a = f a := rfl

/-- `add_monoid.End.apply_distrib_mul_action` is faithful. -/
instance add_monoid.End.apply_has_faithful_scalar [add_monoid α] :
  has_faithful_scalar (add_monoid.End α) α :=
⟨add_monoid_hom.ext⟩

/-- The monoid hom representing a monoid action.

When `M` is a group, see `mul_action.to_perm_hom`. -/
def mul_action.to_End_hom [monoid M] [mul_action M α] : M →* function.End α :=
{ to_fun := (•),
  map_one' := funext (one_smul M),
  map_mul' := λ x y, funext (mul_smul x y) }

/-- The monoid action induced by a monoid hom to `function.End α`

See note [reducible non-instances]. -/
@[reducible]
def mul_action.of_End_hom [monoid M] (f : M →* function.End α) : mul_action M α :=
mul_action.comp_hom α f

/-- The tautological additive action by `additive (function.End α)` on `α`. -/
instance add_action.function_End : add_action (additive (function.End α)) α :=
{ vadd := ($),
  zero_vadd := λ _, rfl,
  add_vadd := λ _ _ _, rfl }

/-- The additive monoid hom representing an additive monoid action.

When `M` is a group, see `add_action.to_perm_hom`. -/
def add_action.to_End_hom [add_monoid M] [add_action M α] : M →+ additive (function.End α) :=
{ to_fun := (+ᵥ),
  map_zero' := funext (zero_vadd M),
  map_add' := λ x y, funext (add_vadd x y) }

/-- The additive action induced by a hom to `additive (function.End α)`

See note [reducible non-instances]. -/
@[reducible]
def add_action.of_End_hom [add_monoid M] (f : M →+ additive (function.End α)) : add_action M α :=
add_action.comp_hom α f


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

! This file was ported from Lean 3 source module data.rat.sqrt
! leanprover-community/mathlib commit 46a64b5b4268c594af770c44d9e502afc6a515cb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Rat.Order
import Mathlib.Data.Rat.Lemmas
import Mathlib.Data.Int.Sqrt

/-!
# Square root on rational numbers

This file defines the square root function on rational numbers `Rat.sqrt`
and proves several theorems about it.

-/

namespace Rat

/-- Square root function on rational numbers, defined by taking the (integer) square root of the
numerator and the square root (on natural numbers) of the denominator. -/
-- @[pp_nodot] porting note: unknown attribute
def sqrt (q : ℚ) : ℚ := mkRat (Int.sqrt q.num) (Nat.sqrt q.den)
#align rat.sqrt Rat.sqrt

theorem sqrt_eq (q : ℚ) : Rat.sqrt (q * q) = |q| := by
  rw [sqrt, mul_self_num, mul_self_den, Int.sqrt_eq, Nat.sqrt_eq, abs_def, divInt_ofNat]
#align rat.sqrt_eq Rat.sqrt_eq

theorem exists_mul_self (x : ℚ) : (∃ q, q * q = x) ↔ Rat.sqrt x * Rat.sqrt x = x :=
  ⟨fun ⟨n, hn⟩ => by rw [← hn, sqrt_eq, abs_mul_abs_self], fun h => ⟨Rat.sqrt x, h⟩⟩
#align rat.exists_mul_self Rat.exists_mul_self

theorem sqrt_nonneg (q : ℚ) : 0 ≤ Rat.sqrt q :=
  nonneg_iff_zero_le.1 <|
    (divInt_nonneg _ <|
          Int.coe_nat_pos.2 <|
            Nat.pos_of_ne_zero fun H => q.den_nz <| Nat.sqrt_eq_zero.1 H).2 <|
      Int.coe_nat_nonneg _
#align rat.sqrt_nonneg Rat.sqrt_nonneg

end Rat


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison
-/
import algebra.group.defs
import data.option.basic
import logic.relation

/-!
# Shapes of homological complexes

We define a structure `complex_shape ι` for describing the shapes of homological complexes
indexed by a type `ι`.
This is intended to capture chain complexes and cochain complexes, indexed by either `ℕ` or `ℤ`,
as well as more exotic examples.

Rather than insisting that the indexing type has a `succ` function
specifying where differentials should go,
inside `c : complex_shape` we have `c.rel : ι → ι → Prop`,
and when we define `homological_complex`
we only allow nonzero differentials `d i j` from `i` to `j` if `c.rel i j`.
Further, we require that `{ j // c.rel i j }` and `{ i // c.rel i j }` are subsingletons.
This means that the shape consists of some union of lines, rays, intervals, and circles.

Convenience functions `c.next` and `c.prev` provide, as an `option`, these related elements
when they exist.

This design aims to avoid certain problems arising from dependent type theory.
In particular we never have to ensure morphisms `d i : X i ⟶ X (succ i)` compose as
expected (which would often require rewriting by equations in the indexing type).
Instead such identities become separate proof obligations when verifying that a
complex we've constructed is of the desired shape.

If `α` is an `add_right_cancel_semigroup`, then we define `up α : complex_shape α`,
the shape appropriate for cohomology,so `d : X i ⟶ X j` is nonzero only when `j = i + 1`,
as well as `down α : complex_shape α`, appropriate for homology,
so `d : X i ⟶ X j` is nonzero only when `i = j + 1`.
(Later we'll introduce `cochain_complex` and `chain_complex` as abbreviations for
`homological_complex` with one of these shapes baked in.)
-/

open_locale classical
noncomputable theory

/--
A `c : complex_shape ι` describes the shape of a chain complex,
with chain groups indexed by `ι`.
Typically `ι` will be `ℕ`, `ℤ`, or `fin n`.

There is a relation `rel : ι → ι → Prop`,
and we will only allow a non-zero differential from `i` to `j` when `rel i j`.

There are axioms which imply `{ j // c.rel i j }` and `{ i // c.rel i j }` are subsingletons.
This means that the shape consists of some union of lines, rays, intervals, and circles.

Below we define `c.next` and `c.prev` which provide, as an `option`, these related elements.
-/
@[ext, nolint has_inhabited_instance]
structure complex_shape (ι : Type*) :=
(rel : ι → ι → Prop)
(next_eq : ∀ {i j j'}, rel i j → rel i j' → j = j')
(prev_eq : ∀ {i i' j}, rel i j → rel i' j → i = i')

namespace complex_shape
variables {ι : Type*}

/--
The complex shape where only differentials from each `X.i` to itself are allowed.

This is mostly only useful so we can describe the relation of "related in `k` steps" below.
-/
@[simps]
def refl (ι : Type*) : complex_shape ι :=
{ rel := λ i j, i = j,
  next_eq := λ i j j' w w', w.symm.trans w',
  prev_eq := λ i i' j w w', w.trans w'.symm, }

/--
The reverse of a `complex_shape`.
-/
@[simps]
def symm (c : complex_shape ι) : complex_shape ι :=
{ rel := λ i j, c.rel j i,
  next_eq := λ i j j' w w', c.prev_eq w w',
  prev_eq := λ i i' j w w', c.next_eq w w', }

@[simp]
lemma symm_symm (c : complex_shape ι) : c.symm.symm = c :=
by { ext, simp, }

/--
The "composition" of two `complex_shape`s.

We need this to define "related in k steps" later.
-/
@[simp]
def trans (c₁ c₂ : complex_shape ι) : complex_shape ι :=
{ rel := relation.comp c₁.rel c₂.rel,
  next_eq := λ i j j' w w',
  begin
    obtain ⟨k, w₁, w₂⟩ := w,
    obtain ⟨k', w₁', w₂'⟩ := w',
    rw c₁.next_eq w₁ w₁' at w₂,
    exact c₂.next_eq w₂ w₂',
  end,
  prev_eq := λ i i' j w w',
  begin
    obtain ⟨k, w₁, w₂⟩ := w,
    obtain ⟨k', w₁', w₂'⟩ := w',
    rw c₂.prev_eq w₂ w₂' at w₁,
    exact c₁.prev_eq w₁ w₁',
  end }

instance subsingleton_next (c : complex_shape ι) (i : ι) :
  subsingleton { j // c.rel i j } :=
begin
  fsplit,
  rintros ⟨j, rij⟩ ⟨k, rik⟩,
  congr,
  exact c.next_eq rij rik,
end

instance subsingleton_prev (c : complex_shape ι) (j : ι) :
  subsingleton { i // c.rel i j } :=
begin
  fsplit,
  rintros ⟨i, rik⟩ ⟨j, rjk⟩,
  congr,
  exact c.prev_eq rik rjk,
end

/--
An option-valued arbitary choice of index `j` such that `rel i j`, if such exists.
-/
def next (c : complex_shape ι) (i : ι) : option { j // c.rel i j } :=
option.choice _

/--
An option-valued arbitary choice of index `i` such that `rel i j`, if such exists.
-/
def prev (c : complex_shape ι) (j : ι) : option { i // c.rel i j } :=
option.choice _

lemma next_eq_some (c : complex_shape ι) {i j : ι} (h : c.rel i j) : c.next i = some ⟨j, h⟩ :=
option.choice_eq _

lemma prev_eq_some (c : complex_shape ι) {i j : ι} (h : c.rel i j) : c.prev j = some ⟨i, h⟩ :=
option.choice_eq _

/--
The `complex_shape` allowing differentials from `X i` to `X (i+a)`.
(For example when `a = 1`, a cohomology theory indexed by `ℕ` or `ℤ`)
-/
@[simps]
def up' {α : Type*} [add_right_cancel_semigroup α] (a : α) : complex_shape α :=
{ rel := λ i j , i + a = j,
  next_eq := λ i j k hi hj, hi.symm.trans hj,
  prev_eq := λ i j k hi hj, add_right_cancel (hi.trans hj.symm), }

/--
The `complex_shape` allowing differentials from `X (j+a)` to `X j`.
(For example when `a = 1`, a homology theory indexed by `ℕ` or `ℤ`)
-/
@[simps]
def down' {α : Type*} [add_right_cancel_semigroup α] (a : α) : complex_shape α :=
{ rel := λ i j , j + a = i,
  next_eq := λ i j k hi hj, add_right_cancel (hi.trans (hj.symm)),
  prev_eq := λ i j k hi hj, hi.symm.trans hj, }

/--
The `complex_shape` appropriate for cohomology, so `d : X i ⟶ X j` only when `j = i + 1`.
-/
@[simps]
def up (α : Type*) [add_right_cancel_semigroup α] [has_one α] : complex_shape α :=
up' 1

/--
The `complex_shape` appropriate for homology, so `d : X i ⟶ X j` only when `i = j + 1`.
-/
@[simps]
def down (α : Type*) [add_right_cancel_semigroup α] [has_one α] : complex_shape α :=
down' 1

end complex_shape


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Deniz Aydin
-/
import Mathlib.Init.Logic
import Mathlib.Init.Data.Ordering.Basic
import Mathlib.Tactic.Relation.Rfl
import Mathlib.Tactic.SplitIfs

/-!
# Orders

Defines classes for preorders, partial orders, and linear orders
and proves some basic lemmas about them.
-/

/-
TODO: Does Lean4 have an equivalent for this:
  Make sure instances defined in this file have lower priority than the ones
  defined for concrete structures
set_option default_priority 100
-/

universe u
variable {α : Type u}

-- set_option auto_param.check_exists false

section Preorder

/-!
### Definition of `Preorder` and lemmas about types with a `Preorder`
-/

/-- A preorder is a reflexive, transitive relation `≤` with `a < b` defined in the obvious way. -/
class Preorder (α : Type u) extends LE α, LT α where
  le_refl : ∀ a : α, a ≤ a
  le_trans : ∀ a b c : α, a ≤ b → b ≤ c → a ≤ c
  lt := λ a b => a ≤ b ∧ ¬ b ≤ a
  lt_iff_le_not_le : ∀ a b : α, a < b ↔ (a ≤ b ∧ ¬ b ≤ a) := by intros; rfl
#align preorder.to_has_le Preorder.toLE
#align preorder.to_has_lt Preorder.toLT

variable [Preorder α]

/-- The relation `≤` on a preorder is reflexive. -/
@[simp, refl] theorem le_refl : ∀ (a : α), a ≤ a :=
Preorder.le_refl

/-- The relation `≤` on a preorder is transitive. -/
theorem le_trans : ∀ {a b c : α}, a ≤ b → b ≤ c → a ≤ c :=
Preorder.le_trans _ _ _

theorem lt_iff_le_not_le : ∀ {a b : α}, a < b ↔ (a ≤ b ∧ ¬ b ≤ a) :=
Preorder.lt_iff_le_not_le _ _

theorem lt_of_le_not_le : ∀ {a b : α}, a ≤ b → ¬ b ≤ a → a < b
| _a, _b, hab, hba => lt_iff_le_not_le.mpr ⟨hab, hba⟩

theorem le_not_le_of_lt : ∀ {a b : α}, a < b → a ≤ b ∧ ¬ b ≤ a
| _a, _b, hab => lt_iff_le_not_le.mp hab

theorem le_of_eq {a b : α} : a = b → a ≤ b :=
λ h => h ▸ le_refl a

theorem ge_trans : ∀ {a b c : α}, a ≥ b → b ≥ c → a ≥ c :=
λ h₁ h₂ => le_trans h₂ h₁

theorem lt_irrefl : ∀ a : α, ¬ a < a
| _a, haa => match le_not_le_of_lt haa with
  | ⟨h1, h2⟩ => h2 h1

theorem gt_irrefl : ∀ a : α, ¬ a > a :=
lt_irrefl

theorem lt_trans : ∀ {a b c : α}, a < b → b < c → a < c
| _a, _b, _c, hab, hbc =>
  match le_not_le_of_lt hab, le_not_le_of_lt hbc with
  | ⟨hab, _⟩, ⟨hbc, hcb⟩ => lt_of_le_not_le (le_trans hab hbc) (λ hca => hcb (le_trans hca hab))

theorem gt_trans : ∀ {a b c : α}, a > b → b > c → a > c :=
λ h₁ h₂ => lt_trans h₂ h₁

theorem ne_of_lt {a b : α} (h : a < b) : a ≠ b :=
λ he => absurd h (he ▸ lt_irrefl a)

theorem ne_of_gt {a b : α} (h : b < a) : a ≠ b :=
λ he => absurd h (he ▸ lt_irrefl a)

theorem lt_asymm {a b : α} (h : a < b) : ¬ b < a :=
λ h1 : b < a => lt_irrefl a (lt_trans h h1)

theorem le_of_lt : ∀ {a b : α}, a < b → a ≤ b
| _a, _b, hab => (le_not_le_of_lt hab).left

theorem lt_of_lt_of_le : ∀ {a b c : α}, a < b → b ≤ c → a < c
| _a, _b, _c, hab, hbc =>
  let ⟨hab, hba⟩ := le_not_le_of_lt hab
  lt_of_le_not_le (le_trans hab hbc) $ λ hca => hba (le_trans hbc hca)

theorem lt_of_le_of_lt : ∀ {a b c : α}, a ≤ b → b < c → a < c
| _a, _b, _c, hab, hbc =>
  let ⟨hbc, hcb⟩ := le_not_le_of_lt hbc
  lt_of_le_not_le (le_trans hab hbc) $ λ hca => hcb (le_trans hca hab)

theorem gt_of_gt_of_ge {a b c : α} (h₁ : a > b) (h₂ : b ≥ c) : a > c :=
lt_of_le_of_lt h₂ h₁

theorem gt_of_ge_of_gt {a b c : α} (h₁ : a ≥ b) (h₂ : b > c) : a > c :=
lt_of_lt_of_le h₂ h₁

instance : @Trans α α α LE.le LE.le LE.le := ⟨le_trans⟩
instance : @Trans α α α LT.lt LT.lt LT.lt := ⟨lt_trans⟩
instance : @Trans α α α LT.lt LE.le LT.lt := ⟨lt_of_lt_of_le⟩
instance : @Trans α α α LE.le LT.lt LT.lt := ⟨lt_of_le_of_lt⟩
instance : @Trans α α α GE.ge GE.ge GE.ge := ⟨ge_trans⟩
instance : @Trans α α α GT.gt GT.gt GT.gt := ⟨gt_trans⟩
instance : @Trans α α α GT.gt GE.ge GT.gt := ⟨gt_of_gt_of_ge⟩
instance : @Trans α α α GE.ge GT.gt GT.gt := ⟨gt_of_ge_of_gt⟩

theorem not_le_of_gt {a b : α} (h : a > b) : ¬ a ≤ b :=
(le_not_le_of_lt h).right

theorem not_lt_of_ge {a b : α} (h : a ≥ b) : ¬ a < b :=
λ hab => not_le_of_gt hab h

theorem le_of_lt_or_eq : ∀ {a b : α}, (a < b ∨ a = b) → a ≤ b
| _a, _b, Or.inl hab => le_of_lt hab
| _a, _b, Or.inr hab => hab ▸ le_refl _

theorem le_of_eq_or_lt {a b : α} (h : a = b ∨ a < b) : a ≤ b := match h with
| (Or.inl h) => le_of_eq h
| (Or.inr h) => le_of_lt h

instance decidableLT_of_decidableLE [DecidableRel (. ≤ . : α → α → Prop)] :
  DecidableRel (. < . : α → α → Prop)
| a, b =>
  if hab : a ≤ b then
    if hba : b ≤ a then
      isFalse $ λ hab' => not_le_of_gt hab' hba
    else
      isTrue $ lt_of_le_not_le hab hba
  else
    isFalse $ λ hab' => hab (le_of_lt hab')

end Preorder

section PartialOrder

/-!
### Definition of `PartialOrder` and lemmas about types with a partial order
-/

/-- A partial order is a reflexive, transitive, antisymmetric relation `≤`. -/
class PartialOrder (α : Type u) extends Preorder α :=
(le_antisymm : ∀ a b : α, a ≤ b → b ≤ a → a = b)

variable [PartialOrder α]

theorem le_antisymm : ∀ {a b : α}, a ≤ b → b ≤ a → a = b :=
PartialOrder.le_antisymm _ _

theorem le_antisymm_iff {a b : α} : a = b ↔ a ≤ b ∧ b ≤ a :=
⟨λ e => ⟨le_of_eq e, le_of_eq e.symm⟩, λ ⟨h1, h2⟩ => le_antisymm h1 h2⟩

theorem lt_of_le_of_ne {a b : α} : a ≤ b → a ≠ b → a < b :=
λ h₁ h₂ => lt_of_le_not_le h₁ $ mt (le_antisymm h₁) h₂

instance decidableEq_of_decidableLE [DecidableRel (. ≤ . : α → α → Prop)] :
  DecidableEq α
| a, b =>
  if hab : a ≤ b then
    if hba : b ≤ a then
      isTrue (le_antisymm hab hba)
    else
      isFalse (λ heq => hba (heq ▸ le_refl _))
  else
    isFalse (λ heq => hab (heq ▸ le_refl _))

namespace Decidable

variable [@DecidableRel α (. ≤ .)]

theorem lt_or_eq_of_le {a b : α} (hab : a ≤ b) : a < b ∨ a = b :=
if hba : b ≤ a then Or.inr (le_antisymm hab hba)
else Or.inl (lt_of_le_not_le hab hba)

theorem eq_or_lt_of_le {a b : α} (hab : a ≤ b) : a = b ∨ a < b :=
(lt_or_eq_of_le hab).symm

theorem le_iff_lt_or_eq {a b : α} : a ≤ b ↔ a < b ∨ a = b :=
⟨lt_or_eq_of_le, le_of_lt_or_eq⟩

end Decidable

attribute [local instance] Classical.propDecidable

theorem lt_or_eq_of_le {a b : α} : a ≤ b → a < b ∨ a = b := Decidable.lt_or_eq_of_le

theorem le_iff_lt_or_eq {a b : α} : a ≤ b ↔ a < b ∨ a = b := Decidable.le_iff_lt_or_eq

end PartialOrder

section LinearOrder

/-!
### Definition of `LinearOrder` and lemmas about types with a linear order
-/

/-- Default definition of `max`. -/
def maxDefault {α : Type u} [LE α] [DecidableRel ((· ≤ ·) : α → α → Prop)] (a b : α) :=
if a ≤ b then b else a

/-- Default definition of `min`. -/
def minDefault {α : Type u} [LE α] [DecidableRel ((· ≤ ·) : α → α → Prop)] (a b : α) :=
if a ≤ b then a else b

/-- This attempts to prove that a given instance of `compare` is equal to `compareOfLessAndEq` by
introducing the arguments and trying the following approaches in order:

1. seeing if `rfl` works
2. seeing if the `compare` at hand is nonetheless essentially `compareOfLessAndEq`, but, because of
implicit arguments, requires us to unfold the defs and split the `if`s in the definition of
`compareOfLessAndEq`
3. seeing if we can split by cases on the arguments, then see if the defs work themselves out
  (useful when `compare` is defined via a `match` statement, as it is for `Bool`) -/
macro "compareOfLessAndEq_rfl" : tactic =>
  `(tactic| (intros a b; first | rfl |
    (simp only [compare, compareOfLessAndEq]; split_ifs <;> rfl) |
    (induction a <;> induction b <;> simp only [])))

/-- A linear order is reflexive, transitive, antisymmetric and total relation `≤`.
We assume that every linear ordered type has decidable `(≤)`, `(<)`, and `(=)`. -/
class LinearOrder (α : Type u) extends PartialOrder α, Min α, Max α, Ord α :=
  /-- A linear order is total. -/
  le_total (a b : α) : a ≤ b ∨ b ≤ a
  /-- In a linearly ordered type, we assume the order relations are all decidable. -/
  decidable_le : DecidableRel (. ≤ . : α → α → Prop)
  /-- In a linearly ordered type, we assume the order relations are all decidable. -/
  decidable_eq : DecidableEq α := @decidableEq_of_decidableLE _ _ decidable_le
  /-- In a linearly ordered type, we assume the order relations are all decidable. -/
  decidable_lt : DecidableRel (. < . : α → α → Prop) :=
    @decidableLT_of_decidableLE _ _ decidable_le
  min := fun a b => if a ≤ b then a else b
  max := fun a b => if a ≤ b then b else a
  /-- The minimum function is equivalent to the one you get from `minOfLe`. -/
  min_def : ∀ a b, min a b = if a ≤ b then a else b := by intros; rfl
  /-- The minimum function is equivalent to the one you get from `maxOfLe`. -/
  max_def : ∀ a b, max a b = if a ≤ b then b else a := by intros; rfl
  compare a b := compareOfLessAndEq a b
  /-- Comparison via `compare` is equal to the canonical comparison given decidable `<` and `=`. -/
  compare_eq_compareOfLessAndEq : ∀ a b, compare a b = compareOfLessAndEq a b := by
    compareOfLessAndEq_rfl

variable [LinearOrder α]

attribute [local instance] LinearOrder.decidable_le

theorem le_total : ∀ a b : α, a ≤ b ∨ b ≤ a :=
LinearOrder.le_total

theorem le_of_not_ge {a b : α} : ¬ a ≥ b → a ≤ b :=
Or.resolve_left (le_total b a)

theorem le_of_not_le {a b : α} : ¬ a ≤ b → b ≤ a :=
Or.resolve_left (le_total a b)

theorem not_lt_of_gt {a b : α} (h : a > b) : ¬ a < b :=
lt_asymm h

theorem lt_trichotomy (a b : α) : a < b ∨ a = b ∨ b < a :=
Or.elim
  (le_total a b)
  (λ h : a ≤ b   => Or.elim
    (Decidable.lt_or_eq_of_le h)
    (λ h : a < b => Or.inl h)
    (λ h : a = b => Or.inr (Or.inl h)))
  (λ h : b ≤ a   => Or.elim
    (Decidable.lt_or_eq_of_le h)
    (λ h : b < a => Or.inr (Or.inr h))
    (λ h : b = a => Or.inr (Or.inl h.symm)))

theorem le_of_not_lt {a b : α} (h : ¬ b < a) : a ≤ b :=
match lt_trichotomy a b with
| Or.inl hlt          => le_of_lt hlt
| Or.inr (Or.inl heq) => heq ▸ le_refl a
| Or.inr (Or.inr hgt) => absurd hgt h

theorem le_of_not_gt {a b : α} : ¬ a > b → a ≤ b := le_of_not_lt

theorem lt_of_not_ge {a b : α} (h : ¬ a ≥ b) : a < b :=
lt_of_le_not_le ((le_total _ _).resolve_right h) h

theorem lt_or_le (a b : α) : a < b ∨ b ≤ a :=
if hba : b ≤ a then Or.inr hba else Or.inl $ lt_of_not_ge hba

theorem le_or_lt (a b : α) : a ≤ b ∨ b < a :=
(lt_or_le b a).symm

theorem lt_or_ge : ∀ (a b : α), a < b ∨ a ≥ b := lt_or_le
theorem le_or_gt : ∀ (a b : α), a ≤ b ∨ a > b := le_or_lt

theorem lt_or_gt_of_ne {a b : α} (h : a ≠ b) : a < b ∨ a > b :=
match lt_trichotomy a b with
| Or.inl hlt          => Or.inl hlt
| Or.inr (Or.inl heq) => absurd heq h
| Or.inr (Or.inr hgt) => Or.inr hgt

theorem ne_iff_lt_or_gt {a b : α} : a ≠ b ↔ a < b ∨ a > b :=
⟨lt_or_gt_of_ne, λ o => match o with
  | Or.inl ol => ne_of_lt ol
  | Or.inr or => ne_of_gt or
⟩

theorem lt_iff_not_ge (x y : α) : x < y ↔ ¬ x ≥ y :=
⟨not_le_of_gt, lt_of_not_ge⟩

@[simp] theorem not_lt {a b : α} : ¬ a < b ↔ b ≤ a := ⟨le_of_not_gt, not_lt_of_ge⟩

@[simp] theorem not_le {a b : α} : ¬ a ≤ b ↔ b < a := (lt_iff_not_ge _ _).symm

instance (a b : α) : Decidable (a < b) :=
LinearOrder.decidable_lt a b

instance (a b : α) : Decidable (a ≤ b) :=
LinearOrder.decidable_le a b

instance (a b : α) : Decidable (a = b) :=
LinearOrder.decidable_eq a b

theorem eq_or_lt_of_not_lt {a b : α} (h : ¬ a < b) : a = b ∨ b < a :=
if h₁ : a = b then Or.inl h₁
else Or.inr (lt_of_not_ge (λ hge => h (lt_of_le_of_ne hge h₁)))

/- TODO: instances of classes that haven't been defined.

instance : is_total_preorder α (≤) :=
{trans := @le_trans _ _, total := le_total}

instance is_strict_weak_order_of_linear_order : is_strict_weak_order α (<) :=
is_strict_weak_order_of_is_total_preorder lt_iff_not_ge

instance is_strict_total_order_of_linear_order : is_strict_total_order α (<) :=
{ trichotomous := lt_trichotomy }
-/

/-- Perform a case-split on the ordering of `x` and `y` in a decidable linear order. -/
def lt_by_cases (x y : α) {P : Sort _}
 (h₁ : x < y → P) (h₂ : x = y → P) (h₃ : y < x → P) : P :=
if h : x < y then h₁ h else
if h' : y < x then h₃ h' else
h₂ (le_antisymm (le_of_not_gt h') (le_of_not_gt h))

theorem le_imp_le_of_lt_imp_lt {β} [Preorder α] [LinearOrder β]
  {a b : α} {c d : β} (H : d < c → b < a) (h : a ≤ b) : c ≤ d :=
le_of_not_lt $ λ h' => not_le_of_gt (H h') h

section Ord

theorem compare_lt_iff_lt {a b : α} : (compare a b = .lt) ↔ a < b := by
  rw [LinearOrder.compare_eq_compareOfLessAndEq, compareOfLessAndEq]
  split_ifs <;> simp only [*, lt_irrefl]

theorem compare_gt_iff_gt {a b : α} : (compare a b = .gt) ↔ a > b := by
  rw [LinearOrder.compare_eq_compareOfLessAndEq, compareOfLessAndEq]
  split_ifs <;> simp only [*, lt_irrefl, not_lt_of_gt]
  case _ h₁ h₂ =>
    have h : b < a := lt_trichotomy a b |>.resolve_left h₁ |>.resolve_left h₂
    exact true_iff_iff.2 h

theorem compare_eq_iff_eq {a b : α} : (compare a b = .eq) ↔ a = b := by
  rw [LinearOrder.compare_eq_compareOfLessAndEq, compareOfLessAndEq]
  split_ifs <;> simp only []
  case _ h   => exact false_iff_iff.2 <| ne_iff_lt_or_gt.2 <| .inl h
  case _ _ h => exact true_iff_iff.2 h
  case _ _ h => exact false_iff_iff.2 h

theorem compare_le_iff_le {a b : α} : (compare a b ≠ .gt) ↔ a ≤ b := by
  cases h : compare a b <;> simp only []
  · exact true_iff_iff.2 <| le_of_lt <| compare_lt_iff_lt.1 h
  · exact true_iff_iff.2 <| le_of_eq <| compare_eq_iff_eq.1 h
  · exact false_iff_iff.2 <| not_le_of_gt <| compare_gt_iff_gt.1 h

theorem compare_ge_iff_ge {a b : α} : (compare a b ≠ .lt) ↔ a ≥ b := by
  cases h : compare a b <;> simp only []
  · exact false_iff_iff.2 <| (lt_iff_not_ge a b).1 <| compare_lt_iff_lt.1 h
  · exact true_iff_iff.2 <| le_of_eq <| (·.symm) <| compare_eq_iff_eq.1 h
  · exact true_iff_iff.2 <| le_of_lt <| compare_gt_iff_gt.1 h

theorem compare_iff (a b : α) {o : Ordering} : compare a b = o ↔ o.toRel a b := by
  cases o <;> simp only [Ordering.toRel]
  · exact compare_lt_iff_lt
  · exact compare_eq_iff_eq
  · exact compare_gt_iff_gt

instance : Std.TransCmp (compare (α := α)) where
  symm a b := by
    cases h : compare a b <;>
    simp only [Ordering.swap] <;> symm
    · exact compare_gt_iff_gt.2 <| compare_lt_iff_lt.1 h
    · exact compare_eq_iff_eq.2 <| compare_eq_iff_eq.1 h |>.symm
    · exact compare_lt_iff_lt.2 <| compare_gt_iff_gt.1 h
  le_trans := fun h₁ h₂ ↦
    compare_le_iff_le.2 <| le_trans (compare_le_iff_le.1 h₁) (compare_le_iff_le.1 h₂)

end Ord

end LinearOrder


import ring_theory.power_series
import combinatorics.composition
import data.nat.parity

open power_series
noncomputable theory

variables {α : Type*}

/-- The sequence from section 1.1 of GFology -/
def sequence_one_one : ℕ → ℚ
| 0 := 0
| (n+1) := 2 * sequence_one_one n + 1

/-- Inductive proof of the formula -/
lemma inductive_proof : ∀ n, sequence_one_one n = 2^n - 1
| 0 := rfl
| (n+1) :=
begin
  rw [sequence_one_one, inductive_proof n, pow_succ],
  ring,
end

-- TODO: multivariate version
/-- Differentiate a power series -/
def differentiate [semiring α] : power_series α →+ power_series α :=
{ to_fun := λ f, mk (λ n, (n + 1) * coeff α (n+1) f),
  map_zero' :=
  begin
    ext,
    simp,
  end,
  map_add' := λ x y,
  begin
    ext,
    simp [mul_add],
  end }

@[simp]
lemma coeff_differentiate [semiring α] (f : power_series α) (n : ℕ) :
  coeff _ n (differentiate f) = (n+1) * coeff _ (n+1) f :=
coeff_mk _ _

section prod_map

variables {α₁ : Type*} {α₂ : Type*} {β₁ : Type*} {β₂ : Type*} (f : α₁ ↪ α₂) (g : β₁ ↪ β₂)

def embedding.prod_map : (α₁ × β₁) ↪ α₂ × β₂ :=
{ to_fun := prod.map f g,
  inj' := λ x y h, prod.ext (f.injective (prod.ext_iff.1 h).1) (g.injective (prod.ext_iff.1 h).2) }

variables {f} {g}

@[simp]
def embedding.coe_prod_map :
  ⇑(embedding.prod_map f g) = prod.map f g := rfl

end prod_map

/-- Product rule -/
lemma diff_mul [comm_semiring α] (f g : power_series α) :
  differentiate (f * g) = differentiate f * g + f * differentiate g :=
begin
  ext,
  simp only [coeff_mul, add_monoid_hom.map_add, coeff_differentiate],
  transitivity (finset.nat.antidiagonal (n + 1)).sum (λ (p : ℕ × ℕ), (↑(p.fst)) * (coeff α (p.fst)) f * (coeff α p.snd) g) + (finset.nat.antidiagonal (n + 1)).sum (λ (p : ℕ × ℕ), (coeff α p.fst) f * ((↑(p.snd)) * (coeff α p.snd) g)),
  { rw ← finset.sum_add_distrib, rw finset.mul_sum,
    apply finset.sum_congr rfl,
    intros x hx,
    rw [← mul_assoc _ (↑x.snd) _, mul_comm ((coeff α x.fst) f) (↑x.snd), mul_assoc, mul_assoc,
        ← add_mul, ← nat.cast_add, finset.nat.mem_antidiagonal.1 hx],
    simp },
  { refine congr (congr rfl _) _,
    { simp [finset.nat.sum_antidiagonal_succ] },
    { rw [← finset.nat.map_swap_antidiagonal, finset.sum_map],
      symmetry,
      rw [← finset.nat.map_swap_antidiagonal, finset.sum_map, finset.nat.sum_antidiagonal_succ],
      simp } }
end

@[simp]
lemma diff_const [semiring α] (a : α) :
  differentiate (C α a) = 0 :=
begin
  ext,
  simp [coeff_C],
end
@[simp]
lemma diff_one [semiring α] :
  differentiate (1 : power_series α) = 0 :=
diff_const _

@[simp]
lemma diff_X [semiring α]  :
  differentiate (X : power_series α) = 1 :=
begin
  ext,
  cases n,
  { simp [-coeff_zero_eq_constant_coeff] },
  have : n.succ + 1 ≠ 1,
    rintro ⟨⟩,
  simp [-coeff_zero_eq_constant_coeff, coeff_X, nat.succ_ne_zero, if_neg this],
end

/--
The generating function for a sequence is just the power series whose coefficients are the
sequence.
-/
@[reducible]
def generating_function (f : ℕ → α) : power_series α :=
power_series.mk f

-- example {α : Type*} [field α] {a b c : α} (h : a * c = b) : a = b * c⁻¹ :=
-- begin
--   library_search,
-- end
@[simp]
lemma constant_coeff_mk (f : ℕ → α) [semiring α] : constant_coeff _ (mk f) = f 0 :=
begin
  rw [← coeff_zero_eq_constant_coeff_apply, coeff_mk],
end
-- @[simp] lemma coeff_C_mul [semiring α] (n : ℕ) (φ : power_series α) (a : α) :
--   coeff α n (C α a * φ) = a * coeff α n φ :=
-- begin
--   sorry -- open PR to mathlib so sorry here
-- end
-- @[simp]
-- lemma coeff_smul (a : α) (n : ℕ) (f : power_series α) [semiring α] :
--   coeff _ n (a • f) = a * coeff _ n f :=
-- begin
--   change coeff _ _ (C _ _ * _) = _,
--   rw coeff_C_mul,
-- end
@[simp]
lemma constant_coeff_smul (a : α) (f : power_series α) [semiring α] :
  constant_coeff _ (a • f) = a * constant_coeff _ f :=
begin
  change constant_coeff _ (C _ _ * _) = _,
  simp,
end
lemma eq_mul_inv_iff [field α] {a b c : power_series α} (h : constant_coeff _ c ≠ 0) :
  a = b * c⁻¹ ↔ a * c = b :=
⟨λ k, by simp [k, mul_assoc, power_series.inv_mul _ h],
 λ k, by simp [← k, mul_assoc, power_series.mul_inv _ h]⟩

lemma mul_inv_eq_iff [field α] {a b c : power_series α} (h : constant_coeff _ c ≠ 0) :
  a * c⁻¹ = b ↔ a = b * c :=
⟨λ k, by simp [← k, mul_assoc, power_series.inv_mul _ h],
 λ k, by simp [k, mul_assoc, power_series.mul_inv _ h]⟩

lemma diff_inv [field α] (f : power_series α) (h : constant_coeff _ f ≠ 0) :
  differentiate (f⁻¹) = - differentiate f * (f^2)⁻¹ :=
begin
  have : differentiate (f * f⁻¹) = 0,
    rw [power_series.mul_inv _ h, diff_one],
  rw [diff_mul, add_eq_zero_iff_neg_eq, neg_mul_eq_neg_mul, mul_inv_eq_iff h, neg_eq_iff_neg_eq] at this,
  rw [eq_mul_inv_iff, ← this, neg_neg, mul_comm f, pow_two, mul_assoc],
  rw [pow_two], simp [h],
end

lemma eq_inv_iff [field α] {a b : power_series α} (h : constant_coeff _ b ≠ 0) : a = b⁻¹ ↔ a * b = 1 :=
by rw [← eq_mul_inv_iff h, one_mul]
lemma power_series.inv_eq_iff [field α] {a b : power_series α} (h : constant_coeff _ b ≠ 0) : b⁻¹ = a ↔ a * b = 1 :=
by rw [eq_comm, eq_inv_iff h]

-- lemma big_geom (q : ℚ) : generating_function (λ n, q ^ n) = (1 - q • X)⁻¹ :=
-- begin
--   rw eq_inv_iff,
--   { rw [mul_sub, mul_one],
--     ext,
--     cases n,
--       simp,
--     simp [if_neg n.succ_ne_zero, coeff_smul, pow_succ] },
--   { simp },
-- end
-- @[simp]
-- lemma big_geom' (n : ℕ) (q : ℚ) : coeff _ n (1 - q • X)⁻¹ = q ^ n :=
-- begin
--   rw [← big_geom, generating_function, coeff_mk],
-- end

-- lemma basic_geom : generating_function (λ n, (1 : ℚ)) = (1 - X)⁻¹ :=
-- by simpa using big_geom 1
-- @[simp]
-- lemma basic_geom' (n : ℕ) : coeff ℚ n (1 - X)⁻¹ = 1 :=
-- by simpa using big_geom' n 1

-- lemma basic_arith_geom : generating_function (λ n, (n + 1 : ℚ)) = ((1 - X)^2)⁻¹ :=
-- calc generating_function (λ n, (n + 1 : ℚ))
--          = differentiate (generating_function (λ n, (1 : ℚ))) : power_series.ext (by simp)
--      ... = ((1 - X)^2)⁻¹ : by simp [basic_geom, diff_inv]

-- lemma generate_of_succ (f : ℕ → ℚ) (h : f 0 = 0) :
--   generating_function f = X * generating_function (λ n, f (n+1)) :=
-- begin
--   ext,
--   cases n,
--   simp [h],
--   rw [mul_comm X],
--   simp,
-- end
-- lemma basic_arith_geom' : generating_function (λ n, (n : ℚ)) = X * ((1 - X)^2)⁻¹ :=
-- begin
--   rw [generate_of_succ],
--     simp [basic_arith_geom],
--   simp,
-- end

-- lemma my_seq :
--   generating_function sequence_one_one = X * (1 - X)⁻¹ * (1 - (2 : ℚ) • X)⁻¹ :=
-- begin
--   rw [eq_mul_inv_iff, eq_mul_inv_iff, generating_function],
--   { ext,
--     cases n,
--     { simp [sequence_one_one] },
--     cases n,
--     { simp [mul_sub, sub_mul, ← mul_assoc, sequence_one_one, coeff_smul, ← sub_add], },
--     { have : ¬(n.succ.succ = 1), rintro ⟨⟩,
--       simp [mul_sub, sub_mul, ← mul_assoc, coeff_X, sequence_one_one, coeff_smul, if_neg this] } },
--   { simp },
--   { simp },
-- end

-- lemma gf_proof (n : ℕ) : sequence_one_one n = 2^n - 1 :=
-- begin
--   suffices : coeff _ n (generating_function sequence_one_one) = 2^n - 1,
--     simpa,
--   have : (X : power_series ℚ) * (1 - X)⁻¹ * (1 - (2 : ℚ) • X)⁻¹ = X * ((2 : ℚ) • (1 - (2 : ℚ) • X)⁻¹ - (1 - X)⁻¹),
--     rw [mul_inv_eq_iff, mul_assoc, sub_mul, algebra.smul_mul_assoc, power_series.inv_mul,
--         mul_inv_eq_iff, mul_assoc, sub_mul, mul_comm (1 - X)⁻¹, mul_assoc, power_series.inv_mul,
--         mul_one, algebra.smul_mul_assoc, one_mul, smul_sub, sub_sub_sub_cancel_right, two_smul];
--     simp,
--   rw [my_seq, this],
--   cases n,
--     simp,
--   rw mul_comm X,
--   simp [mul_sub, coeff_smul, pow_succ],
-- end

-- /-- The sequence from section 1.2 of GFology -/
-- def sequence_one_two : ℕ → ℚ
-- | 0 := 1
-- | (n+1) := 2 * sequence_one_two n + n

-- lemma my_seq2 :
--   generating_function sequence_one_two = (1 - (2:ℚ)•X + (2:ℚ)•X^2) * ((1 - X)^2)⁻¹ * (1 - (2:ℚ)•X)⁻¹ :=
-- begin
--   rw [eq_mul_inv_iff, eq_mul_inv_iff],
--   { ext,
--     cases n,
--     { simp [sequence_one_two, pow_two] },
--     cases n,
--     { simp [← mul_assoc, coeff_X_pow, sequence_one_two, pow_two (1 - X), mul_sub, sub_mul],
--       norm_num },
--     cases n,
--     { simp [coeff_X_pow, mul_sub, sub_mul, pow_two (1 - X), sequence_one_two, ← mul_assoc, coeff_X],
--       norm_num },
--     simp [pow_two (1 - X), mul_sub, sub_mul, sequence_one_two, ← mul_assoc, coeff_one_X,
--           coeff_X_pow, coeff_X],
--     ring },
--   { simp },
--   { simp },
-- end

-- lemma gf_proof2 (n : ℕ) : sequence_one_two n = 2^(n+1) - n - 1 :=
-- begin
--   suffices : coeff _ n (generating_function sequence_one_two) = 2^(n+1) - n - 1,
--     simpa,
--   have : (1 - (2:ℚ)•(X : power_series ℚ) + (2:ℚ)•X^2) * ((1-X)^2)⁻¹ * (1 - (2:ℚ)•X)⁻¹ = (2:ℚ)•(1 - (2:ℚ)•X)⁻¹ - ((1-X)^2)⁻¹,
--     rw [mul_inv_eq_iff, sub_mul, algebra.smul_mul_assoc, power_series.inv_mul,
--         mul_inv_eq_iff, sub_mul, mul_comm _⁻¹, mul_assoc, power_series.inv_mul],
--     simp [← sub_add, sub_mul, mul_sub, two_smul],
--     ring,
--     simp, simp, simp, simp,
--   rw [my_seq2, this],
--   simp only [←basic_arith_geom, coeff_mk, coeff_smul, add_monoid_hom.map_sub, big_geom'],
--   simp [sub_sub, pow_succ],
-- end

-- lemma inductive_proof2 : ∀ n, sequence_one_two n = 2^(n+1) - n - 1
-- | 0 := rfl
-- | (n+1) :=
-- begin
--   simp [sequence_one_two, inductive_proof2 n, pow_succ],
--   ring,
-- end


/-
Copyright (c) 2022 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov, Heather Macbeth
-/
import measure_theory.function.l1_space
import measure_theory.function.simple_func_dense

/-!
# Density of simple functions

Show that each `Lᵖ` Borel measurable function can be approximated in `Lᵖ` norm
by a sequence of simple functions.

## Main definitions

* `measure_theory.Lp.simple_func`, the type of `Lp` simple functions
* `coe_to_Lp`, the embedding of `Lp.simple_func E p μ` into `Lp E p μ`

## Main results

* `tendsto_approx_on_univ_Lp` (Lᵖ convergence): If `E` is a `normed_add_comm_group` and `f` is
  measurable and `mem_ℒp` (for `p < ∞`), then the simple functions
  `simple_func.approx_on f hf s 0 h₀ n` may be considered as elements of `Lp E p μ`, and they tend
  in Lᵖ to `f`.
* `Lp.simple_func.dense_embedding`: the embedding `coe_to_Lp` of the `Lp` simple functions into
  `Lp` is dense.
* `Lp.simple_func.induction`, `Lp.induction`, `mem_ℒp.induction`, `integrable.induction`: to prove
  a predicate for all elements of one of these classes of functions, it suffices to check that it
  behaves correctly on simple functions.

## TODO

For `E` finite-dimensional, simple functions `α →ₛ E` are dense in L^∞ -- prove this.

## Notations

* `α →ₛ β` (local notation): the type of simple functions `α → β`.
* `α →₁ₛ[μ] E`: the type of `L1` simple functions `α → β`.
-/

noncomputable theory
open set function filter topological_space ennreal emetric finset
open_locale classical topology ennreal measure_theory big_operators
variables {α β ι E F 𝕜 : Type*}

namespace measure_theory

local infixr ` →ₛ `:25 := simple_func

namespace simple_func

/-! ### Lp approximation by simple functions -/

section Lp
variables [measurable_space β] [measurable_space E] [normed_add_comm_group E]
  [normed_add_comm_group F] {q : ℝ} {p : ℝ≥0∞}

lemma nnnorm_approx_on_le [opens_measurable_space E] {f : β → E} (hf : measurable f)
  {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [separable_space s] (x : β) (n : ℕ) :
  ‖approx_on f hf s y₀ h₀ n x - f x‖₊ ≤ ‖f x - y₀‖₊ :=
begin
  have := edist_approx_on_le hf h₀ x n,
  rw edist_comm y₀ at this,
  simp only [edist_nndist, nndist_eq_nnnorm] at this,
  exact_mod_cast this
end

lemma norm_approx_on_y₀_le [opens_measurable_space E] {f : β → E} (hf : measurable f)
  {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [separable_space s] (x : β) (n : ℕ) :
  ‖approx_on f hf s y₀ h₀ n x - y₀‖ ≤ ‖f x - y₀‖ + ‖f x - y₀‖ :=
begin
  have := edist_approx_on_y0_le hf h₀ x n,
  repeat { rw [edist_comm y₀, edist_eq_coe_nnnorm_sub] at this },
  exact_mod_cast this,
end

lemma norm_approx_on_zero_le [opens_measurable_space E] {f : β → E} (hf : measurable f)
  {s : set E} (h₀ : (0 : E) ∈ s) [separable_space s] (x : β) (n : ℕ) :
  ‖approx_on f hf s 0 h₀ n x‖ ≤ ‖f x‖ + ‖f x‖ :=
begin
  have := edist_approx_on_y0_le hf h₀ x n,
  simp [edist_comm (0 : E), edist_eq_coe_nnnorm] at this,
  exact_mod_cast this,
end

lemma tendsto_approx_on_Lp_snorm [opens_measurable_space E]
  {f : β → E} (hf : measurable f) {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [separable_space s]
  (hp_ne_top : p ≠ ∞) {μ : measure β} (hμ : ∀ᵐ x ∂μ, f x ∈ closure s)
  (hi : snorm (λ x, f x - y₀) p μ < ∞) :
  tendsto (λ n, snorm (approx_on f hf s y₀ h₀ n - f) p μ) at_top (𝓝 0) :=
begin
  by_cases hp_zero : p = 0,
  { simpa only [hp_zero, snorm_exponent_zero] using tendsto_const_nhds },
  have hp : 0 < p.to_real := to_real_pos hp_zero hp_ne_top,
  suffices : tendsto (λ n, ∫⁻ x, ‖approx_on f hf s y₀ h₀ n x - f x‖₊ ^ p.to_real ∂μ) at_top (𝓝 0),
  { simp only [snorm_eq_lintegral_rpow_nnnorm hp_zero hp_ne_top],
    convert continuous_rpow_const.continuous_at.tendsto.comp this;
    simp [_root_.inv_pos.mpr hp] },
  -- We simply check the conditions of the Dominated Convergence Theorem:
  -- (1) The function "`p`-th power of distance between `f` and the approximation" is measurable
  have hF_meas : ∀ n, measurable (λ x, (‖approx_on f hf s y₀ h₀ n x - f x‖₊ : ℝ≥0∞) ^ p.to_real),
  { simpa only [← edist_eq_coe_nnnorm_sub] using
      λ n, (approx_on f hf s y₀ h₀ n).measurable_bind (λ y x, (edist y (f x)) ^ p.to_real)
      (λ y, (measurable_edist_right.comp hf).pow_const p.to_real) },
  -- (2) The functions "`p`-th power of distance between `f` and the approximation" are uniformly
  -- bounded, at any given point, by `λ x, ‖f x - y₀‖ ^ p.to_real`
  have h_bound : ∀ n, (λ x, (‖approx_on f hf s y₀ h₀ n x - f x‖₊ : ℝ≥0∞) ^ p.to_real)
      ≤ᵐ[μ] (λ x, ‖f x - y₀‖₊ ^ p.to_real),
  { exact λ n, eventually_of_forall
      (λ x, rpow_le_rpow (coe_mono (nnnorm_approx_on_le hf h₀ x n)) to_real_nonneg) },
  -- (3) The bounding function `λ x, ‖f x - y₀‖ ^ p.to_real` has finite integral
  have h_fin :  ∫⁻ (a : β), ‖f a - y₀‖₊ ^ p.to_real ∂μ ≠ ⊤,
    from (lintegral_rpow_nnnorm_lt_top_of_snorm_lt_top hp_zero hp_ne_top hi).ne,
  -- (4) The functions "`p`-th power of distance between `f` and the approximation" tend pointwise
  -- to zero
  have h_lim : ∀ᵐ (a : β) ∂μ,
    tendsto (λ n, (‖approx_on f hf s y₀ h₀ n a - f a‖₊ : ℝ≥0∞) ^ p.to_real) at_top (𝓝 0),
  { filter_upwards [hμ] with a ha,
    have : tendsto (λ n, (approx_on f hf s y₀ h₀ n) a - f a) at_top (𝓝 (f a - f a)),
    { exact (tendsto_approx_on hf h₀ ha).sub tendsto_const_nhds },
    convert continuous_rpow_const.continuous_at.tendsto.comp (tendsto_coe.mpr this.nnnorm),
    simp [zero_rpow_of_pos hp] },
  -- Then we apply the Dominated Convergence Theorem
  simpa using tendsto_lintegral_of_dominated_convergence _ hF_meas h_bound h_fin h_lim,
end

lemma mem_ℒp_approx_on [borel_space E]
  {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : mem_ℒp f p μ) {s : set E} {y₀ : E}
  (h₀ : y₀ ∈ s) [separable_space s] (hi₀ : mem_ℒp (λ x, y₀) p μ) (n : ℕ) :
  mem_ℒp (approx_on f fmeas s y₀ h₀ n) p μ :=
begin
  refine ⟨(approx_on f fmeas s y₀ h₀ n).ae_strongly_measurable, _⟩,
  suffices : snorm (λ x, approx_on f fmeas s y₀ h₀ n x - y₀) p μ < ⊤,
  { have : mem_ℒp (λ x, approx_on f fmeas s y₀ h₀ n x - y₀) p μ :=
      ⟨(approx_on f fmeas s y₀ h₀ n - const β y₀).ae_strongly_measurable, this⟩,
    convert snorm_add_lt_top this hi₀,
    ext x,
    simp },
  have hf' : mem_ℒp (λ x, ‖f x - y₀‖) p μ,
  { have h_meas : measurable (λ x, ‖f x - y₀‖),
    { simp only [← dist_eq_norm],
      exact (continuous_id.dist continuous_const).measurable.comp fmeas },
    refine ⟨h_meas.ae_measurable.ae_strongly_measurable, _⟩,
    rw snorm_norm,
    convert snorm_add_lt_top hf hi₀.neg,
    ext x,
    simp [sub_eq_add_neg] },
  have : ∀ᵐ x ∂μ, ‖approx_on f fmeas s y₀ h₀ n x - y₀‖ ≤ ‖(‖f x - y₀‖ + ‖f x - y₀‖)‖,
  { refine eventually_of_forall _,
    intros x,
    convert norm_approx_on_y₀_le fmeas h₀ x n,
    rw [real.norm_eq_abs, abs_of_nonneg],
    exact add_nonneg (norm_nonneg _) (norm_nonneg _) },
  calc snorm (λ x, approx_on f fmeas s y₀ h₀ n x - y₀) p μ
      ≤ snorm (λ x, ‖f x - y₀‖ + ‖f x - y₀‖) p μ : snorm_mono_ae this
  ... < ⊤ : snorm_add_lt_top hf' hf',
end

lemma tendsto_approx_on_range_Lp_snorm [borel_space E]
  {f : β → E} (hp_ne_top : p ≠ ∞) {μ : measure β} (fmeas : measurable f)
  [separable_space (range f ∪ {0} : set E)]
  (hf : snorm f p μ < ∞) :
  tendsto (λ n, snorm (approx_on f fmeas (range f ∪ {0}) 0 (by simp) n - f) p μ) at_top (𝓝 0) :=
begin
  refine tendsto_approx_on_Lp_snorm fmeas _ hp_ne_top _ _,
  { apply eventually_of_forall,
    assume x,
    apply subset_closure,
    simp },
  { simpa using hf }
end

lemma mem_ℒp_approx_on_range [borel_space E]
  {f : β → E} {μ : measure β} (fmeas : measurable f) [separable_space (range f ∪ {0} : set E)]
  (hf : mem_ℒp f p μ) (n : ℕ) :
  mem_ℒp (approx_on f fmeas (range f ∪ {0}) 0 (by simp) n) p μ :=
mem_ℒp_approx_on fmeas hf (by simp) zero_mem_ℒp n

lemma tendsto_approx_on_range_Lp [borel_space E]
  {f : β → E} [hp : fact (1 ≤ p)] (hp_ne_top : p ≠ ∞) {μ : measure β} (fmeas : measurable f)
  [separable_space (range f ∪ {0} : set E)] (hf : mem_ℒp f p μ) :
  tendsto (λ n, (mem_ℒp_approx_on_range fmeas hf n).to_Lp
    (approx_on f fmeas (range f ∪ {0}) 0 (by simp) n))
      at_top (𝓝 (hf.to_Lp f)) :=
by simpa only [Lp.tendsto_Lp_iff_tendsto_ℒp'']
  using tendsto_approx_on_range_Lp_snorm hp_ne_top fmeas hf.2

end Lp

/-! ### L1 approximation by simple functions -/

section integrable
variables [measurable_space β]
variables [measurable_space E] [normed_add_comm_group E]

lemma tendsto_approx_on_L1_nnnorm [opens_measurable_space E]
  {f : β → E} (hf : measurable f) {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [separable_space s]
  {μ : measure β} (hμ : ∀ᵐ x ∂μ, f x ∈ closure s) (hi : has_finite_integral (λ x, f x - y₀) μ) :
  tendsto (λ n, ∫⁻ x, ‖approx_on f hf s y₀ h₀ n x - f x‖₊ ∂μ) at_top (𝓝 0) :=
by simpa [snorm_one_eq_lintegral_nnnorm] using tendsto_approx_on_Lp_snorm hf h₀ one_ne_top hμ
  (by simpa [snorm_one_eq_lintegral_nnnorm] using hi)

lemma integrable_approx_on [borel_space E]
  {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f μ)
  {s : set E} {y₀ : E} (h₀ : y₀ ∈ s)
  [separable_space s] (hi₀ : integrable (λ x, y₀) μ) (n : ℕ) :
  integrable (approx_on f fmeas s y₀ h₀ n) μ :=
begin
  rw ← mem_ℒp_one_iff_integrable at hf hi₀ ⊢,
  exact mem_ℒp_approx_on fmeas hf h₀ hi₀ n,
end

lemma tendsto_approx_on_range_L1_nnnorm [opens_measurable_space E]
  {f : β → E} {μ : measure β} [separable_space (range f ∪ {0} : set E)]
  (fmeas : measurable f) (hf : integrable f μ) :
  tendsto (λ n, ∫⁻ x, ‖approx_on f fmeas (range f ∪ {0}) 0 (by simp) n x - f x‖₊ ∂μ)
    at_top (𝓝 0) :=
begin
  apply tendsto_approx_on_L1_nnnorm fmeas,
  { apply eventually_of_forall,
    assume x,
    apply subset_closure,
    simp },
  { simpa using hf.2 }
end

lemma integrable_approx_on_range [borel_space E]
  {f : β → E} {μ : measure β} (fmeas : measurable f)
  [separable_space (range f ∪ {0} : set E)] (hf : integrable f μ) (n : ℕ) :
  integrable (approx_on f fmeas (range f ∪ {0}) 0 (by simp) n) μ :=
integrable_approx_on fmeas hf _ (integrable_zero _ _ _) n

end integrable

section simple_func_properties

variables [measurable_space α]
variables [normed_add_comm_group E] [normed_add_comm_group F]
variables {μ : measure α} {p : ℝ≥0∞}

/-!
### Properties of simple functions in `Lp` spaces

A simple function `f : α →ₛ E` into a normed group `E` verifies, for a measure `μ`:
- `mem_ℒp f 0 μ` and `mem_ℒp f ∞ μ`, since `f` is a.e.-measurable and bounded,
- for `0 < p < ∞`,
  `mem_ℒp f p μ ↔ integrable f μ ↔ f.fin_meas_supp μ ↔ ∀ y ≠ 0, μ (f ⁻¹' {y}) < ∞`.
-/

lemma exists_forall_norm_le (f : α →ₛ F) : ∃ C, ∀ x, ‖f x‖ ≤ C :=
exists_forall_le (f.map (λ x, ‖x‖))

lemma mem_ℒp_zero (f : α →ₛ E) (μ : measure α) : mem_ℒp f 0 μ :=
mem_ℒp_zero_iff_ae_strongly_measurable.mpr f.ae_strongly_measurable

lemma mem_ℒp_top (f : α →ₛ E) (μ : measure α) : mem_ℒp f ∞ μ :=
let ⟨C, hfC⟩ := f.exists_forall_norm_le in
mem_ℒp_top_of_bound f.ae_strongly_measurable C $ eventually_of_forall hfC

protected lemma snorm'_eq {p : ℝ} (f : α →ₛ F) (μ : measure α) :
  snorm' f p μ = (∑ y in f.range, (‖y‖₊ : ℝ≥0∞) ^ p * μ (f ⁻¹' {y})) ^ (1/p) :=
have h_map : (λ a, (‖f a‖₊ : ℝ≥0∞) ^ p) = f.map (λ a : F, (‖a‖₊ : ℝ≥0∞) ^ p), by simp,
by rw [snorm', h_map, lintegral_eq_lintegral, map_lintegral]

lemma measure_preimage_lt_top_of_mem_ℒp (hp_pos : p ≠ 0) (hp_ne_top : p ≠ ∞) (f : α →ₛ E)
  (hf : mem_ℒp f p μ) (y : E) (hy_ne : y ≠ 0) :
  μ (f ⁻¹' {y}) < ∞ :=
begin
  have hp_pos_real : 0 < p.to_real, from ennreal.to_real_pos hp_pos hp_ne_top,
  have hf_snorm := mem_ℒp.snorm_lt_top hf,
  rw [snorm_eq_snorm' hp_pos hp_ne_top, f.snorm'_eq,
    ← @ennreal.lt_rpow_one_div_iff _ _ (1 / p.to_real) (by simp [hp_pos_real]),
    @ennreal.top_rpow_of_pos (1 / (1 / p.to_real)) (by simp [hp_pos_real]),
    ennreal.sum_lt_top_iff] at hf_snorm,
  by_cases hyf : y ∈ f.range,
  swap,
  { suffices h_empty : f ⁻¹' {y} = ∅,
      by { rw [h_empty, measure_empty], exact ennreal.coe_lt_top, },
    ext1 x,
    rw [set.mem_preimage, set.mem_singleton_iff, mem_empty_iff_false, iff_false],
    refine λ hxy, hyf _,
    rw [mem_range, set.mem_range],
    exact ⟨x, hxy⟩, },
  specialize hf_snorm y hyf,
  rw ennreal.mul_lt_top_iff at hf_snorm,
  cases hf_snorm,
  { exact hf_snorm.2, },
  cases hf_snorm,
  { refine absurd _ hy_ne,
    simpa [hp_pos_real] using hf_snorm, },
  { simp [hf_snorm], },
end

lemma mem_ℒp_of_finite_measure_preimage (p : ℝ≥0∞) {f : α →ₛ E} (hf : ∀ y ≠ 0, μ (f ⁻¹' {y}) < ∞) :
  mem_ℒp f p μ :=
begin
  by_cases hp0 : p = 0,
  { rw [hp0, mem_ℒp_zero_iff_ae_strongly_measurable], exact f.ae_strongly_measurable, },
  by_cases hp_top : p = ∞,
  { rw hp_top, exact mem_ℒp_top f μ, },
  refine ⟨f.ae_strongly_measurable, _⟩,
  rw [snorm_eq_snorm' hp0 hp_top, f.snorm'_eq],
  refine ennreal.rpow_lt_top_of_nonneg (by simp) (ennreal.sum_lt_top_iff.mpr (λ y hy, _)).ne,
  by_cases hy0 : y = 0,
  { simp [hy0, ennreal.to_real_pos hp0 hp_top], },
  { refine ennreal.mul_lt_top _ (hf y hy0).ne,
    exact (ennreal.rpow_lt_top_of_nonneg ennreal.to_real_nonneg ennreal.coe_ne_top).ne },
end

lemma mem_ℒp_iff {f : α →ₛ E} (hp_pos : p ≠ 0) (hp_ne_top : p ≠ ∞) :
  mem_ℒp f p μ ↔ ∀ y ≠ 0, μ (f ⁻¹' {y}) < ∞ :=
⟨λ h, measure_preimage_lt_top_of_mem_ℒp hp_pos hp_ne_top f h,
  λ h, mem_ℒp_of_finite_measure_preimage p h⟩

lemma integrable_iff {f : α →ₛ E} : integrable f μ ↔ ∀ y ≠ 0, μ (f ⁻¹' {y}) < ∞ :=
mem_ℒp_one_iff_integrable.symm.trans $ mem_ℒp_iff one_ne_zero ennreal.coe_ne_top

lemma mem_ℒp_iff_integrable {f : α →ₛ E} (hp_pos : p ≠ 0) (hp_ne_top : p ≠ ∞) :
  mem_ℒp f p μ ↔ integrable f μ :=
(mem_ℒp_iff hp_pos hp_ne_top).trans integrable_iff.symm

lemma mem_ℒp_iff_fin_meas_supp {f : α →ₛ E} (hp_pos : p ≠ 0) (hp_ne_top : p ≠ ∞) :
  mem_ℒp f p μ ↔ f.fin_meas_supp μ :=
(mem_ℒp_iff hp_pos hp_ne_top).trans fin_meas_supp_iff.symm

lemma integrable_iff_fin_meas_supp {f : α →ₛ E} : integrable f μ ↔ f.fin_meas_supp μ :=
integrable_iff.trans fin_meas_supp_iff.symm

lemma fin_meas_supp.integrable {f : α →ₛ E} (h : f.fin_meas_supp μ) : integrable f μ :=
integrable_iff_fin_meas_supp.2 h

lemma integrable_pair {f : α →ₛ E} {g : α →ₛ F} :
  integrable f μ → integrable g μ → integrable (pair f g) μ :=
by simpa only [integrable_iff_fin_meas_supp] using fin_meas_supp.pair

lemma mem_ℒp_of_is_finite_measure (f : α →ₛ E) (p : ℝ≥0∞) (μ : measure α) [is_finite_measure μ] :
  mem_ℒp f p μ :=
let ⟨C, hfC⟩ := f.exists_forall_norm_le in
mem_ℒp.of_bound f.ae_strongly_measurable C $ eventually_of_forall hfC

lemma integrable_of_is_finite_measure [is_finite_measure μ] (f : α →ₛ E) : integrable f μ :=
mem_ℒp_one_iff_integrable.mp (f.mem_ℒp_of_is_finite_measure 1 μ)

lemma measure_preimage_lt_top_of_integrable (f : α →ₛ E) (hf : integrable f μ) {x : E}
  (hx : x ≠ 0) :
  μ (f ⁻¹' {x}) < ∞ :=
integrable_iff.mp hf x hx

lemma measure_support_lt_top [has_zero β] (f : α →ₛ β) (hf : ∀ y ≠ 0, μ (f ⁻¹' {y}) < ∞) :
  μ (support f) < ∞ :=
begin
  rw support_eq,
  refine (measure_bUnion_finset_le _ _).trans_lt (ennreal.sum_lt_top_iff.mpr (λ y hy, _)),
  rw finset.mem_filter at hy,
  exact hf y hy.2,
end

lemma measure_support_lt_top_of_mem_ℒp (f : α →ₛ E) (hf : mem_ℒp f p μ) (hp_ne_zero : p ≠ 0)
  (hp_ne_top : p ≠ ∞) :
  μ (support f) < ∞ :=
f.measure_support_lt_top ((mem_ℒp_iff hp_ne_zero hp_ne_top).mp hf)

lemma measure_support_lt_top_of_integrable (f : α →ₛ E) (hf : integrable f μ) :
  μ (support f) < ∞ :=
f.measure_support_lt_top (integrable_iff.mp hf)

lemma measure_lt_top_of_mem_ℒp_indicator (hp_pos : p ≠ 0) (hp_ne_top : p ≠ ∞) {c : E} (hc : c ≠ 0)
  {s : set α} (hs : measurable_set s)
  (hcs : mem_ℒp ((const α c).piecewise s hs (const α 0)) p μ) :
  μ s < ⊤ :=
begin
  have : function.support (const α c) = set.univ := function.support_const hc,
  simpa only [mem_ℒp_iff_fin_meas_supp hp_pos hp_ne_top, fin_meas_supp_iff_support,
    support_indicator, set.inter_univ, this] using hcs
end

end simple_func_properties

end simple_func

/-! Construction of the space of `Lp` simple functions, and its dense embedding into `Lp`. -/
namespace Lp

open ae_eq_fun

variables [measurable_space α] [normed_add_comm_group E] [normed_add_comm_group F] (p : ℝ≥0∞)
  (μ : measure α)

variables (E)

/-- `Lp.simple_func` is a subspace of Lp consisting of equivalence classes of an integrable simple
    function. -/
def simple_func : add_subgroup (Lp E p μ) :=
{ carrier := {f : Lp E p μ |
                ∃ (s : α →ₛ E), (ae_eq_fun.mk s s.ae_strongly_measurable : α →ₘ[μ] E) = f},
  zero_mem' := ⟨0, rfl⟩,
  add_mem' := λ f g ⟨s, hs⟩ ⟨t, ht⟩, ⟨s + t,
      by simp only [←hs, ←ht, ae_eq_fun.mk_add_mk, add_subgroup.coe_add, ae_eq_fun.mk_eq_mk,
        simple_func.coe_add]⟩,
  neg_mem' := λ f ⟨s, hs⟩, ⟨-s,
      by simp only [←hs, ae_eq_fun.neg_mk, simple_func.coe_neg, ae_eq_fun.mk_eq_mk,
        add_subgroup.coe_neg]⟩ }

variables {E p μ}

namespace simple_func

section instances
/-! Simple functions in Lp space form a `normed_space`. -/

@[norm_cast] lemma coe_coe (f : Lp.simple_func E p μ) : ⇑(f : Lp E p μ) = f := rfl

protected lemma eq' {f g : Lp.simple_func E p μ} : (f : α →ₘ[μ] E) = (g : α →ₘ[μ] E) → f = g :=
subtype.eq ∘ subtype.eq

/-! Implementation note:  If `Lp.simple_func E p μ` were defined as a `𝕜`-submodule of `Lp E p μ`,
then the next few lemmas, putting a normed `𝕜`-group structure on `Lp.simple_func E p μ`, would be
unnecessary.  But instead, `Lp.simple_func E p μ` is defined as an `add_subgroup` of `Lp E p μ`,
which does not permit this (but has the advantage of working when `E` itself is a normed group,
i.e. has no scalar action). -/

variables [normed_field 𝕜] [normed_space 𝕜 E]

/-- If `E` is a normed space, `Lp.simple_func E p μ` is a `has_smul`. Not declared as an
instance as it is (as of writing) used only in the construction of the Bochner integral. -/
protected def has_smul : has_smul 𝕜 (Lp.simple_func E p μ) := ⟨λ k f, ⟨k • f,
begin
  rcases f with ⟨f, ⟨s, hs⟩⟩,
  use k • s,
  apply eq.trans (ae_eq_fun.smul_mk k s s.ae_strongly_measurable).symm _,
  rw hs,
  refl,
end ⟩⟩

local attribute [instance] simple_func.has_smul

@[simp, norm_cast] lemma coe_smul (c : 𝕜) (f : Lp.simple_func E p μ) :
  ((c • f : Lp.simple_func E p μ) : Lp E p μ) = c • (f : Lp E p μ) := rfl

/-- If `E` is a normed space, `Lp.simple_func E p μ` is a module. Not declared as an
instance as it is (as of writing) used only in the construction of the Bochner integral. -/
protected def module : module 𝕜 (Lp.simple_func E p μ) :=
{ one_smul  := λf, by { ext1, exact one_smul _ _ },
  mul_smul  := λx y f, by { ext1, exact mul_smul _ _ _ },
  smul_add  := λx f g, by { ext1, exact smul_add _ _ _ },
  smul_zero := λx, by { ext1, exact smul_zero _ },
  add_smul  := λx y f, by { ext1, exact add_smul _ _ _ },
  zero_smul := λf, by { ext1, exact zero_smul _ _ } }

local attribute [instance] simple_func.module

/-- If `E` is a normed space, `Lp.simple_func E p μ` is a normed space. Not declared as an
instance as it is (as of writing) used only in the construction of the Bochner integral. -/
protected def normed_space [fact (1 ≤ p)] : normed_space 𝕜 (Lp.simple_func E p μ) :=
⟨ λc f, by { rw [add_subgroup.coe_norm, add_subgroup.coe_norm, coe_smul, norm_smul] } ⟩

end instances

local attribute [instance] simple_func.module simple_func.normed_space

section to_Lp

/-- Construct the equivalence class `[f]` of a simple function `f` satisfying `mem_ℒp`. -/
@[reducible] def to_Lp (f : α →ₛ E) (hf : mem_ℒp f p μ) : (Lp.simple_func E p μ) :=
⟨hf.to_Lp f, ⟨f, rfl⟩⟩

lemma to_Lp_eq_to_Lp (f : α →ₛ E) (hf : mem_ℒp f p μ) :
  (to_Lp f hf : Lp E p μ) = hf.to_Lp f := rfl

lemma to_Lp_eq_mk (f : α →ₛ E) (hf : mem_ℒp f p μ) :
  (to_Lp f hf : α →ₘ[μ] E) = ae_eq_fun.mk f f.ae_strongly_measurable := rfl

lemma to_Lp_zero : to_Lp (0 : α →ₛ E) zero_mem_ℒp = (0 : Lp.simple_func E p μ) := rfl

lemma to_Lp_add (f g : α →ₛ E) (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) :
  to_Lp (f + g) (hf.add hg) = to_Lp f hf + to_Lp g hg := rfl

lemma to_Lp_neg (f : α →ₛ E) (hf : mem_ℒp f p μ) :
  to_Lp (-f) hf.neg = -to_Lp f hf := rfl

lemma to_Lp_sub (f g : α →ₛ E) (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) :
  to_Lp (f - g) (hf.sub hg) = to_Lp f hf - to_Lp g hg :=
by { simp only [sub_eq_add_neg, ← to_Lp_neg, ← to_Lp_add], refl }

variables [normed_field 𝕜] [normed_space 𝕜 E]

lemma to_Lp_smul (f : α →ₛ E) (hf : mem_ℒp f p μ) (c : 𝕜) :
  to_Lp (c • f) (hf.const_smul c) = c • to_Lp f hf := rfl

lemma norm_to_Lp [fact (1 ≤ p)] (f : α →ₛ E) (hf : mem_ℒp f p μ) :
  ‖to_Lp f hf‖ = ennreal.to_real (snorm f p μ) :=
norm_to_Lp f hf

end to_Lp

section to_simple_func

/-- Find a representative of a `Lp.simple_func`. -/
def to_simple_func (f : Lp.simple_func E p μ) : α →ₛ E := classical.some f.2

/-- `(to_simple_func f)` is measurable. -/
@[measurability]
protected lemma measurable [measurable_space E] (f : Lp.simple_func E p μ) :
  measurable (to_simple_func f) :=
(to_simple_func f).measurable

protected lemma strongly_measurable (f : Lp.simple_func E p μ) :
  strongly_measurable (to_simple_func f) :=
(to_simple_func f).strongly_measurable

@[measurability]
protected lemma ae_measurable [measurable_space E] (f : Lp.simple_func E p μ) :
  ae_measurable (to_simple_func f) μ :=
(simple_func.measurable f).ae_measurable

protected lemma ae_strongly_measurable (f : Lp.simple_func E p μ) :
  ae_strongly_measurable (to_simple_func f) μ :=
(simple_func.strongly_measurable f).ae_strongly_measurable

lemma to_simple_func_eq_to_fun (f : Lp.simple_func E p μ) : to_simple_func f =ᵐ[μ] f :=
show ⇑(to_simple_func f) =ᵐ[μ] ⇑(f : α →ₘ[μ] E),
begin
  convert (ae_eq_fun.coe_fn_mk (to_simple_func f) (to_simple_func f).ae_strongly_measurable).symm
    using 2,
  exact (classical.some_spec f.2).symm,
end

/-- `to_simple_func f` satisfies the predicate `mem_ℒp`. -/
protected lemma mem_ℒp (f : Lp.simple_func E p μ) : mem_ℒp (to_simple_func f) p μ :=
mem_ℒp.ae_eq (to_simple_func_eq_to_fun f).symm $ mem_Lp_iff_mem_ℒp.mp (f : Lp E p μ).2

lemma to_Lp_to_simple_func (f : Lp.simple_func E p μ) :
  to_Lp (to_simple_func f) (simple_func.mem_ℒp f) = f :=
simple_func.eq' (classical.some_spec f.2)

lemma to_simple_func_to_Lp (f : α →ₛ E) (hfi : mem_ℒp f p μ) :
  to_simple_func (to_Lp f hfi) =ᵐ[μ] f :=
by { rw ← ae_eq_fun.mk_eq_mk, exact classical.some_spec (to_Lp f hfi).2 }

variables (E μ)

lemma zero_to_simple_func : to_simple_func (0 : Lp.simple_func E p μ) =ᵐ[μ] 0 :=
begin
  filter_upwards [to_simple_func_eq_to_fun (0 : Lp.simple_func E p μ), Lp.coe_fn_zero E 1 μ]
    with _ h₁ _,
  rwa h₁,
end

variables {E μ}

lemma add_to_simple_func (f g : Lp.simple_func E p μ) :
  to_simple_func (f + g) =ᵐ[μ] to_simple_func f + to_simple_func g :=
begin
  filter_upwards [to_simple_func_eq_to_fun (f + g), to_simple_func_eq_to_fun f,
    to_simple_func_eq_to_fun g, Lp.coe_fn_add (f :  Lp E p μ) g] with _,
  simp only [← coe_coe, add_subgroup.coe_add, pi.add_apply],
  iterate 4 { assume h, rw h, },
end

lemma neg_to_simple_func (f : Lp.simple_func E p μ) :
  to_simple_func (-f) =ᵐ[μ] - to_simple_func f :=
begin
  filter_upwards [to_simple_func_eq_to_fun (-f), to_simple_func_eq_to_fun f,
    Lp.coe_fn_neg (f : Lp E p μ)] with _,
  simp only [pi.neg_apply, add_subgroup.coe_neg, ← coe_coe],
  repeat { assume h, rw h, },
end

lemma sub_to_simple_func (f g : Lp.simple_func E p μ) :
  to_simple_func (f - g) =ᵐ[μ] to_simple_func f - to_simple_func g :=
begin
  filter_upwards [to_simple_func_eq_to_fun (f - g), to_simple_func_eq_to_fun f,
    to_simple_func_eq_to_fun g, Lp.coe_fn_sub (f : Lp E p μ) g] with _,
  simp only [add_subgroup.coe_sub, pi.sub_apply, ← coe_coe],
  repeat { assume h, rw h, },
end

variables [normed_field 𝕜] [normed_space 𝕜 E]

lemma smul_to_simple_func (k : 𝕜) (f : Lp.simple_func E p μ) :
  to_simple_func (k • f) =ᵐ[μ] k • to_simple_func f :=
begin
  filter_upwards [to_simple_func_eq_to_fun (k • f), to_simple_func_eq_to_fun f,
    Lp.coe_fn_smul k (f : Lp E p μ)] with _,
  simp only [pi.smul_apply, coe_smul, ← coe_coe],
  repeat { assume h, rw h, },
end

lemma norm_to_simple_func [fact (1 ≤ p)] (f : Lp.simple_func E p μ) :
  ‖f‖ = ennreal.to_real (snorm (to_simple_func f) p μ) :=
by simpa [to_Lp_to_simple_func] using norm_to_Lp (to_simple_func f) (simple_func.mem_ℒp f)

end to_simple_func

section induction

variables (p)

/-- The characteristic function of a finite-measure measurable set `s`, as an `Lp` simple function.
-/
def indicator_const {s : set α} (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : E) :
  Lp.simple_func E p μ :=
to_Lp ((simple_func.const _ c).piecewise s hs (simple_func.const _ 0))
  (mem_ℒp_indicator_const p hs c (or.inr hμs))

variables {p}

@[simp] lemma coe_indicator_const {s : set α} (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : E) :
  (↑(indicator_const p hs hμs c) : Lp E p μ) = indicator_const_Lp p hs hμs c :=
rfl

lemma to_simple_func_indicator_const {s : set α} (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : E) :
  to_simple_func (indicator_const p hs hμs c)
    =ᵐ[μ] (simple_func.const _ c).piecewise s hs (simple_func.const _ 0) :=
Lp.simple_func.to_simple_func_to_Lp _ _

/-- To prove something for an arbitrary `Lp` simple function, with `0 < p < ∞`, it suffices to show
that the property holds for (multiples of) characteristic functions of finite-measure measurable
sets and is closed under addition (of functions with disjoint support). -/
@[elab_as_eliminator]
protected lemma induction (hp_pos : p ≠ 0) (hp_ne_top : p ≠ ∞) {P : Lp.simple_func E p μ → Prop}
  (h_ind : ∀ (c : E) {s : set α} (hs : measurable_set s) (hμs : μ s < ∞),
    P (Lp.simple_func.indicator_const p hs hμs.ne c))
  (h_add : ∀ ⦃f g : α →ₛ E⦄, ∀ hf : mem_ℒp f p μ, ∀ hg : mem_ℒp g p μ,
    disjoint (support f) (support g) → P (Lp.simple_func.to_Lp f hf)
    → P (Lp.simple_func.to_Lp g hg) → P (Lp.simple_func.to_Lp f hf + Lp.simple_func.to_Lp g hg))
  (f : Lp.simple_func E p μ) : P f :=
begin
  suffices : ∀ f : α →ₛ E, ∀ hf : mem_ℒp f p μ, P (to_Lp f hf),
  { rw ← to_Lp_to_simple_func f,
    apply this }, clear f,
  refine simple_func.induction _ _,
  { intros c s hs hf,
    by_cases hc : c = 0,
    { convert h_ind 0 measurable_set.empty (by simp) using 1,
      ext1,
      simp [hc] },
    exact h_ind c hs (simple_func.measure_lt_top_of_mem_ℒp_indicator hp_pos hp_ne_top hc hs hf) },
  { intros f g hfg hf hg hfg',
    obtain ⟨hf', hg'⟩ : mem_ℒp f p μ ∧ mem_ℒp g p μ,
    { exact (mem_ℒp_add_of_disjoint hfg f.strongly_measurable g.strongly_measurable).mp hfg' },
    exact h_add hf' hg' hfg (hf hf') (hg hg') },
end

end induction

section coe_to_Lp

variables [fact (1 ≤ p)]

protected lemma uniform_continuous :
  uniform_continuous (coe : (Lp.simple_func E p μ) → (Lp E p μ)) :=
uniform_continuous_comap

protected lemma uniform_embedding :
  uniform_embedding (coe : (Lp.simple_func E p μ) → (Lp E p μ)) :=
uniform_embedding_comap subtype.val_injective

protected lemma uniform_inducing : uniform_inducing (coe : (Lp.simple_func E p μ) → (Lp E p μ)) :=
simple_func.uniform_embedding.to_uniform_inducing

protected lemma dense_embedding (hp_ne_top : p ≠ ∞) :
  dense_embedding (coe : (Lp.simple_func E p μ) → (Lp E p μ)) :=
begin
  borelize E,
  apply simple_func.uniform_embedding.dense_embedding,
  assume f,
  rw mem_closure_iff_seq_limit,
  have hfi' : mem_ℒp f p μ := Lp.mem_ℒp f,
  haveI : separable_space (range f ∪ {0} : set E) :=
    (Lp.strongly_measurable f).separable_space_range_union_singleton,
  refine ⟨λ n, ↑(to_Lp (simple_func.approx_on f (Lp.strongly_measurable f).measurable
    (range f ∪ {0}) 0 (by simp) n)
    (simple_func.mem_ℒp_approx_on_range (Lp.strongly_measurable f).measurable hfi' n)),
    λ n, mem_range_self _, _⟩,
  convert simple_func.tendsto_approx_on_range_Lp hp_ne_top (Lp.strongly_measurable f).measurable
    hfi',
  rw to_Lp_coe_fn f (Lp.mem_ℒp f)
end

protected

protected lemma dense_range (hp_ne_top : p ≠ ∞) :
  dense_range (coe : (Lp.simple_func E p μ) → (Lp E p μ)) :=
(simple_func.dense_inducing hp_ne_top).dense

variables [normed_field 𝕜] [normed_space 𝕜 E]
variables (α E 𝕜)

/-- The embedding of Lp simple functions into Lp functions, as a continuous linear map. -/
def coe_to_Lp : (Lp.simple_func E p μ) →L[𝕜] (Lp E p μ) :=
{ map_smul' := λk f, rfl,
  cont := Lp.simple_func.uniform_continuous.continuous,
  .. add_subgroup.subtype (Lp.simple_func E p μ) }

variables {α E 𝕜}

end coe_to_Lp

section order

variables {G : Type*} [normed_lattice_add_comm_group G]

lemma coe_fn_le (f g : Lp.simple_func G p μ) : f ≤ᵐ[μ] g ↔ f ≤ g :=
by rw [← subtype.coe_le_coe, ← Lp.coe_fn_le, coe_fn_coe_base', coe_fn_coe_base' g]

instance : covariant_class (Lp.simple_func G p μ) (Lp.simple_func G p μ) (+) (≤) :=
begin
  refine ⟨λ f g₁ g₂ hg₁₂, _⟩,
  rw ← Lp.simple_func.coe_fn_le at hg₁₂ ⊢,
  have h_add_1 : ⇑(f + g₁) =ᵐ[μ] f + g₁, from Lp.coe_fn_add _ _,
  have h_add_2 : ⇑(f + g₂) =ᵐ[μ] f + g₂, from Lp.coe_fn_add _ _,
  filter_upwards [h_add_1, h_add_2, hg₁₂] with _ h1 h2 h3,
  rw [h1, h2, pi.add_apply, pi.add_apply],
  exact add_le_add le_rfl h3,
end

variables (p μ G)
lemma coe_fn_zero : (0 : Lp.simple_func G p μ) =ᵐ[μ] (0 : α → G) := Lp.coe_fn_zero _ _ _
variables{p μ G}

lemma coe_fn_nonneg (f : Lp.simple_func G p μ) : 0 ≤ᵐ[μ] f ↔ 0 ≤ f :=
begin
  rw ← Lp.simple_func.coe_fn_le,
  have h0 : (0 : Lp.simple_func G p μ) =ᵐ[μ] (0 : α → G), from Lp.simple_func.coe_fn_zero p μ G,
  split; intro h; filter_upwards [h, h0] with _ _ h2,
  { rwa h2, },
  { rwa ← h2, },
end

lemma exists_simple_func_nonneg_ae_eq {f : Lp.simple_func G p μ} (hf : 0 ≤ f) :
  ∃ f' : α →ₛ G, 0 ≤ f' ∧ f =ᵐ[μ] f' :=
begin
  rw ← Lp.simple_func.coe_fn_nonneg at hf,
  have hf_ae : 0 ≤ᵐ[μ] (simple_func.to_simple_func f),
    by { filter_upwards [to_simple_func_eq_to_fun f, hf] with _ h1 _, rwa h1 },
  let s := (to_measurable μ {x | ¬ 0 ≤ simple_func.to_simple_func f x})ᶜ,
  have hs_zero : μ sᶜ = 0,
    by { rw [compl_compl, measure_to_measurable], rwa [eventually_le, ae_iff] at hf_ae, },
  have hfs_nonneg : ∀ x ∈ s, 0 ≤ simple_func.to_simple_func f x,
  { intros x hxs,
    rw mem_compl_iff at hxs,
    have hx' : x ∉ {a : α | ¬0 ≤ simple_func.to_simple_func f a},
      from λ h, hxs (subset_to_measurable μ _ h),
    rwa [set.nmem_set_of_iff, not_not] at hx', },
  let f' := simple_func.piecewise s (measurable_set_to_measurable μ _).compl
    (simple_func.to_simple_func f) (simple_func.const α (0 : G)),
  refine ⟨f', λ x, _, _⟩,
  { rw simple_func.piecewise_apply,
    by_cases hxs : x ∈ s,
    { simp only [hxs, hfs_nonneg x hxs, if_true, pi.zero_apply, simple_func.coe_zero], },
    { simp only [hxs, simple_func.const_zero, if_false], }, },
  { rw simple_func.coe_piecewise,
    have : s =ᵐ[μ] univ,
    { rw ae_eq_set,
      simp only [true_and, measure_empty, eq_self_iff_true, diff_univ, ← compl_eq_univ_diff],
      exact hs_zero, },
    refine eventually_eq.trans (to_simple_func_eq_to_fun f).symm _,
    refine eventually_eq.trans _ (piecewise_ae_eq_of_ae_eq_set this.symm),
    simp only [simple_func.const_zero, indicator_univ, piecewise_eq_indicator,
      simple_func.coe_zero], },
end

variables (p μ G)
/-- Coercion from nonnegative simple functions of Lp to nonnegative functions of Lp. -/
def coe_simple_func_nonneg_to_Lp_nonneg :
  {g : Lp.simple_func G p μ // 0 ≤ g} → {g : Lp G p μ // 0 ≤ g} :=
λ g, ⟨g, g.2⟩

lemma dense_range_coe_simple_func_nonneg_to_Lp_nonneg [hp : fact (1 ≤ p)] (hp_ne_top : p ≠ ∞) :
  dense_range (coe_simple_func_nonneg_to_Lp_nonneg p μ G) :=
begin
  borelize G,
  assume g,
  rw mem_closure_iff_seq_limit,
  have hg_mem_ℒp : mem_ℒp g p μ := Lp.mem_ℒp g,
  have zero_mem : (0 : G) ∈ (range g ∪ {0} : set G) ∩ {y | 0 ≤ y}, by simp only [union_singleton,
    mem_inter_iff, mem_insert_iff, eq_self_iff_true, true_or, mem_set_of_eq, le_refl, and_self],
  haveI : separable_space (((range g ∪ {0}) ∩ {y | 0 ≤ y}) : set G),
  { apply is_separable.separable_space,
    apply is_separable.mono _ (set.inter_subset_left _ _),
    exact (Lp.strongly_measurable (g : Lp G p μ)).is_separable_range.union
      (finite_singleton _).is_separable },
  have g_meas : measurable g := (Lp.strongly_measurable (g : Lp G p μ)).measurable,
  let x := λ n, simple_func.approx_on g g_meas ((range g ∪ {0}) ∩ {y | 0 ≤ y}) 0 zero_mem n,
  have hx_nonneg : ∀ n, 0 ≤ x n,
  { assume n a,
    change x n a ∈ {y : G | 0 ≤ y},
    have A : (range g ∪ {0} : set G) ∩ {y | 0 ≤ y} ⊆ {y | 0 ≤ y} := inter_subset_right _ _,
    apply A,
    exact simple_func.approx_on_mem g_meas _ n a },
  have hx_mem_ℒp : ∀ n, mem_ℒp (x n) p μ,
    from simple_func.mem_ℒp_approx_on _ hg_mem_ℒp _ ⟨ae_strongly_measurable_const, by simp⟩,
  have h_to_Lp := λ n, mem_ℒp.coe_fn_to_Lp (hx_mem_ℒp n),
  have hx_nonneg_Lp : ∀ n, 0 ≤ to_Lp (x n) (hx_mem_ℒp n),
  { intro n,
    rw [← Lp.simple_func.coe_fn_le, coe_fn_coe_base' (simple_func.to_Lp (x n) _),
      Lp.simple_func.to_Lp_eq_to_Lp],
    have h0 := Lp.simple_func.coe_fn_zero p μ G,
    filter_upwards [Lp.simple_func.coe_fn_zero p μ G, h_to_Lp n] with a ha0 ha_to_Lp,
    rw [ha0, ha_to_Lp],
    exact hx_nonneg n a, },
  have hx_tendsto : tendsto (λ (n : ℕ), snorm (x n - g) p μ) at_top (𝓝 0),
  { apply simple_func.tendsto_approx_on_Lp_snorm g_meas zero_mem hp_ne_top,
    { have hg_nonneg : 0 ≤ᵐ[μ] g, from (Lp.coe_fn_nonneg _).mpr g.2,
      refine hg_nonneg.mono (λ a ha, subset_closure _),
      simpa using ha, },
    { simp_rw sub_zero, exact hg_mem_ℒp.snorm_lt_top, }, },
  refine ⟨λ n, (coe_simple_func_nonneg_to_Lp_nonneg p μ G) ⟨to_Lp (x n) (hx_mem_ℒp n),
    hx_nonneg_Lp n⟩, λ n, mem_range_self _, _⟩,
  suffices : tendsto (λ (n : ℕ), ↑(to_Lp (x n) (hx_mem_ℒp n))) at_top (𝓝 (g : Lp G p μ)),
  { rw tendsto_iff_dist_tendsto_zero at this ⊢,
    simp_rw subtype.dist_eq,
    convert this, },
  rw Lp.tendsto_Lp_iff_tendsto_ℒp',
  convert hx_tendsto,
  refine funext (λ n, snorm_congr_ae (eventually_eq.sub _ _)),
  { rw Lp.simple_func.to_Lp_eq_to_Lp,
    exact h_to_Lp n, },
  { rw ← coe_fn_coe_base, },
end

variables {p μ G}

end order

end simple_func

end Lp

variables [measurable_space α] [normed_add_comm_group E] {f : α → E} {p : ℝ≥0∞} {μ : measure α}

/-- To prove something for an arbitrary `Lp` function in a second countable Borel normed group, it
suffices to show that
* the property holds for (multiples of) characteristic functions;
* is closed under addition;
* the set of functions in `Lp` for which the property holds is closed.
-/
@[elab_as_eliminator]
lemma Lp.induction [_i : fact (1 ≤ p)] (hp_ne_top : p ≠ ∞) (P : Lp E p μ → Prop)
  (h_ind : ∀ (c : E) {s : set α} (hs : measurable_set s) (hμs : μ s < ∞),
      P (Lp.simple_func.indicator_const p hs hμs.ne c))
  (h_add : ∀ ⦃f g⦄, ∀ hf : mem_ℒp f p μ, ∀ hg : mem_ℒp g p μ, disjoint (support f) (support g) →
    P (hf.to_Lp f) → P (hg.to_Lp g) → P ((hf.to_Lp f) + (hg.to_Lp g)))
  (h_closed : is_closed {f : Lp E p μ | P f}) :
  ∀ f : Lp E p μ, P f :=
begin
  refine λ f, (Lp.simple_func.dense_range hp_ne_top).induction_on f h_closed _,
  refine Lp.simple_func.induction (lt_of_lt_of_le zero_lt_one _i.elim).ne' hp_ne_top _ _,
  { exact λ c s, h_ind c },
  { exact λ f g hf hg, h_add hf hg },
end

/-- To prove something for an arbitrary `mem_ℒp` function in a second countable
Borel normed group, it suffices to show that
* the property holds for (multiples of) characteristic functions;
* is closed under addition;
* the set of functions in the `Lᵖ` space for which the property holds is closed.
* the property is closed under the almost-everywhere equal relation.

It is possible to make the hypotheses in the induction steps a bit stronger, and such conditions
can be added once we need them (for example in `h_add` it is only necessary to consider the sum of
a simple function with a multiple of a characteristic function and that the intersection
of their images is a subset of `{0}`).
-/
@[elab_as_eliminator]
lemma mem_ℒp.induction [_i : fact (1 ≤ p)] (hp_ne_top : p ≠ ∞) (P : (α → E) → Prop)
  (h_ind : ∀ (c : E) ⦃s⦄, measurable_set s → μ s < ∞ → P (s.indicator (λ _, c)))
  (h_add : ∀ ⦃f g : α → E⦄, disjoint (support f) (support g) → mem_ℒp f p μ → mem_ℒp g p μ →
    P f → P g → P (f + g))
  (h_closed : is_closed {f : Lp E p μ | P f} )
  (h_ae : ∀ ⦃f g⦄, f =ᵐ[μ] g → mem_ℒp f p μ → P f → P g) :
  ∀ ⦃f : α → E⦄ (hf : mem_ℒp f p μ), P f :=
begin
  have : ∀ (f : simple_func α E), mem_ℒp f p μ → P f,
  { refine simple_func.induction _ _,
    { intros c s hs h,
      by_cases hc : c = 0,
      { subst hc, convert h_ind 0 measurable_set.empty (by simp) using 1, ext, simp [const] },
      have hp_pos : p ≠ 0 := (lt_of_lt_of_le zero_lt_one _i.elim).ne',
      exact h_ind c hs (simple_func.measure_lt_top_of_mem_ℒp_indicator hp_pos hp_ne_top hc hs h) },
    { intros f g hfg hf hg int_fg,
      rw [simple_func.coe_add,
        mem_ℒp_add_of_disjoint hfg f.strongly_measurable g.strongly_measurable] at int_fg,
      refine h_add hfg int_fg.1 int_fg.2 (hf int_fg.1) (hg int_fg.2) } },
  have : ∀ (f : Lp.simple_func E p μ), P f,
  { intro f,
    exact h_ae (Lp.simple_func.to_simple_func_eq_to_fun f) (Lp.simple_func.mem_ℒp f)
      (this (Lp.simple_func.to_simple_func f) (Lp.simple_func.mem_ℒp f)) },
  have : ∀ (f : Lp E p μ), P f :=
    λ f, (Lp.simple_func.dense_range hp_ne_top).induction_on f h_closed this,
  exact λ f hf, h_ae hf.coe_fn_to_Lp (Lp.mem_ℒp _) (this (hf.to_Lp f)),
end

section integrable

notation α ` →₁ₛ[`:25 μ `] ` E := @measure_theory.Lp.simple_func α E _ _ 1 μ

lemma L1.simple_func.to_Lp_one_eq_to_L1 (f : α →ₛ E) (hf : integrable f μ) :
  (Lp.simple_func.to_Lp f (mem_ℒp_one_iff_integrable.2 hf) : α →₁[μ] E) = hf.to_L1 f :=
rfl

protected lemma L1.simple_func.integrable (f : α →₁ₛ[μ] E) :
  integrable (Lp.simple_func.to_simple_func f) μ :=
by { rw ← mem_ℒp_one_iff_integrable, exact (Lp.simple_func.mem_ℒp f) }

/-- To prove something for an arbitrary integrable function in a normed group,
it suffices to show that
* the property holds for (multiples of) characteristic functions;
* is closed under addition;
* the set of functions in the `L¹` space for which the property holds is closed.
* the property is closed under the almost-everywhere equal relation.

It is possible to make the hypotheses in the induction steps a bit stronger, and such conditions
can be added once we need them (for example in `h_add` it is only necessary to consider the sum of
a simple function with a multiple of a characteristic function and that the intersection
of their images is a subset of `{0}`).
-/
@[elab_as_eliminator]
lemma integrable.induction (P : (α → E) → Prop)
  (h_ind : ∀ (c : E) ⦃s⦄, measurable_set s → μ s < ∞ → P (s.indicator (λ _, c)))
  (h_add : ∀ ⦃f g : α → E⦄, disjoint (support f) (support g) → integrable f μ → integrable g μ →
    P f → P g → P (f + g))
  (h_closed : is_closed {f : α →₁[μ] E | P f} )
  (h_ae : ∀ ⦃f g⦄, f =ᵐ[μ] g → integrable f μ → P f → P g) :
  ∀ ⦃f : α → E⦄ (hf : integrable f μ), P f :=
begin
  simp only [← mem_ℒp_one_iff_integrable] at *,
  exact mem_ℒp.induction one_ne_top P h_ind h_add h_closed h_ae
end

end integrable

end measure_theory