/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kevin Kappelmann
-/
import data.int.lemmas
import data.set.intervals.group
import data.set.lattice
import tactic.abel
import tactic.linarith
import tactic.positivity

/-!
# Floor and ceil

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

## Summary

We define the natural- and integer-valued floor and ceil functions on linearly ordered rings.

## Main Definitions

* `floor_semiring`: An ordered semiring with natural-valued floor and ceil.
* `nat.floor a`: Greatest natural `n` such that `n ≤ a`. Equal to `0` if `a < 0`.
* `nat.ceil a`: Least natural `n` such that `a ≤ n`.

* `floor_ring`: A linearly ordered ring with integer-valued floor and ceil.
* `int.floor a`: Greatest integer `z` such that `z ≤ a`.
* `int.ceil a`: Least integer `z` such that `a ≤ z`.
* `int.fract a`: Fractional part of `a`, defined as `a - floor a`.
* `round a`: Nearest integer to `a`. It rounds halves towards infinity.

## Notations

* `⌊a⌋₊` is `nat.floor a`.
* `⌈a⌉₊` is `nat.ceil a`.
* `⌊a⌋` is `int.floor a`.
* `⌈a⌉` is `int.ceil a`.

The index `₊` in the notations for `nat.floor` and `nat.ceil` is used in analogy to the notation
for `nnnorm`.

## TODO

`linear_ordered_ring`/`linear_ordered_semiring` can be relaxed to `order_ring`/`order_semiring` in
many lemmas.

## Tags

rounding, floor, ceil
-/

open set
variables {F α β : Type*}

/-! ### Floor semiring -/

/-- A `floor_semiring` is an ordered semiring over `α` with a function
`floor : α → ℕ` satisfying `∀ (n : ℕ) (x : α), n ≤ ⌊x⌋ ↔ (n : α) ≤ x)`.
Note that many lemmas require a `linear_order`. Please see the above `TODO`. -/
class floor_semiring (α) [ordered_semiring α] :=
(floor : α → ℕ)
(ceil : α → ℕ)
(floor_of_neg {a : α} (ha : a < 0) : floor a = 0)
(gc_floor {a : α} {n : ℕ} (ha : 0 ≤ a) : n ≤ floor a ↔ (n : α) ≤ a)
(gc_ceil : galois_connection ceil coe)

instance : floor_semiring ℕ :=
{ floor := id,
  ceil := id,
  floor_of_neg := λ a ha, (a.not_lt_zero ha).elim,
  gc_floor := λ n a ha, by { rw nat.cast_id, refl },
  gc_ceil := λ n a, by { rw nat.cast_id, refl } }

namespace nat

section ordered_semiring
variables [ordered_semiring α] [floor_semiring α] {a : α} {n : ℕ}

/-- `⌊a⌋₊` is the greatest natural `n` such that `n ≤ a`. If `a` is negative, then `⌊a⌋₊ = 0`. -/
def floor : α → ℕ := floor_semiring.floor

/-- `⌈a⌉₊` is the least natural `n` such that `a ≤ n` -/
def ceil : α → ℕ := floor_semiring.ceil

@[simp] lemma floor_nat : (nat.floor : ℕ → ℕ) = id := rfl
@[simp] lemma ceil_nat : (nat.ceil : ℕ → ℕ) = id := rfl

notation `⌊` a `⌋₊` := nat.floor a
notation `⌈` a `⌉₊` := nat.ceil a

end ordered_semiring

section linear_ordered_semiring
variables [linear_ordered_semiring α] [floor_semiring α] {a : α} {n : ℕ}

lemma le_floor_iff (ha : 0 ≤ a) : n ≤ ⌊a⌋₊ ↔ (n : α) ≤ a := floor_semiring.gc_floor ha

lemma le_floor (h : (n : α) ≤ a) : n ≤ ⌊a⌋₊ := (le_floor_iff $ n.cast_nonneg.trans h).2 h

lemma floor_lt (ha : 0 ≤ a) : ⌊a⌋₊ < n ↔ a < n := lt_iff_lt_of_le_iff_le $ le_floor_iff ha

lemma floor_lt_one (ha : 0 ≤ a) : ⌊a⌋₊ < 1 ↔ a < 1 :=
(floor_lt ha).trans $ by rw nat.cast_one

lemma lt_of_floor_lt (h : ⌊a⌋₊ < n) : a < n := lt_of_not_le $ λ h', (le_floor h').not_lt h

lemma lt_one_of_floor_lt_one (h : ⌊a⌋₊ < 1) : a < 1 := by exact_mod_cast lt_of_floor_lt h

lemma floor_le (ha : 0 ≤ a) : (⌊a⌋₊ : α) ≤ a := (le_floor_iff ha).1 le_rfl

lemma lt_succ_floor (a : α) : a < ⌊a⌋₊.succ := lt_of_floor_lt $ nat.lt_succ_self _

lemma lt_floor_add_one (a : α) : a < ⌊a⌋₊ + 1 := by simpa using lt_succ_floor a

@[simp] lemma floor_coe (n : ℕ) : ⌊(n : α)⌋₊ = n :=
eq_of_forall_le_iff $ λ a, by { rw [le_floor_iff, nat.cast_le], exact n.cast_nonneg }

@[simp] lemma floor_zero : ⌊(0 : α)⌋₊ = 0 := by rw [← nat.cast_zero, floor_coe]

@[simp] lemma floor_one : ⌊(1 : α)⌋₊ = 1 := by rw [←nat.cast_one, floor_coe]

lemma floor_of_nonpos (ha : a ≤ 0) : ⌊a⌋₊ = 0 :=
ha.lt_or_eq.elim floor_semiring.floor_of_neg $ by { rintro rfl, exact floor_zero }

lemma floor_mono : monotone (floor : α → ℕ) := λ a b h, begin
  obtain ha | ha := le_total a 0,
  { rw floor_of_nonpos ha,
    exact nat.zero_le _ },
  { exact le_floor ((floor_le ha).trans h) }
end

lemma le_floor_iff' (hn : n ≠ 0) : n ≤ ⌊a⌋₊ ↔ (n : α) ≤ a :=
begin
  obtain ha | ha := le_total a 0,
  { rw floor_of_nonpos ha,
    exact iff_of_false (nat.pos_of_ne_zero hn).not_le
      (not_le_of_lt $ ha.trans_lt $ cast_pos.2 $ nat.pos_of_ne_zero hn) },
  { exact le_floor_iff ha }
end

@[simp] lemma one_le_floor_iff (x : α) : 1 ≤ ⌊x⌋₊ ↔ 1 ≤ x :=
by exact_mod_cast (@le_floor_iff' α _ _ x 1 one_ne_zero)

lemma floor_lt' (hn : n ≠ 0) : ⌊a⌋₊ < n ↔ a < n := lt_iff_lt_of_le_iff_le $ le_floor_iff' hn

lemma floor_pos : 0 < ⌊a⌋₊ ↔ 1 ≤ a :=
by { convert le_floor_iff' nat.one_ne_zero, exact cast_one.symm }

lemma pos_of_floor_pos (h : 0 < ⌊a⌋₊) : 0 < a :=
(le_or_lt a 0).resolve_left (λ ha, lt_irrefl 0 $ by rwa floor_of_nonpos ha at h)

lemma lt_of_lt_floor (h : n < ⌊a⌋₊) : ↑n < a :=
(nat.cast_lt.2 h).trans_le $ floor_le (pos_of_floor_pos $ (nat.zero_le n).trans_lt h).le

lemma floor_le_of_le (h : a ≤ n) : ⌊a⌋₊ ≤ n := le_imp_le_iff_lt_imp_lt.2 lt_of_lt_floor h

lemma floor_le_one_of_le_one (h : a ≤ 1) : ⌊a⌋₊ ≤ 1 :=
floor_le_of_le $ h.trans_eq $ nat.cast_one.symm

@[simp] lemma floor_eq_zero : ⌊a⌋₊ = 0 ↔ a < 1 :=
by { rw [←lt_one_iff, ←@cast_one α], exact floor_lt' nat.one_ne_zero }

lemma floor_eq_iff (ha : 0 ≤ a) : ⌊a⌋₊ = n ↔ ↑n ≤ a ∧ a < ↑n + 1 :=
by rw [←le_floor_iff ha, ←nat.cast_one, ←nat.cast_add, ←floor_lt ha, nat.lt_add_one_iff,
  le_antisymm_iff, and.comm]

lemma floor_eq_iff' (hn : n ≠ 0) : ⌊a⌋₊ = n ↔ ↑n ≤ a ∧ a < ↑n + 1 :=
by rw [← le_floor_iff' hn, ← nat.cast_one, ← nat.cast_add, ← floor_lt' (nat.add_one_ne_zero n),
  nat.lt_add_one_iff, le_antisymm_iff, and.comm]

lemma floor_eq_on_Ico (n : ℕ) : ∀ a ∈ (set.Ico n (n+1) : set α), ⌊a⌋₊ = n :=
λ a ⟨h₀, h₁⟩, (floor_eq_iff $ n.cast_nonneg.trans h₀).mpr ⟨h₀, h₁⟩

@[simp] lemma preimage_floor_zero : (floor : α → ℕ) ⁻¹' {0} = Iio 1 :=
ext $ λ a, floor_eq_zero

lemma preimage_floor_of_ne_zero {n : ℕ} (hn : n ≠ 0) : (floor : α → ℕ) ⁻¹' {n} = Ico n (n + 1) :=
ext $ λ a, floor_eq_iff' hn

/-! #### Ceil -/

lemma gc_ceil_coe : galois_connection (ceil : α → ℕ) coe := floor_semiring.gc_ceil

@[simp] lemma ceil_le : ⌈a⌉₊ ≤ n ↔ a ≤ n := gc_ceil_coe _ _

lemma lt_ceil : n < ⌈a⌉₊ ↔ (n : α) < a := lt_iff_lt_of_le_iff_le ceil_le

@[simp] lemma add_one_le_ceil_iff : n + 1 ≤ ⌈a⌉₊ ↔ (n : α) < a :=
by rw [← nat.lt_ceil, nat.add_one_le_iff]

@[simp] lemma one_le_ceil_iff : 1 ≤ ⌈a⌉₊ ↔ 0 < a :=
by rw [← zero_add 1, nat.add_one_le_ceil_iff, nat.cast_zero]

lemma ceil_le_floor_add_one (a : α) : ⌈a⌉₊ ≤ ⌊a⌋₊ + 1 :=
by { rw [ceil_le, nat.cast_add, nat.cast_one], exact (lt_floor_add_one a).le }

lemma le_ceil (a : α) : a ≤ ⌈a⌉₊ := ceil_le.1 le_rfl

@[simp] lemma ceil_int_cast {α : Type*} [linear_ordered_ring α]
  [floor_semiring α] (z : ℤ) : ⌈(z : α)⌉₊ = z.to_nat :=
eq_of_forall_ge_iff $ λ a, by { simp, norm_cast }

@[simp] lemma ceil_nat_cast (n : ℕ) : ⌈(n : α)⌉₊ = n :=
eq_of_forall_ge_iff $ λ a, by rw [ceil_le, cast_le]

lemma ceil_mono : monotone (ceil : α → ℕ) := gc_ceil_coe.monotone_l

@[simp] lemma ceil_zero : ⌈(0 : α)⌉₊ = 0 := by rw [← nat.cast_zero, ceil_nat_cast]

@[simp] lemma ceil_one : ⌈(1 : α)⌉₊ = 1 := by rw [←nat.cast_one, ceil_nat_cast]

@[simp] lemma ceil_eq_zero : ⌈a⌉₊ = 0 ↔ a ≤ 0 := by rw [← le_zero_iff, ceil_le, nat.cast_zero]

@[simp] lemma ceil_pos : 0 < ⌈a⌉₊ ↔ 0 < a := by rw [lt_ceil, cast_zero]

lemma lt_of_ceil_lt (h : ⌈a⌉₊ < n) : a < n := (le_ceil a).trans_lt (nat.cast_lt.2 h)

lemma le_of_ceil_le (h : ⌈a⌉₊ ≤ n) : a ≤ n := (le_ceil a).trans (nat.cast_le.2 h)

lemma floor_le_ceil (a : α) : ⌊a⌋₊ ≤ ⌈a⌉₊ :=
begin
  obtain ha | ha := le_total a 0,
  { rw floor_of_nonpos ha,
    exact nat.zero_le _ },
  { exact cast_le.1 ((floor_le ha).trans $ le_ceil _) }
end

lemma floor_lt_ceil_of_lt_of_pos {a b : α} (h : a < b) (h' : 0 < b) : ⌊a⌋₊ < ⌈b⌉₊ :=
begin
  rcases le_or_lt 0 a with ha|ha,
  { rw floor_lt ha, exact h.trans_le (le_ceil _) },
  { rwa [floor_of_nonpos ha.le, lt_ceil, nat.cast_zero] }
end

lemma ceil_eq_iff (hn : n ≠ 0) : ⌈a⌉₊ = n ↔ ↑(n - 1) < a ∧ a ≤ n :=
by rw [← ceil_le, ← not_le, ← ceil_le, not_le,
  tsub_lt_iff_right (nat.add_one_le_iff.2 (pos_iff_ne_zero.2 hn)), nat.lt_add_one_iff,
  le_antisymm_iff, and.comm]

@[simp] lemma preimage_ceil_zero : (nat.ceil : α → ℕ) ⁻¹' {0} = Iic 0 :=
ext $ λ x, ceil_eq_zero

lemma preimage_ceil_of_ne_zero (hn : n ≠ 0) : (nat.ceil : α → ℕ) ⁻¹' {n} = Ioc ↑(n - 1) n :=
ext $ λ x, ceil_eq_iff hn

/-! #### Intervals -/

@[simp] lemma preimage_Ioo {a b : α} (ha : 0 ≤ a) :
  ((coe : ℕ → α) ⁻¹' (set.Ioo a b)) = set.Ioo ⌊a⌋₊ ⌈b⌉₊ :=
by { ext, simp [floor_lt, lt_ceil, ha] }

@[simp] lemma preimage_Ico {a b : α} : ((coe : ℕ → α) ⁻¹' (set.Ico a b)) = set.Ico ⌈a⌉₊ ⌈b⌉₊ :=
by { ext, simp [ceil_le, lt_ceil] }

@[simp] lemma preimage_Ioc {a b : α} (ha : 0 ≤ a) (hb : 0 ≤ b) :
  ((coe : ℕ → α) ⁻¹' (set.Ioc a b)) = set.Ioc ⌊a⌋₊ ⌊b⌋₊ :=
by { ext, simp [floor_lt, le_floor_iff, hb, ha] }

@[simp] lemma preimage_Icc {a b : α} (hb : 0 ≤ b) :
  ((coe : ℕ → α) ⁻¹' (set.Icc a b)) = set.Icc ⌈a⌉₊ ⌊b⌋₊ :=
by { ext, simp [ceil_le, hb, le_floor_iff] }

@[simp] lemma preimage_Ioi {a : α} (ha : 0 ≤ a) : ((coe : ℕ → α) ⁻¹' (set.Ioi a)) = set.Ioi ⌊a⌋₊ :=
by { ext, simp [floor_lt, ha] }

@[simp] lemma preimage_Ici {a : α} : ((coe : ℕ → α) ⁻¹' (set.Ici a)) = set.Ici ⌈a⌉₊ :=
by { ext, simp [ceil_le] }

@[simp] lemma preimage_Iio {a : α} : ((coe : ℕ → α) ⁻¹' (set.Iio a)) = set.Iio ⌈a⌉₊ :=
by { ext, simp [lt_ceil] }

@[simp] lemma preimage_Iic {a : α} (ha : 0 ≤ a) : ((coe : ℕ → α) ⁻¹' (set.Iic a)) = set.Iic ⌊a⌋₊ :=
by { ext, simp [le_floor_iff, ha] }

lemma floor_add_nat (ha : 0 ≤ a) (n : ℕ) : ⌊a + n⌋₊ = ⌊a⌋₊ + n :=
eq_of_forall_le_iff $ λ b, begin
  rw [le_floor_iff (add_nonneg ha n.cast_nonneg)],
  obtain hb | hb := le_total n b,
  { obtain ⟨d, rfl⟩ := exists_add_of_le hb,
    rw [nat.cast_add, add_comm n, add_comm (n : α), add_le_add_iff_right, add_le_add_iff_right,
      le_floor_iff ha] },
  { obtain ⟨d, rfl⟩ := exists_add_of_le hb,
    rw [nat.cast_add, add_left_comm _ b, add_left_comm _ (b : α)],
    refine iff_of_true _ le_self_add,
    exact (le_add_of_nonneg_right $ ha.trans $ le_add_of_nonneg_right d.cast_nonneg) }
end

lemma floor_add_one (ha : 0 ≤ a) : ⌊a + 1⌋₊ = ⌊a⌋₊ + 1 :=
by { convert floor_add_nat ha 1, exact cast_one.symm }

lemma floor_sub_nat [has_sub α] [has_ordered_sub α] [has_exists_add_of_le α] (a : α) (n : ℕ) :
  ⌊a - n⌋₊ = ⌊a⌋₊ - n :=
begin
  obtain ha | ha := le_total a 0,
  { rw [floor_of_nonpos ha, floor_of_nonpos (tsub_nonpos_of_le (ha.trans n.cast_nonneg)),
      zero_tsub] },
  cases le_total a n,
  { rw [floor_of_nonpos (tsub_nonpos_of_le h), eq_comm, tsub_eq_zero_iff_le],
    exact nat.cast_le.1 ((nat.floor_le ha).trans h) },
  { rw [eq_tsub_iff_add_eq_of_le (le_floor h), ←floor_add_nat _,
      tsub_add_cancel_of_le h],
    exact le_tsub_of_add_le_left ((add_zero _).trans_le h), }
end

lemma ceil_add_nat (ha : 0 ≤ a) (n : ℕ) : ⌈a + n⌉₊ = ⌈a⌉₊ + n :=
eq_of_forall_ge_iff $ λ b, begin
  rw [←not_lt, ←not_lt, not_iff_not],
  rw [lt_ceil],
  obtain hb | hb := le_or_lt n b,
  { obtain ⟨d, rfl⟩ := exists_add_of_le hb,
    rw [nat.cast_add, add_comm n, add_comm (n : α), add_lt_add_iff_right, add_lt_add_iff_right,
      lt_ceil] },
  { exact iff_of_true (lt_add_of_nonneg_of_lt ha $ cast_lt.2 hb) (lt_add_left _ _ _ hb) }
end

lemma ceil_add_one (ha : 0 ≤ a) : ⌈a + 1⌉₊ = ⌈a⌉₊ + 1 :=
by { convert ceil_add_nat ha 1, exact cast_one.symm }

lemma ceil_lt_add_one (ha : 0 ≤ a) : (⌈a⌉₊ : α) < a + 1 :=
lt_ceil.1 $ (nat.lt_succ_self _).trans_le (ceil_add_one ha).ge

lemma ceil_add_le (a b : α) : ⌈a + b⌉₊ ≤ ⌈a⌉₊ + ⌈b⌉₊ :=
begin
  rw [ceil_le, nat.cast_add],
  exact add_le_add (le_ceil _) (le_ceil _),
end

end linear_ordered_semiring

section linear_ordered_ring
variables [linear_ordered_ring α] [floor_semiring α]

lemma sub_one_lt_floor (a : α) : a - 1 < ⌊a⌋₊ := sub_lt_iff_lt_add.2 $ lt_floor_add_one a

end linear_ordered_ring

section linear_ordered_semifield
variables [linear_ordered_semifield α] [floor_semiring α]

lemma floor_div_nat (a : α) (n : ℕ) : ⌊a / n⌋₊ = ⌊a⌋₊ / n :=
begin
  cases le_total a 0 with ha ha,
  { rw [floor_of_nonpos, floor_of_nonpos ha],
    { simp },
    apply div_nonpos_of_nonpos_of_nonneg ha n.cast_nonneg },
  obtain rfl | hn := n.eq_zero_or_pos,
  { rw [cast_zero, div_zero, nat.div_zero, floor_zero] },
  refine (floor_eq_iff _).2 _,
  { exact div_nonneg ha n.cast_nonneg },
  split,
  { exact cast_div_le.trans (div_le_div_of_le_of_nonneg (floor_le ha) n.cast_nonneg) },
  rw [div_lt_iff, add_mul, one_mul, ←cast_mul, ←cast_add, ←floor_lt ha],
  { exact lt_div_mul_add hn },
  { exact (cast_pos.2 hn) }
end

/-- Natural division is the floor of field division. -/
lemma floor_div_eq_div (m n : ℕ) : ⌊(m : α) / n⌋₊ = m / n :=
by { convert floor_div_nat (m : α) n, rw m.floor_coe }

end linear_ordered_semifield

end nat

/-- There exists at most one `floor_semiring` structure on a linear ordered semiring. -/
lemma subsingleton_floor_semiring {α} [linear_ordered_semiring α] :
  subsingleton (floor_semiring α) :=
begin
  refine ⟨λ H₁ H₂, _⟩,
  have : H₁.ceil = H₂.ceil,
    from funext (λ a, H₁.gc_ceil.l_unique H₂.gc_ceil $ λ n, rfl),
  have : H₁.floor = H₂.floor,
  { ext a,
    cases lt_or_le a 0,
    { rw [H₁.floor_of_neg, H₂.floor_of_neg]; exact h },
    { refine eq_of_forall_le_iff (λ n, _),
      rw [H₁.gc_floor, H₂.gc_floor]; exact h } },
  cases H₁, cases H₂, congr; assumption
end

/-! ### Floor rings -/

/--
A `floor_ring` is a linear ordered ring over `α` with a function
`floor : α → ℤ` satisfying `∀ (z : ℤ) (a : α), z ≤ floor a ↔ (z : α) ≤ a)`.
-/
class floor_ring (α) [linear_ordered_ring α] :=
(floor : α → ℤ)
(ceil : α → ℤ)
(gc_coe_floor : galois_connection coe floor)
(gc_ceil_coe : galois_connection ceil coe)

instance : floor_ring ℤ :=
{ floor := id,
  ceil := id,
  gc_coe_floor := λ a b, by { rw int.cast_id, refl },
  gc_ceil_coe := λ a b, by { rw int.cast_id, refl } }

/-- A `floor_ring` constructor from the `floor` function alone. -/
def floor_ring.of_floor (α) [linear_ordered_ring α] (floor : α → ℤ)
  (gc_coe_floor : galois_connection coe floor) : floor_ring α :=
{ floor := floor,
  ceil := λ a, -floor (-a),
  gc_coe_floor := gc_coe_floor,
  gc_ceil_coe := λ a z, by rw [neg_le, ←gc_coe_floor, int.cast_neg, neg_le_neg_iff] }

/-- A `floor_ring` constructor from the `ceil` function alone. -/
def floor_ring.of_ceil (α) [linear_ordered_ring α] (ceil : α → ℤ)
  (gc_ceil_coe : galois_connection ceil coe) : floor_ring α :=
{ floor := λ a, -ceil (-a),
  ceil := ceil,
  gc_coe_floor := λ a z, by rw [le_neg, gc_ceil_coe, int.cast_neg, neg_le_neg_iff],
  gc_ceil_coe := gc_ceil_coe }

namespace int
variables [linear_ordered_ring α] [floor_ring α] {z : ℤ} {a : α}

/-- `int.floor a` is the greatest integer `z` such that `z ≤ a`. It is denoted with `⌊a⌋`. -/
def floor : α → ℤ := floor_ring.floor

/-- `int.ceil a` is the smallest integer `z` such that `a ≤ z`. It is denoted with `⌈a⌉`. -/
def ceil : α → ℤ := floor_ring.ceil

/-- `int.fract a`, the fractional part of `a`, is `a` minus its floor. -/
def fract (a : α) : α := a - floor a

@[simp] lemma floor_int : (int.floor : ℤ → ℤ) = id := rfl
@[simp] lemma ceil_int : (int.ceil : ℤ → ℤ) = id := rfl
@[simp] lemma fract_int : (int.fract : ℤ → ℤ) = 0 := funext $ λ x, by simp [fract]

notation `⌊` a `⌋` := int.floor a
notation `⌈` a `⌉` := int.ceil a
-- Mathematical notation for `fract a` is usually `{a}`. Let's not even go there.

@[simp] lemma floor_ring_floor_eq : @floor_ring.floor = @int.floor := rfl

@[simp] lemma floor_ring_ceil_eq : @floor_ring.ceil = @int.ceil := rfl

/-! #### Floor -/

lemma gc_coe_floor : galois_connection (coe : ℤ → α) floor := floor_ring.gc_coe_floor

lemma le_floor : z ≤ ⌊a⌋ ↔ (z : α) ≤ a := (gc_coe_floor z a).symm

lemma floor_lt : ⌊a⌋ < z ↔ a < z := lt_iff_lt_of_le_iff_le le_floor

lemma floor_le (a : α) : (⌊a⌋ : α) ≤ a := gc_coe_floor.l_u_le a

lemma floor_nonneg : 0 ≤ ⌊a⌋ ↔ 0 ≤ a := by rw [le_floor, int.cast_zero]

@[simp] lemma floor_le_sub_one_iff : ⌊a⌋ ≤ z - 1 ↔ a < z := by rw [← floor_lt, le_sub_one_iff]

@[simp] lemma floor_le_neg_one_iff : ⌊a⌋ ≤ -1 ↔ a < 0 :=
by rw [← zero_sub (1 : ℤ), floor_le_sub_one_iff, cast_zero]

lemma floor_nonpos (ha : a ≤ 0) : ⌊a⌋ ≤ 0 :=
begin
  rw [← @cast_le α, int.cast_zero],
  exact (floor_le a).trans ha,
end

lemma lt_succ_floor (a : α) : a < ⌊a⌋.succ := floor_lt.1 $ int.lt_succ_self _

@[simp] lemma lt_floor_add_one (a : α) : a < ⌊a⌋ + 1 :=
by simpa only [int.succ, int.cast_add, int.cast_one] using lt_succ_floor a

@[simp] lemma sub_one_lt_floor (a : α) : a - 1 < ⌊a⌋ := sub_lt_iff_lt_add.2 (lt_floor_add_one a)

@[simp] lemma floor_int_cast (z : ℤ) : ⌊(z : α)⌋ = z :=
eq_of_forall_le_iff $ λ a, by rw [le_floor, int.cast_le]

@[simp] lemma floor_nat_cast (n : ℕ) : ⌊(n : α)⌋ = n :=
eq_of_forall_le_iff $ λ a, by rw [le_floor, ← cast_coe_nat, cast_le]

@[simp] lemma floor_zero : ⌊(0 : α)⌋ = 0 := by rw [← cast_zero, floor_int_cast]

@[simp] lemma floor_one : ⌊(1 : α)⌋ = 1 := by rw [← cast_one, floor_int_cast]

@[mono] lemma floor_mono : monotone (floor : α → ℤ) := gc_coe_floor.monotone_u

lemma floor_pos : 0 < ⌊a⌋ ↔ 1 ≤ a :=
by { convert le_floor, exact cast_one.symm }

@[simp] lemma floor_add_int (a : α) (z : ℤ) : ⌊a + z⌋ = ⌊a⌋ + z :=
eq_of_forall_le_iff $ λ a, by rw [le_floor,
  ← sub_le_iff_le_add, ← sub_le_iff_le_add, le_floor, int.cast_sub]

lemma floor_add_one (a : α) : ⌊a + 1⌋ = ⌊a⌋ + 1 :=
by { convert floor_add_int a 1, exact cast_one.symm }

lemma le_floor_add (a b : α) : ⌊a⌋ + ⌊b⌋ ≤ ⌊a + b⌋ :=
begin
  rw [le_floor, int.cast_add],
  exact add_le_add (floor_le _) (floor_le _),
end

lemma le_floor_add_floor (a b : α) : ⌊a + b⌋ - 1 ≤ ⌊a⌋ + ⌊b⌋ :=
begin
  rw [←sub_le_iff_le_add, le_floor, int.cast_sub, sub_le_comm, int.cast_sub, int.cast_one],
  refine le_trans _ (sub_one_lt_floor _).le,
  rw [sub_le_iff_le_add', ←add_sub_assoc, sub_le_sub_iff_right],
  exact floor_le _,
end

@[simp] lemma floor_int_add (z : ℤ) (a : α) : ⌊↑z + a⌋ = z + ⌊a⌋ :=
by simpa only [add_comm] using floor_add_int a z

@[simp] lemma floor_add_nat (a : α) (n : ℕ) : ⌊a + n⌋ = ⌊a⌋ + n :=
by rw [← int.cast_coe_nat, floor_add_int]

@[simp] lemma floor_nat_add (n : ℕ) (a : α) : ⌊↑n + a⌋ = n + ⌊a⌋ :=
by rw [← int.cast_coe_nat, floor_int_add]

@[simp] lemma floor_sub_int (a : α) (z : ℤ) : ⌊a - z⌋ = ⌊a⌋ - z :=
eq.trans (by rw [int.cast_neg, sub_eq_add_neg]) (floor_add_int _ _)

@[simp] lemma floor_sub_nat (a : α) (n : ℕ) : ⌊a - n⌋ = ⌊a⌋ - n :=
by rw [← int.cast_coe_nat, floor_sub_int]

lemma abs_sub_lt_one_of_floor_eq_floor {α : Type*} [linear_ordered_comm_ring α] [floor_ring α]
  {a b : α} (h : ⌊a⌋ = ⌊b⌋) : |a - b| < 1 :=
begin
  have : a < ⌊a⌋ + 1     := lt_floor_add_one a,
  have : b < ⌊b⌋ + 1     := lt_floor_add_one b,
  have : (⌊a⌋ : α) = ⌊b⌋ := int.cast_inj.2 h,
  have : (⌊a⌋ : α) ≤ a   := floor_le a,
  have : (⌊b⌋ : α) ≤ b   := floor_le b,
  exact abs_sub_lt_iff.2 ⟨by linarith, by linarith⟩
end

lemma floor_eq_iff : ⌊a⌋ = z ↔ ↑z ≤ a ∧ a < z + 1 :=
by rw [le_antisymm_iff, le_floor, ←int.lt_add_one_iff, floor_lt, int.cast_add, int.cast_one,
  and.comm]

@[simp] lemma floor_eq_zero_iff : ⌊a⌋ = 0 ↔ a ∈ Ico (0 : α) 1 := by simp [floor_eq_iff]

lemma floor_eq_on_Ico (n : ℤ) : ∀ a ∈ set.Ico (n : α) (n + 1), ⌊a⌋ = n :=
λ a ⟨h₀, h₁⟩, floor_eq_iff.mpr ⟨h₀, h₁⟩

lemma floor_eq_on_Ico' (n : ℤ) : ∀ a ∈ set.Ico (n : α) (n + 1), (⌊a⌋ : α) = n :=
λ a ha, congr_arg _ $ floor_eq_on_Ico n a ha

@[simp] lemma preimage_floor_singleton (m : ℤ) : (floor : α → ℤ) ⁻¹' {m} = Ico m (m + 1) :=
ext $ λ x, floor_eq_iff

/-! #### Fractional part -/

@[simp] lemma self_sub_floor (a : α) : a - ⌊a⌋ = fract a := rfl

@[simp] lemma floor_add_fract (a : α) : (⌊a⌋ : α) + fract a = a := add_sub_cancel'_right _ _

@[simp] lemma fract_add_floor (a : α) : fract a + ⌊a⌋ = a := sub_add_cancel _ _

@[simp] lemma fract_add_int (a : α) (m : ℤ) : fract (a + m) = fract a :=
by { rw fract, simp }

@[simp] lemma fract_add_nat (a : α) (m : ℕ) : fract (a + m) = fract a :=
by { rw fract, simp }

@[simp] lemma fract_sub_int (a : α) (m : ℤ) : fract (a - m) = fract a :=
by { rw fract, simp }

@[simp] lemma fract_int_add (m : ℤ) (a : α) : fract (↑m + a) = fract a :=
by rw [add_comm, fract_add_int]

@[simp] lemma fract_sub_nat (a : α) (n : ℕ) : fract (a - n) = fract a :=
by { rw fract, simp }

@[simp] lemma fract_int_nat (n : ℕ) (a : α) : fract (↑n + a) = fract a :=
by rw [add_comm, fract_add_nat]

lemma fract_add_le (a b : α) : fract (a + b) ≤ fract a + fract b :=
begin
  rw [fract, fract, fract, sub_add_sub_comm, sub_le_sub_iff_left, ←int.cast_add, int.cast_le],
  exact le_floor_add _ _,
end

lemma fract_add_fract_le (a b : α) : fract a + fract b ≤ fract (a + b) + 1 :=
begin
  rw [fract, fract, fract, sub_add_sub_comm, sub_add, sub_le_sub_iff_left],
  exact_mod_cast le_floor_add_floor a b,
end

@[simp] lemma self_sub_fract (a : α) : a - fract a = ⌊a⌋ := sub_sub_cancel _ _

@[simp] lemma fract_sub_self (a : α) : fract a - a = -⌊a⌋ := sub_sub_cancel_left _ _

@[simp] lemma fract_nonneg (a : α) : 0 ≤ fract a := sub_nonneg.2 $ floor_le _

/-- The fractional part of `a` is positive if and only if `a ≠ ⌊a⌋`. -/
lemma fract_pos : 0 < fract a ↔ a ≠ ⌊a⌋ :=
(fract_nonneg a).lt_iff_ne.trans $ ne_comm.trans sub_ne_zero

lemma fract_lt_one (a : α) : fract a < 1 := sub_lt_comm.1 $ sub_one_lt_floor _

@[simp] lemma fract_zero : fract (0 : α) = 0 := by rw [fract, floor_zero, cast_zero, sub_self]

@[simp] lemma fract_one : fract (1 : α) = 0 :=
by simp [fract]

lemma abs_fract : |int.fract a| = int.fract a := abs_eq_self.mpr $ fract_nonneg a

@[simp] lemma abs_one_sub_fract : |1 - fract a| = 1 - fract a :=
abs_eq_self.mpr $ sub_nonneg.mpr (fract_lt_one a).le

@[simp] lemma fract_int_cast (z : ℤ) : fract (z : α) = 0 :=
by { unfold fract, rw floor_int_cast, exact sub_self _ }

@[simp] lemma fract_nat_cast (n : ℕ) : fract (n : α) = 0 := by simp [fract]

@[simp] lemma fract_floor (a : α) : fract (⌊a⌋ : α) = 0 := fract_int_cast _

@[simp] lemma floor_fract (a : α) : ⌊fract a⌋ = 0 :=
by rw [floor_eq_iff, int.cast_zero, zero_add]; exact ⟨fract_nonneg _, fract_lt_one _⟩

lemma fract_eq_iff {a b : α} : fract a = b ↔ 0 ≤ b ∧ b < 1 ∧ ∃ z : ℤ, a - b = z :=
⟨λ h, by { rw ←h, exact ⟨fract_nonneg _, fract_lt_one _, ⟨⌊a⌋, sub_sub_cancel _ _⟩⟩},
  begin
    rintro ⟨h₀, h₁, z, hz⟩,
    show a - ⌊a⌋ = b, apply eq.symm,
    rw [eq_sub_iff_add_eq, add_comm, ←eq_sub_iff_add_eq],
    rw [hz, int.cast_inj, floor_eq_iff, ←hz],
    clear hz, split; simpa [sub_eq_add_neg, add_assoc]
  end⟩

lemma fract_eq_fract {a b : α} : fract a = fract b ↔ ∃ z : ℤ, a - b = z :=
⟨λ h, ⟨⌊a⌋ - ⌊b⌋, begin
  unfold fract at h, rw [int.cast_sub, sub_eq_sub_iff_sub_eq_sub.1 h],
 end⟩, begin
  rintro ⟨z, hz⟩,
  refine fract_eq_iff.2 ⟨fract_nonneg _, fract_lt_one _, z + ⌊b⌋, _⟩,
  rw [eq_add_of_sub_eq hz, add_comm, int.cast_add],
  exact add_sub_sub_cancel _ _ _,
end⟩

@[simp] lemma fract_eq_self {a : α} : fract a = a ↔ 0 ≤ a ∧ a < 1 :=
fract_eq_iff.trans $ and.assoc.symm.trans $ and_iff_left ⟨0, by simp⟩

@[simp] lemma fract_fract (a : α) : fract (fract a) = fract a :=
fract_eq_self.2 ⟨fract_nonneg _, fract_lt_one _⟩

lemma fract_add (a b : α) : ∃ z : ℤ, fract (a + b) - fract a - fract b = z :=
⟨⌊a⌋ + ⌊b⌋ - ⌊a + b⌋, by { unfold fract, simp [sub_eq_add_neg], abel }⟩

lemma fract_neg {x : α} (hx : fract x ≠ 0) :
  fract (-x) = 1 - fract x :=
begin
  rw fract_eq_iff,
  split,
  { rw [le_sub_iff_add_le, zero_add],
    exact (fract_lt_one x).le, },
  refine ⟨sub_lt_self _ (lt_of_le_of_ne' (fract_nonneg x) hx), -⌊x⌋ - 1, _⟩,
  simp only [sub_sub_eq_add_sub, cast_sub, cast_neg, cast_one, sub_left_inj],
  conv in (-x) {rw ← floor_add_fract x},
  simp [-floor_add_fract],
end

@[simp]
lemma fract_neg_eq_zero {x : α} : fract (-x) = 0 ↔ fract x = 0 :=
begin
  simp only [fract_eq_iff, le_refl, zero_lt_one, tsub_zero, true_and],
  split; rintros ⟨z, hz⟩; use [-z]; simp [← hz],
end

lemma fract_mul_nat (a : α) (b : ℕ) : ∃ z : ℤ, fract a * b - fract (a * b) = z :=
begin
  induction b with c hc,
    use 0, simp,
  rcases hc with ⟨z, hz⟩,
  rw [nat.succ_eq_add_one, nat.cast_add, mul_add, mul_add, nat.cast_one, mul_one, mul_one],
  rcases fract_add (a * c) a with ⟨y, hy⟩,
  use z - y,
  rw [int.cast_sub, ←hz, ←hy],
  abel
end

lemma preimage_fract (s : set α) : fract ⁻¹' s = ⋃ m : ℤ, (λ x, x - m) ⁻¹' (s ∩ Ico (0 : α) 1) :=
begin
  ext x,
  simp only [mem_preimage, mem_Union, mem_inter_iff],
  refine ⟨λ h, ⟨⌊x⌋, h, fract_nonneg x, fract_lt_one x⟩, _⟩,
  rintro ⟨m, hms, hm0, hm1⟩,
  obtain rfl : ⌊x⌋ = m, from floor_eq_iff.2 ⟨sub_nonneg.1 hm0, sub_lt_iff_lt_add'.1 hm1⟩,
  exact hms
end

lemma image_fract (s : set α) : fract '' s = ⋃ m : ℤ, (λ x, x - m) '' s ∩ Ico 0 1 :=
begin
  ext x,
  simp only [mem_image, mem_inter_iff, mem_Union], split,
  { rintro ⟨y, hy, rfl⟩,
    exact ⟨⌊y⌋, ⟨y, hy, rfl⟩, fract_nonneg y, fract_lt_one y⟩ },
  { rintro ⟨m, ⟨y, hys, rfl⟩, h0, h1⟩,
    obtain rfl : ⌊y⌋ = m, from floor_eq_iff.2 ⟨sub_nonneg.1 h0, sub_lt_iff_lt_add'.1 h1⟩,
    exact ⟨y, hys, rfl⟩ }
end

section linear_ordered_field

variables {k : Type*} [linear_ordered_field k] [floor_ring k] {b : k}

lemma fract_div_mul_self_mem_Ico (a b : k) (ha : 0 < a) : fract (b/a) * a ∈ Ico 0 a :=
⟨(zero_le_mul_right ha).2 (fract_nonneg (b/a)), (mul_lt_iff_lt_one_left ha).2 (fract_lt_one (b/a))⟩

lemma fract_div_mul_self_add_zsmul_eq (a b : k) (ha : a ≠ 0) :
  fract (b/a) * a + ⌊b/a⌋ • a = b :=
by rw [zsmul_eq_mul, ← add_mul, fract_add_floor, div_mul_cancel b ha]

lemma sub_floor_div_mul_nonneg (a : k) (hb : 0 < b) : 0 ≤ a - ⌊a / b⌋ * b :=
sub_nonneg_of_le $ (le_div_iff hb).1 $ floor_le _

lemma sub_floor_div_mul_lt (a : k) (hb : 0 < b) : a - ⌊a / b⌋ * b < b :=
sub_lt_iff_lt_add.2 $ by { rw [←one_add_mul, ←div_lt_iff hb, add_comm], exact lt_floor_add_one _ }

lemma fract_div_nat_cast_eq_div_nat_cast_mod {m n : ℕ} :
  fract ((m : k) / n) = ↑(m % n) / n :=
begin
  rcases n.eq_zero_or_pos with rfl | hn, { simp, },
  have hn' : 0 < (n : k), { norm_cast, assumption, },
  refine fract_eq_iff.mpr ⟨by positivity, _, m / n, _⟩,
  { simpa only [div_lt_one hn', nat.cast_lt] using m.mod_lt hn, },
  { rw [sub_eq_iff_eq_add', ← mul_right_inj' hn'.ne.symm, mul_div_cancel' _ hn'.ne.symm, mul_add,
      mul_div_cancel' _ hn'.ne.symm],
    norm_cast,
    rw [← nat.cast_add, nat.mod_add_div m n], },
end

-- TODO Generalise this to allow `n : ℤ` using `int.fmod` instead of `int.mod`.
lemma fract_div_int_cast_eq_div_int_cast_mod {m : ℤ} {n : ℕ} :
  fract ((m : k) / n) = ↑(m % n) / n :=
begin
  rcases n.eq_zero_or_pos with rfl | hn, { simp, },
  replace hn : 0 < (n : k), { norm_cast, assumption, },
  have : ∀ {l : ℤ} (hl : 0 ≤ l), fract ((l : k) / n) = ↑(l % n) / n,
  { intros,
    obtain ⟨l₀, rfl | rfl⟩ := l.eq_coe_or_neg,
    { rw [cast_coe_nat, ← coe_nat_mod, cast_coe_nat, fract_div_nat_cast_eq_div_nat_cast_mod], },
    { rw [right.nonneg_neg_iff, coe_nat_nonpos_iff] at hl, simp [hl, zero_mod], }, },
  obtain ⟨m₀, rfl | rfl⟩ := m.eq_coe_or_neg, { exact this (of_nat_nonneg m₀), },
  let q := ⌈↑m₀ / (n : k)⌉,
  let m₁ := (q * ↑n) -(↑m₀ : ℤ),
  have hm₁ : 0 ≤ m₁, { simpa [←@cast_le k, ←div_le_iff hn] using floor_ring.gc_ceil_coe.le_u_l _, },
  calc fract (↑-↑m₀ / ↑n) = fract (-(m₀ : k) / n) : by push_cast
                      ... = fract ((m₁ : k) / n) : _
                      ... = ↑(m₁ % (n : ℤ)) / ↑n : this hm₁
                      ... = ↑(-(↑m₀ : ℤ) % ↑n) / ↑n : _,
  { rw [← fract_int_add q, ← mul_div_cancel (q : k) (ne_of_gt hn), ← add_div, ← sub_eq_add_neg],
    push_cast, },
  { congr' 2,
    change ((q * ↑n) -(↑m₀ : ℤ)) % ↑n = _,
    rw [sub_eq_add_neg, add_comm (q * ↑n), add_mul_mod_self], },
end

end linear_ordered_field

/-! #### Ceil -/

lemma gc_ceil_coe : galois_connection ceil (coe : ℤ → α) := floor_ring.gc_ceil_coe

lemma ceil_le : ⌈a⌉ ≤ z ↔ a ≤ z := gc_ceil_coe a z

lemma floor_neg : ⌊-a⌋ = -⌈a⌉ :=
eq_of_forall_le_iff (λ z, by rw [le_neg, ceil_le, le_floor, int.cast_neg, le_neg])

lemma ceil_neg : ⌈-a⌉ = -⌊a⌋ :=
eq_of_forall_ge_iff (λ z, by rw [neg_le, ceil_le, le_floor, int.cast_neg, neg_le])

lemma lt_ceil : z < ⌈a⌉ ↔ (z : α) < a := lt_iff_lt_of_le_iff_le ceil_le

@[simp] lemma add_one_le_ceil_iff : z + 1 ≤ ⌈a⌉ ↔ (z : α) < a := by rw [← lt_ceil, add_one_le_iff]

@[simp] lemma one_le_ceil_iff : 1 ≤ ⌈a⌉ ↔ 0 < a :=
by rw [← zero_add (1 : ℤ), add_one_le_ceil_iff, cast_zero]

lemma ceil_le_floor_add_one (a : α) : ⌈a⌉ ≤ ⌊a⌋ + 1 :=
by { rw [ceil_le, int.cast_add, int.cast_one], exact (lt_floor_add_one a).le }

lemma le_ceil (a : α) : a ≤ ⌈a⌉ := gc_ceil_coe.le_u_l a

@[simp] lemma ceil_int_cast (z : ℤ) : ⌈(z : α)⌉ = z :=
eq_of_forall_ge_iff $ λ a, by rw [ceil_le, int.cast_le]

@[simp] lemma ceil_nat_cast (n : ℕ) : ⌈(n : α)⌉ = n :=
eq_of_forall_ge_iff $ λ a, by rw [ceil_le, ← cast_coe_nat, cast_le]

lemma ceil_mono : monotone (ceil : α → ℤ) := gc_ceil_coe.monotone_l

@[simp] lemma ceil_add_int (a : α) (z : ℤ) : ⌈a + z⌉ = ⌈a⌉ + z :=
by rw [←neg_inj, neg_add', ←floor_neg, ←floor_neg, neg_add', floor_sub_int]

@[simp] lemma ceil_add_nat (a : α) (n : ℕ) : ⌈a + n⌉ = ⌈a⌉ + n :=
by rw [← int.cast_coe_nat, ceil_add_int]

@[simp] lemma ceil_add_one (a : α) : ⌈a + 1⌉ = ⌈a⌉ + 1 :=
by { convert ceil_add_int a (1 : ℤ), exact cast_one.symm }

@[simp] lemma ceil_sub_int (a : α) (z : ℤ) : ⌈a - z⌉ = ⌈a⌉ - z :=
eq.trans (by rw [int.cast_neg, sub_eq_add_neg]) (ceil_add_int _ _)

@[simp] lemma ceil_sub_nat (a : α) (n : ℕ) : ⌈a - n⌉ = ⌈a⌉ - n :=
by convert ceil_sub_int a n using 1; simp

@[simp] lemma ceil_sub_one (a : α) : ⌈a - 1⌉ = ⌈a⌉ - 1 :=
by rw [eq_sub_iff_add_eq, ← ceil_add_one, sub_add_cancel]

lemma ceil_lt_add_one (a : α) : (⌈a⌉ : α) < a + 1 :=
by { rw [← lt_ceil, ← int.cast_one, ceil_add_int], apply lt_add_one }

lemma ceil_add_le (a b : α) : ⌈a + b⌉ ≤ ⌈a⌉ + ⌈b⌉ :=
begin
  rw [ceil_le, int.cast_add],
  exact add_le_add (le_ceil _) (le_ceil _),
end

lemma ceil_add_ceil_le (a b : α) : ⌈a⌉ + ⌈b⌉ ≤ ⌈a + b⌉ + 1 :=
begin
  rw [←le_sub_iff_add_le, ceil_le, int.cast_sub, int.cast_add, int.cast_one, le_sub_comm],
  refine (ceil_lt_add_one _).le.trans _,
  rw [le_sub_iff_add_le', ←add_assoc, add_le_add_iff_right],
  exact le_ceil _,
end

@[simp] lemma ceil_pos : 0 < ⌈a⌉ ↔ 0 < a := by rw [lt_ceil, cast_zero]

@[simp] lemma ceil_zero : ⌈(0 : α)⌉ = 0 := by rw [← cast_zero, ceil_int_cast]

@[simp] lemma ceil_one : ⌈(1 : α)⌉ = 1 := by rw [← cast_one, ceil_int_cast]

lemma ceil_nonneg (ha : 0 ≤ a) : 0 ≤ ⌈a⌉ :=
by exact_mod_cast ha.trans (le_ceil a)

lemma ceil_eq_iff : ⌈a⌉ = z ↔ ↑z - 1 < a ∧ a ≤ z :=
by rw [←ceil_le, ←int.cast_one, ←int.cast_sub, ←lt_ceil, int.sub_one_lt_iff, le_antisymm_iff,
  and.comm]

@[simp] lemma ceil_eq_zero_iff : ⌈a⌉ = 0 ↔ a ∈ Ioc (-1 : α) 0 := by simp [ceil_eq_iff]

lemma ceil_eq_on_Ioc (z : ℤ) : ∀ a ∈ set.Ioc (z - 1 : α) z, ⌈a⌉ = z :=
λ a ⟨h₀, h₁⟩, ceil_eq_iff.mpr ⟨h₀, h₁⟩

lemma ceil_eq_on_Ioc' (z : ℤ) : ∀ a ∈ set.Ioc (z - 1 : α) z, (⌈a⌉ : α) = z :=
λ a ha, by exact_mod_cast ceil_eq_on_Ioc z a ha

lemma floor_le_ceil (a : α) : ⌊a⌋ ≤ ⌈a⌉ := cast_le.1 $ (floor_le _).trans $ le_ceil _

lemma floor_lt_ceil_of_lt {a b : α} (h : a < b) : ⌊a⌋ < ⌈b⌉ :=
cast_lt.1 $ (floor_le a).trans_lt $ h.trans_le $ le_ceil b

@[simp] lemma preimage_ceil_singleton (m : ℤ) : (ceil : α → ℤ) ⁻¹' {m} = Ioc (m - 1) m :=
ext $ λ x, ceil_eq_iff

lemma fract_eq_zero_or_add_one_sub_ceil (a : α) : fract a = 0 ∨ fract a = a + 1 - (⌈a⌉ : α) :=
begin
  cases eq_or_ne (fract a) 0 with ha ha, { exact or.inl ha, }, right,
  suffices : (⌈a⌉ : α) = ⌊a⌋ + 1, { rw [this, ← self_sub_fract], abel, },
  norm_cast,
  rw ceil_eq_iff,
  refine ⟨_, _root_.le_of_lt $ by simp⟩,
  rw [cast_add, cast_one, add_tsub_cancel_right, ← self_sub_fract a, sub_lt_self_iff],
  exact ha.symm.lt_of_le (fract_nonneg a),
end

lemma ceil_eq_add_one_sub_fract (ha : fract a ≠ 0) : (⌈a⌉ : α) = a + 1 - fract a :=
by { rw (or_iff_right ha).mp (fract_eq_zero_or_add_one_sub_ceil a), abel, }

lemma ceil_sub_self_eq (ha : fract a ≠ 0) : (⌈a⌉ : α) - a = 1 - fract a :=
by { rw (or_iff_right ha).mp (fract_eq_zero_or_add_one_sub_ceil a), abel, }

/-! #### Intervals -/

@[simp] lemma preimage_Ioo {a b : α} : ((coe : ℤ → α) ⁻¹' (set.Ioo a b)) = set.Ioo ⌊a⌋ ⌈b⌉ :=
by { ext, simp [floor_lt, lt_ceil] }

@[simp] lemma preimage_Ico {a b : α} : ((coe : ℤ → α) ⁻¹' (set.Ico a b)) = set.Ico ⌈a⌉ ⌈b⌉ :=
by { ext, simp [ceil_le, lt_ceil] }

@[simp] lemma preimage_Ioc {a b : α} : ((coe : ℤ → α) ⁻¹' (set.Ioc a b)) = set.Ioc ⌊a⌋ ⌊b⌋ :=
by { ext, simp [floor_lt, le_floor] }

@[simp] lemma preimage_Icc {a b : α} : ((coe : ℤ → α) ⁻¹' (set.Icc a b)) = set.Icc ⌈a⌉ ⌊b⌋ :=
by { ext, simp [ceil_le, le_floor] }

@[simp] lemma preimage_Ioi : ((coe : ℤ → α) ⁻¹' (set.Ioi a)) = set.Ioi ⌊a⌋ :=
by { ext, simp [floor_lt] }

@[simp] lemma preimage_Ici : ((coe : ℤ → α) ⁻¹' (set.Ici a)) = set.Ici ⌈a⌉ :=
by { ext, simp [ceil_le] }

@[simp] lemma preimage_Iio : ((coe : ℤ → α) ⁻¹' (set.Iio a)) = set.Iio ⌈a⌉ :=
by { ext, simp [lt_ceil] }

@[simp] lemma preimage_Iic : ((coe : ℤ → α) ⁻¹' (set.Iic a)) = set.Iic ⌊a⌋ :=
by { ext, simp [le_floor] }

end int

open int

/-! ### Round -/

section round

section linear_ordered_ring

variables [linear_ordered_ring α] [floor_ring α]

/-- `round` rounds a number to the nearest integer. `round (1 / 2) = 1` -/
def round (x : α) : ℤ := if 2 * fract x < 1 then ⌊x⌋ else ⌈x⌉

@[simp] lemma round_zero : round (0 : α) = 0 := by simp [round]

@[simp] lemma round_one : round (1 : α) = 1 := by simp [round]

@[simp] lemma round_nat_cast (n : ℕ) : round (n : α) = n := by simp [round]

@[simp] lemma round_int_cast (n : ℤ) : round (n : α) = n := by simp [round]

@[simp]
lemma round_add_int (x : α) (y : ℤ) : round (x + y) = round x + y :=
by rw [round, round, int.fract_add_int, int.floor_add_int, int.ceil_add_int, ← apply_ite2, if_t_t]

@[simp]
lemma round_add_one (a : α) : round (a + 1) = round a + 1 :=
by { convert round_add_int a 1, exact int.cast_one.symm }

@[simp]
lemma round_sub_int (x : α) (y : ℤ) : round (x - y) = round x - y :=
by { rw [sub_eq_add_neg], norm_cast, rw [round_add_int, sub_eq_add_neg] }

@[simp]
lemma round_sub_one (a : α) : round (a - 1) = round a - 1 :=
by { convert round_sub_int a 1, exact int.cast_one.symm }

@[simp]
lemma round_add_nat (x : α) (y : ℕ) : round (x + y) = round x + y :=
by rw [round, round, fract_add_nat, int.floor_add_nat, int.ceil_add_nat, ← apply_ite2, if_t_t]

@[simp]
lemma round_sub_nat (x : α) (y : ℕ) : round (x - y) = round x - y :=
by { rw [sub_eq_add_neg, ← int.cast_coe_nat], norm_cast, rw [round_add_int, sub_eq_add_neg] }

@[simp]
lemma round_int_add (x : α) (y : ℤ) : round ((y : α) + x) = y + round x :=
by { rw [add_comm, round_add_int, add_comm] }

@[simp]
lemma round_nat_add (x : α) (y : ℕ) : round ((y : α) + x) = y + round x :=
by { rw [add_comm, round_add_nat, add_comm] }

lemma abs_sub_round_eq_min (x : α) : |x - round x| = min (fract x) (1 - fract x) :=
begin
  simp_rw [round, min_def_lt, two_mul, ← lt_tsub_iff_left],
  cases lt_or_ge (fract x) (1 - fract x) with hx hx,
  { rw [if_pos hx, if_pos hx, self_sub_floor, abs_fract], },
  { have : 0 < fract x,
    { replace hx : 0 < fract x + fract x := lt_of_lt_of_le zero_lt_one (tsub_le_iff_left.mp hx),
      simpa only [← two_mul, zero_lt_mul_left, zero_lt_two] using hx, },
    rw [if_neg (not_lt.mpr hx), if_neg (not_lt.mpr hx), abs_sub_comm, ceil_sub_self_eq this.ne.symm,
      abs_one_sub_fract], },
end

lemma round_le (x : α) (z : ℤ) : |x - round x| ≤ |x - z| :=
begin
  rw [abs_sub_round_eq_min, min_le_iff],
  rcases le_or_lt (z : α) x with hx | hx; [left, right],
  { conv_rhs { rw [abs_eq_self.mpr (sub_nonneg.mpr hx), ← fract_add_floor x, add_sub_assoc], },
    simpa only [le_add_iff_nonneg_right, sub_nonneg, cast_le] using le_floor.mpr hx, },
  { rw abs_eq_neg_self.mpr (sub_neg.mpr hx).le,
    conv_rhs { rw ← fract_add_floor x, },
    rw [add_sub_assoc, add_comm, neg_add, neg_sub, le_add_neg_iff_add_le, sub_add_cancel,
      le_sub_comm],
    norm_cast,
    exact floor_le_sub_one_iff.mpr hx, },
end

end linear_ordered_ring

section linear_ordered_field

variables [linear_ordered_field α] [floor_ring α]

lemma round_eq (x : α) : round x = ⌊x + 1 / 2⌋ :=
begin
  simp_rw [round, (by simp only [lt_div_iff', two_pos] : 2 * fract x < 1 ↔ fract x < 1 / 2)],
  cases lt_or_ge (fract x) (1 / 2) with hx hx,
  { conv_rhs { rw [← fract_add_floor x, add_assoc, add_left_comm, floor_int_add], },
    rw [if_pos hx, self_eq_add_right, floor_eq_iff, cast_zero, zero_add],
    split; linarith [fract_nonneg x], },
  { have : ⌊fract x + 1 / 2⌋ = 1, { rw floor_eq_iff, split; norm_num; linarith [fract_lt_one x], },
    rw [if_neg (not_lt.mpr hx), ← fract_add_floor x, add_assoc, add_left_comm, floor_int_add,
      ceil_add_int, add_comm _ ⌊x⌋, add_right_inj, ceil_eq_iff, this, cast_one, sub_self],
    split; linarith [fract_lt_one x], },
end

@[simp] lemma round_two_inv : round (2⁻¹ : α) = 1 :=
by simp only [round_eq, ← one_div, add_halves', floor_one]

@[simp] lemma round_neg_two_inv : round (-2⁻¹ : α) = 0 :=
by simp only [round_eq, ← one_div, add_left_neg, floor_zero]

@[simp] lemma round_eq_zero_iff {x : α} : round x = 0 ↔ x ∈ Ico (-(1 / 2)) ((1 : α)/2) :=
begin
  rw [round_eq, floor_eq_zero_iff, add_mem_Ico_iff_left],
  norm_num,
end

lemma abs_sub_round (x : α) : |x - round x| ≤ 1 / 2 :=
begin
  rw [round_eq, abs_sub_le_iff],
  have := floor_le (x + 1 / 2),
  have := lt_floor_add_one (x + 1 / 2),
  split; linarith
end

lemma abs_sub_round_div_nat_cast_eq {m n : ℕ} :
  |(m : α) / n - round ((m : α) / n)| = ↑(min (m % n) (n - m % n)) / n :=
begin
  rcases n.eq_zero_or_pos with rfl | hn, { simp, },
  have hn' : 0 < (n : α), { norm_cast, assumption, },
  rw [abs_sub_round_eq_min, nat.cast_min, ← min_div_div_right hn'.le,
    fract_div_nat_cast_eq_div_nat_cast_mod, nat.cast_sub (m.mod_lt hn).le, sub_div,
    div_self hn'.ne.symm],
end

end linear_ordered_field

end round

namespace nat
variables [linear_ordered_semiring α] [linear_ordered_semiring β] [floor_semiring α]
  [floor_semiring β] [ring_hom_class F α β] {a : α} {b : β}
include β

lemma floor_congr (h : ∀ n : ℕ, (n : α) ≤ a ↔ (n : β) ≤ b) : ⌊a⌋₊ = ⌊b⌋₊ :=
begin
  have h₀ : 0 ≤ a ↔ 0 ≤ b := by simpa only [cast_zero] using h 0,
  obtain ha | ha := lt_or_le a 0,
  { rw [floor_of_nonpos ha.le, floor_of_nonpos (le_of_not_le $ h₀.not.mp ha.not_le)] },
  exact (le_floor $ (h _).1 $ floor_le ha).antisymm (le_floor $ (h _).2 $ floor_le $ h₀.1 ha),
end

lemma ceil_congr (h : ∀ n : ℕ, a ≤ n ↔ b ≤ n) : ⌈a⌉₊ = ⌈b⌉₊ :=
(ceil_le.2 $ (h _).2 $ le_ceil _).antisymm $ ceil_le.2 $ (h _).1 $ le_ceil _

lemma map_floor (f : F) (hf : strict_mono f) (a : α) : ⌊f a⌋₊ = ⌊a⌋₊ :=
floor_congr $ λ n, by rw [←map_nat_cast f, hf.le_iff_le]

lemma map_ceil (f : F) (hf : strict_mono f) (a : α) : ⌈f a⌉₊ = ⌈a⌉₊ :=
ceil_congr $ λ n, by rw [←map_nat_cast f, hf.le_iff_le]

end nat

namespace int
variables [linear_ordered_ring α] [linear_ordered_ring β] [floor_ring α] [floor_ring β]
  [ring_hom_class F α β] {a : α} {b : β}
include β

lemma floor_congr (h : ∀ n : ℤ, (n : α) ≤ a ↔ (n : β) ≤ b) : ⌊a⌋ = ⌊b⌋ :=
(le_floor.2 $ (h _).1 $ floor_le _).antisymm $ le_floor.2 $ (h _).2 $ floor_le _

lemma ceil_congr (h : ∀ n : ℤ, a ≤ n ↔ b ≤ n) : ⌈a⌉ = ⌈b⌉ :=
(ceil_le.2 $ (h _).2 $ le_ceil _).antisymm $ ceil_le.2 $ (h _).1 $ le_ceil _

lemma map_floor (f : F) (hf : strict_mono f) (a : α) : ⌊f a⌋ = ⌊a⌋ :=
floor_congr $ λ n, by rw [←map_int_cast f, hf.le_iff_le]

lemma map_ceil (f : F) (hf : strict_mono f) (a : α) : ⌈f a⌉ = ⌈a⌉ :=
ceil_congr $ λ n, by rw [←map_int_cast f, hf.le_iff_le]

lemma map_fract (f : F) (hf : strict_mono f) (a : α) : fract (f a) = f (fract a) :=
by simp_rw [fract, map_sub, map_int_cast, map_floor _ hf]

end int

namespace int
variables [linear_ordered_field α] [linear_ordered_field β] [floor_ring α] [floor_ring β]
  [ring_hom_class F α β] {a : α} {b : β}
include β

lemma map_round (f : F) (hf : strict_mono f) (a : α) : round (f a) = round a :=
by simp_rw [round_eq, ←map_floor _ hf, map_add, one_div, map_inv₀, map_bit0, map_one]

end int

section floor_ring_to_semiring
variables {α} [linear_ordered_ring α] [floor_ring α]

/-! #### A floor ring as a floor semiring -/

@[priority 100] -- see Note [lower instance priority]
instance _root_.floor_ring.to_floor_semiring : floor_semiring α :=
{ floor := λ a, ⌊a⌋.to_nat,
  ceil := λ a, ⌈a⌉.to_nat,
  floor_of_neg := λ a ha, int.to_nat_of_nonpos (int.floor_nonpos ha.le),
  gc_floor := λ a n ha,
    by rw [int.le_to_nat_iff (int.floor_nonneg.2 ha), int.le_floor, int.cast_coe_nat],
  gc_ceil := λ a n, by rw [int.to_nat_le, int.ceil_le, int.cast_coe_nat] }

lemma int.floor_to_nat (a : α) : ⌊a⌋.to_nat = ⌊a⌋₊ := rfl

lemma int.ceil_to_nat  (a : α) : ⌈a⌉.to_nat = ⌈a⌉₊ := rfl

@[simp] lemma nat.floor_int : (nat.floor : ℤ → ℕ) = int.to_nat := rfl
@[simp] lemma nat.ceil_int : (nat.ceil : ℤ → ℕ) = int.to_nat := rfl

variables {a : α}

lemma nat.cast_floor_eq_int_floor (ha : 0 ≤ a) : (⌊a⌋₊ : ℤ) = ⌊a⌋ :=
by rw [←int.floor_to_nat, int.to_nat_of_nonneg (int.floor_nonneg.2 ha)]

lemma nat.cast_floor_eq_cast_int_floor (ha : 0 ≤ a) : (⌊a⌋₊ : α) = ⌊a⌋ :=
by rw [←nat.cast_floor_eq_int_floor ha, int.cast_coe_nat]

lemma nat.cast_ceil_eq_int_ceil (ha : 0 ≤ a) : (⌈a⌉₊ : ℤ) = ⌈a⌉ :=
by { rw [←int.ceil_to_nat, int.to_nat_of_nonneg (int.ceil_nonneg ha)] }

lemma nat.cast_ceil_eq_cast_int_ceil (ha : 0 ≤ a) : (⌈a⌉₊ : α) = ⌈a⌉ :=
by rw [←nat.cast_ceil_eq_int_ceil ha, int.cast_coe_nat]

end floor_ring_to_semiring

/-- There exists at most one `floor_ring` structure on a given linear ordered ring. -/
lemma subsingleton_floor_ring {α} [linear_ordered_ring α] :
  subsingleton (floor_ring α) :=
begin
  refine ⟨λ H₁ H₂, _⟩,
  have : H₁.floor = H₂.floor := funext (λ a, H₁.gc_coe_floor.u_unique H₂.gc_coe_floor $ λ _, rfl),
  have : H₁.ceil = H₂.ceil := funext (λ a, H₁.gc_ceil_coe.l_unique H₂.gc_ceil_coe $ λ _, rfl),
  cases H₁, cases H₂, congr; assumption
end

namespace tactic
open positivity

private lemma int_floor_nonneg [linear_ordered_ring α] [floor_ring α] {a : α} (ha : 0 ≤ a) :
  0 ≤ ⌊a⌋ := int.floor_nonneg.2 ha
private lemma int_floor_nonneg_of_pos [linear_ordered_ring α] [floor_ring α] {a : α} (ha : 0 < a) :
  0 ≤ ⌊a⌋ := int_floor_nonneg ha.le

/-- Extension for the `positivity` tactic: `int.floor` is nonnegative if its input is. -/
@[positivity]
meta def positivity_floor : expr → tactic strictness
| `(⌊%%a⌋) := do
      strictness_a ← core a,
      match strictness_a with
      | positive p := nonnegative <$> mk_app ``int_floor_nonneg_of_pos [p]
      | nonnegative p := nonnegative <$> mk_app ``int_floor_nonneg [p]
      | _ := failed
      end
| e := pp e >>= fail ∘ format.bracket "The expression `" "` is not of the form `⌊a⌋`"

private lemma nat_ceil_pos [linear_ordered_semiring α] [floor_semiring α] {a : α} :
  0 < a → 0 < ⌈a⌉₊ := nat.ceil_pos.2
private lemma int_ceil_pos [linear_ordered_ring α] [floor_ring α] {a : α} : 0 < a → 0 < ⌈a⌉ :=
int.ceil_pos.2

/-- Extension for the `positivity` tactic: `ceil` and `int.ceil` are positive/nonnegative if
their input is. -/
@[positivity]
meta def positivity_ceil : expr → tactic strictness
| `(⌈%%a⌉₊) := do
      positive p ← core a, -- We already know `0 ≤ n` for all `n : ℕ`
      positive <$> mk_app ``nat_ceil_pos [p]
| `(⌈%%a⌉) := do
      strictness_a ← core a,
      match strictness_a with
      | positive p := positive <$> mk_app ``int_ceil_pos [p]
      | nonnegative p := nonnegative <$> mk_app ``int.ceil_nonneg [p]
      | _ := failed
      end
| e := pp e >>= fail ∘ format.bracket "The expression `" "` is not of the form `⌈a⌉₊` nor `⌈a⌉`"

end tactic


import tactic

/-!

# The partition challenge!

Prove that equivalence relations on α are the same as partitions of α.

Three sections:

1) partitions
2) equivalence classes
3) the challenge

Say `α` is a type, and `R` is a binary relation on `α`.
The following things are already in Lean:

reflexive R := ∀ (x : α), R x x
symmetric R := ∀ ⦃x y : α⦄, R x y → R y x
transitive R := ∀ ⦃x y z : α⦄, R x y → R y z → R x z

equivalence R := reflexive R ∧ symmetric R ∧ transitive R

In the file below, we will define partitions of `α` and "build some
interface" (i.e. prove some propositions). We will define
equivalence classes and do the same thing.
Finally, we will prove that there's a bijection between
equivalence relations on `α` and partitions of `α`.

-/

/-

# 1) Partitions

We define a partition, and prove some easy lemmas.

-/

/-

## Definition of a partition

Let `α` be a type. A *partition* on `α` is defined to be
the following data:

1) A set C of subsets of α, called "blocks".
2) A hypothesis (i.e. a proof!) that all the blocks are non-empty.
3) A hypothesis that every term of type α is in one of the blocks.
4) A hypothesis that two blocks with non-empty intersection are equal.
-/

/-- The structure of a partition on a Type α. -/
@[ext] structure partition (α : Type) :=
(C : set (set α))
(Hnonempty : ∀ X ∈ C, (X : set α).nonempty)
(Hcover : ∀ a, ∃ X ∈ C, a ∈ X)
(Hdisjoint : ∀ X Y ∈ C, (X ∩ Y : set α).nonempty → X = Y)

-- docstrings

/-- The set of blocks. -/
add_decl_doc partition.C

/-- Every element of a block is nonempty. -/
add_decl_doc partition.Hnonempty

/-- The blocks cover the type they partition -/
add_decl_doc partition.Hcover

/-- Two blocks which share an element are equal -/
add_decl_doc partition.Hdisjoint

/-

## Basic interface for partitions

-/

namespace partition

-- let α be a type, and fix a partition P on α. Let X and Y be subsets of α.
variables {α : Type} {P : partition α} {X Y : set α}

/-- If X and Y are blocks, and a is in X and Y, then X = Y. -/
theorem eq_of_mem (hX : X ∈ P.C) (hY : Y ∈ P.C) {a : α} (haX : a ∈ X)
  (haY : a ∈ Y) : X = Y :=
-- Proof: follows immediately from the disjointness hypothesis.
P.Hdisjoint _ hX _ hY ⟨a, haX, haY⟩

/-- If a is in two blocks X and Y, and if b is in X,
  then b is in Y (as X=Y) -/
theorem mem_of_mem (hX : X ∈ P.C) (hY : Y ∈ P.C) {a b : α}
  (haX : a ∈ X) (haY : a ∈ Y) (hbX : b ∈ X) : b ∈ Y :=
begin
  -- *great* place to teach convert here
  convert hbX,
  apply eq_of_mem hY hX haY haX,
end

theorem mem_block (a : α) : ∃ X : set α, X ∈ P.C ∧ a ∈ X :=
begin
  -- new tactic
  rcases P.Hcover a with ⟨X, hX, haX⟩,
--  obtain ⟨X, hX, haX⟩ := P.Hcover a,
  use X,
  split,
    assumption,
  exact haX,
end

end partition

/-

# 2) Equivalence classes.

We define equivalence classes and prove a few basic results about them.

-/

section equivalence_classes

/-!

## Definition of equivalence classes

-/

-- Notation and variables for the equivalence class section:

-- let α be a type, and let R be an equivalence relation on R.
variables {α : Type} (R : α → α → Prop)

/-- The equivalence class of `x` is the set of `y` related to `x`. -/
def cl (x : α) :=
{y : α | R y x}

/-!

## Basic lemmas about equivalence classes

-/

/-- Useful for rewriting -- `y` is in the equivalence class of `x` iff
`y` is related to `x`. True by definition. -/
theorem cl_def {x y : α} : x ∈ cl R y ↔ R x y := iff.rfl

variables {R} (hR : equivalence R)

include hR

/-- x is in cl(x) -/
lemma mem_cl_self (x : α) :
  x ∈ cl R x :=
begin
  rcases hR with ⟨hrefl, hsymm, htrans⟩,
  -- rw on ↔
  rw cl_def,
  -- understand how to use hrefl
  apply hrefl,
end

lemma cl_sub_cl_of_mem_cl {x y : α} :
  x ∈ cl R y →
  cl R x ⊆ cl R y :=
begin
  rcases hR with ⟨hrefl, hsymm, htrans⟩,
  intro h,
  rw cl_def at h,
  -- new thing
  -- understand def of subset
  rw set.subset_def,
  intro z,
  intro hzx,
  rw cl_def at hzx ⊢,
  unfold transitive at htrans,
  apply htrans,
    exact hzx,
  exact h,
end

lemma cl_eq_cl_of_mem_cl {x y : α} :
  x ∈ cl R y →
  cl R x = cl R y :=
begin
  intro hxy,
  -- new function, find with library_search
  apply set.subset.antisymm,
    apply cl_sub_cl_of_mem_cl hR,
    assumption,
  apply cl_sub_cl_of_mem_cl hR,
  rcases hR with ⟨hrefl, hsymm, htrans⟩,
  apply hsymm,
  assumption,
end

end equivalence_classes -- section

/-!

# 3) The challenge!

Let `α` be a type (i.e. a collection of stucff).

There is a bijection between equivalence relations on `α` and
partitions of `α`.

We prove this by writing down constructions in each direction
and proving that the constructions are two-sided inverses of one another.
-/

open partition

example (α : Type) : {R : α → α → Prop // equivalence R} ≃ partition α :=
-- We define functions in both directions and prove that one is a two-sided
-- inverse of the other
{ -- Here is the first function (construction), from equivalence
  -- relations to partitions.
  -- Let R be an equivalence relation.
  to_fun := λ R, {
    -- Let C be the set of equivalence classes for R.
    C := { B : set α | ∃ x : α, B = cl R.1 x},
    -- I claim that C is a partition. We need to check the three
    -- hypotheses for a partition (`Hnonempty`, `Hcover` and `Hdisjoint`),
    -- so we need to supply three proofs.
    Hnonempty := begin
      cases R with R hR,
      -- If X is an equivalence class then X is nonempty.
      show ∀ (X : set α), (∃ (a : α), X = cl R a) → X.nonempty,
      rintros _ ⟨a, rfl⟩,
--      unfold set.nonempty,
      use a,
      rw cl_def,
      rcases hR with ⟨hrefl, hsymm, htrans⟩,
      apply hrefl,
    end,
    Hcover := begin
      cases R with R hR,
      -- The equivalence classes cover α
      show ∀ (a : α), ∃ (X : set α) (H : ∃ (b : α), X = cl R b), a ∈ X,
      intro a,
      use cl R a,
      split,
        use a,
      apply hR.1,
    end,
    Hdisjoint := begin
      cases R with R hR,
      -- If two equivalence classes overlap, they are equal.
      show ∀ (X : set α), (∃ (a : α), X = cl R a) →
        ∀ (Y : set α), (∃ (b : α), Y = cl _ b) → (X ∩ Y).nonempty → X = Y,
      rintros X ⟨a, rfl⟩ Y ⟨b, rfl⟩ ⟨c, hca, hcb⟩,
      apply cl_eq_cl_of_mem_cl hR,
      apply hR.2.2,
        apply hR.2.1,
        exact hca,
      exact hcb,
    end },
  -- Conversely, say P is an partition.
  inv_fun := λ P,
    -- Let's define a binary relation by x ~ y iff every block containing a,
    -- also contains b. Because only one block contains a, this will work,
    -- and it turns out to be a nice way of thinking about it.
    ⟨λ a b, ∀ X ∈ P.C, a ∈ X → b ∈ X, begin
      -- I claim this is an equivalence relation.
    split,
    { -- It's reflexive
      show ∀ (a : α)
        (X : set α), X ∈ P.C → a ∈ X → a ∈ X,
      intros a X hXC haX,
      assumption,
    },
    split,
    { -- it's symmetric
      show ∀ (a b : α),
        (∀ (X : set α), X ∈ P.C → a ∈ X → b ∈ X) →
         ∀ (X : set α), X ∈ P.C → b ∈ X → a ∈ X,
      intros a b h X hX hbX,
      -- need to know something about how to use partitions.
      obtain ⟨Y, hY, haY⟩ := P.Hcover a,
      specialize h Y hY haY,
      exact mem_of_mem hY hX h hbX haY,
    },
    { -- it's transitive
      unfold transitive,
      show ∀ (a b c : α),
        (∀ (X : set α), X ∈ P.C → a ∈ X → b ∈ X) →
        (∀ (X : set α), X ∈ P.C → b ∈ X → c ∈ X) →
         ∀ (X : set α), X ∈ P.C → a ∈ X → c ∈ X,
      intros a b c hbX hcX X hX haX,
      apply hcX, assumption,
      apply hbX, assumption,
      assumption,
    }
  end⟩,
  -- If you start with the equivalence relation, and then make the partition
  -- and a new equivalence relation, you get back to where you started.
  left_inv := begin
    rintro ⟨R, hR⟩,
    -- Tidying up the mess...
    suffices : (λ (a b : α), ∀ (c : α), a ∈ cl R c → b ∈ cl R c) = R,
      simpa,
    -- ... you have to prove two binary relations are equal.
    ext a b,
    -- so you have to prove an if and only if.
    show (∀ (c : α), a ∈ cl R c → b ∈ cl R c) ↔ R a b,
    split,
    { intros hab,
      apply hR.2.1,
      apply hab,
      apply hR.1,
    },
    { intros hab c hac,
      apply hR.2.2,
        apply hR.2.1,
        exact hab,
      exact hac,
    }
  end,
  -- Similarly, if you start with the partition, and then make the
  -- equivalence relation, and then construct the corresponding partition
  -- into equivalence classes, you have the same partition you started with.
  right_inv := begin
    -- Let P be a partition
    intro P,
    -- It suffices to prove that a subset X is in the original partition
    -- if and only if it's in the one made from the equivalence relation.
    ext X,
    show (∃ (a : α), X = cl _ a) ↔ X ∈ P.C,
    split,
    { rintro ⟨a, rfl⟩,
      obtain ⟨X, hX, haX⟩ := P.Hcover a,
      convert hX,
      ext b,
      rw cl_def,
      dsimp,
      split,
      { intro haY,
      obtain ⟨Y, hY, hbY⟩ := P.Hcover b,
      specialize haY Y hY hbY,
      convert hbY,
      exact eq_of_mem hX hY haX haY,
      },
      { intros hbX Y hY hbY,
        apply mem_of_mem hX hY hbX hbY haX,
      }
    },
    { intro hX,
      rcases P.Hnonempty X hX with ⟨a, ha⟩,
      use a,
      ext b,
      split,
      { intro hbX,
        rw cl_def,
        dsimp,
        intros Y hY hbY,
        exact mem_of_mem hX hY hbX hbY ha,
      },
      { rw cl_def,
        dsimp,
        intro haY,
        obtain ⟨Y, hY, hbY⟩ := P.Hcover b,
        specialize haY Y hY hbY,
        exact mem_of_mem hY hX haY ha hbY,
      }
    }
  end }

/-
-- get these files with
leanproject get ImperialCollegeLondon/M40001_lean

-/


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.set.pointwise
import order.conditionally_complete_lattice

/-!
# Upper/lower bounds in ordered monoids and groups

In this file we prove a few facts like “`-s` is bounded above iff `s` is bounded below”
(`bdd_above_neg`).
-/

open function set
open_locale pointwise

section inv_neg

variables {G : Type*} [group G] [preorder G] [covariant_class G G (*) (≤)]
  [covariant_class G G (swap (*)) (≤)] {s : set G} {a : G}

@[simp, to_additive]
lemma bdd_above_inv : bdd_above s⁻¹ ↔ bdd_below s := (order_iso.inv G).bdd_above_preimage

@[simp, to_additive]
lemma bdd_below_inv : bdd_below s⁻¹ ↔ bdd_above s := (order_iso.inv G).bdd_below_preimage

@[to_additive]
lemma bdd_above.inv (h : bdd_above s) : bdd_below s⁻¹ := bdd_below_inv.2 h

@[to_additive]
lemma bdd_below.inv (h : bdd_below s) : bdd_above s⁻¹ := bdd_above_inv.2 h

@[simp, to_additive]
lemma is_lub_inv : is_lub s⁻¹ a ↔ is_glb s a⁻¹ := (order_iso.inv G).is_lub_preimage

@[to_additive]
lemma is_lub_inv' : is_lub s⁻¹ a⁻¹ ↔ is_glb s a := (order_iso.inv G).is_lub_preimage'

@[to_additive]
lemma is_glb.inv (h : is_glb s a) : is_lub s⁻¹ a⁻¹ := is_lub_inv'.2 h

@[simp, to_additive]
lemma is_glb_inv : is_glb s⁻¹ a ↔ is_lub s a⁻¹ := (order_iso.inv G).is_glb_preimage

@[to_additive]
lemma is_glb_inv' : is_glb s⁻¹ a⁻¹ ↔ is_lub s a := (order_iso.inv G).is_glb_preimage'

@[to_additive]
lemma is_lub.inv (h : is_lub s a) : is_glb s⁻¹ a⁻¹ := is_glb_inv'.2 h

end inv_neg

section mul_add

variables {M : Type*} [has_mul M] [preorder M] [covariant_class M M (*) (≤)]
  [covariant_class M M (swap (*)) (≤)]

@[to_additive] lemma mul_mem_upper_bounds_mul {s t : set M} {a b : M} (ha : a ∈ upper_bounds s)
  (hb : b ∈ upper_bounds t) :
  a * b ∈ upper_bounds (s * t) :=
forall_image2_iff.2 $ λ x hx y hy, mul_le_mul' (ha hx) (hb hy)

@[to_additive] lemma subset_upper_bounds_mul (s t : set M) :
  upper_bounds s * upper_bounds t ⊆ upper_bounds (s * t) :=
image2_subset_iff.2 $ λ x hx y hy, mul_mem_upper_bounds_mul hx hy

@[to_additive] lemma mul_mem_lower_bounds_mul {s t : set M} {a b : M} (ha : a ∈ lower_bounds s)
  (hb : b ∈ lower_bounds t) : a * b ∈ lower_bounds (s * t) :=
@mul_mem_upper_bounds_mul (order_dual M) _ _ _ _ _ _ _ _ ha hb

@[to_additive] lemma subset_lower_bounds_mul (s t : set M) :
  lower_bounds s * lower_bounds t ⊆ lower_bounds (s * t) :=
@subset_upper_bounds_mul (order_dual M) _ _ _ _ _ _

@[to_additive] lemma bdd_above.mul {s t : set M} (hs : bdd_above s) (ht : bdd_above t) :
  bdd_above (s * t) :=
(hs.mul ht).mono (subset_upper_bounds_mul s t)

@[to_additive] lemma bdd_below.mul {s t : set M} (hs : bdd_below s) (ht : bdd_below t) :
  bdd_below (s * t) :=
(hs.mul ht).mono (subset_lower_bounds_mul s t)

end mul_add

section conditionally_complete_lattice

section right

variables {ι G : Type*} [group G] [conditionally_complete_lattice G]
  [covariant_class G G (function.swap (*)) (≤)] [nonempty ι] {f : ι → G}

@[to_additive] lemma csupr_mul (hf : bdd_above (set.range f)) (a : G) :
  (⨆ i, f i) * a = ⨆ i, f i * a :=
(order_iso.mul_right a).map_csupr hf

@[to_additive] lemma csupr_div (hf : bdd_above (set.range f)) (a : G) :
  (⨆ i, f i) / a = ⨆ i, f i / a :=
by simp only [div_eq_mul_inv, csupr_mul hf]

end right

section left

variables {ι G : Type*} [group G] [conditionally_complete_lattice G]
  [covariant_class G G (*) (≤)] [nonempty ι] {f : ι → G}

@[to_additive] lemma mul_csupr (hf : bdd_above (set.range f)) (a : G) :
  a * (⨆ i, f i) = ⨆ i, a * f i :=
(order_iso.mul_left a).map_csupr hf

end left

end conditionally_complete_lattice


import algebra.module.linear_map
import linear_algebra.basic
import data.real.basic

theorem cpge_applin_11
(R : Type*) (E : Type*) (F : Type*)
[field R]
[add_comm_group E] [module R E]
[add_comm_group F] [module R F]
(f g : linear_map R E F)
:
(∀ x, ∃ (l:R), (g x) = l • (f x)) -> ∃ (l:R), (∀ x, g x = (l • f x)) := sorry


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Yaël Dillies
-/
import data.set.lattice
import data.set_like.basic
import order.galois_connection
import order.hom.basic
import tactic.monotonicity

/-!
# Closure operators between preorders

We define (bundled) closure operators on a preorder as monotone (increasing), extensive
(inflationary) and idempotent functions.
We define closed elements for the operator as elements which are fixed by it.

Lower adjoints to a function between preorders `u : β → α` allow to generalise closure operators to
situations where the closure operator we are dealing with naturally decomposes as `u ∘ l` where `l`
is a worthy function to have on its own. Typical examples include
`l : set G → subgroup G := subgroup.closure`, `u : subgroup G → set G := coe`, where `G` is a group.
This shows there is a close connection between closure operators, lower adjoints and Galois
connections/insertions: every Galois connection induces a lower adjoint which itself induces a
closure operator by composition (see `galois_connection.lower_adjoint` and
`lower_adjoint.closure_operator`), and every closure operator on a partial order induces a Galois
insertion from the set of closed elements to the underlying type (see `closure_operator.gi`).

## Main definitions

* `closure_operator`: A closure operator is a monotone function `f : α → α` such that
  `∀ x, x ≤ f x` and `∀ x, f (f x) = f x`.
* `lower_adjoint`: A lower adjoint to `u : β → α` is a function `l : α → β` such that `l` and `u`
  form a Galois connection.

## Implementation details

Although `lower_adjoint` is technically a generalisation of `closure_operator` (by defining
`to_fun := id`), it is desirable to have both as otherwise `id`s would be carried all over the
place when using concrete closure operators such as `convex_hull`.

`lower_adjoint` really is a semibundled `structure` version of `galois_connection`.

## References

* https://en.wikipedia.org/wiki/Closure_operator#Closure_operators_on_partially_ordered_sets
-/

universe u

/-! ### Closure operator -/

variable (α : Type*)

/-- A closure operator on the preorder `α` is a monotone function which is extensive (every `x`
is less than its closure) and idempotent. -/
structure closure_operator [preorder α] extends α →o α :=
(le_closure' : ∀ x, x ≤ to_fun x)
(idempotent' : ∀ x, to_fun (to_fun x) = to_fun x)

namespace closure_operator

instance [preorder α] : has_coe_to_fun (closure_operator α) (λ _, α → α) := ⟨λ c, c.to_fun⟩

/-- See Note [custom simps projection] -/
def simps.apply [preorder α] (f : closure_operator α) : α → α := f

initialize_simps_projections closure_operator (to_order_hom_to_fun → apply, -to_order_hom)

section partial_order
variable [partial_order α]

/-- The identity function as a closure operator. -/
@[simps]
def id : closure_operator α :=
{ to_order_hom := order_hom.id,
  le_closure' := λ _, le_rfl,
  idempotent' := λ _, rfl }

instance : inhabited (closure_operator α) := ⟨id α⟩

variables {α} (c : closure_operator α)

@[ext] lemma ext :
  ∀ (c₁ c₂ : closure_operator α), (c₁ : α → α) = (c₂ : α → α) → c₁ = c₂
| ⟨⟨c₁, _⟩, _, _⟩ ⟨⟨c₂, _⟩, _, _⟩ h := by { congr, exact h }

/-- Constructor for a closure operator using the weaker idempotency axiom: `f (f x) ≤ f x`. -/
@[simps]
def mk' (f : α → α) (hf₁ : monotone f) (hf₂ : ∀ x, x ≤ f x) (hf₃ : ∀ x, f (f x) ≤ f x) :
  closure_operator α :=
{ to_fun := f,
  monotone' := hf₁,
  le_closure' := hf₂,
  idempotent' := λ x, (hf₃ x).antisymm (hf₁ (hf₂ x)) }

/-- Convenience constructor for a closure operator using the weaker minimality axiom:
`x ≤ f y → f x ≤ f y`, which is sometimes easier to prove in practice. -/
@[simps]
def mk₂ (f : α → α) (hf : ∀ x, x ≤ f x) (hmin : ∀ ⦃x y⦄, x ≤ f y → f x ≤ f y) :
  closure_operator α :=
{ to_fun := f,
  monotone' := λ x y hxy, hmin (hxy.trans (hf y)),
  le_closure' := hf,
  idempotent' := λ x, (hmin le_rfl).antisymm (hf _) }

/-- Expanded out version of `mk₂`. `p` implies being closed. This constructor should be used when
you already know a sufficient condition for being closed and using `mem_mk₃_closed` will avoid you
the (slight) hassle of having to prove it both inside and outside the constructor. -/
@[simps]
def mk₃ (f : α → α) (p : α → Prop) (hf : ∀ x, x ≤ f x) (hfp : ∀ x, p (f x))
  (hmin : ∀ ⦃x y⦄, x ≤ y → p y → f x ≤ y) :
  closure_operator α :=
mk₂ f hf (λ x y hxy, hmin hxy (hfp y))

/-- This lemma shows that the image of `x` of a closure operator built from the `mk₃` constructor
respects `p`, the property that was fed into it. -/
lemma closure_mem_mk₃ {f : α → α} {p : α → Prop} {hf : ∀ x, x ≤ f x} {hfp : ∀ x, p (f x)}
  {hmin : ∀ ⦃x y⦄, x ≤ y → p y → f x ≤ y} (x : α) :
  p (mk₃ f p hf hfp hmin x) :=
hfp x

/-- Analogue of `closure_le_closed_iff_le` but with the `p` that was fed into the `mk₃` constructor.
-/
lemma closure_le_mk₃_iff {f : α → α} {p : α → Prop} {hf : ∀ x, x ≤ f x} {hfp : ∀ x, p (f x)}
  {hmin : ∀ ⦃x y⦄, x ≤ y → p y → f x ≤ y} {x y : α} (hxy : x ≤ y) (hy : p y) :
  mk₃ f p hf hfp hmin x ≤ y :=
hmin hxy hy

@[mono]

/-- Every element is less than its closure. This property is sometimes referred to as extensivity or
inflationarity. -/
lemma le_closure (x : α) : x ≤ c x := c.le_closure' x

@[simp] lemma idempotent (x : α) : c (c x) = c x := c.idempotent' x

lemma le_closure_iff (x y : α) : x ≤ c y ↔ c x ≤ c y :=
⟨λ h, c.idempotent y ▸ c.monotone h, λ h, (c.le_closure x).trans h⟩

/-- An element `x` is closed for the closure operator `c` if it is a fixed point for it. -/
def closed : set α := λ x, c x = x

lemma mem_closed_iff (x : α) : x ∈ c.closed ↔ c x = x := iff.rfl

lemma mem_closed_iff_closure_le (x : α) : x ∈ c.closed ↔ c x ≤ x :=
⟨le_of_eq, λ h, h.antisymm (c.le_closure x)⟩

lemma closure_eq_self_of_mem_closed {x : α} (h : x ∈ c.closed) : c x = x := h

@[simp] lemma closure_is_closed (x : α) : c x ∈ c.closed := c.idempotent x

/-- The set of closed elements for `c` is exactly its range. -/
lemma closed_eq_range_close : c.closed = set.range c :=
set.ext $ λ x, ⟨λ h, ⟨x, h⟩, by { rintro ⟨y, rfl⟩, apply c.idempotent }⟩

/-- Send an `x` to an element of the set of closed elements (by taking the closure). -/
def to_closed (x : α) : c.closed := ⟨c x, c.closure_is_closed x⟩

@[simp] lemma closure_le_closed_iff_le (x : α) {y : α} (hy : c.closed y) : c x ≤ y ↔ x ≤ y :=
by rw [←c.closure_eq_self_of_mem_closed hy, ←le_closure_iff]

/-- A closure operator is equal to the closure operator obtained by feeding `c.closed` into the
`mk₃` constructor. -/
lemma eq_mk₃_closed (c : closure_operator α) :
  c = mk₃ c c.closed c.le_closure c.closure_is_closed
  (λ x y hxy hy, (c.closure_le_closed_iff_le x hy).2 hxy) :=
by { ext, refl }

/-- The property `p` fed into the `mk₃` constructor implies being closed. -/
lemma mem_mk₃_closed {f : α → α} {p : α → Prop} {hf : ∀ x, x ≤ f x} {hfp : ∀ x, p (f x)}
  {hmin : ∀ ⦃x y⦄, x ≤ y → p y → f x ≤ y} {x : α} (hx : p x) :
  x ∈ (mk₃ f p hf hfp hmin).closed :=
(hmin le_rfl hx).antisymm (hf _)

end partial_order

variable {α}

section order_top
variables [partial_order α] [order_top α] (c : closure_operator α)

@[simp] lemma closure_top : c ⊤ = ⊤ :=
le_top.antisymm (c.le_closure _)

lemma top_mem_closed : ⊤ ∈ c.closed :=
c.closure_top

end order_top

lemma closure_inf_le [semilattice_inf α] (c : closure_operator α) (x y : α) :
  c (x ⊓ y) ≤ c x ⊓ c y :=
c.monotone.map_inf_le _ _

section semilattice_sup
variables [semilattice_sup α] (c : closure_operator α)

lemma closure_sup_closure_le (x y : α) :
  c x ⊔ c y ≤ c (x ⊔ y) :=
c.monotone.le_map_sup _ _

lemma closure_sup_closure_left (x y : α) :
  c (c x ⊔ y) = c (x ⊔ y) :=
((c.le_closure_iff _ _).1 (sup_le (c.monotone le_sup_left) (le_sup_right.trans
  (c.le_closure _)))).antisymm (c.monotone (sup_le_sup_right (c.le_closure _) _))

lemma closure_sup_closure_right (x y : α) :
  c (x ⊔ c y) = c (x ⊔ y) :=
by rw [sup_comm, closure_sup_closure_left, sup_comm]

lemma closure_sup_closure (x y : α) :
  c (c x ⊔ c y) = c (x ⊔ y) :=
by rw [closure_sup_closure_left, closure_sup_closure_right]

end semilattice_sup

section complete_lattice
variables [complete_lattice α] (c : closure_operator α)

lemma closure_supr_closure {ι : Type u} (x : ι → α) :
  c (⨆ i, c (x i)) = c (⨆ i, x i) :=
le_antisymm ((c.le_closure_iff _ _).1 (supr_le (λ i, c.monotone
  (le_supr x i)))) (c.monotone (supr_le_supr (λ i, c.le_closure _)))

lemma closure_bsupr_closure (p : α → Prop) :
  c (⨆ x (H : p x), c x) = c (⨆ x (H : p x), x) :=
le_antisymm ((c.le_closure_iff _ _).1 (bsupr_le (λ x hx, c.monotone
  (le_bsupr_of_le x hx (le_refl x))))) (c.monotone (bsupr_le_bsupr (λ x hx, c.le_closure x)))

end complete_lattice
end closure_operator

/-! ### Lower adjoint -/

variables {α} {β : Type*}

/-- A lower adjoint of `u` on the preorder `α` is a function `l` such that `l` and `u` form a Galois
connection. It allows us to define closure operators whose output does not match the input. In
practice, `u` is often `coe : β → α`. -/
structure lower_adjoint [preorder α] [preorder β] (u : β → α) :=
(to_fun : α → β)
(gc' : galois_connection to_fun u)

namespace lower_adjoint

variable (α)

/-- The identity function as a lower adjoint to itself. -/
@[simps]
protected def id [preorder α] : lower_adjoint (id : α → α) :=
{ to_fun := λ x, x,
  gc' := galois_connection.id }

variable {α}

instance [preorder α] : inhabited (lower_adjoint (id : α → α)) := ⟨lower_adjoint.id α⟩

section preorder
variables [preorder α] [preorder β] {u : β → α} (l : lower_adjoint u)

instance : has_coe_to_fun (lower_adjoint u) (λ _, α → β) := { coe := to_fun }

/-- See Note [custom simps projection] -/
def simps.apply : α → β := l

lemma gc : galois_connection l u := l.gc'

@[ext] lemma ext :
  ∀ (l₁ l₂ : lower_adjoint u), (l₁ : α → β) = (l₂ : α → β) → l₁ = l₂
| ⟨l₁, _⟩ ⟨l₂, _⟩ h := by { congr, exact h }

@[mono] lemma monotone : monotone (u ∘ l) := l.gc.monotone_u.comp l.gc.monotone_l

/-- Every element is less than its closure. This property is sometimes referred to as extensivity or
inflationarity. -/
lemma le_closure (x : α) : x ≤ u (l x) := l.gc.le_u_l _

end preorder

section partial_order
variables [partial_order α] [preorder β] {u : β → α} (l : lower_adjoint u)

/-- Every lower adjoint induces a closure operator given by the composition. This is the partial
order version of the statement that every adjunction induces a monad. -/
@[simps]
def closure_operator :
  closure_operator α :=
{ to_fun := λ x, u (l x),
  monotone' := l.monotone,
  le_closure' := l.le_closure,
  idempotent' := λ x, l.gc.u_l_u_eq_u (l x) }

lemma idempotent (x : α) : u (l (u (l x))) = u (l x) :=
l.closure_operator.idempotent _

lemma le_closure_iff (x y : α) : x ≤ u (l y) ↔ u (l x) ≤ u (l y) :=
l.closure_operator.le_closure_iff _ _

end partial_order

section preorder
variables [preorder α] [preorder β] {u : β → α} (l : lower_adjoint u)

/-- An element `x` is closed for `l : lower_adjoint u` if it is a fixed point: `u (l x) = x` -/
def closed : set α := λ x, u (l x) = x

lemma mem_closed_iff (x : α) : x ∈ l.closed ↔ u (l x) = x := iff.rfl

lemma closure_eq_self_of_mem_closed {x : α} (h : x ∈ l.closed) : u (l x) = x := h

end preorder

section partial_order
variables [partial_order α] [partial_order β] {u : β → α} (l : lower_adjoint u)

lemma mem_closed_iff_closure_le (x : α) : x ∈ l.closed ↔ u (l x) ≤ x :=
l.closure_operator.mem_closed_iff_closure_le _

@[simp] lemma closure_is_closed (x : α) : u (l x) ∈ l.closed := l.idempotent x

/-- The set of closed elements for `l` is the range of `u ∘ l`. -/
lemma closed_eq_range_close : l.closed = set.range (u ∘ l) :=
l.closure_operator.closed_eq_range_close

/-- Send an `x` to an element of the set of closed elements (by taking the closure). -/
def to_closed (x : α) : l.closed := ⟨u (l x), l.closure_is_closed x⟩

@[simp] lemma closure_le_closed_iff_le (x : α) {y : α} (hy : l.closed y) : u (l x) ≤ y ↔ x ≤ y :=
l.closure_operator.closure_le_closed_iff_le x hy

end partial_order

lemma closure_top [partial_order α] [order_top α] [preorder β] {u : β → α} (l : lower_adjoint u) :
  u (l ⊤) = ⊤ :=
l.closure_operator.closure_top

lemma closure_inf_le [semilattice_inf α] [preorder β] {u : β → α} (l : lower_adjoint u) (x y : α) :
  u (l (x ⊓ y)) ≤ u (l x) ⊓ u (l y) :=
l.closure_operator.closure_inf_le x y

section semilattice_sup
variables [semilattice_sup α] [preorder β] {u : β → α} (l : lower_adjoint u)

lemma closure_sup_closure_le (x y : α) :
  u (l x) ⊔ u (l y) ≤ u (l (x ⊔ y)) :=
l.closure_operator.closure_sup_closure_le x y

lemma closure_sup_closure_left (x y : α) :
  u (l (u (l x) ⊔ y)) = u (l (x ⊔ y)) :=
l.closure_operator.closure_sup_closure_left x y

lemma closure_sup_closure_right (x y : α) :
  u (l (x ⊔ u (l y))) = u (l (x ⊔ y)) :=
l.closure_operator.closure_sup_closure_right x y

lemma closure_sup_closure (x y : α) :
  u (l (u (l x) ⊔ u (l y))) = u (l (x ⊔ y)) :=
l.closure_operator.closure_sup_closure x y

end semilattice_sup

section complete_lattice
variables [complete_lattice α] [preorder β] {u : β → α} (l : lower_adjoint u)

lemma closure_supr_closure {ι : Type u} (x : ι → α) :
  u (l (⨆ i, u (l (x i)))) = u (l (⨆ i, x i)) :=
l.closure_operator.closure_supr_closure x

lemma closure_bsupr_closure (p : α → Prop) :
  u (l (⨆ x (H : p x), u (l x))) = u (l (⨆ x (H : p x), x)) :=
l.closure_operator.closure_bsupr_closure p

end complete_lattice

/- Lemmas for `lower_adjoint (coe : α → set β)`, where `set_like α β` -/
section coe_to_set
variables [set_like α β] (l : lower_adjoint (coe : α → set β))

lemma subset_closure (s : set β) : s ⊆ l s :=
l.le_closure s

lemma not_mem_of_not_mem_closure {s : set β} {P : β} (hP : P ∉ l s) : P ∉ s :=
λ h, hP (subset_closure _ s h)

lemma le_iff_subset (s : set β) (S : α) : l s ≤ S ↔ s ⊆ S :=
l.gc s S

lemma mem_iff (s : set β) (x : β) : x ∈ l s ↔ ∀ S : α, s ⊆ S → x ∈ S :=
by { simp_rw [←set_like.mem_coe, ←set.singleton_subset_iff, ←l.le_iff_subset],
  exact ⟨λ h S, h.trans, λ h, h _ le_rfl⟩ }

lemma eq_of_le {s : set β} {S : α} (h₁ : s ⊆ S) (h₂ : S ≤ l s) : l s = S :=
((l.le_iff_subset _ _).2 h₁).antisymm h₂

lemma closure_union_closure_subset (x y : α) :
  (l x : set β) ∪ (l y) ⊆ l (x ∪ y) :=
l.closure_sup_closure_le x y

@[simp] lemma closure_union_closure_left (x y : α) :
  (l ((l x) ∪ y) : set β) = l (x ∪ y) :=
l.closure_sup_closure_left x y

@[simp] lemma closure_union_closure_right (x y : α) :
  l (x ∪ (l y)) = l (x ∪ y) :=
set_like.coe_injective (l.closure_sup_closure_right x y)

@[simp] lemma closure_union_closure (x y : α) :
  l ((l x) ∪ (l y)) = l (x ∪ y) :=
set_like.coe_injective (l.closure_operator.closure_sup_closure x y)

@[simp] lemma closure_Union_closure {ι : Type u} (x : ι → α) :
  l (⋃ i, l (x i)) = l (⋃ i, x i) :=
set_like.coe_injective (l.closure_supr_closure (coe ∘ x))

@[simp] lemma closure_bUnion_closure (p : set β → Prop) :
  l (⋃ x (H : p x), l x) = l (⋃ x (H : p x), x) :=
set_like.coe_injective (l.closure_bsupr_closure p)

end coe_to_set

end lower_adjoint

/-! ### Translations between `galois_connection`, `lower_adjoint`, `closure_operator` -/

variable {α}

/-- Every Galois connection induces a lower adjoint. -/
@[simps]
def galois_connection.lower_adjoint [preorder α] [preorder β] {l : α → β} {u : β → α}
  (gc : galois_connection l u) :
  lower_adjoint u :=
{ to_fun := l,
  gc' := gc }

/-- Every Galois connection induces a closure operator given by the composition. This is the partial
order version of the statement that every adjunction induces a monad. -/
@[simps]
def galois_connection.closure_operator [partial_order α] [preorder β] {l : α → β} {u : β → α}
  (gc : galois_connection l u) :
  closure_operator α :=
gc.lower_adjoint.closure_operator

/-- The set of closed elements has a Galois insertion to the underlying type. -/
def closure_operator.gi [partial_order α] (c : closure_operator α) :
  galois_insertion c.to_closed coe :=
{ choice := λ x hx, ⟨x, hx.antisymm (c.le_closure x)⟩,
  gc := λ x y, (c.closure_le_closed_iff_le _ y.2),
  le_l_u := λ x, c.le_closure _,
  choice_eq := λ x hx, le_antisymm (c.le_closure x) hx }

/-- The Galois insertion associated to a closure operator can be used to reconstruct the closure
operator.
Note that the inverse in the opposite direction does not hold in general. -/
@[simp]
lemma closure_operator_gi_self [partial_order α] (c : closure_operator α) :
  c.gi.gc.closure_operator = c :=
by { ext x, refl }


/-
Copyright (c) 2022 Vincent Beffara. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Vincent Beffara
-/
import analysis.analytic.basic
import analysis.calculus.dslope
import analysis.calculus.fderiv_analytic
import analysis.calculus.formal_multilinear_series
import analysis.analytic.uniqueness

/-!
# Principle of isolated zeros

This file proves the fact that the zeros of a non-constant analytic function of one variable are
isolated. It also introduces a little bit of API in the `has_fpower_series_at` namespace that is
useful in this setup.

## Main results

* `analytic_at.eventually_eq_zero_or_eventually_ne_zero` is the main statement that if a function is
  analytic at `z₀`, then either it is identically zero in a neighborhood of `z₀`, or it does not
  vanish in a punctured neighborhood of `z₀`.
* `analytic_on.eq_on_of_preconnected_of_frequently_eq` is the identity theorem for analytic
  functions: if a function `f` is analytic on a connected set `U` and is zero on a set with an
  accumulation point in `U` then `f` is identically `0` on `U`.
-/

open_locale classical

open filter function nat formal_multilinear_series emetric set
open_locale topology big_operators

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {s : E}
  {p q : formal_multilinear_series 𝕜 𝕜 E} {f g : 𝕜 → E}
  {n : ℕ} {z z₀ : 𝕜} {y : fin n → 𝕜}

namespace has_sum

variables {a : ℕ → E}

lemma has_sum_at_zero (a : ℕ → E) : has_sum (λ n, (0:𝕜) ^ n • a n) (a 0) :=
by convert has_sum_single 0 (λ b h, _); simp [nat.pos_of_ne_zero h] <|> simp

lemma exists_has_sum_smul_of_apply_eq_zero (hs : has_sum (λ m, z ^ m • a m) s)
  (ha : ∀ k < n, a k = 0) :
  ∃ t : E, z ^ n • t = s ∧ has_sum (λ m, z ^ m • a (m + n)) t :=
begin
  obtain rfl | hn := n.eq_zero_or_pos,
  { simpa },
  by_cases h : z = 0,
  { have : s = 0 := hs.unique (by simpa [ha 0 hn, h] using has_sum_at_zero a),
    exact ⟨a n, by simp [h, hn, this], by simpa [h] using has_sum_at_zero (λ m, a (m + n))⟩ },
  { refine ⟨(z ^ n)⁻¹ • s, by field_simp [smul_smul], _⟩,
    have h1 : ∑ i in finset.range n, z ^ i • a i = 0,
      from finset.sum_eq_zero (λ k hk, by simp [ha k (finset.mem_range.mp hk)]),
    have h2 : has_sum (λ m, z ^ (m + n) • a (m + n)) s,
      by simpa [h1] using (has_sum_nat_add_iff' n).mpr hs,
    convert h2.const_smul (z⁻¹ ^ n),
    { field_simp [pow_add, smul_smul] },
    { simp only [inv_pow] } }
end

end has_sum

namespace has_fpower_series_at

lemma has_fpower_series_dslope_fslope (hp : has_fpower_series_at f p z₀) :
  has_fpower_series_at (dslope f z₀) p.fslope z₀ :=
begin
  have hpd : deriv f z₀ = p.coeff 1 := hp.deriv,
  have hp0 : p.coeff 0 = f z₀ := hp.coeff_zero 1,
  simp only [has_fpower_series_at_iff, apply_eq_pow_smul_coeff, coeff_fslope] at hp ⊢,
  refine hp.mono (λ x hx, _),
  by_cases h : x = 0,
  { convert has_sum_single 0 _; intros; simp [*] },
  { have hxx : ∀ (n : ℕ), x⁻¹ * x ^ (n + 1) = x ^ n := λ n, by field_simp [h, pow_succ'],
    suffices : has_sum (λ n, x⁻¹ • x ^ (n + 1) • p.coeff (n + 1)) (x⁻¹ • (f (z₀ + x) - f z₀)),
    { simpa [dslope, slope, h, smul_smul, hxx] using this },
    { simpa [hp0] using ((has_sum_nat_add_iff' 1).mpr hx).const_smul x⁻¹ } }
end

lemma has_fpower_series_iterate_dslope_fslope (n : ℕ) (hp : has_fpower_series_at f p z₀) :
  has_fpower_series_at ((swap dslope z₀)^[n] f) (fslope^[n] p) z₀ :=
begin
  induction n with n ih generalizing f p,
  { exact hp },
  { simpa using ih (has_fpower_series_dslope_fslope hp) }
end

lemma iterate_dslope_fslope_ne_zero (hp : has_fpower_series_at f p z₀) (h : p ≠ 0) :
  (swap dslope z₀)^[p.order] f z₀ ≠ 0 :=
begin
  rw [← coeff_zero (has_fpower_series_iterate_dslope_fslope p.order hp) 1],
  simpa [coeff_eq_zero] using apply_order_ne_zero h
end

lemma eq_pow_order_mul_iterate_dslope (hp : has_fpower_series_at f p z₀) :
  ∀ᶠ z in 𝓝 z₀, f z = (z - z₀) ^ p.order • ((swap dslope z₀)^[p.order] f z) :=
begin
  have hq := has_fpower_series_at_iff'.mp (has_fpower_series_iterate_dslope_fslope p.order hp),
  filter_upwards [hq, has_fpower_series_at_iff'.mp hp] with x hx1 hx2,
  have : ∀ k < p.order, p.coeff k = 0,
    from λ k hk, by simpa [coeff_eq_zero] using apply_eq_zero_of_lt_order hk,
  obtain ⟨s, hs1, hs2⟩ := has_sum.exists_has_sum_smul_of_apply_eq_zero hx2 this,
  convert hs1.symm,
  simp only [coeff_iterate_fslope] at hx1,
  exact hx1.unique hs2
end

lemma locally_ne_zero (hp : has_fpower_series_at f p z₀) (h : p ≠ 0) :
  ∀ᶠ z in 𝓝[≠] z₀, f z ≠ 0 :=
begin
  rw [eventually_nhds_within_iff],
  have h2 := (has_fpower_series_iterate_dslope_fslope p.order hp).continuous_at,
  have h3 := h2.eventually_ne (iterate_dslope_fslope_ne_zero hp h),
  filter_upwards [eq_pow_order_mul_iterate_dslope hp, h3] with z e1 e2 e3,
  simpa [e1, e2, e3] using pow_ne_zero p.order (sub_ne_zero.mpr e3),
end

lemma locally_zero_iff (hp : has_fpower_series_at f p z₀) :
  (∀ᶠ z in 𝓝 z₀, f z = 0) ↔ p = 0 :=
⟨λ hf, hp.eq_zero_of_eventually hf, λ h, eventually_eq_zero (by rwa h at hp)⟩

end has_fpower_series_at

namespace analytic_at

/-- The *principle of isolated zeros* for an analytic function, local version: if a function is
analytic at `z₀`, then either it is identically zero in a neighborhood of `z₀`, or it does not
vanish in a punctured neighborhood of `z₀`. -/
theorem eventually_eq_zero_or_eventually_ne_zero (hf : analytic_at 𝕜 f z₀) :
  (∀ᶠ z in 𝓝 z₀, f z = 0) ∨ (∀ᶠ z in 𝓝[≠] z₀, f z ≠ 0) :=
begin
  rcases hf with ⟨p, hp⟩,
  by_cases h : p = 0,
  { exact or.inl (has_fpower_series_at.eventually_eq_zero (by rwa h at hp)) },
  { exact or.inr (hp.locally_ne_zero h) }
end

lemma eventually_eq_or_eventually_ne (hf : analytic_at 𝕜 f z₀) (hg : analytic_at 𝕜 g z₀) :
  (∀ᶠ z in 𝓝 z₀, f z = g z) ∨ (∀ᶠ z in 𝓝[≠] z₀, f z ≠ g z) :=
by simpa [sub_eq_zero] using (hf.sub hg).eventually_eq_zero_or_eventually_ne_zero

lemma frequently_zero_iff_eventually_zero {f : 𝕜 → E} {w : 𝕜} (hf : analytic_at 𝕜 f w) :
  (∃ᶠ z in 𝓝[≠] w, f z = 0) ↔ (∀ᶠ z in 𝓝 w, f z = 0) :=
⟨hf.eventually_eq_zero_or_eventually_ne_zero.resolve_right,
  λ h, (h.filter_mono nhds_within_le_nhds).frequently⟩

lemma frequently_eq_iff_eventually_eq (hf : analytic_at 𝕜 f z₀) (hg : analytic_at 𝕜 g z₀) :
  (∃ᶠ z in 𝓝[≠] z₀, f z = g z) ↔ (∀ᶠ z in 𝓝 z₀, f z = g z) :=
by simpa [sub_eq_zero] using frequently_zero_iff_eventually_zero (hf.sub hg)

end analytic_at

namespace analytic_on

variables {U : set 𝕜}

/-- The *principle of isolated zeros* for an analytic function, global version: if a function is
analytic on a connected set `U` and vanishes in arbitrary neighborhoods of a point `z₀ ∈ U`, then
it is identically zero in `U`.
For higher-dimensional versions requiring that the function vanishes in a neighborhood of `z₀`,
see `eq_on_zero_of_preconnected_of_eventually_eq_zero`. -/
theorem eq_on_zero_of_preconnected_of_frequently_eq_zero
  (hf : analytic_on 𝕜 f U) (hU : is_preconnected U)
  (h₀ : z₀ ∈ U) (hfw : ∃ᶠ z in 𝓝[≠] z₀, f z = 0) :
  eq_on f 0 U :=
hf.eq_on_zero_of_preconnected_of_eventually_eq_zero hU h₀
  ((hf z₀ h₀).frequently_zero_iff_eventually_zero.1 hfw)

theorem eq_on_zero_of_preconnected_of_mem_closure (hf : analytic_on 𝕜 f U) (hU : is_preconnected U)
  (h₀ : z₀ ∈ U) (hfz₀ : z₀ ∈ closure ({z | f z = 0} \ {z₀})) :
  eq_on f 0 U :=
hf.eq_on_zero_of_preconnected_of_frequently_eq_zero hU h₀
  (mem_closure_ne_iff_frequently_within.mp hfz₀)

/-- The *identity principle* for analytic functions, global version: if two functions are
analytic on a connected set `U` and coincide at points which accumulate to a point `z₀ ∈ U`, then
they coincide globally in `U`.
For higher-dimensional versions requiring that the functions coincide in a neighborhood of `z₀`,
see `eq_on_of_preconnected_of_eventually_eq`. -/
theorem eq_on_of_preconnected_of_frequently_eq (hf : analytic_on 𝕜 f U) (hg : analytic_on 𝕜 g U)
  (hU : is_preconnected U) (h₀ : z₀ ∈ U) (hfg : ∃ᶠ z in 𝓝[≠] z₀, f z = g z) :
  eq_on f g U :=
begin
  have hfg' : ∃ᶠ z in 𝓝[≠] z₀, (f - g) z = 0 := hfg.mono (λ z h, by rw [pi.sub_apply, h, sub_self]),
  simpa [sub_eq_zero] using
    λ z hz, (hf.sub hg).eq_on_zero_of_preconnected_of_frequently_eq_zero hU h₀ hfg' hz
end

theorem eq_on_of_preconnected_of_mem_closure (hf : analytic_on 𝕜 f U) (hg : analytic_on 𝕜 g U)
  (hU : is_preconnected U) (h₀ : z₀ ∈ U) (hfg : z₀ ∈ closure ({z | f z = g z} \ {z₀})) :
  eq_on f g U :=
hf.eq_on_of_preconnected_of_frequently_eq hg hU h₀ (mem_closure_ne_iff_frequently_within.mp hfg)

end analytic_on


import mynat.definition
import mynat.mul
import world2.level5

namespace mynat

lemma one_mul (m : mynat) : 1 * m = m :=
begin [nat_num_game]
    induction m with d hd,
    {
        rw mul_zero,
        refl,
    },
    {
        rw mul_succ,
        rw succ_eq_add_one,
        rw hd,
        refl,
    },
end

end mynat


def f : Nat → Nat → Nat
| 100, 2 => 0
| _,   4 => 1
| _,   _ => 2

theorem ex1 : f 100 2 = 0 := rfl
theorem ex2 : f 9 4   = 1 := rfl
theorem ex3 : f 8 4   = 1 := rfl
theorem ex4 : f 6 3   = 2 := rfl

inductive BV : Nat → Type
| nil  : BV 0
| cons : {n : Nat} → Bool → BV n → BV (n+1)

open BV

def g : {n : Nat} → BV n → Nat → Nat
  | _, cons b v, 1000000 => g v 0
  | _, cons b v, x       => g v (x + 1)
  | _, _,        _       => 1

def g' : BV n → Nat → Nat
  | cons b v, 1000000 => g v 0
  | cons b v, x       => g v (x + 1)
  | _,        _       => 1


import algebra.group.units

universe variables u

lemma mul_unit_eq_iff_mul_inv_eq {α : Type u} [monoid α] (a b : α) (c : units α) :
a * c = b ↔ a = b * (@has_inv.inv (units α) _ c) :=
by rw [←units.inv_mul_cancel_right b c, units.mul_right_inj, mul_assoc, units.mul_inv, mul_one]


import .basic
import prelim.intervals
import prelim.collections prelim.embed prelim.size prelim.induction prelim.minmax finsum.fin_api
import matroid.pointcount matroid.submatroid.minor_iso

noncomputable theory
open_locale classical big_operators

open set matroid

/-- the size of a projective geometry over a `q`-element field; i.e `1 + q + q^2 + ... + q^{n-1}`.
This is currently defined for integers `q`, but really `q` can live in any ring and it still
makes sense. -/
def pg_size' : ℤ → ℕ → ℤ
| q 0     := 0
| q (n+1) := 1 + q * (pg_size' q n)

@[simp] lemma pg_size'_zero (q : ℤ) :
  pg_size' q 0 = 0 :=
rfl

@[simp] lemma pg_size'_succ {q : ℤ}{n : ℕ}:
  pg_size' q n.succ = 1 + q * (pg_size' q n) := rfl

@[simp] lemma pg_size'_order_one (n : ℕ) :
  pg_size' 1 n = n :=
by {induction n with n ih, simp, simp [pg_size', ih, add_comm]  }

lemma pg_size'_eq_powsum (q : ℤ) (n : ℕ) :
  pg_size' q n = ∑ᶠ i in Ico 0 n , q^i  :=
begin
  induction n with n ih,
    simp,
  rw [pg_size', ih, mul_distrib_finsum_in],
  conv in (_ * _) {rw ← pow_succ},
  rw [← pow_zero q, finsum_Ico_shift, Ico_ℕ_eq_Ioo, nat.zero_add, nat.sub_self,
   ← finsum_in_insert, Ioo_insert_left_eq_Ico];
  simp [set.Ioo_ℕ_finite],
end

lemma pg_size'_rat (q : ℤ) (n : ℕ) (hq : 2 ≤ q) :
  (pg_size' q n : ℚ) = (q^n - 1)/(q - 1) :=
begin
  induction n with n ih,
    simp,
  have hq : (q : ℚ) -1 ≠ 0 := by {norm_cast, linarith},
  rw [pg_size', int.cast_add, int.cast_mul, int.cast_one, ih, pow_succ, ← mul_div_assoc,
  one_add_div hq, div_left_inj' hq],
  ring,
end

def pg_size (q n : ℤ) := pg_size' q n.to_nat

lemma pg_size_eq_zero (q n : ℤ)(hn : n ≤ 0) :
  pg_size q n = 0 :=
by {rw pg_size, convert pg_size'_zero q, rw int.to_nat_zero_of_nonpos hn, }

lemma pg_size_rec (q : ℤ) {n : ℤ} (hn : 1 ≤ n):
  pg_size q n = 1 + q * (pg_size q (n-1)) :=
begin
  rw [pg_size, pg_size],
  obtain ⟨m,rfl⟩ := int.eq_coe_of_zero_le (by linarith : 0 ≤ n),
  norm_num,
  cases m, exfalso, norm_num at hn, refl,
end

lemma pg_size_eq_powsum (q n : ℤ):
  pg_size q n = ∑ᶠ i in Ico 0 n.to_nat, q^i  :=
begin
  cases le_or_lt n 0 with hn hn',
  { convert finsum_in_empty.symm,
    exact pg_size_eq_zero q n hn,
    apply Ico_eq_empty,
    rw int.to_nat_zero_of_nonpos hn,  },
  convert pg_size'_eq_powsum q n.to_nat,
end

lemma pg_size_nonneg (q n : ℤ)(hq : 0 ≤ q):
  0 ≤ pg_size q n :=
begin
  rw pg_size_eq_powsum,
  apply nonneg_of_finsum_in_nonneg,
  intros i hi,
  exact pow_nonneg hq i,
end

theorem kung {q : ℤ}(hq : 1 ≤ q){α : Type*} [fintype α] (M : matroid α) :
  M.has_no_line_minor (q+2) → M.ε univ ≤ pg_size q (M.r univ) :=
begin
  revert M,
  by_contra hn,
  obtain ⟨M,hM⟩ := min_counterexample_nonneg_int_param
    _ (λ (M : matroid α), size (M.nonloops)) (λ s, size_nonneg _) hn,
  push_neg at hM,
  rcases hM with ⟨⟨hMq, hMs⟩, hM_min⟩,

  by_cases hr : M.r univ ≤ 0,
  { linarith [pg_size_nonneg q (M.r univ) (by linarith : 0 ≤ q),
              ε_eq_r_of_r_le_one (by linarith: M.r univ ≤ 1)]},
  obtain ⟨e,-,he⟩ := contains_nonloop_of_one_le_rank (lt_of_not_ge' hr),

  rw ε_as_ε_proj_nonloop he at hMs,

  set lines := {L : set α | M.is_line L ∧ e ∈ L} with hlines,
  have h_L_ub : ∀ L ∈ lines, M.ε L -1 ≤ q,
  { rintros L ⟨hL,-⟩, exact int.sub_right_le_of_le_add (line_restr_ub_ε (by linarith) hMq hL)},

  have h_le : ∑ᶠ (L : set α) in lines, (M.ε L - 1) ≤  q * ((M ⟋ {e}).ε univ),
  { convert fin.finsum_in_le_finsum_in h_L_ub,
    rw [int.finsum_in_const_eq_mul_size, hlines, ε_proj_nonloop _ he]},

  specialize hM_min (M ⟋ {e})
    (size_strict_monotone (project_nonloop_fewer_nonloops he))
    (pseudominor_has_no_uniform_minor (by norm_num) (by linarith) (pr_is_pminor M {e}) hMq),

  have hlt := calc
    pg_size q (M.r univ)  < 1 + ∑ᶠ (L : set α) in lines, (M.ε L - 1)
                        : hMs
                      ... ≤ 1 + q * (M ⟋ {e}).ε univ
                        : add_le_add_left h_le 1
                      ... ≤ 1 + q * (pg_size q ((M ⟋ {e}).r univ))
                        : add_le_add_left ((mul_le_mul_left (by linarith : 0 < q)).mpr hM_min) 1,

  rw [project_r, univ_union, rank_nonloop he, ← pg_size_rec q (by linarith : 1 ≤ M.r univ)] at hlt,
  exact lt_irrefl _ hlt,
end

/-
  This is (almost) boilerplate for the fact that a minimal counterexample has no parallel pairs.
  Not needed for the proof above, as it turned out, but may be useful later.

  have no_parallel : ∀ e f, M.parallel e f → e = f,
  { by_contra hn', push_neg at hn', obtain ⟨e,f,hef,hne⟩ := hn',
    set M' := M ⟍ {f} with hM',
    specialize hM_min M'
      (size_strict_monotone (loopify_nonloop_fewer_nonloops hef.nonloop_right))
      (pseudominor_has_no_uniform_minor (by norm_num) (by linarith) (lp_is_pminor M {f}) hMq),
    rw [rank_nat, r_nat] at hM_min hMs,
    rw [hM', rank_eq_rank_loopify_parallel hef hne,
          ε_loopify_parallel _ (ne.symm hne) (hef.symm)] at hM_min,
    exact lt_irrefl _ (lt_of_le_of_lt hM_min hMs)},

  have h' : M.is_simple_set (M.nonloops),
  { rw [simple_set_iff_no_loops_or_parallel_pairs, loopless_set_iff_subset_nonloops],
     refine ⟨subset.refl _, λ e f _ _ hef, no_parallel e f hef⟩},

  clear no_parallel hn,

-/