/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland
-/

import algebra.big_operators.order
import algebra.big_operators.ring
import algebra.big_operators.intervals
import tactic.abel
import data.nat.parity

/-!
# Partial sums of geometric series

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

This file determines the values of the geometric series $\sum_{i=0}^{n-1} x^i$ and
$\sum_{i=0}^{n-1} x^i y^{n-1-i}$ and variants thereof. We also provide some bounds on the
"geometric" sum of `a/b^i` where `a b : ℕ`.

## Main statements

* `geom_sum_Ico` proves that $\sum_{i=m}^{n-1} x^i=\frac{x^n-x^m}{x-1}$ in a division ring.
* `geom_sum₂_Ico` proves that $\sum_{i=m}^{n-1} x^i=\frac{x^n-y^{n-m}x^m}{x-y}$ in a field.

Several variants are recorded, generalising in particular to the case of a noncommutative ring in
which `x` and `y` commute. Even versions not using division or subtraction, valid in each semiring,
are recorded.
-/

universe u
variable {α : Type u}

open finset mul_opposite

open_locale big_operators

section semiring
variable [semiring α]

lemma geom_sum_succ {x : α} {n : ℕ} :
  ∑ i in range (n + 1), x ^ i = x * ∑ i in range n, x ^ i + 1 :=
by simp only [mul_sum, ←pow_succ, sum_range_succ', pow_zero]

lemma geom_sum_succ' {x : α} {n : ℕ} :
  ∑ i in range (n + 1), x ^ i = x ^ n + ∑ i in range n, x ^ i :=
(sum_range_succ _ _).trans (add_comm _ _)

theorem geom_sum_zero (x : α) :
  ∑ i in range 0, x ^ i = 0 := rfl

theorem geom_sum_one (x : α) :
  ∑ i in range 1, x ^ i = 1 :=
by simp [geom_sum_succ']

@[simp] lemma geom_sum_two {x : α} : ∑ i in range 2, x ^ i = x + 1 :=
by simp [geom_sum_succ']

@[simp] lemma zero_geom_sum : ∀ {n}, ∑ i in range n, (0 : α) ^ i = if n = 0 then 0 else 1
| 0     := by simp
| 1     := by simp
| (n+2) := by { rw geom_sum_succ', simp [zero_geom_sum] }

lemma one_geom_sum (n : ℕ) : ∑ i in range n, (1 : α) ^ i = n :=
by simp

@[simp] lemma op_geom_sum (x : α) (n : ℕ) :
  op (∑ i in range n, x ^ i) = ∑ i in range n, (op x) ^ i :=
by simp

@[simp] lemma op_geom_sum₂ (x y : α) (n : ℕ) :
  op (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) =
    ∑ i in range n, (op y) ^ i * ((op x) ^ (n - 1 - i)) :=
begin
  simp only [op_sum, op_mul, op_pow],
  rw ← sum_range_reflect,
  refine sum_congr rfl (λ j j_in, _),
  rw [mem_range, nat.lt_iff_add_one_le] at j_in,
  congr,
  apply tsub_tsub_cancel_of_le,
  exact le_tsub_of_add_le_right j_in
end

theorem geom_sum₂_with_one (x : α) (n : ℕ) :
  ∑ i in range n, x ^ i * (1 ^ (n - 1 - i)) = ∑ i in range n, x ^ i :=
sum_congr rfl (λ i _, by { rw [one_pow, mul_one] })

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
protected theorem commute.geom_sum₂_mul_add {x y : α} (h : commute x y) (n : ℕ) :
  (∑ i in range n, (x + y) ^ i * (y ^ (n - 1 - i))) * x + y ^ n = (x + y) ^ n :=
begin
  let f := λ (m i : ℕ), (x + y) ^ i * y ^ (m - 1 - i),
  change (∑ i in range n, (f n) i) * x + y ^ n = (x + y) ^ n,
  induction n with n ih,
  { rw [range_zero, sum_empty, zero_mul, zero_add, pow_zero, pow_zero] },
  { have f_last : f (n + 1) n = (x + y) ^ n :=
     by { dsimp [f],
          rw [← tsub_add_eq_tsub_tsub, nat.add_comm, tsub_self, pow_zero, mul_one] },
    have f_succ : ∀ i, i ∈ range n → f (n + 1) i = y * f n i :=
      λ i hi, by
      { dsimp [f],
        have : commute y ((x + y) ^ i) :=
         (h.symm.add_right (commute.refl y)).pow_right i,
        rw [← mul_assoc, this.eq, mul_assoc, ← pow_succ y (n - 1 - i)],
        congr' 2,
        rw [add_tsub_cancel_right, ← tsub_add_eq_tsub_tsub, add_comm 1 i],
        have : i + 1 + (n - (i + 1)) = n := add_tsub_cancel_of_le (mem_range.mp hi),
        rw [add_comm (i + 1)] at this,
        rw [← this, add_tsub_cancel_right, add_comm i 1, ← add_assoc,
            add_tsub_cancel_right] },
    rw [pow_succ (x + y), add_mul, sum_range_succ_comm, add_mul, f_last, add_assoc],
    rw (((commute.refl x).add_right h).pow_right n).eq,
    congr' 1,
    rw [sum_congr rfl f_succ, ← mul_sum, pow_succ y, mul_assoc, ← mul_add y, ih] }
end

end semiring

@[simp] lemma neg_one_geom_sum [ring α] {n : ℕ} :
  ∑ i in range n, (-1 : α) ^ i = if even n then 0 else 1 :=
begin
  induction n with k hk,
  { simp },
  { simp only [geom_sum_succ', nat.even_add_one, hk],
    split_ifs,
    { rw [h.neg_one_pow, add_zero] },
    { rw [(nat.odd_iff_not_even.2 h).neg_one_pow, neg_add_self] } }
end

theorem geom_sum₂_self {α : Type*} [comm_ring α] (x : α) (n : ℕ) :
  ∑ i in range n, x ^ i * (x ^ (n - 1 - i)) = n * x ^ (n-1) :=
calc  ∑ i in finset.range n, x ^ i * x ^ (n - 1 - i)
    = ∑ i in finset.range n, x ^ (i + (n - 1 - i)) : by simp_rw [← pow_add]
... = ∑ i in finset.range n, x ^ (n - 1) : finset.sum_congr rfl
  (λ i hi, congr_arg _ $ add_tsub_cancel_of_le $ nat.le_pred_of_lt $ finset.mem_range.1 hi)
... = (finset.range n).card • (x ^ (n - 1)) : finset.sum_const _
... = n * x ^ (n - 1) : by rw [finset.card_range, nsmul_eq_mul]

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
theorem geom_sum₂_mul_add [comm_semiring α] (x y : α) (n : ℕ) :
  (∑ i in range n, (x + y) ^ i * (y ^ (n - 1 - i))) * x + y ^ n = (x + y) ^ n :=
(commute.all x y).geom_sum₂_mul_add n

theorem geom_sum_mul_add [semiring α] (x : α) (n : ℕ) :
  (∑ i in range n, (x + 1) ^ i) * x + 1 = (x + 1) ^ n :=
begin
  have := (commute.one_right x).geom_sum₂_mul_add n,
  rw [one_pow, geom_sum₂_with_one] at this,
  exact this
end

protected theorem commute.geom_sum₂_mul [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) * (x - y) = x ^ n - y ^ n :=
begin
  have := (h.sub_left (commute.refl y)).geom_sum₂_mul_add n,
  rw [sub_add_cancel] at this,
  rw [← this, add_sub_cancel]
end

lemma commute.mul_neg_geom_sum₂ [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (y - x) * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = y ^ n - x ^ n :=
begin
  apply op_injective,
  simp only [op_mul, op_sub, op_geom_sum₂, op_pow],
  exact (commute.op h.symm).geom_sum₂_mul n
end

lemma commute.mul_geom_sum₂ [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (x - y) * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = x ^ n - y ^ n :=
by rw [← neg_sub (y ^ n), ← h.mul_neg_geom_sum₂, ← neg_mul, neg_sub]

theorem geom_sum₂_mul [comm_ring α] (x y : α) (n : ℕ) :
  (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) * (x - y) = x ^ n - y ^ n :=
(commute.all x y).geom_sum₂_mul n

theorem sub_dvd_pow_sub_pow [comm_ring α] (x y : α) (n : ℕ) : x - y ∣ x ^ n - y ^ n :=
  dvd.intro_left _ (geom_sum₂_mul x y n)

theorem nat_sub_dvd_pow_sub_pow (x y n : ℕ) : x - y ∣ x ^ n - y ^ n :=
begin
  cases le_or_lt y x with h,
  { have : y ^ n ≤ x ^ n := nat.pow_le_pow_of_le_left h _,
    exact_mod_cast sub_dvd_pow_sub_pow (x : ℤ) ↑y n },
  { have : x ^ n ≤ y ^ n := nat.pow_le_pow_of_le_left h.le _,
    exact (nat.sub_eq_zero_of_le this).symm ▸ dvd_zero (x - y) }
end

theorem odd.add_dvd_pow_add_pow [comm_ring α] (x y : α) {n : ℕ} (h : odd n) :
  x + y ∣ x ^ n + y ^ n :=
begin
  have h₁ := geom_sum₂_mul x (-y) n,
  rw [odd.neg_pow h y, sub_neg_eq_add, sub_neg_eq_add] at h₁,
  exact dvd.intro_left _ h₁,
end

theorem odd.nat_add_dvd_pow_add_pow (x y : ℕ) {n : ℕ} (h : odd n) : x + y ∣ x ^ n + y ^ n :=
by exact_mod_cast odd.add_dvd_pow_add_pow (x : ℤ) ↑y h

theorem geom_sum_mul [ring α] (x : α) (n : ℕ) :
  (∑ i in range n, x ^ i) * (x - 1) = x ^ n - 1 :=
begin
  have := (commute.one_right x).geom_sum₂_mul n,
  rw [one_pow, geom_sum₂_with_one] at this,
  exact this
end

lemma mul_geom_sum [ring α] (x : α) (n : ℕ) :
  (x - 1) * (∑ i in range n, x ^ i) = x ^ n - 1 :=
op_injective $ by simpa using geom_sum_mul (op x) n

theorem geom_sum_mul_neg [ring α] (x : α) (n : ℕ) :
  (∑ i in range n, x ^ i) * (1 - x) = 1 - x ^ n :=
begin
  have := congr_arg has_neg.neg (geom_sum_mul x n),
  rw [neg_sub, ← mul_neg, neg_sub] at this,
  exact this
end

lemma mul_neg_geom_sum [ring α] (x : α) (n : ℕ) :
  (1 - x) * (∑ i in range n, x ^ i) = 1 - x ^ n :=
op_injective $ by simpa using geom_sum_mul_neg (op x) n

protected lemma commute.geom_sum₂_comm {α : Type u} [semiring α] {x y : α} (n : ℕ)
  (h : commute x y) :
  ∑ i in range n, x ^ i * y ^ (n - 1 - i) = ∑ i in range n, y ^ i * x ^ (n - 1 - i) :=
begin
  cases n, { simp },
  simp only [nat.succ_eq_add_one, nat.add_sub_cancel],
  rw ← finset.sum_flip,
  refine finset.sum_congr rfl (λ i hi, _),
  simpa [nat.sub_sub_self (nat.succ_le_succ_iff.mp (finset.mem_range.mp hi))] using h.pow_pow _ _
end

lemma geom_sum₂_comm {α : Type u} [comm_semiring α] (x y : α) (n : ℕ) :
  ∑ i in range n, x ^ i * y ^ (n - 1 - i) = ∑ i in range n, y ^ i * x ^ (n - 1 - i) :=
(commute.all x y).geom_sum₂_comm n

protected theorem commute.geom_sum₂ [division_ring α] {x y : α} (h' : commute x y) (h : x ≠ y)
  (n : ℕ) : (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = (x ^ n - y ^ n) / (x - y) :=
have x - y ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← h'.geom_sum₂_mul, mul_div_cancel _ this]

theorem geom₂_sum [field α] {x y : α} (h : x ≠ y) (n : ℕ) :
  (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = (x ^ n - y ^ n) / (x - y) :=
(commute.all x y).geom_sum₂ h n

theorem geom_sum_eq [division_ring α] {x : α} (h : x ≠ 1) (n : ℕ) :
  (∑ i in range n, x ^ i) = (x ^ n - 1) / (x - 1) :=
have x - 1 ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← geom_sum_mul, mul_div_cancel _ this]

protected theorem commute.mul_geom_sum₂_Ico [ring α] {x y : α} (h : commute x y) {m n : ℕ}
  (hmn : m ≤ n) :
  (x - y) * (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) :=
begin
  rw [sum_Ico_eq_sub _ hmn],
  have : ∑ k in range m, x ^ k * y ^ (n - 1 - k)
    = ∑ k in range m, x ^ k * (y ^ (n - m) * y ^ (m - 1 - k)),
  { refine sum_congr rfl (λ j j_in, _),
    rw ← pow_add,
    congr,
    rw [mem_range, nat.lt_iff_add_one_le, add_comm] at j_in,
    have h' : n - m + (m - (1 + j)) = n - (1 + j) := tsub_add_tsub_cancel hmn j_in,
    rw [← tsub_add_eq_tsub_tsub m, h', ← tsub_add_eq_tsub_tsub] },
  rw this,
  simp_rw pow_mul_comm y (n-m) _,
  simp_rw ← mul_assoc,
  rw [← sum_mul, mul_sub, h.mul_geom_sum₂, ← mul_assoc,
    h.mul_geom_sum₂, sub_mul, ← pow_add, add_tsub_cancel_of_le hmn,
    sub_sub_sub_cancel_right (x ^ n) (x ^ m * y ^ (n - m)) (y ^ n)],
end

protected theorem commute.geom_sum₂_succ_eq {α : Type u} [ring α] {x y : α}
  (h : commute x y) {n : ℕ} :
  ∑ i in range (n + 1), x ^ i * (y ^ (n - i)) =
    x ^ n + y * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) :=
begin
  simp_rw [mul_sum, sum_range_succ_comm, tsub_self, pow_zero, mul_one, add_right_inj, ←mul_assoc,
    (h.symm.pow_right _).eq, mul_assoc, ←pow_succ],
  refine sum_congr rfl (λ i hi, _),
  suffices : n - 1 - i + 1 = n - i, { rw this },
  cases n,
  { exact absurd (list.mem_range.mp hi) i.not_lt_zero },
  { rw [tsub_add_eq_add_tsub (nat.le_pred_of_lt (list.mem_range.mp hi)),
        tsub_add_cancel_of_le (nat.succ_le_iff.mpr n.succ_pos)] },
end

theorem geom_sum₂_succ_eq {α : Type u} [comm_ring α] (x y : α)  {n : ℕ} :
  ∑ i in range (n + 1), x ^ i * (y ^ (n - i)) =
    x ^ n + y * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) :=
(commute.all x y).geom_sum₂_succ_eq

theorem mul_geom_sum₂_Ico [comm_ring α] (x y : α) {m n : ℕ} (hmn : m ≤ n) :
  (x - y) * (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) :=
(commute.all x y).mul_geom_sum₂_Ico hmn

protected theorem commute.geom_sum₂_Ico_mul [ring α] {x y : α} (h : commute x y) {m n : ℕ}
  (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) * (x - y) = x ^ n -  y ^ (n - m) * x ^ m :=
begin
  apply op_injective,
  simp only [op_sub, op_mul, op_pow, op_sum],
  have : ∑ k in Ico m n, op y ^ (n - 1 - k) * op x ^ k
    = ∑ k in Ico m n, op x ^ k * op y ^ (n - 1 - k),
  { refine sum_congr rfl (λ k k_in, _),
    apply commute.pow_pow (commute.op h.symm) },
  rw this,
  exact (commute.op h).mul_geom_sum₂_Ico hmn
end

theorem geom_sum_Ico_mul [ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i) * (x - 1) = x^n - x^m :=
by rw [sum_Ico_eq_sub _ hmn, sub_mul,
  geom_sum_mul, geom_sum_mul, sub_sub_sub_cancel_right]

theorem geom_sum_Ico_mul_neg [ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i) * (1 - x) = x^m - x^n :=
by rw [sum_Ico_eq_sub _ hmn, sub_mul,
  geom_sum_mul_neg, geom_sum_mul_neg, sub_sub_sub_cancel_left]

protected theorem commute.geom_sum₂_Ico [division_ring α] {x y : α} (h : commute x y) (hxy : x ≠ y)
  {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i) = (x ^ n - y ^ (n - m) * x ^ m ) / (x - y) :=
have x - y ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← h.geom_sum₂_Ico_mul hmn, mul_div_cancel _ this]

theorem geom_sum₂_Ico [field α] {x y : α} (hxy : x ≠ y) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i) = (x ^ n - y ^ (n - m) * x ^ m ) / (x - y) :=
(commute.all x y).geom_sum₂_Ico hxy hmn

theorem geom_sum_Ico [division_ring α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i = (x ^ n - x ^ m) / (x - 1) :=
by simp only [sum_Ico_eq_sub _ hmn, geom_sum_eq hx, div_sub_div_same,
  sub_sub_sub_cancel_right]

theorem geom_sum_Ico' [division_ring α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i = (x ^ m - x ^ n) / (1 - x) :=
by { simp only [geom_sum_Ico hx hmn], convert neg_div_neg_eq (x^m - x^n) (1-x); abel }

lemma geom_sum_Ico_le_of_lt_one [linear_ordered_field α]
  {x : α} (hx : 0 ≤ x) (h'x : x < 1) {m n : ℕ} :
  ∑ i in Ico m n, x ^ i ≤ x ^ m / (1 - x) :=
begin
  rcases le_or_lt m n with hmn | hmn,
  { rw geom_sum_Ico' h'x.ne hmn,
    apply div_le_div (pow_nonneg hx _) _ (sub_pos.2 h'x) le_rfl,
    simpa using pow_nonneg hx _ },
  { rw [Ico_eq_empty, sum_empty],
    { apply div_nonneg (pow_nonneg hx _),
      simpa using h'x.le },
    { simpa using hmn.le } },
end

lemma geom_sum_inv [division_ring α] {x : α} (hx1 : x ≠ 1) (hx0 : x ≠ 0) (n : ℕ) :
  (∑ i in range n, x⁻¹ ^ i) = (x - 1)⁻¹ * (x - x⁻¹ ^ n * x) :=
have h₁ : x⁻¹ ≠ 1, by rwa [inv_eq_one_div, ne.def, div_eq_iff_mul_eq hx0, one_mul],
have h₂ : x⁻¹ - 1 ≠ 0, from mt sub_eq_zero.1 h₁,
have h₃ : x - 1 ≠ 0, from mt sub_eq_zero.1 hx1,
have h₄ : x * (x ^ n)⁻¹ = (x ^ n)⁻¹ * x :=
  nat.rec_on n (by simp)
  (λ n h, by rw [pow_succ, mul_inv_rev, ←mul_assoc, h, mul_assoc, mul_inv_cancel hx0, mul_assoc,
    inv_mul_cancel hx0]),
begin
  rw [geom_sum_eq h₁, div_eq_iff_mul_eq h₂, ← mul_right_inj' h₃,
    ← mul_assoc, ← mul_assoc, mul_inv_cancel h₃],
  simp [mul_add, add_mul, mul_inv_cancel hx0, mul_assoc, h₄, sub_eq_add_neg, add_comm,
    add_left_comm],
end

variables {β : Type*}

theorem ring_hom.map_geom_sum [semiring α] [semiring β] (x : α) (n : ℕ) (f : α →+* β) :
  f (∑ i in range n, x ^ i) = ∑ i in range n, (f x) ^ i :=
by simp [f.map_sum]

theorem ring_hom.map_geom_sum₂ [semiring α] [semiring β] (x y : α) (n : ℕ) (f : α →+* β) :
  f (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) =
    ∑ i in range n, (f x) ^ i * ((f y) ^ (n - 1 - i)) :=
by simp [f.map_sum]

/-! ### Geometric sum with `ℕ`-division -/

lemma nat.pred_mul_geom_sum_le (a b n : ℕ) :
  (b - 1) * ∑ i in range n.succ, a/b^i ≤ a * b - a/b^n :=
calc
  (b - 1) * (∑ i in range n.succ, a/b^i)
      = ∑ i in range n, a/b^(i + 1) * b + a * b
        - (∑ i in range n, a/b^i + a/b^n)
      : by rw [tsub_mul, mul_comm, sum_mul, one_mul, sum_range_succ',
          sum_range_succ, pow_zero, nat.div_one]
  ... ≤ ∑ i in range n, a/b^i + a * b - (∑ i in range n, a/b^i + a/b^n)
      : begin
        refine tsub_le_tsub_right (add_le_add_right (sum_le_sum $ λ i _, _) _) _,
        rw [pow_succ', ←nat.div_div_eq_div_mul],
        exact nat.div_mul_le_self _ _,
      end
  ... = a * b - a/b^n : add_tsub_add_eq_tsub_left _ _ _

lemma nat.geom_sum_le {b : ℕ} (hb : 2 ≤ b) (a n : ℕ) :
  ∑ i in range n, a/b^i ≤ a * b/(b - 1) :=
begin
  refine (nat.le_div_iff_mul_le $ tsub_pos_of_lt hb).2 _,
  cases n,
  { rw [sum_range_zero, zero_mul],
    exact nat.zero_le _ },
  rw mul_comm,
  exact (nat.pred_mul_geom_sum_le a b n).trans tsub_le_self,
end

lemma nat.geom_sum_Ico_le {b : ℕ} (hb : 2 ≤ b) (a n : ℕ) :
  ∑ i in Ico 1 n, a/b^i ≤ a/(b - 1) :=
begin
  cases n,
  { rw [Ico_eq_empty_of_le (zero_le_one' ℕ), sum_empty],
    exact nat.zero_le _ },
  rw ←add_le_add_iff_left a,
  calc
    a + ∑ (i : ℕ) in Ico 1 n.succ, a/b^i
        = a/b^0 + ∑ (i : ℕ) in Ico 1 n.succ, a/b^i : by rw [pow_zero, nat.div_one]
    ... = ∑ i in range n.succ, a/b^i : begin
          rw [range_eq_Ico, ←nat.Ico_insert_succ_left (nat.succ_pos _), sum_insert],
          exact λ h, zero_lt_one.not_le (mem_Ico.1 h).1,
        end
    ... ≤ a * b/(b - 1) : nat.geom_sum_le hb a _
    ... = (a * 1 + a * (b - 1))/(b - 1)
        : by rw [←mul_add, add_tsub_cancel_of_le (one_le_two.trans hb)]
    ... = a + a/(b - 1)
        : by rw [mul_one, nat.add_mul_div_right _ _ (tsub_pos_of_lt hb), add_comm]
end

section order

variables {n : ℕ} {x : α}

lemma geom_sum_pos [strict_ordered_semiring α] (hx : 0 ≤ x) (hn : n ≠ 0) :
  0 < ∑ i in range n, x ^ i :=
sum_pos' (λ k hk, pow_nonneg hx _) ⟨0, mem_range.2 hn.bot_lt, by simp⟩

lemma geom_sum_pos_and_lt_one [strict_ordered_ring α] (hx : x < 0) (hx' : 0 < x + 1) (hn : 1 < n) :
  0 < ∑ i in range n, x ^ i ∧ ∑ i in range n, x ^ i < 1 :=
begin
  refine nat.le_induction _ _ n (show 2 ≤ n, from hn),
  { rw geom_sum_two,
    exact ⟨hx', (add_lt_iff_neg_right _).2 hx⟩ },
  clear hn n,
  intros n hn ihn,
  rw [geom_sum_succ, add_lt_iff_neg_right, ← neg_lt_iff_pos_add', neg_mul_eq_neg_mul],
  exact ⟨mul_lt_one_of_nonneg_of_lt_one_left (neg_nonneg.2 hx.le)
    (neg_lt_iff_pos_add'.2 hx') ihn.2.le, mul_neg_of_neg_of_pos hx ihn.1⟩
end

lemma geom_sum_alternating_of_le_neg_one [strict_ordered_ring α] (hx : x + 1 ≤ 0) (n : ℕ) :
  if even n then ∑ i in range n, x ^ i ≤ 0 else 1 ≤ ∑ i in range n, x ^ i :=
begin
  have hx0 : x ≤ 0 := (le_add_of_nonneg_right zero_le_one).trans hx,
  induction n with n ih,
  { simp only [even_zero, geom_sum_zero, le_refl] },
  simp only [nat.even_add_one, geom_sum_succ],
  split_ifs at ih,
  { rw [if_neg (not_not_intro h), le_add_iff_nonneg_left],
    exact mul_nonneg_of_nonpos_of_nonpos hx0 ih },
  { rw if_pos h,
    refine (add_le_add_right _ _).trans hx,
    simpa only [mul_one] using mul_le_mul_of_nonpos_left ih hx0 }
end

lemma geom_sum_alternating_of_lt_neg_one [strict_ordered_ring α] (hx : x + 1 < 0) (hn : 1 < n) :
  if even n then ∑ i in range n, x ^ i < 0 else 1 < ∑ i in range n, x ^ i  :=
begin
  have hx0 : x < 0, from ((le_add_iff_nonneg_right _).2 zero_le_one).trans_lt hx,
  refine nat.le_induction _ _ n (show 2 ≤ n, from hn),
  { simp only [geom_sum_two, hx, true_or, even_bit0, if_true_left_eq_or] },
  clear hn n,
  intros n hn ihn,
  simp only [nat.even_add_one, geom_sum_succ],
  by_cases hn' : even n,
  { rw [if_pos hn'] at ihn, rw [if_neg, lt_add_iff_pos_left],
    exact mul_pos_of_neg_of_neg hx0 ihn, exact not_not_intro hn', },
  { rw [if_neg hn'] at ihn, rw [if_pos], swap, { exact hn' },
    have := add_lt_add_right (mul_lt_mul_of_neg_left ihn hx0) 1,
    rw mul_one at this,
    exact this.trans hx }
end

lemma geom_sum_pos' [linear_ordered_ring α] (hx : 0 < x + 1) (hn : n ≠ 0) :
  0 < ∑ i in range n, x ^ i :=
begin
  obtain _ | _ | n := n,
  { cases hn rfl },
  { simp },
  obtain hx' | hx' := lt_or_le x 0,
  { exact (geom_sum_pos_and_lt_one hx' hx n.one_lt_succ_succ).1 },
  { exact geom_sum_pos hx' (by simp only [nat.succ_ne_zero, ne.def, not_false_iff]) }
end

lemma odd.geom_sum_pos [linear_ordered_ring α] (h : odd n) :
  0 < ∑ i in range n, x ^ i :=
begin
  rcases n with (_ | _ | k),
  { exact ((show ¬ odd 0, from dec_trivial) h).elim },
  { simp only [geom_sum_one, zero_lt_one] },
  rw nat.odd_iff_not_even at h,
  rcases lt_trichotomy (x + 1) 0 with hx | hx | hx,
  { have := geom_sum_alternating_of_lt_neg_one hx k.one_lt_succ_succ,
    simp only [h, if_false] at this,
    exact zero_lt_one.trans this },
  { simp only [eq_neg_of_add_eq_zero_left hx, h, neg_one_geom_sum, if_false, zero_lt_one] },
  { exact geom_sum_pos' hx k.succ.succ_ne_zero }
end

lemma geom_sum_pos_iff [linear_ordered_ring α] (hn : n ≠ 0) :
  0 < ∑ i in range n, x ^ i ↔ odd n ∨ 0 < x + 1 :=
begin
  refine ⟨λ h, _, _⟩,
  { rw [or_iff_not_imp_left, ←not_le, ←nat.even_iff_not_odd],
    refine λ hn hx, h.not_le _,
    simpa [if_pos hn] using geom_sum_alternating_of_le_neg_one hx n },
  { rintro (hn | hx'),
    { exact hn.geom_sum_pos },
    { exact geom_sum_pos' hx' hn } }
end

lemma geom_sum_ne_zero [linear_ordered_ring α] (hx : x ≠ -1) (hn : n ≠ 0) :
  ∑ i in range n, x ^ i ≠ 0 :=
begin
  obtain _ | _ | n := n,
  { cases hn rfl },
  { simp },
  rw [ne.def, eq_neg_iff_add_eq_zero, ←ne.def] at hx,
  obtain h | h := hx.lt_or_lt,
  { have := geom_sum_alternating_of_lt_neg_one h n.one_lt_succ_succ,
    split_ifs at this,
    { exact this.ne },
    { exact (zero_lt_one.trans this).ne' } },
  { exact (geom_sum_pos' h n.succ.succ_ne_zero).ne' }
end

lemma geom_sum_eq_zero_iff_neg_one [linear_ordered_ring α] (hn : n ≠ 0) :
  ∑ i in range n, x ^ i = 0 ↔ x = -1 ∧ even n :=
begin
  refine ⟨λ h, _, λ ⟨h, hn⟩, by simp only [h, hn, neg_one_geom_sum, if_true]⟩,
  contrapose! h,
  obtain rfl | hx := eq_or_ne x (-1),
  { simp only [h rfl, neg_one_geom_sum, if_false, ne.def, not_false_iff, one_ne_zero] },
  { exact geom_sum_ne_zero hx hn }
end

lemma geom_sum_neg_iff [linear_ordered_ring α] (hn : n ≠ 0) :
  ∑ i in range n, x ^ i < 0 ↔ even n ∧ x + 1 < 0 :=
by rw [← not_iff_not, not_lt, le_iff_lt_or_eq, eq_comm,
       or_congr (geom_sum_pos_iff hn) (geom_sum_eq_zero_iff_neg_one hn), nat.odd_iff_not_even,
       ← add_eq_zero_iff_eq_neg, not_and, not_lt, le_iff_lt_or_eq, eq_comm,
       ← imp_iff_not_or, or_comm, and_comm, decidable.and_or_imp, or_comm]

end order


/-
Copyright (c) 2022 Kevin H. Wilson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin H. Wilson
-/
import measure_theory.integral.interval_integral
import data.set.function
import analysis.special_functions.integrals

/-!
# Comparing sums and integrals

## Summary

It is often the case that error terms in analysis can be computed by comparing
an infinite sum to the improper integral of an antitone function. This file will eventually enable
that.

At the moment it contains four lemmas in this direction: `antitone_on.integral_le_sum`,
`antitone_on.sum_le_integral` and versions for monotone functions, which can all be paired
with a `filter.tendsto` to estimate some errors.

`TODO`: Add more lemmas to the API to directly address limiting issues

## Main Results

* `antitone_on.integral_le_sum`: The integral of an antitone function is at most the sum of its
  values at integer steps aligning with the left-hand side of the interval
* `antitone_on.sum_le_integral`: The sum of an antitone function along integer steps aligning with
  the right-hand side of the interval is at most the integral of the function along that interval
* `monotone_on.integral_le_sum`: The integral of a monotone function is at most the sum of its
  values at integer steps aligning with the right-hand side of the interval
* `monotone_on.sum_le_integral`: The sum of a monotone function along integer steps aligning with
  the left-hand side of the interval is at most the integral of the function along that interval

## Tags

analysis, comparison, asymptotics
-/

open set measure_theory.measure_space
open_locale big_operators

variables {x₀ : ℝ} {a b : ℕ} {f : ℝ → ℝ}

lemma antitone_on.integral_le_sum (hf : antitone_on f (Icc x₀ (x₀ + a))) :
  ∫ x in x₀..(x₀ + a), f x ≤ ∑ i in finset.range a, f (x₀ + i) :=
begin
  have hint : ∀ (k : ℕ), k < a → interval_integrable f volume (x₀+k) (x₀ + (k + 1 : ℕ)),
  { assume k hk,
    refine (hf.mono _).interval_integrable,
    rw uIcc_of_le,
    { apply Icc_subset_Icc,
      { simp only [le_add_iff_nonneg_right, nat.cast_nonneg] },
      { simp only [add_le_add_iff_left, nat.cast_le, nat.succ_le_of_lt hk] } },
    { simp only [add_le_add_iff_left, nat.cast_le, nat.le_succ] } },
  calc
  ∫ x in x₀..(x₀ + a), f x = ∑ i in finset.range a, ∫ x in (x₀+i)..(x₀+(i+1 : ℕ)), f x :
    begin
      convert (interval_integral.sum_integral_adjacent_intervals hint).symm,
      simp only [nat.cast_zero, add_zero],
    end
  ... ≤ ∑ i in finset.range a, ∫ x in (x₀+i)..(x₀+(i+1 : ℕ)), f (x₀ + i) :
    begin
      apply finset.sum_le_sum (λ i hi, _),
      have ia : i < a := finset.mem_range.1 hi,
      refine interval_integral.integral_mono_on (by simp) (hint _ ia) (by simp) (λ x hx, _),
      apply hf _ _ hx.1,
      { simp only [ia.le, mem_Icc, le_add_iff_nonneg_right, nat.cast_nonneg, add_le_add_iff_left,
          nat.cast_le, and_self] },
      { refine mem_Icc.2 ⟨le_trans (by simp) hx.1, le_trans hx.2 _⟩,
        simp only [add_le_add_iff_left, nat.cast_le, nat.succ_le_of_lt ia] },
    end
  ... = ∑ i in finset.range a, f (x₀ + i) : by simp
end

lemma antitone_on.integral_le_sum_Ico (hab : a ≤ b) (hf : antitone_on f (set.Icc a b)) :
  ∫ x in a..b, f x ≤ ∑ x in finset.Ico a b, f x :=
begin
  rw [(nat.sub_add_cancel hab).symm, nat.cast_add],
  conv { congr, congr, skip, skip, rw add_comm, skip, skip, congr, congr, rw ←zero_add a, },
  rw [← finset.sum_Ico_add, nat.Ico_zero_eq_range],
  conv { to_rhs, congr, skip, funext, rw nat.cast_add, },
  apply antitone_on.integral_le_sum,
  simp only [hf, hab, nat.cast_sub, add_sub_cancel'_right],
end

lemma antitone_on.sum_le_integral (hf : antitone_on f (Icc x₀ (x₀ + a))) :
  ∑ i in finset.range a, f (x₀ + (i + 1 : ℕ)) ≤ ∫ x in x₀..(x₀ + a), f x :=
begin
  have hint : ∀ (k : ℕ), k < a → interval_integrable f volume (x₀+k) (x₀ + (k + 1 : ℕ)),
  { assume k hk,
    refine (hf.mono _).interval_integrable,
    rw uIcc_of_le,
    { apply Icc_subset_Icc,
      { simp only [le_add_iff_nonneg_right, nat.cast_nonneg] },
      { simp only [add_le_add_iff_left, nat.cast_le, nat.succ_le_of_lt hk] } },
    { simp only [add_le_add_iff_left, nat.cast_le, nat.le_succ] } },
  calc ∑ i in finset.range a, f (x₀ + (i + 1 : ℕ))
      = ∑ i in finset.range a, ∫ x in (x₀+i)..(x₀+(i+1:ℕ)), f (x₀ + (i + 1 : ℕ)) : by simp
  ... ≤ ∑ i in finset.range a, ∫ x in (x₀+i)..(x₀+(i+1:ℕ)), f x :
    begin
      apply finset.sum_le_sum (λ i hi, _),
      have ia : i + 1 ≤ a := finset.mem_range.1 hi,
      refine interval_integral.integral_mono_on (by simp) (by simp) (hint _ ia) (λ x hx, _),
      apply hf _ _ hx.2,
      { refine mem_Icc.2 ⟨le_trans ((le_add_iff_nonneg_right _).2 (nat.cast_nonneg _)) hx.1,
          le_trans hx.2 _⟩,
        simp only [nat.cast_le, add_le_add_iff_left, ia] },
      { refine mem_Icc.2 ⟨(le_add_iff_nonneg_right _).2 (nat.cast_nonneg _), _⟩,
        simp only [add_le_add_iff_left, nat.cast_le, ia] },
    end
  ... = ∫ x in x₀..(x₀ + a), f x :
    begin
      convert interval_integral.sum_integral_adjacent_intervals hint,
      simp only [nat.cast_zero, add_zero],
    end
end

lemma antitone_on.sum_le_integral_Ico (hab : a ≤ b) (hf : antitone_on f (set.Icc a b)) :
  ∑ i in finset.Ico a b, f (i + 1 : ℕ) ≤ ∫ x in a..b, f x :=
begin
  rw [(nat.sub_add_cancel hab).symm, nat.cast_add],
  conv { congr, congr, congr, rw ← zero_add a, skip, skip, skip, rw add_comm, },
  rw [← finset.sum_Ico_add, nat.Ico_zero_eq_range],
  conv { to_lhs, congr, congr, skip, funext, rw [add_assoc, nat.cast_add], },
  apply antitone_on.sum_le_integral,
  simp only [hf, hab, nat.cast_sub, add_sub_cancel'_right],
end

lemma monotone_on.sum_le_integral (hf : monotone_on f (Icc x₀ (x₀ + a))) :
  ∑ i in finset.range a, f (x₀ + i) ≤ ∫ x in x₀..(x₀ + a), f x :=
begin
  rw [← neg_le_neg_iff, ← finset.sum_neg_distrib, ← interval_integral.integral_neg],
  exact hf.neg.integral_le_sum,
end

lemma monotone_on.sum_le_integral_Ico (hab : a ≤ b) (hf : monotone_on f (set.Icc a b)) :
  ∑ x in finset.Ico a b, f x ≤ ∫ x in a..b, f x :=
begin
  rw [← neg_le_neg_iff, ← finset.sum_neg_distrib, ← interval_integral.integral_neg],
  exact hf.neg.integral_le_sum_Ico hab,
end

lemma monotone_on.integral_le_sum (hf : monotone_on f (Icc x₀ (x₀ + a))) :
  ∫ x in x₀..(x₀ + a), f x ≤ ∑ i in finset.range a, f (x₀ + (i + 1 : ℕ)) :=
begin
  rw [← neg_le_neg_iff, ← finset.sum_neg_distrib, ← interval_integral.integral_neg],
  exact hf.neg.sum_le_integral,
end

lemma monotone_on.integral_le_sum_Ico (hab : a ≤ b) (hf : monotone_on f (set.Icc a b)) :
  ∫ x in a..b, f x ≤ ∑ i in finset.Ico a b, f (i + 1 : ℕ) :=
begin
  rw [← neg_le_neg_iff, ← finset.sum_neg_distrib, ← interval_integral.integral_neg],
  exact hf.neg.sum_le_integral_Ico hab,
end


/-
Copyright (c) 2021 David Wärn,. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn, Scott Morrison
-/
import combinatorics.quiver.basic
import logic.lemmas

/-!
# Paths in quivers

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

Given a quiver `V`, we define the type of paths from `a : V` to `b : V` as an inductive
family. We define composition of paths and the action of prefunctors on paths.
-/

open function

universes v v₁ v₂ u u₁ u₂

namespace quiver

/-- `G.path a b` is the type of paths from `a` to `b` through the arrows of `G`. -/
inductive path {V : Type u} [quiver.{v} V] (a : V) : V → Sort (max (u+1) v)
| nil  : path a
| cons : Π {b c : V}, path b → (b ⟶ c) → path c

/-- An arrow viewed as a path of length one. -/
def hom.to_path {V} [quiver V] {a b : V} (e : a ⟶ b) : path a b :=
path.nil.cons e

namespace path

variables {V : Type u} [quiver V] {a b c d : V}

lemma nil_ne_cons (p : path a b) (e : b ⟶ a) : path.nil ≠ p.cons e.

lemma cons_ne_nil (p : path a b) (e : b ⟶ a) : p.cons e ≠ path.nil.

lemma obj_eq_of_cons_eq_cons {p : path a b} {p' : path a c}
  {e : b ⟶ d} {e' : c ⟶ d} (h : p.cons e = p'.cons e') : b = c := by injection h

lemma heq_of_cons_eq_cons {p : path a b} {p' : path a c}
  {e : b ⟶ d} {e' : c ⟶ d} (h : p.cons e = p'.cons e') : p == p' := by injection h

lemma hom_heq_of_cons_eq_cons {p : path a b} {p' : path a c}
  {e : b ⟶ d} {e' : c ⟶ d} (h : p.cons e = p'.cons e') : e == e' := by injection h

/-- The length of a path is the number of arrows it uses. -/
def length {a : V} : Π {b : V}, path a b → ℕ
| _ path.nil        := 0
| _ (path.cons p _) := p.length + 1

instance {a : V} : inhabited (path a a) := ⟨path.nil⟩

@[simp] lemma length_nil {a : V} :
  (path.nil : path a a).length = 0 := rfl

@[simp] lemma length_cons (a b c : V) (p : path a b)
  (e : b ⟶ c) : (p.cons e).length = p.length + 1 := rfl

lemma eq_of_length_zero (p : path a b) (hzero : p.length = 0) : a = b :=
by { cases p, { refl }, { cases nat.succ_ne_zero _ hzero } }

/-- Composition of paths. -/
def comp {a b : V} : Π {c}, path a b → path b c → path a c
| _ p (path.nil) := p
| _ p (path.cons q e) := (p.comp q).cons e

@[simp] lemma comp_cons {a b c d : V} (p : path a b) (q : path b c) (e : c ⟶ d) :
  p.comp (q.cons e) = (p.comp q).cons e := rfl

@[simp] lemma comp_nil {a b : V} (p : path a b) : p.comp path.nil = p := rfl

@[simp] lemma nil_comp {a : V} : ∀ {b} (p : path a b), path.nil.comp p = p
| a path.nil := rfl
| b (path.cons p e) := by rw [comp_cons, nil_comp]

@[simp] lemma comp_assoc {a b c : V} : ∀ {d}
  (p : path a b) (q : path b c) (r : path c d),
    (p.comp q).comp r = p.comp (q.comp r)
| c p q path.nil := rfl
| d p q (path.cons r e) := by rw [comp_cons, comp_cons, comp_cons, comp_assoc]

@[simp] lemma length_comp (p : path a b) :
  ∀ {c} (q : path b c), (p.comp q).length = p.length + q.length
| c nil := rfl
| c (cons q h) := congr_arg nat.succ q.length_comp

lemma comp_inj {p₁ p₂ : path a b} {q₁ q₂ : path b c} (hq : q₁.length = q₂.length) :
  p₁.comp q₁ = p₂.comp q₂ ↔ p₁ = p₂ ∧ q₁ = q₂ :=
begin
  refine ⟨λ h, _, by { rintro ⟨rfl, rfl⟩, refl }⟩,
  induction q₁ with d₁ e₁ q₁ f₁ ih generalizing q₂; obtain _ | ⟨q₂, f₂⟩ := q₂,
  { exact ⟨h, rfl⟩ },
  { cases hq },
  { cases hq },
  simp only [comp_cons] at h,
  obtain rfl := h.1,
  obtain ⟨rfl, rfl⟩ := ih (nat.succ.inj hq) h.2.1.eq,
  rw h.2.2.eq,
  exact ⟨rfl, rfl⟩,
end

lemma comp_inj' {p₁ p₂ : path a b} {q₁ q₂ : path b c} (h : p₁.length = p₂.length) :
  p₁.comp q₁ = p₂.comp q₂ ↔ p₁ = p₂ ∧ q₁ = q₂ :=
⟨λ h_eq, (comp_inj $ nat.add_left_cancel $
  by simpa [h] using congr_arg length h_eq).1 h_eq, by { rintro ⟨rfl, rfl⟩, refl }⟩

lemma comp_injective_left (q : path b c) : injective (λ p : path a b, p.comp q) :=
λ p₁ p₂ h, ((comp_inj rfl).1 h).1

lemma comp_injective_right (p : path a b) : injective (p.comp : path b c → path a c) :=
λ q₁ q₂ h, ((comp_inj' rfl).1 h).2

@[simp] lemma comp_inj_left {p₁ p₂ : path a b} {q : path b c} : p₁.comp q = p₂.comp q ↔ p₁ = p₂ :=
q.comp_injective_left.eq_iff

@[simp] lemma comp_inj_right {p : path a b} {q₁ q₂ : path b c} : p.comp q₁ = p.comp q₂ ↔ q₁ = q₂ :=
p.comp_injective_right.eq_iff

/-- Turn a path into a list. The list contains `a` at its head, but not `b` a priori. -/
@[simp] def to_list : Π {b : V}, path a b → list V
| b nil := []
| b (@cons _ _ _ c _ p f) := c :: p.to_list

/-- `quiver.path.to_list` is a contravariant functor. The inversion comes from `quiver.path` and
`list` having different preferred directions for adding elements. -/
@[simp] lemma to_list_comp (p : path a b) :
  ∀ {c} (q : path b c), (p.comp q).to_list = q.to_list ++ p.to_list
| c nil := by simp
| c (@cons _ _ _ d _ q f) := by simp [to_list_comp]

lemma to_list_chain_nonempty :
  ∀ {b} (p : path a b), p.to_list.chain (λ x y, nonempty (y ⟶ x)) b
| b nil := list.chain.nil
| b (cons p f) := p.to_list_chain_nonempty.cons ⟨f⟩

variables [∀ a b : V, subsingleton (a ⟶ b)]

lemma to_list_injective (a : V) : ∀ b, injective (to_list : path a b → list V)
| b nil nil h := rfl
| b nil (@cons _ _ _ c _ p f) h := by cases h
| b (@cons _ _ _ c _ p f) nil h := by cases h
| b (@cons _ _ _ c _ p f) (@cons _ _ s t u C D) h := begin
  simp only [to_list] at h,
  obtain ⟨rfl, hAC⟩ := h,
  simp [to_list_injective _ hAC],
end

@[simp] lemma to_list_inj {p q : path a b} : p.to_list = q.to_list ↔ p = q :=
(to_list_injective _ _).eq_iff

end path

end quiver

namespace prefunctor

open quiver

variables {V : Type u₁} [quiver.{v₁} V] {W : Type u₂} [quiver.{v₂} W] (F : V ⥤q W)

/-- The image of a path under a prefunctor. -/
def map_path {a : V} :
  Π {b : V}, path a b → path (F.obj a) (F.obj b)
| _ path.nil := path.nil
| _ (path.cons p e) := path.cons (map_path p) (F.map e)

@[simp] lemma map_path_nil (a : V) : F.map_path (path.nil : path a a) = path.nil := rfl
@[simp] lemma map_path_cons {a b c : V} (p : path a b) (e : b ⟶ c) :
  F.map_path (path.cons p e) = path.cons (F.map_path p) (F.map e) := rfl

@[simp] lemma map_path_comp {a b : V} (p : path a b) :
  ∀ {c : V} (q : path b c), F.map_path (p.comp q) = (F.map_path p).comp (F.map_path q)
| _ path.nil := rfl
| _ (path.cons p e) := begin dsimp, rw [map_path_comp], end

@[simp]
lemma map_path_to_path {a b : V} (f : a ⟶ b) : F.map_path f.to_path = (F.map f).to_path := rfl

end prefunctor


import Lean4Axiomatic.Rational.Reciprocation

/-! # Rational numbers: sign -/

namespace Lean4Axiomatic.Rational

open Logic (AP)
open Signed (Negative Positive sgn)

/--
Operations pertaining to rational number signedness.

The operation names are prefixed with underscores so that they don't conflict
with the standard names. This allows the standard names to be used unqualified,
without a namespace prefix.
-/
class Sign.Ops
    {ℕ ℤ : outParam Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ] (ℚ : Type)
    :=
  /--
  The [_signum function_](https://en.wikipedia.org/wiki/Sign_function).

  Extracts the sign of a rational number.
  -/
  _sgn : ℚ → ℤ

  /-- Holds only for positive rational numbers. -/
  _Positive : ℚ → Prop

  /-- Holds only for negative rational numbers. -/
  _Negative : ℚ → Prop

/-- Enables the use of the standard name `sgn` for signum. -/
instance sgn_ops
    {ℕ ℤ ℚ : Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ] [Sign.Ops (ℤ := ℤ) ℚ]
    : Signed.Sgn.Ops (ℤ := ℤ) ℚ
    := {
  sgn := Sign.Ops._sgn
}

/-- Enables the use of the standard names `Positive` and `Negative`. -/
instance signed_ops
    {ℕ ℤ ℚ : Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
    [Core (ℤ := ℤ) ℚ] [Sign.Ops (ℤ := ℤ) ℚ]
    : Signed.Ops ℚ := {
  Positive := Sign.Ops._Positive
  Negative := Sign.Ops._Negative
  Nonzero := (· ≄ 0)
}

/-- Properties of rational number signedness. -/
class Sign.Props
    {ℕ ℤ : outParam Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
    (ℚ : Type)
      [Core (ℤ := ℤ) ℚ] [Addition ℚ] [Multiplication ℚ] [Negation ℚ]
      [Ops (ℤ := ℤ) ℚ]
    :=
  /-- `sgn` respects rational number equivalence. -/
  sgn_subst {p₁ p₂ : ℚ} : p₁ ≃ p₂ → sgn p₁ ≃ sgn p₂

  /-- Zero is the only rational number whose `sgn` is zero. -/
  sgn_zero_only_for_zero {p : ℚ} : sgn p ≃ 0 → p ≃ 0

  /-- Converting integers to rational numbers preserves their sign. -/
  sgn_from_integer {a : ℤ} : sgn (a : ℚ) ≃ sgn a

  /-- The `sgn` function is compatible with multiplication. -/
  sgn_compat_mul {p q : ℚ} : sgn (p * q) ≃ sgn p * sgn q

  /-- There are only three possible values of the `sgn` function. -/
  sgn_trichotomy (p : ℚ) : AA.OneOfThree (sgn p ≃ 0) (sgn p ≃ 1) (sgn p ≃ -1)

  /-- A rational number is positive iff its sign is `1`. -/
  sgn_positive {p : ℚ} : Positive p ↔ sgn p ≃ 1

  /-- A rational number is negative iff its sign is `-1`. -/
  sgn_negative {p : ℚ} : Negative p ↔ sgn p ≃ -1

export Sign.Props (
  sgn_compat_mul sgn_from_integer sgn_negative sgn_positive sgn_subst
  sgn_trichotomy
)

/-- All rational number sign axioms. -/
class Sign
    {ℕ ℤ : outParam Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
    (ℚ : Type) [Core (ℤ := ℤ) ℚ] [Addition ℚ] [Multiplication ℚ] [Negation ℚ]
    :=
  toOps : Sign.Ops (ℤ := ℤ) ℚ
  toProps : Sign.Props ℚ

attribute [instance] Sign.toOps
attribute [instance] Sign.toProps

/-! ## Derived properties -/

variable {ℕ ℤ ℚ : Type}
  [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
  [Core (ℤ := ℤ) ℚ] [Addition ℚ] [Multiplication ℚ]
  [Negation ℚ] [Reciprocation ℚ] [Division ℚ] [Sign ℚ]

/--
Zero's sign is zero, and it's the only rational number with that sign value.

**Property intuition**: Zero is neither positive nor negative.

**Proof intuition**: Directly follows from the `sgn_from_integer` and
`sgn_zero_only_for_zero` axioms.
-/
theorem sgn_zero {p : ℚ} : p ≃ 0 ↔ sgn p ≃ 0 := by
  apply Iff.intro
  case mp =>
    intro (_ : p ≃ 0)
    show sgn p ≃ 0
    calc
      sgn p             ≃ _ := sgn_subst ‹p ≃ 0›
      sgn ((0 : ℤ) : ℚ) ≃ _ := sgn_from_integer
      sgn (0 : ℤ)       ≃ _ := Integer.sgn_zero.mp Rel.refl
      0                 ≃ _ := Rel.refl
  case mpr =>
    exact Sign.Props.sgn_zero_only_for_zero

/--
Taking both the `sgn` and negation of a rational number can be done in either
order.

See `Integer.sgn_compat_neg` for intuition.
-/
theorem sgn_compat_neg {p : ℚ} : sgn (-p) ≃ -(sgn p) := by
  have : sgn (-1 : ℤ) ≃ -1 := Integer.sgn_negative.mp Integer.neg_one_negative
  have neg_coe : (-1 : ℚ) ≃ ((-1 : ℤ) : ℚ) := eqv_symm neg_compat_from_integer
  calc
    sgn (-p)                   ≃ _ := sgn_subst (eqv_symm mul_neg_one)
    sgn (-1 * p)               ≃ _ := sgn_compat_mul
    sgn (-1 : ℚ) * sgn p       ≃ _ := AA.substL (sgn_subst neg_coe)
    sgn ((-1 : ℤ) : ℚ) * sgn p ≃ _ := AA.substL sgn_from_integer
    sgn (-1 : ℤ) * sgn p       ≃ _ := AA.substL ‹sgn (-1 : ℤ) ≃ -1›
    (-1) * sgn p               ≃ _ := Integer.mul_neg_one
    (-(sgn p))                 ≃ _ := Rel.refl

/--
The sign of a nonzero rational number is a square root of unity.

**Property and proof intuition**: The allowed sign values are `1`, `0`, and
`-1`; nonzero rationals have nonzero signs; `1` and `-1` are square roots of
unity.
-/
theorem sqrt1_sgn_nonzero {p : ℚ} [AP (p ≄ 0)] : Integer.Sqrt1 (sgn p) := by
  have : AA.OneOfThree (sgn p ≃ 0) (sgn p ≃ 1) (sgn p ≃ -1) := sgn_trichotomy p
  have : sgn p ≃ 1 ∨ sgn p ≃ -1 :=
    match this with
    | AA.OneOfThree.first (_ : sgn p ≃ 0) =>
      have : p ≄ 0 := ‹AP (p ≄ 0)›.ev
      have : sgn p ≄ 0 := mt sgn_zero.mpr this
      absurd ‹sgn p ≃ 0› ‹sgn p ≄ 0›
    | AA.OneOfThree.second (_ : sgn p ≃ 1) =>
      Or.inl ‹sgn p ≃ 1›
    | AA.OneOfThree.third (_ : sgn p ≃ -1) =>
      Or.inr ‹sgn p ≃ -1›
  have : Integer.Sqrt1 (sgn p) := Integer.sqrt1_cases.mpr this
  exact this

/--
Taking the reciprocal of a rational number preserves its sign.

**Property intuition**: Flipping a fraction over doesn't change the sign of the
numerator or denominator.

**Proof intuition**: This can only be shown for nonzero rational numbers, since
they have reciprocals. Use the property that the sign values of nonzero
rationals are square roots of unity, along with the algebraic interactions of
`sgn` with multiplication and reciprocation.
-/
theorem sgn_recip {p : ℚ} [AP (p ≄ 0)] : sgn (p⁻¹) ≃ sgn p := by
  have : 1 ≃ sgn p * sgn p := Rel.symm sqrt1_sgn_nonzero.elim
  calc
    sgn (p⁻¹)                   ≃ _ := Rel.symm AA.identR
    sgn (p⁻¹) * 1               ≃ _ := AA.substR ‹1 ≃ sgn p * sgn p›
    sgn (p⁻¹) * (sgn p * sgn p) ≃ _ := AA.substR (Rel.symm sgn_compat_mul)
    sgn (p⁻¹) * sgn (p * p)     ≃ _ := Rel.symm sgn_compat_mul
    sgn (p⁻¹ * (p * p))         ≃ _ := sgn_subst (eqv_symm mul_assoc)
    sgn ((p⁻¹ * p) * p)         ≃ _ := sgn_subst (mul_substL mul_inverseL)
    sgn (1 * p)                 ≃ _ := sgn_subst mul_identL
    sgn p                       ≃ _ := Rel.refl

/--
The sign of a fraction formed from integers is the product of the integers'
signs.

**Property and proof intuition**: Division is multiplication by a reciprocal,
and since reciprocal preserves signs, it can be ignored.
-/
theorem sgn_div_integers
    {a b : ℤ} [Integer.Nonzero b] : sgn ((a : ℚ) / (b : ℚ)) ≃ sgn a * sgn b
    := calc
  sgn ((a : ℚ) / (b : ℚ))       ≃ _ := sgn_subst div_mul_recip
  sgn ((a : ℚ) * (b : ℚ)⁻¹)     ≃ _ := sgn_compat_mul
  sgn (a : ℚ) * sgn ((b : ℚ)⁻¹) ≃ _ := AA.substR sgn_recip
  sgn (a : ℚ) * sgn (b : ℚ)     ≃ _ := AA.substL sgn_from_integer
  sgn a * sgn (b : ℚ)           ≃ _ := AA.substR sgn_from_integer
  sgn a * sgn b                 ≃ _ := Rel.refl

/--
The _signum_ function is idempotent: applying it twice is the same as applying
it once.

**Property intuition**: The `sgn` function has only three possible results, and
each of them is a fixed point.

**Proof intuition**: Instead of using trichotomy to do tedious case analysis,
convert the rational into its fraction form and reduce it to an expression with
integer `sgn`, which we already know is idempotent.
-/
theorem sgn_idemp {p : ℚ} : sgn (sgn p) ≃ sgn p := by
  have (AsRatio.intro (a : ℤ) (b : ℤ) (_ : Integer.Nonzero b) eqv) :=
    as_ratio p
  have : p ≃ a/b := eqv
  calc
    sgn (sgn p)               ≃ _ := Integer.sgn_subst (sgn_subst ‹p ≃ a/b›)
    sgn (sgn ((a : ℚ)/b))     ≃ _ := Integer.sgn_subst sgn_div_integers
    sgn (sgn a * sgn b)       ≃ _ := Integer.sgn_compat_mul
    sgn (sgn a) * sgn (sgn b) ≃ _ := AA.substL Integer.sgn_idemp
    sgn a * sgn (sgn b)       ≃ _ := AA.substR Integer.sgn_idemp
    sgn a * sgn b             ≃ _ := Rel.symm sgn_div_integers
    sgn ((a : ℚ)/b)           ≃ _ := sgn_subst (eqv_symm ‹p ≃ a/b›)
    sgn p                     ≃ _ := Rel.refl

/--
The square of a rational number is nonnegative.

**Property intuition**: The product of two negative numbers is positive, and
zero times anything is zero, so this must be true.

**Proof intuition**: Assume that the square is negative and reach a
contradiction. The sign of the number being squared must be nonzero, otherwise
its square would have a sign of zero. We also know that the square of the sign
is `-1`. If two nonzero signs have a negative product, then they must be
distinct -- but in this case that means the sign is distinct from itself.
Contradiction.
-/
theorem nonneg_square {p : ℚ} : sgn (p * p) ≄ -1 := by
  intro (_ : sgn (p * p) ≃ -1)
  show False
  have : sgn p * sgn p ≃ -1 :=
    Rel.trans (Rel.symm sgn_compat_mul) ‹sgn (p * p) ≃ -1›
  have : Integer.Nonzero (-1 : ℤ) := Integer.nonzero_sqrt1
  have : Integer.Nonzero (sgn p * sgn p) :=
    Integer.nonzero_subst (Rel.symm ‹sgn p * sgn p ≃ -1›) this
  have (And.intro (_ : Integer.Nonzero (sgn p)) _) :=
    Integer.nonzero_factors_if_nonzero_product this
  have : Integer.Sqrt1 (sgn (sgn p)) :=
    Integer.sgn_nonzero.mp ‹Integer.Nonzero (sgn p)›
  have : Integer.Sqrt1 (sgn p) := Integer.sqrt1_subst sgn_idemp this
  have : sgn p ≄ sgn p := Integer.mul_sqrt1_neqv.mp ‹sgn p * sgn p ≃ -1›
  exact absurd Rel.refl this

/--
For a product of rational numbers to be zero, at least one of its factors must
be zero.

**Property intuition**: This holds for integers, and since rational numbers
are just scaled integers it should hold for them as well.

**Proof intuition**: The `sgn` of a rational number is an integer, so we can
use the integer version of this property to show that the sign value of one of
the factors must be zero. But only zero has a zero sign value, so one of the
rational numbers must itself be zero.
-/
theorem mul_split_zero {p q : ℚ} : p * q ≃ 0 ↔ p ≃ 0 ∨ q ≃ 0 := by
  apply Iff.intro
  case mp =>
    intro (_ : p * q ≃ 0)
    show p ≃ 0 ∨ q ≃ 0
    have : sgn p * sgn q ≃ 0 := calc
      sgn p * sgn q ≃ _ := Rel.symm sgn_compat_mul
      sgn (p * q)   ≃ _ := sgn_zero.mp ‹p * q ≃ 0›
      0             ≃ _ := Rel.refl
    have : sgn p ≃ 0 ∨ sgn q ≃ 0 := Integer.mul_split_zero.mp this
    have : p ≃ 0 ∨ q ≃ 0 := match this with
    | Or.inl (_ : sgn p ≃ 0) =>
      have : p ≃ 0 := sgn_zero.mpr ‹sgn p ≃ 0›
      Or.inl this
    | Or.inr (_ : sgn q ≃ 0) =>
      have : q ≃ 0 := sgn_zero.mpr ‹sgn q ≃ 0›
      Or.inr this
    exact this
  case mpr =>
    intro (_ : p ≃ 0 ∨ q ≃ 0)
    show p * q ≃ 0
    match ‹p ≃ 0 ∨ q ≃ 0› with
    | Or.inl (_ : p ≃ 0) => calc
      p * q ≃ _ := mul_substL ‹p ≃ 0›
      0 * q ≃ _ := mul_absorbL
      0     ≃ _ := eqv_refl
    | Or.inr (_ : q ≃ 0) => calc
      p * q ≃ _ := mul_substR ‹q ≃ 0›
      p * 0 ≃ _ := mul_absorbR
      0     ≃ _ := eqv_refl

/--
The product of nonzero rational numbers is nonzero.

**Property and proof intuition**: This is essentially the contrapositive of
`mul_split_zero`.
-/
theorem mul_preserves_nonzero {p q : ℚ} : p ≄ 0 → q ≄ 0 → p * q ≄ 0 := by
  intro (_ : p ≄ 0) (_ : q ≄ 0)
  show p * q ≄ 0
  have : p ≄ 0 ∧ q ≄ 0 := And.intro ‹p ≄ 0› ‹q ≄ 0›
  have : ¬(p ≃ 0 ∨ q ≃ 0) := Logic.not_or_iff_and_not.mpr this
  have : p * q ≄ 0 := mt mul_split_zero.mp this
  exact this

/--
Enables clean syntax when taking reciprocals of, or dividing by, products.
-/
instance mul_preserves_nonzero_inst
    {p q : ℚ} [AP (p ≄ 0)] [AP (q ≄ 0)] : AP (p * q ≄ 0)
    :=
  AP.mk (mul_preserves_nonzero ‹AP (p ≄ 0)›.ev ‹AP (q ≄ 0)›.ev)

/--
Taking the reciprocal of a product of rational numbers is equivalent to the
product of each of their reciprocals.

**Property intuition**: Reciprocals and products have independent effects on
fractions, so it makes sense that they can be done in any order.

**Proof intuition**: Follows from algebraic operations, mostly associativity
and the multiplicative identity and inverse properties.
-/
theorem recip_compat_mul
    {p q : ℚ} [AP (p ≄ 0)] [AP (q ≄ 0)] : (p * q)⁻¹ ≃ p⁻¹ * q⁻¹
    := by
  have inv_p : 1 ≃ p * p⁻¹ := eqv_symm mul_inverseR
  have inv_q : 1 ≃ q * q⁻¹ := eqv_symm mul_inverseR
  have swap_middle : (p * p⁻¹) * (q * q⁻¹) ≃ (p * q) * (p⁻¹ * q⁻¹) :=
    AA.expr_xxfxxff_lr_swap_rl
  calc
    (p * q)⁻¹                           ≃ _ := eqv_symm mul_identR
    (p * q)⁻¹ * 1                       ≃ _ := mul_substR (eqv_symm mul_identR)
    (p * q)⁻¹ * (1 * 1)                 ≃ _ := mul_substR (mul_substL inv_p)
    (p * q)⁻¹ * ((p * p⁻¹) * 1)         ≃ _ := mul_substR (mul_substR inv_q)
    (p * q)⁻¹ * ((p * p⁻¹) * (q * q⁻¹)) ≃ _ := mul_substR swap_middle
    (p * q)⁻¹ * ((p * q) * (p⁻¹ * q⁻¹)) ≃ _ := eqv_symm mul_assoc
    ((p * q)⁻¹ * (p * q)) * (p⁻¹ * q⁻¹) ≃ _ := mul_substL mul_inverseL
    1 * (p⁻¹ * q⁻¹)                     ≃ _ := mul_identL
    p⁻¹ * q⁻¹                           ≃ _ := eqv_refl

/--
Taking the reciprocal of a negated rational number is equivalent to negating
its reciprocal.

**Property intuition**: Reciprocals and negation have independent effects on
fractions, so it makes sense that they can be done in any order.

**Proof intuition**: Convert negation to multiplication by `-1`, then use the
result that reciprocals are compatible with multiplication.
-/
theorem recip_compat_neg {p : ℚ} [AP (p ≄ 0)] : (-p)⁻¹ ≃ -p⁻¹ := calc
  (-p)⁻¹       ≃ _ := recip_subst (eqv_symm mul_neg_one)
  (-1 * p)⁻¹   ≃ _ := recip_compat_mul
  (-1)⁻¹ * p⁻¹ ≃ _ := mul_substL recip_sqrt1
  (-1) * p⁻¹   ≃ _ := mul_neg_one
  (-p⁻¹)       ≃ _ := eqv_refl

/--
Negation can be moved between the "outside" of a division operation and the
"inside", specifically its left operand.

**Property and proof intuition**: The same property holds for multiplication,
and division is a form of multiplication.
-/
theorem neg_scompatL_div {p q : ℚ} [AP (q ≄ 0)] : -(p / q) ≃ (-p) / q := calc
  (-(p / q))   ≃ _ := neg_subst div_mul_recip
  (-(p * q⁻¹)) ≃ _ := neg_scompatL_mul
  (-p) * q⁻¹   ≃ _ := eqv_symm div_mul_recip
  (-p) / q     ≃ _ := eqv_refl

/--
Negation can be moved between the "outside" of a division operation and the
"inside", specifically its right operand.

**Property and proof intuition**: Division is the multiplication of the left
operand with the reciprocal of the right operand. Negation can be moved from
the "outside" to the "inside" of both reciprocation and multiplication.
-/
theorem neg_scompatR_div {p q : ℚ} [AP (q ≄ 0)] : -(p / q) ≃ p / (-q) := calc
  (-(p / q))   ≃ _ := neg_subst div_mul_recip
  (-(p * q⁻¹)) ≃ _ := neg_scompatR_mul
  p * -(q⁻¹)   ≃ _ := mul_substR (eqv_symm recip_compat_neg)
  p * (-q)⁻¹   ≃ _ := eqv_symm div_mul_recip
  p / (-q)     ≃ _ := eqv_refl

/--
A division operation where both operands are negated is equivalent to one where
neither operand is.

**Property intuition**: This is one of the basic properties of fractions from
school: negation on the top and bottom of a fraction can be canceled.

**Proof intuition**: Using semicompatibility of negation, move both negations
to the "outside" of the division, where they can be removed by the
double-negation property.
-/
theorem div_neg_cancel {p q : ℚ} [AP (q ≄ 0)] : (-p)/(-q) ≃ p / q := calc
  (-p)/(-q)     ≃ _ := eqv_symm neg_scompatL_div
  (-(p / -q))   ≃ _ := neg_subst (eqv_symm neg_scompatR_div)
  (-(-(p / q))) ≃ _ := neg_involutive
  p / q         ≃ _ := eqv_refl

/--
The sum of two fractions (division operations on converted integers) can be
written as a single fraction.

**Property intuition**: Since rational numbers are equivalent to fractions, we
know this must be the case.

**Proof intuition**: Expand division into multiplication by the reciprocal (we
do this only because we haven't proven many algebraic identities for division).
Introduce multiplicative inverse terms to generate a common reciprocal value
(i.e., denominator) and factor it out. Move the integer-to-rational conversions
to the outermost layer, then switch back into a fraction for the result.
-/
theorem add_div_integers
    {a b c d : ℤ} [Integer.Nonzero b] [Integer.Nonzero d]
    : (a : ℚ)/b + (c : ℚ)/d ≃ ((a * d + b * c : ℤ) : ℚ)/((b * d : ℤ) : ℚ)
    := by
  let aQ := (a : ℚ); let bQ := (b : ℚ); let cQ := (c : ℚ); let dQ := (d : ℚ)
  calc
    aQ/bQ + cQ/dQ
      ≃ _ := add_substL div_mul_recip
    aQ * bQ⁻¹ + cQ/dQ
      ≃ _ := add_substR div_mul_recip
    aQ * bQ⁻¹ + cQ * dQ⁻¹
      ≃ _ := add_substL (eqv_symm mul_identR)
    aQ * bQ⁻¹ * 1 + cQ * dQ⁻¹
      ≃ _ := add_substL (mul_substR (eqv_symm mul_inverseR))
    aQ * bQ⁻¹ * (dQ * dQ⁻¹) + cQ * dQ⁻¹
      ≃ _ := add_substL AA.expr_xxfxxff_lr_swap_rl
    aQ * dQ * (bQ⁻¹ * dQ⁻¹) + cQ * dQ⁻¹
      ≃ _ := add_substL (mul_substR (eqv_symm recip_compat_mul))
    aQ * dQ * (bQ * dQ)⁻¹ + cQ * dQ⁻¹
      ≃ _ := add_substR (eqv_symm mul_identR)
    aQ * dQ * (bQ * dQ)⁻¹ + cQ * dQ⁻¹ * 1
      ≃ _ := add_substR (mul_substR (eqv_symm mul_inverseL))
    aQ * dQ * (bQ * dQ)⁻¹ + cQ * dQ⁻¹ * (bQ⁻¹ * bQ)
      ≃ _ := add_substR AA.expr_xxfxxff_lr_swap_rr
    aQ * dQ * (bQ * dQ)⁻¹ + cQ * bQ * (bQ⁻¹ * dQ⁻¹)
      ≃ _ := add_substR (mul_substL mul_comm)
    aQ * dQ * (bQ * dQ)⁻¹ + bQ * cQ * (bQ⁻¹ * dQ⁻¹)
      ≃ _ := add_substR (mul_substR (eqv_symm recip_compat_mul))
    aQ * dQ * (bQ * dQ)⁻¹ + bQ * cQ * (bQ * dQ)⁻¹
      ≃ _ := eqv_symm mul_distribR
    (aQ * dQ + bQ * cQ) * (bQ * dQ)⁻¹
      ≃ _ := mul_substL (add_substL (eqv_symm mul_compat_from_integer))
    ((a * d : ℤ) + bQ * cQ) * (bQ * dQ)⁻¹
      ≃ _ := mul_substL (add_substR (eqv_symm mul_compat_from_integer))
    ((a * d : ℤ) + (b * c : ℤ)) * (bQ * dQ)⁻¹
      ≃ _ := mul_substL (eqv_symm add_compat_from_integer)
    (a * d + b * c : ℤ) * (bQ * dQ)⁻¹
      ≃ _ := mul_substR (recip_subst (eqv_symm mul_compat_from_integer))
    (a * d + b * c : ℤ) * ((b * d : ℤ) : ℚ)⁻¹
      ≃ _ := eqv_symm div_mul_recip
    ((a * d + b * c : ℤ) : ℚ)/((b * d : ℤ) : ℚ)
      ≃ _ := eqv_refl

/--
If two rational numbers have the same sign value, their sum will as well.

**Property intuition**: If we visualize rational numbers as arrows on a number
line, an arrow's length is its magnitude and its direction is its sign. Two
positive or two negative numbers will have their arrows pointing in the same
direction; adding them produces a longer arrow, again pointing in the same
direction.

**Proof intuition**: Convert both rational numbers to their fraction
representations. Their sum can be written as a single fraction, and its sign is
just the product of the signs of its numerator and denominator. This can be
rearranged algebraically into the sign of an integer sum, the operands of which
happen to share a sign. By the corresponding theorem for integers, the sum must
have that sign as well.
-/
theorem add_preserves_sign
    {s : ℤ} {p q : ℚ} : sgn p ≃ s → sgn q ≃ s → sgn (p + q) ≃ s
    := by
  intro (_ : sgn p ≃ s) (_ : sgn q ≃ s)
  show sgn (p + q) ≃ s
  have (AsRatio.intro (a : ℤ) (b : ℤ) (_ : Integer.Nonzero b) p_eqv) :=
    as_ratio p
  have (AsRatio.intro (c : ℤ) (d : ℤ) (_ : Integer.Nonzero d) q_eqv) :=
    as_ratio q
  have : p ≃ a/b := p_eqv
  have : q ≃ c/d := q_eqv
  have : Integer.Sqrt1 (sgn b) := Integer.sgn_nonzero.mp ‹Integer.Nonzero b›
  have : Integer.Sqrt1 (sgn d) := Integer.sgn_nonzero.mp ‹Integer.Nonzero d›
  have : sgn (a * b) ≃ s := calc
    sgn (a * b)     ≃ _ := Integer.sgn_compat_mul
    sgn a * sgn b   ≃ _ := Rel.symm sgn_div_integers
    sgn ((a : ℚ)/b) ≃ _ := sgn_subst (eqv_symm ‹p ≃ a/b›)
    sgn p           ≃ _ := ‹sgn p ≃ s›
    s               ≃ _ := Rel.refl
  have : sgn (c * d) ≃ s := calc
    sgn (c * d)     ≃ _ := Integer.sgn_compat_mul
    sgn c * sgn d   ≃ _ := Rel.symm sgn_div_integers
    sgn ((c : ℚ)/d) ≃ _ := sgn_subst (eqv_symm ‹q ≃ c/d›)
    sgn q           ≃ _ := ‹sgn q ≃ s›
    s               ≃ _ := Rel.refl
  have sgn_abdd : sgn (a * b * (d * d)) ≃ s := calc
    sgn (a * b * (d * d))     ≃ _ := Integer.sgn_compat_mul
    sgn (a * b) * sgn (d * d) ≃ _ := AA.substL ‹sgn (a * b) ≃ s›
    s * sgn (d * d)           ≃ _ := AA.substR Integer.sgn_compat_mul
    s * (sgn d * sgn d)       ≃ _ := AA.substR ‹Integer.Sqrt1 (sgn d)›.elim
    s * 1                     ≃ _ := AA.identR
    s                         ≃ _ := Rel.refl
  have sgn_bbcd : sgn (b * b * (c * d)) ≃ s := calc
    sgn (b * b * (c * d))     ≃ _ := Integer.sgn_compat_mul
    sgn (b * b) * sgn (c * d) ≃ _ := AA.substR ‹sgn (c * d) ≃ s›
    sgn (b * b) * s           ≃ _ := AA.substL Integer.sgn_compat_mul
    sgn b * sgn b * s         ≃ _ := AA.substL ‹Integer.Sqrt1 (sgn b)›.elim
    1 * s                     ≃ _ := AA.identL
    s                         ≃ _ := Rel.refl
  have : sgn (p + q) ≃ s := calc
    sgn (p + q)
      ≃ _ := sgn_subst (add_substL ‹p ≃ a/b›)
    sgn ((a : ℚ)/b + q)
      ≃ _ := sgn_subst (add_substR ‹q ≃ c/d›)
    sgn ((a : ℚ)/b + (c : ℚ)/d)
      ≃ _ := sgn_subst add_div_integers
    sgn (((a * d + b * c : ℤ) : ℚ)/((b * d : ℤ) : ℚ))
      ≃ _ := sgn_div_integers
    sgn (a * d + b * c) * sgn (b * d)
      ≃ _ := Rel.symm Integer.sgn_compat_mul
    sgn ((a * d + b * c) * (b * d))
      ≃ _ := Integer.sgn_subst AA.distribR
    sgn (a * d * (b * d) + b * c * (b * d))
      ≃ _ := Integer.sgn_subst (AA.substL AA.expr_xxfxxff_lr_swap_rl)
    sgn (a * b * (d * d) + b * c * (b * d))
      ≃ _ := Integer.sgn_subst (AA.substR AA.expr_xxfxxff_lr_swap_rl)
    sgn (a * b * (d * d) + b * b * (c * d))
      ≃ _ := Integer.add_preserves_sign sgn_abdd sgn_bbcd
    s
      ≃ _ := Rel.refl
  exact this

end Lean4Axiomatic.Rational


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.lattice

/-!
# Relations holding pairwise on finite sets

In this file we prove a few results about the interaction of `set.pairwise_disjoint` and `finset`.
-/

open finset

variables {α ι ι' : Type*}

lemma finset.pairwise_disjoint_range_singleton [decidable_eq α] :
  (set.range (singleton : α → finset α)).pairwise_disjoint id :=
begin
  rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ h,
  exact disjoint_singleton.2 (ne_of_apply_ne _ h),
end

namespace set

lemma pairwise_disjoint.elim_finset [decidable_eq α] {s : set ι} {f : ι → finset α}
  (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s) (a : α) (hai : a ∈ f i)
  (haj : a ∈ f j) :
  i = j :=
hs.elim hi hj (finset.not_disjoint_iff.2 ⟨a, hai, haj⟩)

variables [lattice α] [order_bot α]

/-- Bind operation for `set.pairwise_disjoint`. In a complete lattice, you can use
`set.pairwise_disjoint.bUnion`. -/
lemma pairwise_disjoint.bUnion_finset {s : set ι'} {g : ι' → finset ι} {f : ι → α}
  (hs : s.pairwise_disjoint (λ i' : ι', (g i').sup f))
  (hg : ∀ i ∈ s, (g i : set ι).pairwise_disjoint f) :
  (⋃ i ∈ s, ↑(g i)).pairwise_disjoint f :=
begin
  rintro a ha b hb hab,
  simp_rw set.mem_Union at ha hb,
  obtain ⟨c, hc, ha⟩ := ha,
  obtain ⟨d, hd, hb⟩ := hb,
  obtain hcd | hcd := eq_or_ne (g c) (g d),
  { exact hg d hd a (hcd ▸ ha) b hb hab },
  { exact (hs _ hc _ hd (ne_of_apply_ne _ hcd)).mono (finset.le_sup ha) (finset.le_sup hb) }
end

end set


import Analysis.Pre
import Analysis.Logic

def Set (α : Type u) := α → Prop

def setOf (p : α → Prop) : Set α := p

namespace Set

/-! ## Basic Definitions -/

def empty : Set α := λ x => False

instance : EmptyCollection (Set α) := ⟨empty⟩

variable {α : Type u} {s : Set α}

def mem (a : α) (s : Set α) := s a

instance : Mem α (Set α) := ⟨mem⟩

-- We note that the reverse direction is a bit more subtle and requires
-- the definition of images
instance [Coe β α] : Coe (Set α) (Set β) := ⟨λ S => λ x => (x : α) ∈ S⟩

instance : CoeSort (Set α) (Type u) where
  coe s := Subtype s

theorem ext {s t : Set α} (h : ∀ x, x ∈ s ↔ x ∈ t) : s = t :=
  funext <| λ x => propext <| h x

-- Declaring the index category
declare_syntax_cat index
syntax ident : index
syntax ident " : " term : index
syntax ident " ∈ " term : index

-- Notation for sets
syntax "{ " index " | " term " }" : term
-- syntax "{" term,* "}"  : term
-- syntax "%{" term,* "|" term "}" : term

macro_rules
| `({ $x:ident : $t | $p }) => `(setOf (λ ($x:ident : $t) => $p))
| `({ $x:ident | $p }) => `(setOf (λ ($x:ident) => $p))
| `({ $x:ident ∈ $s | $p }) => `(setOf (λ $x => $x ∈ $s ∧ $p))

def insert (s : Set α) (a : α) : Set α := setOf (λ x => x ∈ s ∨ x = a)

theorem insertMem (s : Set α) {a : α} (ha : a ∈ s) : s.insert a = s :=
  ext (λ x => Iff.intro (λ hx => match hx with
    | Or.inl hx => hx | Or.inr hx => hx ▸ ha) (λ hx => Or.inl hx))

-- Temporary notation for singletons
notation "{ " a " }" => insert ∅ a

theorem memSelfSingleton (a : α) : a ∈ { a } := Or.inr rfl

theorem memSingleton (a b : α) : b ∈ { a } ↔ b = a :=
  Iff.intro (λ hb => match hb with
    | Or.inl hb => False.elim hb | Or.inr hb => hb) (λ hb => Or.inr hb)

-- macro_rules
--   | `({ $elems,* }) => do
--     let rec expandListLit (i : Nat) (skip : Bool) (result : Syntax) : MacroM Syntax := do
--       match i, skip with
--       | 0,   _     => pure result
--       | i+1, true  => expandListLit i false result
--       | i+1, false => expandListLit i true  (← ``(Set.insert $(elems.elemsAndSeps[i]) $result))
--     if elems.elemsAndSeps.size < 64 then
--       expandListLit elems.elemsAndSeps.size false (← ``(Set.empty))
--     else
--       `(%{ $elems,* | Set.empty })

def union (s t : Set α) : Set α := { x : α | x ∈ s ∨ x ∈ t }

def inter (s t : Set α) : Set α := { x : α | x ∈ s ∧ x ∈ t }

theorem unionDef (s t : Set α) : union s t = λ x => s x ∨ t x := rfl

theorem interDef (s t : Set α) : inter s t = λ x => s x ∧ t x := rfl

infix:60 " ∪ " => Set.union
infix:60 " ∩ " => Set.inter

def Union {base} [h : Coe β (Set base)] (s : Set β) : Set base :=
  { x | ∃ t : β, t ∈ s ∧ (t : Set base) x }

def Inter {base} [h : Coe β (Set base)] (s : Set β) : Set base :=
  { x | ∀ t : β, t ∈ s → (t : Set base) x }

def UnionDef [h : Coe β (Set α)] (s : Set β) : Union s =
  λ x => ∃ t : β, t ∈ s ∧ (t : Set α) x := rfl

def InterDef [h : Coe β (Set α)] (s : Set β) : Inter s =
  λ x => ∀ t : β, t ∈ s → (t : Set α) x := rfl

syntax " ⋃ " index "," term : term
syntax " ⋂ " index "," term : term

macro_rules
| `(⋃ $s:ident ∈ $c, $s) => `(Union $c)
| `(⋂ $s:ident ∈ $c, $s) => `(Inter $c)
| `(⋃ $s:ident ∈ $c, $coe $s) => `(Union {h := coe} $c)
| `(⋂ $s:ident ∈ $c, $coe $s) => `(Inion {h := coe} $c)

-- Notation for ∀ x ∈ s, p and ∃ x ∈ s, p
syntax " ∀ " index "," term : term
syntax " ∃ " index "," term : term

macro_rules
| `(∀ $x:ident ∈ $s, $p) => `(∀ $x:ident, $x ∈ $s → $p)
| `(∃ $x:ident ∈ $s, $p) => `(∃ $x:ident, $x ∈ $s ∧ $p)

-- @[appUnexpander Set.setOf]
-- def setOf.unexpander : Lean.PrettyPrinter.Unexpander
-- | `(setOf (λ ($x:ident : $t) => $p)) => `({ $x | $p })
-- | _ => throw ()

-- #check { x | x = 1 }

def compl (s : Set α) := { x | x ∉ s }

postfix:100 "ᶜ " => compl

theorem compl.def (s : Set α) (x) : x ∈ sᶜ ↔ ¬ s x := Iff.rfl

def Subset (s t : Set α) := ∀ x ∈ s, x ∈ t

instance : LE (Set α) := ⟨Subset⟩

infix:50 " ⊆ " => Subset

theorem Subset.def {s t : Set α} : s ⊆ t ↔ ∀ x ∈ s, x ∈ t := Iff.rfl

namespace Subset

theorem refl {s : Set α} : s ⊆ s := λ _ hx => hx

theorem trans {s t v : Set α} (hst : s ⊆ t) (htv : t ⊆ v) : s ⊆ v :=
  λ x hx => htv _ (hst x hx)

theorem antisymm {s t : Set α} (hst : s ⊆ t) (hts : t ⊆ s) : s = t :=
  Set.ext λ x => ⟨ λ hx => hst x hx, λ hx => hts x hx ⟩

theorem antisymmIff {s t : Set α} : s = t ↔ s ⊆ t ∧ t ⊆ s :=
  ⟨ by { intro hst; subst hst; exact ⟨ refl, refl ⟩ },
    λ ⟨ hst, hts ⟩ => antisymm hst hts ⟩

-- ↓ Uses classical logic
theorem notSubset : ¬ s ⊆ t ↔ ∃ x ∈ s, x ∉ t := by
  apply Iff.intro
  { intro hst;
    rw [Classical.Exists.notAnd];
    apply Classical.notForall;
    exact λ h => hst λ x hx => h x hx }
  { intro h hst;
    let ⟨ x, ⟨ hxs, hxt ⟩ ⟩ := h;
    exact hxt <| hst x hxs }

end Subset

/-! ## Easy Lemmas-/

theorem memEmptySet {x : α} (h : x ∈ (∅ : Set α)) : False := h

@[simp] theorem memEmptySetIff : (∃ (x : α), x ∈ (∅ : Set α)) ↔ False :=
  Iff.intro (λ h => h.2) False.elim

@[simp] theorem setOfFalse : { a : α | False } = ∅ := rfl

def univ : Set α := { x | True }

@[simp] theorem memUniv (x : α) : x ∈ (univ : Set α) := True.intro

theorem Subset.empty (s : Set α) : ∅ ⊆ s := λ _ h => False.elim h

theorem Subset.subsetUniv {s : Set α} : s ⊆ univ := λ x _ => memUniv x

theorem Subset.univSubsetIff {s : Set α} : univ ⊆ s ↔ univ = s := by
  apply Iff.intro λ hs => Subset.antisymm hs Subset.subsetUniv
  { intro h; subst h; exact Subset.refl }

theorem Subset.singletonIff {s : Set α} : x ∈ s ↔ { x } ⊆ s :=
  Iff.intro
    (λ h y hy => match hy with
      | Or.inl hy => False.elim hy
      | Or.inr hy => hy ▸ h)
    (λ h => h _ <| memSelfSingleton _)

theorem eqUnivIff {s : Set α} : s = univ ↔ ∀ x, x ∈ s := by
  apply Iff.intro
  { intro h x; subst h; exact memUniv x }
  { exact λ h => ext λ x => Iff.intro (λ _ => memUniv _) λ _ => h x }

/-! ## Unions and Intersections -/

macro "extia" x:term : tactic => `(tactic| apply ext; intro $x; apply Iff.intro)

theorem unionSelf {s : Set α} : s ∪ s = s := by
  extia x
  { intro hx; cases hx; assumption; assumption }
  { exact Or.inl }

theorem interSelf {s : Set α} : s ∩ s = s := by
  extia x
  { intro h; exact h.1 }
  { intro h; exact ⟨ h, h ⟩}

theorem unionEmpty {s : Set α} : s ∪ ∅ = s := by
  extia x
  { intro hx; cases hx with
    | inl   => assumption
    | inr h => exact False.elim <| memEmptySet h }
  { exact Or.inl }

theorem unionSymm {s t : Set α} : s ∪ t = t ∪ s := by
  extia x
  allGoals { intro hx; cases hx with
             | inl hx => exact Or.inr hx
             | inr hx => exact Or.inl hx }

theorem emptyunion {s : Set α} : ∅ ∪ s = s := by
  rw [unionSymm]; exact unionEmpty

theorem unionAssoc {s t w : Set α} : (s ∪ t) ∪ w = s ∪ (t ∪ w) := by
  extia x
  { intro hx; cases hx with
    | inr hx   => exact Or.inr <| Or.inr hx
    | inl hx   => cases hx with
      | inr hx => exact Or.inr <| Or.inl hx
      | inl hx => exact Or.inl hx }
  { intro hx; cases hx with
    | inl hx   => exact Or.inl <| Or.inl hx
    | inr hx   => cases hx with
      | inr hx => exact Or.inr hx
      | inl hx => exact Or.inl <| Or.inr hx }

theorem subsetInter {s t u : Set α} (ht : s ⊆ t) (hu : s ⊆ u) : s ⊆ t ∩ u :=
λ x hx => ⟨ ht x hx, hu x hx ⟩

theorem UnionEmpty : Union (base := α) (∅ : Set (Set α)) = ∅ :=
  ext (λ x => Iff.intro (λ ⟨_, h⟩ => False.elim h.1) (λ h => False.elim h))

end Set


import basic
import exp
import coeff
import explicit
open polynomial

#check hermite_coeff_odd_zero

lemma hermite_eval_even (n : ℕ) (x : ℝ) (h : even n) :
eval (-x) (hermite n) = eval x (hermite n) :=
begin

end

-- lemma hermite_eval_even (n : ℕ) (x : ℝ) :
-- eval (-x) (hermite n) = if (even n) then eval x (hermite n) else -(eval x (hermite n)) :=
-- begin
--   induction n with n ih,
--   { sorry },
--   { sorry }
-- end

example (p : polynomial ℝ) (x : ℝ) : eval x p = eval x p :=
begin
  refl,
end

example (n : ℕ) (x : ℝ) : eval x (hermite n) = eval x (hermite n) :=
begin
  refl,
end

example (p : polynomial ℝ) (h : ∀ n, odd n → coeff p n = 0) (x : ℝ) : eval (-x) p = eval x p :=
begin
  sorry
end


import game.max.level06 -- hide

open_locale classical -- hide

noncomputable theory -- hide

namespace xena -- hide

/-
# Chapter 4 : Max and abs

## Level 7

`max_lt` and `max_lt_iff` are equally useful. Let's knock them off
using the same techniques.
-/

/- Lemma
If $a$, $b$, $c$ are real numbers with $a<c$ and $b<c$,
then $\max(a,b)<c.$
-/
theorem max_lt {a b c : ℝ} (hac : a < c) (hbc : b < c) : max a b < c :=
begin
  cases max_choice a b with ha hb,
  rw ha,
  exact hac,
  rw hb,
  exact hbc,

end

end xena --hide