/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.box_integral.partition.filter
import analysis.box_integral.partition.measure
import topology.uniform_space.compact_separated

/-!
# Integrals of Riemann, Henstock-Kurzweil, and McShane

In this file we define the integral of a function over a box in `ℝⁿ. The same definition works for
Riemann, Henstock-Kurzweil, and McShane integrals.

As usual, we represent `ℝⁿ` as the type of functions `ι → ℝ` for some finite type `ι`. A rectangular
box `(l, u]` in `ℝⁿ` is defined to be the set `{x : ι → ℝ | ∀ i, l i < x i ∧ x i ≤ u i}`, see
`box_integral.box`.

Let `vol` be a box-additive function on boxes in `ℝⁿ` with codomain `E →L[ℝ] F`. Given a function
`f : ℝⁿ → E`, a box `I` and a tagged partition `π` of this box, the *integral sum* of `f` over `π`
with respect to the volume `vol` is the sum of `vol J (f (π.tag J))` over all boxes of `π`. Here
`π.tag J` is the point (tag) in `ℝⁿ` associated with the box `J`.

The integral is defined as the limit of integral sums along a filter. Different filters correspond
to different integration theories. In order to avoid code duplication, all our definitions and
theorems take an argument `l : box_integral.integration_params`. This is a type that holds three
boolean values, and encodes eight filters including those corresponding to Riemann,
Henstock-Kurzweil, and McShane integrals.

Following the design of infinite sums (see `has_sum` and `tsum`), we define a predicate
`box_integral.has_integral` and a function `box_integral.integral` that returns a vector satisfying
the predicate or zero if the function is not integrable.

Then we prove some basic properties of box integrals (linearity, a formula for the integral of a
constant). We also prove a version of the Henstock-Sacks inequality (see
`box_integral.integrable.dist_integral_sum_le_of_mem_base_set` and
`box_integral.integrable.dist_integral_sum_sum_integral_le_of_mem_base_set_of_Union_eq`), prove
integrability of continuous functions, and provide a criterion for integrability w.r.t. a
non-Riemann filter (e.g., Henstock-Kurzweil and McShane).

## Notation

- `ℝⁿ`: local notation for `ι → ℝ`

## Tags

integral
-/

open_locale big_operators classical topological_space nnreal filter uniformity box_integral
open set finset function filter metric box_integral.integration_params

noncomputable theory

namespace box_integral

universes u v w

variables {ι : Type u} {E : Type v} {F : Type w} [normed_group E] [normed_space ℝ E]
  [normed_group F] [normed_space ℝ F] {I J : box ι} {π : tagged_prepartition I}

open tagged_prepartition

local notation `ℝⁿ` := ι → ℝ

/-!
### Integral sum and its basic properties
-/

/-- The integral sum of `f : ℝⁿ → E` over a tagged prepartition `π` w.r.t. box-additive volume `vol`
with codomain `E →L[ℝ] F` is the sum of `vol J (f (π.tag J))` over all boxes of `π`. -/
def integral_sum (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F)) (π : tagged_prepartition I) : F :=
∑ J in π.boxes, vol J (f (π.tag J))

lemma integral_sum_bUnion_tagged (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F)) (π : prepartition I)
  (πi : Π J, tagged_prepartition J) :
  integral_sum f vol (π.bUnion_tagged πi) = ∑ J in π.boxes, integral_sum f vol (πi J) :=
begin
  refine (π.sum_bUnion_boxes _ _).trans (sum_congr rfl $ λ J hJ, sum_congr rfl $ λ J' hJ', _),
  rw π.tag_bUnion_tagged hJ hJ'
end

lemma integral_sum_bUnion_partition (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F))
  (π : tagged_prepartition I) (πi : Π J, prepartition J) (hπi : ∀ J ∈ π, (πi J).is_partition) :
  integral_sum f vol (π.bUnion_prepartition πi) = integral_sum f vol π :=
begin
  refine (π.to_prepartition.sum_bUnion_boxes _ _).trans (sum_congr rfl $ λ J hJ, _),
  calc ∑ J' in (πi J).boxes, vol J' (f (π.tag $ π.to_prepartition.bUnion_index πi J'))
      = ∑ J' in (πi J).boxes, vol J' (f (π.tag J)) :
    sum_congr rfl (λ J' hJ', by rw [prepartition.bUnion_index_of_mem _ hJ hJ'])
  ... = vol J (f (π.tag J)) :
    (vol.map ⟨λ g : E →L[ℝ] F, g (f (π.tag J)), rfl, λ _ _, rfl⟩).sum_partition_boxes
      le_top (hπi J hJ)
end

lemma integral_sum_inf_partition (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F))
  (π : tagged_prepartition I) {π' : prepartition I} (h : π'.is_partition) :
  integral_sum f vol (π.inf_prepartition π') = integral_sum f vol π :=
integral_sum_bUnion_partition f vol  π _ $ λ J hJ, h.restrict (prepartition.le_of_mem _ hJ)

lemma integral_sum_fiberwise {α} (g : box ι → α) (f : ℝⁿ → E)
  (vol : ι →ᵇᵃ (E →L[ℝ] F)) (π : tagged_prepartition I) :
  ∑ y in π.boxes.image g, integral_sum f vol (π.filter (λ x, g x = y)) = integral_sum f vol π :=
π.to_prepartition.sum_fiberwise g (λ J, vol J (f $ π.tag J))

lemma integral_sum_sub_partitions (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F))
  {π₁ π₂ : tagged_prepartition I} (h₁ : π₁.is_partition) (h₂ : π₂.is_partition) :
  integral_sum f vol π₁ - integral_sum f vol π₂ =
    ∑ J in (π₁.to_prepartition ⊓ π₂.to_prepartition).boxes,
      (vol J (f $ (π₁.inf_prepartition π₂.to_prepartition).tag J) -
        vol J (f $ (π₂.inf_prepartition π₁.to_prepartition).tag J)) :=
begin
  rw [← integral_sum_inf_partition f vol π₁ h₂,
    ← integral_sum_inf_partition f vol π₂ h₁, integral_sum, integral_sum,
    finset.sum_sub_distrib],
  simp only [inf_prepartition_to_prepartition, _root_.inf_comm]
end

@[simp] lemma integral_sum_disj_union (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F))
  {π₁ π₂ : tagged_prepartition I} (h : disjoint π₁.Union π₂.Union) :
  integral_sum f vol (π₁.disj_union π₂ h) = integral_sum f vol π₁ + integral_sum f vol π₂ :=
begin
  refine (prepartition.sum_disj_union_boxes h _).trans
    (congr_arg2 (+) (sum_congr rfl $ λ J hJ, _) (sum_congr rfl $ λ J hJ, _)),
  { rw disj_union_tag_of_mem_left _ hJ },
  { rw disj_union_tag_of_mem_right _ hJ }
end

@[simp] lemma integral_sum_add (f g : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F))
  (π : tagged_prepartition I) :
  integral_sum (f + g) vol π = integral_sum f vol π + integral_sum g vol π :=
by simp only [integral_sum, pi.add_apply, (vol _).map_add, finset.sum_add_distrib]

@[simp] lemma integral_sum_neg (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F))
  (π : tagged_prepartition I) :
  integral_sum (-f) vol π = -integral_sum f vol π :=
by simp only [integral_sum, pi.neg_apply, (vol _).map_neg, finset.sum_neg_distrib]

@[simp] lemma integral_sum_smul (c : ℝ) (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F))
  (π : tagged_prepartition I) :
  integral_sum (c • f) vol π = c • integral_sum f vol π :=
by simp only [integral_sum, finset.smul_sum, pi.smul_apply, continuous_linear_map.map_smul]

variables [fintype ι]

/-!
### Basic integrability theory
-/

/-- The predicate `has_integral I l f vol y` says that `y` is the integral of `f` over `I` along `l`
w.r.t. volume `vol`. This means that integral sums of `f` tend to `𝓝 y` along
`box_integral.integration_params.to_filter_Union I ⊤`. -/
def has_integral (I : box ι) (l : integration_params) (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F))
  (y : F) : Prop :=
tendsto (integral_sum f vol) (l.to_filter_Union I ⊤) (𝓝 y)

/-- A function is integrable if there exists a vector that satisfies the `has_integral`
predicate. -/
def integrable (I : box ι) (l : integration_params) (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F)) :=
∃ y, has_integral I l f vol y

/-- The integral of a function `f` over a box `I` along a filter `l` w.r.t. a volume `vol`.  Returns
zero on non-integrable functions. -/
def integral (I : box ι) (l : integration_params) (f : ℝⁿ → E) (vol : ι →ᵇᵃ (E →L[ℝ] F)) :=
if h : integrable I l f vol then h.some else 0

variables {l : integration_params} {f g : ℝⁿ → E} {vol : ι →ᵇᵃ (E →L[ℝ] F)} {y y' : F}

/-- Reinterpret `box_integral.has_integral` as `filter.tendsto`, e.g., dot-notation theorems
that are shadowed in the `box_integral.has_integral` namespace. -/
lemma has_integral.tendsto (h : has_integral I l f vol y) :
  tendsto (integral_sum f vol) (l.to_filter_Union I ⊤) (𝓝 y) := h

/-- The `ε`-`δ` definition of `box_integral.has_integral`. -/
lemma has_integral_iff : has_integral I l f vol y ↔
  ∀ ε > (0 : ℝ), ∃ r : ℝ≥0 → ℝⁿ → Ioi (0 : ℝ), (∀ c, l.r_cond (r c)) ∧
    ∀ c π, l.mem_base_set I c (r c) π → is_partition π → dist (integral_sum f vol π) y ≤ ε :=
((l.has_basis_to_filter_Union_top I).tendsto_iff nhds_basis_closed_ball).trans $
  by simp [@forall_swap ℝ≥0 (tagged_prepartition I)]

/-- Quite often it is more natural to prove an estimate of the form `a * ε`, not `ε` in the RHS of
`box_integral.has_integral_iff`, so we provide this auxiliary lemma.  -/
lemma has_integral_of_mul (a : ℝ) (h : ∀ ε : ℝ, 0 < ε →
  ∃ r: ℝ≥0 → ℝⁿ → Ioi (0 : ℝ), (∀ c, l.r_cond (r c)) ∧ ∀ c π, l.mem_base_set I c (r c) π →
    is_partition π → dist (integral_sum f vol π) y ≤ a * ε) :
  has_integral I l f vol y :=
begin
  refine has_integral_iff.2 (λ ε hε, _),
  rcases exists_pos_mul_lt hε a with ⟨ε', hε', ha⟩,
  rcases h ε' hε' with ⟨r, hr, H⟩,
  exact ⟨r, hr, λ c π hπ hπp, (H c π hπ hπp).trans ha.le⟩
end

lemma integrable_iff_cauchy [complete_space F] :
  integrable I l f vol ↔ cauchy ((l.to_filter_Union I ⊤).map (integral_sum f vol)) :=
cauchy_map_iff_exists_tendsto.symm

/-- In a complete space, a function is integrable if and only if its integral sums form a Cauchy
net. Here we restate this fact in terms of `∀ ε > 0, ∃ r, ...`. -/
lemma integrable_iff_cauchy_basis [complete_space F] :
  integrable I l f vol ↔ ∀ ε > (0 : ℝ), ∃ r : ℝ≥0 → ℝⁿ → Ioi (0 : ℝ), (∀ c, l.r_cond (r c)) ∧
    ∀ c₁ c₂ π₁ π₂, l.mem_base_set I c₁ (r c₁) π₁ → π₁.is_partition → l.mem_base_set I c₂ (r c₂) π₂ →
      π₂.is_partition → dist (integral_sum f vol π₁) (integral_sum f vol π₂) ≤ ε :=
begin
  rw [integrable_iff_cauchy, cauchy_map_iff',
    (l.has_basis_to_filter_Union_top _).prod_self.tendsto_iff uniformity_basis_dist_le],
  refine forall_congr (λ ε, forall_congr $ λ ε0, exists_congr $ λ r, _),
  simp only [exists_prop, prod.forall, set.mem_Union, exists_imp_distrib,
    prod_mk_mem_set_prod_eq, and_imp, mem_inter_eq, mem_set_of_eq],
  exact and_congr iff.rfl ⟨λ H c₁ c₂ π₁ π₂ h₁ hU₁ h₂ hU₂, H π₁ π₂ c₁ h₁ hU₁ c₂ h₂ hU₂,
    λ H π₁ π₂ c₁ h₁ hU₁ c₂ h₂ hU₂, H c₁ c₂ π₁ π₂ h₁ hU₁ h₂ hU₂⟩
end

lemma has_integral.mono {l₁ l₂ : integration_params} (h : has_integral I l₁ f vol y)
  (hl : l₂ ≤ l₁) : has_integral I l₂ f vol y :=
h.mono_left $ integration_params.to_filter_Union_mono _ hl _

protected lemma integrable.has_integral (h : integrable I l f vol) :
  has_integral I l f vol (integral I l f vol) :=
by { rw [integral, dif_pos h], exact classical.some_spec h }

lemma integrable.mono {l'} (h : integrable I l f vol) (hle : l' ≤ l) : integrable I l' f vol :=
⟨_, h.has_integral.mono hle⟩

lemma has_integral.unique (h : has_integral I l f vol y) (h' : has_integral I l f vol y') :
  y = y' :=
tendsto_nhds_unique h h'

lemma has_integral.integrable (h : has_integral I l f vol y) : integrable I l f vol := ⟨_, h⟩

lemma has_integral.integral_eq (h : has_integral I l f vol y) :
  integral I l f vol = y :=
h.integrable.has_integral.unique h

lemma has_integral.add (h : has_integral I l f vol y) (h' : has_integral I l g vol y') :
  has_integral I l (f + g) vol (y + y') :=
by simpa only [has_integral, ← integral_sum_add] using h.add h'

lemma integrable.add (hf : integrable I l f vol) (hg : integrable I l g vol) :
  integrable I l (f + g) vol :=
(hf.has_integral.add hg.has_integral).integrable

lemma integral_add (hf : integrable I l f vol) (hg : integrable I l g vol) :
  integral I l (f + g) vol = integral I l f vol + integral I l g vol :=
(hf.has_integral.add hg.has_integral).integral_eq

lemma has_integral.neg (hf : has_integral I l f vol y) : has_integral I l (-f) vol (-y) :=
by simpa only [has_integral, ← integral_sum_neg] using hf.neg

lemma integrable.neg (hf : integrable I l f vol) : integrable I l (-f) vol :=
hf.has_integral.neg.integrable

lemma integrable.of_neg (hf : integrable I l (-f) vol) : integrable I l f vol := neg_neg f ▸ hf.neg

@[simp] lemma integrable_neg : integrable I l (-f) vol ↔ integrable I l f vol :=
⟨λ h, h.of_neg, λ h, h.neg⟩

@[simp] lemma integral_neg : integral I l (-f) vol = -integral I l f vol :=
if h : integrable I l f vol then h.has_integral.neg.integral_eq
else by rw [integral, integral, dif_neg h, dif_neg (mt integrable.of_neg h), neg_zero]

lemma has_integral.sub (h : has_integral I l f vol y) (h' : has_integral I l g vol y') :
  has_integral I l (f - g) vol (y - y') :=
by simpa only [sub_eq_add_neg] using h.add h'.neg

lemma integrable.sub (hf : integrable I l f vol) (hg : integrable I l g vol) :
  integrable I l (f - g) vol :=
(hf.has_integral.sub hg.has_integral).integrable

lemma integral_sub (hf : integrable I l f vol) (hg : integrable I l g vol) :
  integral I l (f - g) vol = integral I l f vol - integral I l g vol :=
(hf.has_integral.sub hg.has_integral).integral_eq

lemma has_integral_const (c : E) : has_integral I l (λ _, c) vol (vol I c) :=
tendsto_const_nhds.congr' $ (l.eventually_is_partition I).mono $ λ π hπ,
  ((vol.map ⟨λ g : E →L[ℝ] F, g c, rfl, λ _ _, rfl⟩).sum_partition_boxes le_top hπ).symm

@[simp] lemma integral_const (c : E) : integral I l (λ _, c) vol = vol I c :=
(has_integral_const c).integral_eq

lemma integrable_const (c : E) : integrable I l (λ _, c) vol :=
⟨_, has_integral_const c⟩

lemma has_integral_zero : has_integral I l (λ _, (0:E)) vol 0 :=
by simpa only [← (vol I).map_zero] using has_integral_const (0 : E)

lemma integrable_zero : integrable I l (λ _, (0:E)) vol := ⟨0, has_integral_zero⟩

lemma integral_zero : integral I l (λ _, (0:E)) vol = 0 := has_integral_zero.integral_eq

lemma has_integral_sum {α : Type*} {s : finset α} {f : α → ℝⁿ → E} {g : α → F}
  (h : ∀ i ∈ s, has_integral I l (f i) vol (g i)) :
  has_integral I l (λ x, ∑ i in s, f i x) vol (∑ i in s, g i) :=
begin
  induction s using finset.induction_on with a s ha ihs, { simp [has_integral_zero] },
  simp only [finset.sum_insert ha], rw finset.forall_mem_insert at h,
  exact h.1.add (ihs h.2)
end

lemma has_integral.smul (hf : has_integral I l f vol y) (c : ℝ) :
  has_integral I l (c • f) vol (c • y) :=
by simpa only [has_integral, ← integral_sum_smul]
  using (tendsto_const_nhds : tendsto _ _ (𝓝 c)).smul hf

lemma integrable.smul (hf : integrable I l f vol) (c : ℝ) :
  integrable I l (c • f) vol :=
(hf.has_integral.smul c).integrable

lemma integrable.of_smul {c : ℝ} (hf : integrable I l (c • f) vol) (hc : c ≠ 0) :
  integrable I l f vol :=
by { convert hf.smul c⁻¹, ext x, simp only [pi.smul_apply, inv_smul_smul₀ hc] }

@[simp] lemma integral_smul (c : ℝ) : integral I l (λ x, c • f x) vol = c • integral I l f vol :=
begin
  rcases eq_or_ne c 0 with rfl | hc, { simp only [zero_smul, integral_zero] },
  by_cases hf : integrable I l f vol,
  { exact (hf.has_integral.smul c).integral_eq },
  { have : ¬integrable I l (λ x, c • f x) vol, from mt (λ h, h.of_smul hc) hf,
    rw [integral, integral, dif_neg hf, dif_neg this, smul_zero] }
end

open measure_theory

/-- The integral of a nonnegative function w.r.t. a volume generated by a locally-finite measure is
nonnegative. -/
lemma integral_nonneg {g : ℝⁿ → ℝ} (hg : ∀ x ∈ I.Icc, 0 ≤ g x)
  (μ : measure ℝⁿ) [is_locally_finite_measure μ] :
  0 ≤ integral I l g μ.to_box_additive.to_smul :=
begin
  by_cases hgi : integrable I l g μ.to_box_additive.to_smul,
  { refine ge_of_tendsto' hgi.has_integral (λ π, sum_nonneg $ λ J hJ, _),
    exact mul_nonneg ennreal.to_real_nonneg (hg _ $ π.tag_mem_Icc _) },
  { rw [integral, dif_neg hgi] }
end

/-- If `∥f x∥ ≤ g x` on `[l, u]` and `g` is integrable, then the norm of the integral of `f` is less
than or equal to the integral of `g`. -/
lemma norm_integral_le_of_norm_le {g : ℝⁿ → ℝ} (hle : ∀ x ∈ I.Icc, ∥f x∥ ≤ g x)
  (μ : measure ℝⁿ) [is_locally_finite_measure μ]
  (hg : integrable I l g μ.to_box_additive.to_smul) :
  ∥(integral I l f μ.to_box_additive.to_smul : E)∥ ≤
    integral I l g μ.to_box_additive.to_smul :=
begin
  by_cases hfi : integrable.{u v v} I l f μ.to_box_additive.to_smul,
  { refine le_of_tendsto_of_tendsto' hfi.has_integral.norm hg.has_integral (λ π, _),
    refine norm_sum_le_of_le _ (λ J hJ, _),
    simp only [box_additive_map.to_smul_apply, norm_smul, smul_eq_mul, real.norm_eq_abs,
      μ.to_box_additive_apply, abs_of_nonneg ennreal.to_real_nonneg],
    exact mul_le_mul_of_nonneg_left (hle _ $ π.tag_mem_Icc _) ennreal.to_real_nonneg },
  { rw [integral, dif_neg hfi, norm_zero],
    exact integral_nonneg (λ x hx, (norm_nonneg _).trans (hle x hx)) μ }
end

lemma norm_integral_le_of_le_const {c : ℝ} (hc : ∀ x ∈ I.Icc, ∥f x∥ ≤ c)
  (μ : measure ℝⁿ) [is_locally_finite_measure μ] :
  ∥(integral I l f μ.to_box_additive.to_smul : E)∥ ≤ (μ I).to_real * c :=
by simpa only [integral_const]
  using norm_integral_le_of_norm_le hc μ (integrable_const c)

/-!
# Henstock-Sacks inequality and integrability on subboxes

Henstock-Sacks inequality for Henstock-Kurzweil integral says the following. Let `f` be a function
integrable on a box `I`; let `r : ℝⁿ → (0, ∞)` be a function such that for any tagged partition of
`I` subordinate to `r`, the integral sum over this partition is `ε`-close to the integral. Then for
any tagged prepartition (i.e. a finite collections of pairwise disjoint subboxes of `I` with tagged
points) `π`, the integral sum over `π` differs from the integral of `f` over the part of `I` covered
by `π` by at most `ε`. The actual statement in the library is a bit more complicated to make it work
for any `box_integral.integration_params`. We formalize several versions of this inequality in
`box_integral.integrable.dist_integral_sum_le_of_mem_base_set`,
`box_integral.integrable.dist_integral_sum_sum_integral_le_of_mem_base_set_of_Union_eq`, and
`box_integral.integrable.dist_integral_sum_sum_integral_le_of_mem_base_set`.

Instead of using predicate assumptions on `r`, we define
`box_integral.integrable.convergence_r (h : integrable I l f vol) (ε : ℝ) (c : ℝ≥0) : ℝⁿ → (0, ∞)`
to be a function `r` such that

- if `l.bRiemann`, then `r` is a constant;
- if `ε > 0`, then for any tagged partition `π` of `I` subordinate to `r` (more precisely,
  satisfying the predicate `l.mem_base_set I c r`), the integral sum of `f` over `π` differs from
  the integral of `f` over `I` by at most `ε`.

The proof is mostly based on
[Russel A. Gordon, *The integrals of Lebesgue, Denjoy, Perron, and Henstock*][Gordon55].

-/

namespace integrable

/-- If `ε > 0`, then `box_integral.integrable.convergence_r` is a function `r : ℝ≥0 → ℝⁿ → (0, ∞)`
such that for every `c : ℝ≥0`, for every tagged partition `π` subordinate to `r` (and satisfying
additional distortion estimates if `box_integral.integration_params.bDistortion l = tt`), the
corresponding integral sum is `ε`-close to the integral.

If `box.integral.integration_params.bRiemann = tt`, then `r c x` does not depend on `x`. If `ε ≤ 0`,
then we use `r c x = 1`.  -/
def convergence_r (h : integrable I l f vol) (ε : ℝ) : ℝ≥0 → ℝⁿ → Ioi (0 : ℝ) :=
if hε : 0 < ε then (has_integral_iff.1 h.has_integral ε hε).some
else λ _ _, ⟨1, set.mem_Ioi.2 zero_lt_one⟩

variables {c c₁ c₂ : ℝ≥0} {ε ε₁ ε₂ : ℝ} {π₁ π₂ : tagged_prepartition I}

lemma convergence_r_cond (h : integrable I l f vol) (ε : ℝ) (c : ℝ≥0) :
  l.r_cond (h.convergence_r ε c) :=
begin
  rw convergence_r, split_ifs with h₀,
  exacts [(has_integral_iff.1 h.has_integral ε h₀).some_spec.1 _, λ _ x, rfl]
end

lemma dist_integral_sum_integral_le_of_mem_base_set (h : integrable I l f vol) (h₀ : 0 < ε)
  (hπ : l.mem_base_set I c (h.convergence_r ε c) π) (hπp : π.is_partition) :
  dist (integral_sum f vol π) (integral I l f vol) ≤ ε :=
begin
  rw [convergence_r, dif_pos h₀] at hπ,
  exact (has_integral_iff.1 h.has_integral ε h₀).some_spec.2 c _ hπ hπp
end

/-- **Henstock-Sacks inequality**. Let `r₁ r₂ : ℝⁿ → (0, ∞)` be function such that for any tagged
*partition* of `I` subordinate to `rₖ`, `k=1,2`, the integral sum of `f` over this partition differs
from the integral of `f` by at most `εₖ`. Then for any two tagged *prepartition* `π₁ π₂` subordinate
to `r₁` and `r₂` respectively and covering the same part of `I`, the integral sums of `f` over these
prepartitions differ from each other by at most `ε₁ + ε₂`.

The actual statement

- uses `box_integral.integrable.convergence_r` instead of a predicate assumption on `r`;
- uses `box_integral.integration_params.mem_base_set` instead of “subordinate to `r`” to
  account for additional requirements like being a Henstock partition or having a bounded
  distortion.

See also `box_integral.integrable.dist_integral_sum_sum_integral_le_of_mem_base_set_of_Union_eq` and
`box_integral.integrable.dist_integral_sum_sum_integral_le_of_mem_base_set`.
-/
lemma dist_integral_sum_le_of_mem_base_set (h : integrable I l f vol)
  (hpos₁ : 0 < ε₁) (hpos₂ : 0 < ε₂) (h₁ : l.mem_base_set I c₁ (h.convergence_r ε₁ c₁) π₁)
  (h₂ : l.mem_base_set I c₂ (h.convergence_r ε₂ c₂) π₂) (HU : π₁.Union = π₂.Union) :
  dist (integral_sum f vol π₁) (integral_sum f vol π₂) ≤ ε₁ + ε₂ :=
begin
  rcases h₁.exists_common_compl h₂ HU with ⟨π, hπU, hπc₁, hπc₂⟩,
  set r : ℝⁿ → Ioi (0 : ℝ) := λ x, min (h.convergence_r ε₁ c₁ x) (h.convergence_r ε₂ c₂ x),
  have hr : l.r_cond r := (h.convergence_r_cond _ c₁).min (h.convergence_r_cond _ c₂),
  set πr := π.to_subordinate r,
  have H₁ : dist (integral_sum f vol (π₁.union_compl_to_subordinate π hπU r))
    (integral I l f vol) ≤ ε₁,
  from h.dist_integral_sum_integral_le_of_mem_base_set hpos₁
    (h₁.union_compl_to_subordinate (λ _ _, min_le_left _ _) hπU hπc₁)
    (is_partition_union_compl_to_subordinate _ _ _ _),
  rw HU at hπU,
  have H₂ : dist (integral_sum f vol (π₂.union_compl_to_subordinate π hπU r))
    (integral I l f vol) ≤ ε₂,
  from h.dist_integral_sum_integral_le_of_mem_base_set hpos₂
    (h₂.union_compl_to_subordinate (λ _ _, min_le_right _ _) hπU hπc₂)
    (is_partition_union_compl_to_subordinate _ _ _ _),
  simpa [union_compl_to_subordinate] using (dist_triangle_right _ _ _).trans (add_le_add H₁ H₂)
end

/-- If `f` is integrable on `I` along `l`, then for two sufficiently fine tagged prepartitions
(in the sense of the filter `box_integral.integration_params.to_filter l I`) such that they cover
the same part of `I`, the integral sums of `f` over `π₁` and `π₂` are very close to each other.  -/
lemma tendsto_integral_sum_to_filter_prod_self_inf_Union_eq_uniformity (h : integrable I l f vol) :
  tendsto
    (λ π : tagged_prepartition I × tagged_prepartition I,
      (integral_sum f vol π.1, integral_sum f vol π.2))
    ((l.to_filter I ×ᶠ l.to_filter I) ⊓ 𝓟 {π | π.1.Union = π.2.Union}) (𝓤 F) :=
begin
  refine (((l.has_basis_to_filter I).prod_self.inf_principal _).tendsto_iff
    uniformity_basis_dist_le).2 (λ ε ε0, _),
  replace ε0 := half_pos ε0,
  use [h.convergence_r (ε / 2), h.convergence_r_cond (ε / 2)], rintro ⟨π₁, π₂⟩ ⟨⟨h₁, h₂⟩, hU⟩,
  rw ← add_halves ε,
  exact h.dist_integral_sum_le_of_mem_base_set ε0 ε0 h₁.some_spec h₂.some_spec hU
end

/-- If `f` is integrable on a box `I` along `l`, then for any fixed subset `s` of `I` that can be
represented as a finite union of boxes, the integral sums of `f` over tagged prepartitions that
cover exactly `s` form a Cauchy “sequence” along `l`. -/
lemma cauchy_map_integral_sum_to_filter_Union (h : integrable I l f vol) (π₀ : prepartition I) :
  cauchy ((l.to_filter_Union I π₀).map (integral_sum f vol)) :=
begin
  refine ⟨infer_instance, _⟩,
  rw [prod_map_map_eq, ← to_filter_inf_Union_eq, ← prod_inf_prod, prod_principal_principal],
  exact h.tendsto_integral_sum_to_filter_prod_self_inf_Union_eq_uniformity.mono_left
    (inf_le_inf_left _ $ principal_mono.2 $ λ π h, h.1.trans h.2.symm)
end

variable [complete_space F]

lemma to_subbox_aux (h : integrable I l f vol) (hJ : J ≤ I) :
  ∃ y : F, has_integral J l f vol y ∧
    tendsto (integral_sum f vol) (l.to_filter_Union I (prepartition.single I J hJ)) (𝓝 y) :=
begin
  refine (cauchy_map_iff_exists_tendsto.1
    (h.cauchy_map_integral_sum_to_filter_Union (prepartition.single I J hJ))).imp (λ y hy, ⟨_, hy⟩),
  convert hy.comp (l.tendsto_embed_box_to_filter_Union_top hJ) -- faster than `exact` here
end

/-- If `f` is integrable on a box `I`, then it is integrable on any subbox of `I`. -/
lemma to_subbox (h : integrable I l f vol) (hJ : J ≤ I) : integrable J l f vol :=
(h.to_subbox_aux hJ).imp $ λ y, and.left

/-- If `f` is integrable on a box `I`, then integral sums of `f` over tagged prepartitions
that cover exactly a subbox `J ≤ I` tend to the integral of `f` over `J` along `l`. -/
lemma tendsto_integral_sum_to_filter_Union_single (h : integrable I l f vol) (hJ : J ≤ I) :
  tendsto (integral_sum f vol) (l.to_filter_Union I (prepartition.single I J hJ))
    (𝓝 $ integral J l f vol) :=
let ⟨y, h₁, h₂⟩ := h.to_subbox_aux hJ in h₁.integral_eq.symm ▸ h₂

/-- **Henstock-Sacks inequality**. Let `r : ℝⁿ → (0, ∞)` be a function such that for any tagged
*partition* of `I` subordinate to `r`, the integral sum of `f` over this partition differs from the
integral of `f` by at most `ε`. Then for any tagged *prepartition* `π` subordinate to `r`, the
integral sum of `f` over this prepartition differs from the integral of `f` over the part of `I`
covered by `π` by at most `ε`.

The actual statement

- uses `box_integral.integrable.convergence_r` instead of a predicate assumption on `r`;
- uses `box_integral.integration_params.mem_base_set` instead of “subordinate to `r`” to
  account for additional requirements like being a Henstock partition or having a bounded
  distortion;
- takes an extra argument `π₀ : prepartition I` and an assumption `π.Union = π₀.Union` instead of
  using `π.to_prepartition`.
-/
lemma dist_integral_sum_sum_integral_le_of_mem_base_set_of_Union_eq (h : integrable I l f vol)
  (h0 : 0 < ε) (hπ : l.mem_base_set I c (h.convergence_r ε c) π) {π₀ : prepartition I}
  (hU : π.Union = π₀.Union) :
  dist (integral_sum f vol π) (∑ J in π₀.boxes, integral J l f vol) ≤ ε :=
begin
  /- Let us prove that the distance is less than or equal to `ε + δ` for all positive `δ`. -/
  refine le_of_forall_pos_le_add (λ δ δ0, _),
  /- First we choose some constants. -/
  set δ' : ℝ := δ / (π₀.boxes.card + 1),
  have H0 : 0 < (π₀.boxes.card + 1 : ℝ) := nat.cast_add_one_pos _,
  have δ'0 : 0 < δ' := div_pos δ0 H0,
  set C := max π₀.distortion π₀.compl.distortion,
  /- Next we choose a tagged partition of each `J ∈ π₀` such that the integral sum of `f` over this
  partition is `δ'`-close to the integral of `f` over `J`. -/
  have : ∀ J ∈ π₀, ∃ πi : tagged_prepartition J, πi.is_partition ∧
    dist (integral_sum f vol πi) (integral J l f vol) ≤ δ' ∧
    l.mem_base_set J C (h.convergence_r δ' C) πi,
  { intros J hJ,
    have Hle : J ≤ I := π₀.le_of_mem hJ,
    have HJi : integrable J l f vol := h.to_subbox Hle,
    set r := λ x, min (h.convergence_r δ' C x) (HJi.convergence_r δ' C x),
    have hr : l.r_cond r, from (h.convergence_r_cond _ C).min (HJi.convergence_r_cond _ C),
    have hJd : J.distortion ≤ C, from le_trans (finset.le_sup hJ) (le_max_left _ _),
    rcases l.exists_mem_base_set_is_partition J hJd r with ⟨πJ, hC, hp⟩,
    have hC₁ : l.mem_base_set J C (HJi.convergence_r δ' C) πJ,
    { refine hC.mono J le_rfl le_rfl (λ x hx, _), exact min_le_right _ _ },
    have hC₂ : l.mem_base_set J C (h.convergence_r δ' C) πJ,
    { refine hC.mono J le_rfl le_rfl (λ x hx, _), exact min_le_left _ _ },
    exact ⟨πJ, hp, HJi.dist_integral_sum_integral_le_of_mem_base_set δ'0 hC₁ hp, hC₂⟩ },
  /- Now we combine these tagged partitions into a tagged prepartition of `I` that covers the
  same part of `I` as `π₀` and apply `box_integral.dist_integral_sum_le_of_mem_base_set` to
  `π` and this prepartition. -/
  choose! πi hπip hπiδ' hπiC,
  have : l.mem_base_set I C (h.convergence_r δ' C) (π₀.bUnion_tagged πi),
    from bUnion_tagged_mem_base_set hπiC hπip (λ _, le_max_right _ _),
  have hU' : π.Union = (π₀.bUnion_tagged πi).Union,
    from hU.trans (prepartition.Union_bUnion_partition _ hπip).symm,
  have := h.dist_integral_sum_le_of_mem_base_set h0 δ'0 hπ this hU',
  rw integral_sum_bUnion_tagged at this,
  calc dist (integral_sum f vol π) (∑ J in π₀.boxes, integral J l f vol)
      ≤ dist (integral_sum f vol π) (∑ J in π₀.boxes, integral_sum f vol (πi J)) +
        dist (∑ J in π₀.boxes, integral_sum f vol (πi J)) (∑ J in π₀.boxes, integral J l f vol) :
    dist_triangle _ _ _
  ... ≤ (ε + δ') + ∑ J in π₀.boxes, δ' : add_le_add this (dist_sum_sum_le_of_le _ hπiδ')
  ... = ε + δ : by { field_simp [H0.ne'], ring }
end

/-- **Henstock-Sacks inequality**. Let `r : ℝⁿ → (0, ∞)` be a function such that for any tagged
*partition* of `I` subordinate to `r`, the integral sum of `f` over this partition differs from the
integral of `f` by at most `ε`. Then for any tagged *prepartition* `π` subordinate to `r`, the
integral sum of `f` over this prepartition differs from the integral of `f` over the part of `I`
covered by `π` by at most `ε`.

The actual statement

- uses `box_integral.integrable.convergence_r` instead of a predicate assumption on `r`;
- uses `box_integral.integration_params.mem_base_set` instead of “subordinate to `r`” to
  account for additional requirements like being a Henstock partition or having a bounded
  distortion;
-/
lemma dist_integral_sum_sum_integral_le_of_mem_base_set (h : integrable I l f vol)
  (h0 : 0 < ε) (hπ : l.mem_base_set I c (h.convergence_r ε c) π) :
  dist (integral_sum f vol π) (∑ J in π.boxes, integral J l f vol) ≤ ε :=
h.dist_integral_sum_sum_integral_le_of_mem_base_set_of_Union_eq h0 hπ rfl

/-- Integral sum of `f` over a tagged prepartition `π` such that `π.Union = π₀.Union` tends to the
sum of integrals of `f` over the boxes of `π₀`. -/
lemma tendsto_integral_sum_sum_integral (h : integrable I l f vol) (π₀ : prepartition I) :
  tendsto (integral_sum f vol) (l.to_filter_Union I π₀) (𝓝 $ ∑ J in π₀.boxes, integral J l f vol) :=
begin
  refine ((l.has_basis_to_filter_Union I π₀).tendsto_iff nhds_basis_closed_ball).2 (λ ε ε0, _),
  refine ⟨h.convergence_r ε, h.convergence_r_cond ε, _⟩,
  simp only [mem_inter_eq, set.mem_Union, mem_set_of_eq],
  rintro π ⟨c, hc, hU⟩,
  exact h.dist_integral_sum_sum_integral_le_of_mem_base_set_of_Union_eq ε0 hc hU
end

/-- If `f` is integrable on `I`, then `λ J, integral J l f vol` is box-additive on subboxes of `I`:
if `π₁`, `π₂` are two prepartitions of `I` covering the same part of `I`, then the sum of integrals
of `f` over the boxes of `π₁` is equal to the sum of integrals of `f` over the boxes of `π₂`.

See also `box_integral.integrable.to_box_additive` for a bundled version. -/
lemma sum_integral_congr (h : integrable I l f vol) {π₁ π₂ : prepartition I}
  (hU : π₁.Union = π₂.Union) :
  ∑ J in π₁.boxes, integral J l f vol = ∑ J in π₂.boxes, integral J l f vol :=
begin
  refine tendsto_nhds_unique (h.tendsto_integral_sum_sum_integral π₁) _,
  rw l.to_filter_Union_congr _ hU,
  exact h.tendsto_integral_sum_sum_integral π₂
end

/-- If `f` is integrable on `I`, then `λ J, integral J l f vol` is box-additive on subboxes of `I`:
if `π₁`, `π₂` are two prepartitions of `I` covering the same part of `I`, then the sum of integrals
of `f` over the boxes of `π₁` is equal to the sum of integrals of `f` over the boxes of `π₂`.

See also `box_integral.integrable.sum_integral_congr` for an unbundled version. -/
@[simps] def to_box_additive (h : integrable I l f vol) : ι →ᵇᵃ[I] F :=
{ to_fun := λ J, integral J l f vol,
  sum_partition_boxes' := λ J hJ π hπ,
    begin
      replace hπ := hπ.Union_eq, rw ← prepartition.Union_top at hπ,
      rw [(h.to_subbox (with_top.coe_le_coe.1 hJ)).sum_integral_congr hπ,
        prepartition.top_boxes, sum_singleton]
    end }

end integrable

open measure_theory

/-!
### Integrability conditions
-/

variable (l)

/-- A continuous function is box-integrable with respect to any locally finite measure.

This is true for any volume with bounded variation. -/
lemma integrable_of_continuous_on [complete_space E] {I : box ι} {f : ℝⁿ → E}
  (hc : continuous_on f I.Icc) (μ : measure ℝⁿ) [is_locally_finite_measure μ] :
  integrable.{u v v} I l f μ.to_box_additive.to_smul :=
begin
  have huc := I.is_compact_Icc.uniform_continuous_on_of_continuous hc,
  rw metric.uniform_continuous_on_iff_le at huc,
  refine integrable_iff_cauchy_basis.2 (λ ε ε0, _),
  rcases exists_pos_mul_lt ε0 (μ.to_box_additive I) with ⟨ε', ε0', hε⟩,
  rcases huc ε' ε0' with ⟨δ, δ0 : 0 < δ, Hδ⟩,
  refine ⟨λ _ _, ⟨δ / 2, half_pos δ0⟩, λ _ _ _, rfl, λ c₁ c₂ π₁ π₂ h₁ h₁p h₂ h₂p, _⟩,
  simp only [dist_eq_norm, integral_sum_sub_partitions _ _ h₁p h₂p,
    box_additive_map.to_smul_apply, ← smul_sub],
  have : ∀ J ∈ π₁.to_prepartition ⊓ π₂.to_prepartition,
    ∥μ.to_box_additive J • (f ((π₁.inf_prepartition π₂.to_prepartition).tag J) -
      f ((π₂.inf_prepartition π₁.to_prepartition).tag J))∥ ≤ μ.to_box_additive J * ε',
  { intros J hJ,
    have : 0 ≤ μ.to_box_additive J, from ennreal.to_real_nonneg,
    rw [norm_smul, real.norm_eq_abs, abs_of_nonneg this, ← dist_eq_norm],
    refine mul_le_mul_of_nonneg_left _ this,
    refine Hδ _ _ (tagged_prepartition.tag_mem_Icc _ _) (tagged_prepartition.tag_mem_Icc _ _) _,
    rw [← add_halves δ],
    refine (dist_triangle_left _ _ J.upper).trans (add_le_add (h₁.1 _ _ _) (h₂.1 _ _ _)),
    { exact prepartition.bUnion_index_mem _ hJ },
    { exact box.le_iff_Icc.1 (prepartition.le_bUnion_index _ hJ) J.upper_mem_Icc },
    { rw _root_.inf_comm at hJ,
      exact prepartition.bUnion_index_mem _ hJ },
    { rw _root_.inf_comm at hJ,
      exact box.le_iff_Icc.1 (prepartition.le_bUnion_index _ hJ) J.upper_mem_Icc } },
  refine (norm_sum_le_of_le _ this).trans _,
  rw [← finset.sum_mul, μ.to_box_additive.sum_partition_boxes le_top (h₁p.inf h₂p)],
  exact hε.le
end

variable {l}

/-- This is an auxiliary lemma used to prove two statements at once. Use one of the next two
lemmas instead. -/
lemma has_integral_of_bRiemann_eq_ff_of_forall_is_o (hl : l.bRiemann = ff)
  (B : ι →ᵇᵃ[I] ℝ) (hB0 : ∀ J, 0 ≤ B J) (g : ι →ᵇᵃ[I] F) (s : set ℝⁿ) (hs : s.countable)
  (hlH : s.nonempty → l.bHenstock = tt)
  (H₁ : ∀ (c : ℝ≥0) (x ∈ I.Icc ∩ s) (ε > (0 : ℝ)), ∃ δ > 0, ∀ J ≤ I,
    J.Icc ⊆ metric.closed_ball x δ → x ∈ J.Icc →
    (l.bDistortion → J.distortion ≤ c) → dist (vol J (f x)) (g J) ≤ ε)
  (H₂ : ∀ (c : ℝ≥0) (x ∈ I.Icc \ s) (ε > (0 : ℝ)), ∃ δ > 0, ∀ J ≤ I,
    J.Icc ⊆ metric.closed_ball x δ → (l.bHenstock → x ∈ J.Icc) →
    (l.bDistortion → J.distortion ≤ c) → dist (vol J (f x)) (g J) ≤ ε * B J) :
  has_integral I l f vol (g I) :=
begin
  /- We choose `r x` differently for `x ∈ s` and `x ∉ s`.

  For `x ∈ s`, we choose `εs` such that `∑' x : s, εs x < ε / 2 / 2 ^ #ι`, then choose `r x` so that
  `dist (vol J (f x)) (g J) ≤ εs x` for `J` in the `r x`-neighborhood of `x`. This guarantees that
  the sum of these distances over boxes `J` such that `π.tag J ∈ s` is less than `ε / 2`. We need an
  additional multiplier `2 ^ #ι` because different boxes can have the same tag.

  For `x ∉ s`, we choose `r x` so that `dist (vol (J (f x))) (g J) ≤ (ε / 2 / B I) * B J` for a box
  `J` in the `δ`-neighborhood of `x`. -/
  refine ((l.has_basis_to_filter_Union_top _).tendsto_iff metric.nhds_basis_closed_ball).2 _,
  intros ε ε0,
  simp only [subtype.exists'] at H₁ H₂,
  choose! δ₁ Hδ₁ using H₁,
  choose! δ₂ Hδ₂ using H₂,
  have ε0' := half_pos ε0, have H0 : 0 < (2 ^ fintype.card ι : ℝ), from pow_pos zero_lt_two _,
  rcases hs.exists_pos_forall_sum_le (div_pos ε0' H0) with ⟨εs, hεs0, hεs⟩,
  simp only [le_div_iff' H0, mul_sum] at hεs,
  rcases exists_pos_mul_lt ε0' (B I) with ⟨ε', ε'0, hεI⟩,
  set δ : ℝ≥0 → ℝⁿ → Ioi (0 : ℝ) := λ c x, if x ∈ s then δ₁ c x (εs x) else (δ₂ c) x ε',
  refine ⟨δ, λ c, l.r_cond_of_bRiemann_eq_ff hl, _⟩,
  simp only [set.mem_Union, mem_inter_eq, mem_set_of_eq],
  rintro π ⟨c, hπδ, hπp⟩,
  /- Now we split the sum into two parts based on whether `π.tag J` belongs to `s` or not. -/
  rw [← g.sum_partition_boxes le_rfl hπp, mem_closed_ball, integral_sum,
    ← sum_filter_add_sum_filter_not π.boxes (λ J, π.tag J ∈ s),
    ← sum_filter_add_sum_filter_not π.boxes (λ J, π.tag J ∈ s), ← add_halves ε],
  refine dist_add_add_le_of_le _ _,
  { unfreezingI { rcases s.eq_empty_or_nonempty with rfl|hsne }, { simp [ε0'.le] },
    /- For the boxes such that `π.tag J ∈ s`, we use the fact that at most `2 ^ #ι` boxes have the
    same tag. -/
    specialize hlH hsne,
    have : ∀ J ∈ π.boxes.filter (λ J, π.tag J ∈ s), dist (vol J (f $ π.tag J)) (g J) ≤ εs (π.tag J),
    { intros J hJ, rw finset.mem_filter at hJ, cases hJ with hJ hJs,
      refine Hδ₁ c _ ⟨π.tag_mem_Icc _, hJs⟩ _ (hεs0 _) _ (π.le_of_mem' _ hJ) _
        (hπδ.2 hlH J hJ) (λ hD, (finset.le_sup hJ).trans (hπδ.3 hD)),
      convert hπδ.1 J hJ, exact (dif_pos hJs).symm },
    refine (dist_sum_sum_le_of_le _ this).trans _,
    rw sum_comp,
    refine (sum_le_sum _).trans (hεs _ _),
    { rintro b -,
      rw [← nat.cast_two, ← nat.cast_pow, ← nsmul_eq_mul],
      refine nsmul_le_nsmul (hεs0 _).le _,
      refine (finset.card_le_of_subset _).trans ((hπδ.is_Henstock hlH).card_filter_tag_eq_le b),
      exact filter_subset_filter _ (filter_subset _ _) },
    { rw [finset.coe_image, set.image_subset_iff],
      exact λ J hJ, (finset.mem_filter.1 hJ).2 } },
  /- Now we deal with boxes such that `π.tag J ∉ s`.
  In this case the estimate is straightforward. -/
  have H₂ : ∀ J ∈ π.boxes.filter (λ J, π.tag J ∉ s), dist (vol J (f $ π.tag J)) (g J) ≤ ε' * B J,
  { intros J hJ, rw finset.mem_filter at hJ, cases hJ with hJ hJs,
    refine Hδ₂ c _ ⟨π.tag_mem_Icc _, hJs⟩ _ ε'0 _ (π.le_of_mem' _ hJ) _ (λ hH, hπδ.2 hH J hJ)
      (λ hD, (finset.le_sup hJ).trans (hπδ.3 hD)),
    convert hπδ.1 J hJ, exact (dif_neg hJs).symm },
  refine (dist_sum_sum_le_of_le _ H₂).trans
    ((sum_le_sum_of_subset_of_nonneg (filter_subset _ _) _).trans _),
  { exact λ _ _ _, mul_nonneg ε'0.le (hB0 _) },
  { rw [← mul_sum, B.sum_partition_boxes le_rfl hπp, mul_comm],
    exact hεI.le }
end

/-- A function `f` has Henstock (or `⊥`) integral over `I` is equal to the value of a box-additive
function `g` on `I` provided that `vol J (f x)` is sufficiently close to `g J` for sufficiently
small boxes `J ∋ x`. This lemma is useful to prove, e.g., to prove the Divergence theorem for
integral along `⊥`.

Let `l` be either `box_integral.integration_params.Henstock` or `⊥`. Let `g` a box-additive function
on subboxes of `I`. Suppose that there exists a nonnegative box-additive function `B` and a
countable set `s` with the following property.

For every `c : ℝ≥0`, a point `x ∈ I.Icc`, and a positive `ε` there exists `δ > 0` such that for any
box `J ≤ I` such that

- `x ∈ J.Icc ⊆ metric.closed_ball x δ`;
- if `l.bDistortion` (i.e., `l = ⊥`), then the distortion of `J` is less than or equal to `c`,

the distance between the term `vol J (f x)` of an integral sum corresponding to `J` and `g J` is
less than or equal to `ε` if `x ∈ s` and is less than or equal to `ε * B J` otherwise.

Then `f` is integrable on `I along `l` with integral `g I`. -/
lemma has_integral_of_le_Henstock_of_forall_is_o (hl : l ≤ Henstock) (B : ι →ᵇᵃ[I] ℝ)
  (hB0 : ∀ J, 0 ≤ B J) (g : ι →ᵇᵃ[I] F) (s : set ℝⁿ) (hs : s.countable)
  (H₁ : ∀ (c : ℝ≥0) (x ∈ I.Icc ∩ s) (ε > (0 : ℝ)), ∃ δ > 0, ∀ J ≤ I,
    J.Icc ⊆ metric.closed_ball x δ → x ∈ J.Icc → (l.bDistortion → J.distortion ≤ c) →
    dist (vol J (f x)) (g J) ≤ ε)
  (H₂ : ∀ (c : ℝ≥0) (x ∈ I.Icc \ s) (ε > (0 : ℝ)), ∃ δ > 0, ∀ J ≤ I,
    J.Icc ⊆ metric.closed_ball x δ → x ∈ J.Icc → (l.bDistortion → J.distortion ≤ c) →
    dist (vol J (f x)) (g J) ≤ ε * B J) :
  has_integral I l f vol (g I) :=
have A : l.bHenstock, from hl.2.1.resolve_left dec_trivial,
has_integral_of_bRiemann_eq_ff_of_forall_is_o (hl.1.resolve_right dec_trivial) B hB0 _ s hs (λ _, A)
  H₁ $ by simpa only [A, true_implies_iff] using H₂

/-- Suppose that there exists a nonnegative box-additive function `B` with the following property.

For every `c : ℝ≥0`, a point `x ∈ I.Icc`, and a positive `ε` there exists `δ > 0` such that for any
box `J ≤ I` such that

- `J.Icc ⊆ metric.closed_ball x δ`;
- if `l.bDistortion` (i.e., `l = ⊥`), then the distortion of `J` is less than or equal to `c`,

the distance between the term `vol J (f x)` of an integral sum corresponding to `J` and `g J` is
less than or equal to `ε * B J`.

Then `f` is McShane integrable on `I` with integral `g I`. -/
lemma has_integral_McShane_of_forall_is_o (B : ι →ᵇᵃ[I] ℝ) (hB0 : ∀ J, 0 ≤ B J)
  (g : ι →ᵇᵃ[I] F) (H : ∀ (c : ℝ≥0) (x ∈ I.Icc) (ε > (0 : ℝ)), ∃ δ > 0, ∀ J ≤ I,
    J.Icc ⊆ metric.closed_ball x δ → dist (vol J (f x)) (g J) ≤ ε * B J) :
  has_integral I McShane f vol (g I) :=
has_integral_of_bRiemann_eq_ff_of_forall_is_o rfl B hB0 g ∅ countable_empty (λ ⟨x, hx⟩, hx.elim)
  (λ c x hx, hx.2.elim) $
  by simpa only [McShane, coe_sort_ff, false_implies_iff, true_implies_iff, diff_empty] using H

end box_integral


/-
Copyright (c) 2023 David Loeffler. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Loeffler

! This file was ported from Lean 3 source module analysis.fourier.fourier_transform
! leanprover-community/mathlib commit 3353f3371120058977ce1e20bf7fc8986c0fb042
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Complex.Circle
import Mathbin.MeasureTheory.Group.Integration
import Mathbin.MeasureTheory.Integral.IntegralEqImproper

/-!
# The Fourier transform

We set up the Fourier transform for complex-valued functions on finite-dimensional spaces.

## Design choices

In namespace `vector_fourier`, we define the Fourier integral in the following context:
* `𝕜` is a commutative ring.
* `V` and `W` are `𝕜`-modules.
* `e` is a unitary additive character of `𝕜`, i.e. a homomorphism `(multiplicative 𝕜) →* circle`.
* `μ` is a measure on `V`.
* `L` is a `𝕜`-bilinear form `V × W → 𝕜`.
* `E` is a complete normed `ℂ`-vector space.

With these definitions, we define `fourier_integral` to be the map from functions `V → E` to
functions `W → E` that sends `f` to

`λ w, ∫ v in V, e [-L v w] • f v ∂μ`,

where `e [x]` is notational sugar for `(e (multiplicative.of_add x) : ℂ)` (available in locale
`fourier_transform`). This includes the cases `W` is the dual of `V` and `L` is the canonical
pairing, or `W = V` and `L` is a bilinear form (e.g. an inner product).

In namespace `fourier`, we consider the more familiar special case when `V = W = 𝕜` and `L` is the
multiplication map (but still allowing `𝕜` to be an arbitrary ring equipped with a measure).

The most familiar case of all is when `V = W = 𝕜 = ℝ`, `L` is multiplication, `μ` is volume, and
`e` is `real.fourier_char`, i.e. the character `λ x, exp ((2 * π * x) * I)`. The Fourier integral
in this case is defined as `real.fourier_integral`.

## Main results

At present the only nontrivial lemma we prove is `continuous_fourier_integral`, stating that the
Fourier transform of an integrable function is continuous (under mild assumptions).
-/

noncomputable section

-- mathport name: expr𝕊
local notation "𝕊" => circle

open MeasureTheory Filter

open Topology

-- mathport name: «expr [ ]»
-- To avoid messing around with multiplicative vs. additive characters, we make a notation.
scoped[FourierTransform] notation e "[" x "]" => (e (Multiplicative.ofAdd x) : ℂ)

/-! ## Fourier theory for functions on general vector spaces -/

namespace VectorFourier

variable {𝕜 : Type _} [CommRing 𝕜] {V : Type _} [AddCommGroup V] [Module 𝕜 V] [MeasurableSpace V]
  {W : Type _} [AddCommGroup W] [Module 𝕜 W] {E : Type _} [NormedAddCommGroup E] [NormedSpace ℂ E]

section Defs

variable [CompleteSpace E]

/-- The Fourier transform integral for `f : V → E`, with respect to a bilinear form `L : V × W → 𝕜`
and an additive character `e`. -/
def fourierIntegral (e : Multiplicative 𝕜 →* 𝕊) (μ : Measure V) (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜) (f : V → E)
    (w : W) : E :=
  ∫ v, e[-L v w] • f v ∂μ
#align vector_fourier.fourier_integral VectorFourier.fourierIntegral

theorem fourierIntegral_smul_const (e : Multiplicative 𝕜 →* 𝕊) (μ : Measure V)
    (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜) (f : V → E) (r : ℂ) :
    fourierIntegral e μ L (r • f) = r • fourierIntegral e μ L f :=
  by
  ext1 w
  simp only [Pi.smul_apply, fourier_integral, smul_comm _ r, integral_smul]
#align vector_fourier.fourier_integral_smul_const VectorFourier.fourierIntegral_smul_const

/-- The uniform norm of the Fourier integral of `f` is bounded by the `L¹` norm of `f`. -/
theorem fourierIntegral_norm_le (e : Multiplicative 𝕜 →* 𝕊) {μ : Measure V} (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜)
    {f : V → E} (hf : Integrable f μ) (w : W) : ‖fourierIntegral e μ L f w‖ ≤ ‖hf.toL1 f‖ :=
  by
  rw [L1.norm_of_fun_eq_integral_norm]
  refine' (norm_integral_le_integral_norm _).trans (le_of_eq _)
  simp_rw [norm_smul, Complex.norm_eq_abs, abs_coe_circle, one_mul]
#align vector_fourier.fourier_integral_norm_le VectorFourier.fourierIntegral_norm_le

/-- The Fourier integral converts right-translation into scalar multiplication by a phase factor.-/
theorem fourierIntegral_comp_add_right [HasMeasurableAdd V] (e : Multiplicative 𝕜 →* 𝕊)
    (μ : Measure V) [μ.IsAddRightInvariant] (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜) (f : V → E) (v₀ : V) :
    fourierIntegral e μ L (f ∘ fun v => v + v₀) = fun w => e[L v₀ w] • fourierIntegral e μ L f w :=
  by
  ext1 w
  dsimp only [fourier_integral, Function.comp_apply]
  conv in L _ => rw [← add_sub_cancel v v₀]
  rw [integral_add_right_eq_self fun v : V => e[-L (v - v₀) w] • f v]
  swap; infer_instance
  dsimp only
  rw [← integral_smul]
  congr 1 with v
  rw [← smul_assoc, smul_eq_mul, ← Submonoid.coe_mul, ← e.map_mul, ← ofAdd_add, ←
    LinearMap.neg_apply, ← sub_eq_add_neg, ← LinearMap.sub_apply, LinearMap.map_sub, neg_sub]
#align vector_fourier.fourier_integral_comp_add_right VectorFourier.fourierIntegral_comp_add_right

end Defs

section Continuous

/- In this section we assume 𝕜, V, W have topologies, and L, e are continuous (but f needn't be).
   This is used to ensure that `e [-L v w]` is (ae strongly) measurable. We could get away with
   imposing only a measurable-space structure on 𝕜 (it doesn't have to be the Borel sigma-algebra of
   a topology); but it seems hard to imagine cases where this extra generality would be useful, and
   allowing it would complicate matters in the most important use cases.
-/
variable [TopologicalSpace 𝕜] [TopologicalRing 𝕜] [TopologicalSpace V] [BorelSpace V]
  [TopologicalSpace W] {e : Multiplicative 𝕜 →* 𝕊} {μ : Measure V} {L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜}

/-- If `f` is integrable, then the Fourier integral is convergent for all `w`. -/
theorem fourierIntegralConvergent (he : Continuous e) (hL : Continuous fun p : V × W => L p.1 p.2)
    {f : V → E} (hf : Integrable f μ) (w : W) : Integrable (fun v : V => e[-L v w] • f v) μ :=
  by
  rw [continuous_induced_rng] at he
  have c : Continuous fun v => e[-L v w] :=
    by
    refine' he.comp (continuous_of_add.comp (Continuous.neg _))
    exact hL.comp (continuous_prod_mk.mpr ⟨continuous_id, continuous_const⟩)
  rw [← integrable_norm_iff (c.ae_strongly_measurable.smul hf.1)]
  convert hf.norm
  ext1 v
  rw [norm_smul, Complex.norm_eq_abs, abs_coe_circle, one_mul]
#align vector_fourier.fourier_integral_convergent VectorFourier.fourierIntegralConvergent

variable [CompleteSpace E]

theorem fourierIntegral_add (he : Continuous e) (hL : Continuous fun p : V × W => L p.1 p.2)
    {f g : V → E} (hf : Integrable f μ) (hg : Integrable g μ) :
    fourierIntegral e μ L f + fourierIntegral e μ L g = fourierIntegral e μ L (f + g) :=
  by
  ext1 w
  dsimp only [Pi.add_apply, fourier_integral]
  simp_rw [smul_add]
  rw [integral_add]
  · exact fourier_integral_convergent he hL hf w
  · exact fourier_integral_convergent he hL hg w
#align vector_fourier.fourier_integral_add VectorFourier.fourierIntegral_add

/-- The Fourier integral of an `L^1` function is a continuous function. -/
theorem fourierIntegral_continuous [TopologicalSpace.FirstCountableTopology W] (he : Continuous e)
    (hL : Continuous fun p : V × W => L p.1 p.2) {f : V → E} (hf : Integrable f μ) :
    Continuous (fourierIntegral e μ L f) :=
  by
  apply continuous_of_dominated
  · exact fun w => (fourier_integral_convergent he hL hf w).1
  · refine' fun w => ae_of_all _ fun v => _
    · exact fun v => ‖f v‖
    · rw [norm_smul, Complex.norm_eq_abs, abs_coe_circle, one_mul]
  · exact hf.norm
  · rw [continuous_induced_rng] at he
    refine' ae_of_all _ fun v => (he.comp (continuous_of_add.comp _)).smul continuous_const
    refine' (hL.comp (continuous_prod_mk.mpr ⟨continuous_const, continuous_id⟩)).neg
#align vector_fourier.fourier_integral_continuous VectorFourier.fourierIntegral_continuous

end Continuous

end VectorFourier

/-! ## Fourier theory for functions on `𝕜` -/

namespace Fourier

variable {𝕜 : Type _} [CommRing 𝕜] [MeasurableSpace 𝕜] {E : Type _} [NormedAddCommGroup E]
  [NormedSpace ℂ E]

section Defs

variable [CompleteSpace E]

/-- The Fourier transform integral for `f : 𝕜 → E`, with respect to the measure `μ` and additive
character `e`. -/
def fourierIntegral (e : Multiplicative 𝕜 →* 𝕊) (μ : Measure 𝕜) (f : 𝕜 → E) (w : 𝕜) : E :=
  VectorFourier.fourierIntegral e μ (LinearMap.mul 𝕜 𝕜) f w
#align fourier.fourier_integral Fourier.fourierIntegral

theorem fourierIntegral_def (e : Multiplicative 𝕜 →* 𝕊) (μ : Measure 𝕜) (f : 𝕜 → E) (w : 𝕜) :
    fourierIntegral e μ f w = ∫ v : 𝕜, e[-(v * w)] • f v ∂μ :=
  rfl
#align fourier.fourier_integral_def Fourier.fourierIntegral_def

theorem fourierIntegral_smul_const (e : Multiplicative 𝕜 →* 𝕊) (μ : Measure 𝕜) (f : 𝕜 → E) (r : ℂ) :
    fourierIntegral e μ (r • f) = r • fourierIntegral e μ f :=
  VectorFourier.fourierIntegral_smul_const _ _ _ _ _
#align fourier.fourier_integral_smul_const Fourier.fourierIntegral_smul_const

/-- The uniform norm of the Fourier transform of `f` is bounded by the `L¹` norm of `f`. -/
theorem fourierIntegral_norm_le (e : Multiplicative 𝕜 →* 𝕊) {μ : Measure 𝕜} {f : 𝕜 → E}
    (hf : Integrable f μ) (w : 𝕜) : ‖fourierIntegral e μ f w‖ ≤ ‖hf.toL1 f‖ :=
  VectorFourier.fourierIntegral_norm_le _ _ _ _
#align fourier.fourier_integral_norm_le Fourier.fourierIntegral_norm_le

/-- The Fourier transform converts right-translation into scalar multiplication by a phase factor.-/
theorem fourierIntegral_comp_add_right [HasMeasurableAdd 𝕜] (e : Multiplicative 𝕜 →* 𝕊)
    (μ : Measure 𝕜) [μ.IsAddRightInvariant] (f : 𝕜 → E) (v₀ : 𝕜) :
    fourierIntegral e μ (f ∘ fun v => v + v₀) = fun w => e[v₀ * w] • fourierIntegral e μ f w :=
  VectorFourier.fourierIntegral_comp_add_right _ _ _ _ _
#align fourier.fourier_integral_comp_add_right Fourier.fourierIntegral_comp_add_right

end Defs

end Fourier

open Real

namespace Real

/-- The standard additive character of `ℝ`, given by `λ x, exp (2 * π * x * I)`. -/
def fourierChar : Multiplicative ℝ →* 𝕊
    where
  toFun z := expMapCircle (2 * π * z.toAdd)
  map_one' := by rw [toAdd_one, MulZeroClass.mul_zero, expMapCircle_zero]
  map_mul' x y := by rw [toAdd_mul, mul_add, expMapCircle_add]
#align real.fourier_char Real.fourierChar

theorem fourierChar_apply (x : ℝ) : Real.fourierChar[x] = Complex.exp (↑(2 * π * x) * Complex.I) :=
  by rfl
#align real.fourier_char_apply Real.fourierChar_apply

@[continuity]
theorem continuous_fourierChar : Continuous Real.fourierChar :=
  (map_continuous expMapCircle).comp (continuous_const.mul continuous_toAdd)
#align real.continuous_fourier_char Real.continuous_fourierChar

variable {E : Type _} [NormedAddCommGroup E] [CompleteSpace E] [NormedSpace ℂ E]

theorem vector_fourierIntegral_eq_integral_exp_smul {V : Type _} [AddCommGroup V] [Module ℝ V]
    [MeasurableSpace V] {W : Type _} [AddCommGroup W] [Module ℝ W] (L : V →ₗ[ℝ] W →ₗ[ℝ] ℝ)
    (μ : Measure V) (f : V → E) (w : W) :
    VectorFourier.fourierIntegral fourierChar μ L f w =
      ∫ v : V, Complex.exp (↑(-2 * π * L v w) * Complex.I) • f v ∂μ :=
  by simp_rw [VectorFourier.fourierIntegral, Real.fourierChar_apply, mul_neg, neg_mul]
#align real.vector_fourier_integral_eq_integral_exp_smul Real.vector_fourierIntegral_eq_integral_exp_smul

/-- The Fourier integral for `f : ℝ → E`, with respect to the standard additive character and
measure on `ℝ`. -/
def fourierIntegral (f : ℝ → E) (w : ℝ) :=
  Fourier.fourierIntegral fourierChar volume f w
#align real.fourier_integral Real.fourierIntegral

theorem fourierIntegral_def (f : ℝ → E) (w : ℝ) :
    fourierIntegral f w = ∫ v : ℝ, fourierChar[-(v * w)] • f v :=
  rfl
#align real.fourier_integral_def Real.fourierIntegral_def

-- mathport name: fourier_integral
scoped[FourierTransform] notation "𝓕" => Real.fourierIntegral

theorem fourierIntegral_eq_integral_exp_smul {E : Type _} [NormedAddCommGroup E] [CompleteSpace E]
    [NormedSpace ℂ E] (f : ℝ → E) (w : ℝ) :
    𝓕 f w = ∫ v : ℝ, Complex.exp (↑(-2 * π * v * w) * Complex.I) • f v := by
  simp_rw [fourier_integral_def, Real.fourierChar_apply, mul_neg, neg_mul, mul_assoc]
#align real.fourier_integral_eq_integral_exp_smul Real.fourierIntegral_eq_integral_exp_smul

end Real


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.convex.extreme
import analysis.convex.function
import analysis.normed_space.ordered

/-!
# Exposed sets

This file defines exposed sets and exposed points for sets in a real vector space.

An exposed subset of `A` is a subset of `A` that is the set of all maximal points of a functional
(a continuous linear map `E → 𝕜`) over `A`. By convention, `∅` is an exposed subset of all sets.
This allows for better functioriality of the definition (the intersection of two exposed subsets is
exposed, faces of a polytope form a bounded lattice).
This is an analytic notion of "being on the side of". It is stronger than being extreme (see
`is_exposed.is_extreme`), but weaker (for exposed points) than being a vertex.

An exposed set of `A` is sometimes called a "face of `A`", but we decided to reserve this
terminology to the more specific notion of a face of a polytope (sometimes hopefully soon out
on mathlib!).

## Main declarations

* `is_exposed 𝕜 A B`: States that `B` is an exposed set of `A` (in the literature, `A` is often
  implicit).
* `is_exposed.is_extreme`: An exposed set is also extreme.

## References

See chapter 8 of [Barry Simon, *Convexity*][simon2011]

## TODO

Define intrinsic frontier/interior and prove the lemmas related to exposed sets and points.

Generalise to Locally Convex Topological Vector Spaces™

More not-yet-PRed stuff is available on the branch `sperner_again`.
-/

open_locale classical affine big_operators
open set

variables (𝕜 : Type*) {E : Type*} [normed_linear_ordered_field 𝕜] [normed_group E]
  [normed_space 𝕜 E] {l : E →L[𝕜] 𝕜} {A B C : set E} {X : finset E} {x : E}

/-- A set `B` is exposed with respect to `A` iff it maximizes some functional over `A` (and contains
all points maximizing it). Written `is_exposed 𝕜 A B`. -/
def is_exposed (A B : set E) : Prop :=
B.nonempty → ∃ l : E →L[𝕜] 𝕜, B = {x ∈ A | ∀ y ∈ A, l y ≤ l x}

variables {𝕜}

/-- A useful way to build exposed sets from intersecting `A` with halfspaces (modelled by an
inequality with a functional). -/
def continuous_linear_map.to_exposed (l : E →L[𝕜] 𝕜) (A : set E) : set E :=
{x ∈ A | ∀ y ∈ A, l y ≤ l x}

lemma continuous_linear_map.to_exposed.is_exposed : is_exposed 𝕜 A (l.to_exposed A) := λ h, ⟨l, rfl⟩

lemma is_exposed_empty : is_exposed 𝕜 A ∅ :=
λ ⟨x, hx⟩, by { exfalso, exact hx }

namespace is_exposed

protected lemma subset (hAB : is_exposed 𝕜 A B) : B ⊆ A :=
begin
  rintro x hx,
  obtain ⟨_, rfl⟩ := hAB ⟨x, hx⟩,
  exact hx.1,
end

@[refl] protected lemma refl (A : set E) : is_exposed 𝕜 A A :=
λ ⟨w, hw⟩, ⟨0, subset.antisymm (λ x hx, ⟨hx, λ y hy, by exact le_refl 0⟩) (λ x hx, hx.1)⟩

protected lemma antisymm (hB : is_exposed 𝕜 A B) (hA : is_exposed 𝕜 B A) :
  A = B :=
hA.subset.antisymm hB.subset

/- `is_exposed` is *not* transitive: Consider a (topologically) open cube with vertices
`A₀₀₀, ..., A₁₁₁` and add to it the triangle `A₀₀₀A₀₀₁A₀₁₀`. Then `A₀₀₁A₀₁₀` is an exposed subset
of `A₀₀₀A₀₀₁A₀₁₀` which is an exposed subset of the cube, but `A₀₀₁A₀₁₀` is not itself an exposed
subset of the cube. -/

protected lemma mono (hC : is_exposed 𝕜 A C) (hBA : B ⊆ A) (hCB : C ⊆ B) :
  is_exposed 𝕜 B C :=
begin
  rintro ⟨w, hw⟩,
  obtain ⟨l, rfl⟩ := hC ⟨w, hw⟩,
  exact ⟨l, subset.antisymm (λ x hx, ⟨hCB hx, λ y hy, hx.2 y (hBA hy)⟩)
    (λ x hx, ⟨hBA hx.1, λ y hy, (hw.2 y hy).trans (hx.2 w (hCB hw))⟩)⟩,
end

/-- If `B` is an exposed subset of `A`, then `B` is the intersection of `A` with some closed
halfspace. The converse is *not* true. It would require that the corresponding open halfspace
doesn't intersect `A`. -/
lemma eq_inter_halfspace (hAB : is_exposed 𝕜 A B) :
  ∃ l : E →L[𝕜] 𝕜, ∃ a, B = {x ∈ A | a ≤ l x} :=
begin
  obtain hB | hB := B.eq_empty_or_nonempty,
  { refine ⟨0, 1, _⟩,
    rw [hB, eq_comm, eq_empty_iff_forall_not_mem],
    rintro x ⟨-, h⟩,
    rw continuous_linear_map.zero_apply at h,
    linarith },
  obtain ⟨l, rfl⟩ := hAB hB,
  obtain ⟨w, hw⟩ := hB,
  exact ⟨l, l w, subset.antisymm (λ x hx, ⟨hx.1, hx.2 w hw.1⟩)
    (λ x hx, ⟨hx.1, λ y hy, (hw.2 y hy).trans hx.2⟩)⟩,
end

protected lemma inter (hB : is_exposed 𝕜 A B) (hC : is_exposed 𝕜 A C) :
  is_exposed 𝕜 A (B ∩ C) :=
begin
  rintro ⟨w, hwB, hwC⟩,
  obtain ⟨l₁, rfl⟩ := hB ⟨w, hwB⟩,
  obtain ⟨l₂, rfl⟩ := hC ⟨w, hwC⟩,
  refine ⟨l₁ + l₂, subset.antisymm _ _⟩,
  { rintro x ⟨⟨hxA, hxB⟩, ⟨-, hxC⟩⟩,
    exact ⟨hxA, λ z hz, add_le_add (hxB z hz) (hxC z hz)⟩ },
  rintro x ⟨hxA, hx⟩,
  refine ⟨⟨hxA, λ y hy, _⟩, hxA, λ y hy, _⟩,
  { exact (add_le_add_iff_right (l₂ x)).1 ((add_le_add (hwB.2 y hy) (hwC.2 x hxA)).trans
      (hx w hwB.1)) },
  { exact (add_le_add_iff_left (l₁ x)).1 (le_trans (add_le_add (hwB.2 x hxA) (hwC.2 y hy))
    (hx w hwB.1)) }
end

lemma sInter {F : finset (set E)} (hF : F.nonempty)
  (hAF : ∀ B ∈ F, is_exposed 𝕜 A B) :
  is_exposed 𝕜 A (⋂₀ F) :=
begin
  revert hF F,
  refine finset.induction _ _,
  { rintro h,
    exfalso,
    exact empty_not_nonempty h },
  rintro C F _ hF _ hCF,
  rw [finset.coe_insert, sInter_insert],
  obtain rfl | hFnemp := F.eq_empty_or_nonempty,
  { rw [finset.coe_empty, sInter_empty, inter_univ],
    exact hCF C (finset.mem_singleton_self C) },
  exact (hCF C (finset.mem_insert_self C F)).inter (hF hFnemp (λ B hB,
    hCF B(finset.mem_insert_of_mem hB))),
end

lemma inter_left (hC : is_exposed 𝕜 A C) (hCB : C ⊆ B) :
  is_exposed 𝕜 (A ∩ B) C :=
begin
  rintro ⟨w, hw⟩,
  obtain ⟨l, rfl⟩ := hC ⟨w, hw⟩,
  exact ⟨l, subset.antisymm (λ x hx, ⟨⟨hx.1, hCB hx⟩, λ y hy, hx.2 y hy.1⟩)
    (λ x ⟨⟨hxC, _⟩, hx⟩, ⟨hxC, λ y hy, (hw.2 y hy).trans (hx w ⟨hC.subset hw, hCB hw⟩)⟩)⟩,
end

lemma inter_right (hC : is_exposed 𝕜 B C) (hCA : C ⊆ A) :
  is_exposed 𝕜 (A ∩ B) C :=
begin
  rw inter_comm,
  exact hC.inter_left hCA,
end

protected lemma is_extreme (hAB : is_exposed 𝕜 A B) :
  is_extreme 𝕜 A B :=
begin
  refine ⟨hAB.subset, λ x₁ x₂ hx₁A hx₂A x hxB hx, _⟩,
  obtain ⟨l, rfl⟩ := hAB ⟨x, hxB⟩,
  have hl : convex_on 𝕜 univ l := l.to_linear_map.convex_on convex_univ,
  have hlx₁ := hxB.2 x₁ hx₁A,
  have hlx₂ := hxB.2 x₂ hx₂A,
  refine ⟨⟨hx₁A, λ y hy, _⟩, ⟨hx₂A, λ y hy, _⟩⟩,
  { rw hlx₁.antisymm (hl.le_left_of_right_le (mem_univ _) (mem_univ _) hx hlx₂),
    exact hxB.2 y hy },
  { rw hlx₂.antisymm (hl.le_right_of_left_le (mem_univ _) (mem_univ _) hx hlx₁),
    exact hxB.2 y hy }
end

protected lemma convex (hAB : is_exposed 𝕜 A B) (hA : convex 𝕜 A) :
  convex 𝕜 B :=
begin
  obtain rfl | hB := B.eq_empty_or_nonempty,
  { exact convex_empty },
  obtain ⟨l, rfl⟩ := hAB hB,
  exact λ x₁ x₂ hx₁ hx₂ a b ha hb hab, ⟨hA hx₁.1 hx₂.1 ha hb hab, λ y hy,
    ((l.to_linear_map.concave_on convex_univ).convex_ge _
    ⟨mem_univ _, hx₁.2 y hy⟩ ⟨mem_univ _, hx₂.2 y hy⟩ ha hb hab).2⟩,
end

protected lemma is_closed [order_closed_topology 𝕜] (hAB : is_exposed 𝕜 A B) (hA : is_closed A) :
  is_closed B :=
begin
  obtain ⟨l, a, rfl⟩ := hAB.eq_inter_halfspace,
  exact hA.is_closed_le continuous_on_const l.continuous.continuous_on,
end

protected lemma is_compact [order_closed_topology 𝕜] (hAB : is_exposed 𝕜 A B) (hA : is_compact A) :
  is_compact B :=
compact_of_is_closed_subset hA (hAB.is_closed hA.is_closed) hAB.subset

end is_exposed

variables (𝕜)

/-- A point is exposed with respect to `A` iff there exists an hyperplane whose intersection with
`A` is exactly that point. -/
def set.exposed_points (A : set E) :
  set E :=
{x ∈ A | ∃ l : E →L[𝕜] 𝕜, ∀ y ∈ A, l y ≤ l x ∧ (l x ≤ l y → y = x)}

variables {𝕜}

lemma exposed_point_def :
  x ∈ A.exposed_points 𝕜 ↔ x ∈ A ∧ ∃ l : E →L[𝕜] 𝕜, ∀ y ∈ A, l y ≤ l x ∧ (l x ≤ l y → y = x) :=
iff.rfl

lemma exposed_points_subset :
  A.exposed_points 𝕜 ⊆ A :=
λ x hx, hx.1

@[simp] lemma exposed_points_empty :
  (∅ : set E).exposed_points 𝕜 = ∅ :=
subset_empty_iff.1 exposed_points_subset

/-- Exposed points exactly correspond to exposed singletons. -/
lemma mem_exposed_points_iff_exposed_singleton :
  x ∈ A.exposed_points 𝕜 ↔ is_exposed 𝕜 A {x} :=
begin
  use λ ⟨hxA, l, hl⟩ h, ⟨l, eq.symm $ eq_singleton_iff_unique_mem.2 ⟨⟨hxA, λ y hy, (hl y hy).1⟩,
    λ z hz, (hl z hz.1).2 (hz.2 x hxA)⟩⟩,
  rintro h,
  obtain ⟨l, hl⟩ := h ⟨x, mem_singleton _⟩,
  rw [eq_comm, eq_singleton_iff_unique_mem] at hl,
  exact ⟨hl.1.1, l, λ y hy, ⟨hl.1.2 y hy, λ hxy, hl.2 y ⟨hy, λ z hz, (hl.1.2 z hz).trans hxy⟩⟩⟩,
end

lemma exposed_points_subset_extreme_points :
  A.exposed_points 𝕜 ⊆ A.extreme_points 𝕜 :=
λ x hx, mem_extreme_points_iff_extreme_singleton.2
  (mem_exposed_points_iff_exposed_singleton.1 hx).is_extreme


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.int.order.basic
import data.nat.cast.basic

/-!
# Cast of integers (additional theorems)

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file proves additional properties about the *canonical* homomorphism from
the integers into an additive group with a one (`int.cast`),
particularly results involving algebraic homomorphisms or the order structure on `ℤ`
which were not available in the import dependencies of `data.int.cast.basic`.

## Main declarations

* `cast_add_hom`: `cast` bundled as an `add_monoid_hom`.
* `cast_ring_hom`: `cast` bundled as a `ring_hom`.
-/

open nat

variables {F ι α β : Type*}

namespace int

/-- Coercion `ℕ → ℤ` as a `ring_hom`. -/
def of_nat_hom : ℕ →+* ℤ := ⟨coe, rfl, int.of_nat_mul, rfl, int.of_nat_add⟩

@[simp] theorem coe_nat_pos {n : ℕ} : (0 : ℤ) < n ↔ 0 < n := nat.cast_pos

lemma coe_nat_succ_pos (n : ℕ) : 0 < (n.succ : ℤ) := int.coe_nat_pos.2 (succ_pos n)

lemma to_nat_lt {a : ℤ} {b : ℕ} (hb : b ≠ 0) : a.to_nat < b ↔ a < b :=
by { rw [←to_nat_lt_to_nat, to_nat_coe_nat], exact coe_nat_pos.2 hb.bot_lt }

lemma nat_mod_lt {a : ℤ} {b : ℕ} (hb : b ≠ 0) : a.nat_mod b < b :=
(to_nat_lt hb).2 $ mod_lt_of_pos _ $ coe_nat_pos.2 hb.bot_lt

section cast

@[simp, norm_cast] theorem cast_mul [non_assoc_ring α] : ∀ m n, ((m * n : ℤ) : α) = m * n :=
λ m, int.induction_on' m 0 (by simp) (λ k _ ih n, by simp [add_mul, ih])
  (λ k _ ih n, by simp [sub_mul, ih])

@[simp, norm_cast] theorem cast_ite [add_group_with_one α] (P : Prop) [decidable P] (m n : ℤ) :
  ((ite P m n : ℤ) : α) = ite P m n :=
apply_ite _ _ _ _

/-- `coe : ℤ → α` as an `add_monoid_hom`. -/
def cast_add_hom (α : Type*) [add_group_with_one α] : ℤ →+ α := ⟨coe, cast_zero, cast_add⟩

@[simp] lemma coe_cast_add_hom [add_group_with_one α] : ⇑(cast_add_hom α) = coe := rfl

/-- `coe : ℤ → α` as a `ring_hom`. -/
def cast_ring_hom (α : Type*) [non_assoc_ring α] : ℤ →+* α :=
⟨coe, cast_one, cast_mul, cast_zero, cast_add⟩

@[simp] lemma coe_cast_ring_hom [non_assoc_ring α] : ⇑(cast_ring_hom α) = coe := rfl

lemma cast_commute [non_assoc_ring α] : ∀ (m : ℤ) (x : α), commute ↑m x
| (n : ℕ) x := by simpa using n.cast_commute x
| -[1+ n] x := by simpa only [cast_neg_succ_of_nat, commute.neg_left_iff, commute.neg_right_iff]
  using (n + 1).cast_commute (-x)

lemma cast_comm [non_assoc_ring α] (m : ℤ) (x : α) : (m : α) * x = x * m :=
(cast_commute m x).eq

lemma commute_cast [non_assoc_ring α] (x : α) (m : ℤ) : commute x m :=
(m.cast_commute x).symm

theorem cast_mono [ordered_ring α] : monotone (coe : ℤ → α) :=
begin
  intros m n h,
  rw ← sub_nonneg at h,
  lift n - m to ℕ using h with k,
  rw [← sub_nonneg, ← cast_sub, ← h_1, cast_coe_nat],
  exact k.cast_nonneg
end

@[simp] theorem cast_nonneg [ordered_ring α] [nontrivial α] : ∀ {n : ℤ}, (0 : α) ≤ n ↔ 0 ≤ n
| (n : ℕ) := by simp
| -[1+ n] := have -(n:α) < 1, from lt_of_le_of_lt (by simp) zero_lt_one,
             by simpa [(neg_succ_lt_zero n).not_le, ← sub_eq_add_neg, le_neg] using this.not_le

@[simp, norm_cast] theorem cast_le [ordered_ring α] [nontrivial α] {m n : ℤ} :
  (m : α) ≤ n ↔ m ≤ n :=
by rw [← sub_nonneg, ← cast_sub, cast_nonneg, sub_nonneg]

theorem cast_strict_mono [ordered_ring α] [nontrivial α] : strict_mono (coe : ℤ → α) :=
strict_mono_of_le_iff_le $ λ m n, cast_le.symm

@[simp, norm_cast] theorem cast_lt [ordered_ring α] [nontrivial α] {m n : ℤ} :
  (m : α) < n ↔ m < n :=
cast_strict_mono.lt_iff_lt

@[simp] theorem cast_nonpos [ordered_ring α] [nontrivial α] {n : ℤ} : (n : α) ≤ 0 ↔ n ≤ 0 :=
by rw [← cast_zero, cast_le]

@[simp] theorem cast_pos [ordered_ring α] [nontrivial α] {n : ℤ} : (0 : α) < n ↔ 0 < n :=
by rw [← cast_zero, cast_lt]

@[simp] theorem cast_lt_zero [ordered_ring α] [nontrivial α] {n : ℤ} : (n : α) < 0 ↔ n < 0 :=
by rw [← cast_zero, cast_lt]

section linear_ordered_ring

variables [linear_ordered_ring α] {a b : ℤ} (n : ℤ)

@[simp, norm_cast] theorem cast_min : (↑(min a b) : α) = min a b :=
monotone.map_min cast_mono

@[simp, norm_cast]

@[simp, norm_cast] theorem cast_abs : ((|a| : ℤ) : α) = |a| :=
by simp [abs_eq_max_neg]

lemma cast_one_le_of_pos (h : 0 < a) : (1 : α) ≤ a :=
by exact_mod_cast int.add_one_le_of_lt h

lemma cast_le_neg_one_of_neg (h : a < 0) : (a : α) ≤ -1 :=
begin
  rw [← int.cast_one, ← int.cast_neg, cast_le],
  exact int.le_sub_one_of_lt h,
end

variables (α) {n}

lemma cast_le_neg_one_or_one_le_cast_of_ne_zero (hn : n ≠ 0) : (n : α) ≤ -1 ∨ 1 ≤ (n : α) :=
hn.lt_or_lt.imp cast_le_neg_one_of_neg cast_one_le_of_pos

variables {α} (n)

lemma nneg_mul_add_sq_of_abs_le_one {x : α} (hx : |x| ≤ 1) :
  (0 : α) ≤ n * x + n * n :=
begin
  have hnx : 0 < n → 0 ≤ x + n := λ hn, by
  { convert add_le_add (neg_le_of_abs_le hx) (cast_one_le_of_pos hn),
    rw add_left_neg, },
  have hnx' : n < 0 → x + n ≤ 0 := λ hn, by
  { convert add_le_add (le_of_abs_le hx) (cast_le_neg_one_of_neg hn),
    rw add_right_neg, },
  rw [← mul_add, mul_nonneg_iff],
  rcases lt_trichotomy n 0 with h | rfl | h,
  { exact or.inr ⟨by exact_mod_cast h.le, hnx' h⟩, },
  { simp [le_total 0 x], },
  { exact or.inl ⟨by exact_mod_cast h.le, hnx h⟩, },
end

lemma cast_nat_abs : (n.nat_abs : α) = |n| :=
begin
  cases n,
  { simp, },
  { simp only [int.nat_abs, int.cast_neg_succ_of_nat, abs_neg, ← nat.cast_succ, nat.abs_cast], },
end

end linear_ordered_ring

lemma coe_int_dvd [comm_ring α] (m n : ℤ) (h : m ∣ n) :
  (m : α) ∣ (n : α) :=
ring_hom.map_dvd (int.cast_ring_hom α) h

end cast

end int

open int

namespace add_monoid_hom

variables {A : Type*}

/-- Two additive monoid homomorphisms `f`, `g` from `ℤ` to an additive monoid are equal
if `f 1 = g 1`. -/
@[ext] theorem ext_int [add_monoid A] {f g : ℤ →+ A} (h1 : f 1 = g 1) : f = g :=
have f.comp (int.of_nat_hom : ℕ →+ ℤ) = g.comp (int.of_nat_hom : ℕ →+ ℤ) := ext_nat' _ _ h1,
have ∀ n : ℕ, f n = g n := ext_iff.1 this,
ext $ λ n, int.cases_on n this $ λ n, eq_on_neg _ _ (this $ n + 1)

variables [add_group_with_one A]

theorem eq_int_cast_hom (f : ℤ →+ A) (h1 : f 1 = 1) : f = int.cast_add_hom A :=
ext_int $ by simp [h1]

end add_monoid_hom

lemma eq_int_cast' [add_group_with_one α] [add_monoid_hom_class F ℤ α] (f : F) (h₁ : f 1 = 1) :
  ∀ n : ℤ, f n = n :=
add_monoid_hom.ext_iff.1 $ (f : ℤ →+ α).eq_int_cast_hom h₁

@[simp] lemma int.cast_add_hom_int : int.cast_add_hom ℤ = add_monoid_hom.id ℤ :=
((add_monoid_hom.id ℤ).eq_int_cast_hom rfl).symm

namespace monoid_hom
variables {M : Type*} [monoid M]
open multiplicative

@[ext] theorem ext_mint {f g : multiplicative ℤ →* M} (h1 : f (of_add 1) = g (of_add 1)) : f = g :=
monoid_hom.ext $ add_monoid_hom.ext_iff.mp $
  @add_monoid_hom.ext_int _ _ f.to_additive g.to_additive h1

/-- If two `monoid_hom`s agree on `-1` and the naturals then they are equal. -/
@[ext] theorem ext_int {f g : ℤ →* M}
  (h_neg_one : f (-1) = g (-1))
  (h_nat : f.comp int.of_nat_hom.to_monoid_hom = g.comp int.of_nat_hom.to_monoid_hom) :
  f = g :=
begin
  ext (x | x),
  { exact (monoid_hom.congr_fun h_nat x : _), },
  { rw [int.neg_succ_of_nat_eq, ← neg_one_mul, f.map_mul, g.map_mul],
    congr' 1,
    exact_mod_cast (monoid_hom.congr_fun h_nat (x + 1) : _), }
end

end monoid_hom

namespace monoid_with_zero_hom

variables {M : Type*} [monoid_with_zero M]

/-- If two `monoid_with_zero_hom`s agree on `-1` and the naturals then they are equal. -/
@[ext] lemma ext_int {f g : ℤ →*₀ M} (h_neg_one : f (-1) = g (-1))
  (h_nat : f.comp int.of_nat_hom.to_monoid_with_zero_hom =
           g.comp int.of_nat_hom.to_monoid_with_zero_hom) :
  f = g :=
to_monoid_hom_injective $ monoid_hom.ext_int h_neg_one $ monoid_hom.ext (congr_fun h_nat : _)

end monoid_with_zero_hom

/-- If two `monoid_with_zero_hom`s agree on `-1` and the _positive_ naturals then they are equal. -/
lemma ext_int' [monoid_with_zero α] [monoid_with_zero_hom_class F ℤ α] {f g : F}
  (h_neg_one : f (-1) = g (-1)) (h_pos : ∀ n : ℕ, 0 < n → f n = g n) : f = g :=
fun_like.ext _ _ $ λ n, by { have := fun_like.congr_fun (@monoid_with_zero_hom.ext_int _ _
  (f : ℤ →*₀ α) (g : ℤ →*₀ α) h_neg_one $ monoid_with_zero_hom.ext_nat h_pos) n, exact this }

section non_assoc_ring
variables [non_assoc_ring α] [non_assoc_ring β]

@[simp] lemma eq_int_cast [ring_hom_class F ℤ α] (f : F) (n : ℤ) : f n = n :=
eq_int_cast' f (map_one _) n

@[simp] lemma map_int_cast [ring_hom_class F α β] (f : F) (n : ℤ) : f n = n :=
eq_int_cast ((f : α →+* β).comp (int.cast_ring_hom α)) n

namespace ring_hom

lemma eq_int_cast' (f : ℤ →+* α) : f = int.cast_ring_hom α := ring_hom.ext $ eq_int_cast f

lemma ext_int {R : Type*} [non_assoc_semiring R] (f g : ℤ →+* R) : f = g :=
coe_add_monoid_hom_injective $ add_monoid_hom.ext_int $ f.map_one.trans g.map_one.symm

instance int.subsingleton_ring_hom {R : Type*} [non_assoc_semiring R] : subsingleton (ℤ →+* R) :=
⟨ring_hom.ext_int⟩

end ring_hom
end non_assoc_ring

@[simp, norm_cast] lemma int.cast_id (n : ℤ) : ↑n = n := (eq_int_cast (ring_hom.id ℤ) _).symm

@[simp] lemma int.cast_ring_hom_int : int.cast_ring_hom ℤ = ring_hom.id ℤ :=
(ring_hom.id ℤ).eq_int_cast'.symm

namespace pi
variables {π : ι → Type*} [Π i, has_int_cast (π i)]

instance : has_int_cast (Π i, π i) :=
by refine_struct { .. }; tactic.pi_instance_derive_field

lemma int_apply (n : ℤ) (i : ι) : (n : Π i, π i) i = n := rfl

@[simp] lemma coe_int (n : ℤ) : (n : Π i, π i) = λ _, n := rfl

end pi

lemma sum.elim_int_cast_int_cast {α β γ : Type*} [has_int_cast γ] (n : ℤ) :
  sum.elim (n : α → γ) (n : β → γ) = n :=
@sum.elim_lam_const_lam_const α β γ n

namespace pi
variables {π : ι → Type*} [Π i, add_group_with_one (π i)]

instance : add_group_with_one (Π i, π i) :=
by refine_struct { .. }; tactic.pi_instance_derive_field

end pi

/-! ### Order dual -/

open order_dual

instance [h : has_int_cast α] : has_int_cast αᵒᵈ := h
instance [h : add_group_with_one α] : add_group_with_one αᵒᵈ := h
instance [h : add_comm_group_with_one α] : add_comm_group_with_one αᵒᵈ := h

@[simp] lemma to_dual_int_cast [has_int_cast α] (n : ℤ) : to_dual (n : α) = n := rfl
@[simp] lemma of_dual_int_cast [has_int_cast α] (n : ℤ) : (of_dual n : α) = n := rfl

/-! ### Lexicographic order -/

instance [h : has_int_cast α] : has_int_cast (lex α) := h
instance [h : add_group_with_one α] : add_group_with_one (lex α) := h
instance [h : add_comm_group_with_one α] : add_comm_group_with_one (lex α) := h

@[simp] lemma to_lex_int_cast [has_int_cast α] (n : ℤ) : to_lex (n : α) = n := rfl
@[simp] lemma of_lex_int_cast [has_int_cast α] (n : ℤ) : (of_lex n : α) = n := rfl


notation `♮` := by admit
notation `♯`  := by admit

structure {u v} Category :=
  ( Obj : Type u )
  ( Hom : Obj → Obj → Type v )
  ( identity : Π X : Obj, Hom X X )
  ( compose  : Π { X Y Z : Obj }, Hom X Y → Hom Y Z → Hom X Z )

  ( left_identity  : ∀ { X Y : Obj } (f : Hom X Y), compose (identity X) f = f )
  ( right_identity : ∀ { X Y : Obj } (f : Hom X Y), compose f (identity Y) = f )
  ( associativity  : ∀ { W X Y Z : Obj } (f : Hom W X) (g : Hom X Y) (h : Hom Y Z),
    compose (compose f g) h = compose f (compose g h) )

attribute [simp] Category.left_identity
attribute [simp] Category.right_identity

structure {u1 v1 u2 v2} Functor (C : Category.{ u1 v1 }) (D : Category.{ u2 v2 }) :=
  (onObjects   : C.Obj → D.Obj)
  (onMorphisms : Π { X Y : C.Obj },
                C.Hom X Y → D.Hom (onObjects X) (onObjects Y))
  (identities : ∀ (X : C.Obj),
    onMorphisms (C.identity X) = D.identity (onObjects X))
  (functoriality : ∀ { X Y Z : C.Obj } (f : C.Hom X Y) (g : C.Hom Y Z),
    onMorphisms (C.compose f g) = D.compose (onMorphisms f) (onMorphisms g))

attribute [simp,ematch] Functor.identities
attribute [simp,ematch] Functor.functoriality

structure {u1 v1 u2 v2} Full     { C : Category.{u1 v1} } { D : Category.{u2 v2} } ( F : Functor C D ) :=
  ( preimage : ∀ { X Y : C.Obj } ( f : D.Hom (F.onObjects X) (F.onObjects Y) ), C.Hom X Y )
  ( witness  : ∀ { X Y : C.Obj } ( f : D.Hom (F.onObjects X) (F.onObjects Y) ), F.onMorphisms (preimage f) = f )

attribute [simp,ematch] Full.witness

structure {u1 v1 u2 v2} Faithful { C : Category.{u1 v1} } { D : Category.{u2 v2} } ( F : Functor C D ) :=
  ( injectivity : ∀ { X Y : C.Obj } ( f g : C.Hom X Y ) ( p : F.onMorphisms f = F.onMorphisms g ), f = g )

definition {u1 v1 u2 v2} Embedding { C : Category.{u1 v1} } { D : Category.{u2 v2} } ( F : Functor C D ) := (Full F) × (Faithful F)

structure Idempotent ( C : Category ) :=
   ( object : C.Obj )
   ( idempotent : C.Hom object object )
   ( witness : C.compose idempotent idempotent = idempotent )

attribute [simp,ematch] Idempotent.witness

definition IdempotentCompletion ( C: Category ) : Category :=
{
  Obj            := Idempotent C,
  Hom            := λ X Y, { f : C.Hom X.object Y.object // C.compose X.idempotent f = f ∧ C.compose f Y.idempotent = f },
  identity       := λ X, ⟨ X.idempotent, ♮ ⟩,
  compose        := λ X Y Z f g, ⟨ C.compose f.val g.val, ♮ ⟩,
  left_identity  := ♯,
  right_identity := ♯,
  associativity  := ♮
}

definition functor_to_IdempotentCompletion ( C : Category ) : Functor C (IdempotentCompletion C) := {
  onObjects     := λ X, ⟨ X, C.identity X, ♮ ⟩,
  onMorphisms   := λ _ _ f, ⟨ f, ♮ ⟩,
  identities    := ♮,
  functoriality := ♮
}

open tactic
meta def fsplit : tactic unit :=
do [c] ← target >>= get_constructors_for | tactic.fail "fsplit tactic failed, target is not an inductive datatype with only one constructor",
   mk_const c >>= fapply

meta def second {α} (t : tactic α) : tactic unit :=
tactic.focus [ skip, t >>= (λ a, skip)]

-- attribute [simp] id_locked_eq

lemma embedding_in_IdempotentCompletition ( C: Category ) : Full (functor_to_IdempotentCompletion C) :=
begin
    fsplit,
    intros,
    dsimp at * {unfold_reducible := tt, md := semireducible},
    induction f,
    simp at *,
    tactic.focus [ `[skip], `[intros] ],
    tactic.focus [ `[skip], `[fapply subtype.eq]],
    tactic.focus [ `[skip], `[dsimp {unfold_reducible := tt, md := semireducible}]],
    tactic.focus [ `[skip], `[dsimp at * {unfold_reducible := tt, md := semireducible}]],
    tactic.focus [ `[skip], `[induction f]],
    tactic.focus [ `[skip], `[dsimp {unfold_reducible := tt, md := semireducible}]],

    -- tidy {trace_result:=tt},
    exact val,
    refl, -- FIXME this really should work!

    fsplit,
    intros,
    dsimp at * {unfold_reducible := tt, md := semireducible},
    induction f,
    simp at *,

    second (intros),
    second `[fapply subtype.eq],
    second `[dsimp {unfold_reducible := tt, md := semireducible}],
    second `[dsimp at * {unfold_reducible := tt, md := semireducible}],
    second `[induction f],
    second `[induction property],
    second `[dsimp {unfold_reducible := tt, md := semireducible}],

    exact val,
    refl, -- FIXME this really should work!
end


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.nilpotent

/-!
# Cartan subalgebras

Cartan subalgebras are one of the most important concepts in Lie theory. We define them here.
The standard example is the set of diagonal matrices in the Lie algebra of matrices.

## Main definitions

  * `lie_subalgebra.normalizer`
  * `lie_subalgebra.le_normalizer_of_ideal`
  * `lie_subalgebra.is_cartan_subalgebra`

## Tags

lie subalgebra, normalizer, idealizer, cartan subalgebra
-/

universes u v w w₁ w₂

variables {R : Type u} {L : Type v}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] (H : lie_subalgebra R L)

namespace lie_subalgebra

/-- The normalizer of a Lie subalgebra `H` is the set of elements of the Lie algebra whose bracket
with any element of `H` lies in `H`. It is the Lie algebra equivalent of the group-theoretic
normalizer (see `subgroup.normalizer`) and is an idealizer in the sense of abstract algebra. -/
def normalizer : lie_subalgebra R L :=
{ carrier   := { x : L | ∀ (y : L), (y ∈ H) → ⁅x, y⁆ ∈ H },
  zero_mem' := λ y hy, by { rw zero_lie y, exact H.zero_mem, },
  add_mem'  := λ z₁ z₂ h₁ h₂ y hy, by { rw add_lie, exact H.add_mem (h₁ y hy) (h₂ y hy), },
  smul_mem' := λ t y hy z hz, by { rw smul_lie, exact H.smul_mem t (hy z hz), },
  lie_mem'  := λ z₁ z₂ h₁ h₂ y hy, by
    { rw lie_lie, exact H.sub_mem (h₁ _ (h₂ y hy)) (h₂ _ (h₁ y hy)), }, }

lemma mem_normalizer_iff (x : L) : x ∈ H.normalizer ↔ ∀ (y : L), (y ∈ H) → ⁅x, y⁆ ∈ H := iff.rfl

lemma le_normalizer : H ≤ H.normalizer :=
begin
  rw le_def, intros x hx,
  simp only [set_like.mem_coe, mem_coe_submodule, coe_coe, mem_normalizer_iff] at ⊢ hx,
  intros y, exact H.lie_mem hx,
end

/-- A Lie subalgebra is an ideal of its normalizer. -/
lemma ideal_in_normalizer : ∀ (x y : L), x ∈ H.normalizer → y ∈ H → ⁅x,y⁆ ∈ H :=
begin
  simp only [mem_normalizer_iff],
  intros x y h, exact h y,
end

/-- The normalizer of a Lie subalgebra `H` is the maximal Lie subalgebra in which `H` is a Lie
ideal. -/
lemma le_normalizer_of_ideal {N : lie_subalgebra R L}
  (h : ∀ (x y : L), x ∈ N → y ∈ H → ⁅x,y⁆ ∈ H) : N ≤ H.normalizer :=
begin
  intros x hx,
  rw mem_normalizer_iff,
  exact λ y, h x y hx,
end

/-- A Cartan subalgebra is a nilpotent, self-normalizing subalgebra. -/
class is_cartan_subalgebra : Prop :=
(nilpotent : lie_algebra.is_nilpotent R H)
(self_normalizing : H.normalizer = H)

end lie_subalgebra

@[simp] lemma lie_ideal.normalizer_eq_top {R : Type u} {L : Type v}
  [comm_ring R] [lie_ring L] [lie_algebra R L] (I : lie_ideal R L) :
  (I : lie_subalgebra R L).normalizer = ⊤ :=
begin
  ext x, simp only [lie_subalgebra.mem_normalizer_iff, lie_subalgebra.mem_top, iff_true],
  intros y hy, exact I.lie_mem hy,
end

open lie_ideal

/-- A nilpotent Lie algebra is its own Cartan subalgebra. -/
instance lie_algebra.top_is_cartan_subalgebra_of_nilpotent [lie_algebra.is_nilpotent R L] :
  lie_subalgebra.is_cartan_subalgebra ⊤ :=
{ nilpotent        :=
    by { rwa lie_algebra.nilpotent_iff_equiv_nilpotent lie_subalgebra.top_equiv_self, },
  self_normalizing :=
    by { rw [← top_coe_lie_subalgebra, normalizer_eq_top, top_coe_lie_subalgebra], }, }


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kenny Lau
-/
import data.list.lattice
import data.list.pairwise
import data.list.forall2
import data.set.pairwise.basic

/-!
# Lists with no duplicates

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

`list.nodup` is defined in `data/list/defs`. In this file we prove various properties of this
predicate.
-/

universes u v

open nat function

variables {α : Type u} {β : Type v} {l l₁ l₂ : list α} {r : α → α → Prop} {a b : α}

namespace list

@[simp] theorem forall_mem_ne {a : α} {l : list α} : (∀ (a' : α), a' ∈ l → ¬a = a') ↔ a ∉ l :=
⟨λ h m, h _ m rfl, λ h a' m e, h (e.symm ▸ m)⟩

@[simp] theorem nodup_nil : @nodup α [] := pairwise.nil

@[simp] theorem nodup_cons {a : α} {l : list α} : nodup (a::l) ↔ a ∉ l ∧ nodup l :=
by simp only [nodup, pairwise_cons, forall_mem_ne]

protected lemma pairwise.nodup {l : list α} {r : α → α → Prop} [is_irrefl α r] (h : pairwise r l) :
  nodup l :=
h.imp $ λ a b, ne_of_irrefl

lemma rel_nodup {r : α → β → Prop} (hr : relator.bi_unique r) : (forall₂ r ⇒ (↔)) nodup nodup
| _ _ forall₂.nil      := by simp only [nodup_nil]
| _ _ (forall₂.cons hab h) :=
  by simpa only [nodup_cons] using relator.rel_and (relator.rel_not (rel_mem hr hab h))
    (rel_nodup h)

protected lemma nodup.cons (ha : a ∉ l) (hl : nodup l) : nodup (a :: l) := nodup_cons.2 ⟨ha, hl⟩

lemma nodup_singleton (a : α) : nodup [a] := pairwise_singleton _ _

lemma nodup.of_cons (h : nodup (a :: l)) : nodup l := (nodup_cons.1 h).2
lemma nodup.not_mem (h : (a :: l).nodup) : a ∉ l := (nodup_cons.1 h).1

lemma not_nodup_cons_of_mem : a ∈ l → ¬ nodup (a :: l) := imp_not_comm.1 nodup.not_mem

protected lemma nodup.sublist : l₁ <+ l₂ → nodup l₂ → nodup l₁ := pairwise.sublist

theorem not_nodup_pair (a : α) : ¬ nodup [a, a] :=
not_nodup_cons_of_mem $ mem_singleton_self _

theorem nodup_iff_sublist {l : list α} : nodup l ↔ ∀ a, ¬ [a, a] <+ l :=
⟨λ d a h, not_nodup_pair a (d.sublist h), begin
  induction l with a l IH; intro h, {exact nodup_nil},
  exact (IH $ λ a s, h a $ sublist_cons_of_sublist _ s).cons
    (λ al, h a $ (singleton_sublist.2 al).cons_cons _)
end⟩

theorem nodup_iff_nth_le_inj {l : list α} :
  nodup l ↔ ∀ i j h₁ h₂, nth_le l i h₁ = nth_le l j h₂ → i = j :=
pairwise_iff_nth_le.trans
⟨λ H i j h₁ h₂ h, ((lt_trichotomy _ _)
  .resolve_left (λ h', H _ _ h₂ h' h))
  .resolve_right (λ h', H _ _ h₁ h' h.symm),
 λ H i j h₁ h₂ h, ne_of_lt h₂ (H _ _ _ _ h)⟩

theorem nodup.nth_le_inj_iff {l : list α} (h : nodup l)
  {i j : ℕ} (hi : i < l.length) (hj : j < l.length) :
  l.nth_le i hi = l.nth_le j hj ↔ i = j :=
⟨nodup_iff_nth_le_inj.mp h _ _ _ _, by simp {contextual := tt}⟩

lemma nodup_iff_nth_ne_nth {l : list α} :
  l.nodup ↔ ∀ (i j : ℕ), i < j → j < l.length → l.nth i ≠ l.nth j :=
begin
  rw nodup_iff_nth_le_inj,
  simp only [nth_le_eq_iff, some_nth_le_eq],
  split; rintro h i j h₁ h₂,
  { exact mt (h i j (h₁.trans h₂) h₂) (ne_of_lt h₁) },
  { intro h₃,
    by_contra h₄,
    cases lt_or_gt_of_ne h₄ with h₅ h₅,
    { exact h i j h₅ h₂ h₃ },
    { exact h j i h₅ h₁ h₃.symm }},
end

lemma nodup.ne_singleton_iff {l : list α} (h : nodup l) (x : α) :
  l ≠ [x] ↔ l = [] ∨ ∃ y ∈ l, y ≠ x :=
begin
  induction l with hd tl hl,
  { simp },
  { specialize hl h.of_cons,
    by_cases hx : tl = [x],
    { simpa [hx, and.comm, and_or_distrib_left] using h },
    { rw [←ne.def, hl] at hx,
      rcases hx with rfl | ⟨y, hy, hx⟩,
      { simp },
      { have : tl ≠ [] := ne_nil_of_mem hy,
        suffices : ∃ (y : α) (H : y ∈ hd :: tl), y ≠ x,
        { simpa [ne_nil_of_mem hy] },
        exact ⟨y, mem_cons_of_mem _ hy, hx⟩ } } }
end

lemma nth_le_eq_of_ne_imp_not_nodup (xs : list α) (n m : ℕ) (hn : n < xs.length)
  (hm : m < xs.length) (h : xs.nth_le n hn = xs.nth_le m hm) (hne : n ≠ m) :
  ¬ nodup xs :=
begin
  rw nodup_iff_nth_le_inj,
  simp only [exists_prop, exists_and_distrib_right, not_forall],
  exact ⟨n, m, ⟨hn, hm, h⟩, hne⟩
end

@[simp] theorem nth_le_index_of [decidable_eq α] {l : list α} (H : nodup l) (n h) :
  index_of (nth_le l n h) l = n :=
nodup_iff_nth_le_inj.1 H _ _ _ h $
index_of_nth_le $ index_of_lt_length.2 $ nth_le_mem _ _ _

theorem nodup_iff_count_le_one [decidable_eq α] {l : list α} : nodup l ↔ ∀ a, count a l ≤ 1 :=
nodup_iff_sublist.trans $ forall_congr $ λ a,
have [a, a] <+ l ↔ 1 < count a l, from (@le_count_iff_replicate_sublist _ _ a l 2).symm,
(not_congr this).trans not_lt

theorem nodup_replicate (a : α) : ∀ {n : ℕ}, nodup (replicate n a) ↔ n ≤ 1
| 0 := by simp [nat.zero_le]
| 1 := by simp
| (n+2) := iff_of_false
  (λ H, nodup_iff_sublist.1 H a ((replicate_sublist_replicate _).2 (nat.le_add_left 2 n)))
  (not_le_of_lt $ nat.le_add_left 2 n)

@[simp] theorem count_eq_one_of_mem [decidable_eq α] {a : α} {l : list α}
  (d : nodup l) (h : a ∈ l) : count a l = 1 :=
le_antisymm (nodup_iff_count_le_one.1 d a) (count_pos.2 h)

lemma count_eq_of_nodup [decidable_eq α] {a : α} {l : list α}
  (d : nodup l) : count a l = if a ∈ l then 1 else 0 :=
begin
  split_ifs with h,
  { exact count_eq_one_of_mem d h },
  { exact count_eq_zero_of_not_mem h },
end

lemma nodup.of_append_left : nodup (l₁ ++ l₂) → nodup l₁ :=
nodup.sublist (sublist_append_left l₁ l₂)

lemma nodup.of_append_right : nodup (l₁ ++ l₂) → nodup l₂ :=
nodup.sublist (sublist_append_right l₁ l₂)

theorem nodup_append {l₁ l₂ : list α} : nodup (l₁++l₂) ↔ nodup l₁ ∧ nodup l₂ ∧ disjoint l₁ l₂ :=
by simp only [nodup, pairwise_append, disjoint_iff_ne]

theorem disjoint_of_nodup_append {l₁ l₂ : list α} (d : nodup (l₁++l₂)) : disjoint l₁ l₂ :=
(nodup_append.1 d).2.2

lemma nodup.append (d₁ : nodup l₁) (d₂ : nodup l₂) (dj : disjoint l₁ l₂) : nodup (l₁ ++ l₂) :=
nodup_append.2 ⟨d₁, d₂, dj⟩

theorem nodup_append_comm {l₁ l₂ : list α} : nodup (l₁++l₂) ↔ nodup (l₂++l₁) :=
by simp only [nodup_append, and.left_comm, disjoint_comm]

theorem nodup_middle {a : α} {l₁ l₂ : list α} : nodup (l₁ ++ a::l₂) ↔ nodup (a::(l₁++l₂)) :=
by simp only [nodup_append, not_or_distrib, and.left_comm, and_assoc, nodup_cons, mem_append,
  disjoint_cons_right]

lemma nodup.of_map (f : α → β) {l : list α} : nodup (map f l) → nodup l :=
pairwise.of_map f $ λ a b, mt $ congr_arg f

lemma nodup.map_on {f : α → β} (H : ∀ x ∈ l, ∀ y ∈ l, f x = f y → x = y) (d : nodup l) :
  (map f l).nodup :=
pairwise.map _ (by exact λ a b ⟨ma, mb, n⟩ e, n (H a ma b mb e)) (pairwise.and_mem.1 d)

theorem nodup_map_iff_inj_on {f : α → β} {l : list α} (d : nodup l) :
  nodup (map f l) ↔ (∀ (x ∈ l) (y ∈ l), f x = f y → x = y) :=
⟨inj_on_of_nodup_map, λ h, d.map_on h⟩

protected lemma nodup.map {f : α → β} (hf : injective f) : nodup l → nodup (map f l) :=
nodup.map_on (assume x _ y _ h, hf h)

theorem nodup_map_iff {f : α → β} {l : list α} (hf : injective f) : nodup (map f l) ↔ nodup l :=
⟨nodup.of_map _, nodup.map hf⟩

@[simp] theorem nodup_attach {l : list α} : nodup (attach l) ↔ nodup l :=
⟨λ h, attach_map_val l ▸ h.map (λ a b, subtype.eq),
  λ h, nodup.of_map subtype.val ((attach_map_val l).symm ▸ h)⟩

alias nodup_attach ↔ nodup.of_attach nodup.attach

attribute [protected] nodup.attach

lemma nodup.pmap {p : α → Prop} {f : Π a, p a → β} {l : list α} {H}
  (hf : ∀ a ha b hb, f a ha = f b hb → a = b) (h : nodup l) : nodup (pmap f l H) :=
by rw [pmap_eq_map_attach]; exact h.attach.map
  (λ ⟨a, ha⟩ ⟨b, hb⟩ h, by congr; exact hf a (H _ ha) b (H _ hb) h)

lemma nodup.filter (p : α → Prop) [decidable_pred p] {l} : nodup l → nodup (filter p l) :=
pairwise.filter p

@[simp] theorem nodup_reverse {l : list α} : nodup (reverse l) ↔ nodup l :=
pairwise_reverse.trans $ by simp only [nodup, ne.def, eq_comm]

lemma nodup.erase_eq_filter [decidable_eq α] {l} (d : nodup l) (a : α) :
  l.erase a = filter (≠ a) l :=
begin
  induction d with b l m d IH, {refl},
  by_cases b = a,
  { subst h, rw [erase_cons_head, filter_cons_of_neg],
    symmetry, rw filter_eq_self, simpa only [ne.def, eq_comm] using m, exact not_not_intro rfl },
  { rw [erase_cons_tail _ h, filter_cons_of_pos, IH], exact h }
end

lemma nodup.erase [decidable_eq α] (a : α) : nodup l → nodup (l.erase a) :=
nodup.sublist $ erase_sublist _ _

lemma nodup.diff [decidable_eq α] : l₁.nodup → (l₁.diff l₂).nodup :=
nodup.sublist $ diff_sublist _ _

lemma nodup.mem_erase_iff [decidable_eq α] (d : nodup l) : a ∈ l.erase b ↔ a ≠ b ∧ a ∈ l :=
by rw [d.erase_eq_filter, mem_filter, and_comm]

lemma nodup.not_mem_erase [decidable_eq α] (h : nodup l) : a ∉ l.erase a :=
λ H, (h.mem_erase_iff.1 H).1 rfl

theorem nodup_join {L : list (list α)} :
  nodup (join L) ↔ (∀ l ∈ L, nodup l) ∧ pairwise disjoint L :=
by simp only [nodup, pairwise_join, disjoint_left.symm, forall_mem_ne]

theorem nodup_bind {l₁ : list α} {f : α → list β} : nodup (l₁.bind f) ↔
  (∀ x ∈ l₁, nodup (f x)) ∧ pairwise (λ (a b : α), disjoint (f a) (f b)) l₁ :=
by simp only [list.bind, nodup_join, pairwise_map, and_comm, and.left_comm, mem_map,
  exists_imp_distrib, and_imp];
   rw [show (∀ (l : list β) (x : α), f x = l → x ∈ l₁ → nodup l) ↔
            (∀ (x : α), x ∈ l₁ → nodup (f x)),
       from forall_swap.trans $ forall_congr $ λ_, forall_eq']

protected lemma nodup.product {l₂ : list β} (d₁ : l₁.nodup) (d₂ : l₂.nodup) :
  (l₁.product l₂).nodup :=
nodup_bind.2
  ⟨λ a ma, d₂.map $ left_inverse.injective $ λ b, (rfl : (a,b).2 = b),
  d₁.imp $ λ a₁ a₂ n x h₁ h₂, begin
    rcases mem_map.1 h₁ with ⟨b₁, mb₁, rfl⟩,
    rcases mem_map.1 h₂ with ⟨b₂, mb₂, ⟨⟩⟩,
    exact n rfl
  end⟩

lemma nodup.sigma {σ : α → Type*} {l₂ : Π a, list (σ a)} (d₁ : nodup l₁) (d₂ : ∀ a, nodup (l₂ a)) :
  (l₁.sigma l₂).nodup :=
nodup_bind.2
  ⟨λ a ma, (d₂ a).map (λ b b' h, by injection h with _ h; exact eq_of_heq h),
  d₁.imp $ λ a₁ a₂ n x h₁ h₂, begin
    rcases mem_map.1 h₁ with ⟨b₁, mb₁, rfl⟩,
    rcases mem_map.1 h₂ with ⟨b₂, mb₂, ⟨⟩⟩,
    exact n rfl
  end⟩

protected lemma nodup.filter_map {f : α → option β} (h : ∀ a a' b, b ∈ f a → b ∈ f a' → a = a') :
  nodup l → nodup (filter_map f l) :=
pairwise.filter_map f $ λ a a' n b bm b' bm' e, n $ h a a' b' (e ▸ bm) bm'

protected lemma nodup.concat (h : a ∉ l) (h' : l.nodup) : (l.concat a).nodup :=
by rw concat_eq_append; exact h'.append (nodup_singleton _) (disjoint_singleton.2 h)

lemma nodup.insert [decidable_eq α] (h : l.nodup) : (insert a l).nodup :=
if h' : a ∈ l then by rw [insert_of_mem h']; exact h
else by rw [insert_of_not_mem h', nodup_cons]; split; assumption

lemma nodup.union [decidable_eq α] (l₁ : list α) (h : nodup l₂) : (l₁ ∪ l₂).nodup  :=
begin
  induction l₁ with a l₁ ih generalizing l₂,
  { exact h },
  { exact (ih h).insert }
end

lemma nodup.inter [decidable_eq α] (l₂ : list α) : nodup l₁ → nodup (l₁ ∩ l₂) := nodup.filter _

lemma nodup.diff_eq_filter [decidable_eq α] :
  ∀ {l₁ l₂ : list α} (hl₁ : l₁.nodup), l₁.diff l₂ = l₁.filter (∉ l₂)
| l₁ []      hl₁ := by simp
| l₁ (a::l₂) hl₁ :=
begin
  rw [diff_cons, (hl₁.erase _).diff_eq_filter, hl₁.erase_eq_filter, filter_filter],
  simp only [mem_cons_iff, not_or_distrib, and.comm]
end

lemma nodup.mem_diff_iff [decidable_eq α] (hl₁ : l₁.nodup) : a ∈ l₁.diff l₂ ↔ a ∈ l₁ ∧ a ∉ l₂ :=
by rw [hl₁.diff_eq_filter, mem_filter]

protected lemma nodup.update_nth : ∀ {l : list α} {n : ℕ} {a : α} (hl : l.nodup) (ha : a ∉ l),
  (l.update_nth n a).nodup
| []     n     a hl ha := nodup_nil
| (b::l) 0     a hl ha := nodup_cons.2 ⟨mt (mem_cons_of_mem _) ha, (nodup_cons.1 hl).2⟩
| (b::l) (n+1) a hl ha := nodup_cons.2
  ⟨λ h, (mem_or_eq_of_mem_update_nth h).elim
      (nodup_cons.1 hl).1
      (λ hba, ha (hba ▸ mem_cons_self _ _)), hl.of_cons.update_nth (mt (mem_cons_of_mem _) ha)⟩

lemma nodup.map_update [decidable_eq α] {l : list α} (hl : l.nodup) (f : α → β) (x : α) (y : β) :
  l.map (function.update f x y) =
    if x ∈ l then (l.map f).update_nth (l.index_of x) y else l.map f :=
begin
  induction l with hd tl ihl, { simp },
  rw [nodup_cons] at hl,
  simp only [mem_cons_iff, map, ihl hl.2],
  by_cases H : hd = x,
  { subst hd,
    simp [update_nth, hl.1] },
  { simp [ne.symm H, H, update_nth, ← apply_ite (cons (f hd))] }
end

lemma nodup.pairwise_of_forall_ne {l : list α} {r : α → α → Prop}
  (hl : l.nodup) (h : ∀ (a ∈ l) (b ∈ l), a ≠ b → r a b) : l.pairwise r :=
begin
  classical,
  refine pairwise_of_reflexive_on_dupl_of_forall_ne _ h,
  intros x hx,
  rw nodup_iff_count_le_one at hl,
  exact absurd (hl x) hx.not_le
end

lemma nodup.pairwise_of_set_pairwise {l : list α} {r : α → α → Prop}
  (hl : l.nodup) (h : {x | x ∈ l}.pairwise r) : l.pairwise r :=
hl.pairwise_of_forall_ne h

@[simp] lemma nodup.pairwise_coe [is_symm α r] (hl : l.nodup) :
  {a | a ∈ l}.pairwise r ↔ l.pairwise r :=
begin
  induction l with a l ih,
  { simp },
  rw list.nodup_cons at hl,
  have : ∀ b ∈ l, ¬a = b → r a b ↔ r a b :=
    λ b hb, imp_iff_right (ne_of_mem_of_not_mem hb hl.1).symm,
  simp [set.set_of_or, set.pairwise_insert_of_symmetric (@symm_of _ r _), ih hl.2, and_comm,
    forall₂_congr this],
end

end list

theorem option.to_list_nodup {α} : ∀ o : option α, o.to_list.nodup
| none     := list.nodup_nil
| (some x) := list.nodup_singleton x


def f (x : α) := x

theorem ex1 (a : α) (b : List α) : f (a::b = []) = False :=
  by simp [f]

def length : List α → Nat
  | []    => 0
  | a::as => length as + 1

theorem ex2 (a b c : α) (as : List α) : length (a :: b :: as) > length as := by
  simp [length]
  apply Nat.lt.step
  apply Nat.lt_succ_self

def fact : Nat → Nat
  | 0 => 1
  | x+1 => (x+1) * fact x

theorem ex3 : fact x > 0 := by
  induction x with
  | zero => decide
  | succ x ih =>
    simp [fact]
    apply Nat.mul_pos
    apply Nat.zero_lt_succ
    apply ih

def head [Inhabited α] : List α → α
  | []   => arbitrary
  | a::_ => a

theorem ex4 [Inhabited α] (a : α) (as : List α) : head (a::as) = a :=
  by simp [head]

def foo := 10

theorem ex5 (x : Nat) : foo + x = 10 + x := by
  simp [foo]
  done

def g (x : Nat) : Nat := do
  let x := x
  return x

theorem ex6 : g x = x := by
  simp [g, bind, pure]

def f1 : StateM Nat Unit := do
  modify fun x => g x

def f2 : StateM Nat Unit := do
  let s ← get
  set <| g s

theorem ex7 : f1 = f2 := by
  simp [f1, f2, bind, StateT.bind, get, getThe, MonadStateOf.get, StateT.get, pure, set, StateT.set, modify, modifyGet, MonadStateOf.modifyGet, StateT.modifyGet]

def h (x : Nat) : Sum (Nat × Nat) Nat := Sum.inl (x, x)

def bla (x : Nat) :=
  match h x with
  | Sum.inl (y, z) => y + z
  | Sum.inr _ => 0

theorem ex8 (x : Nat) : bla x = x + x := by
  simp [bla, h]