/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.uniform_space.uniform_embedding
import Mathlib.PostPort

universes u l u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Abstract theory of Hausdorff completions of uniform spaces

This file characterizes Hausdorff completions of a uniform space α as complete Hausdorff spaces
equipped with a map from α which has dense image and induce the original uniform structure on α.
Assuming these properties we "extend" uniformly continuous maps from α to complete Hausdorff spaces
to the completions of α. This is the universal property expected from a completion.
It is then used to extend uniformly continuous maps from α to α' to maps between
completions of α and α'.

This file does not construct any such completion, it only study consequences of their existence.
The first advantage is that formal properties are clearly highlighted without interference from
construction details. The second advantage is that this framework can then be used to compare
different completion constructions. See `topology/uniform_space/compare_reals` for an example.
Of course the comparison comes from the universal property as usual.

A general explicit construction of completions is done in `uniform_space/completion`, leading
to a functor from uniform spaces to complete Hausdorff uniform spaces that is left adjoint to the
inclusion, see `uniform_space/UniformSpace` for the category packaging.

## Implementation notes

A tiny technical advantage of using a characteristic predicate such as the properties listed in
`abstract_completion` instead of stating the universal property is that the universal property
derived from the predicate is more universe polymorphic.

## References

We don't know any traditional text discussing this. Real world mathematics simply silently
identify the results of any two constructions that lead to something one could reasonnably
call a completion.

## Tags

uniform spaces, completion, universal property
-/

/-- A completion of `α` is the data of a complete separated uniform space (from the same universe)
and a map from `α` with dense range and inducing the original uniform structure on `α`. -/
structure abstract_completion (α : Type u) [uniform_space α]
where
  space : Type u
  coe : α → space
  uniform_struct : uniform_space space
  complete : complete_space space
  separation : separated_space space
  uniform_inducing : uniform_inducing coe
  dense : dense_range coe

namespace abstract_completion

theorem closure_range {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) : closure (set.range (coe pkg)) = set.univ :=
  dense_range.closure_range (dense pkg)

theorem dense_inducing {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) : dense_inducing (coe pkg) :=
  dense_inducing.mk (uniform_inducing.inducing (uniform_inducing pkg)) (dense pkg)

theorem uniform_continuous_coe {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) : uniform_continuous (coe pkg) :=
  uniform_inducing.uniform_continuous (uniform_inducing pkg)

theorem continuous_coe {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) : continuous (coe pkg) :=
  uniform_continuous.continuous (uniform_continuous_coe pkg)

theorem induction_on {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {p : space pkg → Prop} (a : space pkg) (hp : is_closed (set_of fun (a : space pkg) => p a)) (ih : ∀ (a : α), p (coe pkg a)) : p a :=
  is_closed_property (dense pkg) hp ih a

protected theorem funext {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] [t2_space β] {f : space pkg → β} {g : space pkg → β} (hf : continuous f) (hg : continuous g) (h : ∀ (a : α), f (coe pkg a) = g (coe pkg a)) : f = g :=
  funext fun (a : space pkg) => induction_on pkg a (is_closed_eq hf hg) h

/-- Extension of maps to completions -/
protected def extend {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (f : α → β) : space pkg → β :=
  ite (uniform_continuous f) (dense_inducing.extend (dense_inducing pkg) f)
    fun (x : space pkg) => f (dense_range.some (dense pkg) x)

theorem extend_def {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] {f : α → β} (hf : uniform_continuous f) : abstract_completion.extend pkg f = dense_inducing.extend (dense_inducing pkg) f :=
  if_pos hf

theorem extend_coe {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] {f : α → β} [t2_space β] (hf : uniform_continuous f) (a : α) : abstract_completion.extend pkg f (coe pkg a) = f a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (abstract_completion.extend pkg f (coe pkg a) = f a)) (extend_def pkg hf)))
    (dense_inducing.extend_eq (dense_inducing pkg) (uniform_continuous.continuous hf) a)

theorem uniform_continuous_extend {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] {f : α → β} [complete_space β] [separated_space β] : uniform_continuous (abstract_completion.extend pkg f) := sorry

theorem continuous_extend {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] {f : α → β} [complete_space β] [separated_space β] : continuous (abstract_completion.extend pkg f) :=
  uniform_continuous.continuous (uniform_continuous_extend pkg)

theorem extend_unique {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] {f : α → β} [complete_space β] [separated_space β] (hf : uniform_continuous f) {g : space pkg → β} (hg : uniform_continuous g) (h : ∀ (a : α), f a = g (coe pkg a)) : abstract_completion.extend pkg f = g := sorry

@[simp] theorem extend_comp_coe {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] [complete_space β] [separated_space β] {f : space pkg → β} (hf : uniform_continuous f) : abstract_completion.extend pkg (f ∘ coe pkg) = f := sorry

/-- Lifting maps to completions -/
protected def map {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) (f : α → β) : space pkg → space pkg' :=
  abstract_completion.extend pkg (coe pkg' ∘ f)

theorem uniform_continuous_map {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) (f : α → β) : uniform_continuous (abstract_completion.map pkg pkg' f) :=
  uniform_continuous_extend pkg

theorem continuous_map {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) (f : α → β) : continuous (abstract_completion.map pkg pkg' f) :=
  continuous_extend pkg

@[simp] theorem map_coe {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {f : α → β} (hf : uniform_continuous f) (a : α) : abstract_completion.map pkg pkg' f (coe pkg a) = coe pkg' (f a) :=
  extend_coe pkg (uniform_continuous.comp (uniform_continuous_coe pkg') hf) a

theorem map_unique {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {f : α → β} {g : space pkg → space pkg'} (hg : uniform_continuous g) (h : ∀ (a : α), coe pkg' (f a) = g (coe pkg a)) : abstract_completion.map pkg pkg' f = g := sorry

@[simp] theorem map_id {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) : abstract_completion.map pkg pkg id = id :=
  map_unique pkg pkg uniform_continuous_id fun (a : α) => rfl

theorem extend_map {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {γ : Type u_3} [uniform_space γ] [complete_space γ] [separated_space γ] {f : β → γ} {g : α → β} (hf : uniform_continuous f) (hg : uniform_continuous g) : abstract_completion.extend pkg' f ∘ abstract_completion.map pkg pkg' g = abstract_completion.extend pkg (f ∘ g) := sorry

theorem map_comp {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {γ : Type u_3} [uniform_space γ] (pkg'' : abstract_completion γ) {g : β → γ} {f : α → β} (hg : uniform_continuous g) (hf : uniform_continuous f) : abstract_completion.map pkg' pkg'' g ∘ abstract_completion.map pkg pkg' f = abstract_completion.map pkg pkg'' (g ∘ f) :=
  extend_map pkg pkg' (uniform_continuous.comp (uniform_continuous_coe pkg'') hg) hf

-- We can now compare two completion packages for the same uniform space

/-- The comparison map between two completions of the same uniform space. -/
def compare {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) (pkg' : abstract_completion α) : space pkg → space pkg' :=
  abstract_completion.extend pkg (coe pkg')

theorem uniform_continuous_compare {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) (pkg' : abstract_completion α) : uniform_continuous (compare pkg pkg') :=
  uniform_continuous_extend pkg

theorem compare_coe {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) (pkg' : abstract_completion α) (a : α) : compare pkg pkg' (coe pkg a) = coe pkg' a :=
  extend_coe pkg (uniform_continuous_coe pkg') a

theorem inverse_compare {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) (pkg' : abstract_completion α) : compare pkg pkg' ∘ compare pkg' pkg = id := sorry

/-- The bijection between two completions of the same uniform space. -/
def compare_equiv {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) (pkg' : abstract_completion α) : space pkg ≃ space pkg' :=
  equiv.mk (compare pkg pkg') (compare pkg' pkg) sorry sorry

theorem uniform_continuous_compare_equiv {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) (pkg' : abstract_completion α) : uniform_continuous ⇑(compare_equiv pkg pkg') :=
  uniform_continuous_compare pkg pkg'

theorem uniform_continuous_compare_equiv_symm {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) (pkg' : abstract_completion α) : uniform_continuous ⇑(equiv.symm (compare_equiv pkg pkg')) :=
  uniform_continuous_compare pkg' pkg

/-- Products of completions -/
protected def prod {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) : abstract_completion (α × β) :=
  mk (space pkg × space pkg') (fun (p : α × β) => (coe pkg (prod.fst p), coe pkg' (prod.snd p))) prod.uniform_space sorry
    sorry sorry sorry

/-- Extend two variable map to completions. -/
protected def extend₂ {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {γ : Type u_3} [uniform_space γ] (f : α → β → γ) : space pkg → space pkg' → γ :=
  function.curry (abstract_completion.extend (abstract_completion.prod pkg pkg') (function.uncurry f))

theorem extension₂_coe_coe {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {γ : Type u_3} [uniform_space γ] [separated_space γ] {f : α → β → γ} (hf : uniform_continuous (function.uncurry f)) (a : α) (b : β) : abstract_completion.extend₂ pkg pkg' f (coe pkg a) (coe pkg' b) = f a b := sorry

theorem uniform_continuous_extension₂ {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {γ : Type u_3} [uniform_space γ] [separated_space γ] (f : α → β → γ) [complete_space γ] : uniform_continuous₂ (abstract_completion.extend₂ pkg pkg' f) := sorry

/-- Lift two variable maps to completions. -/
protected def map₂ {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {γ : Type u_3} [uniform_space γ] (pkg'' : abstract_completion γ) (f : α → β → γ) : space pkg → space pkg' → space pkg'' :=
  abstract_completion.extend₂ pkg pkg' (function.bicompr (coe pkg'') f)

theorem uniform_continuous_map₂ {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {γ : Type u_3} [uniform_space γ] (pkg'' : abstract_completion γ) (f : α → β → γ) : uniform_continuous₂ (abstract_completion.map₂ pkg pkg' pkg'' f) :=
  uniform_continuous_extension₂ pkg pkg' (function.bicompr (coe pkg'') f)

theorem continuous_map₂ {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {γ : Type u_3} [uniform_space γ] (pkg'' : abstract_completion γ) {δ : Type u_4} [topological_space δ] {f : α → β → γ} {a : δ → space pkg} {b : δ → space pkg'} (ha : continuous a) (hb : continuous b) : continuous fun (d : δ) => abstract_completion.map₂ pkg pkg' pkg'' f (a d) (b d) :=
  continuous.comp (uniform_continuous.continuous (uniform_continuous_map₂ pkg pkg' pkg'' f)) (continuous.prod_mk ha hb)

theorem map₂_coe_coe {α : Type u_1} [uniform_space α] (pkg : abstract_completion α) {β : Type u_2} [uniform_space β] (pkg' : abstract_completion β) {γ : Type u_3} [uniform_space γ] (pkg'' : abstract_completion γ) (a : α) (b : β) (f : α → β → γ) (hf : uniform_continuous₂ f) : abstract_completion.map₂ pkg pkg' pkg'' f (coe pkg a) (coe pkg' b) = coe pkg'' (f a b) :=
  extension₂_coe_coe pkg pkg' (uniform_continuous.comp (uniform_continuous_coe pkg'') hf) a b


/-
Copyright (c) 2020 Zhangir Azerbayev. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Eric Wieser, Zhangir Azerbayev
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.multilinear
import Mathlib.linear_algebra.linear_independent
import Mathlib.group_theory.perm.sign
import Mathlib.PostPort

universes u_1 u_2 u_3 u_6 l u_4 u_5 u_7

namespace Mathlib

/-!
# Alternating Maps

We construct the bundled function `alternating_map`, which extends `multilinear_map` with all the
arguments of the same type.

## Main definitions
* `alternating_map R M N ι` is the space of `R`-linear alternating maps from `ι → M` to `N`.
* `f.map_eq_zero_of_eq` expresses that `f` is zero when two inputs are equal.
* `f.map_swap` expresses that `f` is negated when two inputs are swapped.
* `f.map_perm` expresses how `f` varies by a sign change under a permutation of its inputs.
* An `add_comm_monoid`, `add_comm_group`, and `semimodule` structure over `alternating_map`s that
  matches the definitions over `multilinear_map`s.
* `multilinear_map.alternatization`, which makes an alternating map out of a non-alternating one.

## Implementation notes
`alternating_map` is defined in terms of `map_eq_zero_of_eq`, as this is easier to work with than
using `map_swap` as a definition, and does not require `has_neg N`.

`alternating_map`s are provided with a coercion to `multilinear_map`, along with a set of
`norm_cast` lemmas that act on the algebraic structure:

* `alternating_map.coe_add`
* `alternating_map.coe_zero`
* `alternating_map.coe_sub`
* `alternating_map.coe_neg`
* `alternating_map.coe_smul`
-/

-- semiring / add_comm_monoid

-- semiring / add_comm_group

/--
An alternating map is a multilinear map that vanishes when two of its arguments are equal.
-/
structure alternating_map (R : Type u_1) [semiring R] (M : Type u_2) [add_comm_monoid M]
    [semimodule R M] (N : Type u_3) [add_comm_monoid N] [semimodule R N] (ι : Type u_6)
    [DecidableEq ι]
    extends multilinear_map R (fun (i : ι) => M) N where
  map_eq_zero_of_eq' : ∀ (v : ι → M) (i j : ι), v i = v j → i ≠ j → to_fun v = 0

/-- The multilinear map associated to an alternating map -/
namespace alternating_map

/-! Basic coercion simp lemmas, largely copied from `ring_hom` and `multilinear_map` -/

protected instance has_coe_to_fun {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] : has_coe_to_fun (alternating_map R M N ι) :=
  has_coe_to_fun.mk (fun (x : alternating_map R M N ι) => ((i : ι) → (fun (i : ι) => M) i) → N)
    fun (x : alternating_map R M N ι) => to_fun x

@[simp] theorem to_fun_eq_coe {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : alternating_map R M N ι) : to_fun f = ⇑f :=
  rfl

@[simp] theorem coe_mk {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : (ι → M) → N)
    (h₁ :
      ∀ (m : (i : ι) → (fun (i : ι) => M) i) (i : ι) (x y : M),
        f (function.update m i (x + y)) = f (function.update m i x) + f (function.update m i y))
    (h₂ :
      ∀ (m : (i : ι) → (fun (i : ι) => M) i) (i : ι) (c : R) (x : M),
        f (function.update m i (c • x)) = c • f (function.update m i x))
    (h₃ : ∀ (v : ι → M) (i j : ι), v i = v j → i ≠ j → f v = 0) : ⇑(mk f h₁ h₂ h₃) = f :=
  rfl

theorem congr_fun {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι]
    {f : alternating_map R M N ι} {g : alternating_map R M N ι} (h : f = g) (x : ι → M) :
    coe_fn f x = coe_fn g x :=
  congr_arg (fun (h : alternating_map R M N ι) => coe_fn h x) h

theorem congr_arg {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι]
    (f : alternating_map R M N ι) {x : ι → M} {y : ι → M} (h : x = y) : coe_fn f x = coe_fn f y :=
  congr_arg (fun (x : ι → M) => coe_fn f x) h

theorem coe_inj {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι]
    {f : alternating_map R M N ι} {g : alternating_map R M N ι} (h : ⇑f = ⇑g) : f = g :=
  sorry

theorem ext {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι]
    {f : alternating_map R M N ι} {f' : alternating_map R M N ι}
    (H : ∀ (x : (i : ι) → (fun (i : ι) => M) i), coe_fn f x = coe_fn f' x) : f = f' :=
  coe_inj (funext H)

theorem ext_iff {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι]
    {f : alternating_map R M N ι} {g : alternating_map R M N ι} :
    f = g ↔ ∀ (x : (i : ι) → (fun (i : ι) => M) i), coe_fn f x = coe_fn g x :=
  { mp := fun (h : f = g) (x : (i : ι) → (fun (i : ι) => M) i) => h ▸ rfl,
    mpr := fun (h : ∀ (x : (i : ι) → (fun (i : ι) => M) i), coe_fn f x = coe_fn g x) => ext h }

protected instance multilinear_map.has_coe {R : Type u_1} [semiring R] {M : Type u_2}
    [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N]
    {ι : Type u_6} [DecidableEq ι] :
    has_coe (alternating_map R M N ι) (multilinear_map R (fun (i : ι) => M) N) :=
  has_coe.mk fun (x : alternating_map R M N ι) => to_multilinear_map x

@[simp] theorem coe_multilinear_map {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : alternating_map R M N ι) : ⇑↑f = ⇑f :=
  rfl

@[simp] theorem to_multilinear_map_eq_coe {R : Type u_1} [semiring R] {M : Type u_2}
    [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N]
    {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) : to_multilinear_map f = ↑f :=
  rfl

@[simp] theorem coe_multilinear_map_mk {R : Type u_1} [semiring R] {M : Type u_2}
    [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N]
    {ι : Type u_6} [DecidableEq ι] (f : (ι → M) → N)
    (h₁ :
      ∀ (m : (i : ι) → (fun (i : ι) => M) i) (i : ι) (x y : M),
        f (function.update m i (x + y)) = f (function.update m i x) + f (function.update m i y))
    (h₂ :
      ∀ (m : (i : ι) → (fun (i : ι) => M) i) (i : ι) (c : R) (x : M),
        f (function.update m i (c • x)) = c • f (function.update m i x))
    (h₃ : ∀ (v : ι → M) (i j : ι), v i = v j → i ≠ j → f v = 0) :
    ↑(mk f h₁ h₂ h₃) = multilinear_map.mk f h₁ h₂ :=
  rfl

/-!
### Simp-normal forms of the structure fields

These are expressed in terms of `⇑f` instead of `f.to_fun`.
-/

@[simp] theorem map_add {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) (i : ι) (x : M) (y : M) :
    coe_fn f (function.update v i (x + y)) =
        coe_fn f (function.update v i x) + coe_fn f (function.update v i y) :=
  multilinear_map.map_add' (to_multilinear_map f) v i x y

@[simp] theorem map_sub {R : Type u_1} [semiring R] {M' : Type u_4} [add_comm_group M']
    [semimodule R M'] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] (g' : alternating_map R M' N' ι) (v' : ι → M') (i : ι) (x : M') (y : M') :
    coe_fn g' (function.update v' i (x - y)) =
        coe_fn g' (function.update v' i x) - coe_fn g' (function.update v' i y) :=
  multilinear_map.map_sub (to_multilinear_map g') v' i x y

@[simp] theorem map_neg {R : Type u_1} [semiring R] {M' : Type u_4} [add_comm_group M']
    [semimodule R M'] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] (g' : alternating_map R M' N' ι) (v' : ι → M') (i : ι) (x : M') :
    coe_fn g' (function.update v' i (-x)) = -coe_fn g' (function.update v' i x) :=
  multilinear_map.map_neg (to_multilinear_map g') v' i x

@[simp] theorem map_smul {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) (i : ι) (r : R) (x : M) :
    coe_fn f (function.update v i (r • x)) = r • coe_fn f (function.update v i x) :=
  multilinear_map.map_smul' (to_multilinear_map f) v i r x

@[simp] theorem map_eq_zero_of_eq {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) {i : ι} {j : ι} (h : v i = v j)
    (hij : i ≠ j) : coe_fn f v = 0 :=
  map_eq_zero_of_eq' f v i j h hij

/-!
### Algebraic structure inherited from `multilinear_map`

`alternating_map` carries the same `add_comm_monoid`, `add_comm_group`, and `semimodule` structure
as `multilinear_map`
-/

protected instance has_add {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] : Add (alternating_map R M N ι) :=
  { add :=
      fun (a b : alternating_map R M N ι) =>
        mk (multilinear_map.to_fun (↑a + ↑b)) sorry sorry sorry }

@[simp] theorem add_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : alternating_map R M N ι) (f' : alternating_map R M N ι) (v : ι → M) :
    coe_fn (f + f') v = coe_fn f v + coe_fn f' v :=
  rfl

theorem coe_add {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι]
    (f : alternating_map R M N ι) (f' : alternating_map R M N ι) : ↑(f + f') = ↑f + ↑f' :=
  rfl

protected instance has_zero {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] : HasZero (alternating_map R M N ι) :=
  { zero := mk (multilinear_map.to_fun 0) sorry sorry sorry }

@[simp] theorem zero_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (v : ι → M) : coe_fn 0 v = 0 :=
  rfl

theorem coe_zero {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] : ↑0 = 0 :=
  rfl

protected instance inhabited {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] : Inhabited (alternating_map R M N ι) :=
  { default := 0 }

protected instance add_comm_monoid {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] : add_comm_monoid (alternating_map R M N ι) :=
  add_comm_monoid.mk Add.add sorry 0 sorry sorry sorry

protected instance has_neg {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] : Neg (alternating_map R M N' ι) :=
  { neg :=
      fun (f : alternating_map R M N' ι) => mk (multilinear_map.to_fun (-↑f)) sorry sorry sorry }

@[simp] theorem neg_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] (g : alternating_map R M N' ι) (m : ι → M) : coe_fn (-g) m = -coe_fn g m :=
  rfl

theorem coe_neg {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι]
    (g : alternating_map R M N' ι) : ↑(-g) = -↑g :=
  rfl

protected instance has_sub {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] : Sub (alternating_map R M N' ι) :=
  { sub :=
      fun (f g : alternating_map R M N' ι) =>
        mk (multilinear_map.to_fun (↑f - ↑g)) sorry sorry sorry }

@[simp] theorem sub_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] (g : alternating_map R M N' ι) (g₂ : alternating_map R M N' ι) (m : ι → M) :
    coe_fn (g - g₂) m = coe_fn g m - coe_fn g₂ m :=
  rfl

theorem coe_sub {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι]
    (g : alternating_map R M N' ι) (g₂ : alternating_map R M N' ι) : ↑(g - g₂) = ↑g - ↑g₂ :=
  rfl

protected instance add_comm_group {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] : add_comm_group (alternating_map R M N' ι) :=
  add_comm_group.mk Add.add sorry 0 sorry sorry Neg.neg Sub.sub sorry sorry

protected instance has_scalar {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] {S : Type u_7} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N] :
    has_scalar S (alternating_map R M N ι) :=
  has_scalar.mk
    fun (c : S) (f : alternating_map R M N ι) =>
      mk (multilinear_map.to_fun (c • ↑f)) sorry sorry sorry

@[simp] theorem smul_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : alternating_map R M N ι) {S : Type u_7} [monoid S] [distrib_mul_action S N]
    [smul_comm_class R S N] (c : S) (m : ι → M) : coe_fn (c • f) m = c • coe_fn f m :=
  rfl

theorem coe_smul {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι]
    (f : alternating_map R M N ι) {S : Type u_7} [monoid S] [distrib_mul_action S N]
    [smul_comm_class R S N] (c : S) : ↑(c • f) = c • ↑f :=
  rfl

protected instance distrib_mul_action {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] {S : Type u_7} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N] :
    distrib_mul_action S (alternating_map R M N ι) :=
  distrib_mul_action.mk sorry sorry

/-- The space of multilinear maps over an algebra over `R` is a module over `R`, for the pointwise
addition and scalar multiplication. -/
protected instance semimodule {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] {S : Type u_7} [semiring S] [semimodule S N] [smul_comm_class R S N] :
    semimodule S (alternating_map R M N ι) :=
  semimodule.mk sorry sorry

end alternating_map

/-!
### Composition with linear maps
-/

namespace linear_map

/-- Composing a alternating map with a linear map gives again a alternating map. -/
def comp_alternating_map {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] {N₂ : Type u_7} [add_comm_monoid N₂] [semimodule R N₂] (g : linear_map R N N₂) :
    alternating_map R M N ι →+ alternating_map R M N₂ ι :=
  add_monoid_hom.mk
    (fun (f : alternating_map R M N ι) =>
      alternating_map.mk (multilinear_map.to_fun (comp_multilinear_map g ↑f)) sorry sorry sorry)
    sorry sorry

@[simp] theorem coe_comp_alternating_map {R : Type u_1} [semiring R] {M : Type u_2}
    [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N]
    {ι : Type u_6} [DecidableEq ι] {N₂ : Type u_7} [add_comm_monoid N₂] [semimodule R N₂]
    (g : linear_map R N N₂) (f : alternating_map R M N ι) :
    ⇑(coe_fn (comp_alternating_map g) f) = ⇑g ∘ ⇑f :=
  rfl

theorem comp_alternating_map_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] {N₂ : Type u_7} [add_comm_monoid N₂] [semimodule R N₂] (g : linear_map R N N₂)
    (f : alternating_map R M N ι) (m : ι → M) :
    coe_fn (coe_fn (comp_alternating_map g) f) m = coe_fn g (coe_fn f m) :=
  rfl

end linear_map

namespace alternating_map

/-!
### Other lemmas from `multilinear_map`
-/

theorem map_update_sum {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : alternating_map R M N ι) {α : Type u_4} (t : finset α) (i : ι) (g : α → M)
    (m : ι → M) :
    coe_fn f (function.update m i (finset.sum t fun (a : α) => g a)) =
        finset.sum t fun (a : α) => coe_fn f (function.update m i (g a)) :=
  multilinear_map.map_update_sum (to_multilinear_map f) t i g m

/-!
### Theorems specific to alternating maps

Various properties of reordered and repeated inputs which follow from
`alternating_map.map_eq_zero_of_eq`.
-/

theorem map_update_self {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) {i : ι} {j : ι} (hij : i ≠ j) :
    coe_fn f (function.update v i (v j)) = 0 :=
  sorry

theorem map_update_update {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6}
    [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) {i : ι} {j : ι} (hij : i ≠ j)
    (m : M) : coe_fn f (function.update (function.update v i m) j m) = 0 :=
  sorry

theorem map_swap_add {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι]
    (f : alternating_map R M N ι) (v : ι → M) {i : ι} {j : ι} (hij : i ≠ j) :
    coe_fn f (v ∘ ⇑(equiv.swap i j)) + coe_fn f v = 0 :=
  sorry

theorem map_add_swap {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι]
    (f : alternating_map R M N ι) (v : ι → M) {i : ι} {j : ι} (hij : i ≠ j) :
    coe_fn f v + coe_fn f (v ∘ ⇑(equiv.swap i j)) = 0 :=
  sorry

theorem map_swap {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι]
    (g : alternating_map R M N' ι) (v : ι → M) {i : ι} {j : ι} (hij : i ≠ j) :
    coe_fn g (v ∘ ⇑(equiv.swap i j)) = -coe_fn g v :=
  eq_neg_of_add_eq_zero (map_swap_add g v hij)

theorem map_perm {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι]
    (g : alternating_map R M N' ι) [fintype ι] (v : ι → M) (σ : equiv.perm ι) :
    coe_fn g (v ∘ ⇑σ) = ↑(coe_fn equiv.perm.sign σ) • coe_fn g v :=
  sorry

theorem map_congr_perm {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] (g : alternating_map R M N' ι) (v : ι → M) [fintype ι] (σ : equiv.perm ι) :
    coe_fn g v = ↑(coe_fn equiv.perm.sign σ) • coe_fn g (v ∘ ⇑σ) :=
  sorry

theorem coe_dom_dom_congr {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] (g : alternating_map R M N' ι) [fintype ι] (σ : equiv.perm ι) :
    multilinear_map.dom_dom_congr σ ↑g = ↑(coe_fn equiv.perm.sign σ) • ↑g :=
  multilinear_map.ext fun (v : ι → M) => map_perm g v σ

/-- If the arguments are linearly dependent then the result is `0`.

TODO: Can the `division_ring` requirement be relaxed? -/
theorem map_linear_dependent {ι : Type u_6} [DecidableEq ι] {K : Type u_1} [division_ring K]
    {M : Type u_2} [add_comm_group M] [semimodule K M] {N : Type u_3} [add_comm_group N]
    [semimodule K N] (f : alternating_map K M N ι) (v : ι → M) (h : ¬linear_independent K v) :
    coe_fn f v = 0 :=
  sorry

end alternating_map

namespace multilinear_map

/-- Produce an `alternating_map` out of a `multilinear_map`, by summing over all argument
permutations. -/
def alternatization {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M]
    {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι]
    [fintype ι] : multilinear_map R (fun (i : ι) => M) N' →+ alternating_map R M N' ι :=
  add_monoid_hom.mk
    (fun (m : multilinear_map R (fun (i : ι) => M) N') =>
      alternating_map.mk
        ⇑(finset.sum finset.univ
            fun (σ : equiv.perm ι) => ↑(coe_fn equiv.perm.sign σ) • dom_dom_congr σ m)
        sorry sorry sorry)
    sorry sorry

theorem alternatization_def {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] [fintype ι] (m : multilinear_map R (fun (i : ι) => M) N') :
    ⇑(coe_fn alternatization m) =
        ⇑(finset.sum finset.univ
            fun (σ : equiv.perm ι) => ↑(coe_fn equiv.perm.sign σ) • dom_dom_congr σ m) :=
  rfl

theorem alternatization_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] [fintype ι] (m : multilinear_map R (fun (i : ι) => M) N') (v : ι → M) :
    coe_fn (coe_fn alternatization m) v =
        finset.sum finset.univ
          fun (σ : equiv.perm ι) => ↑(coe_fn equiv.perm.sign σ) • coe_fn (dom_dom_congr σ m) v :=
  sorry

end multilinear_map

namespace alternating_map

/-- Alternatizing a multilinear map that is already alternating results in a scale factor of `n!`,
where `n` is the number of inputs. -/
theorem coe_alternatization {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6}
    [DecidableEq ι] [fintype ι] (a : alternating_map R M N' ι) :
    coe_fn multilinear_map.alternatization ↑a = nat.factorial (fintype.card ι) • a :=
  sorry

end alternating_map

namespace linear_map

/-- Composition with a linear map before and after alternatization are equivalent. -/
theorem comp_multilinear_map_alternatization {R : Type u_1} [semiring R] {M : Type u_2}
    [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N']
    {ι : Type u_6} [DecidableEq ι] {N'₂ : Type u_7} [add_comm_group N'₂] [semimodule R N'₂]
    [fintype ι] (g : linear_map R N' N'₂) (f : multilinear_map R (fun (_x : ι) => M) N') :
    coe_fn multilinear_map.alternatization (comp_multilinear_map g f) =
        coe_fn (comp_alternating_map g) (coe_fn multilinear_map.alternatization f) :=
  sorry

end Mathlib


/- Individual results that should be moved to mathlib. If there are many related results, put them in a separate file. -/

import .basic data.finsupp

universe variables u v
open function

/- move to logic -/
def ite_ne_neg {p : Prop} [h : decidable p] {α : Sort u} {x y : α} (h : ite p x y ≠ y) : p :=
by { by_cases hp : p, exact hp, rw [if_neg hp] at h, contradiction }

def ite_ne_pos {p : Prop} [h : decidable p] {α : Sort u} {x y : α} (h : ite p x y ≠ x) : ¬p :=
by { by_cases hp : p, rw [if_pos hp] at h, contradiction, exact hp }

namespace sum
lemma injective_inl {α β : Type*} : injective (inl : α → α ⊕ β) :=
λ x y, inl.inj

lemma injective_inr {α β : Type*} : injective (inr : β → α ⊕ β) :=
λ x y, inr.inj

def embedding_inl {α β : Type*} : α ↪ α ⊕ β :=
⟨inl, injective_inl⟩

def embedding_inr {α β : Type*} : β ↪ α ⊕ β :=
⟨inr, injective_inr⟩
end sum

namespace equiv

def equiv_embedding_fun {α β : Type*} : (α ≃ β) ↪ (α → β) :=
⟨equiv.to_fun, λ f g, eq_of_to_fun_eq⟩

end equiv

namespace finsupp
/- move to finsupp -/
lemma injective_emb_domain {α β γ : Type*} [has_zero γ] [decidable_eq β] (f : α ↪ β) :
  injective (emb_domain f : (α →₀ γ) → (β →₀ γ)) :=
omitted

def finsupp_embedding_finsupp_left {α β γ : Type*} [has_zero γ] [decidable_eq β] (f : α ↪ β) :
  (α →₀ γ) ↪ (β →₀ γ) :=
⟨λ g, emb_domain f g, injective_emb_domain f⟩
end finsupp


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

Lebesgue integral on `ennreal`.

We define simple functions and show that each Borel measurable function on `ennreal` can be
approximated by a sequence of simple functions.
-/
import
  algebra.pi_instances
  measure_theory.measure_space
  measure_theory.borel_space
noncomputable theory
open lattice set filter
local attribute [instance] classical.prop_decidable

section sequence_of_directed
variables {α : Type*} {β : Type*} [encodable α] [inhabited α]
open encodable

noncomputable def sequence_of_directed (r : β → β → Prop) (f : α → β) (hf : directed r f) : ℕ → α
| 0       := default α
| (n + 1) :=
  let p := sequence_of_directed n in
  match decode α n with
  | none     := p
  | (some a) := classical.some (hf p a)
  end

lemma monotone_sequence_of_directed [partial_order β] (f : α → β) (hf : directed (≤) f) :
  monotone (f ∘ sequence_of_directed (≤) f hf) :=
monotone_of_monotone_nat $ assume n,
  begin
    dsimp [sequence_of_directed],
    generalize eq : sequence_of_directed (≤) f hf n = p,
    cases h : decode α n with a,
    { refl },
    { exact (classical.some_spec (hf p a)).1 }
  end

lemma le_sequence_of_directed [partial_order β] (f : α → β) (hf : directed (≤) f) (a : α) :
  f a ≤ f (sequence_of_directed (≤) f hf (encode a + 1)) :=
begin
  simp [sequence_of_directed, -add_comm, encodek],
  exact (classical.some_spec (hf _ a)).2
end

end sequence_of_directed

namespace measure_theory

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

structure {u v} simple_func (α : Type u) [measurable_space α] (β : Type v) :=
(to_fun : α → β)
(measurable_sn : ∀ x, is_measurable (to_fun ⁻¹' {x}))
(finite : (set.range to_fun).finite)

local infixr ` →ₛ `:25 := simple_func

namespace simple_func

section measurable
variables [measurable_space α]
instance has_coe_to_fun : has_coe_to_fun (α →ₛ β) := ⟨_, to_fun⟩

@[extensionality] theorem ext {f g : α →ₛ β} (H : ∀ a, f a = g a) : f = g :=
by cases f; cases g; congr; exact funext H

protected def range (f : α →ₛ β) := f.finite.to_finset

@[simp] theorem mem_range {f : α →ₛ β} {b} : b ∈ f.range ↔ ∃ a, f a = b :=
finite.mem_to_finset

def const (α) {β} [measurable_space α] (b : β) : α →ₛ β :=
⟨λ a, b, λ x, is_measurable.const _,
  finite_subset (set.finite_singleton b) $ by rintro _ ⟨a, rfl⟩; simp⟩

@[simp] theorem const_apply (a : α) (b : β) : (const α b) a = b := rfl

lemma range_const (α) [measure_space α] [ne : nonempty α] (b : β) :
  (const α b).range = {b} :=
begin
  ext b',
  simp [mem_range],
  exact ⟨assume ⟨_, h⟩, h.symm, assume h, ne.elim $ λa, ⟨a, h.symm⟩⟩
end

lemma is_measurable_cut (p : α → β → Prop) (f : α →ₛ β)
  (h : ∀b, is_measurable {a | p a b}) : is_measurable {a | p a (f a)} :=
begin
  rw (_ : {a | p a (f a)} = ⋃ b ∈ set.range f, {a | p a b} ∩ f ⁻¹' {b}),
  { exact is_measurable.bUnion (countable_finite f.finite)
      (λ b _, is_measurable.inter (h b) (f.measurable_sn _)) },
  ext a, simp,
  exact ⟨λ h, ⟨_, ⟨a, rfl⟩, h, rfl⟩, λ ⟨_, ⟨a', rfl⟩, h', e⟩, e.symm ▸ h'⟩
end

theorem preimage_measurable (f : α →ₛ β) (s) : is_measurable (f ⁻¹' s) :=
is_measurable_cut (λ _ b, b ∈ s) f (λ b, by simp [is_measurable.const])

theorem measurable [measurable_space β] (f : α →ₛ β) : measurable f :=
λ s _, preimage_measurable f s

def ite {s : set α} (hs : is_measurable s) (f g : α →ₛ β) : α →ₛ β :=
⟨λ a, if a ∈ s then f a else g a,
 λ x, by letI : measurable_space β := ⊤; exact
   measurable.if hs f.measurable g.measurable _ trivial,
 finite_subset (finite_union f.finite g.finite) begin
   rintro _ ⟨a, rfl⟩,
   by_cases a ∈ s; simp [h],
   exacts [or.inl ⟨_, rfl⟩, or.inr ⟨_, rfl⟩]
 end⟩

@[simp] theorem ite_apply {s : set α} (hs : is_measurable s)
  (f g : α →ₛ β) (a) : ite hs f g a = if a ∈ s then f a else g a := rfl

def bind (f : α →ₛ β) (g : β → α →ₛ γ) : α →ₛ γ :=
⟨λa, g (f a) a,
 λ c, is_measurable_cut (λa b, g b a ∈ ({c} : set γ)) f (λ b, (g b).measurable_sn c),
 finite_subset (finite_bUnion f.finite (λ b, (g b).finite)) $
 by rintro _ ⟨a, rfl⟩; simp; exact ⟨_, ⟨a, rfl⟩, _, rfl⟩⟩

@[simp] theorem bind_apply (f : α →ₛ β) (g : β → α →ₛ γ) (a) :
  f.bind g a = g (f a) a := rfl

def restrict [has_zero β] (f : α →ₛ β) (s : set α) : α →ₛ β :=
if hs : is_measurable s then ite hs f (const α 0) else const α 0

@[simp] theorem restrict_apply [has_zero β]
  (f : α →ₛ β) {s : set α} (hs : is_measurable s) (a) :
  restrict f s a = if a ∈ s then f a else 0 :=
by unfold_coes; simp [restrict, hs]; apply ite_apply hs

theorem restrict_preimage [has_zero β]
  (f : α →ₛ β) {s : set α} (hs : is_measurable s)
  {t : set β} (ht : (0:β) ∉ t) : restrict f s ⁻¹' t = s ∩ f ⁻¹' t :=
by ext a; dsimp; rw [restrict_apply]; by_cases a ∈ s; simp [h, hs, ht]

def map (g : β → γ) (f : α →ₛ β) : α →ₛ γ := bind f (const α ∘ g)

@[simp] theorem map_apply (g : β → γ) (f : α →ₛ β) (a) : f.map g a = g (f a) := rfl

theorem map_map (g : β → γ) (h: γ → δ) (f : α →ₛ β) : (f.map g).map h = f.map (h ∘ g) := rfl

theorem coe_map (g : β → γ) (f : α →ₛ β) : (f.map g : α → γ) = g ∘ f := rfl

@[simp] theorem range_map (g : β → γ) (f : α →ₛ β) : (f.map g).range = f.range.image g :=
begin
  ext c,
  simp [mem_range],
  split,
  { rintros ⟨a, rfl⟩, exact ⟨f a, ⟨_, rfl⟩, rfl⟩ },
  { rintros ⟨_, ⟨a, rfl⟩, rfl⟩, exact ⟨_, rfl⟩ }
end

def seq (f : α →ₛ (β → γ)) (g : α →ₛ β) : α →ₛ γ := f.bind (λf, g.map f)

def pair (f : α →ₛ β) (g : α →ₛ γ) : α →ₛ (β × γ) := (f.map prod.mk).seq g

@[simp] lemma pair_apply (f : α →ₛ β) (g : α →ₛ γ) (a) : pair f g a = (f a, g a) := rfl

theorem bind_const (f : α →ₛ β) : f.bind (const α) = f := by ext; simp

instance [has_zero β] : has_zero (α →ₛ β) := ⟨const α 0⟩
instance [has_add β] : has_add (α →ₛ β) := ⟨λf g, (f.map (+)).seq g⟩
instance [has_mul β] : has_mul (α →ₛ β) := ⟨λf g, (f.map (*)).seq g⟩
instance [has_sup β] : has_sup (α →ₛ β) := ⟨λf g, (f.map (⊔)).seq g⟩
instance [has_inf β] : has_inf (α →ₛ β) := ⟨λf g, (f.map (⊓)).seq g⟩
instance [has_le β] : has_le (α →ₛ β) := ⟨λf g, ∀a, f a ≤ g a⟩

@[simp] lemma sup_apply [has_sup β] (f g : α →ₛ β) (a : α) : (f ⊔ g) a = f a ⊔ g a := rfl
@[simp] lemma mul_apply [has_mul β] (f g : α →ₛ β) (a : α) : (f * g) a = f a * g a := rfl
lemma add_apply [has_add β] (f g : α →ₛ β) (a : α) : (f + g) a = f a + g a := rfl

lemma add_eq_map₂ [has_add β] (f g : α →ₛ β) : f + g = (pair f g).map (λp:β×β, p.1 + p.2) :=
rfl

lemma sup_eq_map₂ [has_sup β] (f g : α →ₛ β) : f ⊔ g = (pair f g).map (λp:β×β, p.1 ⊔ p.2) :=
rfl

lemma const_mul_eq_map [has_mul β] (f : α →ₛ β) (b : β) : const α b * f = f.map (λa, b * a) := rfl

instance [add_monoid β] : add_monoid (α →ₛ β) :=
{ add       := (+), zero := 0,
  add_assoc := assume f g h, ext (assume a, add_assoc _ _ _),
  zero_add  := assume f, ext (assume a, zero_add _),
  add_zero  := assume f, ext (assume a, add_zero _) }

instance [semiring β] [add_monoid β] : has_scalar β (α →ₛ β) := ⟨λb f, f.map (λa, b * a)⟩

instance [preorder β] : preorder (α →ₛ β) :=
{ le_refl := λf a, le_refl _,
  le_trans := λf g h hfg hgh a, le_trans (hfg _) (hgh a),
  .. simple_func.has_le }

instance [partial_order β] : partial_order (α →ₛ β) :=
{ le_antisymm := assume f g hfg hgf, ext $ assume a, le_antisymm (hfg a) (hgf a),
  .. simple_func.preorder }

instance [order_bot β] : order_bot (α →ₛ β) :=
{ bot := const α ⊥, bot_le := λf a, bot_le, .. simple_func.partial_order }

instance [order_top β] : order_top (α →ₛ β) :=
{ top := const α⊤, le_top := λf a, le_top, .. simple_func.partial_order }

instance [semilattice_inf β] : semilattice_inf (α →ₛ β) :=
{ inf := (⊓),
  inf_le_left := assume f g a, inf_le_left,
  inf_le_right := assume f g a, inf_le_right,
  le_inf := assume f g h hfh hgh a, le_inf (hfh a) (hgh a),
  .. simple_func.partial_order }

instance [semilattice_sup β] : semilattice_sup (α →ₛ β) :=
{ sup := (⊔),
  le_sup_left := assume f g a, le_sup_left,
  le_sup_right := assume f g a, le_sup_right,
  sup_le := assume f g h hfh hgh a, sup_le (hfh a) (hgh a),
  .. simple_func.partial_order }

instance [semilattice_sup_bot β] : semilattice_sup_bot (α →ₛ β) :=
{ .. simple_func.lattice.semilattice_sup,.. simple_func.lattice.order_bot }

instance [lattice β] : lattice (α →ₛ β) :=
{ .. simple_func.lattice.semilattice_sup,.. simple_func.lattice.semilattice_inf }

instance [bounded_lattice β] : bounded_lattice (α →ₛ β) :=
{ .. simple_func.lattice.lattice, .. simple_func.lattice.order_bot, .. simple_func.lattice.order_top }

lemma finset_sup_apply [semilattice_sup_bot β] {f : γ → α →ₛ β} (s : finset γ) (a : α) :
  s.sup f a = s.sup (λc, f c a) :=
begin
  refine finset.induction_on s rfl _,
  assume a s hs ih,
  rw [finset.sup_insert, finset.sup_insert, sup_apply, ih]
end

section approx

section
variables [topological_space β] [semilattice_sup_bot β] [has_zero β]

def approx (i : ℕ → β) (f : α → β) (n : ℕ) : α →ₛ β :=
(finset.range n).sup (λk, restrict (const α (i k)) {a:α | i k ≤ f a})

lemma approx_apply [ordered_topology β] {i : ℕ → β} {f : α → β} {n : ℕ} (a : α)
  (hf : _root_.measurable f) :
  (approx i f n : α →ₛ β) a = (finset.range n).sup (λk, if i k ≤ f a then i k else 0) :=
begin
  dsimp only [approx],
  rw [finset_sup_apply],
  congr,
  funext k,
  rw [restrict_apply],
  refl,
  exact (hf.preimage $ is_measurable_of_is_closed $ is_closed_ge' _)
end

lemma monotone_approx (i : ℕ → β) (f : α → β) : monotone (approx i f) :=
assume n m h, finset.sup_mono $ finset.range_subset.2 h

lemma approx_comp [ordered_topology β] [measurable_space γ]
  {i : ℕ → β} {f : γ → β} {g : α → γ} {n : ℕ} (a : α)
  (hf : _root_.measurable f) (hg : _root_.measurable g) :
  (approx i (f ∘ g) n : α →ₛ β) a = (approx i f n : γ →ₛ β) (g a) :=
by rw [approx_apply _ hf, approx_apply _ (hg.comp hf)]

end

lemma supr_approx_apply [topological_space β] [complete_lattice β] [ordered_topology β] [has_zero β]
  (i : ℕ → β) (f : α → β) (a : α) (hf : _root_.measurable f) (h_zero : (0 : β) = ⊥):
  (⨆n, (approx i f n : α →ₛ β) a) = (⨆k (h : i k ≤ f a), i k) :=
begin
  refine le_antisymm (supr_le $ assume n, _) (supr_le $ assume k, supr_le $ assume hk, _),
  { rw [approx_apply a hf, h_zero],
    refine finset.sup_le (assume k hk, _),
    split_ifs,
    exact le_supr_of_le k (le_supr _ h),
    exact bot_le },
  { refine le_supr_of_le (k+1) _,
    rw [approx_apply a hf],
    have : k ∈ finset.range (k+1) := finset.mem_range.2 (nat.lt_succ_self _),
    refine le_trans (le_of_eq _) (finset.le_sup this),
    rw [if_pos hk] }
end

end approx

section eapprox

def ennreal_rat_embed (n : ℕ) : ennreal :=
nnreal.of_real ((encodable.decode ℚ n).get_or_else (0 : ℚ))

lemma ennreal_rat_embed_encode (q : ℚ) (hq : 0 ≤ q) :
  ennreal_rat_embed (encodable.encode q) = nnreal.of_real q :=
by rw [ennreal_rat_embed, encodable.encodek]; refl

def eapprox : (α → ennreal) → ℕ → α →ₛ ennreal :=
approx ennreal_rat_embed

lemma monotone_eapprox (f : α → ennreal) : monotone (eapprox f) :=
monotone_approx _ f

lemma supr_eapprox_apply (f : α → ennreal) (hf : _root_.measurable f) (a : α) :
  (⨆n, (eapprox f n : α →ₛ ennreal) a) = f a :=
begin
  rw [eapprox, supr_approx_apply ennreal_rat_embed f a hf rfl],
  refine le_antisymm (supr_le $ assume i, supr_le $ assume hi, hi) (le_of_not_gt _),
  assume h,
  rcases ennreal.lt_iff_exists_rat_btwn.1 h with ⟨q, hq, lt_q, q_lt⟩,
  have : (nnreal.of_real q : ennreal) ≤
      (⨆ (k : ℕ) (h : ennreal_rat_embed k ≤ f a), ennreal_rat_embed k),
  { refine le_supr_of_le (encodable.encode q) _,
    rw [ennreal_rat_embed_encode q hq],
    refine le_supr_of_le (le_of_lt q_lt) _,
    exact le_refl _ },
  exact lt_irrefl _ (lt_of_le_of_lt this lt_q)
end

lemma eapprox_comp [measurable_space γ] {f : γ → ennreal} {g : α → γ} {n : ℕ}
  (hf : _root_.measurable f) (hg : _root_.measurable g) :
  (eapprox (f ∘ g) n : α → ennreal) = (eapprox f n : γ →ₛ ennreal) ∘ g :=
funext $ assume a, approx_comp a hf hg

end eapprox

end measurable

section measure
variables [measure_space α]

def integral (f : α →ₛ ennreal) : ennreal :=
f.range.sum (λ x, x * volume (f ⁻¹' {x}))

-- TODO: slow simp proofs
lemma map_integral (g : β → ennreal) (f : α →ₛ β) :
  (f.map g).integral = f.range.sum (λ x, g x * volume (f ⁻¹' {x})) :=
begin
  simp only [integral, coe_map, range_map],
  refine finset.sum_image' _ (assume b hb, _),
  rcases mem_range.1 hb with ⟨a, rfl⟩,
  let s' := f.range.filter (λb, g b = g (f a)),
  have : g ∘ ⇑f ⁻¹' {g (f a)} = (⋃b∈s', ⇑f ⁻¹' {b}),
  { ext a',
    simp,
    split,
    { assume eq, exact ⟨⟨_, rfl⟩, eq⟩ },
    { rintros ⟨_, eq⟩, exact eq } },
  calc g (f a) * volume (g ∘ ⇑f ⁻¹' {g (f a)}) = g (f a) * volume (⋃b∈s', ⇑f ⁻¹' {b}) : by rw [this]
    ... = g (f a) * s'.sum (λb, volume (f ⁻¹' {b})) :
    begin
      rw [volume_bUnion_finset],
      { simp [pairwise_on, (on)],
        rintros b a₀ rfl eq₀ b a₁ rfl eq₁ ne a ⟨h₁, h₂⟩,
        simp at h₁ h₂,
        rw [← h₁, h₂] at ne,
        exact ne rfl },
      exact assume a ha, preimage_measurable _ _
    end
    ... = s'.sum (λb,  g (f a) * volume (f ⁻¹' {b})) : by rw [finset.mul_sum]
    ... = s'.sum  (λb, g b * volume (f ⁻¹' {b})) : finset.sum_congr rfl $ by simp {contextual := tt}
end

lemma zero_integral : (0 : α →ₛ ennreal).integral = 0 :=
begin
  refine (finset.sum_eq_zero_iff_of_nonneg $ assume _ _, zero_le _).2 _,
  assume r hr, rcases mem_range.1 hr with ⟨a, rfl⟩,
  exact zero_mul _
end

lemma add_integral (f g : α →ₛ ennreal) : (f + g).integral = f.integral + g.integral :=
calc (f + g).integral =
      (pair f g).range.sum (λx, x.1 * volume (pair f g ⁻¹' {x}) + x.2  * volume (pair f g ⁻¹' {x})) :
    by rw [add_eq_map₂, map_integral]; exact finset.sum_congr rfl (assume a ha, add_mul _ _ _)
  ... = (pair f g).range.sum (λx, x.1 * volume (pair f g ⁻¹' {x})) +
      (pair f g).range.sum (λx, x.2 * volume (pair f g ⁻¹' {x})) : by rw [finset.sum_add_distrib]
  ... = ((pair f g).map prod.fst).integral + ((pair f g).map prod.snd).integral :
    by rw [map_integral, map_integral]
  ... = integral f + integral g : rfl

lemma const_mul_integral (f : α →ₛ ennreal) (x : ennreal) :
  (const α x * f).integral = x * f.integral :=
calc (f.map (λa, x * a)).integral = f.range.sum (λr, x * r * volume (f ⁻¹' {r})) :
    by rw [map_integral]
  ... = f.range.sum (λr, x * (r * volume (f ⁻¹' {r}))) :
    finset.sum_congr rfl (assume a ha, mul_assoc _ _ _)
  ... = x * f.integral :
    finset.mul_sum.symm

lemma mem_restrict_range [has_zero β] {r : β} {s : set α} {f : α →ₛ β} (hs : is_measurable s) :
  r ∈ (restrict f s).range ↔ (r = 0 ∧ s ≠ univ) ∨ (∃a∈s, f a = r) :=
begin
  simp only [mem_range, restrict_apply, hs],
  split,
  { rintros ⟨a, ha⟩,
    split_ifs at ha,
    { exact or.inr ⟨a, h, ha⟩ },
    { exact or.inl ⟨ha.symm, assume eq, h $ eq.symm ▸ trivial⟩ } },
  { rintros (⟨rfl, h⟩ | ⟨a, ha, rfl⟩),
    { have : ¬ ∀a, a ∈ s := assume this, h $ eq_univ_of_forall this,
      rcases not_forall.1 this with ⟨a, ha⟩,
      refine ⟨a, _⟩,
      rw [if_neg ha] },
    { refine ⟨a, _⟩,
      rw [if_pos ha] } }
end

lemma restrict_preimage' {r : ennreal} {s : set α}
  (f : α →ₛ ennreal) (hs : is_measurable s) (hr : r ≠ 0):
  (restrict f s) ⁻¹' {r} = (f ⁻¹' {r} ∩ s) :=
begin
  ext a,
  by_cases a ∈ s; simp [hs, h, hr.symm]
end

lemma restrict_integral (f : α →ₛ ennreal) (s : set α) (hs : is_measurable s) :
  (restrict f s).integral = f.range.sum (λr, r * volume (f ⁻¹' {r} ∩ s)) :=
begin
  refine finset.sum_bij_ne_zero (λr _ _, r) _ _ _ _,
  { assume r hr,
    rcases (mem_restrict_range hs).1 hr with ⟨rfl, h⟩ | ⟨a, ha, rfl⟩,
    { simp },
    { assume _, exact mem_range.2 ⟨a, rfl⟩ } },
  { assume a b _ _ _ _ h, exact h },
  { assume r hr,
    by_cases r0 : r = 0, { simp [r0] },
    assume h0,
    rcases mem_range.1 hr with ⟨a, rfl⟩,
    have : f ⁻¹' {f a} ∩ s ≠ ∅,
    { assume h, simpa [h] using h0 },
    rcases ne_empty_iff_exists_mem.1 this with ⟨a', eq', ha'⟩,
    refine ⟨_, (mem_restrict_range hs).2 (or.inr ⟨a', ha', _⟩), _, rfl⟩,
    { simpa using eq' },
    { rwa [restrict_preimage' _ hs r0] } },
  { assume r hr ne,
    by_cases r = 0, { simp [h] },
    rw [restrict_preimage' _ hs h] }
end

lemma restrict_const_integral (c : ennreal) (s : set α) (hs : is_measurable s) :
  (restrict (const α c) s).integral = c * volume s :=
have (@const α ennreal _ c) ⁻¹' {c} = univ,
begin
  refine eq_univ_of_forall (assume a, _),
  simp,
end,
calc (restrict (const α c) s).integral = c * volume ((const α c) ⁻¹' {c} ∩ s) :
  begin
    rw [restrict_integral (const α c) s hs],
    refine finset.sum_eq_single c _ _,
    { assume r hr, rcases mem_range.1 hr with ⟨a, rfl⟩, contradiction },
    { by_cases nonempty α,
      { assume ne,
        rcases h with ⟨a⟩,
        exfalso,
        exact ne (mem_range.2 ⟨a, rfl⟩) },
      { assume empty,
        have : (@const α ennreal _ c) ⁻¹' {c} ∩ s = ∅,
        { ext a, exfalso, exact h ⟨a⟩ },
        simp only [this, volume_empty, mul_zero] } }
  end
  ... = c * volume s : by rw [this, univ_inter]

lemma integral_sup_le (f g : α →ₛ ennreal) : f.integral ⊔ g.integral ≤ (f ⊔ g).integral :=
calc f.integral ⊔ g.integral =
      ((pair f g).map prod.fst).integral ⊔ ((pair f g).map prod.snd).integral : rfl
  ... ≤ (pair f g).range.sum (λx, (x.1 ⊔ x.2) * volume (pair f g ⁻¹' {x})) :
  begin
    rw [map_integral, map_integral],
    refine sup_le _ _;
      refine finset.sum_le_sum' (λ a _, canonically_ordered_semiring.mul_le_mul _ (le_refl _)),
    exact le_sup_left,
    exact le_sup_right
  end
  ... = (f ⊔ g).integral : by rw [sup_eq_map₂, map_integral]

lemma integral_le_integral (f g : α →ₛ ennreal) (h : f ≤ g) : f.integral ≤ g.integral :=
calc f.integral ≤ f.integral ⊔ g.integral : le_sup_left
  ... ≤ (f ⊔ g).integral : integral_sup_le _ _
  ... = g.integral : by rw [sup_of_le_right h]

lemma integral_congr (f g : α →ₛ ennreal) (h : {a | f a = g a} ∈ (@measure_space.μ α _).a_e) :
  f.integral = g.integral :=
show ((pair f g).map prod.fst).integral = ((pair f g).map prod.snd).integral, from
begin
  rw [map_integral, map_integral],
  refine finset.sum_congr rfl (assume p hp, _),
  rcases mem_range.1 hp with ⟨a, rfl⟩,
  by_cases eq : f a = g a,
  { dsimp only [pair_apply], rw eq },
  { have : volume ((pair f g) ⁻¹' {(f a, g a)}) = 0,
    { refine volume_mono_null (assume a' ha', _) h,
      simp at ha',
      show f a' ≠ g a',
      rwa [ha'.1, ha'.2] },
    simp [this] }
end

lemma integral_map {β} [measure_space β] (f : α →ₛ ennreal) (g : β →ₛ ennreal)
  (m : α → β) (hm : _root_.measurable m) (eq : ∀a:α, f a = g (m a))
  (h : ∀s:set β, is_measurable s → volume s = volume (m ⁻¹' s)) :
  f.integral = g.integral :=
have f_eq : (f : α → ennreal) = g ∘ m := funext eq,
have vol_f : ∀r, volume (f ⁻¹' {r}) = volume (g ⁻¹' {r}),
  by { assume r, rw [h, f_eq, preimage_comp], exact measurable_sn _ _ },
begin
  simp [integral, vol_f],
  refine finset.sum_subset _ _,
  { simp [finset.subset_iff, f_eq],
    rintros r a rfl, exact ⟨_, rfl⟩ },
  { assume r hrg hrf,
    rw [simple_func.mem_range, not_exists] at hrf,
    have : f ⁻¹' {r} = ∅ := set.eq_empty_of_subset_empty (assume a, by simpa using hrf a),
    simp [(vol_f _).symm, this] }
end

end measure

end simple_func

section lintegral
open simple_func
variable [measure_space α]

/-- The lower Lebesgue integral -/
def lintegral (f : α → ennreal) : ennreal :=
⨆ (s : α →ₛ ennreal) (hf : f ≥ s), s.integral

notation `∫⁻` binders `, ` r:(scoped f, lintegral f) := r

theorem simple_func.lintegral_eq_integral (f : α →ₛ ennreal) : (∫⁻ a, f a) = f.integral :=
le_antisymm
  (supr_le $ assume s, supr_le $ assume hs, integral_le_integral _ _ hs)
  (le_supr_of_le f $ le_supr_of_le (le_refl f) $ le_refl _)

lemma lintegral_le_lintegral (f g : α → ennreal) (h : f ≤ g) : (∫⁻ a, f a) ≤ (∫⁻ a, g a) :=
supr_le_supr $ assume s, supr_le $ assume hs, le_supr_of_le (le_trans hs h) (le_refl _)

lemma lintegral_eq_nnreal (f : α → ennreal) :
  (∫⁻ a, f a) =
    (⨆ (s : α →ₛ nnreal) (hf : f ≥ s.map (coe : nnreal → ennreal)), (s.map (coe : nnreal → ennreal)).integral) :=
begin
  let c : nnreal → ennreal := coe,
  refine le_antisymm
    (supr_le $ assume s, supr_le $ assume hs, _)
    (supr_le $ assume s, supr_le $ assume hs, le_supr_of_le (s.map c) $ le_supr _ hs),
  by_cases {a | s a ≠ ⊤} ∈ (@measure_space.μ α _).a_e,
  { have : f ≥ (s.map ennreal.to_nnreal).map c :=
      le_trans (assume a, ennreal.coe_to_nnreal_le_self) hs,
    refine le_supr_of_le (s.map ennreal.to_nnreal) (le_supr_of_le this (le_of_eq $ integral_congr _ _ _)),
    exact filter.mem_sets_of_superset h (assume a ha, (ennreal.coe_to_nnreal ha).symm) },
  { have h_vol_s : volume {a : α | s a = ⊤} ≠ 0,
    { simp [measure.a_e, set.compl_set_of] at h, assumption },
    let n : ℕ → (α →ₛ nnreal) := λn, restrict (const α (n : nnreal)) (s ⁻¹' {⊤}),
    have n_le_s : ∀i, (n i).map c ≤ s,
    { assume i a,
      dsimp [n, c],
      rw [restrict_apply _ (s.preimage_measurable _)],
      split_ifs with ha,
      { simp at ha, exact ha.symm ▸ le_top },
      { exact zero_le _ } },
    have approx_s : ∀ (i : ℕ), ↑i * volume {a : α | s a = ⊤} ≤ integral (map c (n i)),
    { assume i,
      have : {a : α | s a = ⊤} = s ⁻¹' {⊤}, { ext a, simp },
      rw [this, ← restrict_const_integral _ _ (s.preimage_measurable _)],
      { refine integral_le_integral _ _ (assume a, le_of_eq _),
        simp [n, c, restrict_apply, s.preimage_measurable],
        split_ifs; simp [ennreal.coe_nat] },
     },
    calc s.integral ≤ ⊤ : le_top
      ... = (⨆i:ℕ, (i : ennreal) * volume {a | s a = ⊤}) :
        by rw [← ennreal.supr_mul, ennreal.supr_coe_nat, ennreal.top_mul, if_neg h_vol_s]
      ... ≤ (⨆i, ((n i).map c).integral) : supr_le_supr approx_s
      ... ≤ ⨆ (s : α →ₛ nnreal) (hf : f ≥ s.map c), (s.map c).integral :
        have ∀i, ((n i).map c : α → ennreal) ≤ f := assume i, le_trans (n_le_s i) hs,
        (supr_le $ assume i, le_supr_of_le (n i) (le_supr (λh, ((n i).map c).integral) (this i))) }
end

/-- Monotone convergence theorem -- somtimes called Beppo-Levi convergence.

See `lintegral_supr_directed` for a more general form. -/
theorem lintegral_supr
  {f : ℕ → α → ennreal} (hf : ∀n, measurable (f n)) (h_mono : monotone f) :
  (∫⁻ a, ⨆n, f n a) = (⨆n, ∫⁻ a, f n a) :=
let c : nnreal → ennreal := coe in
let F (a:α) := ⨆n, f n a in
have hF : measurable F := measurable.supr hf,
show (∫⁻ a, F a) = (⨆n, ∫⁻ a, f n a),
begin
  refine le_antisymm _ _,
  { rw [lintegral_eq_nnreal],
    refine supr_le (assume s, supr_le (assume hsf, _)),
    refine ennreal.le_of_forall_lt_one_mul_lt (assume a ha, _),
    rcases ennreal.lt_iff_exists_coe.1 ha with ⟨r, rfl, ha⟩,
    have ha : r < 1 := ennreal.coe_lt_coe.1 ha,
    let rs := s.map (λa, r * a),
    have eq_rs : (const α r : α →ₛ ennreal) * map c s = rs.map c,
    { ext1 a, exact ennreal.coe_mul.symm },
    have eq : ∀p, (rs.map c) ⁻¹' {p} = (⋃n, (rs.map c) ⁻¹' {p} ∩ {a | p ≤ f n a}),
    { assume p,
      rw [← inter_Union_left, ← inter_univ ((map c rs) ⁻¹' {p})] {occs := occurrences.pos [1]},
      refine set.ext (assume x, and_congr_right $ assume hx, (true_iff _).2 _),
      by_cases p_eq : p = 0, { simp [p_eq] },
      simp at hx, subst hx,
      have : r * s x ≠ 0, { rwa [(≠), ← ennreal.coe_eq_zero] },
      have : s x ≠ 0, { refine mt _ this, assume h, rw [h, mul_zero] },
      have : (rs.map c) x < ⨆ (n : ℕ), f n x,
      { refine lt_of_lt_of_le (ennreal.coe_lt_coe.2 (_)) (hsf x),
        suffices : r * s x < 1 * s x, simpa [rs],
        exact mul_lt_mul_of_pos_right ha (zero_lt_iff_ne_zero.2 this) },
      rcases lt_supr_iff.1 this with ⟨i, hi⟩,
      exact mem_Union.2 ⟨i, le_of_lt hi⟩ },
    have mono : ∀r:ennreal, monotone (λn, (rs.map c) ⁻¹' {r} ∩ {a | r ≤ f n a}),
    { assume r i j h,
      refine inter_subset_inter (subset.refl _) _,
      assume x hx, exact le_trans hx (h_mono h x) },
    have h_meas : ∀n, is_measurable {a : α | ⇑(map c rs) a ≤ f n a} :=
      assume n, measurable_le (simple_func.measurable _) (hf n),
    calc (r:ennreal) * integral (s.map c) = (rs.map c).range.sum (λr, r * volume ((rs.map c) ⁻¹' {r})) :
        by rw [← const_mul_integral, integral, eq_rs]
      ... ≤ (rs.map c).range.sum (λr, r * volume (⋃n, (rs.map c) ⁻¹' {r} ∩ {a | r ≤ f n a})) :
        le_of_eq (finset.sum_congr rfl $ assume x hx, by rw ← eq)
      ... ≤ (rs.map c).range.sum (λr, (⨆n, r * volume ((rs.map c) ⁻¹' {r} ∩ {a | r ≤ f n a}))) :
        le_of_eq (finset.sum_congr rfl $ assume x hx,
          begin
            rw [volume, measure_Union_eq_supr_nat _ (mono x), ennreal.mul_supr],
            { assume i,
              refine is_measurable.inter ((rs.map c).preimage_measurable _) _,
              refine (hf i).preimage _,
              exact is_measurable_of_is_closed (is_closed_ge' _) }
          end)
      ... ≤ ⨆n, (rs.map c).range.sum (λr, r * volume ((rs.map c) ⁻¹' {r} ∩ {a | r ≤ f n a})) :
        begin
          refine le_of_eq _,
          rw [ennreal.finset_sum_supr_nat],
          assume p i j h,
          exact canonically_ordered_semiring.mul_le_mul (le_refl _) (volume_mono $ mono p h)
        end
      ... ≤ (⨆n:ℕ, ((rs.map c).restrict {a | (rs.map c) a ≤ f n a}).integral) :
      begin
        refine supr_le_supr (assume n, _),
        rw [restrict_integral _ _ (h_meas n)],
        { refine le_of_eq (finset.sum_congr rfl $ assume r hr, _),
          congr' 2,
          ext a,
          refine and_congr_right _,
          simp {contextual := tt} }
      end
      ... ≤ (⨆n, ∫⁻ a, f n a) :
      begin
        refine supr_le_supr (assume n, _),
        rw [← simple_func.lintegral_eq_integral],
        refine lintegral_le_lintegral _ _ (assume a, _),
        dsimp,
        rw [restrict_apply],
        split_ifs; simp, simpa using h,
        exact h_meas n
      end },
  { exact supr_le (assume n, lintegral_le_lintegral _ _ $ assume a, le_supr _ n) }
end

lemma lintegral_eq_supr_eapprox_integral {f : α → ennreal} (hf : measurable f) :
  (∫⁻ a, f a) = (⨆n, (eapprox f n).integral) :=
calc (∫⁻ a, f a) = (∫⁻ a, ⨆n, (eapprox f n : α → ennreal) a) :
   by congr; ext a; rw [supr_eapprox_apply f hf]
 ... = (⨆n, ∫⁻ a, (eapprox f n : α → ennreal) a) :
 begin
   rw [lintegral_supr],
   { assume n, exact (eapprox f n).measurable },
   { assume i j h, exact (monotone_eapprox f h) }
 end
 ... = (⨆n, (eapprox f n).integral) : by congr; ext n; rw [(eapprox f n).lintegral_eq_integral]

lemma lintegral_add {f g : α → ennreal} (hf : measurable f) (hg : measurable g) :
  (∫⁻ a, f a + g a) = (∫⁻ a, f a) + (∫⁻ a, g a) :=
calc (∫⁻ a, f a + g a) =
    (∫⁻ a, (⨆n, (eapprox f n : α → ennreal) a) + (⨆n, (eapprox g n : α → ennreal) a)) :
    by congr; funext a; rw [supr_eapprox_apply f hf, supr_eapprox_apply g hg]
  ... = (∫⁻ a, (⨆n, (eapprox f n + eapprox g n : α → ennreal) a)) :
  begin
    congr, funext a,
    rw [ennreal.supr_add_supr_of_monotone], { refl },
    { assume i j h, exact monotone_eapprox _ h a },
    { assume i j h, exact monotone_eapprox _ h a },
  end
  ... = (⨆n, (eapprox f n).integral + (eapprox g n).integral) :
  begin
    rw [lintegral_supr],
    { congr, funext n, rw [← simple_func.add_integral, ← simple_func.lintegral_eq_integral], refl },
    { assume n, exact measurable_add (eapprox f n).measurable (eapprox g n).measurable },
    { assume i j h a, exact add_le_add' (monotone_eapprox _ h _) (monotone_eapprox _ h _) }
  end
  ... = (⨆n, (eapprox f n).integral) + (⨆n, (eapprox g n).integral) :
  by refine (ennreal.supr_add_supr_of_monotone _ _).symm;
     { assume i j h, exact simple_func.integral_le_integral _ _ (monotone_eapprox _ h) }
  ... = (∫⁻ a, f a) + (∫⁻ a, g a) :
    by rw [lintegral_eq_supr_eapprox_integral hf, lintegral_eq_supr_eapprox_integral hg]

@[simp] lemma lintegral_zero : (∫⁻ a:α, 0) = 0 :=
show (∫⁻ a:α, (0 : α →ₛ ennreal) a) = 0, by rw [simple_func.lintegral_eq_integral, zero_integral]

lemma lintegral_finset_sum (s : finset β) {f : β → α → ennreal} (hf : ∀b, measurable (f b)) :
  (∫⁻ a, s.sum (λb, f b a)) = s.sum (λb, ∫⁻ a, f b a) :=
begin
  refine finset.induction_on s _ _,
  { simp },
  { assume a s has ih,
    simp [has],
    rw [lintegral_add (hf _) (measurable_finset_sum s hf), ih] }
end

lemma lintegral_const_mul (r : ennreal) {f : α → ennreal} (hf : measurable f) :
  (∫⁻ a, r * f a) = r * (∫⁻ a, f a) :=
calc (∫⁻ a, r * f a) = (∫⁻ a, (⨆n, (const α r * eapprox f n) a)) :
    by congr; funext a; rw [← supr_eapprox_apply f hf, ennreal.mul_supr]; refl
  ... = (⨆n, r * (eapprox f n).integral) :
  begin
    rw [lintegral_supr],
    { congr, funext n, rw [← simple_func.const_mul_integral, ← simple_func.lintegral_eq_integral] },
    { assume n, exact simple_func.measurable _ },
    { assume i j h a, exact canonically_ordered_semiring.mul_le_mul (le_refl _)
        (monotone_eapprox _ h _) }
  end
  ... = r * (∫⁻ a, f a) : by rw [← ennreal.mul_supr, lintegral_eq_supr_eapprox_integral hf]

lemma lintegral_supr_const (r : ennreal) {s : set α} (hs : is_measurable s) :
  (∫⁻ a, ⨆(h : a ∈ s), r) = r * volume s :=
begin
  rw [← restrict_const_integral r s hs, ← (restrict (const α r) s).lintegral_eq_integral],
  congr; ext a; by_cases a ∈ s; simp [h, hs]
end

lemma lintegral_le_lintegral_ae {f g : α → ennreal} (h : ∀ₘ a, f a ≤ g a) :
  (∫⁻ a, f a) ≤ (∫⁻ a, g a) :=
begin
  rcases exists_is_measurable_superset_of_measure_eq_zero h with ⟨t, hts, ht, ht0⟩,
  have : - t ∈ (@measure_space.μ α _).a_e,
  { rw [measure.mem_a_e_iff, lattice.neg_neg, ht0] },
  refine (supr_le $ assume s, supr_le $ assume hfs,
    le_supr_of_le (s.restrict (- t)) $ le_supr_of_le _ _),
  { assume a,
    by_cases a ∈ t;
      simp [h, simple_func.restrict_apply, ht.compl],
    exact le_trans (hfs a) (by_contradiction $ assume hnfg, h (hts hnfg)) },
  { refine le_of_eq (s.integral_congr _ _),
    filter_upwards [this],
    refine assume a hnt, _,
    by_cases hat : a ∈ t; simp [hat, ht.compl],
    exact (hnt hat).elim }
end

lemma lintegral_congr_ae {f g : α → ennreal} (h : ∀ₘ a, f a = g a) :
  (∫⁻ a, f a) = (∫⁻ a, g a) :=
le_antisymm
  (lintegral_le_lintegral_ae $ by filter_upwards [h] assume a h, le_of_eq h)
  (lintegral_le_lintegral_ae $ by filter_upwards [h] assume a h, le_of_eq h.symm)

lemma lintegral_eq_zero_iff {f : α → ennreal} (hf : measurable f) :
  lintegral f = 0 ↔ (∀ₘ a, f a = 0) :=
begin
  refine iff.intro (assume h, _) (assume h, _),
  { have : ∀n:ℕ, ∀ₘ a, f a < n⁻¹,
    { assume n,
      have : is_measurable {a : α | f a ≥ n⁻¹ },
      { exact hf _ (is_measurable_of_is_closed $ is_closed_ge' _) },
      have : (n : ennreal)⁻¹ * volume {a | f a ≥ n⁻¹ } = 0,
      { rw [← simple_func.restrict_const_integral _ _ this, ← le_zero_iff_eq,
          ← simple_func.lintegral_eq_integral],
        refine le_trans (lintegral_le_lintegral _ _ _) (le_of_eq h),
        assume a, by_cases h : (n : ennreal)⁻¹ ≤ f a; simp [h, (≥), this] },
      rw [ennreal.mul_eq_zero, ennreal.inv_eq_zero] at this,
      simpa [ennreal.nat_ne_top, all_ae_iff] using this },
    filter_upwards [all_ae_all_iff.2 this],
    dsimp,
    assume a ha,
    by_contradiction h,
    rcases ennreal.exists_inv_nat_lt h with ⟨n, hn⟩,
    exact (lt_irrefl _ $ lt_trans hn $ ha n).elim },
  { calc lintegral f = lintegral (λa:α, 0) : lintegral_congr_ae h
      ... = 0 : lintegral_zero }
end

section
open encodable

/-- Monotone convergence for a suprema over a directed family and indexed by an encodable type -/
theorem lintegral_supr_directed [encodable β] {f : β → α → ennreal}
  (hf : ∀b, measurable (f b)) (h_directed : directed (≤) f) :
  (∫⁻ a, ⨆b, f b a) = (⨆b, ∫⁻ a, f b a) :=
begin
  by_cases hβ : ¬ nonempty β,
  { have : ∀f : β → ennreal, (⨆(b : β), f b) = 0 :=
      assume f, supr_eq_bot.2 (assume b, (hβ ⟨b⟩).elim),
    simp [this] },
  cases of_not_not hβ with b,
  haveI iβ : inhabited β := ⟨b⟩, clear hβ b,
  have : ∀a, (⨆ b, f b a) = (⨆ n, f (sequence_of_directed (≤) f h_directed n) a),
  { assume a,
    refine le_antisymm (supr_le $ assume b, _) (supr_le $ assume n, le_supr (λn, f n a) _),
    exact le_supr_of_le (encode b + 1) (le_sequence_of_directed f h_directed b a) },
  calc (∫⁻ a, ⨆ b, f b a) = (∫⁻ a, ⨆ n, f (sequence_of_directed (≤) f h_directed n) a) :
      by simp only [this]
    ... = (⨆ n, ∫⁻ a, f (sequence_of_directed (≤) f h_directed n) a) :
      lintegral_supr (assume n, hf _) (monotone_sequence_of_directed f h_directed)
    ... = (⨆ b, ∫⁻ a, f b a) :
    begin
      refine le_antisymm (supr_le $ assume n, _) (supr_le $ assume b, _),
      { exact le_supr (λb, lintegral (f b)) _ },
      { exact le_supr_of_le (encode b + 1)
          (lintegral_le_lintegral _ _ $ le_sequence_of_directed f h_directed b) }
    end
end

end

lemma lintegral_tsum [encodable β] {f : β → α → ennreal} (hf : ∀i, measurable (f i)) :
  (∫⁻ a, ∑ i, f i a) = (∑ i, ∫⁻ a, f i a) :=
begin
  simp only [ennreal.tsum_eq_supr_sum],
  rw [lintegral_supr_directed],
  { simp [lintegral_finset_sum _ hf] },
  { assume b, exact measurable_finset_sum _ hf },
  { assume s t,
    use [s ∪ t],
    split,
    exact assume a, finset.sum_le_sum_of_subset (finset.subset_union_left _ _),
    exact assume a, finset.sum_le_sum_of_subset (finset.subset_union_right _ _) }
end

end lintegral

namespace measure

def integral [measurable_space α] (m : measure α) (f : α → ennreal) : ennreal :=
@lintegral α { μ := m } f

variables [measurable_space α] {m : measure α}

@[simp] lemma integral_zero : m.integral (λa, 0) = 0 := @lintegral_zero α { μ := m }

lemma integral_map [measurable_space β] {f : β → ennreal} {g : α → β}
  (hf : measurable f) (hg : measurable g) : (map g m).integral f = m.integral (f ∘ g) :=
begin
  rw [integral, integral, lintegral_eq_supr_eapprox_integral, lintegral_eq_supr_eapprox_integral],
  { congr, funext n, symmetry,
    apply simple_func.integral_map,
    { exact hg },
    { assume a, exact congr_fun (simple_func.eapprox_comp hf hg) a },
    { assume s hs, exact map_apply hg hs } },
  exact hg.comp hf,
  assumption
end

lemma integral_dirac (a : α) {f : α → ennreal} (hf : measurable f) : (dirac a).integral f = f a :=
have ∀f:α →ₛ ennreal, @simple_func.integral α {μ := dirac a} f = f a,
begin
  assume f,
  have : ∀r, @volume α { μ := dirac a } (⇑f ⁻¹' {r}) = ⨆ h : f a = r, 1,
  { assume r,
    transitivity,
    apply dirac_apply,
    apply simple_func.measurable_sn,
    refine supr_congr_Prop _ _; simp },
  transitivity,
  apply finset.sum_eq_single (f a),
  { assume b hb h, simp [this, ne.symm h], },
  { assume h, simp at h, exact (h a rfl).elim },
  { rw [this], simp }
end,
begin
  rw [integral, lintegral_eq_supr_eapprox_integral],
  { simp [this, simple_func.supr_eapprox_apply f hf] },
  assumption
end

def with_density (m : measure α) (f : α → ennreal) : measure α :=
if hf : measurable f then
  measure.of_measurable (λs hs, m.integral (λa, ⨆(h : a ∈ s), f a))
    (by simp)
    begin
      assume s hs hd,
      have : ∀a, (⨆ (h : a ∈ ⋃i, s i), f a) = (∑i, (⨆ (h : a ∈ s i), f a)),
      { assume a,
        by_cases ha : ∃j, a ∈ s j,
        { rcases ha with ⟨j, haj⟩,
          have : ∀i, a ∈ s i ↔ j = i := assume i,
            iff.intro
              (assume hai, by_contradiction $ assume hij, hd j i hij ⟨haj, hai⟩)
              (by rintros rfl; assumption),
          simp [this, ennreal.tsum_supr_eq] },
        { have : ∀i, ¬ a ∈ s i, { simpa using ha },
          simp [this] } },
      simp only [this],
      apply lintegral_tsum,
      { assume i,
        simp [supr_eq_if],
        exact measurable.if (hs i) hf measurable_const }
    end
else 0

lemma with_density_apply {m : measure α} {f : α → ennreal} {s : set α}
  (hf : measurable f) (hs : is_measurable s) :
  m.with_density f s = m.integral (λa, ⨆(h : a ∈ s), f a) :=
by rw [with_density, dif_pos hf]; exact measure.of_measurable_apply s hs

end measure

end measure_theory


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.power_series.basic
import Mathlib.data.nat.parity
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Definition of well-known power series

In this file we define the following power series:

* `power_series.inv_units_sub`: given `u : units R`, this is the series for `1 / (u - x)`.
  It is given by `∑ n, x ^ n /ₚ u ^ (n + 1)`.

* `power_series.sin`, `power_series.cos`, `power_series.exp` : power series for sin, cosine, and
  exponential functions.
-/

namespace power_series

/-- The power series for `1 / (u - x)`. -/
def inv_units_sub {R : Type u_1} [ring R] (u : units R) : power_series R :=
  mk fun (n : ℕ) => 1 /ₚ u ^ (n + 1)

@[simp] theorem coeff_inv_units_sub {R : Type u_1} [ring R] (u : units R) (n : ℕ) :
    coe_fn (coeff R n) (inv_units_sub u) = 1 /ₚ u ^ (n + 1) :=
  coeff_mk n fun (n : ℕ) => 1 /ₚ u ^ (n + 1)

@[simp] theorem constant_coeff_inv_units_sub {R : Type u_1} [ring R] (u : units R) :
    coe_fn (constant_coeff R) (inv_units_sub u) = 1 /ₚ u :=
  sorry

@[simp] theorem inv_units_sub_mul_X {R : Type u_1} [ring R] (u : units R) :
    inv_units_sub u * X = inv_units_sub u * coe_fn (C R) ↑u - 1 :=
  sorry

@[simp] theorem inv_units_sub_mul_sub {R : Type u_1} [ring R] (u : units R) :
    inv_units_sub u * (coe_fn (C R) ↑u - X) = 1 :=
  sorry

theorem map_inv_units_sub {R : Type u_1} {S : Type u_2} [ring R] [ring S] (f : R →+* S)
    (u : units R) : coe_fn (map f) (inv_units_sub u) = inv_units_sub (coe_fn (units.map ↑f) u) :=
  sorry

/-- Power series for the exponential function at zero. -/
def exp (A : Type u_1) [ring A] [algebra ℚ A] : power_series A :=
  mk fun (n : ℕ) => coe_fn (algebra_map ℚ A) (1 / ↑(nat.factorial n))

/-- Power series for the sine function at zero. -/
def sin (A : Type u_1) [ring A] [algebra ℚ A] : power_series A :=
  mk
    fun (n : ℕ) =>
      ite (even n) 0 (coe_fn (algebra_map ℚ A) ((-1) ^ (n / bit0 1) / ↑(nat.factorial n)))

/-- Power series for the cosine function at zero. -/
def cos (A : Type u_1) [ring A] [algebra ℚ A] : power_series A :=
  mk
    fun (n : ℕ) =>
      ite (even n) (coe_fn (algebra_map ℚ A) ((-1) ^ (n / bit0 1) / ↑(nat.factorial n))) 0

@[simp] theorem coeff_exp {A : Type u_1} [ring A] [algebra ℚ A] (n : ℕ) :
    coe_fn (coeff A n) (exp A) = coe_fn (algebra_map ℚ A) (1 / ↑(nat.factorial n)) :=
  coeff_mk n fun (n : ℕ) => coe_fn (algebra_map ℚ A) (1 / ↑(nat.factorial n))

@[simp] theorem map_exp {A : Type u_1} {A' : Type u_2} [ring A] [ring A'] [algebra ℚ A]
    [algebra ℚ A'] (f : A →+* A') : coe_fn (map f) (exp A) = exp A' :=
  sorry

@[simp] theorem map_sin {A : Type u_1} {A' : Type u_2} [ring A] [ring A'] [algebra ℚ A]
    [algebra ℚ A'] (f : A →+* A') : coe_fn (map f) (sin A) = sin A' :=
  sorry

@[simp] theorem map_cos {A : Type u_1} {A' : Type u_2} [ring A] [ring A'] [algebra ℚ A]
    [algebra ℚ A'] (f : A →+* A') : coe_fn (map f) (cos A) = cos A' :=
  sorry

end Mathlib


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.module.pi
import Mathlib.algebra.ordered_pi
import Mathlib.algebra.module.prod
import Mathlib.algebra.ordered_field
import Mathlib.PostPort

universes u_1 u_2 l u_3

namespace Mathlib

/-!
# Ordered semimodules

In this file we define

* `ordered_semimodule R M` : an ordered additive commutative monoid `M` is an `ordered_semimodule`
  over an `ordered_semiring` `R` if the scalar product respects the order relation on the
  monoid and on the ring. There is a correspondence between this structure and convex cones,
  which is proven in `analysis/convex/cone.lean`.

## Implementation notes

* We choose to define `ordered_semimodule` as a `Prop`-valued mixin, so that it can be
  used for both modules and algebras
  (the axioms for an "ordered algebra" are exactly that the algebra is ordered as a module).
* To get ordered modules and ordered vector spaces, it suffices to the replace the
  `order_add_comm_monoid` and the `ordered_semiring` as desired.

## References

* https://en.wikipedia.org/wiki/Ordered_vector_space

## Tags

ordered semimodule, ordered module, ordered vector space
-/

/--
An ordered semimodule is an ordered additive commutative monoid
with a partial order in which the scalar multiplication is compatible with the order.
-/
class ordered_semimodule (R : Type u_1) (M : Type u_2) [ordered_semiring R]
    [ordered_add_comm_monoid M] [semimodule R M]
    where
  smul_lt_smul_of_pos : ∀ {a b : M} {c : R}, a < b → 0 < c → c • a < c • b
  lt_of_smul_lt_smul_of_pos : ∀ {a b : M} {c : R}, c • a < c • b → 0 < c → a < b

theorem smul_lt_smul_of_pos {R : Type u_1} {M : Type u_2} [ordered_semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] [ordered_semimodule R M] {a : M} {b : M} {c : R} :
    a < b → 0 < c → c • a < c • b :=
  ordered_semimodule.smul_lt_smul_of_pos

theorem smul_le_smul_of_nonneg {R : Type u_1} {M : Type u_2} [ordered_semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] [ordered_semimodule R M] {a : M} {b : M} {c : R}
    (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c • a ≤ c • b :=
  sorry

theorem eq_of_smul_eq_smul_of_pos_of_le {R : Type u_1} {M : Type u_2} [ordered_semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] [ordered_semimodule R M] {a : M} {b : M} {c : R}
    (h₁ : c • a = c • b) (hc : 0 < c) (hle : a ≤ b) : a = b :=
  or.resolve_left (has_le.le.lt_or_eq hle)
    fun (hlt : a < b) => has_lt.lt.ne (smul_lt_smul_of_pos hlt hc) h₁

theorem lt_of_smul_lt_smul_of_nonneg {R : Type u_1} {M : Type u_2} [ordered_semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] [ordered_semimodule R M] {a : M} {b : M} {c : R}
    (h : c • a < c • b) (hc : 0 ≤ c) : a < b :=
  sorry

theorem smul_lt_smul_iff_of_pos {R : Type u_1} {M : Type u_2} [ordered_semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] [ordered_semimodule R M] {a : M} {b : M} {c : R}
    (hc : 0 < c) : c • a < c • b ↔ a < b :=
  { mp := fun (h : c • a < c • b) => lt_of_smul_lt_smul_of_nonneg h (has_lt.lt.le hc),
    mpr := fun (h : a < b) => smul_lt_smul_of_pos h hc }

theorem smul_pos_iff_of_pos {R : Type u_1} {M : Type u_2} [ordered_semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] [ordered_semimodule R M] {a : M} {c : R}
    (hc : 0 < c) : 0 < c • a ↔ 0 < a :=
  iff.trans
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 < c • a ↔ c • 0 < c • a)) (smul_zero c)))
      (iff.refl (0 < c • a)))
    (smul_lt_smul_iff_of_pos hc)

/-- If `R` is a linear ordered semifield, then it suffices to verify only the first axiom of
`ordered_semimodule`. Moreover, it suffices to verify that `a < b` and `0 < c` imply
`c • a ≤ c • b`. We have no semifields in `mathlib`, so we use the assumption `∀ c ≠ 0, is_unit c`
instead. -/
theorem ordered_semimodule.mk'' {R : Type u_1} {M : Type u_2} [linear_ordered_semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] (hR : ∀ {c : R}, c ≠ 0 → is_unit c)
    (hlt : ∀ {a b : M} {c : R}, a < b → 0 < c → c • a ≤ c • b) : ordered_semimodule R M :=
  sorry

/-- If `R` is a linear ordered field, then it suffices to verify only the first axiom of
`ordered_semimodule`. -/
theorem ordered_semimodule.mk' {k : Type u_1} {M : Type u_2} [linear_ordered_field k]
    [ordered_add_comm_monoid M] [semimodule k M]
    (hlt : ∀ {a b : M} {c : k}, a < b → 0 < c → c • a ≤ c • b) : ordered_semimodule k M :=
  ordered_semimodule.mk'' (fun (c : k) (hc : c ≠ 0) => is_unit.mk0 c hc) hlt

protected instance linear_ordered_semiring.to_ordered_semimodule {R : Type u_1}
    [linear_ordered_semiring R] : ordered_semimodule R R :=
  ordered_semimodule.mk ordered_semiring.mul_lt_mul_of_pos_left
    fun (_x _x_1 _x_2 : R) (h : _x_2 • _x < _x_2 • _x_1) (hc : 0 < _x_2) =>
      lt_of_mul_lt_mul_left h (has_lt.lt.le hc)

theorem smul_le_smul_iff_of_pos {k : Type u_1} {M : Type u_2} [linear_ordered_field k]
    [ordered_add_comm_group M] [semimodule k M] [ordered_semimodule k M] {a : M} {b : M} {c : k}
    (hc : 0 < c) : c • a ≤ c • b ↔ a ≤ b :=
  sorry

theorem smul_le_smul_iff_of_neg {k : Type u_1} {M : Type u_2} [linear_ordered_field k]
    [ordered_add_comm_group M] [semimodule k M] [ordered_semimodule k M] {a : M} {b : M} {c : k}
    (hc : c < 0) : c • a ≤ c • b ↔ b ≤ a :=
  sorry

theorem smul_lt_iff_of_pos {k : Type u_1} {M : Type u_2} [linear_ordered_field k]
    [ordered_add_comm_group M] [semimodule k M] [ordered_semimodule k M] {a : M} {b : M} {c : k}
    (hc : 0 < c) : c • a < b ↔ a < c⁻¹ • b :=
  sorry

theorem smul_le_iff_of_pos {k : Type u_1} {M : Type u_2} [linear_ordered_field k]
    [ordered_add_comm_group M] [semimodule k M] [ordered_semimodule k M] {a : M} {b : M} {c : k}
    (hc : 0 < c) : c • a ≤ b ↔ a ≤ c⁻¹ • b :=
  sorry

theorem le_smul_iff_of_pos {k : Type u_1} {M : Type u_2} [linear_ordered_field k]
    [ordered_add_comm_group M] [semimodule k M] [ordered_semimodule k M] {a : M} {b : M} {c : k}
    (hc : 0 < c) : a ≤ c • b ↔ c⁻¹ • a ≤ b :=
  sorry

protected instance prod.ordered_semimodule {k : Type u_1} {M : Type u_2} {N : Type u_3}
    [linear_ordered_field k] [ordered_add_comm_group M] [semimodule k M] [ordered_semimodule k M]
    [ordered_add_comm_group N] [semimodule k N] [ordered_semimodule k N] :
    ordered_semimodule k (M × N) :=
  ordered_semimodule.mk'
    fun (v u : M × N) (c : k) (h : v < u) (hc : 0 < c) =>
      { left := smul_le_smul_of_nonneg (and.left (and.left h)) (has_lt.lt.le hc),
        right := smul_le_smul_of_nonneg (and.right (and.left h)) (has_lt.lt.le hc) }

protected instance pi.ordered_semimodule {k : Type u_1} [linear_ordered_field k] {ι : Type u_2}
    {M : ι → Type u_3} [(i : ι) → ordered_add_comm_group (M i)] [(i : ι) → semimodule k (M i)]
    [∀ (i : ι), ordered_semimodule k (M i)] : ordered_semimodule k ((i : ι) → M i) :=
  ordered_semimodule.mk'
    fun (v u : (i : ι) → M i) (c : k) (h : v < u) (hc : 0 < c) (i : ι) =>
      id (smul_le_smul_of_nonneg (has_lt.lt.le h i) (has_lt.lt.le hc))

-- Sometimes Lean fails to apply the dependent version to non-dependent functions,

-- so we define another instance

protected instance pi.ordered_semimodule' {k : Type u_1} [linear_ordered_field k] {ι : Type u_2}
    {M : Type u_3} [ordered_add_comm_group M] [semimodule k M] [ordered_semimodule k M] :
    ordered_semimodule k (ι → M) :=
  pi.ordered_semimodule

protected instance order_dual.has_scalar {R : Type u_1} {M : Type u_2} [semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] : has_scalar R (order_dual M) :=
  has_scalar.mk has_scalar.smul

protected instance order_dual.mul_action {R : Type u_1} {M : Type u_2} [semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] : mul_action R (order_dual M) :=
  mul_action.mk sorry sorry

protected instance order_dual.distrib_mul_action {R : Type u_1} {M : Type u_2} [semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] : distrib_mul_action R (order_dual M) :=
  distrib_mul_action.mk sorry sorry

protected instance order_dual.semimodule {R : Type u_1} {M : Type u_2} [semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] : semimodule R (order_dual M) :=
  semimodule.mk sorry sorry

protected instance order_dual.ordered_semimodule {R : Type u_1} {M : Type u_2} [ordered_semiring R]
    [ordered_add_comm_monoid M] [semimodule R M] [ordered_semimodule R M] :
    ordered_semimodule R (order_dual M) :=
  ordered_semimodule.mk (fun (a b : order_dual M) => ordered_semimodule.smul_lt_smul_of_pos)
    fun (a b : order_dual M) => ordered_semimodule.lt_of_smul_lt_smul_of_pos

end Mathlib


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.preserves.shapes.binary_products
import category_theory.limits.preserves.shapes.products
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.finite_products
import category_theory.pempty
import data.equiv.fin

/-!
# Constructing finite products from binary products and terminal.

If a category has binary products and a terminal object then it has finite products.
If a functor preserves binary products and the terminal object then it preserves finite products.

# TODO

Provide the dual results.
Show the analogous results for functors which reflect or create (co)limits.
-/

universes v u u'

noncomputable theory
open category_theory category_theory.category category_theory.limits
namespace category_theory

variables {J : Type v} [small_category J]
variables {C : Type u} [category.{v} C]
variables {D : Type u'} [category.{v} D]

/--
Given `n+1` objects of `C`, a fan for the last `n` with point `c₁.X` and a binary fan on `c₁.X` and
`f 0`, we can build a fan for all `n+1`.

In `extend_fan_is_limit` we show that if the two given fans are limits, then this fan is also a
limit.
-/
@[simps {rhs_md := semireducible}]
def extend_fan {n : ℕ} {f : ulift (fin (n+1)) → C}
  (c₁ : fan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩))
  (c₂ : binary_fan (f ⟨0⟩) c₁.X) :
  fan f :=
fan.mk c₂.X
begin
  rintro ⟨i⟩,
  revert i,
  refine fin.cases _ _,
  { apply c₂.fst },
  { intro i,
    apply c₂.snd ≫ c₁.π.app (ulift.up i) },
end

/--
Show that if the two given fans in `extend_fan` are limits, then the constructed fan is also a
limit.
-/
def extend_fan_is_limit {n : ℕ} (f : ulift (fin (n+1)) → C)
  {c₁ : fan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩)} {c₂ : binary_fan (f ⟨0⟩) c₁.X}
  (t₁ : is_limit c₁) (t₂ : is_limit c₂) :
  is_limit (extend_fan c₁ c₂) :=
{ lift := λ s,
  begin
    apply (binary_fan.is_limit.lift' t₂ (s.π.app ⟨0⟩) _).1,
    apply t₁.lift ⟨_, discrete.nat_trans (λ i, s.π.app ⟨i.down.succ⟩)⟩
  end,
  fac' := λ s,
  begin
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply (binary_fan.is_limit.lift' t₂ _ _).2.1 },
    { rintro i -,
      dsimp only [extend_fan_π_app],
      rw [fin.cases_succ, ← assoc, (binary_fan.is_limit.lift' t₂ _ _).2.2, t₁.fac],
      refl }
  end,
  uniq' := λ s m w,
  begin
    apply binary_fan.is_limit.hom_ext t₂,
    { rw (binary_fan.is_limit.lift' t₂ _ _).2.1,
      apply w ⟨0⟩ },
    { rw (binary_fan.is_limit.lift' t₂ _ _).2.2,
      apply t₁.uniq ⟨_, _⟩,
      rintro ⟨j⟩,
      rw assoc,
      dsimp only [discrete.nat_trans_app],
      rw ← w ⟨j.succ⟩,
      dsimp only [extend_fan_π_app],
      rw fin.cases_succ }
  end }

section
variables [has_binary_products.{v} C] [has_terminal C]

/--
If `C` has a terminal object and binary products, then it has a product for objects indexed by
`ulift (fin n)`.
This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_product_ulift_fin :
  Π (n : ℕ) (f : ulift.{v} (fin n) → C), has_product f
| 0 := λ f,
  begin
    letI : has_limits_of_shape (discrete (ulift.{v} (fin 0))) C :=
      has_limits_of_shape_of_equivalence
        (discrete.equivalence.{v} (equiv.ulift.trans fin_zero_equiv').symm),
    apply_instance,
  end
| (n+1) := λ f,
  begin
    haveI := has_product_ulift_fin n,
    apply has_limit.mk ⟨_, extend_fan_is_limit f (limit.is_limit.{v} _) (limit.is_limit _)⟩,
  end

/--
If `C` has a terminal object and binary products, then it has limits of shape
`discrete (ulift (fin n))` for any `n : ℕ`.
This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_limits_of_shape_ulift_fin (n : ℕ) :
  has_limits_of_shape (discrete (ulift.{v} (fin n))) C :=
{ has_limit := λ K,
begin
  letI := has_product_ulift_fin n K.obj,
  let : discrete.functor K.obj ≅ K := discrete.nat_iso (λ i, iso.refl _),
  apply has_limit_of_iso this,
end }

/-- If `C` has a terminal object and binary products, then it has finite products. -/
lemma has_finite_products_of_has_binary_and_terminal : has_finite_products C :=
⟨λ J 𝒥₁ 𝒥₂, begin
  resetI,
  let e := fintype.equiv_fin J,
  apply has_limits_of_shape_of_equivalence (discrete.equivalence (e.trans equiv.ulift.symm)).symm,
  refine has_limits_of_shape_ulift_fin (fintype.card J),
end⟩

end

section preserves
variables (F : C ⥤ D)
variables [preserves_limits_of_shape (discrete walking_pair) F]
variables [preserves_limits_of_shape (discrete pempty) F]
variables [has_finite_products.{v} C]

/--
If `F` preserves the terminal object and binary products, then it preserves products indexed by
`ulift (fin n)` for any `n`.
-/
noncomputable def preserves_fin_of_preserves_binary_and_terminal  :
  Π (n : ℕ) (f : ulift (fin n) → C), preserves_limit (discrete.functor f) F
| 0 := λ f,
  begin
    letI : preserves_limits_of_shape (discrete (ulift (fin 0))) F :=
      preserves_limits_of_shape_of_equiv
        (discrete.equivalence (equiv.ulift.trans fin_zero_equiv').symm) _,
    apply_instance,
  end
| (n+1) :=
  begin
    haveI := preserves_fin_of_preserves_binary_and_terminal n,
    intro f,
    refine preserves_limit_of_preserves_limit_cone
      (extend_fan_is_limit f (limit.is_limit.{v} _) (limit.is_limit _)) _,
    apply (is_limit_map_cone_fan_mk_equiv _ _ _).symm _,
    let := extend_fan_is_limit (λ i, F.obj (f i))
              (is_limit_of_has_product_of_preserves_limit F _)
              (is_limit_of_has_binary_product_of_preserves_limit F _ _),
    refine is_limit.of_iso_limit this _,
    apply cones.ext _ _,
    apply iso.refl _,
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply (category.id_comp _).symm },
    { rintro i -,
      dsimp only [extend_fan_π_app, iso.refl_hom, fan.mk_π_app],
      rw [fin.cases_succ, fin.cases_succ],
      change F.map _ ≫ _ = 𝟙 _ ≫ _,
      rw [id_comp, ←F.map_comp],
      refl }
  end

/--
If `F` preserves the terminal object and binary products, then it preserves limits of shape
`discrete (ulift (fin n))`.
-/
def preserves_ulift_fin_of_preserves_binary_and_terminal (n : ℕ) :
  preserves_limits_of_shape (discrete (ulift (fin n))) F :=
{ preserves_limit := λ K,
  begin
    let : discrete.functor K.obj ≅ K := discrete.nat_iso (λ i, iso.refl _),
    haveI := preserves_fin_of_preserves_binary_and_terminal F n K.obj,
    apply preserves_limit_of_iso_diagram F this,
  end }

/-- If `F` preserves the terminal object and binary products then it preserves finite products. -/
def preserves_finite_products_of_preserves_binary_and_terminal
  (J : Type v) [fintype J] :
  preserves_limits_of_shape.{v} (discrete J) F :=
begin
  classical,
  let e := fintype.equiv_fin J,
  haveI := preserves_ulift_fin_of_preserves_binary_and_terminal F (fintype.card J),
  apply preserves_limits_of_shape_of_equiv (discrete.equivalence (e.trans equiv.ulift.symm)).symm,
end

end preserves

/--
Given `n+1` objects of `C`, a cofan for the last `n` with point `c₁.X`
and a binary cofan on `c₁.X` and `f 0`, we can build a cofan for all `n+1`.

In `extend_cofan_is_colimit` we show that if the two given cofans are colimits,
then this cofan is also a colimit.
-/
@[simps {rhs_md := semireducible}]
def extend_cofan {n : ℕ} {f : ulift (fin (n+1)) → C}
  (c₁ : cofan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩))
  (c₂ : binary_cofan (f ⟨0⟩) c₁.X) :
  cofan f :=
cofan.mk c₂.X
begin
  rintro ⟨i⟩,
  revert i,
  refine fin.cases _ _,
  { apply c₂.inl },
  { intro i,
    apply c₁.ι.app (ulift.up i) ≫ c₂.inr },
end

/--
Show that if the two given cofans in `extend_cofan` are colimits,
then the constructed cofan is also a colimit.
-/
def extend_cofan_is_colimit {n : ℕ} (f : ulift (fin (n+1)) → C)
  {c₁ : cofan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩)} {c₂ : binary_cofan (f ⟨0⟩) c₁.X}
  (t₁ : is_colimit c₁) (t₂ : is_colimit c₂) :
  is_colimit (extend_cofan c₁ c₂) :=
{ desc := λ s,
  begin
    apply (binary_cofan.is_colimit.desc' t₂ (s.ι.app ⟨0⟩) _).1,
    apply t₁.desc ⟨_, discrete.nat_trans (λ i, s.ι.app ⟨i.down.succ⟩)⟩
  end,
  fac' := λ s,
  begin
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply (binary_cofan.is_colimit.desc' t₂ _ _).2.1 },
    { rintro i -,
      dsimp only [extend_cofan_ι_app],
      rw [fin.cases_succ, assoc, (binary_cofan.is_colimit.desc' t₂ _ _).2.2, t₁.fac],
      refl }
  end,
  uniq' := λ s m w,
  begin
    apply binary_cofan.is_colimit.hom_ext t₂,
    { rw (binary_cofan.is_colimit.desc' t₂ _ _).2.1,
      apply w ⟨0⟩ },
    { rw (binary_cofan.is_colimit.desc' t₂ _ _).2.2,
      apply t₁.uniq ⟨_, _⟩,
      rintro ⟨j⟩,
      dsimp only [discrete.nat_trans_app],
      rw ← w ⟨j.succ⟩,
      dsimp only [extend_cofan_ι_app],
      rw [fin.cases_succ, assoc], }
  end }

section
variables [has_binary_coproducts.{v} C] [has_initial C]

/--
If `C` has an initial object and binary coproducts, then it has a coproduct for objects indexed by
`ulift (fin n)`.
This is a helper lemma for `has_cofinite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_coproduct_ulift_fin :
  Π (n : ℕ) (f : ulift.{v} (fin n) → C), has_coproduct f
| 0 := λ f,
  begin
    letI : has_colimits_of_shape (discrete (ulift.{v} (fin 0))) C :=
      has_colimits_of_shape_of_equivalence
        (discrete.equivalence.{v} (equiv.ulift.trans fin_zero_equiv').symm),
    apply_instance,
  end
| (n+1) := λ f,
  begin
    haveI := has_coproduct_ulift_fin n,
    apply has_colimit.mk
      ⟨_, extend_cofan_is_colimit f (colimit.is_colimit.{v} _) (colimit.is_colimit _)⟩,
  end

/--
If `C` has an initial object and binary coproducts, then it has colimits of shape
`discrete (ulift (fin n))` for any `n : ℕ`.
This is a helper lemma for `has_cofinite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
private lemma has_colimits_of_shape_ulift_fin (n : ℕ) :
  has_colimits_of_shape (discrete (ulift.{v} (fin n))) C :=
{ has_colimit := λ K,
begin
  letI := has_coproduct_ulift_fin n K.obj,
  let : K ≅ discrete.functor K.obj := discrete.nat_iso (λ i, iso.refl _),
  apply has_colimit_of_iso this,
end }

/-- If `C` has an initial object and binary coproducts, then it has finite coproducts. -/
lemma has_finite_coproducts_of_has_binary_and_terminal : has_finite_coproducts C :=
⟨λ J 𝒥₁ 𝒥₂, begin
  resetI,
  let e := fintype.equiv_fin J,
  apply has_colimits_of_shape_of_equivalence (discrete.equivalence (e.trans equiv.ulift.symm)).symm,
  refine has_colimits_of_shape_ulift_fin (fintype.card J),
end⟩

end

section preserves
variables (F : C ⥤ D)
variables [preserves_colimits_of_shape (discrete walking_pair) F]
variables [preserves_colimits_of_shape (discrete pempty) F]
variables [has_finite_coproducts.{v} C]

/--
If `F` preserves the initial object and binary coproducts, then it preserves products indexed by
`ulift (fin n)` for any `n`.
-/
noncomputable def preserves_fin_of_preserves_binary_and_initial  :
  Π (n : ℕ) (f : ulift (fin n) → C), preserves_colimit (discrete.functor f) F
| 0 := λ f,
  begin
    letI : preserves_colimits_of_shape (discrete (ulift (fin 0))) F :=
      preserves_colimits_of_shape_of_equiv
        (discrete.equivalence (equiv.ulift.trans fin_zero_equiv').symm) _,
    apply_instance,
  end
| (n+1) :=
  begin
    haveI := preserves_fin_of_preserves_binary_and_initial n,
    intro f,
    refine preserves_colimit_of_preserves_colimit_cocone
      (extend_cofan_is_colimit f (colimit.is_colimit.{v} _) (colimit.is_colimit _)) _,
    apply (is_colimit_map_cocone_cofan_mk_equiv _ _ _).symm _,
    let := extend_cofan_is_colimit (λ i, F.obj (f i))
              (is_colimit_of_has_coproduct_of_preserves_colimit F _)
              (is_colimit_of_has_binary_coproduct_of_preserves_colimit F _ _),
    refine is_colimit.of_iso_colimit this _,
    apply cocones.ext _ _,
    apply iso.refl _,
    rintro ⟨j⟩,
    apply fin.induction_on j,
    { apply category.comp_id },
    { rintro i -,
      dsimp only [extend_cofan_ι_app, iso.refl_hom, cofan.mk_ι_app],
      rw [fin.cases_succ, fin.cases_succ],
      erw [comp_id, ←F.map_comp],
      refl, }
  end

/--
If `F` preserves the initial object and binary coproducts, then it preserves colimits of shape
`discrete (ulift (fin n))`.
-/
def preserves_ulift_fin_of_preserves_binary_and_initial (n : ℕ) :
  preserves_colimits_of_shape (discrete (ulift (fin n))) F :=
{ preserves_colimit := λ K,
  begin
    let : discrete.functor K.obj ≅ K := discrete.nat_iso (λ i, iso.refl _),
    haveI := preserves_fin_of_preserves_binary_and_initial F n K.obj,
    apply preserves_colimit_of_iso_diagram F this,
  end }

/-- If `F` preserves the initial object and binary coproducts then it preserves finite products. -/
def preserves_finite_coproducts_of_preserves_binary_and_initial
  (J : Type v) [fintype J] :
  preserves_colimits_of_shape.{v} (discrete J) F :=
begin
  classical,
  let e := fintype.equiv_fin J,
  haveI := preserves_ulift_fin_of_preserves_binary_and_initial F (fintype.card J),
  apply preserves_colimits_of_shape_of_equiv (discrete.equivalence (e.trans equiv.ulift.symm)).symm,
end

end preserves

end category_theory