/-
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.basic
import data.nat.cast

/-!
# Cast of integers

This file defines the *canonical* homomorphism from the integers into a type `α` with `0`,
`1`, `+` and `-` (typically a `ring`).

## Main declarations

* `cast`: Canonical homomorphism `ℤ → α` where `α` has a `0`, `1`, `+` and `-`.
* `cast_add_hom`: `cast` bundled as an `add_monoid_hom`.
* `cast_ring_hom`: `cast` bundled as a `ring_hom`.

## Implementation note

Setting up the coercions priorities is tricky. See Note [coercion into rings].
-/

open nat

namespace int

@[simp, push_cast] theorem nat_cast_eq_coe_nat : ∀ n,
  @coe ℕ ℤ (@coe_to_lift _ _ nat.cast_coe) n =
  @coe ℕ ℤ (@coe_to_lift _ _ (@coe_base _ _ int.has_coe)) n
| 0     := rfl
| (n+1) := congr_arg (+(1:ℤ)) (nat_cast_eq_coe_nat n)

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

section cast
variables {α : Type*}

section
variables [has_zero α] [has_one α] [has_add α] [has_neg α]

/-- Canonical homomorphism from the integers to any ring(-like) structure `α` -/
protected def cast : ℤ → α
| (n : ℕ) := n
| -[1+ n] := -(n+1)

-- see Note [coercion into rings]
@[priority 900] instance cast_coe : has_coe_t ℤ α := ⟨int.cast⟩

@[simp, norm_cast] theorem cast_zero : ((0 : ℤ) : α) = 0 := rfl

theorem cast_of_nat (n : ℕ) : (of_nat n : α) = n := rfl
@[simp, norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℤ) : α) = n := rfl
theorem cast_coe_nat' (n : ℕ) :
  (@coe ℕ ℤ (@coe_to_lift _ _ nat.cast_coe) n : α) = n :=
by simp

@[simp, norm_cast] theorem cast_neg_succ_of_nat (n : ℕ) : (-[1+ n] : α) = -(n + 1) := rfl

end

@[simp, norm_cast] theorem cast_one [add_monoid α] [has_one α] [has_neg α] :
  ((1 : ℤ) : α) = 1 := nat.cast_one

@[simp] theorem cast_sub_nat_nat [add_group α] [has_one α] (m n) :
  ((int.sub_nat_nat m n : ℤ) : α) = m - n :=
begin
  unfold sub_nat_nat, cases e : n - m,
  { simp [sub_nat_nat, e, tsub_eq_zero_iff_le.mp e] },
  { rw [sub_nat_nat, cast_neg_succ_of_nat, ← nat.cast_succ, ← e,
        nat.cast_sub $ _root_.le_of_lt $ nat.lt_of_sub_eq_succ e, neg_sub] },
end

@[simp, norm_cast] theorem cast_neg_of_nat [add_group α] [has_one α] :
  ∀ n, ((neg_of_nat n : ℤ) : α) = -n
| 0     := neg_zero.symm
| (n+1) := rfl

@[simp, norm_cast] theorem cast_add [add_group α] [has_one α] : ∀ m n, ((m + n : ℤ) : α) = m + n
| (m : ℕ) (n : ℕ) := nat.cast_add _ _
| (m : ℕ) -[1+ n] := by simpa only [sub_eq_add_neg] using cast_sub_nat_nat _ _
| -[1+ m] (n : ℕ) := (cast_sub_nat_nat _ _).trans $ sub_eq_of_eq_add $
  show (n:α) = -(m+1) + n + (m+1),
  by rw [add_assoc, ← cast_succ, ← nat.cast_add, add_comm,
         nat.cast_add, cast_succ, neg_add_cancel_left]
| -[1+ m] -[1+ n] := show -((m + n + 1 + 1 : ℕ) : α) = -(m + 1) + -(n + 1),
  begin
    rw [← neg_add_rev, ← nat.cast_add_one, ← nat.cast_add_one, ← nat.cast_add],
    apply congr_arg (λ x:ℕ, -(x:α)),
    ac_refl
  end

@[simp, norm_cast] theorem cast_neg [add_group α] [has_one α] : ∀ n, ((-n : ℤ) : α) = -n
| (n : ℕ) := cast_neg_of_nat _
| -[1+ n] := (neg_neg _).symm

@[simp, norm_cast] theorem cast_sub [add_group α] [has_one α] (m n) : ((m - n : ℤ) : α) = m - n :=
by simp [sub_eq_add_neg]

@[simp, norm_cast] theorem cast_mul [ring α] : ∀ m n, ((m * n : ℤ) : α) = m * n
| (m : ℕ) (n : ℕ) := nat.cast_mul _ _
| (m : ℕ) -[1+ n] := (cast_neg_of_nat _).trans $
  show (-(m * (n + 1) : ℕ) : α) = m * -(n + 1),
  by rw [nat.cast_mul, nat.cast_add_one, neg_mul_eq_mul_neg]
| -[1+ m] (n : ℕ) := (cast_neg_of_nat _).trans $
  show (-((m + 1) * n : ℕ) : α) = -(m + 1) * n,
  by rw [nat.cast_mul, nat.cast_add_one, neg_mul_eq_neg_mul]
| -[1+ m] -[1+ n] := show (((m + 1) * (n + 1) : ℕ) : α) = -(m + 1) * -(n + 1),
  by rw [nat.cast_mul, nat.cast_add_one, nat.cast_add_one, neg_mul_neg]

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

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

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

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

lemma cast_commute [ring α] (m : ℤ) (x : α) : commute ↑m x :=
int.cases_on m (λ n, n.cast_commute x) (λ n, ((n+1).cast_commute x).neg_left)

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

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

@[simp, norm_cast]
theorem coe_nat_bit0 (n : ℕ) : (↑(bit0 n) : ℤ) = bit0 ↑n := by {unfold bit0, simp}

@[simp, norm_cast]
theorem coe_nat_bit1 (n : ℕ) : (↑(bit1 n) : ℤ) = bit1 ↑n := by {unfold bit1, unfold bit0, simp}

@[simp, norm_cast] theorem cast_bit0 [ring α] (n : ℤ) : ((bit0 n : ℤ) : α) = bit0 n := cast_add _ _

@[simp, norm_cast] theorem cast_bit1 [ring α] (n : ℤ) : ((bit1 n : ℤ) : α) = bit1 n :=
by rw [bit1, cast_add, cast_one, cast_bit0]; refl

lemma cast_two [ring α] : ((2 : ℤ) : α) = 2 := by simp

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]

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

@[simp, norm_cast] theorem cast_max [linear_ordered_ring α] {a b : ℤ} :
  (↑(max a b) : α) = max a b :=
monotone.map_max cast_mono

@[simp, norm_cast] theorem cast_abs [linear_ordered_ring α] {q : ℤ} :
  ((|q| : ℤ) : α) = |q| :=
by simp [abs_eq_max_neg]

lemma cast_nat_abs {R : Type*} [linear_ordered_ring R] : ∀ (n : ℤ), (n.nat_abs : R) = |n|
| (n : ℕ) := by simp only [int.nat_abs_of_nat, int.cast_coe_nat, nat.abs_cast]
| -[1+n]  := by simp only [int.nat_abs, int.cast_neg_succ_of_nat, abs_neg,
                           ← nat.cast_succ, nat.abs_cast]

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

namespace prod

variables {α : Type*} {β : Type*} [has_zero α] [has_one α] [has_add α] [has_neg α]
  [has_zero β] [has_one β] [has_add β] [has_neg β]

@[simp] lemma fst_int_cast (n : ℤ) : (n : α × β).fst = n :=
by induction n; simp *

@[simp] lemma snd_int_cast (n : ℤ) : (n : α × β).snd = n :=
by induction n; simp *

end prod

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 A] [has_one A]

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

theorem eq_int_cast (f : ℤ →+ A) (h1 : f 1 = 1) : ∀ n : ℤ, f n = n :=
ext_iff.1 (f.eq_int_cast_hom h1)

end add_monoid_hom

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] theorem ext_int {f g : monoid_with_zero_hom ℤ 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 : _)

/-- If two `monoid_with_zero_hom`s agree on `-1` and the _positive_ naturals then they are equal. -/
theorem ext_int' {φ₁ φ₂ : monoid_with_zero_hom ℤ M}
  (h_neg_one : φ₁ (-1) = φ₂ (-1)) (h_pos : ∀ n : ℕ, 0 < n → φ₁ n = φ₂ n) : φ₁ = φ₂ :=
ext_int h_neg_one $ ext_nat h_pos

end monoid_with_zero_hom

namespace ring_hom

variables {α : Type*} {β : Type*} [ring α] [ring β]

@[simp] lemma eq_int_cast (f : ℤ →+* α) (n : ℤ) : f n  = n :=
f.to_add_monoid_hom.eq_int_cast f.map_one n

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

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

lemma ext_int {R : Type*} [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*} [semiring R] : subsingleton (ℤ →+* R) :=
⟨ring_hom.ext_int⟩

end ring_hom

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

namespace pi

variables {α β : Type*}

lemma int_apply [has_zero β] [has_one β] [has_add β] [has_neg β] :
  ∀ (n : ℤ) (a : α), (n : α → β) a = n
| (n:ℕ)  a := pi.nat_apply n a
| -[1+n] a :=
by rw [cast_neg_succ_of_nat, cast_neg_succ_of_nat, neg_apply, add_apply, one_apply, nat_apply]

@[simp] lemma coe_int [has_zero β] [has_one β] [has_add β] [has_neg β] (n : ℤ) :
  (n : α → β) = λ _, n :=
by { ext, rw pi.int_apply }

end pi


import geometry.euclidean.angle.sphere
import linear_algebra.affine_space.finite_dimensional
import tactic

open affine affine_map affine_subspace euclidean_geometry finite_dimensional set
open_locale affine big_operators classical euclidean_geometry real

-- https://www.wikiwand.com/en/Sylvester-Gallai_theorem
-- Note that this can be generalised to arbitrary metric spaces
-- See "The Sylvester–Chvatal Theorem" by Xiaomin Chen

namespace generic_space

variables (k : Type*) {V : Type*} {P : Type*}
variables [add_comm_group V] [affine_space V P]
include V

-- 3 points are either collinear, or one point doesn't lie on the the line through the other two
lemma lemma1 [division_ring k] [module k V] {p1 p2 p3 : P} :
(collinear k ({p1, p2, p3} : set P)) ∨ (p1 ∉ line[k, p2, p3]) :=
begin
  apply imp_iff_or_not.1,
  intro h,
  -- p1 ∈ line[k, p2, p3] ↔ ∃ a, a • (p2 -ᵥ p3) = p1 -ᵥ p3
  rw [← vsub_right_mem_direction_iff_mem (mem_affine_span k
      (set.mem_insert_of_mem p2 (mem_singleton p3))), direction_affine_span, vector_span_pair,
      submodule.mem_span_singleton] at h,
  cases h with a ha,
  -- collinear {p1, p2, p3} ↔ ∀ (p : P), p ∈ {p1, p2, p3} → ∃ (r : k), p = r • (p2 -ᵥ p3) +ᵥ p3
  rw [collinear_iff_of_mem (show p3 ∈ {p1, p2, p3}, by simp)],
  use (p2 -ᵥ p3),
  intros p hp,
  -- cases on p ∈ {p1, p2, p3}
  cases hp,
  { use a, rwa [ha, vsub_vadd], },
  cases hp,
  { use 1, rwa [one_smul, vsub_vadd], },
  { rw mem_singleton_iff at hp, use 0, rwa [zero_smul, zero_vadd], },
end

-- For a finite set of points S, a line connecting points in S is *ordinary* if it passes through
-- exactly two points in S.
def ordinary_line [ring k] [module k V] (s : finset P) (p1 p2 : P) (h1 : p1 ∈ s) (h2 : p2 ∈ s) :=
∀ p ∈ s, p = p1 ∨ p = p2 ∨ p ∉ line[k, p1, p2]

end generic_space

---------------------------------------------------------------------------------------------------

namespace real_space

open metric emetric ennreal nnreal generic_space
open_locale ennreal nnreal

-- Specify on the real plane
noncomputable theory

-- variables {V : Type*} {P : Type*}
-- variables [add_comm_group V] [module ℝ V] [affine_space V P] [metric_space P]
-- include V

variables (V : Type*) {Pt : Type*} [inner_product_space ℝ V] [metric_space Pt]
variables [normed_add_torsor V Pt] [finite_dimensional ℝ V] [hd2 : fact (finrank ℝ V = 2)]
include hd2

-- Perpendicular distance from p3 to p1 p2, which doesn't seem to be defined in mathlib
def pdist (p1 p2 p3 : Pt) : ℝ≥0 := metric.inf_nndist p3 line[ℝ, p1, p2]

-- (Practice lemmas)
-- The perpendicular distance from p1 to p1 p2 is 0
lemma lemma1 {p1 p2 : Pt} : pdist V p1 p2 p1 = 0 :=
begin
  rw [pdist, inf_nndist, to_nnreal_eq_zero_iff],
  left,
  apply inf_edist_zero_of_mem,
  apply mem_span_points,
  rw [mem_insert_iff],
  left,
  refl,
end

-- The shortest distance from p3 to any point on p1 p2 is perpendicular distance
lemma lemma2 {p1 p2 p3 : Pt} :
⨅ x ∈ (line[ℝ, p1, p2] : set Pt), nndist x p3 = pdist V p1 p2 p3 :=
begin
  rw [pdist, inf_nndist, inf_edist, coe_affine_span],
  simp_rw [nndist_edist],
end

lemma infi_set {ι α : Type*} [nonempty ι] {f : ι → ennreal} (h : ∀ x : ι, f x ≠ ⊤):
(⨅ x, f x).to_nnreal = (⨅ x, (f x).to_nnreal) :=
begin
  lift f to ι → nnreal, by exact h,
  simp,
end

example {A B C : Prop} (h : A → B) (h' : B → C) : A → C :=
begin
  library_search
end

lemma infi_set' {ι : Type*} [nonempty ι] {f : ι → ennreal} (h : ∀ x, f x ≠ ⊤) :
(⨅ x, f x).to_real = ⨅ x, (f x).to_real :=
begin
  lift f to ι → nnreal, by exact h, simp only [coe_to_real],
  -- (∀ (i : ι), b ≤ f i) → (∀ (w : α), b < w → (∃ (i : ι), f i < w)) → (⨅ (i : ι), f i) = b
  -- b = (⨅ (x : ι), ↑(f x)).to_nnreal
  -- Goal: ⨅ (i : ι), f i = (⨅ (x : ι), ↑(f x)).to_nnreal
  rw [← nnreal.coe_infi, ennreal.to_real],
  congr,

  have l1 : (⨅ (x : ι), ↑(f x)) ≠ ⊤,
  { by_contradiction h',
    rw infi_eq_top at h',
    cases (exists_true_iff_nonempty.2 _inst_5) with y hy,
    exact (h y) (h' y), },

end

-- Casting issues
lemma lemma2' {p1 p2 p3 : Pt} :
(⨅ x ∈ line[ℝ, p1, p2], dist x p3) = (⨅ x ∈ line[ℝ, p1, p2], edist x p3).to_real :=
begin

end

-- Perpendicular distance from p3 to p1 p2 equals the distance from p3 to its orthogonal prrojection
lemma lemma3 {p1 p2 p3 : Pt} :
pdist V p1 p2 p3 = dist p3 (orthogonal_projection line[ℝ, p1, p2] p3) :=
begin
  rw [pdist, coe_affine_span],
end

-- Given a right angle triangle ABC with right angle at B, fix a point D on BC.
-- Then, distance from D to AC < distance from A to BC
/-
A
|\
| \
|  \
|   X
|  / \
B-D---C
-/
-- Not done at all
lemma lemma4 {p1 p2 p3 : Pt} (h : inner (p1 -ᵥ p2) (p3 -ᵥ p2) = (0 : ℝ)) :
∀ p4 ∈ affine_segment ℝ p2 p3, pdist V p1 p3 p4 < pdist V p2 p3 p1 :=
begin
  intros P hP,
end

-- The Sylvester-Gallai Theorem, this formulation doesn't work
theorem sylvester_gallai {s : finset Pt} (h : ¬(collinear ℝ (s : set Pt))):
∃ p1 (hp1 : p1 ∈ s) p2 (hp2 : p2 ∈ s), ordinary_line ℝ s p1 p2 hp1 hp2 :=
begin

end

end real_space


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

! This file was ported from Lean 3 source module analysis.box_integral.partition.basic
! leanprover-community/mathlib commit 84dc0bd6619acaea625086d6f53cb35cdd554219
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Option
import Mathbin.Analysis.BoxIntegral.Box.Basic

/-!
# Partitions of rectangular boxes in `ℝⁿ`

In this file we define (pre)partitions of rectangular boxes in `ℝⁿ`.  A partition of a box `I` in
`ℝⁿ` (see `box_integral.prepartition` and `box_integral.prepartition.is_partition`) is a finite set
of pairwise disjoint boxes such that their union is exactly `I`. We use `boxes : finset (box ι)` to
store the set of boxes.

Many lemmas about box integrals deal with pairwise disjoint collections of subboxes, so we define a
structure `box_integral.prepartition (I : box_integral.box ι)` that stores a collection of boxes
such that

* each box `J ∈ boxes` is a subbox of `I`;
* the boxes are pairwise disjoint as sets in `ℝⁿ`.

Then we define a predicate `box_integral.prepartition.is_partition`; `π.is_partition` means that the
boxes of `π` actually cover the whole `I`. We also define some operations on prepartitions:

* `box_integral.partition.bUnion`: split each box of a partition into smaller boxes;
* `box_integral.partition.restrict`: restrict a partition to a smaller box.

We also define a `semilattice_inf` structure on `box_integral.partition I` for all
`I : box_integral.box ι`.

## Tags

rectangular box, partition
-/

open Set Finset Function

open Classical NNReal BigOperators

noncomputable section

namespace BoxIntegral

variable {ι : Type _}

/-- A prepartition of `I : box_integral.box ι` is a finite set of pairwise disjoint subboxes of
`I`. -/
structure Prepartition (I : Box ι) where
  boxes : Finset (Box ι)
  le_of_mem' : ∀ J ∈ boxes, J ≤ I
  PairwiseDisjoint : Set.Pairwise (↑boxes) (Disjoint on (coe : Box ι → Set (ι → ℝ)))
#align box_integral.prepartition BoxIntegral.Prepartition

namespace Prepartition

variable {I J J₁ J₂ : Box ι} (π : Prepartition I) {π₁ π₂ : Prepartition I} {x : ι → ℝ}

instance : Membership (Box ι) (Prepartition I) :=
  ⟨fun J π => J ∈ π.boxes⟩

@[simp]
theorem mem_boxes : J ∈ π.boxes ↔ J ∈ π :=
  Iff.rfl
#align box_integral.prepartition.mem_boxes BoxIntegral.Prepartition.mem_boxes

@[simp]
theorem mem_mk {s h₁ h₂} : J ∈ (mk s h₁ h₂ : Prepartition I) ↔ J ∈ s :=
  Iff.rfl
#align box_integral.prepartition.mem_mk BoxIntegral.Prepartition.mem_mk

theorem disjoint_coe_of_mem (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (h : J₁ ≠ J₂) :
    Disjoint (J₁ : Set (ι → ℝ)) J₂ :=
  π.PairwiseDisjoint h₁ h₂ h
#align box_integral.prepartition.disjoint_coe_of_mem BoxIntegral.Prepartition.disjoint_coe_of_mem

theorem eq_of_mem_of_mem (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hx₁ : x ∈ J₁) (hx₂ : x ∈ J₂) : J₁ = J₂ :=
  by_contra fun H => (π.disjoint_coe_of_mem h₁ h₂ H).le_bot ⟨hx₁, hx₂⟩
#align box_integral.prepartition.eq_of_mem_of_mem BoxIntegral.Prepartition.eq_of_mem_of_mem

theorem eq_of_le_of_le (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hle₁ : J ≤ J₁) (hle₂ : J ≤ J₂) : J₁ = J₂ :=
  π.eq_of_mem_of_mem h₁ h₂ (hle₁ J.upper_mem) (hle₂ J.upper_mem)
#align box_integral.prepartition.eq_of_le_of_le BoxIntegral.Prepartition.eq_of_le_of_le

theorem eq_of_le (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hle : J₁ ≤ J₂) : J₁ = J₂ :=
  π.eq_of_le_of_le h₁ h₂ le_rfl hle
#align box_integral.prepartition.eq_of_le BoxIntegral.Prepartition.eq_of_le

theorem le_of_mem (hJ : J ∈ π) : J ≤ I :=
  π.le_of_mem' J hJ
#align box_integral.prepartition.le_of_mem BoxIntegral.Prepartition.le_of_mem

theorem lower_le_lower (hJ : J ∈ π) : I.lower ≤ J.lower :=
  Box.antitone_lower (π.le_of_mem hJ)
#align box_integral.prepartition.lower_le_lower BoxIntegral.Prepartition.lower_le_lower

theorem upper_le_upper (hJ : J ∈ π) : J.upper ≤ I.upper :=
  Box.monotone_upper (π.le_of_mem hJ)
#align box_integral.prepartition.upper_le_upper BoxIntegral.Prepartition.upper_le_upper

theorem injective_boxes : Function.Injective (boxes : Prepartition I → Finset (Box ι)) :=
  by
  rintro ⟨s₁, h₁, h₁'⟩ ⟨s₂, h₂, h₂'⟩ (rfl : s₁ = s₂)
  rfl
#align box_integral.prepartition.injective_boxes BoxIntegral.Prepartition.injective_boxes

@[ext]
theorem ext (h : ∀ J, J ∈ π₁ ↔ J ∈ π₂) : π₁ = π₂ :=
  injective_boxes <| Finset.ext h
#align box_integral.prepartition.ext BoxIntegral.Prepartition.ext

/-- The singleton prepartition `{J}`, `J ≤ I`. -/
@[simps]
def single (I J : Box ι) (h : J ≤ I) : Prepartition I :=
  ⟨{J}, by simpa, by simp⟩
#align box_integral.prepartition.single BoxIntegral.Prepartition.single

@[simp]
theorem mem_single {J'} (h : J ≤ I) : J' ∈ single I J h ↔ J' = J :=
  mem_singleton
#align box_integral.prepartition.mem_single BoxIntegral.Prepartition.mem_single

/-- We say that `π ≤ π'` if each box of `π` is a subbox of some box of `π'`. -/
instance : LE (Prepartition I) :=
  ⟨fun π π' => ∀ ⦃I⦄, I ∈ π → ∃ I' ∈ π', I ≤ I'⟩

instance : PartialOrder (Prepartition I)
    where
  le := (· ≤ ·)
  le_refl π I hI := ⟨I, hI, le_rfl⟩
  le_trans π₁ π₂ π₃ h₁₂ h₂₃ I₁ hI₁ :=
    let ⟨I₂, hI₂, hI₁₂⟩ := h₁₂ hI₁
    let ⟨I₃, hI₃, hI₂₃⟩ := h₂₃ hI₂
    ⟨I₃, hI₃, hI₁₂.trans hI₂₃⟩
  le_antisymm :=
    by
    suffices : ∀ {π₁ π₂ : prepartition I}, π₁ ≤ π₂ → π₂ ≤ π₁ → π₁.boxes ⊆ π₂.boxes
    exact fun π₁ π₂ h₁ h₂ => injective_boxes (subset.antisymm (this h₁ h₂) (this h₂ h₁))
    intro π₁ π₂ h₁ h₂ J hJ
    rcases h₁ hJ with ⟨J', hJ', hle⟩; rcases h₂ hJ' with ⟨J'', hJ'', hle'⟩
    obtain rfl : J = J''; exact π₁.eq_of_le hJ hJ'' (hle.trans hle')
    obtain rfl : J' = J; exact le_antisymm ‹_› ‹_›
    assumption

instance : OrderTop (Prepartition I)
    where
  top := single I I le_rfl
  le_top π J hJ := ⟨I, by simp, π.le_of_mem hJ⟩

instance : OrderBot (Prepartition I)
    where
  bot := ⟨∅, fun J hJ => False.elim hJ, fun J hJ => False.elim hJ⟩
  bot_le π J hJ := False.elim hJ

instance : Inhabited (Prepartition I) :=
  ⟨⊤⟩

theorem le_def : π₁ ≤ π₂ ↔ ∀ J ∈ π₁, ∃ J' ∈ π₂, J ≤ J' :=
  Iff.rfl
#align box_integral.prepartition.le_def BoxIntegral.Prepartition.le_def

@[simp]
theorem mem_top : J ∈ (⊤ : Prepartition I) ↔ J = I :=
  mem_singleton
#align box_integral.prepartition.mem_top BoxIntegral.Prepartition.mem_top

@[simp]
theorem top_boxes : (⊤ : Prepartition I).boxes = {I} :=
  rfl
#align box_integral.prepartition.top_boxes BoxIntegral.Prepartition.top_boxes

@[simp]
theorem not_mem_bot : J ∉ (⊥ : Prepartition I) :=
  id
#align box_integral.prepartition.not_mem_bot BoxIntegral.Prepartition.not_mem_bot

@[simp]
theorem bot_boxes : (⊥ : Prepartition I).boxes = ∅ :=
  rfl
#align box_integral.prepartition.bot_boxes BoxIntegral.Prepartition.bot_boxes

/-- An auxiliary lemma used to prove that the same point can't belong to more than
`2 ^ fintype.card ι` closed boxes of a prepartition. -/
theorem injOn_setOf_mem_icc_setOf_lower_eq (x : ι → ℝ) :
    InjOn (fun J : Box ι => { i | J.lower i = x i }) { J | J ∈ π ∧ x ∈ J.Icc } :=
  by
  rintro J₁ ⟨h₁, hx₁⟩ J₂ ⟨h₂, hx₂⟩ (H : { i | J₁.lower i = x i } = { i | J₂.lower i = x i })
  suffices ∀ i, (Ioc (J₁.lower i) (J₁.upper i) ∩ Ioc (J₂.lower i) (J₂.upper i)).Nonempty
    by
    choose y hy₁ hy₂
    exact π.eq_of_mem_of_mem h₁ h₂ hy₁ hy₂
  intro i
  simp only [Set.ext_iff, mem_set_of_eq] at H
  cases' (hx₁.1 i).eq_or_lt with hi₁ hi₁
  · have hi₂ : J₂.lower i = x i := (H _).1 hi₁
    have H₁ : x i < J₁.upper i := by simpa only [hi₁] using J₁.lower_lt_upper i
    have H₂ : x i < J₂.upper i := by simpa only [hi₂] using J₂.lower_lt_upper i
    rw [Ioc_inter_Ioc, hi₁, hi₂, sup_idem, Set.nonempty_Ioc]
    exact lt_min H₁ H₂
  · have hi₂ : J₂.lower i < x i := (hx₂.1 i).lt_of_ne (mt (H _).2 hi₁.ne)
    exact ⟨x i, ⟨hi₁, hx₁.2 i⟩, ⟨hi₂, hx₂.2 i⟩⟩
#align box_integral.prepartition.inj_on_set_of_mem_Icc_set_of_lower_eq BoxIntegral.Prepartition.injOn_setOf_mem_icc_setOf_lower_eq

/-- The set of boxes of a prepartition that contain `x` in their closures has cardinality
at most `2 ^ fintype.card ι`. -/
theorem card_filter_mem_icc_le [Fintype ι] (x : ι → ℝ) :
    (π.boxes.filterₓ fun J : Box ι => x ∈ J.Icc).card ≤ 2 ^ Fintype.card ι :=
  by
  rw [← Fintype.card_set]
  refine'
    Finset.card_le_card_of_inj_on (fun J : box ι => { i | J.lower i = x i })
      (fun _ _ => Finset.mem_univ _) _
  simpa only [Finset.mem_filter] using π.inj_on_set_of_mem_Icc_set_of_lower_eq x
#align box_integral.prepartition.card_filter_mem_Icc_le BoxIntegral.Prepartition.card_filter_mem_icc_le

/-- Given a prepartition `π : box_integral.prepartition I`, `π.Union` is the part of `I` covered by
the boxes of `π`. -/
protected def union : Set (ι → ℝ) :=
  ⋃ J ∈ π, ↑J
#align box_integral.prepartition.Union BoxIntegral.Prepartition.union

theorem union_def : π.unionᵢ = ⋃ J ∈ π, ↑J :=
  rfl
#align box_integral.prepartition.Union_def BoxIntegral.Prepartition.union_def

theorem union_def' : π.unionᵢ = ⋃ J ∈ π.boxes, ↑J :=
  rfl
#align box_integral.prepartition.Union_def' BoxIntegral.Prepartition.union_def'

@[simp]
theorem mem_union : x ∈ π.unionᵢ ↔ ∃ J ∈ π, x ∈ J :=
  Set.mem_unionᵢ₂
#align box_integral.prepartition.mem_Union BoxIntegral.Prepartition.mem_union

@[simp]
theorem union_single (h : J ≤ I) : (single I J h).unionᵢ = J := by simp [Union_def]
#align box_integral.prepartition.Union_single BoxIntegral.Prepartition.union_single

@[simp]
theorem union_top : (⊤ : Prepartition I).unionᵢ = I := by simp [prepartition.Union]
#align box_integral.prepartition.Union_top BoxIntegral.Prepartition.union_top

@[simp]
theorem union_eq_empty : π₁.unionᵢ = ∅ ↔ π₁ = ⊥ := by
  simp [← injective_boxes.eq_iff, Finset.ext_iff, prepartition.Union, imp_false]
#align box_integral.prepartition.Union_eq_empty BoxIntegral.Prepartition.union_eq_empty

@[simp]
theorem union_bot : (⊥ : Prepartition I).unionᵢ = ∅ :=
  union_eq_empty.2 rfl
#align box_integral.prepartition.Union_bot BoxIntegral.Prepartition.union_bot

theorem subset_union (h : J ∈ π) : ↑J ⊆ π.unionᵢ :=
  subset_bunionᵢ_of_mem h
#align box_integral.prepartition.subset_Union BoxIntegral.Prepartition.subset_union

theorem union_subset : π.unionᵢ ⊆ I :=
  unionᵢ₂_subset π.le_of_mem'
#align box_integral.prepartition.Union_subset BoxIntegral.Prepartition.union_subset

@[mono]
theorem union_mono (h : π₁ ≤ π₂) : π₁.unionᵢ ⊆ π₂.unionᵢ := fun x hx =>
  let ⟨J₁, hJ₁, hx⟩ := π₁.mem_unionᵢ.1 hx
  let ⟨J₂, hJ₂, hle⟩ := h hJ₁
  π₂.mem_unionᵢ.2 ⟨J₂, hJ₂, hle hx⟩
#align box_integral.prepartition.Union_mono BoxIntegral.Prepartition.union_mono

theorem disjoint_boxes_of_disjoint_union (h : Disjoint π₁.unionᵢ π₂.unionᵢ) :
    Disjoint π₁.boxes π₂.boxes :=
  Finset.disjoint_left.2 fun J h₁ h₂ =>
    Disjoint.le_bot (h.mono (π₁.subset_unionᵢ h₁) (π₂.subset_unionᵢ h₂)) ⟨J.upper_mem, J.upper_mem⟩
#align box_integral.prepartition.disjoint_boxes_of_disjoint_Union BoxIntegral.Prepartition.disjoint_boxes_of_disjoint_union

theorem le_iff_nonempty_imp_le_and_union_subset :
    π₁ ≤ π₂ ↔
      (∀ J ∈ π₁, ∀ J' ∈ π₂, (J ∩ J' : Set (ι → ℝ)).Nonempty → J ≤ J') ∧ π₁.unionᵢ ⊆ π₂.unionᵢ :=
  by
  fconstructor
  · refine' fun H => ⟨fun J hJ J' hJ' Hne => _, Union_mono H⟩
    rcases H hJ with ⟨J'', hJ'', Hle⟩
    rcases Hne with ⟨x, hx, hx'⟩
    rwa [π₂.eq_of_mem_of_mem hJ' hJ'' hx' (Hle hx)]
  · rintro ⟨H, HU⟩ J hJ
    simp only [Set.subset_def, mem_Union] at HU
    rcases HU J.upper ⟨J, hJ, J.upper_mem⟩ with ⟨J₂, hJ₂, hx⟩
    exact ⟨J₂, hJ₂, H _ hJ _ hJ₂ ⟨_, J.upper_mem, hx⟩⟩
#align box_integral.prepartition.le_iff_nonempty_imp_le_and_Union_subset BoxIntegral.Prepartition.le_iff_nonempty_imp_le_and_union_subset

theorem eq_of_boxes_subset_union_superset (h₁ : π₁.boxes ⊆ π₂.boxes) (h₂ : π₂.unionᵢ ⊆ π₁.unionᵢ) :
    π₁ = π₂ :=
  (le_antisymm fun J hJ => ⟨J, h₁ hJ, le_rfl⟩) <|
    le_iff_nonempty_imp_le_and_union_subset.2
      ⟨fun J₁ hJ₁ J₂ hJ₂ Hne =>
        (π₂.eq_of_mem_of_mem hJ₁ (h₁ hJ₂) Hne.choose_spec.1 Hne.choose_spec.2).le, h₂⟩
#align box_integral.prepartition.eq_of_boxes_subset_Union_superset BoxIntegral.Prepartition.eq_of_boxes_subset_union_superset

/-- Given a prepartition `π` of a box `I` and a collection of prepartitions `πi J` of all boxes
`J ∈ π`, returns the prepartition of `I` into the union of the boxes of all `πi J`.

Though we only use the values of `πi` on the boxes of `π`, we require `πi` to be a globally defined
function. -/
@[simps]
def bUnion (πi : ∀ J : Box ι, Prepartition J) : Prepartition I
    where
  boxes := π.boxes.bunionᵢ fun J => (πi J).boxes
  le_of_mem' J hJ :=
    by
    simp only [Finset.mem_bunionᵢ, exists_prop, mem_boxes] at hJ
    rcases hJ with ⟨J', hJ', hJ⟩
    exact ((πi J').le_of_mem hJ).trans (π.le_of_mem hJ')
  PairwiseDisjoint :=
    by
    simp only [Set.Pairwise, Finset.mem_coe, Finset.mem_bunionᵢ]
    rintro J₁' ⟨J₁, hJ₁, hJ₁'⟩ J₂' ⟨J₂, hJ₂, hJ₂'⟩ Hne
    rw [Function.onFun, Set.disjoint_left]
    rintro x hx₁ hx₂; apply Hne
    obtain rfl : J₁ = J₂
    exact π.eq_of_mem_of_mem hJ₁ hJ₂ ((πi J₁).le_of_mem hJ₁' hx₁) ((πi J₂).le_of_mem hJ₂' hx₂)
    exact (πi J₁).eq_of_mem_of_mem hJ₁' hJ₂' hx₁ hx₂
#align box_integral.prepartition.bUnion BoxIntegral.Prepartition.bUnion

variable {πi πi₁ πi₂ : ∀ J : Box ι, Prepartition J}

@[simp]
theorem mem_bUnion : J ∈ π.bunionᵢ πi ↔ ∃ J' ∈ π, J ∈ πi J' := by simp [bUnion]
#align box_integral.prepartition.mem_bUnion BoxIntegral.Prepartition.mem_bUnion

theorem bUnion_le (πi : ∀ J, Prepartition J) : π.bunionᵢ πi ≤ π := fun J hJ =>
  let ⟨J', hJ', hJ⟩ := π.mem_bunionᵢ.1 hJ
  ⟨J', hJ', (πi J').le_of_mem hJ⟩
#align box_integral.prepartition.bUnion_le BoxIntegral.Prepartition.bUnion_le

@[simp]
theorem bUnion_top : (π.bunionᵢ fun _ => ⊤) = π :=
  by
  ext
  simp
#align box_integral.prepartition.bUnion_top BoxIntegral.Prepartition.bUnion_top

@[congr]
theorem bUnion_congr (h : π₁ = π₂) (hi : ∀ J ∈ π₁, πi₁ J = πi₂ J) :
    π₁.bunionᵢ πi₁ = π₂.bunionᵢ πi₂ := by
  subst π₂
  ext J
  simp (config := { contextual := true }) [hi]
#align box_integral.prepartition.bUnion_congr BoxIntegral.Prepartition.bUnion_congr

theorem bUnion_congr_of_le (h : π₁ = π₂) (hi : ∀ J ≤ I, πi₁ J = πi₂ J) :
    π₁.bunionᵢ πi₁ = π₂.bunionᵢ πi₂ :=
  bUnion_congr h fun J hJ => hi J (π₁.le_of_mem hJ)
#align box_integral.prepartition.bUnion_congr_of_le BoxIntegral.Prepartition.bUnion_congr_of_le

@[simp]
theorem union_bUnion (πi : ∀ J : Box ι, Prepartition J) :
    (π.bunionᵢ πi).unionᵢ = ⋃ J ∈ π, (πi J).unionᵢ := by simp [prepartition.Union]
#align box_integral.prepartition.Union_bUnion BoxIntegral.Prepartition.union_bUnion

@[simp]
theorem sum_bunionᵢ_boxes {M : Type _} [AddCommMonoid M] (π : Prepartition I)
    (πi : ∀ J, Prepartition J) (f : Box ι → M) :
    (∑ J in π.boxes.bunionᵢ fun J => (πi J).boxes, f J) =
      ∑ J in π.boxes, ∑ J' in (πi J).boxes, f J' :=
  by
  refine' Finset.sum_bunionᵢ fun J₁ h₁ J₂ h₂ hne => Finset.disjoint_left.2 fun J' h₁' h₂' => _
  exact hne (π.eq_of_le_of_le h₁ h₂ ((πi J₁).le_of_mem h₁') ((πi J₂).le_of_mem h₂'))
#align box_integral.prepartition.sum_bUnion_boxes BoxIntegral.Prepartition.sum_bunionᵢ_boxes

/-- Given a box `J ∈ π.bUnion πi`, returns the box `J' ∈ π` such that `J ∈ πi J'`.
For `J ∉ π.bUnion πi`, returns `I`. -/
def bUnionIndex (πi : ∀ J, Prepartition J) (J : Box ι) : Box ι :=
  if hJ : J ∈ π.bunionᵢ πi then (π.mem_bunionᵢ.1 hJ).some else I
#align box_integral.prepartition.bUnion_index BoxIntegral.Prepartition.bUnionIndex

theorem bUnionIndex_mem (hJ : J ∈ π.bunionᵢ πi) : π.bUnionIndex πi J ∈ π :=
  by
  rw [bUnion_index, dif_pos hJ]
  exact (π.mem_bUnion.1 hJ).choose_spec.fst
#align box_integral.prepartition.bUnion_index_mem BoxIntegral.Prepartition.bUnionIndex_mem

theorem bUnionIndex_le (πi : ∀ J, Prepartition J) (J : Box ι) : π.bUnionIndex πi J ≤ I :=
  by
  by_cases hJ : J ∈ π.bUnion πi
  · exact π.le_of_mem (π.bUnion_index_mem hJ)
  · rw [bUnion_index, dif_neg hJ]
    exact le_rfl
#align box_integral.prepartition.bUnion_index_le BoxIntegral.Prepartition.bUnionIndex_le

theorem mem_bUnionIndex (hJ : J ∈ π.bunionᵢ πi) : J ∈ πi (π.bUnionIndex πi J) := by
  convert(π.mem_bUnion.1 hJ).choose_spec.snd <;> exact dif_pos hJ
#align box_integral.prepartition.mem_bUnion_index BoxIntegral.Prepartition.mem_bUnionIndex

theorem le_bUnionIndex (hJ : J ∈ π.bunionᵢ πi) : J ≤ π.bUnionIndex πi J :=
  le_of_mem _ (π.mem_bUnionIndex hJ)
#align box_integral.prepartition.le_bUnion_index BoxIntegral.Prepartition.le_bUnionIndex

/-- Uniqueness property of `box_integral.partition.bUnion_index`. -/
theorem bUnionIndex_of_mem (hJ : J ∈ π) {J'} (hJ' : J' ∈ πi J) : π.bUnionIndex πi J' = J :=
  have : J' ∈ π.bunionᵢ πi := π.mem_bunionᵢ.2 ⟨J, hJ, hJ'⟩
  π.eq_of_le_of_le (π.bUnionIndex_mem this) hJ (π.le_bUnionIndex this) (le_of_mem _ hJ')
#align box_integral.prepartition.bUnion_index_of_mem BoxIntegral.Prepartition.bUnionIndex_of_mem

theorem bUnion_assoc (πi : ∀ J, Prepartition J) (πi' : Box ι → ∀ J : Box ι, Prepartition J) :
    (π.bunionᵢ fun J => (πi J).bunionᵢ (πi' J)) =
      (π.bunionᵢ πi).bunionᵢ fun J => πi' (π.bUnionIndex πi J) J :=
  by
  ext J
  simp only [mem_bUnion, exists_prop]
  fconstructor
  · rintro ⟨J₁, hJ₁, J₂, hJ₂, hJ⟩
    refine' ⟨J₂, ⟨J₁, hJ₁, hJ₂⟩, _⟩
    rwa [π.bUnion_index_of_mem hJ₁ hJ₂]
  · rintro ⟨J₁, ⟨J₂, hJ₂, hJ₁⟩, hJ⟩
    refine' ⟨J₂, hJ₂, J₁, hJ₁, _⟩
    rwa [π.bUnion_index_of_mem hJ₂ hJ₁] at hJ
#align box_integral.prepartition.bUnion_assoc BoxIntegral.Prepartition.bUnion_assoc

/-- Create a `box_integral.prepartition` from a collection of possibly empty boxes by filtering out
the empty one if it exists. -/
def ofWithBot (boxes : Finset (WithBot (Box ι)))
    (le_of_mem : ∀ J ∈ boxes, (J : WithBot (Box ι)) ≤ I)
    (pairwise_disjoint : Set.Pairwise (boxes : Set (WithBot (Box ι))) Disjoint) : Prepartition I
    where
  boxes := boxes.eraseNone
  le_of_mem' J hJ := by
    rw [mem_erase_none] at hJ
    simpa only [WithBot.some_eq_coe, WithBot.coe_le_coe] using le_of_mem _ hJ
  PairwiseDisjoint J₁ h₁ J₂ h₂ hne :=
    by
    simp only [mem_coe, mem_erase_none] at h₁ h₂
    exact box.disjoint_coe.1 (pairwise_disjoint h₁ h₂ (mt Option.some_inj.1 hne))
#align box_integral.prepartition.of_with_bot BoxIntegral.Prepartition.ofWithBot

@[simp]
theorem mem_ofWithBot {boxes : Finset (WithBot (Box ι))} {h₁ h₂} :
    J ∈ (ofWithBot boxes h₁ h₂ : Prepartition I) ↔ (J : WithBot (Box ι)) ∈ boxes :=
  mem_eraseNone
#align box_integral.prepartition.mem_of_with_bot BoxIntegral.Prepartition.mem_ofWithBot

@[simp]
theorem union_ofWithBot (boxes : Finset (WithBot (Box ι)))
    (le_of_mem : ∀ J ∈ boxes, (J : WithBot (Box ι)) ≤ I)
    (pairwise_disjoint : Set.Pairwise (boxes : Set (WithBot (Box ι))) Disjoint) :
    (ofWithBot boxes le_of_mem pairwise_disjoint).unionᵢ = ⋃ J ∈ boxes, ↑J :=
  by
  suffices (⋃ (J : box ι) (hJ : ↑J ∈ boxes), ↑J) = ⋃ J ∈ boxes, ↑J by
    simpa [of_with_bot, prepartition.Union]
  simp only [← box.bUnion_coe_eq_coe, @Union_comm _ _ (box ι), @Union_comm _ _ (@Eq _ _ _),
    Union_Union_eq_right]
#align box_integral.prepartition.Union_of_with_bot BoxIntegral.Prepartition.union_ofWithBot

theorem ofWithBot_le {boxes : Finset (WithBot (Box ι))}
    {le_of_mem : ∀ J ∈ boxes, (J : WithBot (Box ι)) ≤ I}
    {pairwise_disjoint : Set.Pairwise (boxes : Set (WithBot (Box ι))) Disjoint}
    (H : ∀ J ∈ boxes, J ≠ ⊥ → ∃ J' ∈ π, J ≤ ↑J') :
    ofWithBot boxes le_of_mem pairwise_disjoint ≤ π :=
  by
  have : ∀ J : Box ι, ↑J ∈ boxes → ∃ J' ∈ π, J ≤ J' := fun J hJ => by
    simpa only [WithBot.coe_le_coe] using H J hJ WithBot.coe_ne_bot
  simpa [of_with_bot, le_def]
#align box_integral.prepartition.of_with_bot_le BoxIntegral.Prepartition.ofWithBot_le

theorem le_ofWithBot {boxes : Finset (WithBot (Box ι))}
    {le_of_mem : ∀ J ∈ boxes, (J : WithBot (Box ι)) ≤ I}
    {pairwise_disjoint : Set.Pairwise (boxes : Set (WithBot (Box ι))) Disjoint}
    (H : ∀ J ∈ π, ∃ J' ∈ boxes, ↑J ≤ J') : π ≤ ofWithBot boxes le_of_mem pairwise_disjoint :=
  by
  intro J hJ
  rcases H J hJ with ⟨J', J'mem, hle⟩
  lift J' to box ι using ne_bot_of_le_ne_bot WithBot.coe_ne_bot hle
  exact ⟨J', mem_of_with_bot.2 J'mem, WithBot.coe_le_coe.1 hle⟩
#align box_integral.prepartition.le_of_with_bot BoxIntegral.Prepartition.le_ofWithBot

theorem ofWithBot_mono {boxes₁ : Finset (WithBot (Box ι))}
    {le_of_mem₁ : ∀ J ∈ boxes₁, (J : WithBot (Box ι)) ≤ I}
    {pairwise_disjoint₁ : Set.Pairwise (boxes₁ : Set (WithBot (Box ι))) Disjoint}
    {boxes₂ : Finset (WithBot (Box ι))} {le_of_mem₂ : ∀ J ∈ boxes₂, (J : WithBot (Box ι)) ≤ I}
    {pairwise_disjoint₂ : Set.Pairwise (boxes₂ : Set (WithBot (Box ι))) Disjoint}
    (H : ∀ J ∈ boxes₁, J ≠ ⊥ → ∃ J' ∈ boxes₂, J ≤ J') :
    ofWithBot boxes₁ le_of_mem₁ pairwise_disjoint₁ ≤
      ofWithBot boxes₂ le_of_mem₂ pairwise_disjoint₂ :=
  le_ofWithBot _ fun J hJ => H J (mem_ofWithBot.1 hJ) WithBot.coe_ne_bot
#align box_integral.prepartition.of_with_bot_mono BoxIntegral.Prepartition.ofWithBot_mono

theorem sum_ofWithBot {M : Type _} [AddCommMonoid M] (boxes : Finset (WithBot (Box ι)))
    (le_of_mem : ∀ J ∈ boxes, (J : WithBot (Box ι)) ≤ I)
    (pairwise_disjoint : Set.Pairwise (boxes : Set (WithBot (Box ι))) Disjoint) (f : Box ι → M) :
    (∑ J in (ofWithBot boxes le_of_mem pairwise_disjoint).boxes, f J) =
      ∑ J in boxes, Option.elim' 0 f J :=
  Finset.sum_eraseNone _ _
#align box_integral.prepartition.sum_of_with_bot BoxIntegral.Prepartition.sum_ofWithBot

/-- Restrict a prepartition to a box. -/
def restrict (π : Prepartition I) (J : Box ι) : Prepartition J :=
  ofWithBot (π.boxes.image fun J' => J ⊓ J')
    (fun J' hJ' => by
      rcases Finset.mem_image.1 hJ' with ⟨J', -, rfl⟩
      exact inf_le_left)
    (by
      simp only [Set.Pairwise, on_fun, Finset.mem_coe, Finset.mem_image]
      rintro _ ⟨J₁, h₁, rfl⟩ _ ⟨J₂, h₂, rfl⟩ Hne
      have : J₁ ≠ J₂ := by
        rintro rfl
        exact Hne rfl
      exact ((box.disjoint_coe.2 <| π.disjoint_coe_of_mem h₁ h₂ this).inf_left' _).inf_right' _)
#align box_integral.prepartition.restrict BoxIntegral.Prepartition.restrict

@[simp]
theorem mem_restrict : J₁ ∈ π.restrict J ↔ ∃ J' ∈ π, (J₁ : WithBot (Box ι)) = J ⊓ J' := by
  simp [restrict, eq_comm]
#align box_integral.prepartition.mem_restrict BoxIntegral.Prepartition.mem_restrict

theorem mem_restrict' : J₁ ∈ π.restrict J ↔ ∃ J' ∈ π, (J₁ : Set (ι → ℝ)) = J ∩ J' := by
  simp only [mem_restrict, ← box.with_bot_coe_inj, box.coe_inf, box.coe_coe]
#align box_integral.prepartition.mem_restrict' BoxIntegral.Prepartition.mem_restrict'

@[mono]
theorem restrict_mono {π₁ π₂ : Prepartition I} (Hle : π₁ ≤ π₂) : π₁.restrict J ≤ π₂.restrict J :=
  by
  refine' of_with_bot_mono fun J₁ hJ₁ hne => _
  rw [Finset.mem_image] at hJ₁; rcases hJ₁ with ⟨J₁, hJ₁, rfl⟩
  rcases Hle hJ₁ with ⟨J₂, hJ₂, hle⟩
  exact ⟨_, Finset.mem_image_of_mem _ hJ₂, inf_le_inf_left _ <| WithBot.coe_le_coe.2 hle⟩
#align box_integral.prepartition.restrict_mono BoxIntegral.Prepartition.restrict_mono

theorem monotone_restrict : Monotone fun π : Prepartition I => restrict π J := fun π₁ π₂ =>
  restrict_mono
#align box_integral.prepartition.monotone_restrict BoxIntegral.Prepartition.monotone_restrict

/-- Restricting to a larger box does not change the set of boxes. We cannot claim equality
of prepartitions because they have different types. -/
theorem restrict_boxes_of_le (π : Prepartition I) (h : I ≤ J) : (π.restrict J).boxes = π.boxes :=
  by
  simp only [restrict, of_with_bot, erase_none_eq_bUnion]
  refine' finset.image_bUnion.trans _
  refine' (Finset.bunionᵢ_congr rfl _).trans Finset.bunionᵢ_singleton_eq_self
  intro J' hJ'
  rw [inf_of_le_right, ← WithBot.some_eq_coe, Option.toFinset_some]
  exact WithBot.coe_le_coe.2 ((π.le_of_mem hJ').trans h)
#align box_integral.prepartition.restrict_boxes_of_le BoxIntegral.Prepartition.restrict_boxes_of_le

@[simp]
theorem restrict_self : π.restrict I = π :=
  injective_boxes <| restrict_boxes_of_le π le_rfl
#align box_integral.prepartition.restrict_self BoxIntegral.Prepartition.restrict_self

@[simp]
theorem union_restrict : (π.restrict J).unionᵢ = J ∩ π.unionᵢ := by
  simp [restrict, ← inter_Union, ← Union_def]
#align box_integral.prepartition.Union_restrict BoxIntegral.Prepartition.union_restrict

@[simp]
theorem restrict_bUnion (πi : ∀ J, Prepartition J) (hJ : J ∈ π) :
    (π.bunionᵢ πi).restrict J = πi J :=
  by
  refine' (eq_of_boxes_subset_Union_superset (fun J₁ h₁ => _) _).symm
  · refine' (mem_restrict _).2 ⟨J₁, π.mem_bUnion.2 ⟨J, hJ, h₁⟩, (inf_of_le_right _).symm⟩
    exact WithBot.coe_le_coe.2 (le_of_mem _ h₁)
  · simp only [Union_restrict, Union_bUnion, Set.subset_def, Set.mem_inter_iff, Set.mem_unionᵢ]
    rintro x ⟨hxJ, J₁, h₁, hx⟩
    obtain rfl : J = J₁
    exact π.eq_of_mem_of_mem hJ h₁ hxJ (Union_subset _ hx)
    exact hx
#align box_integral.prepartition.restrict_bUnion BoxIntegral.Prepartition.restrict_bUnion

theorem bUnion_le_iff {πi : ∀ J, Prepartition J} {π' : Prepartition I} :
    π.bunionᵢ πi ≤ π' ↔ ∀ J ∈ π, πi J ≤ π'.restrict J :=
  by
  fconstructor <;> intro H J hJ
  · rw [← π.restrict_bUnion πi hJ]
    exact restrict_mono H
  · rw [mem_bUnion] at hJ
    rcases hJ with ⟨J₁, h₁, hJ⟩
    rcases H J₁ h₁ hJ with ⟨J₂, h₂, Hle⟩
    rcases π'.mem_restrict.mp h₂ with ⟨J₃, h₃, H⟩
    exact ⟨J₃, h₃, Hle.trans <| WithBot.coe_le_coe.1 <| H.trans_le inf_le_right⟩
#align box_integral.prepartition.bUnion_le_iff BoxIntegral.Prepartition.bUnion_le_iff

theorem le_bUnion_iff {πi : ∀ J, Prepartition J} {π' : Prepartition I} :
    π' ≤ π.bunionᵢ πi ↔ π' ≤ π ∧ ∀ J ∈ π, π'.restrict J ≤ πi J :=
  by
  refine' ⟨fun H => ⟨H.trans (π.bUnion_le πi), fun J hJ => _⟩, _⟩
  · rw [← π.restrict_bUnion πi hJ]
    exact restrict_mono H
  · rintro ⟨H, Hi⟩ J' hJ'
    rcases H hJ' with ⟨J, hJ, hle⟩
    have : J' ∈ π'.restrict J :=
      π'.mem_restrict.2 ⟨J', hJ', (inf_of_le_right <| WithBot.coe_le_coe.2 hle).symm⟩
    rcases Hi J hJ this with ⟨Ji, hJi, hlei⟩
    exact ⟨Ji, π.mem_bUnion.2 ⟨J, hJ, hJi⟩, hlei⟩
#align box_integral.prepartition.le_bUnion_iff BoxIntegral.Prepartition.le_bUnion_iff

instance : Inf (Prepartition I) :=
  ⟨fun π₁ π₂ => π₁.bunionᵢ fun J => π₂.restrict J⟩

theorem inf_def (π₁ π₂ : Prepartition I) : π₁ ⊓ π₂ = π₁.bunionᵢ fun J => π₂.restrict J :=
  rfl
#align box_integral.prepartition.inf_def BoxIntegral.Prepartition.inf_def

@[simp]
theorem mem_inf {π₁ π₂ : Prepartition I} :
    J ∈ π₁ ⊓ π₂ ↔ ∃ J₁ ∈ π₁, ∃ J₂ ∈ π₂, (J : WithBot (Box ι)) = J₁ ⊓ J₂ := by
  simp only [inf_def, mem_bUnion, mem_restrict]
#align box_integral.prepartition.mem_inf BoxIntegral.Prepartition.mem_inf

@[simp]
theorem union_inf (π₁ π₂ : Prepartition I) : (π₁ ⊓ π₂).unionᵢ = π₁.unionᵢ ∩ π₂.unionᵢ := by
  simp only [inf_def, Union_bUnion, Union_restrict, ← Union_inter, ← Union_def]
#align box_integral.prepartition.Union_inf BoxIntegral.Prepartition.union_inf

instance : SemilatticeInf (Prepartition I) :=
  { Prepartition.hasInf,
    Prepartition.partialOrder with
    inf_le_left := fun π₁ π₂ => π₁.bUnion_le _
    inf_le_right := fun π₁ π₂ => (bUnion_le_iff _).2 fun J hJ => le_rfl
    le_inf := fun π π₁ π₂ h₁ h₂ => π₁.le_bUnion_iff.2 ⟨h₁, fun J hJ => restrict_mono h₂⟩ }

/-- The prepartition with boxes `{J ∈ π | p J}`. -/
@[simps]
def filter (π : Prepartition I) (p : Box ι → Prop) : Prepartition I
    where
  boxes := π.boxes.filterₓ p
  le_of_mem' J hJ := π.le_of_mem (mem_filter.1 hJ).1
  PairwiseDisjoint J₁ h₁ J₂ h₂ := π.disjoint_coe_of_mem (mem_filter.1 h₁).1 (mem_filter.1 h₂).1
#align box_integral.prepartition.filter BoxIntegral.Prepartition.filter

@[simp]
theorem mem_filter {p : Box ι → Prop} : J ∈ π.filterₓ p ↔ J ∈ π ∧ p J :=
  Finset.mem_filter
#align box_integral.prepartition.mem_filter BoxIntegral.Prepartition.mem_filter

theorem filter_le (π : Prepartition I) (p : Box ι → Prop) : π.filterₓ p ≤ π := fun J hJ =>
  let ⟨hπ, hp⟩ := π.mem_filter.1 hJ
  ⟨J, hπ, le_rfl⟩
#align box_integral.prepartition.filter_le BoxIntegral.Prepartition.filter_le

theorem filter_of_true {p : Box ι → Prop} (hp : ∀ J ∈ π, p J) : π.filterₓ p = π :=
  by
  ext J
  simpa using hp J
#align box_integral.prepartition.filter_of_true BoxIntegral.Prepartition.filter_of_true

@[simp]
theorem filter_true : (π.filterₓ fun _ => True) = π :=
  π.filter_of_true fun _ _ => trivial
#align box_integral.prepartition.filter_true BoxIntegral.Prepartition.filter_true

@[simp]
theorem union_filter_not (π : Prepartition I) (p : Box ι → Prop) :
    (π.filterₓ fun J => ¬p J).unionᵢ = π.unionᵢ \ (π.filterₓ p).unionᵢ :=
  by
  simp only [prepartition.Union]
  convert(@Set.bunionᵢ_diff_bunionᵢ_eq _ (box ι) π.boxes (π.filter p).boxes coe _).symm
  · ext (J x)
    simp (config := { contextual := true })
  · convert π.pairwise_disjoint
    simp
#align box_integral.prepartition.Union_filter_not BoxIntegral.Prepartition.union_filter_not

theorem sum_fiberwise {α M} [AddCommMonoid M] (π : Prepartition I) (f : Box ι → α) (g : Box ι → M) :
    (∑ y in π.boxes.image f, ∑ J in (π.filterₓ fun J => f J = y).boxes, g J) =
      ∑ J in π.boxes, g J :=
  by convert sum_fiberwise_of_maps_to (fun _ => Finset.mem_image_of_mem f) g
#align box_integral.prepartition.sum_fiberwise BoxIntegral.Prepartition.sum_fiberwise

/-- Union of two disjoint prepartitions. -/
@[simps]
def disjUnion (π₁ π₂ : Prepartition I) (h : Disjoint π₁.unionᵢ π₂.unionᵢ) : Prepartition I
    where
  boxes := π₁.boxes ∪ π₂.boxes
  le_of_mem' J hJ := (Finset.mem_union.1 hJ).elim π₁.le_of_mem π₂.le_of_mem
  PairwiseDisjoint :=
    suffices ∀ J₁ ∈ π₁, ∀ J₂ ∈ π₂, J₁ ≠ J₂ → Disjoint (J₁ : Set (ι → ℝ)) J₂ by
      simpa [pairwise_union_of_symmetric (symmetric_disjoint.comap _), pairwise_disjoint]
    fun J₁ h₁ J₂ h₂ _ => h.mono (π₁.subset_unionᵢ h₁) (π₂.subset_unionᵢ h₂)
#align box_integral.prepartition.disj_union BoxIntegral.Prepartition.disjUnion

@[simp]
theorem mem_disjUnion (H : Disjoint π₁.unionᵢ π₂.unionᵢ) :
    J ∈ π₁.disjUnion π₂ H ↔ J ∈ π₁ ∨ J ∈ π₂ :=
  Finset.mem_union
#align box_integral.prepartition.mem_disj_union BoxIntegral.Prepartition.mem_disjUnion

@[simp]
theorem union_disjUnion (h : Disjoint π₁.unionᵢ π₂.unionᵢ) :
    (π₁.disjUnion π₂ h).unionᵢ = π₁.unionᵢ ∪ π₂.unionᵢ := by
  simp [disj_union, prepartition.Union, Union_or, Union_union_distrib]
#align box_integral.prepartition.Union_disj_union BoxIntegral.Prepartition.union_disjUnion

@[simp]
theorem sum_disj_union_boxes {M : Type _} [AddCommMonoid M] (h : Disjoint π₁.unionᵢ π₂.unionᵢ)
    (f : Box ι → M) :
    (∑ J in π₁.boxes ∪ π₂.boxes, f J) = (∑ J in π₁.boxes, f J) + ∑ J in π₂.boxes, f J :=
  sum_union <| disjoint_boxes_of_disjoint_union h
#align box_integral.prepartition.sum_disj_union_boxes BoxIntegral.Prepartition.sum_disj_union_boxes

section Distortion

variable [Fintype ι]

/-- The distortion of a prepartition is the maximum of the distortions of the boxes of this
prepartition. -/
def distortion : ℝ≥0 :=
  π.boxes.sup Box.distortion
#align box_integral.prepartition.distortion BoxIntegral.Prepartition.distortion

theorem distortion_le_of_mem (h : J ∈ π) : J.distortion ≤ π.distortion :=
  le_sup h
#align box_integral.prepartition.distortion_le_of_mem BoxIntegral.Prepartition.distortion_le_of_mem

theorem distortion_le_iff {c : ℝ≥0} : π.distortion ≤ c ↔ ∀ J ∈ π, Box.distortion J ≤ c :=
  Finset.sup_le_iff
#align box_integral.prepartition.distortion_le_iff BoxIntegral.Prepartition.distortion_le_iff

theorem distortion_bUnion (π : Prepartition I) (πi : ∀ J, Prepartition J) :
    (π.bunionᵢ πi).distortion = π.boxes.sup fun J => (πi J).distortion :=
  sup_bunionᵢ _ _
#align box_integral.prepartition.distortion_bUnion BoxIntegral.Prepartition.distortion_bUnion

@[simp]
theorem distortion_disjUnion (h : Disjoint π₁.unionᵢ π₂.unionᵢ) :
    (π₁.disjUnion π₂ h).distortion = max π₁.distortion π₂.distortion :=
  sup_union
#align box_integral.prepartition.distortion_disj_union BoxIntegral.Prepartition.distortion_disjUnion

theorem distortion_of_const {c} (h₁ : π.boxes.Nonempty) (h₂ : ∀ J ∈ π, Box.distortion J = c) :
    π.distortion = c :=
  (sup_congr rfl h₂).trans (sup_const h₁ _)
#align box_integral.prepartition.distortion_of_const BoxIntegral.Prepartition.distortion_of_const

@[simp]
theorem distortion_top (I : Box ι) : distortion (⊤ : Prepartition I) = I.distortion :=
  sup_singleton
#align box_integral.prepartition.distortion_top BoxIntegral.Prepartition.distortion_top

@[simp]
theorem distortion_bot (I : Box ι) : distortion (⊥ : Prepartition I) = 0 :=
  sup_empty
#align box_integral.prepartition.distortion_bot BoxIntegral.Prepartition.distortion_bot

end Distortion

/-- A prepartition `π` of `I` is a partition if the boxes of `π` cover the whole `I`. -/
def IsPartition (π : Prepartition I) :=
  ∀ x ∈ I, ∃ J ∈ π, x ∈ J
#align box_integral.prepartition.is_partition BoxIntegral.Prepartition.IsPartition

theorem isPartition_iff_union_eq {π : Prepartition I} : π.IsPartition ↔ π.unionᵢ = I := by
  simp_rw [is_partition, Set.Subset.antisymm_iff, π.Union_subset, true_and_iff, Set.subset_def,
    mem_Union, box.mem_coe]
#align box_integral.prepartition.is_partition_iff_Union_eq BoxIntegral.Prepartition.isPartition_iff_union_eq

@[simp]
theorem isPartition_single_iff (h : J ≤ I) : IsPartition (single I J h) ↔ J = I := by
  simp [is_partition_iff_Union_eq]
#align box_integral.prepartition.is_partition_single_iff BoxIntegral.Prepartition.isPartition_single_iff

theorem isPartitionTop (I : Box ι) : IsPartition (⊤ : Prepartition I) := fun x hx =>
  ⟨I, mem_top.2 rfl, hx⟩
#align box_integral.prepartition.is_partition_top BoxIntegral.Prepartition.isPartitionTop

namespace IsPartition

variable {π}

theorem union_eq (h : π.IsPartition) : π.unionᵢ = I :=
  isPartition_iff_union_eq.1 h
#align box_integral.prepartition.is_partition.Union_eq BoxIntegral.Prepartition.IsPartition.union_eq

theorem union_subset (h : π.IsPartition) (π₁ : Prepartition I) : π₁.unionᵢ ⊆ π.unionᵢ :=
  h.unionᵢ_eq.symm ▸ π₁.unionᵢ_subset
#align box_integral.prepartition.is_partition.Union_subset BoxIntegral.Prepartition.IsPartition.union_subset

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (J «expr ∈ » π) -/
protected theorem existsUnique (h : π.IsPartition) (hx : x ∈ I) : ∃! (J : _)(_ : J ∈ π), x ∈ J :=
  by
  rcases h x hx with ⟨J, h, hx⟩
  exact ExistsUnique.intro₂ J h hx fun J' h' hx' => π.eq_of_mem_of_mem h' h hx' hx
#align box_integral.prepartition.is_partition.exists_unique BoxIntegral.Prepartition.IsPartition.existsUnique

theorem nonempty_boxes (h : π.IsPartition) : π.boxes.Nonempty :=
  let ⟨J, hJ, _⟩ := h _ I.upper_mem
  ⟨J, hJ⟩
#align box_integral.prepartition.is_partition.nonempty_boxes BoxIntegral.Prepartition.IsPartition.nonempty_boxes

theorem eq_of_boxes_subset (h₁ : π₁.IsPartition) (h₂ : π₁.boxes ⊆ π₂.boxes) : π₁ = π₂ :=
  eq_of_boxes_subset_union_superset h₂ <| h₁.unionᵢ_subset _
#align box_integral.prepartition.is_partition.eq_of_boxes_subset BoxIntegral.Prepartition.IsPartition.eq_of_boxes_subset

theorem le_iff (h : π₂.IsPartition) :
    π₁ ≤ π₂ ↔ ∀ J ∈ π₁, ∀ J' ∈ π₂, (J ∩ J' : Set (ι → ℝ)).Nonempty → J ≤ J' :=
  le_iff_nonempty_imp_le_and_union_subset.trans <| and_iff_left <| h.unionᵢ_subset _
#align box_integral.prepartition.is_partition.le_iff BoxIntegral.Prepartition.IsPartition.le_iff

protected theorem bUnion (h : IsPartition π) (hi : ∀ J ∈ π, IsPartition (πi J)) :
    IsPartition (π.bunionᵢ πi) := fun x hx =>
  let ⟨J, hJ, hxi⟩ := h x hx
  let ⟨Ji, hJi, hx⟩ := hi J hJ x hxi
  ⟨Ji, π.mem_bunionᵢ.2 ⟨J, hJ, hJi⟩, hx⟩
#align box_integral.prepartition.is_partition.bUnion BoxIntegral.Prepartition.IsPartition.bUnion

protected theorem restrict (h : IsPartition π) (hJ : J ≤ I) : IsPartition (π.restrict J) :=
  isPartition_iff_union_eq.2 <| by simp [h.Union_eq, hJ]
#align box_integral.prepartition.is_partition.restrict BoxIntegral.Prepartition.IsPartition.restrict

protected theorem inf (h₁ : IsPartition π₁) (h₂ : IsPartition π₂) : IsPartition (π₁ ⊓ π₂) :=
  isPartition_iff_union_eq.2 <| by simp [h₁.Union_eq, h₂.Union_eq]
#align box_integral.prepartition.is_partition.inf BoxIntegral.Prepartition.IsPartition.inf

end IsPartition

theorem union_bUnion_partition (h : ∀ J ∈ π, (πi J).IsPartition) :
    (π.bunionᵢ πi).unionᵢ = π.unionᵢ :=
  (union_bUnion _ _).trans <|
    unionᵢ_congr_of_surjective id surjective_id fun J =>
      unionᵢ_congr_of_surjective id surjective_id fun hJ => (h J hJ).unionᵢ_eq
#align box_integral.prepartition.Union_bUnion_partition BoxIntegral.Prepartition.union_bUnion_partition

theorem isPartitionDisjUnionOfEqDiff (h : π₂.unionᵢ = I \ π₁.unionᵢ) :
    IsPartition (π₁.disjUnion π₂ <| h.symm ▸ disjoint_sdiff_self_right) :=
  isPartition_iff_union_eq.2 <| (union_disjUnion _).trans <| by simp [h, π₁.Union_subset]
#align box_integral.prepartition.is_partition_disj_union_of_eq_diff BoxIntegral.Prepartition.isPartitionDisjUnionOfEqDiff

end Prepartition

end BoxIntegral


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import linear_algebra.affine_space.basis
import linear_algebra.finite_dimensional

/-!
# Finite-dimensional subspaces of affine spaces.

This file provides a few results relating to finite-dimensional
subspaces of affine spaces.

## Main definitions

* `collinear` defines collinear sets of points as those that span a
  subspace of dimension at most 1.

-/

noncomputable theory
open_locale big_operators affine

section affine_space'

variables (k : Type*) {V : Type*} {P : Type*}
variables {ι : Type*}
include V

open affine_subspace finite_dimensional module

variables [division_ring k] [add_comm_group V] [module k V] [affine_space V P]

/-- The `vector_span` of a finite set is finite-dimensional. -/
lemma finite_dimensional_vector_span_of_finite {s : set P} (h : set.finite s) :
  finite_dimensional k (vector_span k s) :=
span_of_finite k $ h.vsub h

/-- The `vector_span` of a family indexed by a `fintype` is
finite-dimensional. -/
instance finite_dimensional_vector_span_range [_root_.finite ι] (p : ι → P) :
  finite_dimensional k (vector_span k (set.range p)) :=
finite_dimensional_vector_span_of_finite k (set.finite_range _)

/-- The `vector_span` of a subset of a family indexed by a `fintype`
is finite-dimensional. -/
instance finite_dimensional_vector_span_image_of_finite [_root_.finite ι] (p : ι → P)
  (s : set ι) : finite_dimensional k (vector_span k (p '' s)) :=
finite_dimensional_vector_span_of_finite k (set.to_finite _)

/-- The direction of the affine span of a finite set is
finite-dimensional. -/
lemma finite_dimensional_direction_affine_span_of_finite {s : set P} (h : set.finite s) :
  finite_dimensional k (affine_span k s).direction :=
(direction_affine_span k s).symm ▸ finite_dimensional_vector_span_of_finite k h

/-- The direction of the affine span of a family indexed by a
`fintype` is finite-dimensional. -/
instance finite_dimensional_direction_affine_span_range [_root_.finite ι] (p : ι → P) :
  finite_dimensional k (affine_span k (set.range p)).direction :=
finite_dimensional_direction_affine_span_of_finite k (set.finite_range _)

/-- The direction of the affine span of a subset of a family indexed
by a `fintype` is finite-dimensional. -/
instance finite_dimensional_direction_affine_span_image_of_finite [_root_.finite ι] (p : ι → P)
  (s : set ι) : finite_dimensional k (affine_span k (p '' s)).direction :=
finite_dimensional_direction_affine_span_of_finite k (set.to_finite _)

/-- An affine-independent family of points in a finite-dimensional affine space is finite. -/
lemma finite_of_fin_dim_affine_independent [finite_dimensional k V] {p : ι → P}
  (hi : affine_independent k p) : _root_.finite ι :=
begin
  nontriviality ι, inhabit ι,
  rw affine_independent_iff_linear_independent_vsub k p default at hi,
  letI : is_noetherian k V := is_noetherian.iff_fg.2 infer_instance,
  exact (set.finite_singleton default).finite_of_compl
    (set.finite_coe_iff.1 hi.finite_of_is_noetherian)
end

/-- An affine-independent subset of a finite-dimensional affine space is finite. -/
lemma finite_set_of_fin_dim_affine_independent [finite_dimensional k V] {s : set ι} {f : s → P}
  (hi : affine_independent k f) : s.finite :=
@set.to_finite _ s (finite_of_fin_dim_affine_independent k hi)

open_locale classical
variables {k}

/-- The `vector_span` of a finite subset of an affinely independent
family has dimension one less than its cardinality. -/
lemma affine_independent.finrank_vector_span_image_finset {p : ι → P}
  (hi : affine_independent k p) {s : finset ι} {n : ℕ} (hc : finset.card s = n + 1) :
  finrank k (vector_span k (s.image p : set P)) = n :=
begin
  have hi' := hi.range.mono (set.image_subset_range p ↑s),
  have hc' : (s.image p).card = n + 1,
  { rwa s.card_image_of_injective hi.injective },
  have hn : (s.image p).nonempty,
  { simp [hc', ←finset.card_pos] },
  rcases hn with ⟨p₁, hp₁⟩,
  have hp₁' : p₁ ∈ p '' s := by simpa using hp₁,
  rw [affine_independent_set_iff_linear_independent_vsub k hp₁', ← finset.coe_singleton,
      ← finset.coe_image, ← finset.coe_sdiff, finset.sdiff_singleton_eq_erase,
      ← finset.coe_image] at hi',
  have hc : (finset.image (λ (p : P), p -ᵥ p₁) ((finset.image p s).erase p₁)).card = n,
  { rw [finset.card_image_of_injective _ (vsub_left_injective _),
        finset.card_erase_of_mem hp₁],
    exact nat.pred_eq_of_eq_succ hc' },
  rwa [vector_span_eq_span_vsub_finset_right_ne k hp₁, finrank_span_finset_eq_card, hc]
end

/-- The `vector_span` of a finite affinely independent family has
dimension one less than its cardinality. -/
lemma affine_independent.finrank_vector_span [fintype ι] {p : ι → P}
  (hi : affine_independent k p) {n : ℕ} (hc : fintype.card ι = n + 1) :
  finrank k (vector_span k (set.range p)) = n :=
begin
  rw ← finset.card_univ at hc,
  rw [← set.image_univ, ← finset.coe_univ, ← finset.coe_image],
  exact hi.finrank_vector_span_image_finset hc
end

/-- The `vector_span` of a finite affinely independent family whose
cardinality is one more than that of the finite-dimensional space is
`⊤`. -/
lemma affine_independent.vector_span_eq_top_of_card_eq_finrank_add_one [finite_dimensional k V]
  [fintype ι] {p : ι → P} (hi : affine_independent k p) (hc : fintype.card ι = finrank k V + 1) :
  vector_span k (set.range p) = ⊤ :=
eq_top_of_finrank_eq $ hi.finrank_vector_span hc

variables (k)

/-- The `vector_span` of `n + 1` points in an indexed family has
dimension at most `n`. -/
lemma finrank_vector_span_image_finset_le (p : ι → P) (s : finset ι) {n : ℕ}
  (hc : finset.card s = n + 1) : finrank k (vector_span k (s.image p : set P)) ≤ n :=
begin
  have hn : (s.image p).nonempty,
  { rw [finset.nonempty.image_iff, ← finset.card_pos, hc], apply nat.succ_pos },
  rcases hn with ⟨p₁, hp₁⟩,
  rw [vector_span_eq_span_vsub_finset_right_ne k hp₁],
  refine le_trans (finrank_span_finset_le_card (((s.image p).erase p₁).image (λ p, p -ᵥ p₁))) _,
  rw [finset.card_image_of_injective _ (vsub_left_injective p₁), finset.card_erase_of_mem hp₁,
      tsub_le_iff_right, ← hc],
  apply finset.card_image_le
end

/-- The `vector_span` of an indexed family of `n + 1` points has
dimension at most `n`. -/
lemma finrank_vector_span_range_le [fintype ι] (p : ι → P) {n : ℕ}
  (hc : fintype.card ι = n + 1) : finrank k (vector_span k (set.range p)) ≤ n :=
begin
  rw [←set.image_univ, ←finset.coe_univ, ← finset.coe_image],
  rw ←finset.card_univ at hc,
  exact finrank_vector_span_image_finset_le _ _ _ hc
end

/-- `n + 1` points are affinely independent if and only if their
`vector_span` has dimension `n`. -/
lemma affine_independent_iff_finrank_vector_span_eq [fintype ι] (p : ι → P) {n : ℕ}
  (hc : fintype.card ι = n + 1) :
  affine_independent k p ↔ finrank k (vector_span k (set.range p)) = n :=
begin
  have hn : nonempty ι, by simp [←fintype.card_pos_iff, hc],
  cases hn with i₁,
  rw [affine_independent_iff_linear_independent_vsub _ _ i₁,
      linear_independent_iff_card_eq_finrank_span, eq_comm,
      vector_span_range_eq_span_range_vsub_right_ne k p i₁],
  congr',
  rw ←finset.card_univ at hc,
  rw fintype.subtype_card,
  simp [finset.filter_ne', finset.card_erase_of_mem, hc]
end

/-- `n + 1` points are affinely independent if and only if their
`vector_span` has dimension at least `n`. -/
lemma affine_independent_iff_le_finrank_vector_span [fintype ι] (p : ι → P) {n : ℕ}
  (hc : fintype.card ι = n + 1) :
  affine_independent k p ↔ n ≤ finrank k (vector_span k (set.range p)) :=
begin
  rw affine_independent_iff_finrank_vector_span_eq k p hc,
  split,
  { rintro rfl,
    refl },
  { exact λ hle, le_antisymm (finrank_vector_span_range_le k p hc) hle }
end

/-- `n + 2` points are affinely independent if and only if their
`vector_span` does not have dimension at most `n`. -/
lemma affine_independent_iff_not_finrank_vector_span_le [fintype ι] (p : ι → P) {n : ℕ}
  (hc : fintype.card ι = n + 2) :
  affine_independent k p ↔ ¬ finrank k (vector_span k (set.range p)) ≤ n :=
by rw [affine_independent_iff_le_finrank_vector_span k p hc, ←nat.lt_iff_add_one_le, lt_iff_not_ge]

/-- `n + 2` points have a `vector_span` with dimension at most `n` if
and only if they are not affinely independent. -/
lemma finrank_vector_span_le_iff_not_affine_independent [fintype ι] (p : ι → P) {n : ℕ}
  (hc : fintype.card ι = n + 2) :
  finrank k (vector_span k (set.range p)) ≤ n ↔ ¬ affine_independent k p :=
(not_iff_comm.1 (affine_independent_iff_not_finrank_vector_span_le k p hc).symm).symm

variables {k}

/-- If the `vector_span` of a finite subset of an affinely independent
family lies in a submodule with dimension one less than its
cardinality, it equals that submodule. -/
lemma affine_independent.vector_span_image_finset_eq_of_le_of_card_eq_finrank_add_one
  {p : ι → P} (hi : affine_independent k p) {s : finset ι} {sm : submodule k V}
  [finite_dimensional k sm] (hle : vector_span k (s.image p : set P) ≤ sm)
  (hc : finset.card s = finrank k sm + 1) : vector_span k (s.image p : set P) = sm :=
eq_of_le_of_finrank_eq hle $ hi.finrank_vector_span_image_finset hc

/-- If the `vector_span` of a finite affinely independent
family lies in a submodule with dimension one less than its
cardinality, it equals that submodule. -/
lemma affine_independent.vector_span_eq_of_le_of_card_eq_finrank_add_one [fintype ι]
  {p : ι → P} (hi : affine_independent k p) {sm : submodule k V} [finite_dimensional k sm]
  (hle : vector_span k (set.range p) ≤ sm) (hc : fintype.card ι = finrank k sm + 1) :
  vector_span k (set.range p) = sm :=
eq_of_le_of_finrank_eq hle $ hi.finrank_vector_span hc

/-- If the `affine_span` of a finite subset of an affinely independent
family lies in an affine subspace whose direction has dimension one
less than its cardinality, it equals that subspace. -/
lemma affine_independent.affine_span_image_finset_eq_of_le_of_card_eq_finrank_add_one
  {p : ι → P} (hi : affine_independent k p) {s : finset ι} {sp : affine_subspace k P}
  [finite_dimensional k sp.direction] (hle : affine_span k (s.image p : set P) ≤ sp)
  (hc : finset.card s = finrank k sp.direction + 1) : affine_span k (s.image p : set P) = sp :=
begin
  have hn : s.nonempty,
  { rw [←finset.card_pos, hc], apply nat.succ_pos },
  refine eq_of_direction_eq_of_nonempty_of_le _ ((hn.image _).to_set.affine_span _)hle,
  have hd := direction_le hle,
  rw direction_affine_span at ⊢ hd,
  exact hi.vector_span_image_finset_eq_of_le_of_card_eq_finrank_add_one hd hc
end

/-- If the `affine_span` of a finite affinely independent family lies
in an affine subspace whose direction has dimension one less than its
cardinality, it equals that subspace. -/
lemma affine_independent.affine_span_eq_of_le_of_card_eq_finrank_add_one [fintype ι]
  {p : ι → P} (hi : affine_independent k p) {sp : affine_subspace k P}
  [finite_dimensional k sp.direction] (hle : affine_span k (set.range p) ≤ sp)
  (hc : fintype.card ι = finrank k sp.direction + 1) : affine_span k (set.range p) = sp :=
begin
  rw ←finset.card_univ at hc,
  rw [←set.image_univ, ←finset.coe_univ, ← finset.coe_image] at ⊢ hle,
  exact hi.affine_span_image_finset_eq_of_le_of_card_eq_finrank_add_one hle hc
end

/-- The `affine_span` of a finite affinely independent family is `⊤` iff the
family's cardinality is one more than that of the finite-dimensional space. -/
lemma affine_independent.affine_span_eq_top_iff_card_eq_finrank_add_one [finite_dimensional k V]
  [fintype ι] {p : ι → P} (hi : affine_independent k p) :
  affine_span k (set.range p) = ⊤ ↔ fintype.card ι = finrank k V + 1 :=
begin
  split,
  { intros h_tot,
    let n := fintype.card ι - 1,
    have hn : fintype.card ι = n + 1,
    { exact (nat.succ_pred_eq_of_pos (card_pos_of_affine_span_eq_top k V P h_tot)).symm, },
    rw [hn, ← finrank_top, ← (vector_span_eq_top_of_affine_span_eq_top k V P) h_tot,
      ← hi.finrank_vector_span hn], },
  { intros hc,
    rw [← finrank_top, ← direction_top k V P] at hc,
    exact hi.affine_span_eq_of_le_of_card_eq_finrank_add_one le_top hc, },
end

lemma affine.simplex.span_eq_top [finite_dimensional k V] {n : ℕ} (T : affine.simplex k V n)
  (hrank : finrank k V = n) :
  affine_span k (set.range T.points) = ⊤ :=
by rw [affine_independent.affine_span_eq_top_iff_card_eq_finrank_add_one T.independent,
  fintype.card_fin, hrank]

/-- The `vector_span` of adding a point to a finite-dimensional subspace is finite-dimensional. -/
instance finite_dimensional_vector_span_insert (s : affine_subspace k P)
  [finite_dimensional k s.direction] (p : P) :
  finite_dimensional k (vector_span k (insert p (s : set P))) :=
begin
  rw [←direction_affine_span, ←affine_span_insert_affine_span],
  rcases (s : set P).eq_empty_or_nonempty with hs | ⟨p₀, hp₀⟩,
  { rw coe_eq_bot_iff at hs,
    rw [hs, bot_coe, span_empty, bot_coe, direction_affine_span],
    convert finite_dimensional_bot _ _;
      simp },
  { rw [affine_span_coe, direction_affine_span_insert hp₀],
    apply_instance }
end

/-- The direction of the affine span of adding a point to a finite-dimensional subspace is
finite-dimensional. -/
instance finite_dimensional_direction_affine_span_insert (s : affine_subspace k P)
  [finite_dimensional k s.direction] (p : P) :
  finite_dimensional k (affine_span k (insert p (s : set P))).direction :=
(direction_affine_span k (insert p (s : set P))).symm ▸ finite_dimensional_vector_span_insert s p

variables (k)

/-- The `vector_span` of adding a point to a set with a finite-dimensional `vector_span` is
finite-dimensional. -/
instance finite_dimensional_vector_span_insert_set (s : set P)
  [finite_dimensional k (vector_span k s)] (p : P) :
  finite_dimensional k (vector_span k (insert p s)) :=
begin
  haveI : finite_dimensional k (affine_span k s).direction :=
    (direction_affine_span k s).symm ▸ infer_instance,
  rw [←direction_affine_span, ←affine_span_insert_affine_span, direction_affine_span],
  exact finite_dimensional_vector_span_insert (affine_span k s) p
end

/-- A set of points is collinear if their `vector_span` has dimension
at most `1`. -/
def collinear (s : set P) : Prop := module.rank k (vector_span k s) ≤ 1

/-- The definition of `collinear`. -/
lemma collinear_iff_dim_le_one (s : set P) : collinear k s ↔ module.rank k (vector_span k s) ≤ 1 :=
iff.rfl

variables {k}

/-- A set of points, whose `vector_span` is finite-dimensional, is
collinear if and only if their `vector_span` has dimension at most
`1`. -/
lemma collinear_iff_finrank_le_one {s : set P} [finite_dimensional k (vector_span k s)] :
  collinear k s ↔ finrank k (vector_span k s) ≤ 1 :=
begin
  have h := collinear_iff_dim_le_one k s,
  rw ←finrank_eq_dim at h,
  exact_mod_cast h
end

alias collinear_iff_finrank_le_one ↔ collinear.finrank_le_one _

/-- A subset of a collinear set is collinear. -/
lemma collinear.subset {s₁ s₂ : set P} (hs : s₁ ⊆ s₂) (h : collinear k s₂) : collinear k s₁ :=
(dim_le_of_submodule (vector_span k s₁) (vector_span k s₂) (vector_span_mono k hs)).trans h

/-- The `vector_span` of collinear points is finite-dimensional. -/
lemma collinear.finite_dimensional_vector_span {s : set P} (h : collinear k s) :
  finite_dimensional k (vector_span k s) :=
is_noetherian.iff_fg.1
  (is_noetherian.iff_dim_lt_aleph_0.2 (lt_of_le_of_lt h cardinal.one_lt_aleph_0))

/-- The direction of the affine span of collinear points is finite-dimensional. -/
lemma collinear.finite_dimensional_direction_affine_span {s : set P} (h : collinear k s) :
  finite_dimensional k (affine_span k s).direction :=
(direction_affine_span k s).symm ▸ h.finite_dimensional_vector_span

variables (k P)

/-- The empty set is collinear. -/
lemma collinear_empty : collinear k (∅ : set P) :=
begin
  rw [collinear_iff_dim_le_one, vector_span_empty],
  simp
end

variables {P}

/-- A single point is collinear. -/
lemma collinear_singleton (p : P) : collinear k ({p} : set P) :=
begin
  rw [collinear_iff_dim_le_one, vector_span_singleton],
  simp
end

variables {k}

/-- Given a point `p₀` in a set of points, that set is collinear if and
only if the points can all be expressed as multiples of the same
vector, added to `p₀`. -/
lemma collinear_iff_of_mem {s : set P} {p₀ : P} (h : p₀ ∈ s) :
  collinear k s ↔ ∃ v : V, ∀ p ∈ s, ∃ r : k, p = r • v +ᵥ p₀ :=
begin
  simp_rw [collinear_iff_dim_le_one, dim_submodule_le_one_iff', submodule.le_span_singleton_iff],
  split,
  { rintro ⟨v₀, hv⟩,
    use v₀,
    intros p hp,
    obtain ⟨r, hr⟩ := hv (p -ᵥ p₀) (vsub_mem_vector_span k hp h),
    use r,
    rw eq_vadd_iff_vsub_eq,
    exact hr.symm },
  { rintro ⟨v, hp₀v⟩,
    use v,
    intros w hw,
    have hs : vector_span k s ≤ k ∙ v,
    { rw [vector_span_eq_span_vsub_set_right k h, submodule.span_le, set.subset_def],
      intros x hx,
      rw [set_like.mem_coe, submodule.mem_span_singleton],
      rw set.mem_image at hx,
      rcases hx with ⟨p, hp, rfl⟩,
      rcases hp₀v p hp with ⟨r, rfl⟩,
      use r,
      simp },
    have hw' := set_like.le_def.1 hs hw,
    rwa submodule.mem_span_singleton at hw' }
end

/-- A set of points is collinear if and only if they can all be
expressed as multiples of the same vector, added to the same base
point. -/
lemma collinear_iff_exists_forall_eq_smul_vadd (s : set P) :
  collinear k s ↔ ∃ (p₀ : P) (v : V), ∀ p ∈ s, ∃ r : k, p = r • v +ᵥ p₀ :=
begin
  rcases set.eq_empty_or_nonempty s with rfl | ⟨⟨p₁, hp₁⟩⟩,
  { simp [collinear_empty] },
  { rw collinear_iff_of_mem hp₁,
    split,
    { exact λ h, ⟨p₁, h⟩ },
    { rintros ⟨p, v, hv⟩,
      use v,
      intros p₂ hp₂,
      rcases hv p₂ hp₂ with ⟨r, rfl⟩,
      rcases hv p₁ hp₁ with ⟨r₁, rfl⟩,
      use r - r₁,
      simp [vadd_vadd, ←add_smul] } }
end

variables (k)

/-- Two points are collinear. -/
lemma collinear_pair (p₁ p₂ : P) : collinear k ({p₁, p₂} : set P) :=
begin
  rw collinear_iff_exists_forall_eq_smul_vadd,
  use [p₁, p₂ -ᵥ p₁],
  intros p hp,
  rw [set.mem_insert_iff, set.mem_singleton_iff] at hp,
  cases hp,
  { use 0,
    simp [hp] },
  { use 1,
    simp [hp] }
end

variables {k}

/-- Three points are affinely independent if and only if they are not
collinear. -/
lemma affine_independent_iff_not_collinear {p : fin 3 → P} :
  affine_independent k p ↔ ¬ collinear k (set.range p) :=
by rw [collinear_iff_finrank_le_one,
       affine_independent_iff_not_finrank_vector_span_le k p (fintype.card_fin 3)]

/-- Three points are collinear if and only if they are not affinely
independent. -/
lemma collinear_iff_not_affine_independent {p : fin 3 → P} :
  collinear k (set.range p) ↔ ¬ affine_independent k p :=
by rw [collinear_iff_finrank_le_one,
       finrank_vector_span_le_iff_not_affine_independent k p (fintype.card_fin 3)]

/-- Three points are affinely independent if and only if they are not collinear. -/
lemma affine_independent_iff_not_collinear_set {p₁ p₂ p₃ : P} :
  affine_independent k ![p₁, p₂, p₃] ↔ ¬collinear k ({p₁, p₂, p₃} : set P) :=
by simp [affine_independent_iff_not_collinear, -set.union_singleton]

/-- Three points are collinear if and only if they are not affinely independent. -/
lemma collinear_iff_not_affine_independent_set {p₁ p₂ p₃ : P} :
  collinear k ({p₁, p₂, p₃} : set P) ↔ ¬affine_independent k ![p₁, p₂, p₃] :=
affine_independent_iff_not_collinear_set.not_left.symm

/-- Three points are affinely independent if and only if they are not collinear. -/
lemma affine_independent_iff_not_collinear_of_ne {p : fin 3 → P} {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂)
  (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
  affine_independent k p ↔ ¬collinear k ({p i₁, p i₂, p i₃} : set P) :=
begin
  have hu : (finset.univ : finset (fin 3)) = {i₁, i₂, i₃}, by dec_trivial!,
  rw [affine_independent_iff_not_collinear, ←set.image_univ, ←finset.coe_univ, hu,
      finset.coe_insert, finset.coe_insert, finset.coe_singleton, set.image_insert_eq,
      set.image_pair]
end

/-- Three points are collinear if and only if they are not affinely independent. -/
lemma collinear_iff_not_affine_independent_of_ne {p : fin 3 → P} {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂)
  (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
  collinear k ({p i₁, p i₂, p i₃} : set P) ↔ ¬affine_independent k p:=
(affine_independent_iff_not_collinear_of_ne h₁₂ h₁₃ h₂₃).not_left.symm

/-- If three points are not collinear, the first and second are different. -/
lemma ne₁₂_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear k ({p₁, p₂, p₃} : set P)) : p₁ ≠ p₂ :=
by { rintro rfl, simpa [collinear_pair] using h }

/-- If three points are not collinear, the first and third are different. -/
lemma ne₁₃_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear k ({p₁, p₂, p₃} : set P)) : p₁ ≠ p₃ :=
by { rintro rfl, simpa [collinear_pair] using h }

/-- If three points are not collinear, the second and third are different. -/
lemma ne₂₃_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear k ({p₁, p₂, p₃} : set P)) : p₂ ≠ p₃ :=
by { rintro rfl, simpa [collinear_pair] using h }

/-- A point in a collinear set of points lies in the affine span of any two distinct points of
that set. -/
lemma collinear.mem_affine_span_of_mem_of_ne {s : set P} (h : collinear k s) {p₁ p₂ p₃ : P}
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₁p₂ : p₁ ≠ p₂) :
  p₃ ∈ line[k, p₁, p₂] :=
begin
  rw collinear_iff_of_mem hp₁ at h,
  rcases h with ⟨v, h⟩,
  rcases h p₂ hp₂ with ⟨r₂, rfl⟩,
  rcases h p₃ hp₃ with ⟨r₃, rfl⟩,
  rw vadd_left_mem_affine_span_pair,
  refine ⟨r₃ / r₂, _⟩,
  have h₂ : r₂ ≠ 0,
  { rintro rfl,
    simpa using hp₁p₂ },
  simp [smul_smul, h₂]
end

/-- The affine span of any two distinct points of a collinear set of points equals the affine
span of the whole set. -/
lemma collinear.affine_span_eq_of_ne {s : set P} (h : collinear k s) {p₁ p₂ : P}
  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₁p₂ : p₁ ≠ p₂) :
  line[k, p₁, p₂] = affine_span k s :=
le_antisymm (affine_span_mono _
  (set.insert_subset.2 ⟨hp₁, set.singleton_subset_iff.2 hp₂⟩))
  (affine_span_le.2 (λ p hp, h.mem_affine_span_of_mem_of_ne hp₁ hp₂ hp hp₁p₂))

/-- Given a collinear set of points, and two distinct points `p₂` and `p₃` in it, a point `p₁` is
collinear with the set if and only if it is collinear with `p₂` and `p₃`. -/
lemma collinear.collinear_insert_iff_of_ne {s : set P} (h : collinear k s) {p₁ p₂ p₃ : P}
  (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₂p₃ : p₂ ≠ p₃) :
  collinear k (insert p₁ s) ↔ collinear k ({p₁, p₂, p₃} : set P) :=
begin
  have hv : vector_span k (insert p₁ s) = vector_span k ({p₁, p₂, p₃} : set P),
  { conv_lhs { rw [←direction_affine_span, ←affine_span_insert_affine_span] },
    conv_rhs { rw [←direction_affine_span, ←affine_span_insert_affine_span] },
    rw h.affine_span_eq_of_ne hp₂ hp₃ hp₂p₃ },
  rw [collinear, collinear, hv]
end

/-- Adding a point in the affine span of a set does not change whether that set is collinear. -/
lemma collinear_insert_iff_of_mem_affine_span {s : set P} {p : P} (h : p ∈ affine_span k s) :
  collinear k (insert p s) ↔ collinear k s :=
by rw [collinear, collinear, vector_span_insert_eq_vector_span h]

/-- If a point lies in the affine span of two points, those three points are collinear. -/
lemma collinear_insert_of_mem_affine_span_pair {p₁ p₂ p₃ : P} (h : p₁ ∈ line[k, p₂, p₃]) :
  collinear k ({p₁, p₂, p₃} : set P) :=
begin
  rw collinear_insert_iff_of_mem_affine_span h,
  exact collinear_pair _ _ _
end

/-- If two points lie in the affine span of two points, those four points are collinear. -/
lemma collinear_insert_insert_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ : P}
  (h₁ : p₁ ∈ line[k, p₃, p₄]) (h₂ : p₂ ∈ line[k, p₃, p₄]) :
  collinear k ({p₁, p₂, p₃, p₄} : set P) :=
begin
  rw [collinear_insert_iff_of_mem_affine_span ((affine_subspace.le_def' _ _).1
        (affine_span_mono k (set.subset_insert _ _)) _ h₁),
      collinear_insert_iff_of_mem_affine_span h₂],
  exact collinear_pair _ _ _
end

/-- If three points lie in the affine span of two points, those five points are collinear. -/
lemma collinear_insert_insert_insert_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ p₅ : P}
  (h₁ : p₁ ∈ line[k, p₄, p₅]) (h₂ : p₂ ∈ line[k, p₄, p₅]) (h₃ : p₃ ∈ line[k, p₄, p₅]) :
  collinear k ({p₁, p₂, p₃, p₄, p₅} : set P) :=
begin
  rw [collinear_insert_iff_of_mem_affine_span ((affine_subspace.le_def' _ _).1
        (affine_span_mono k ((set.subset_insert _ _).trans (set.subset_insert _ _))) _ h₁),
      collinear_insert_iff_of_mem_affine_span ((affine_subspace.le_def' _ _).1
        (affine_span_mono k (set.subset_insert _ _)) _ h₂),
      collinear_insert_iff_of_mem_affine_span h₃],
  exact collinear_pair _ _ _
end

/-- If three points lie in the affine span of two points, the first four points are collinear. -/
lemma collinear_insert_insert_insert_left_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ p₅ : P}
  (h₁ : p₁ ∈ line[k, p₄, p₅]) (h₂ : p₂ ∈ line[k, p₄, p₅]) (h₃ : p₃ ∈ line[k, p₄, p₅]) :
  collinear k ({p₁, p₂, p₃, p₄} : set P) :=
begin
  refine (collinear_insert_insert_insert_of_mem_affine_span_pair h₁ h₂ h₃).subset _,
  simp [set.insert_subset_insert]
end

/-- If three points lie in the affine span of two points, the first three points are collinear. -/
lemma collinear_triple_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ p₅ : P}
  (h₁ : p₁ ∈ line[k, p₄, p₅]) (h₂ : p₂ ∈ line[k, p₄, p₅]) (h₃ : p₃ ∈ line[k, p₄, p₅]) :
  collinear k ({p₁, p₂, p₃} : set P) :=
begin
  refine (collinear_insert_insert_insert_left_of_mem_affine_span_pair h₁ h₂ h₃).subset _,
  simp [set.insert_subset_insert]
end

variables (k)

/-- A set of points is coplanar if their `vector_span` has dimension at most `2`. -/
def coplanar (s : set P) : Prop := module.rank k (vector_span k s) ≤ 2

variables {k}

/-- The `vector_span` of coplanar points is finite-dimensional. -/
lemma coplanar.finite_dimensional_vector_span {s : set P} (h : coplanar k s) :
  finite_dimensional k (vector_span k s) :=
begin
  refine is_noetherian.iff_fg.1 (is_noetherian.iff_dim_lt_aleph_0.2 (lt_of_le_of_lt h _)),
  simp,
end

/-- The direction of the affine span of coplanar points is finite-dimensional. -/
lemma coplanar.finite_dimensional_direction_affine_span {s : set P} (h : coplanar k s) :
  finite_dimensional k (affine_span k s).direction :=
(direction_affine_span k s).symm ▸ h.finite_dimensional_vector_span

/-- A set of points, whose `vector_span` is finite-dimensional, is coplanar if and only if their
`vector_span` has dimension at most `2`. -/
lemma coplanar_iff_finrank_le_two {s : set P} [finite_dimensional k (vector_span k s)] :
  coplanar k s ↔ finrank k (vector_span k s) ≤ 2 :=
begin
  have h : coplanar k s ↔ module.rank k (vector_span k s) ≤ 2 := iff.rfl,
  rw ←finrank_eq_dim at h,
  exact_mod_cast h
end

alias coplanar_iff_finrank_le_two ↔ coplanar.finrank_le_two _

/-- A subset of a coplanar set is coplanar. -/
lemma coplanar.subset {s₁ s₂ : set P} (hs : s₁ ⊆ s₂) (h : coplanar k s₂) : coplanar k s₁ :=
(dim_le_of_submodule (vector_span k s₁) (vector_span k s₂) (vector_span_mono k hs)).trans h

/-- Collinear points are coplanar. -/
lemma collinear.coplanar {s : set P} (h : collinear k s) : coplanar k s :=
le_trans h one_le_two

variables (k) (P)

/-- The empty set is coplanar. -/
lemma coplanar_empty : coplanar k (∅ : set P) :=
(collinear_empty k P).coplanar

variables {P}

/-- A single point is coplanar. -/
lemma coplanar_singleton (p : P) : coplanar k ({p} : set P) :=
(collinear_singleton k p).coplanar

/-- Two points are coplanar. -/
lemma coplanar_pair (p₁ p₂ : P) : coplanar k ({p₁, p₂} : set P) :=
(collinear_pair k p₁ p₂).coplanar

variables {k}

/-- Adding a point in the affine span of a set does not change whether that set is coplanar. -/
lemma coplanar_insert_iff_of_mem_affine_span {s : set P} {p : P} (h : p ∈ affine_span k s) :
  coplanar k (insert p s) ↔ coplanar k s :=
by rw [coplanar, coplanar, vector_span_insert_eq_vector_span h]

end affine_space'

section division_ring

variables {k : Type*} {V : Type*} {P : Type*}
include V

open affine_subspace finite_dimensional module

variables [division_ring k] [add_comm_group V] [module k V] [affine_space V P]

/-- Adding a point to a finite-dimensional subspace increases the dimension by at most one. -/
lemma finrank_vector_span_insert_le (s : affine_subspace k P) (p : P) :
  finrank k (vector_span k (insert p (s : set P))) ≤ finrank k s.direction + 1 :=
begin
  by_cases hf : finite_dimensional k s.direction, swap,
  { have hf' : ¬finite_dimensional k (vector_span k (insert p (s : set P))),
    { intro h,
      have h' : s.direction ≤ vector_span k (insert p (s : set P)),
      { conv_lhs { rw [←affine_span_coe s, direction_affine_span] },
        exact vector_span_mono k (set.subset_insert _ _) },
      exactI hf (submodule.finite_dimensional_of_le h') },
    rw [finrank_of_infinite_dimensional hf, finrank_of_infinite_dimensional hf', zero_add],
    exact zero_le_one },
  haveI := hf,
  rw [←direction_affine_span, ←affine_span_insert_affine_span],
  rcases (s : set P).eq_empty_or_nonempty with hs | ⟨p₀, hp₀⟩,
  { rw coe_eq_bot_iff at hs,
    rw [hs, bot_coe, span_empty, bot_coe, direction_affine_span, direction_bot, finrank_bot,
        zero_add],
    convert zero_le_one' ℕ,
    rw ←finrank_bot k V,
    convert rfl;
      simp },
  { rw [affine_span_coe, direction_affine_span_insert hp₀, add_comm],
    refine (submodule.dim_add_le_dim_add_dim _ _).trans (add_le_add_right _ _),
    refine finrank_le_one ⟨p -ᵥ p₀, submodule.mem_span_singleton_self _⟩ (λ v, _),
    have h := v.property,
    rw submodule.mem_span_singleton at h,
    rcases h with ⟨c, hc⟩,
    refine ⟨c, _⟩,
    ext,
    exact hc }
end

variables (k)

/-- Adding a point to a set with a finite-dimensional span increases the dimension by at most
one. -/
lemma finrank_vector_span_insert_le_set (s : set P) (p : P) :
  finrank k (vector_span k (insert p s)) ≤ finrank k (vector_span k s) + 1 :=
begin
  rw [←direction_affine_span, ←affine_span_insert_affine_span, direction_affine_span],
  refine (finrank_vector_span_insert_le _ _).trans (add_le_add_right _ _),
  rw direction_affine_span
end

variables {k}

/-- Adding a point to a collinear set produces a coplanar set. -/
lemma collinear.coplanar_insert {s : set P} (h : collinear k s) (p : P) :
  coplanar k (insert p s) :=
begin
  haveI := h.finite_dimensional_vector_span,
  rw [coplanar_iff_finrank_le_two],
  exact (finrank_vector_span_insert_le_set k s p).trans (add_le_add_right h.finrank_le_one _)
end

/-- A set of points in a two-dimensional space is coplanar. -/
lemma coplanar_of_finrank_eq_two (s : set P) (h : finrank k V = 2) : coplanar k s :=
begin
  haveI := finite_dimensional_of_finrank_eq_succ h,
  rw [coplanar_iff_finrank_le_two, ←h],
  exact submodule.finrank_le _
end

/-- A set of points in a two-dimensional space is coplanar. -/
lemma coplanar_of_fact_finrank_eq_two (s : set P) [h : fact (finrank k V = 2)] : coplanar k s :=
coplanar_of_finrank_eq_two s h.out

variables (k)

/-- Three points are coplanar. -/
lemma coplanar_triple (p₁ p₂ p₃ : P) : coplanar k ({p₁, p₂, p₃} : set P) :=
(collinear_pair k p₂ p₃).coplanar_insert p₁

end division_ring

namespace affine_basis

universes u₁ u₂ u₃ u₄

variables {ι : Type u₁} {k : Type u₂} {V : Type u₃} {P : Type u₄}
variables [add_comm_group V] [affine_space V P]

section division_ring

variables [division_ring k] [module k V]
include V

protected

protected lemma finite [finite_dimensional k V] (b : affine_basis ι k P) : finite ι :=
finite_of_fin_dim_affine_independent k b.ind

protected lemma finite_set [finite_dimensional k V] {s : set ι} (b : affine_basis s k P) :
  s.finite :=
finite_set_of_fin_dim_affine_independent k b.ind

lemma card_eq_finrank_add_one [fintype ι] (b : affine_basis ι k P) :
  fintype.card ι = finite_dimensional.finrank k V + 1 :=
begin
  haveI := b.finite_dimensional,
  exact b.ind.affine_span_eq_top_iff_card_eq_finrank_add_one.mp b.tot
end

variables {k V P}

lemma exists_affine_basis_of_finite_dimensional [fintype ι] [finite_dimensional k V]
  (h : fintype.card ι = finite_dimensional.finrank k V + 1) :
  nonempty (affine_basis ι k P) :=
begin
  obtain ⟨s, b, hb⟩ := affine_basis.exists_affine_basis k V P,
  lift s to finset P using b.finite_set,
  refine ⟨b.reindex $ fintype.equiv_of_card_eq _⟩,
  rw [h, ← b.card_eq_finrank_add_one]
end

end division_ring

end affine_basis


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Aaron Anderson
-/
import data.finsupp.basic

/-!
# Pointwise order on finitely supported functions

This file lifts order structures on `α` to `ι →₀ α`.

## Main declarations

* `finsupp.order_embedding_to_fun`: The order embedding from finitely supported functions to
  functions.
* `finsupp.order_iso_multiset`: The order isomorphism between `ℕ`-valued finitely supported
  functions and multisets.
-/

noncomputable theory
open_locale classical big_operators

open finset

variables {ι α : Type*}

namespace finsupp

/-! ### Order structures -/

section has_zero
variables [has_zero α]

section has_le
variables [has_le α]
instance : has_le (ι →₀ α) := ⟨λ f g, ∀ i, f i ≤ g i⟩

lemma le_def {f g : ι →₀ α} : f ≤ g ↔ ∀ i, f i ≤ g i := iff.rfl

/-- The order on `finsupp`s over a partial order embeds into the order on functions -/
def order_embedding_to_fun : (ι →₀ α) ↪o (ι → α) :=
{ to_fun := λ f, f,
  inj' := λ f g h, finsupp.ext $ λ i, by { dsimp at h, rw h },
  map_rel_iff' := λ a b, (@le_def _ _ _ _ a b).symm }

@[simp] lemma order_embedding_to_fun_apply {f : ι →₀ α} {i : ι} :
  order_embedding_to_fun f i = f i := rfl

end has_le

section preorder
variables [preorder α]

instance : preorder (ι →₀ α) :=
{ le_refl := λ f i, le_rfl,
  le_trans := λ f g h hfg hgh i, (hfg i).trans (hgh i),
  .. finsupp.has_le }

lemma monotone_to_fun : monotone (finsupp.to_fun : (ι →₀ α) → (ι → α)) := λ f g h a, le_def.1 h a

end preorder

instance [partial_order α] : partial_order (ι →₀ α) :=
{ le_antisymm := λ f g hfg hgf, ext $ λ i, (hfg i).antisymm (hgf i),
  .. finsupp.preorder }

instance [semilattice_inf α] : semilattice_inf (ι →₀ α) :=
{ inf := zip_with (⊓) inf_idem,
  inf_le_left := λ f g i, inf_le_left,
  inf_le_right := λ f g i, inf_le_right,
  le_inf := λ f g i h1 h2 s, le_inf (h1 s) (h2 s),
  ..finsupp.partial_order, }

@[simp] lemma inf_apply [semilattice_inf α] {i : ι} {f g : ι →₀ α} : (f ⊓ g) i = f i ⊓ g i := rfl

instance [semilattice_sup α] : semilattice_sup (ι →₀ α) :=
{ sup := zip_with (⊔) sup_idem,
  le_sup_left := λ f g i, le_sup_left,
  le_sup_right := λ f g i, le_sup_right,
  sup_le := λ f g h hf hg i, sup_le (hf i) (hg i),
  ..finsupp.partial_order }

@[simp] lemma sup_apply [semilattice_sup α] {i : ι} {f g : ι →₀ α} : (f ⊔ g) i = f i ⊔ g i := rfl

instance lattice [lattice α] : lattice (ι →₀ α) :=
{ .. finsupp.semilattice_inf, .. finsupp.semilattice_sup }

end has_zero

/-! ### Algebraic order structures -/

instance [ordered_add_comm_monoid α] : ordered_add_comm_monoid (ι →₀ α) :=
{ add_le_add_left := λ a b h c s, add_le_add_left (h s) (c s),
  .. finsupp.add_comm_monoid, .. finsupp.partial_order }

instance [ordered_cancel_add_comm_monoid α] : ordered_cancel_add_comm_monoid (ι →₀ α) :=
{ le_of_add_le_add_left := λ f g i h s, le_of_add_le_add_left (h s),
  add_left_cancel := λ f g i h, ext $ λ s, add_left_cancel (ext_iff.1 h s),
  .. finsupp.ordered_add_comm_monoid }

instance [ordered_add_comm_monoid α] [contravariant_class α α (+) (≤)] :
  contravariant_class (ι →₀ α) (ι →₀ α) (+) (≤) :=
⟨λ f g h H x, le_of_add_le_add_left $ H x⟩

section canonically_ordered_add_monoid
variables [canonically_ordered_add_monoid α]

instance : order_bot (ι →₀ α) :=
{ bot := 0,
  bot_le := by simp only [le_def, coe_zero, pi.zero_apply, implies_true_iff, zero_le]}

protected lemma bot_eq_zero : (⊥ : ι →₀ α) = 0 := rfl

@[simp] lemma add_eq_zero_iff (f g : ι →₀ α) : f + g = 0 ↔ f = 0 ∧ g = 0 :=
by simp [ext_iff, forall_and_distrib]

lemma le_iff' (f g : ι →₀ α) {s : finset ι} (hf : f.support ⊆ s) : f ≤ g ↔ ∀ i ∈ s, f i ≤ g i :=
⟨λ h s hs, h s,
λ h s, if H : s ∈ f.support then h s (hf H) else (not_mem_support_iff.1 H).symm ▸ zero_le (g s)⟩

lemma le_iff (f g : ι →₀ α) : f ≤ g ↔ ∀ i ∈ f.support, f i ≤ g i := le_iff' f g $ subset.refl _

instance decidable_le [decidable_rel (@has_le.le α _)] : decidable_rel (@has_le.le (ι →₀ α) _) :=
λ f g, decidable_of_iff _ (le_iff f g).symm

@[simp] lemma single_le_iff {i : ι} {x : α} {f : ι →₀ α} : single i x ≤ f ↔ x ≤ f i :=
(le_iff' _ _ support_single_subset).trans $ by simp

variables [has_sub α] [has_ordered_sub α] {f g : ι →₀ α} {i : ι} {a b : α}

/-- This is called `tsub` for truncated subtraction, to distinguish it with subtraction in an
additive group. -/
instance tsub : has_sub (ι →₀ α) := ⟨zip_with (λ m n, m - n) (tsub_self 0)⟩

instance : has_ordered_sub (ι →₀ α) := ⟨λ n m k, forall_congr $ λ x, tsub_le_iff_right⟩

instance : canonically_ordered_add_monoid (ι →₀ α) :=
{ le_iff_exists_add := λ f g, begin
      refine ⟨λ h, ⟨g - f, _⟩, _⟩,
      { ext x,
        exact (add_tsub_cancel_of_le $ h x).symm },
      { rintro ⟨g, rfl⟩ x,
        exact self_le_add_right (f x) (g x) }
    end,
 .. finsupp.order_bot,
 .. finsupp.ordered_add_comm_monoid }

@[simp] lemma coe_tsub (f g : ι →₀ α) : ⇑(f - g) = f - g := rfl

lemma tsub_apply (f g : ι →₀ α) (a : ι) : (f - g) a = f a - g a := rfl

@[simp] lemma single_tsub : single i (a - b) = single i a - single i b :=
begin
  ext j,
  obtain rfl | h := eq_or_ne i j,
  { rw [tsub_apply, single_eq_same, single_eq_same, single_eq_same] },
  { rw [tsub_apply, single_eq_of_ne h, single_eq_of_ne h, single_eq_of_ne h, tsub_self] }
end

lemma support_tsub {f1 f2 : ι →₀ α} : (f1 - f2).support ⊆ f1.support :=
by simp only [subset_iff, tsub_eq_zero_iff_le, mem_support_iff, ne.def, coe_tsub, pi.sub_apply,
    not_imp_not, zero_le, implies_true_iff] {contextual := tt}

lemma subset_support_tsub {f1 f2 : ι →₀ α} : f1.support \ f2.support ⊆ (f1 - f2).support :=
by simp [subset_iff] {contextual := tt}

end canonically_ordered_add_monoid

section canonically_linear_ordered_add_monoid
variables [canonically_linear_ordered_add_monoid α] [decidable_eq ι] {f g : ι →₀ α}

@[simp] lemma support_inf : (f ⊓ g).support = f.support ∩ g.support :=
begin
  ext,
  simp only [inf_apply, mem_support_iff,  ne.def,
    finset.mem_union, finset.mem_filter, finset.mem_inter],
  simp only [inf_eq_min, ←nonpos_iff_eq_zero, min_le_iff, not_or_distrib],
end

@[simp] lemma support_sup : (f ⊔ g).support = f.support ∪ g.support :=
begin
  ext,
  simp only [finset.mem_union, mem_support_iff, sup_apply, ne.def, ←bot_eq_zero],
  rw [_root_.sup_eq_bot_iff, not_and_distrib],
end

lemma disjoint_iff : disjoint f g ↔ disjoint f.support g.support :=
begin
  rw [disjoint_iff, disjoint_iff, finsupp.bot_eq_zero, ← finsupp.support_eq_empty,
    finsupp.support_inf],
  refl,
end

end canonically_linear_ordered_add_monoid

/-! ### Some lemmas about `ℕ` -/

section nat

lemma sub_single_one_add {a : ι} {u u' : ι →₀ ℕ} (h : u a ≠ 0) :
  u - single a 1 + u' = u + u' - single a 1 :=
tsub_add_eq_add_tsub $ single_le_iff.mpr $ nat.one_le_iff_ne_zero.mpr h

lemma add_sub_single_one {a : ι} {u u' : ι →₀ ℕ} (h : u' a ≠ 0) :
  u + (u' - single a 1) = u + u' - single a 1 :=
(add_tsub_assoc_of_le (single_le_iff.mpr $ nat.one_le_iff_ne_zero.mpr h) _).symm

end nat
end finsupp


section question9

variables A B C : Prop

example (h : C → A ∨ B) : (C ∧ ¬A) → B :=
begin
  intro h₁, -- N.B. What happens if you try `split` instead of `intro`?
  cases h₁ with h₂ h₃,
  have h₄ : A ∨ B, from h h₂, -- What happens if you write `h h₂` instead?
  cases h₄ with h₅ h₅, -- Or elimination.
  { exfalso,
    exact h₃ h₅,
    -- contradiction,
  },
  { exact h₅, },
end

end question9


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import algebra.order.field.basic
import data.fintype.lattice

/-!
# Lemmas about (finite domain) functions into fields.

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

We split this from `algebra.order.field.basic` to avoid importing the finiteness hierarchy there.
-/

variables {α ι : Type*} [linear_ordered_semifield α]

lemma pi.exists_forall_pos_add_lt [has_exists_add_of_le α] [finite ι] {x y : ι → α}
  (h : ∀ i, x i < y i) : ∃ ε, 0 < ε ∧ ∀ i, x i + ε < y i :=
begin
  casesI nonempty_fintype ι,
  casesI is_empty_or_nonempty ι,
  { exact ⟨1, zero_lt_one, is_empty_elim⟩ },
  choose ε hε hxε using λ i, exists_pos_add_of_lt' (h i),
  obtain rfl : x + ε = y := funext hxε,
  have hε : 0 < finset.univ.inf' finset.univ_nonempty ε := (finset.lt_inf'_iff _).2 (λ i _, hε _),
  exact ⟨_, half_pos hε, λ i, add_lt_add_left ((half_lt_self hε).trans_le $ finset.inf'_le _ $
    finset.mem_univ _) _⟩,
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.algebra.basic
import Mathlib.algebra.module.ordered
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Ordered algebras

An ordered algebra is an ordered semiring, which is an algebra over an ordered commutative semiring,
for which scalar multiplication is "compatible" with the two orders.

The prototypical example is 2x2 matrices over the reals or complexes (or indeed any C^* algebra)
where the ordering the one determined by the positive cone of positive operators,
i.e. `A ≤ B` iff `B - A = star R * R` for some `R`.
(We don't yet have this example in mathlib.)

## Implementation

Because the axioms for an ordered algebra are exactly the same as those for the underlying
module being ordered, we don't actually introduce a new class, but just use the `ordered_semimodule`
mixin.

## Tags

ordered algebra
-/

theorem algebra_map_monotone {R : Type u_1} {A : Type u_2} [ordered_comm_ring R] [ordered_ring A] [algebra R A] [ordered_semimodule R A] : monotone ⇑(algebra_map R A) := sorry

protected instance linear_ordered_comm_ring.to_ordered_semimodule {R : Type u_1} [linear_ordered_comm_ring R] : ordered_semimodule R R :=
  ordered_semimodule.mk ordered_semiring.mul_lt_mul_of_pos_left
    fun (a b c : R) (w₁ : c • a < c • b) (w₂ : 0 < c) => iff.mp (mul_lt_mul_left w₂) w₁


open classical
variable A : Prop
theorem dne ( h: not ( not A )) : A :=
by_contradiction
    (assume h1 : not A,
        show false, from h h1)
-- My theorem to prove ¬ (¬ ( A ∨ ¬ A)) --
theorem notnot : ¬ (¬ ( A ∨ ¬ A)) :=
(assume h1 :  ¬ (A ∨ ¬ A),
    have h2 : ¬ A, from
        assume h3 : A,
        have h4 : A ∨ ¬ A, from or.inl h3,
        show false, from h1 h4,
    have h5 : A ∨ ¬ A, from or.inr h2,
    show false, from h1 h5)
example : A ∨ ¬ A :=
have hN : not ( not ( A ∨ not A)), from notnot(A),-- Got ¬ (¬ ( A ∨ ¬ A)) using my theorem --
show A ∨ ¬ A,from dne(A ∨ not A) hN


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin

! This file was ported from Lean 3 source module data.mv_polynomial.counit
! leanprover-community/mathlib commit abb3121f210743a930dea73cd766d988079bdf8b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.MvPolynomial.Basic

/-!
## Counit morphisms for multivariate polynomials

One may consider the ring of multivariate polynomials `MvPolynomial A R` with coefficients in `R`
and variables indexed by `A`. If `A` is not just a type, but an algebra over `R`,
then there is a natural surjective algebra homomorphism `MvPolynomial A R →ₐ[R] A`
obtained by `X a ↦ a`.

### Main declarations

* `MvPolynomial.ACounit R A` is the natural surjective algebra homomorphism
  `MvPolynomial A R →ₐ[R] A` obtained by `X a ↦ a`
* `MvPolynomial.counit` is an “absolute” variant with `R = ℤ`
* `MvPolynomial.counitNat` is an “absolute” variant with `R = ℕ`

-/

namespace MvPolynomial

open Function

variable (A B R : Type _) [CommSemiring A] [CommSemiring B] [CommRing R] [Algebra A B]

/-- `MvPolynomial.ACounit A B` is the natural surjective algebra homomorphism
`MvPolynomial B A →ₐ[A] B` obtained by `X a ↦ a`.

See `MvPolynomial.counit` for the “absolute” variant with `A = ℤ`,
and `MvPolynomial.counitNat` for the “absolute” variant with `A = ℕ`. -/
noncomputable def ACounit : MvPolynomial B A →ₐ[A] B :=
  aeval id
#align mv_polynomial.acounit MvPolynomial.ACounit

variable {B}

@[simp]
theorem ACounit_X (b : B) : ACounit A B (X b) = b :=
  aeval_X _ b
set_option linter.uppercaseLean3 false in
#align mv_polynomial.acounit_X MvPolynomial.ACounit_X

variable {A} (B)

@[simp]
theorem ACounit_C (a : A) : ACounit A B (C a) = algebraMap A B a :=
  aeval_C _ a
set_option linter.uppercaseLean3 false in
#align mv_polynomial.acounit_C MvPolynomial.ACounit_C

variable (A)

theorem ACounit_surjective : Surjective (ACounit A B) := fun b => ⟨X b, ACounit_X A b⟩
#align mv_polynomial.acounit_surjective MvPolynomial.ACounit_surjective

/-- `MvPolynomial.counit R` is the natural surjective ring homomorphism
`MvPolynomial R ℤ →+* R` obtained by `X r ↦ r`.

See `MvPolynomial.ACounit` for a “relative” variant for algebras over a base ring,
and `MvPolynomial.counitNat` for the “absolute” variant with `R = ℕ`. -/
noncomputable def counit : MvPolynomial R ℤ →+* R :=
  (ACounit ℤ R).toRingHom
#align mv_polynomial.counit MvPolynomial.counit

/-- `MvPolynomial.counitNat A` is the natural surjective ring homomorphism
`MvPolynomial A ℕ →+* A` obtained by `X a ↦ a`.

See `MvPolynomial.ACounit` for a “relative” variant for algebras over a base ring
and `MvPolynomial.counit` for the “absolute” variant with `A = ℤ`. -/
noncomputable def counitNat : MvPolynomial A ℕ →+* A :=
  ACounit ℕ A
#align mv_polynomial.counit_nat MvPolynomial.counitNat

theorem counit_surjective : Surjective (counit R) :=
  ACounit_surjective ℤ R
#align mv_polynomial.counit_surjective MvPolynomial.counit_surjective

theorem counitNat_surjective : Surjective (counitNat A) :=
  ACounit_surjective ℕ A
#align mv_polynomial.counit_nat_surjective MvPolynomial.counitNat_surjective

theorem counitNat_C (n : ℕ) : counitNat A (C n) = n :=
  ACounit_C _ _
set_option linter.uppercaseLean3 false in
#align mv_polynomial.counit_nat_C MvPolynomial.counitNat_C

variable {R A}

@[simp]
theorem counit_X (r : R) : counit R (X r) = r :=
  ACounit_X _ _
set_option linter.uppercaseLean3 false in
#align mv_polynomial.counit_X MvPolynomial.counit_X

@[simp]
theorem counitNat_X (a : A) : counitNat A (X a) = a :=
  ACounit_X _ _
set_option linter.uppercaseLean3 false in
#align mv_polynomial.counit_nat_X MvPolynomial.counitNat_X

end MvPolynomial