/-
Written by Congzhou M Sha (cms6712@psu.edu)

Copyright 2022 Congzhou M Sha

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

-/
import data.real.basic
import tactic
import analysis.normed.group.basic
import algebra.order.absolute_value
import algebra.order.group
import algebra.group_power.basic
import data.nat.choose.basic
import data.nat.choose.sum
import algebra.big_operators.basic
import analysis.calculus.fderiv
import analysis.special_functions.pow
import analysis.calculus.cont_diff
import data.num.lemmas

open polynomial nat finset filter asymptotics set metric
open_locale topological_space big_operators
namespace power_rule

  @[simp] def x_to_n : (ℕ → (ℝ → ℝ))
  | 0 := λ (x : ℝ), (1 : ℝ)
  | (n + 1) := λ (x : ℝ), x ^ (n + 1)
  @[simp] def x_to_n' : (ℕ → (ℝ → ℝ))
  | 0 := λ (x : ℝ), (0 : ℝ)
  | (n + 1) := λ (x : ℝ), (n + 1 : ℝ) * x ^ n

  theorem geometric_series_no_division (x : ℝ) (n : ℕ) :
    finset.sum (range n) (λ k, (x-1) * x ^ (k : ℝ)) = x ^ n - 1 :=
  begin
    apply sum_range_induction,
    simp,
    intro m,
    simp,
    ring_nf,
  end

  lemma mul_sum_left_distrib (f : ℝ → ℝ → ℝ) (g : ℕ → ℝ) (x : ℝ) (y : ℝ) (n : ℕ) :
    (f x y) * (range n).sum g = (range n).sum (λ k, (f x y) * (g k)) :=
  begin
    induction n with n h,
    { simp, },
    {
      rw finset.sum_range_succ,
      rw left_distrib,
      dsimp,
      rw h,
      rw finset.sum_range_succ,
    }
  end

  lemma unfold_last_term : ∀ (x y : ℝ) (n : ℕ) (f : ℕ → ℝ),
    (n > 0) → (range n).sum f = (range (n - 1)).sum (λ k, f k) + f (n-1) :=
  begin
    intros x y n f p,
    induction n with n ih,
    { simp, linarith,},
    {
      rw range_succ,
      simp,
      ring,
    },
  end

  lemma unfold_first_term : ∀ (x y : ℝ) (n : ℕ) (f : ℕ → ℝ),
    (n > 0) → (range n).sum f = f 0 + (range (n-1)).sum (λ k, f (k + 1)) :=
  begin
    intros x y n f p,
    induction n with n ih,
    { simp, linarith, },
    {
      induction n with n₁ ih₁,
      { norm_num, },
      {
        rw range_succ,
        simp,
        have q : n₁.succ > 0, by simp,
        have r := ih q,
        rw r,
        clear ih ih₁ p,
        have s := (unfold_last_term x y n₁.succ f) q,
        rename_var x k,
        simp,
        rw range_succ,
        simp,
        rw nat.succ_eq_add_one,
        linarith,
      },
    }
  end

  theorem x_to_n_sub_y_to_n_factor (x y : ℝ) (n : ℕ) : x^n-y^n = (x-y) * (range n).sum (λ k, x ^ (n - 1 - k) * y ^ k) := begin
    rw finset.mul_sum,
    induction n with n ih,
    { simp, },
    {
      rw [pow_succ, pow_succ, finset.sum_range_succ],
      simp,
      rw [mul_sub_right_distrib, ← add_sub_assoc, sub_left_inj],
      rw sub_eq_iff_eq_add at ih,
      rw [ih, left_distrib, finset.mul_sum, add_left_inj, finset.sum_congr rfl],
      intros k p,
      rw [← mul_assoc, ← mul_assoc, mul_comm, mul_comm x (x-y),
        mul_assoc (x-y) x (x ^ (n - 1 - k)), ← pow_succ],

      have q : n - 1 - k + 1 = n - k, begin
        rw nat.sub.right_comm,
        rw finset.mem_range at p,
        have q₁ : 0 < n - k, begin
          exact nat.sub_pos_of_lt p,
        end,
        have q₂ : 1 ≤ n - k, by linarith,
        rw nat.sub_add_cancel q₂,
      end,

      rw q,
      ring_nf,
    }
  end

  lemma pos_mul_ge_one_ge_one (a b : ℝ) (h₁ : a ≥ 1) (h₂ : b > 0) : (a * b ≥ b) := begin
    nlinarith,
  end

  lemma weaken_le (a b c : ℝ) (h : a ≤ b ∧ 0 < c) : (a ≤ b + c) :=
  begin
    have h₁ := h.1,
    have h₂ := h.2,
    nlinarith,
  end

  lemma deriv_power_ineq_helper_1 (x y : ℝ) (n k : ℕ)
  (h : -1 < y - x ∧ y - x < 1)
  (p : k ≤ n) :
  |x| ^ k ≤ (|x| + 1) ^ k :=
  begin
    have v₁ : |x| ≤ |x| + 1,
      begin
        have w₁ := le_abs_self x,
        linarith,
      end,
      induction k with k ih,
      {
        simp,
      },
      {
        have : k ≤ n, begin
          rw succ_eq_add_one at p,
          linarith,
        end,
        rw [pow_succ, pow_succ],
        have w₁ := le_abs_self x,
        have w₂ := ih this,
        have w₃ : |x| + 1 ≥ 1 :=
        begin
          have := abs_nonneg x,
          linarith,
        end,
        rw [right_distrib, one_mul],
        have w₄ : 0 < (|x| + 1), by nlinarith,
        have w₅ := pow_pos w₄,
        apply weaken_le,
        split,
        {
          nlinarith,
        },
        {
          specialize w₅ k,
          exact w₅,
        },
      },
  end

  lemma deriv_power_ineq_helper_2
    (x y : ℝ) (n k : ℕ)
    (h : -1 < y - x ∧ y - x < 1)
    (p : k ≤ n) : |y| ^ (n - k) ≤ (|x| + 1) ^ (n - k) :=
  begin
    have h₁ := h.1,
    have h₂ := h.2,
    clear h,
    have h₃ : |y| < |x| + 1,
    begin
      have q := le_abs_self x,
      rw abs_lt,
      split,
      {
        rw [neg_eq_zero_sub, sub_add_eq_sub_sub, sub_lt_iff_lt_add,
          ← neg_eq_zero_sub, neg_lt, lt_abs],
        right,
        linarith,
      },
      {
        linarith,
      },
    end,
    induction (n-k) with n ih,
    { simp, },
    {
      rw [pow_succ, pow_succ],
      have w₁ := le_abs_self x,
      have w₂ := ih,
      have w₃ : |x| + 1 ≥ 1 :=
      begin
        have := abs_nonneg x,
        linarith,
      end,
      have w₄ : |y| ≤ |x| + 1, by linarith,
      have w₅ := abs_nonneg y,
      have w₆ : 0 < |x| + 1, by linarith,
      have w₇ := pow_pos w₆,
      have w₈ := pow_nonneg w₅,
      specialize w₈ n,
      replace w₆ : 0 ≤ |x| + 1, by linarith,
      exact mul_le_mul w₄ ih w₈ w₆,
    },
  end

  lemma deriv_power_ineq'
    (x y : ℝ) (n k : ℕ)
    (h : -1 < y - x ∧ y - x < 1)
    (p : k ≤ n) :
    |y ^ (n - k) * x ^ k| ≤ (|x| + 1) ^ n :=
  begin
    have u₁ := deriv_power_ineq_helper_1 x y n k h p,
    have u₂ := deriv_power_ineq_helper_2 x y n k h p,
    rw abs_mul,
    repeat {rw abs_pow},
    have u₃ := pow_nonneg (abs_nonneg y),
    have u₄ : 0 ≤ (|x| + 1), begin
      have := abs_nonneg x,
      linarith,
    end,
    specialize u₃ (n-k),
    replace u₄ := pow_nonneg u₄,
    specialize u₄ k,
    have q := mul_le_mul u₁ u₂ u₃ u₄,
    rw ← pow_add at q,
    rw ← nat.add_sub_assoc at q,
    rw (nat.add_sub_cancel_left k n) at q,
    rw mul_comm,
    exact q,
    exact p,
  end

  lemma sum_cons_simp (x y : ℝ) (n : ℕ) : ∑ (x_1 : ℕ) in range (n + 1), (|x| + 1) ^ n = (n + 1) * (|x| + 1) ^ n :=
  begin
    simp,
  end

  lemma sum_one_plus_abs_pos (x : ℝ) (n : ℕ) :  ∀ i ∈ range (n+1), 0 < (|x| + 1) ^ n :=
  begin
    intros i p,
    have := abs_nonneg x,
    have h₁ : 0 < |x| + 1, by linarith,
    have h₂ := pow_pos h₁,
    specialize h₂ n,
    exact h₂,
  end

    lemma sum_one_plus_abs_nonneg (x : ℝ) (n : ℕ) : ∀ i ∈ range (n + 1), 0 ≤ (|x| + 1) ^ n :=
  begin
    intros i p,
    have := abs_nonneg x,
    have h₁ : 0 ≤ |x| + 1, by linarith,
    have h₂ := pow_nonneg h₁,
    specialize h₂ n,
    exact h₂,
  end
  lemma sum_power_bound_constant (x : ℝ) (n : ℕ) : ∑ (x_1 : ℕ) in range (n + 1), (|x| + 1) ^ n = (n+1) * (|x| + 1) ^ n :=
  begin
    simp,
  end

  lemma one_plus_abs_pos (x : ℝ) : 0 < 1 + |x| := begin
    have := abs_nonneg x,
    linarith,
  end

  lemma one_plus_abs_nonneg (x : ℝ) : 0 ≤ 1 + |x| := begin
    have := abs_nonneg x,
    linarith,
  end

  lemma one_plus_abs_pow_pos (x : ℝ) : ∀ (n:ℕ), 0 < (1 + |x|) ^ n := pow_pos (one_plus_abs_pos x)

  lemma one_plus_abs_pow_nonneg (x : ℝ) (n : ℕ) : 0 ≤ (1 + |x|) ^ n :=
  begin
    have := one_plus_abs_pow_pos x n,
    linarith,
  end

  lemma bound_xy_y (x y : ℝ) (r : |y - x| < 1) : |y| < 1 + |x| := begin
    have := abs_abs_sub_abs_le_abs_sub y x,
    have : | |y| - |x| | < 1, by linarith,
    rw abs_lt at this,
    linarith,
  end

  lemma bound_x (x : ℝ) : |x| ≤ 1 + |x| := begin linarith, end

  lemma bound_x_pow_one (x : ℝ) (n : ℕ) : 1 ≤ (1 + |x|) ^ n :=
  begin
    induction n with n ih,
    { simp, },
    {
      rw pow_succ,
      have a := abs_nonneg x,
      have b : 1 ≤ 1 + |x|, by linarith,
      have c : (0 : ℝ) ≤ 1, by norm_num,
      have := mul_le_mul b ih c (one_plus_abs_nonneg x),
      rw one_mul at this,
      exact this,
    },
  end

  lemma bound_x_pow (x : ℝ) (n : ℕ) : |x| ^ n ≤ (1 + |x|) ^ n :=
  begin
    induction n with n ih,
    {
      have := bound_x x,
      linarith,
    },
    {
      rw [pow_succ, pow_succ],
      have a := one_plus_abs_pos x,
      have b := one_plus_abs_pow_pos x n,
      have := abs_nonneg x,
      have f := pow_nonneg this,
      specialize f n,
      have e : 0 ≤ (1 + |x|) ^ n, by linarith,
      have c : |x| ≤ |x|, by linarith,
      have d : |x| ≤ 1 + |x|, by linarith,
      have : 0 ≤ 1 + |x|, by linarith,
      exact mul_le_mul d ih f this,
    },
  end

  lemma pow_abs_nonneg (x : ℝ) (n : ℕ) : 0 ≤ (|x|) ^ n :=
  begin
    have := abs_nonneg x,
    have := pow_nonneg this,
    specialize this n,
    exact this,
  end

  lemma power_abs_y_bound (x y : ℝ) (q : |y| ≤ 1 + |x|) (k : ℕ) : |y| ^ k ≤ (1 + |x|) ^ k :=
  begin
    induction k with k ih,
    { simp, },
    {
      rw [pow_succ, pow_succ],
      have a := pow_abs_nonneg y k,
      have := abs_nonneg x,
      have b : 0 ≤ 1 + |x|, by linarith,
      exact mul_le_mul q ih a b,
    },
  end

  lemma power_abs_x_bound (x y : ℝ) (k : ℕ)  : |x| ^ k ≤ (1 + |x|) ^ k :=
  begin
    induction k with k ih,
    { simp, },
    {
      rw [pow_succ, pow_succ],
      have a := pow_abs_nonneg x k,
      have := abs_nonneg x,
      have f : 0 ≤ 1 + |x|, by linarith,
      have b := bound_x x,
      exact mul_le_mul b ih a f,
    },
  end

  lemma function_bound (x y : ℝ) (q : |y| ≤ 1 + |x|) (n : ℕ):
    ∀ (x_1 : ℕ), x_1 ∈ range (n + 1) → |y ^ (n - x_1) * x ^ x_1| ≤ |(1+|x|) ^ n| :=
  begin
    intros k p,
    rw abs_mul,
    repeat {rw abs_pow},
    have a : ∀ (k : ℕ), |y| ^ k ≤ (1 + |x|) ^ k :=
    begin
      intro k,
      clear p,
      induction k with k ih,
      { simp, },
      {
        rw [pow_succ, pow_succ],
        have a := pow_abs_nonneg y k,
        have := abs_nonneg x,
        have b : 0 ≤ 1 + |x|, by linarith,
        exact mul_le_mul q ih a b,
      },
    end,
    specialize a (n-k),

    have b := bound_x x,
    have c : ∀ (k : ℕ), |x| ^ k ≤ (1 + |x|) ^ k :=
    begin
      intro k,
      clear p,
      induction k with k ih,
      { simp, },
      {
        rw [pow_succ, pow_succ],
        have a := pow_abs_nonneg x k,
        have := abs_nonneg x,
        have f : 0 ≤ 1 + |x|, by linarith,
        exact mul_le_mul b ih a f,
      },
    end,
    specialize c k,

    have := abs_nonneg x,
    have q : 0 ≤ 1 + |x|, by linarith,
    have := pow_nonneg q,
    specialize this (n - k),

    have d := mul_le_mul a c (pow_abs_nonneg x k) this,
    rw finset.mem_range_succ_iff at p,
    rw pow_sub_mul_pow (1 + |x|) p at d,
    rw ← abs_of_nonneg q at d,
    exact d,
  end

  lemma sum_ineq (x y c : ℝ) (h : |y| ≤ 1 + |x|) (n : ℕ) :
    |∑ (x_1 : ℕ) in range (n + 1), y ^ (n - x_1) * x ^ x_1|
    ≤ |∑ (x_1 : ℕ) in range (n + 1), (1 + |x|) ^ n| :=
  begin
    have q₁ := bound_x x,
    have q₂ := finset.abs_sum_le_sum_abs (λ x_1, y ^ (n - x_1) * x ^ x_1) (range (n + 1)),
    simp at q₂,
    have q₃ := function_bound x y h n,
    have q₄ := finset.sum_le_sum q₃,
    simp at q₄,
    simp,
    have := one_plus_abs_pow_pos x n,
    have a : 0 ≤ (1 + |x|) ^ n, by linarith,
    have : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,
    have : (0 : ℝ) ≤ ↑n + 1, by linarith,
    have : 0 ≤ (↑n + 1) * (1 + |x|) ^ n := mul_nonneg this a,
    rw abs_of_nonneg this,
    clear this this this,
    rw ← abs_of_pos (one_plus_abs_pos x),
    linarith,
  end

  lemma power_limit_denom_pos (x : ℝ) (n : ℕ) :
    0 < ((↑n + 2) * (↑n + 1) * (1 + |x|) ^ n) :=
  begin
    have a : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,
    have b : (0 : ℝ) < 2, by norm_num,
    have c := add_pos_of_nonneg_of_pos a b,
    have b : (0 : ℝ) < 1, by norm_num,
    have d := add_pos_of_nonneg_of_pos a b,
    have e := one_plus_abs_pow_pos x n,
    have := mul_pos c (mul_pos d e),
    rw ← mul_assoc at this,
    exact this,
  end

  lemma power_limit_div_pos (x : ℝ) (n : ℕ) (c : ℝ) (r : 0 < c) :
    0 < c / ((↑n + 2) * (↑n + 1) * (1 + |x|) ^ n) :=
  begin
    have a := power_limit_denom_pos x n,
    exact div_pos r a,
  end

  lemma ineq_1 (x : ℝ) (n : ℕ) : |(x ^ n * ↑n + x ^ n)| ≤ |2 * (↑n+2) * (1+|x|)^(n+1)| := begin
    have := one_plus_abs_pow_pos x (n + 1),
    have := le_abs_self x,

    have a : 1*|x ^ n| ≤ (↑n + 2) * (1 + |x|) ^ (n + 1) := begin
      have a := bound_x_pow x n,
      have f : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,
      have : (0 : ℝ) < (1 : ℝ), by norm_num,
      have b: (0 : ℝ) ≤ ↑n + 1, by linarith,
      have g : (1 : ℝ) ≤ ↑n + 2, by linarith,
      have h : (0 : ℝ) ≤ ↑n + 2, by linarith,
      have := abs_nonneg x,
      have i := pow_nonneg this,
      specialize i n,
      have c : 1 ≤ 1 + |x|, by linarith,
      have d : 0 ≤ 1 + |x|, by linarith,
      have e := mul_le_mul c a (pow_abs_nonneg x n) d,
      simp at e,
      rw ← pow_succ at e,
      rw ← pow_abs,
      exact mul_le_mul g e i h,
    end,
    have b : (|x| ^ n * ↑n) ≤ (n + 2) * (1 + |x|) ^ (n+1) := begin
      rw mul_comm,
      have a := bound_x_pow x n,
      have b : ↑n ≤ ↑n + (1 : ℝ), by linarith,
      refine mul_le_mul _ _ _ _,
      linarith,
      have := abs_nonneg x,
      have c : 1 ≤ 1 + |x|, by linarith,
      have d : 0 ≤ 1 + |x|, by linarith,
      have e := mul_le_mul c a (pow_abs_nonneg x n) d,
      rw one_mul at e,
      rw pow_succ,
      exact e,
      exact pow_abs_nonneg x n,
      have f := nat.cast_nonneg n,
      have g : (0 : ℝ) ≤ 1, by norm_num,
      have : (0 : ℝ) ≤ 2, by linarith,
      have := add_le_add f this,
      linarith,
    end,

    rw one_mul at a,
    have c : (↑n + (1:ℝ) ≤ ↑n + 2), by linarith,
    have d := one_plus_abs_pow_pos x (n + 1),
    replace d : 0 ≤ (1 + |x|) ^ (n + 1), by linarith,
    have e := abs_add (x ^ n * ↑n) (x ^ n),
    have g := one_plus_abs_pow_pos x (n + 1),
    have g' : 0 ≤ (1 + |x|) ^ (n+1), by linarith,
    have f : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,
    have h : (0 : ℝ) ≤ ↑n + 2, by linarith,
    have j : (0 : ℝ) ≤ 2, by norm_num,
    have i := mul_nonneg h g',
    replace j := mul_nonneg j i,
    rw ← mul_assoc at j,
    rw abs_of_nonneg j,
    have : (2 : ℝ) = 1 + 1, by norm_num,
    rw [this, right_distrib, one_mul, ← this, right_distrib],
    rw ← abs_pow at b,
    rw ← abs_of_nonneg f at b,
    rw ← abs_mul at b,
    rw abs_of_nonneg f at *,
    linarith,
  end

  lemma expr_nonneg (x y : ℝ) (n : ℕ) (h : 0 < |y-x|): 0 ≤ |y - x| * ((↑n + 3) * (↑n + 2) * (1 + |x|) ^ (n + 1)) :=
  begin
    have p₂ := one_plus_abs_pow_pos x (n + 1),
    have p₃ : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,
    have p₄ : (0 : ℝ) < ↑n + 2, by linarith,
    have p₅ : (0 : ℝ) < ↑n + 3, by linarith,
    have p₆ := mul_pos p₅ p₄,
    have p₇ := mul_pos p₆ p₂,
    have p₈ := mul_pos h p₇,
    linarith,
  end

  lemma one_plus_abs_mono_inc (x : ℝ) (n : ℕ) : (1 + |x|) ^ n ≤ (1 + |x|) ^ (n + 1) :=
  begin
    induction n with n ih,
    { simp, },
    {
      rw pow_succ,
      rw pow_succ,
      have a : 1 + |x| ≤ 1 + |x|, by linarith,
      refine mul_le_mul _ _ _ _,
      exact a,
      exact ih,
      have := one_plus_abs_pow_pos x n,
      linarith,
      have := one_plus_abs_pos x,
      linarith,
    },
  end

  lemma one_plus_abs_mono_inc_pair (x : ℝ) (m n : ℕ) : (1 + |x|) ^ m ≤ (1 + |x|) ^ (m + n) :=
  begin
    induction m with m ih,
    { simp, exact bound_x_pow_one x n, },
    {
      rw [pow_succ, nat.succ_add, pow_succ],
      have : 1 + |x| ≤ 1 + |x|, by linarith,
      exact mul_le_mul this ih (one_plus_abs_pow_nonneg x m) (one_plus_abs_nonneg x),
    }
  end

  lemma one_plus_abs_mono_inc_le (x : ℝ) (m n : ℕ) (h : m ≤ n) : (1 + |x|) ^ m ≤ (1 + |x|) ^ n :=
  begin
    have a := one_plus_abs_mono_inc_pair x m (n - m),
    rw nat.add_sub_of_le h at a,
    assumption,
  end

  lemma expr_lt (x : ℝ) (n : ℕ) : (↑n + 1) * (1 + |x|) ^ n ≤ (↑n + 2) * (1 + |x|) ^ (n + 1) :=
  begin
    have a := one_plus_abs_mono_inc x n,
    have a' := one_plus_abs_pow_nonneg x n,
    have b : 1 ≤ 2, by norm_num,
    have c : (↑n + (1:ℝ)) ≤ (↑n + (2 : ℝ)), by linarith,
    have c' : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,

    refine mul_le_mul _ _ _ _,
    repeat {linarith},
  end

  lemma ineq_1_pos (x : ℝ) (n : ℕ) : 0 < (↑n + 1) * (1 + |x|) ^ n :=
  begin
    have a' := one_plus_abs_pow_pos x n,
    have c' : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,
    have c : (0:ℝ) < ↑n + 1, by linarith,
    exact mul_pos c a',
  end

  lemma ineq_2_pos (x : ℝ) (n : ℕ) : 0 < 2 * (↑n + 2) * (1 + |x|) ^ (n + 1) :=
  begin
    have a' := one_plus_abs_pow_pos x (n+1),
    have c' : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,
    have c : (0:ℝ) < ↑n + 2, by linarith,
    have d := mul_pos c a',
    have : (0:ℝ) < 2, by norm_num,
    have := mul_pos this d,
    linarith,
  end

  lemma ineq_3 (x : ℝ) (n : ℕ) : 3 * (↑n + 2) * (1 + |x|) ^ (n + 1) ≤ (↑n + 3) * (↑n + 2) * (1 + |x|) ^ (n + 1) :=
  begin
    have a : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,
    have a' : (0 : ℝ) ≤ ↑n + 2, by linarith,
    have a'' : (0 : ℝ) ≤ ↑n + 3, by linarith,
    have a₁ : (3 : ℝ) ≤ ↑n + 3, by linarith,
    have a₂ : (↑n + (2 : ℝ)) ≤ ↑n + 2, by linarith,
    have b := one_plus_abs_pow_nonneg x (n + 1),
    refine mul_le_mul _ _ _ _,
    repeat {linarith},
    refine mul_le_mul _ _ _ _,
    repeat {linarith},
    refine mul_nonneg _ _,
    repeat {linarith},
  end

  lemma individual_to_sum (x : ℝ) (n : ℕ) : x ^ n * ↑n + x ^ n = ∑ (x_1 : ℕ) in range (n+1), x ^ n :=
  begin
    simp,
    rw right_distrib,
    rw one_mul,
    rw mul_comm,
  end
  lemma sub_sum_eq_sum_sub (x : ℝ) (n : ℕ) (f : ℕ → ℝ) (g : ℕ → ℝ) :
  ∑ (x_1 : ℕ) in range n, (f x_1 - g x_1) = (∑ (x_1 : ℕ) in range n, f x_1) - (∑ (x_1 : ℕ) in range n, g x_1) :=
  begin
    simp,
  end

  lemma factor_out (x y : ℝ) (n : ℕ) :
    ∑ (x_1 : ℕ) in range (n + 1), (y ^ (n - x_1) * x ^ x_1 - x ^ n) =
    ∑ (x_1 : ℕ) in range (n + 1), x ^ x_1 * (y ^ (n - x_1) - x ^ (n - x_1)) :=
  begin
    apply finset.sum_congr rfl,
    intros k p,
    rw finset.mem_range at p,
    have : k ≤ n, by linarith,
    rw mul_sub_left_distrib,
    rw mul_comm,
    rw pow_mul_pow_sub x this,
  end

  lemma rw_inner_expr (x y : ℝ) (n : ℕ) :
    ∑ (x_1 : ℕ) in range (n + 1), x ^ x_1 * (y ^ (n - x_1) - x ^ (n - x_1)) =
    ∑ (x_1 : ℕ) in range (n + 1), x ^ x_1 * (y - x) * ∑ (x_2 : ℕ) in range (n - x_1), y ^ (n - x_1 - 1 - x_2) * x ^ x_2 :=
  begin
    apply finset.sum_congr rfl,
    intros k p,
    rw mul_assoc,
    rw x_to_n_sub_y_to_n_factor y x (n - k),
  end

  lemma ineq_inner_sum (x y : ℝ) (n : ℕ) (h : |y| ≤ 1 + |x|):
    |∑ (k : ℕ) in range (n + 1), y ^ (n - k) * x ^ k| ≤ (n + 1) * (1 + |x|) ^ n :=
  begin
    have a := sum_ineq x y n h n,
    simp at a,
    have b := one_plus_abs_pow_nonneg x n,
    have : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,
    have c : (0 : ℝ) ≤ ↑n + 1, by linarith,
    have d := mul_nonneg c b,
    have := abs_of_nonneg d,
    rw this at a,
    assumption,
  end

  lemma function_bound_2 (x y : ℝ) (n : ℕ) : ∀ (i : ℕ), i ∈ range (n + 1) →
    |x ^ i * (y - x) * ∑ (x_2 : ℕ) in range (n - i), y ^ (n - i - 1 - x_2) * x ^ x_2|
    ≤ |x ^ i * (y - x)| * |∑ (x_2 : ℕ) in range (n - i), y ^ (n - i - 1 - x_2) * x ^ x_2| :=
  begin
    intros i p,
    rw abs_mul,
  end

  lemma coe_nat_ineq (n i : ℕ) (h : i < n) : ↑(n - i - 1) + (1 : ℝ) = ↑(n-i) :=
  begin
    have : n ≥ i + 1, by linarith,
    have : n - i ≥ 1 := le_tsub_of_add_le_left this,
    have : 1 ≤ n - i, by linarith,
    rw nat.cast_sub this,
    simp,
  end

  lemma weird_nat_ineq_1 (n i : ℕ) : n - i - 1 ≤ n - i := nat.sub_le (n - i) 1
  /-
  lemma function_bound_2_5 (x : ℝ) (n i : ℕ) :
    ∑ (x_2 : ℕ) in range (n - i), |(1 + |x|) ^ (n - i - 1 - x_2) * (1 + |x|) ^ x_2|
    = ∑ (x_2 : ℕ) in range (n - i), (1 + |x|) ^ (n - i - 1) :=
  begin
    rw finset.sum_congr rfl,
    intros k p,
    rw finset.mem_range at p,

    have a := weird_nat_ineq_1 n i,

    rw ← abs_of_pos (one_plus_abs_pow_pos x (n - i - 1)),
    rw ← pow_add,
    rw nat.sub_add_cancel this,
  end
  -/

  lemma function_bound_3_pos (x y : ℝ) (n i : ℕ) : 0 ≤ ↑(n - i) * (1 + |x|) ^ (n - i - 1) :=
  begin
    have a : (0 : ℝ) ≤ ↑(n - i) := nat.cast_nonneg (n - i),
    have b := one_plus_abs_pow_nonneg x (n - i - 1),
    exact mul_nonneg a b,
  end

  lemma function_bound_3 (x y : ℝ) (n i : ℕ) (h : |y| ≤ 1 + |x|) : ∀ (k : ℕ), k ∈ range(n - i) →
    |y ^ (n - i - 1 - k) * x ^ k|
    ≤ (1 + |x|) ^ (n - i - 1) :=
  begin
    intros k p,
    rw finset.mem_range at p,
    have p := le_pred_of_lt p,
    rw ← abs_of_pos (one_plus_abs_pow_pos x (n - i - 1)),
    rw abs_mul,
    repeat {rw abs_pow},
    have a := power_abs_x_bound x y k,
    have b := power_abs_y_bound x y h (n - i - 1 - k),

    have := abs_nonneg x,
    have q : 0 ≤ 1 + |x|, by linarith,
    have q₁ := pow_nonneg q (n - i - 1 - k),
    have q₂ := pow_nonneg this k,

    have d := mul_le_mul b a q₂ q₁,
    rw pow_sub_mul_pow (1 + |x|) p at d,
    rw ← abs_of_nonneg q at d,
    exact d,
  end

  @[simp] lemma rw_abs_sum (x : ℝ) (n : ℕ) :
    ∑ (i : ℕ) in range (n + 1), |x| ^ i * |↑(n - i) * (1 + |x|) ^ (n - i - 1)|
    = ∑ (i : ℕ) in range (n + 1), |x| ^ i * (↑(n - i) * (1 + |x|) ^ (n - i - 1)) :=
  begin
    rw finset.sum_congr rfl,
    intros i p,
    have a := one_plus_abs_pow_nonneg x (n - i - 1),
    have b : (0 : ℝ) ≤ ↑(n - i) := nat.cast_nonneg (n - i),
    have c := mul_nonneg b a,
    rw ← abs_of_nonneg c,
    rw abs_abs,
  end

  lemma rw_abs_sum_2 (x y : ℝ) (n : ℕ ) :
    ∑ (i : ℕ) in range (n + 1), |x| ^ i * (↑(n - i) * (1 + |x|) ^ (n - i - 1))
    = ∑ (x_1 : ℕ) in range (n + 1), |x| ^ x_1 * ((↑n - ↑x_1) * (1 + |x|) ^ (n - x_1 - 1)) :=
  begin
    rw finset.sum_congr rfl,
    intros i p,
    rw finset.mem_range at p,
    have : i ≤ n, by linarith,
    rw nat.cast_sub this,
  end

  lemma ineq_5 (x y : ℝ) (n : ℕ) (h : |y| ≤ 1 + |x|): ∑ (i : ℕ) in range (n + 1), |x ^ i| * |∑ (x_2 : ℕ) in range (n - i), y ^ (n - i - 1 - x_2) * x ^ x_2| ≤
  ∑ (i : ℕ) in range (n + 1), |x ^ i| * |∑ (x_2 : ℕ) in range (n - i), (1 + |x|) ^ (n - i - 1)| :=
  begin
    refine finset.sum_le_sum _,
    intros i p,
    rw finset.mem_range at p,
    refine mul_le_mul _ _ _ _,
    { linarith, },
    {
      simp,
      have a := finset.abs_sum_le_sum_abs (λ x_2, y ^ (n - i - 1 - x_2) * x ^ x_2) (range (n - i)),
      rw abs_of_nonneg (function_bound_3_pos x y n i),

      have b := function_bound_3 x y n i h,
      have c := finset.sum_le_sum b,
      simp at c,
      rename_var x_1 i_1,
      linarith,
    },
    {
      exact abs_nonneg (∑ (x_2 : ℕ) in range (n - i), y ^ (n - i - 1 - x_2) * x ^ x_2),
    },
    {
      exact abs_nonneg (x ^ i),
    },
  end

  lemma rw_inner_sum (x y : ℝ) (n : ℕ) : ∑ (i : ℕ) in range (n + 1),
  |x ^ i * ∑ (x_2 : ℕ) in range (n - i),
    y ^ (n - i - 1 - x_2) * x ^ x_2|
      = ∑ (x_1 : ℕ) in range (n + 1),
        |x ^ x_1| * |∑ (x_2 : ℕ) in range (n - x_1),
          y ^ (n - x_1 - 1 - x_2) * x ^ x_2| :=
  begin
    rw finset.sum_congr rfl,
    intros k p,
    rw finset.mem_range at p,
    rw abs_mul,
  end

  lemma ineq_6 (x y : ℝ) (n : ℕ) (h : |y| ≤ 1 + |x|) :
    |y - x| * ∑ (i : ℕ) in range (n + 1), |x ^ i| * |∑ (x_2 : ℕ) in range (n - i), y ^ (n - i - 1 - x_2) * x ^ x_2|
      ≤ |y - x| * ∑ (i : ℕ) in range (n + 1), |x ^ i| * ((n - i) * (1 + |x|) ^ (n - i - 1)) :=
  begin
    have d := eq_zero_or_ne_zero (|y-x|),
    cases d,
    { rw d, simp, },
    {
      have : 0 < |y-x| :=
      begin
        have := abs_nonneg (y-x),
        by_contra,
        apply d.out,
        linarith,
      end,

      have h := ineq_5 x y n h,
      simp at h,
      simp,
      refine mul_le_mul _ _ _ _,
      { linarith, },
      {
        rw ← rw_abs_sum_2 x y n,
        linarith,
      },
      {
        have a := rw_inner_sum x y n,
        simp at a,
        rw ← a,
        have := finset.abs_sum_le_sum_abs (λ i, x ^ i * ∑ (x_2 : ℕ) in range (n - i), y ^ (n - i - 1 - x_2) * x ^ x_2) (range (n + 1)),
        simp at this,
        have := abs_nonneg (∑ (i : ℕ) in range (n + 1), x ^ i * ∑ (x_2 : ℕ) in range (n - i), y ^ (n - i - 1 - x_2) * x ^ x_2),
        linarith,
      },
      {
        exact abs_nonneg (y - x),
      },
    },
  end

  lemma sum_abs_pos (f : ℕ → ℝ) (n : ℕ) :
    0 ≤ ∑ (i : ℕ) in range n, |f i| :=
  begin
    induction n with n ih,
    simp,
    rw finset.sum_range_succ,
    have := abs_nonneg (f n),
    linarith,
  end

  lemma abs_pow_nonneg (x : ℝ) (n : ℕ) : 0 ≤ |x| ^ n :=
  begin
    exact pow_nonneg (abs_nonneg x) n,
  end

  lemma function_bound_4_1 (x y : ℝ) (n : ℕ) (h : |y| ≤ 1 + |x|) : ∀ (i : ℕ), i ∈ range (n + 1) →
  |x ^ i * (y - x) * ∑ (x_2 : ℕ) in range (n - i), y ^ (n - i - 1 - x_2) * x ^ x_2| ≤ |(1 + |x|) ^ i| * |y - x| * ((n - i) * (1 + |x|) ^ (n - i - 1)) :=
  begin
    intros i p,
    repeat {rw abs_mul},
    repeat {rw abs_pow},
    have := one_plus_abs_nonneg x,
    have a := power_abs_x_bound x y i,
    have b : |y-x| ≤ |y-x|, by linarith,
    have c := finset.abs_sum_le_sum_abs (λ x_2, y ^ (n - i - 1 - x_2) * x ^ x_2) (range (n - i)),
    rw finset.mem_range at p,
    have : i ≤ n, by linarith,
    rw ← nat.cast_sub this,
    have c' := abs_of_nonneg (function_bound_3_pos x y n i),
    have d := function_bound_3 x y n i h,
    have e := finset.sum_le_sum d,
    simp at e,
    have := mul_le_mul b e (sum_abs_pos (λ i_1, y ^ (n - i - 1 - i_1) * x ^ i_1) (n-i)) (abs_nonneg (y-x)),
    have := mul_le_mul a this (mul_nonneg (abs_nonneg (y - x)) (sum_abs_pos (λ i_1, y ^ (n - i - 1 - i_1) * x ^ i_1) (n-i))) (one_plus_abs_pow_nonneg x i),
    repeat {rw ← mul_assoc},
    repeat {rw ← mul_assoc at this},
    rw abs_of_nonneg (one_plus_abs_nonneg x),
    have f : |x| ^ i ≤ |x| ^ i, by linarith,
    have := mul_le_mul b c (abs_nonneg ∑ (i_1 : ℕ) in range (n - i), y ^ (n - i - 1 - i_1) * x ^ i_1) (abs_nonneg (y-x)),
    have := mul_le_mul f this (mul_nonneg (abs_nonneg (y - x)) (abs_nonneg ∑ (i_1 : ℕ) in range (n - i), y ^ (n - i - 1 - i_1) * x ^ i_1)) (abs_pow_nonneg x i),
    simp at *,
    repeat {rw ← mul_assoc at this},
    linarith,
  end

  lemma function_bound_4 (x y : ℝ) (n : ℕ) (h : |y| ≤ 1 + |x|) :
  ∑ (i : ℕ) in range (n + 1), |x ^ i * (y - x) * ∑ (x_2 : ℕ) in range (n - i), y ^ (n - i - 1 - x_2) * x ^ x_2| ≤
  ∑ (i : ℕ) in range (n + 1), |(1 + |x|) ^ i| * |y - x| * ((n - i) * (1 + |x|) ^ (n - i - 1)) :=
  begin
    have a := function_bound_4_1 x y n h,
    have b := finset.sum_le_sum a,
    assumption,
  end

  lemma ineq_constants (x y : ℝ) (n : ℕ) : ∀ (i : ℕ), i ∈ range (n + 1) →
    (λ i, |(1 + |x|) ^ i| * |y - x| * ((↑n - ↑i) * (1 + |x|) ^ (n - i - 1))) i ≤ (λ i, |y - x| * (↑n + 1) * (1 + |x|) ^ n) i :=
  begin
    intros i p,
    dsimp,
    rw finset.mem_range at p,
    have q : i ≤ n, by linarith,
    rw abs_of_nonneg (one_plus_abs_pow_nonneg x i),
    rw [mul_comm ((1 + |x|) ^ i), ← mul_assoc],
    have := nat.sub.right_comm n i 1,
    have := weird_nat_ineq_1 n i,
    rw [mul_comm, ← mul_assoc, ← mul_assoc,
      mul_comm ((1 + |x|) ^ (n - i - 1)),
      mul_assoc (|y-x|), ← pow_add (1 + |x|) (n - i - 1) i,
      mul_assoc, mul_comm ((1 + |x|) ^ (n - i - 1 + i)), ← mul_assoc],
    have : n - i - 1 + i ≤ n, by linarith,
    have a := one_plus_abs_mono_inc_le x (n - i - 1 + i) n this,
    have : (0 : ℝ) ≤ i := nat.cast_nonneg i,
    have a' : (↑n - ↑i : ℝ) ≤ ↑n + 1, by linarith,
    have : (0 : ℝ) ≤ n := nat.cast_nonneg n,
    have : (0 : ℝ) ≤ n + 1, by linarith,
    have b := mul_le_mul a' a (one_plus_abs_pow_nonneg x (n - i - 1 + i)) this,
    have c := abs_nonneg (y-x),
    have d: |y-x| ≤ |y-x|, by linarith,
    rw [mul_assoc, mul_assoc],
    refine mul_le_mul d b _ _,
    {
      have a: (0 : ℝ) ≤ ↑(n - i) := nat.cast_nonneg (n - i),
      have := nat.cast_sub q,
      rw ← this,
      exact mul_nonneg a (one_plus_abs_pow_nonneg x (n - i - 1 + i)),
    },
    {
      exact abs_nonneg (y - x),
    },
  end

  lemma final (x y c : ℝ) (n : ℕ) (h₁ : 0 < c) (d : 0 < |y - x|) (h₂ : |y - x| < c / ((↑n + 2) * (↑n + 1) * (1 + |x|) ^ n)) :
    (↑n + 1) * (|y - x| * (↑n + 1) * (1 + |x|) ^ n) ≤ c :=
  begin
    have h₁' : 0 ≤ c, by linarith,
    have h₂' : |y - x| ≤ c / ((↑n + 2) * (↑n + 1) * (1 + |x|) ^ n), by linarith,
    have p := power_limit_denom_pos x n,
    have p' : 0 ≤ (↑n + 2) * (↑n + 1) * (1 + |x|) ^ n, by linarith,
    have : |y - x| ≤ c / ((↑n + 2) * (↑n + 1) * (1 + |x|) ^ n) ↔ |y - x| * ((↑n + 2) * (↑n + 1) * (1 + |x|) ^ n) ≤ c :=
    begin
      exact le_div_iff p,
    end,
    replace h₂' := this.mp h₂',
    rw [← mul_assoc, ← mul_assoc] at h₂',
    rw [← mul_assoc, ← mul_assoc, mul_comm (↑n + 1) (|y-x|)],
    have : (0 : ℝ) ≤ ↑n := nat.cast_nonneg n,
    have c : ↑n + (1 : ℝ) ≤ ↑n + 2, by linarith,
    have a' : 0 ≤ (↑n +(1 : ℝ)), by linarith,
    have a'' := one_plus_abs_pow_nonneg x n,
    have a''' := mul_nonneg a' a'',
    have b' : (0 : ℝ) ≤ ↑n + (2:ℝ), by linarith,

    have a : (↑n + (1 : ℝ)) * (1 + |x|) ^ n ≤ (↑n + (1 : ℝ)) * (1 + |x|) ^ n, by linarith,
    have b := mul_le_mul c a a''' b',
    have d': |y - x| ≤ |y - x|, by linarith,
    have d'' : (0 : ℝ) ≤ ↑n + 1, by linarith,
    have d''' := mul_nonneg d'' a''',
    have d := mul_le_mul d' b d''' (abs_nonneg (y-x)),
    linarith,
  end

  lemma ineq_inner_sum_2 (x : ℝ) (n : ℕ) ⦃c : ℝ⦄ (y : ℝ)
  (r : 0 < c)
  (p₁ : |y - x| < 1)
  (p₂ : |y - x| < c / ((↑n + 2) * (↑n + 1) * (1 + |x|) ^ n))
  (d : 0 < |y - x|) :
  |∑ (x_1 : ℕ) in
        range (n + 1),
        x ^ x_1 * (y - x) *
          ∑ (x_2 : ℕ) in
            range (n - x_1),
            y ^ (n - x_1 - 1 - x_2) * x ^ x_2| ≤
    c :=
  begin
    have h₁' := bound_xy_y x y p₁,
    replace h₁' : |y| ≤ 1 + |x|, by linarith,
    have a := function_bound_4 x y n h₁',
    have b := finset.sum_le_sum (ineq_constants x y n),
    have c' := finset.abs_sum_le_sum_abs (λ x_1, x ^ x_1 * (y - x) * ∑ (x_2 : ℕ) in range (n - x_1), y ^ (n - x_1 - 1 - x_2) * x ^ x_2) (range (n + 1)),

    simp at a,
    simp at b,
    simp at c',

    have d' : |∑ (x_1 : ℕ) in range (n + 1), x ^ x_1 * (y - x) * ∑ (x_2 : ℕ) in range (n - x_1), y ^ (n - x_1 - 1 - x_2) * x ^ x_2| ≤
      (↑n + 1) * (|y - x| * (↑n + 1) * (1 + |x|) ^ n), by linarith,
    have e := final x y c n r d p₂,
    linarith,
  end

  lemma inequality_chasing_deriv_of_power (x : ℝ) (n : ℕ) ⦃c : ℝ⦄ (y : ℝ)
  (r : 0 < c)
  (p : dist y x < min 1 (c / (((n+2) * (n+1) * (1 + |x|) ^ n)))) :
  |(y - x) * ∑ (x_1 : ℕ) in range (n + 1), y ^ (n - x_1) * x ^ x_1 +
        (x - y) * (x ^ n * ↑n + x ^ n)| ≤
    c * |y - x| :=
  begin
    unfold dist at p,
    rw lt_min_iff at p,
    have p₁ := p.1,
    have p₂ := p.2,
    clear p,
    rw ← neg_sub y x,
    rw neg_mul,
    rw ← sub_eq_add_neg ((y - x) * ∑ (x_1 : ℕ) in range (n + 1), y ^ (n - x_1) * x ^ x_1) ((y - x) * (x ^ n * ↑n + x ^ n)),
    rw ← mul_sub_left_distrib,
    rw abs_mul,
    rw mul_comm,

    have := bound_xy_y x y p₁,
    have : |y| ≤ 1 + |x|, by linarith,
    have a := sum_ineq x y c this n,
    clear this this,
    simp at a,
    have d := eq_zero_or_ne_zero (|y-x|),
    cases d,
    {
      repeat {rw d},
      rw [mul_zero, mul_zero],
    },
    {
      have := abs_nonneg (y-x),
      replace d := d.out,
      replace d : 0 < |y-x| := begin
        by_contra,
        apply d,
        linarith,
      end,
      rw zero_lt.mul_le_mul_right d,
      rw individual_to_sum x n,
      have b := sub_sum_eq_sum_sub x (n + 1) (λ (x_1 : ℕ), y ^ (n - x_1) * x ^ x_1) (λ (x_1 : ℕ), x ^ n),
      dsimp at b,
      rw ← b,
      clear b,
      have g := bound_xy_y x y p₁,
      have : |y| ≤ 1 + |x|, by linarith,
      have f := function_bound x y this n,
      clear g this,
      rw factor_out x y n,
      rw rw_inner_expr x y n,
      exact ineq_inner_sum_2 x n y r p₁ p₂ d,
    },
  end

  theorem deriv_of_power : ∀ (n : ℕ), ∀ (x : ℝ), has_deriv_at (x_to_n n) (x_to_n' n x) x :=
  begin
    intros n x,
    rw has_deriv_at,
    rw has_deriv_at_filter,
    rw has_fderiv_at_filter,
    dsimp,
    induction n with n ih,
    { simp, },
    {
      clear ih,
      induction n with n ih,
      { simp, },
      {
        rw [x_to_n, x_to_n'],
        dsimp,
        ring_nf,
        refine asymptotics.is_o_iff.mpr _,
        intros c r,
        refine eventually_nhds_iff_ball.mpr _,
        unfold ball,
        simp,
        use min 1 (c / ((n.succ+2) * (n.succ+1) * (1 + |x|) ^ n.succ)),
        split,
        {
          rw lt_min_iff,
          split,
          { norm_num, },
          {
            exact power_limit_div_pos x n.succ c r,
          }
        },
        {
          intros y p,
          rw [← add_assoc, tactic.ring.add_neg_eq_sub, x_to_n_sub_y_to_n_factor y x (n.succ+1)],
          rw [← tactic.ring.add_neg_eq_sub (-(x ^ n.succ * (↑n+1))), ← neg_add, neg_mul,
            mul_comm (x ^ (n.succ) * (↑n+1) + x ^ n.succ), ← neg_mul,
            mul_comm (x ^ n.succ * (↑n+1) + x ^ n.succ) x],
          rw [add_comm (-y * (x ^ n.succ * (↑n+1) + x ^ n.succ)), neg_mul, tactic.ring.add_neg_eq_sub,
            ← mul_sub_right_distrib],
          have q := abs_add ((y - x) * ∑ (x_1 : ℕ) in range (n + 1), y ^ (n - x_1) * x ^ x_1) ((x - y) * (x ^ n * ↑n + x ^ n)),
          simp,
          have := inequality_chasing_deriv_of_power x n.succ y r p,
          simp at this,
          linarith,
        }
      }
    }

  end
end power_rule


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic

/-

# Finite sets

Remember that mathematicians use "set" in two different ways. There is
the generic "collection of stuff" usage, as in "A group is a set equipped with
a multiplication and satisfying these axioms...", for which Lean uses types.
And there's the concept of a *subset*, so we have the collection of stuff
already and want to consider the elements which have some other properties,
for example the subset {1,2,3,4,...,37} of the natural numbers, or the
subset of prime numbers or even numbers or whatever.

Someone on the Discord asked if I would do something about "finite sets",
and because there are two uses of the idea of a set in mathematics, the
first question on my mind is "which kind of finite set?". It seems to me
that the student is interested in finite *subsets* of the naturals and
the reals, so let's talk first about finite subsets.

## Two ways to do finite subsets of a type `X`

### First way: a subset of `X`, which is finite

Let `X` be a type. We've already seen the type `set X` of subsets of `X`,
so one way to let `S` be a finite subset of `X` would be to make a term
`S : set X` and then to have a hypothesis that `S` is finite.
In Lean the predicate which says a set is finite is `set.finite`. So here
is one way of saying "let `S` be a finite subset of `X`":

-/

example (X : Type) (S : set X) (T : set X)
  (hs : set.finite S) (ht : T.finite) : (S ∪ T).finite :=
begin
  -- you cannot hope to prove this from first principles unless you really know
  -- what you're doing! How are you going to find out the name of this lemma?
  sorry
end

/-

But Lean has another way.

### Second way: the type of all finite subsets of X

Lean has a dedicated type whose terms are finite subsets of `X`. It's called `finset X`.

Clearly, for a general infinite type `X`, `set X` and `finset X` are not "the same".
In type theory, *distinct types are disjoint*. That means if we have a term `S : finset X`
then *`S` does not have type `set X`*. A finset is not *equal to* a set. This is the
same phenomenon which says that a natural number in Lean is not *equal to* a real number.
There is a *map* from the natural numbers to the real numbers, and it's a map which
mathematicians don't notice and so it's called a *coercion* and is represented by a little
up-arrow. The same is true here.

If `S : finset X` then you can coerce `S` to `set X`, and this coerced term will be
displayed as `↑S` in Lean, with this arrow meaning "the obvious map from `finset X` to `set X`".

-/

-- let X be a type
variable (X : Type)

example (S : finset X) : (S : set X) = (S : set X) :=
begin
  -- ⊢ ↑S = ↑S
  refl,
end

-- Lean has the theorem that if you start with a finset, then the coerced set is finite.
example (S : finset X) : set.finite (↑S : set X) :=
begin
  exact set.to_finite S,
end

/-

# Why?

Finite sets are really important in computer science, and they also play a special role in
mathematics: for example you can sum over a finite set in huge generality, whereas if you
want to sum over a general set then you need some metric or topology on the target to make
sense of the notion of convergence. Also finite sets can be handled in constructive mathematics
and the theory is much easier to make computable than a general theory of sets. I'm not
particularly interested in making mathematics more constructive and computable, but other
people are, and this is why we've ended up with a dedicated type for finite sets.

Let's see how to do finite sums in Lean. In mathematics we often sum from 1 to n, but
computer scientists seem to prefer to sum from 0 to n-1. The finset `{0,1,2,...,n-1} : finset ℕ`
has got a name; it's called `finset.range n`. Let's see it in action by proving that
the sum of i^2 from i=0 to n-1 is (some random cubic with 6 in the denominator).

-/

open_locale big_operators -- enable ∑ notation

example : ∑ i in finset.range 10, i = 45 :=
begin
  refl, -- the advantage of constructive finiteness is that Lean knows a complete list of
  -- the numbers in `finset.range 10` so `refl` works.
end

example (n : ℕ) : ∑ i in finset.range n,
  (i : ℚ)^2 = n * (n - 1) * (2 * n - 1) / 6 :=
begin
  induction n with d hd,
  { -- base case n = 0 will follow by rewriting lemmas such as `∑ i in finset.range 0 f(i) = 0`
    -- and `0 * x = 0` etc, and the simplifier knows all these things.
    simp, },
  { -- inductive step
    -- We're summing to `finset.range succ(d)`, and so we next use the lemma saying
    -- that equals the sum over `finset.range d`, plus the last term.
    rw finset.sum_range_succ,
    -- Now we have a sum over finset.range d, which we know the answer to by induction
    rw hd,
    -- Now tidy up (e.g. replace all the `succ d` with `d + 1`)
    simp,
    -- and now it must be an identity in algebra.
    ring,
  }
end

-- If you look through the proof you'll see some ↑; this is because we can't do the
-- algebra calculation in the naturals because subtraction and division are involved,
-- and the definitions of subtraction and division on the naturals in Lean are *pathological*
-- (for example 4 - 5 = 0 and 5 / 2 = 2, because they have to return naturals, so they have to
-- return the wrong answer). So we coerce everything to the rationals first, and then the
-- problem goes away.

-- See if you can can sum the first n cubes.
example (n : ℕ) : ∑ i in finset.range n, (i : ℚ)^3 = n^2 * (n - 1)^2 / 4 :=
begin
  sorry
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.set.lattice
import logic.relation

/-!
# Relations holding pairwise

This file defines pairwise relations and pairwise disjoint indexed sets.

## Main declarations

* `pairwise`: `pairwise r` states that `r i j` for all `i ≠ j`.
* `set.pairwise`: `s.pairwise r` states that `r i j` for all `i ≠ j` with `i, j ∈ s`.
* `set.pairwise_disjoint`: `s.pairwise_disjoint f` states that images under `f` of distinct elements
  of `s` are either equal or `disjoint`.

## Notes

The spelling `s.pairwise_disjoint id` is preferred over `s.pairwise disjoint` to permit dot notation
on `set.pairwise_disjoint`, even though the latter unfolds to something nicer.
-/

open set function

variables {α β γ ι ι' : Type*} {r p q : α → α → Prop}

section pairwise
variables {f g : ι → α} {s t u : set α} {a b : α}

/-- A relation `r` holds pairwise if `r i j` for all `i ≠ j`. -/
def pairwise (r : α → α → Prop) := ∀ i j, i ≠ j → r i j

lemma pairwise.mono (hr : pairwise r) (h : ∀ ⦃i j⦄, r i j → p i j) : pairwise p :=
λ i j hij, h $ hr i j hij

lemma pairwise_on_bool (hr : symmetric r) {a b : α} : pairwise (r on (λ c, cond c a b)) ↔ r a b :=
by simpa [pairwise, function.on_fun] using @hr a b

lemma pairwise_disjoint_on_bool [semilattice_inf α] [order_bot α] {a b : α} :
  pairwise (disjoint on (λ c, cond c a b)) ↔ disjoint a b :=
pairwise_on_bool disjoint.symm

lemma symmetric.pairwise_on [linear_order ι] (hr : symmetric r) (f : ι → α) :
  pairwise (r on f) ↔ ∀ m n, m < n → r (f m) (f n) :=
⟨λ h m n hmn, h m n hmn.ne, λ h m n hmn, begin
  obtain hmn' | hmn' := hmn.lt_or_lt,
  { exact h _ _ hmn' },
  { exact hr (h _ _ hmn') }
end⟩

lemma pairwise_disjoint_on [semilattice_inf α] [order_bot α] [linear_order ι] (f : ι → α) :
  pairwise (disjoint on f) ↔ ∀ m n, m < n → disjoint (f m) (f n) :=
symmetric.pairwise_on disjoint.symm f

lemma pairwise_disjoint.mono [semilattice_inf α] [order_bot α]
  (hs : pairwise (disjoint on f)) (h : g ≤ f) : pairwise (disjoint on g) :=
hs.mono (λ i j hij, disjoint.mono (h i) (h j) hij)

lemma function.injective_iff_pairwise_ne : injective f ↔ pairwise ((≠) on f) :=
forall₂_congr $ λ i j, not_imp_not.symm

alias function.injective_iff_pairwise_ne ↔ function.injective.pairwise_ne _

namespace set

/-- The relation `r` holds pairwise on the set `s` if `r x y` for all *distinct* `x y ∈ s`. -/
protected def pairwise (s : set α) (r : α → α → Prop) := ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x ≠ y → r x y

lemma pairwise_of_forall (s : set α) (r : α → α → Prop) (h : ∀ a b, r a b) : s.pairwise r :=
λ a _ b _ _, h a b

lemma pairwise.imp_on (h : s.pairwise r) (hrp : s.pairwise (λ ⦃a b : α⦄, r a b → p a b)) :
  s.pairwise p :=
λ a ha b hb hab, hrp ha hb hab $ h ha hb hab

lemma pairwise.imp (h : s.pairwise r) (hpq : ∀ ⦃a b : α⦄, r a b → p a b) : s.pairwise p :=
h.imp_on $ pairwise_of_forall s _ hpq

lemma pairwise.mono (h : t ⊆ s) (hs : s.pairwise r) : t.pairwise r :=
λ x xt y yt, hs (h xt) (h yt)

lemma pairwise.mono' (H : r ≤ p) (hr : s.pairwise r) : s.pairwise p := hr.imp H

protected lemma pairwise.eq (hs : s.pairwise r) (ha : a ∈ s) (hb : b ∈ s) (h : ¬ r a b) : a = b :=
of_not_not $ λ hab, h $ hs ha hb hab

lemma pairwise_top (s : set α) : s.pairwise ⊤ := pairwise_of_forall s _ (λ a b, trivial)

protected lemma subsingleton.pairwise (h : s.subsingleton) (r : α → α → Prop) :
  s.pairwise r :=
λ x hx y hy hne, (hne (h hx hy)).elim

@[simp] lemma pairwise_empty (r : α → α → Prop) : (∅ : set α).pairwise r :=
subsingleton_empty.pairwise r

@[simp] lemma pairwise_singleton (a : α) (r : α → α → Prop) : set.pairwise {a} r :=
subsingleton_singleton.pairwise r

lemma pairwise_iff_of_refl [is_refl α r] : s.pairwise r ↔ ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → r a b :=
forall₄_congr $ λ a _ b _, or_iff_not_imp_left.symm.trans $ or_iff_right_of_imp of_eq

alias pairwise_iff_of_refl ↔ set.pairwise.of_refl _

lemma _root_.reflexive.set_pairwise_iff (hr : reflexive r) :
  s.pairwise r ↔ ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → r a b :=
forall₄_congr $ λ a _ b _, or_iff_not_imp_left.symm.trans $ or_iff_right_of_imp $ eq.rec $ hr a

lemma nonempty.pairwise_iff_exists_forall [is_equiv α r] {s : set ι} (hs : s.nonempty) :
  (s.pairwise (r on f)) ↔ ∃ z, ∀ x ∈ s, r (f x) z :=
begin
  fsplit,
  { rcases hs with ⟨y, hy⟩,
    refine λ H, ⟨f y, λ x hx, _⟩,
    rcases eq_or_ne x y with rfl|hne,
    { apply is_refl.refl },
    { exact H hx hy hne } },
  { rintro ⟨z, hz⟩ x hx y hy hne,
    exact @is_trans.trans α r _ (f x) z (f y) (hz _ hx) (is_symm.symm _ _ $ hz _ hy) }
end

/-- For a nonempty set `s`, a function `f` takes pairwise equal values on `s` if and only if
for some `z` in the codomain, `f` takes value `z` on all `x ∈ s`. See also
`set.pairwise_eq_iff_exists_eq` for a version that assumes `[nonempty ι]` instead of
`set.nonempty s`. -/
lemma nonempty.pairwise_eq_iff_exists_eq {s : set α} (hs : s.nonempty) {f : α → ι} :
  (s.pairwise (λ x y, f x = f y)) ↔ ∃ z, ∀ x ∈ s, f x = z :=
hs.pairwise_iff_exists_forall

lemma pairwise_iff_exists_forall [nonempty ι] (s : set α) (f : α → ι) {r : ι → ι → Prop}
  [is_equiv ι r] :
  (s.pairwise (r on f)) ↔ ∃ z, ∀ x ∈ s, r (f x) z :=
begin
  rcases s.eq_empty_or_nonempty with rfl|hne,
  { simp },
  { exact hne.pairwise_iff_exists_forall }
end

/-- A function `f : α → ι` with nonempty codomain takes pairwise equal values on a set `s` if and
only if for some `z` in the codomain, `f` takes value `z` on all `x ∈ s`. See also
`set.nonempty.pairwise_eq_iff_exists_eq` for a version that assumes `set.nonempty s` instead of
`[nonempty ι]`. -/
lemma pairwise_eq_iff_exists_eq [nonempty ι] (s : set α) (f : α → ι) :
  (s.pairwise (λ x y, f x = f y)) ↔ ∃ z, ∀ x ∈ s, f x = z :=
pairwise_iff_exists_forall s f

lemma pairwise_union :
  (s ∪ t).pairwise r ↔
    s.pairwise r ∧ t.pairwise r ∧ ∀ (a ∈ s) (b ∈ t), a ≠ b → r a b ∧ r b a :=
begin
  simp only [set.pairwise, mem_union_eq, or_imp_distrib, forall_and_distrib],
  exact ⟨λ H, ⟨H.1.1, H.2.2, H.2.1, λ x hx y hy hne, H.1.2 y hy x hx hne.symm⟩,
    λ H, ⟨⟨H.1, λ x hx y hy hne, H.2.2.2 y hy x hx hne.symm⟩, H.2.2.1, H.2.1⟩⟩
end

lemma pairwise_union_of_symmetric (hr : symmetric r) :
  (s ∪ t).pairwise r ↔
    s.pairwise r ∧ t.pairwise r ∧ ∀ (a ∈ s) (b ∈ t), a ≠ b → r a b :=
pairwise_union.trans $ by simp only [hr.iff, and_self]

lemma pairwise_insert :
  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, a ≠ b → r a b ∧ r b a :=
by simp only [insert_eq, pairwise_union, pairwise_singleton, true_and,
  mem_singleton_iff, forall_eq]

lemma pairwise.insert (hs : s.pairwise r) (h : ∀ b ∈ s, a ≠ b → r a b ∧ r b a) :
  (insert a s).pairwise r :=
pairwise_insert.2 ⟨hs, h⟩

lemma pairwise_insert_of_symmetric (hr : symmetric r) :
  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, a ≠ b → r a b :=
by simp only [pairwise_insert, hr.iff a, and_self]

lemma pairwise.insert_of_symmetric (hs : s.pairwise r) (hr : symmetric r)
  (h : ∀ b ∈ s, a ≠ b → r a b) :
  (insert a s).pairwise r :=
(pairwise_insert_of_symmetric hr).2 ⟨hs, h⟩

lemma pairwise_pair : set.pairwise {a, b} r ↔ (a ≠ b → r a b ∧ r b a) :=
by simp [pairwise_insert]

lemma pairwise_pair_of_symmetric (hr : symmetric r) : set.pairwise {a, b} r ↔ (a ≠ b → r a b) :=
by simp [pairwise_insert_of_symmetric hr]

lemma pairwise_univ : (univ : set α).pairwise r ↔ pairwise r :=
by simp only [set.pairwise, pairwise, mem_univ, forall_const]

@[simp] lemma pairwise_bot_iff : s.pairwise (⊥ : α → α → Prop) ↔ (s : set α).subsingleton :=
⟨λ h a ha b hb, h.eq ha hb id, λ h, h.pairwise _⟩

alias pairwise_bot_iff ↔ set.pairwise.subsingleton _

lemma pairwise.on_injective (hs : s.pairwise r) (hf : function.injective f)
  (hfs : ∀ x, f x ∈ s) :
  pairwise (r on f) :=
λ i j hij, hs (hfs i) (hfs j) (hf.ne hij)

lemma inj_on.pairwise_image {s : set ι} (h : s.inj_on f) :
  (f '' s).pairwise r ↔ s.pairwise (r on f) :=
by simp [h.eq_iff, set.pairwise] {contextual := tt}

lemma pairwise_Union {f : ι → set α} (h : directed (⊆) f) :
  (⋃ n, f n).pairwise r ↔ ∀ n, (f n).pairwise r :=
begin
  split,
  { assume H n,
    exact pairwise.mono (subset_Union _ _) H },
  { assume H i hi j hj hij,
    rcases mem_Union.1 hi with ⟨m, hm⟩,
    rcases mem_Union.1 hj with ⟨n, hn⟩,
    rcases h m n with ⟨p, mp, np⟩,
    exact H p (mp hm) (np hn) hij }
end

lemma pairwise_sUnion {r : α → α → Prop} {s : set (set α)} (h : directed_on (⊆) s) :
  (⋃₀ s).pairwise r ↔ (∀ a ∈ s, set.pairwise a r) :=
by { rw [sUnion_eq_Union, pairwise_Union (h.directed_coe), set_coe.forall], refl }

end set

lemma pairwise.set_pairwise (h : pairwise r) (s : set α) : s.pairwise r := λ x hx y hy, h x y

end pairwise

lemma pairwise_subtype_iff_pairwise_set {α : Type*} (s : set α) (r : α → α → Prop) :
  pairwise (λ (x : s) (y : s), r x y) ↔ s.pairwise r :=
begin
  split,
  { assume h x hx y hy hxy,
    exact h ⟨x, hx⟩ ⟨y, hy⟩ (by simpa only [subtype.mk_eq_mk, ne.def]) },
  { rintros h ⟨x, hx⟩ ⟨y, hy⟩ hxy,
    simp only [subtype.mk_eq_mk, ne.def] at hxy,
    exact h hx hy hxy }
end

alias pairwise_subtype_iff_pairwise_set ↔ pairwise.set_of_subtype set.pairwise.subtype

namespace set
section semilattice_inf_bot
variables [semilattice_inf α] [order_bot α] {s t : set ι} {f g : ι → α}

/-- A set is `pairwise_disjoint` under `f`, if the images of any distinct two elements under `f`
are disjoint.

`s.pairwise disjoint` is (definitionally) the same as `s.pairwise_disjoint id`. We prefer the latter
in order to allow dot notation on `set.pairwise_disjoint`, even though the former unfolds more
nicely. -/
def pairwise_disjoint (s : set ι) (f : ι → α) : Prop := s.pairwise (disjoint on f)

lemma pairwise_disjoint.subset (ht : t.pairwise_disjoint f) (h : s ⊆ t) : s.pairwise_disjoint f :=
pairwise.mono h ht

lemma pairwise_disjoint.mono_on (hs : s.pairwise_disjoint f) (h : ∀ ⦃i⦄, i ∈ s → g i ≤ f i) :
  s.pairwise_disjoint g :=
λ a ha b hb hab, (hs ha hb hab).mono (h ha) (h hb)

lemma pairwise_disjoint.mono (hs : s.pairwise_disjoint f) (h : g ≤ f) : s.pairwise_disjoint g :=
hs.mono_on (λ i _, h i)

@[simp] lemma pairwise_disjoint_empty : (∅ : set ι).pairwise_disjoint f := pairwise_empty _

@[simp] lemma pairwise_disjoint_singleton (i : ι) (f : ι → α) : pairwise_disjoint {i} f :=
pairwise_singleton i _

lemma pairwise_disjoint_insert {i : ι} :
  (insert i s).pairwise_disjoint f
    ↔ s.pairwise_disjoint f ∧ ∀ j ∈ s, i ≠ j → disjoint (f i) (f j) :=
set.pairwise_insert_of_symmetric $ symmetric_disjoint.comap f

lemma pairwise_disjoint.insert (hs : s.pairwise_disjoint f) {i : ι}
  (h : ∀ j ∈ s, i ≠ j → disjoint (f i) (f j)) :
  (insert i s).pairwise_disjoint f :=
set.pairwise_disjoint_insert.2 ⟨hs, h⟩

lemma pairwise_disjoint.image_of_le (hs : s.pairwise_disjoint f) {g : ι → ι} (hg : f ∘ g ≤ f) :
  (g '' s).pairwise_disjoint f :=
begin
  rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ h,
  exact (hs ha hb $ ne_of_apply_ne _ h).mono (hg a) (hg b),
end

lemma inj_on.pairwise_disjoint_image {g : ι' → ι} {s : set ι'} (h : s.inj_on g) :
  (g '' s).pairwise_disjoint f ↔ s.pairwise_disjoint (f ∘ g) :=
h.pairwise_image

lemma pairwise_disjoint.range (g : s → ι) (hg : ∀ (i : s), f (g i) ≤ f i)
  (ht : s.pairwise_disjoint f) :
  (range g).pairwise_disjoint f :=
begin
  rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ hxy,
  exact (ht x.2 y.2 $ λ h, hxy $ congr_arg g $ subtype.ext h).mono (hg x) (hg y),
end

lemma pairwise_disjoint_union :
  (s ∪ t).pairwise_disjoint f ↔ s.pairwise_disjoint f ∧ t.pairwise_disjoint f ∧
    ∀ ⦃i⦄, i ∈ s → ∀ ⦃j⦄, j ∈ t → i ≠ j → disjoint (f i) (f j) :=
pairwise_union_of_symmetric $ symmetric_disjoint.comap f

lemma pairwise_disjoint.union (hs : s.pairwise_disjoint f) (ht : t.pairwise_disjoint f)
  (h : ∀ ⦃i⦄, i ∈ s → ∀ ⦃j⦄, j ∈ t → i ≠ j → disjoint (f i) (f j)) :
  (s ∪ t).pairwise_disjoint f :=
pairwise_disjoint_union.2 ⟨hs, ht, h⟩

lemma pairwise_disjoint_Union {g : ι' → set ι} (h : directed (⊆) g) :
  (⋃ n, g n).pairwise_disjoint f ↔ ∀ ⦃n⦄, (g n).pairwise_disjoint f :=
pairwise_Union h

lemma pairwise_disjoint_sUnion {s : set (set ι)} (h : directed_on (⊆) s) :
  (⋃₀ s).pairwise_disjoint f ↔ ∀ ⦃a⦄, a ∈ s → set.pairwise_disjoint a f :=
pairwise_sUnion h

-- classical
lemma pairwise_disjoint.elim (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
  (h : ¬ disjoint (f i) (f j)) :
  i = j :=
hs.eq hi hj h

-- classical
lemma pairwise_disjoint.elim' (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
  (h : f i ⊓ f j ≠ ⊥) :
  i = j :=
hs.elim hi hj $ λ hij, h hij.eq_bot

lemma pairwise_disjoint.eq_of_le (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
  (hf : f i ≠ ⊥) (hij : f i ≤ f j) :
  i = j :=
hs.elim' hi hj $ λ h, hf $ (inf_of_le_left hij).symm.trans h

end semilattice_inf_bot

section complete_lattice
variables [complete_lattice α]

/-- Bind operation for `set.pairwise_disjoint`. If you want to only consider finsets of indices, you
can use `set.pairwise_disjoint.bUnion_finset`. -/
lemma pairwise_disjoint.bUnion {s : set ι'} {g : ι' → set ι} {f : ι → α}
  (hs : s.pairwise_disjoint (λ i' : ι', ⨆ i ∈ g i', f i))
  (hg : ∀ i ∈ s, (g i).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 (hcd.subst ha) hb hab },
  { exact (hs hc hd $ ne_of_apply_ne _ hcd).mono (le_supr₂ a ha) (le_supr₂ b hb) }
end

end complete_lattice

/-! ### Pairwise disjoint set of sets -/

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

lemma pairwise_disjoint_fiber (f : ι → α) (s : set α) : s.pairwise_disjoint (λ a, f ⁻¹' {a}) :=
λ a _ b _ h i ⟨hia, hib⟩, h $ (eq.symm hia).trans hib

-- classical
lemma pairwise_disjoint.elim_set {s : set ι} {f : ι → set α} (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 $ not_disjoint_iff.2 ⟨a, hai, haj⟩

lemma bUnion_diff_bUnion_eq {s t : set ι} {f : ι → set α} (h : (s ∪ t).pairwise_disjoint f) :
  (⋃ i ∈ s, f i) \ (⋃ i ∈ t, f i) = (⋃ i ∈ s \ t, f i) :=
begin
  refine (bUnion_diff_bUnion_subset f s t).antisymm
    (Union₂_subset $ λ i hi a ha, (mem_diff _).2 ⟨mem_bUnion hi.1 ha, _⟩),
  rw mem_Union₂, rintro ⟨j, hj, haj⟩,
  exact h (or.inl hi.1) (or.inr hj) (ne_of_mem_of_not_mem hj hi.2).symm ⟨ha, haj⟩,
end

/-- Equivalence between a disjoint bounded union and a dependent sum. -/
noncomputable def bUnion_eq_sigma_of_disjoint {s : set ι} {f : ι → set α}
  (h : s.pairwise_disjoint f) :
  (⋃ i ∈ s, f i) ≃ (Σ i : s, f i) :=
(equiv.set_congr (bUnion_eq_Union _ _)).trans $ Union_eq_sigma_of_disjoint $
  λ ⟨i, hi⟩ ⟨j, hj⟩ ne, h hi hj $ λ eq, ne $ subtype.eq eq

/-- The partial images of a binary function `f` whose partial evaluations are injective are pairwise
disjoint iff `f` is injective . -/
lemma pairwise_disjoint_image_right_iff {f : α → β → γ} {s : set α} {t : set β}
  (hf : ∀ a ∈ s, injective (f a)) :
  s.pairwise_disjoint (λ a, f a '' t) ↔ (s ×ˢ t : set (α × β)).inj_on (λ p, f p.1 p.2) :=
begin
  refine ⟨λ hs x hx y hy (h : f _ _ = _), _, λ hs x hx y hy h, _⟩,
  { suffices : x.1 = y.1,
    { exact prod.ext this (hf _ hx.1 $ h.trans $ by rw this) },
    refine hs.elim hx.1 hy.1 (not_disjoint_iff.2 ⟨_, mem_image_of_mem _ hx.2, _⟩),
    rw h,
    exact mem_image_of_mem _ hy.2 },
  { rintro _ ⟨⟨a, ha, hab⟩, b, hb, rfl⟩,
    exact h (congr_arg prod.fst $ hs (mk_mem_prod hx ha) (mk_mem_prod hy hb) hab) }
end

/-- The partial images of a binary function `f` whose partial evaluations are injective are pairwise
disjoint iff `f` is injective . -/
lemma pairwise_disjoint_image_left_iff {f : α → β → γ} {s : set α} {t : set β}
  (hf : ∀ b ∈ t, injective (λ a, f a b)) :
  t.pairwise_disjoint (λ b, (λ a, f a b) '' s) ↔ (s ×ˢ t : set (α × β)).inj_on (λ p, f p.1 p.2) :=
begin
  refine ⟨λ ht x hx y hy (h : f _ _ = _), _, λ ht x hx y hy h, _⟩,
  { suffices : x.2 = y.2,
    { exact prod.ext (hf _ hx.2 $ h.trans $ by rw this) this },
    refine ht.elim hx.2 hy.2 (not_disjoint_iff.2 ⟨_, mem_image_of_mem _ hx.1, _⟩),
    rw h,
    exact mem_image_of_mem _ hy.1 },
  { rintro _ ⟨⟨a, ha, hab⟩, b, hb, rfl⟩,
    exact h (congr_arg prod.snd $ ht (mk_mem_prod ha hx) (mk_mem_prod hb hy) hab) }
end

end set

lemma pairwise_disjoint_fiber (f : ι → α) : pairwise (disjoint on (λ a : α, f ⁻¹' {a})) :=
set.pairwise_univ.1 $ set.pairwise_disjoint_fiber f univ


/-
Copyright (c) 2020 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.continued_fractions.translations
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Stabilisation of gcf Computations Under Termination

## Summary

We show that the continuants and convergents of a gcf stabilise once the gcf terminates.
-/

namespace generalized_continued_fraction

/-- If a gcf terminated at position `n`, it also terminated at `m ≥ n`.-/
theorem terminated_stable {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} {m : ℕ} (n_le_m : n ≤ m) (terminated_at_n : terminated_at g n) : terminated_at g m :=
  seq.terminated_stable (s g) n_le_m terminated_at_n

theorem continuants_aux_stable_step_of_terminated {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] (terminated_at_n : terminated_at g n) : continuants_aux g (n + bit0 1) = continuants_aux g (n + 1) := sorry

theorem continuants_aux_stable_of_terminated {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} {m : ℕ} [division_ring K] (succ_n_le_m : n + 1 ≤ m) (terminated_at_n : terminated_at g n) : continuants_aux g m = continuants_aux g (n + 1) := sorry

theorem convergents'_aux_stable_step_of_terminated {K : Type u_1} {n : ℕ} [division_ring K] {s : seq (pair K)} (terminated_at_n : seq.terminated_at s n) : convergents'_aux s (n + 1) = convergents'_aux s n := sorry

theorem convergents'_aux_stable_of_terminated {K : Type u_1} {n : ℕ} {m : ℕ} [division_ring K] {s : seq (pair K)} (n_le_m : n ≤ m) (terminated_at_n : seq.terminated_at s n) : convergents'_aux s m = convergents'_aux s n := sorry

theorem continuants_stable_of_terminated {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} {m : ℕ} [division_ring K] (n_le_m : n ≤ m) (terminated_at_n : terminated_at g n) : continuants g m = continuants g n := sorry

theorem numerators_stable_of_terminated {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} {m : ℕ} [division_ring K] (n_le_m : n ≤ m) (terminated_at_n : terminated_at g n) : numerators g m = numerators g n := sorry

theorem denominators_stable_of_terminated {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} {m : ℕ} [division_ring K] (n_le_m : n ≤ m) (terminated_at_n : terminated_at g n) : denominators g m = denominators g n := sorry

theorem convergents_stable_of_terminated {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} {m : ℕ} [division_ring K] (n_le_m : n ≤ m) (terminated_at_n : terminated_at g n) : convergents g m = convergents g n := sorry

theorem convergents'_stable_of_terminated {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} {m : ℕ} [division_ring K] (n_le_m : n ≤ m) (terminated_at_n : terminated_at g n) : convergents' g m = convergents' g n := sorry


/- # Lean implementation and verification of the insert sort algorithm! -/
import Mathlib.Data.Nat.Basic
namespace Notes
variable {α : Type} (f: α → α → Bool) (r : α → α → Prop) [DecidableRel r]

/-
We sort lists of type 'α' using the comparison function 'f' or 'r'.

If 'f a₁ a₂ = true', then this is the "correct" order. Otherwise, it is "incorrect".

If 'r a₁ a₂' has a proof, then this is the "correct" order. Otherwise, it is "incorrect".

What are some examples of sorted lists?
- [] should be "sorted"
- for any 'a : α', then '[a]' is sorted
- for any 'a₁ a₂ : α' and any 'as : List α' such that
  'f a₁ a₂ = true' and 'a₂::as' is sorted, then 'a₁::a₂::as' is sorted
-/

inductive Sorted (r : α → α → Prop) : List α → Prop where
  | nil : Sorted r []
  | single {a:α} : Sorted r [a]
  | longer {a₁ a₂ : α} {as : List α} (h : r a₁ a₂)
    (h' : Sorted r (a₂::as)) : Sorted r (a₁::a₂::as)

open Sorted
example : Sorted (·≤·) [1, 2, 3] := by
  apply longer
  · simp
  · apply longer
    · simp
    · apply single

theorem sorted_tail_of_sorted (a : α) (as : List α)
    (h : Sorted r (a::as)) : Sorted r as := by
  match h with
  | single => apply nil
  | longer _ h'' => exact h''

/- Insertion Sort Implementation -/
def insert (a : α) (l : List α) : List α :=
  match l with
  | [] => [a]
  | a'::as =>
    if r a a' then a::a'::as else a'::insert a as

@[simp]
theorem len_insert_eq_succ_len {a : α} {l : List α} :
    (insert r a l).length = l.length + 1 :=
  match l with
  | [] => by simp[insert]
  | a'::as =>
    if h : r a a' then by simp [insert, h] else
    by simp [insert, h]; apply len_insert_eq_succ_len

def insertSort (l : List α) : List α :=
  match l with
  | [] => []
  | a::as => insert r a <| insertSort as

-- Check that the implementation works on certain inputs
#eval insertSort (·≤·) [4, 5, 2, 4, 5, 6]
#eval insertSort (fun (b b' : Bool) => b && b') [true, false, false]
#eval insertSort (fun (_ _ ) => false) [4, 5, 2, 4, 5, 6]

/- Establish that the output of insertSort will always match the behavior defined in Sorted, i.e., verify the algorithm -/

class Asymmetric (r : α → α → Prop) where
  asym {a a'} : ¬r a a' → r a' a

open Asymmetric

def Sorted.cons {a : α} {l : List α} (h₁ : Sorted r l)
  (h₂ : l.length > 0) (h₃ : r a l[0]) : Sorted r (a::l) :=
  match h₁ with
  | nil => single
  | single => longer h₃ single
  | longer h h' => longer h₃ <| longer h h'

theorem ordered_of_sorted {a a' : α} (as : List α)
  (h : Sorted r (a::a'::as)) : r a a' :=
  match h with
  | longer h' _ => h'

theorem ordered_cons_insert_of_unordered {a a' : α} {as : List α}
    (h : Sorted r (a'::as)) (h' : r a' a) : r a' (insert r a as)[0] :=
  match as with
  | [] => by simpa[insert]
  | a''::as' =>
    if h'' : r a a'' then
    by simpa[insert, h'']
    else
    by simp [insert, h'']; apply ordered_of_sorted r h

theorem insert_sorted_of_sorted {a : α} {l : List α} [Asymmetric r]
    (h : Sorted r l) : Sorted r <| insert r a l :=
  match l with
  | [] => single
  | a'::as =>
    if h' : r a a' then
    by simp[insert, h']; apply longer h' h
    else
    by
      simp[insert, h']
      apply cons r
      · apply insert_sorted_of_sorted <| sorted_tail_of_sorted r a' as h
      · apply ordered_cons_insert_of_unordered r h
        · apply asym; simp; assumption

theorem sorted_of_insertSort (l : List α) [Asymmetric r] :
    Sorted r <| insertSort r l :=
  match l with
  | [] => nil
  | a::as => by
    dsimp [insertSort]
    apply insert_sorted_of_sorted r <| sorted_of_insertSort as

variable [Trans r r r]

theorem totally_ordered_of_sorted {l : List α} (h : Sorted r l) :
  ∀ {i j : ℕ}, (i < j) → (_: i < l.length) → (_: j < l.length) → r l[i] l[j] :=
  match h with
  | nil => fun _ h' _ => False.elim <| by simp [h'] at h'
  | single => sorry
  | longer h₁ h₂ => sorry


import linear_algebra.basis

variables {R : Type*} [ring R] {M : Type*} [add_comm_group M] [module R M] {N : Type*}
  [add_comm_group N] [module R N] {M' : Type*} [add_comm_group M'] [module R M']

theorem map_inf (p p' : submodule R M) (f : M →ₗ[R] M') (hf : function.injective f) :
  p.map f ⊓ p'.map f = (p ⊓ p').map f :=
submodule.coe_injective $ set.image_inter hf

/-- We have R-submodules of M, S, T ⊆ A, where S, T are thought of as submodules of A.
Given sets s, t ⊆ M, if the submodule s generates equals 'S as a submodule of M' and the submodule
t generates equals 'T as a submodule of M', and s & t are linearly independent, and S, T are complementary
submodules of A, then s ∪ t is linearly independent and generates A. -/
theorem union_is_basis_of_gen_compl (A : submodule R M) (S : submodule R A) (s : set M)
  (T : submodule R A) (t : set M)
  (hss : submodule.span R s = S.map A.subtype) (hts : submodule.span R t = T.map A.subtype)
  (hsl : linear_independent R (λ x, x : s → M))
  (htl : linear_independent R (λ x, x : t → M))
  (h1 : S ⊓ T = ⊥) (h2 : S ⊔ T = ⊤) : linear_independent R (λ x, x : s ∪ t → M)
    ∧ submodule.span R (set.range (λ x, x : s ∪ t → M)) = A :=
begin
  split,
  apply linear_independent.union hsl htl,
  rw hss, rw hts,
  rw disjoint_iff,
  rw map_inf, rw h1, rw submodule.map_bot, exact subtype.val_injective,
  have := submodule.map_sup S T A.subtype,
  rw h2 at this,
  rw submodule.map_subtype_top at this, rw this,
  erw subtype.range_coe_subtype, rw ←hss, rw ←hts, exact submodule.span_union _ _,
end


import Mathlib.Data.Real.NNReal

--open_locale nnreal

def proportion (r s t u : ℝ) : Prop :=
  0 ≤ r ∧ 0 ≤ s ∧ 0 ≤ t ∧ 0 ≤ u ∧
  ∀ (n m : ℕ),
  ((n : ℝ) * r = m * s → (n : ℝ) * t = m * u) ∧
  ((n : ℝ) * r < m * s → (n : ℝ) * t < m * u) ∧
  ((m : ℝ) * s < n * r → (m : ℝ) * u < n * t)

lemma proportion_of_eq_ratio {r s t u : ℝ} (hr : 0 ≤ r) (hs : 0 ≤ s) (ht : 0 ≤ t) (hu : 0 ≤ u) (s_ne : s ≠ 0) (u_ne : u ≠ 0)
  (rstu : r / s = t / u) :
  proportion r s t u :=
 by sorry
 --
/-begin
  refine ⟨hr, hs, ht, hu, _⟩,
  intros n m,
  field_simp at rstu,
  split,
  { intros h,
    suffices hh : (n : ℝ) * t * s = m * u * s,
    { convert (congr_arg (λ x, x / s) hh) using 1; field_simp, },
    { convert (congr_arg (λ x, x * u) h) using 1,
      { rw [mul_assoc, ← rstu],
        ring, },
      { ring, }, }, },
  { split,
    { intros h,
      suffices hh : (n : ℝ) * t * s < m * u * s,
      { convert mul_lt_mul hh (by simp : (1:ℝ)/s ≤ 1/s) (by positivity) (by positivity) using 1;
        field_simp, },
      { rw [mul_assoc, ← rstu, ← mul_assoc],
        convert mul_lt_mul h (by simp : u ≤ u) (by positivity) (by positivity) using 1;
        ring, }, },
    { intros h,
      suffices hh : (m : ℝ) * u * s < n * t * s,
      { convert mul_lt_mul hh (by simp : (1:ℝ)/s ≤ 1/s) (by positivity) (by positivity) using 1;
        field_simp, },
      { rw [(by ring : (n : ℝ) * t * s = n * (t * s)), ← rstu],
        convert mul_lt_mul h (by simp : u ≤ u) (by positivity) (by positivity) using 1;
        ring, }, }, },  end-/

lemma eq_ratio_of_proportion {r s t u : ℝ} (s_ne : s ≠ 0) (u_ne : u ≠ 0)
  (h : proportion r s t u) :
  r / s = t / u :=
 by sorry
 --
/-begin
  have hr := h.1,
  have hs := h.2.1,
  have ht := h.2.2.1,
  have hu := h.2.2.2.1,
  have h := h.2.2.2.2,
  by_contra hh,
  change r / s ≠ t / u at hh,
  by_cases rstu : r / s < t / u,
  { have : ∃ n m : ℕ, r / s < n / m ∧ (n:ℝ) / m < t / u ∧ n ≠ 0 ∧ m ≠ 0,
    { obtain ⟨q, hq⟩ := exists_rat_btwn rstu,
      let m := q.denom,
      have m_ne : m ≠ 0 := rat.denom_ne_zero q,
      have m_ne_ℝ : (m:ℝ) ≠ 0 := by exact_mod_cast m_ne,
      have q_gt : (0:ℚ) < q := by exact_mod_cast
        calc (0:ℝ) ≤ r/s : by positivity
        ... < q : hq.1,
      let nn := q.num,
      have nn_gt : 0 < nn := rat.num_pos_iff_pos.mpr q_gt,
      let n := nn.to_nat,
      have n_nn : (n:ℤ) = nn := int.to_nat_of_nonneg (le_of_lt nn_gt),
      use n, -- use n m doesn't work???
      use m,
      have : (n : ℝ) / m = q,
      { have : (nn : ℝ) / m = q := by exact_mod_cast (rat.num_div_denom q),
        convert this using 2,
        exact_mod_cast int.to_nat_of_nonneg (le_of_lt nn_gt), },
      rw this,
      exact ⟨hq.1, hq.2, by linarith, m_ne⟩, },
    obtain ⟨n, m, hrs_le_nm, hnm_le_tu, n_ne, m_ne⟩ := this,
    have m_ne_ℝ : (m:ℝ) ≠ 0 := by exact_mod_cast m_ne,
    have mrns : (m:ℝ)*r < n*s → (m:ℝ) * t < n * u := by exact_mod_cast (h m n).2.1,
    have := mrns _,
    { suffices hh : (n:ℝ) * u < m * t,
      { linarith, },
      convert mul_lt_mul hnm_le_tu (by simp : u * m ≤ u * m) (by positivity) (by positivity) using 1,
      { field_simp,
        ring, },
      { field_simp,
        ring, }, },
    convert mul_lt_mul hrs_le_nm (by simp : s * m ≤ s * m) (by positivity) (by positivity) using 1,
    { field_simp,
      ring, },
    { field_simp,
      ring, }, },
  { have turs : t / u < r / s := (or_iff_right rstu).mp (lt_or_lt_iff_ne.mpr hh),
    have : ∃ n m : ℕ, t / u < n / m ∧ (n:ℝ) / m < r / s ∧ n ≠ 0 ∧ m ≠ 0,
    { obtain ⟨q, hq⟩ := exists_rat_btwn turs,
      let m := q.denom,
      have m_ne : m ≠ 0 := rat.denom_ne_zero q,
      have m_ne_ℝ : (m:ℝ) ≠ 0 := by exact_mod_cast m_ne,
      have q_gt : (0:ℚ) < q := by exact_mod_cast
        calc (0:ℝ) ≤ t/u : by positivity
        ... < q : hq.1,
      let nn := q.num,
      have nn_gt : 0 < nn := rat.num_pos_iff_pos.mpr q_gt,
      let n := nn.to_nat,
      have n_nn : (n:ℤ) = nn := int.to_nat_of_nonneg (le_of_lt nn_gt),
      use n, -- use n m doesn't work???
      use m,
      have : (n : ℝ) / m = q,
      { have : (nn : ℝ) / m = q := by exact_mod_cast (rat.num_div_denom q),
        convert this using 2,
        exact_mod_cast int.to_nat_of_nonneg (le_of_lt nn_gt), },
      rw this,
      exact ⟨hq.1, hq.2, by linarith, m_ne⟩, },
    obtain ⟨n, m, hrs_le_nm, hnm_le_tu, n_ne, m_ne⟩ := this,
    have m_ne_ℝ : (m:ℝ) ≠ 0 := by exact_mod_cast m_ne,
    have n_ne_ℝ : (n:ℝ) ≠ 0 := by exact_mod_cast n_ne,
    have mrns : (n:ℝ) * s < m * r → (n:ℝ) * u < m * t := by exact_mod_cast (h m n).2.2,
    have : (n:ℝ) * s < m * r,
    { convert mul_lt_mul hnm_le_tu (by simp : s * m ≤ s * m) (by positivity) (by positivity) using 1;
      { field_simp,
        ring, }, },
    have := mrns this,
    have : t * m < n * u,
    { convert mul_lt_mul hrs_le_nm (by simp : u * m ≤ u * m) (by positivity) (by positivity) using 1;
      { field_simp,
        ring, }, },
    linarith, },  end-/

lemma proportion_iff {r s t u : ℝ} (hr : 0 ≤ r) (hs : 0 ≤ s) (ht : 0 ≤ t) (hu : 0 ≤ u) (s_ne : s ≠ 0) (u_ne : u ≠ 0) :
  r / s = t / u ↔ proportion r s t u :=
 by sorry
 -- ⟨λ h, proportion_of_eq_ratio hr hs ht hu s_ne u_ne h, λ h, eq_ratio_of_proportion s_ne u_ne h⟩

lemma proportion_inv {r s t u : ℝ} (h : proportion r s t u) :
  proportion s r u t :=
   by sorry
 --
/-begin
    dsimp [proportion] at ⊢ h,
    refine ⟨h.2.1, h.1, h.2.2.2.1, h.2.2.1, _⟩,
    intros n m,
    have := h.2.2.2.2 m n,
    split,
    intro h,
    exact (this.1 h.symm).symm,
    split,
    intro h,
    exact (this.2.2 h),
    intro h,
    exact (this.2.1 h),
   end-/

lemma proportion_inv_iff {r s t u : ℝ} :
  proportion r s t u ↔ proportion s r u t :=
   by sorry
 --
/-begin
    split,
    all_goals
    { intro h,
      exact proportion_inv h, },
   end-/

lemma zero_of_proportion_iff { r s t u : ℝ } (h : proportion r s t u) :
  s = 0 ↔ u = 0 :=
   by sorry
 --
/-begin
    dsimp [proportion] at h,
    split,
    { intro s_ne,
      have := (h.2.2.2.2 0 1).1,
      rw s_ne at this,
      simp only [algebra_map.coe_zero, zero_mul, algebra_map.coe_one, eq_self_iff_true, one_mul, forall_true_left] at this,
      exact this.symm, },
    { intro u_ne,
      have := (h.2.2.2.2 0 1).2.1,
      rw u_ne at this,
      simp only [algebra_map.coe_zero, zero_mul, algebra_map.coe_one, one_mul, lt_self_iff_false] at this,
      by_contradiction contra,
      rw (ne.def s 0).symm at contra,
      exact this (lt_of_le_of_ne h.2.1 contra.symm), },
   end-/

lemma proportion_of_zero : proportion 0 0 0 0 :=
   by sorry
 --
/-begin
    dsimp [proportion],
    simp only [le_refl, mul_zero, eq_self_iff_true, lt_self_iff_false, is_empty.forall_iff, and_self, forall_const],
   end-/

lemma proportion_symm {r s t u : ℝ} (s_ne : s ≠ 0) (u_ne : u ≠ 0) (h : proportion r s t u) :
  proportion t u r s
 :=  by sorry
 -- (proportion_iff h.2.2.1 h.2.2.2.1 h.1 h.2.1 u_ne s_ne).mp(((proportion_iff h.1 h.2.1 h.2.2.1 h.2.2.2.1 s_ne u_ne).mpr) h).symm

lemma proportion_symm' {r s t u : ℝ} (h : proportion r s t u) :
  proportion t u r s :=
   by sorry
 --
/-begin
    by_cases s_ne : s = 0,
    { have u_ne := (zero_of_proportion_iff h).mp s_ne,
      -- invert the proportionality relation
      have inv := proportion_inv h,
      by_cases r_ne : r = 0,
      { have t_ne := (zero_of_proportion_iff inv).mp r_ne,
        rw [s_ne,r_ne,t_ne,u_ne],
        exact proportion_of_zero,
      },

      have t_ne := (zero_of_proportion_iff inv).not.mp r_ne,
      rw proportion_inv_iff,
      exact proportion_symm r_ne t_ne inv,
    },

    have u_ne := (zero_of_proportion_iff h).not.mp s_ne,
    exact proportion_symm s_ne u_ne h,
   end-/

lemma proportion_symm_iff {r s t u : ℝ}
  : proportion r s t u ↔ proportion t u r s :=
   by sorry
 --
/-begin
    split,
    all_goals
    { intro h,
      exact proportion_symm' h, },
   end-/

lemma proportion_eq {r s : ℝ} (hr: 0 ≤ r) (hs: 0 ≤ s) (r_ne: r ≠ 0) (s_ne: s ≠ 0) : proportion r r s s :=
   by sorry
 --
/-begin
    rw (proportion_iff hr hr hs hs r_ne s_ne).symm,
    field_simp,
   end-/


/-
  Copyright 2020 Grayson Burton
  License available in the LICENSE file.
-/

import data.set.basic tactic

private lemma {u} set_ins_comm {α : Type u} (x y : α) :
  ({x, y} : set α) = {y, x} :=
by simp [set.insert_def, or.comm]

/-- A strict betweenness relation. -/
class {u} has_betweenness (α : Type u) : Type u :=
(between : α → α → α → Prop)
(between_extend : ∀ {p q}, p ≠ q → ∃ r, between p q r)
(between_irrefl : ∀ {p q r}, between p q r → p ≠ r)
(between_symm : ∀ {p q r}, between p q r → between r q p)
(between_not_rotate : ∀ {p q r}, between p q r → ¬ between r p q)

/-- `between P Q R` means "`Q` lies in the line segment `PR` and isnt an
    endpoint." -/
def {u} between {α : Type u} [has_betweenness α] :=
@has_betweenness.between α _

namespace between
section
universe u
parameters {α : Type u} [has_betweenness α]

/-- For any two distinct points `P`,`Q` there is another point `R` such that
    `Q` is between `P` and `R`. -/
lemma extend {p q : α} : p ≠ q → ∃ r, between p q r :=
has_betweenness.between_extend

lemma eq_of_no_extension {p q : α} : (¬ ∃ r, between p q r) → p = q :=
by contrapose!; exact extend

lemma eq_of_no_extension' {p q : α} : (∀ r, ¬ between p q r) → p = q :=
by contrapose!; exact extend

/-- If `Q` is between `P` and `R`, then `P ≠ R`. -/
protected lemma irrefl {p q r : α} : between p q r → p ≠ r :=
has_betweenness.between_irrefl

lemma not_between_of_eq {p r : α} (q : α) : p = r → ¬ between p q r :=
by contrapose!; exact between.irrefl

protected lemma symm {p q r : α} : between p q r → between r q p :=
has_betweenness.between_symm

/-- `Q` is between `P` and `R` iff it is between `R` and `P`. -/
lemma symm_iff (p q r : α) : between p q r ↔ between r q p :=
iff.intro between.symm between.symm

/-- If `Q` is between `P` and `R`, then `P` isn't between `R` and `Q`. -/
lemma not_rotate {p q r : α} : between p q r → ¬ between r p q :=
has_betweenness.between_not_rotate

/-- There is no point between `P` and itself. -/
lemma irrefl' (p q : α) : ¬ between p q p :=
not_between_of_eq q rfl

/-- No point is between itself and another point. -/
theorem not_self_between (p q : α) : ¬ between p p q :=
λ h, h.not_rotate h.symm

/-- No point is between itself and another point. -/
theorem not_between_self (p q : α) : ¬ between p q q :=
λ h, not_self_between _ _ h.symm

end
end between

section
universe u
parameters {α : Type u} [has_betweenness α]

/-- A line segment excluding the endpoints -/
def segment (x y : α) : set α := {z | between x z y}

/-- A line segment including the endpoints -/
def interval (x y : α) : set α := segment x y ∪ {x, y}

/-- The ray (or half line) from `x` to `y`. Excludes `x`. -/
def ray (x y : α) : set α := {z | between z y x} ∪ segment x y ∪ {y}

/-- A line through `x` and `y` -/
def line (x y : α) : set α := interval x y ∪ ray x y ∪ ray y x

/-- `collinear P Q R` means "There is a line with `p`, `r`, and `q` on it." -/
def collinear (p q r : α) : Prop :=
∃ v₀ v₁, p ∈ line v₀ v₁ ∧ q ∈ line v₀ v₁ ∧ r ∈ line v₀ v₁

end

section
universe u
parameters {α : Type u} [has_betweenness α]

namespace segment

@[simp]
lemma seg_def (x y : α) : segment x y = {z | between x z y} := rfl

theorem empty_of_same_ends (x : α) : segment x x = ∅ :=
by rw set.eq_empty_iff_forall_not_mem; apply between.irrefl'

theorem end_not_mem_seg_left (x y : α) : x ∉ segment x y :=
between.not_self_between _ _

theorem end_not_mem_seg_right (x y : α) : y ∉ segment x y :=
between.not_between_self _ _

theorem swap (x y : α) : segment x y = segment y x :=
by dsimp; congr; funext; rw between.symm_iff

lemma symm {p q r : α} (h : r ∈ segment p q) : r ∈ segment q p :=
by rwa swap at h

theorem subs_intrv (x y : α) : segment x y ⊆ interval x y :=
λ _, or.inl

theorem ssubs_intrv (x y : α) : segment x y ⊂ interval x y :=
begin
  rw set.ssubset_iff_subset_ne,
  refine ⟨subs_intrv _ _, λ h₁, _⟩,
  replace h₁ := eq_iff_iff.mp (congr_fun h₁ x),
  apply end_not_mem_seg_left x y,
  exact h₁.mpr (or.inr $ or.inl rfl)
end

theorem seg_subs_ray (x y : α) : segment x y ⊆ ray x y :=
λ _, or.inl ∘ or.inr

theorem seg_ssubs_ray (x y : α) : segment x y ⊂ ray x y :=
begin
  rw set.ssubset_iff_subset_ne,
  refine ⟨seg_subs_ray _ _, λ h₁, _⟩,
  replace h₁ := eq_iff_iff.mp (congr_fun h₁ y),
  apply end_not_mem_seg_right x y,
  exact h₁.mpr (or.inr rfl)
end

theorem seg_subs_line (x y : α) : segment x y ⊆ line x y :=
λ _, or.inl ∘ or.inl ∘ or.inl

theorem seg_ssubs_line (x y : α) : segment x y ⊂ line x y :=
begin
  rw set.ssubset_iff_subset_ne,
  refine ⟨seg_subs_line _ _, λ h₁, _⟩,
  replace h₁ := eq_iff_iff.mp (congr_fun h₁ y),
  apply end_not_mem_seg_right x y,
  exact h₁.mpr (or.inl $ or.inr $ or.inr rfl)
end

theorem ne_ends_of_mem {x y : α} (h : ∃ z, z ∈ segment x y) : x ≠ y :=
begin
  intro he,
  induction he,
  cases h with _ h,
  rw empty_of_same_ends at h,
  exact h
end

theorem ne_left_of_mem {x y z : α} (h : x ∈ segment y z) : x ≠ y :=
λ he, by rw he at h; exact (end_not_mem_seg_left _ _).elim h

theorem ne_right_of_mem {x y z : α} (h : x ∈ segment y z) : x ≠ z :=
λ he, by rw he at h; exact (end_not_mem_seg_right _ _).elim h

theorem not_in_rotate {x y z : α} : z ∈ segment x y → x ∉ segment y z :=
between.not_rotate

theorem not_in_rotate' {x y z : α} : z ∈ segment x y → x ∉ segment z y :=
by rw swap z y; exact not_in_rotate

end segment

namespace interval

@[simp]
lemma intrv_def (x y : α) :
  interval x y = {z | between x z y ∨ z = x ∨ z = y} :=
rfl

@[simp]
lemma intrv_def' (x y : α) : interval x y = segment x y ∪ {x, y} := rfl

theorem seg_subs (x y : α) : segment x y ⊆ interval x y :=
segment.subs_intrv _ _

@[simp]
theorem single_self (x : α) : interval x x = {x} :=
begin
  rw intrv_def,
  congr,
  funext,
  rw or_self,
  apply or_eq_of_eq_false_left,
  rw eq_false,
  apply between.irrefl'
end

theorem end_mem_intrv_left (x y : α) : x ∈ interval x y :=
or.inr $ or.inl rfl

theorem end_mem_intrv_right (x y : α) : y ∈ interval x y :=
or.inr $ or.inr rfl

theorem seg_ssubs (x y : α) : segment x y ⊂ interval x y :=
segment.ssubs_intrv _ _

theorem swap (x y : α) : interval x y = interval y x :=
by simp only [intrv_def', segment.swap, set_ins_comm]

theorem eq_of_mem_same {p q : α} (h : p ∈ interval q q) : p = q :=
by rw single_self at h; exact h

theorem eq_iff_mem_same (p q : α) : p ∈ interval q q ↔ p = q :=
⟨eq_of_mem_same, λ _, by simpa⟩

end interval

namespace ray

@[simp]
lemma ray_def (x y : α) :
  ray x y = {z | between z y x} ∪ segment x y ∪ {y} :=
rfl

@[simp]
theorem single_self (x : α) : ray x x = {x} :=
begin
  rw ray_def,
  funext,
  apply or_eq_of_eq_false_left,
  apply eq_false_intro,
  change ¬ (_ ∨ _),
  push_neg,
  exact ⟨between.not_between_self _ _, between.irrefl' _ _⟩
end

lemma end_not_mem_ray_left_of_ne {x y : α} : x ≠ y → x ∉ ray x y :=
begin
  intro h,
  rw ray_def,
  change ¬ ((_ ∨ _) ∨ _),
  push_neg,
  exact ⟨⟨between.irrefl' _ _, segment.end_not_mem_seg_left _ _⟩, h⟩
end

lemma ne_of_end_not_mem_ray_left {x y : α} : x ∉ ray x y → x ≠ y :=
begin
  intro h,
  rw ray_def at h,
  change ¬ ((_ ∨ _) ∨ _) at h,
  push_neg at h,
  exact h.right
end

theorem end_not_mem_ray_left_iff_ne (x y : α) : x ≠ y ↔ x ∉ ray x y :=
  iff.intro end_not_mem_ray_left_of_ne ne_of_end_not_mem_ray_left

theorem end_mem_ray_left_iff_eq (x y : α) : x = y ↔ x ∈ ray x y :=
begin
  classical,
  exact not_iff_not.mp (end_not_mem_ray_left_iff_ne _ _)
end

theorem end_mem_ray_right (x y : α) : y ∈ ray x y :=
or.inr rfl

theorem seg_subs (x y : α) : segment x y ⊆ ray x y :=
segment.seg_subs_ray _ _

theorem seg_ssubs (x y : α) : segment x y ⊂ ray x y :=
segment.seg_ssubs_ray _ _

theorem eq_of_mem_same {x y : α} (h : x ∈ ray y y) : x = y :=
by rw single_self at h; exact h

@[simp]
theorem eq_iff_mem_same (x y : α) : x ∈ ray y y ↔ x = y :=
⟨eq_of_mem_same, λ h, by simp [h]⟩

end ray

namespace line

@[simp]
theorem line_def (x y : α) : line x y = interval x y ∪ ray x y ∪ ray y x := rfl

@[simp]
theorem single_self (x : α) : line x x = {x} :=
by simp

theorem swap (x y : α) : line x y = line y x :=
by rw [line_def, interval.swap, set.union_assoc,
       set.union_comm (ray _ _), ←set.union_assoc, line_def]

theorem ray_subs (x y : α) : ray x y ⊆ line x y :=
λ _, or.inl ∘ or.inr

theorem ray_subs' (x y : α) : ray y x ⊆ line x y :=
λ _, or.inr

theorem seg_subs (x y : α) : segment x y ⊆ line x y :=
segment.seg_subs_line x y

theorem seg_ssubs (x y : α) : segment x y ⊂ line x y :=
segment.seg_ssubs_line x y

theorem intrv_subs (x y : α) : interval x y ⊆ line x y :=
λ _, or.inl ∘ or.inl

theorem end_mem_line_left (x y : α) : x ∈ line x y :=
or.inr $ ray.end_mem_ray_right _ _

theorem end_mem_line_right (x y : α) : y ∈ line x y :=
or.inl $ or.inr $ ray.end_mem_ray_right _ _

theorem ray_ssubs_of_ne {x y : α} (h : x ≠ y) : ray x y ⊂ line x y :=
begin
  apply set.ssubset_iff_subset_ne.mpr ⟨ray_subs _ _, λ h₁, _⟩,
  rw [ray.end_not_mem_ray_left_iff_ne, h₁] at h,
  exact h (end_mem_line_left _ _)
end

theorem ray_ssubs_of_ne' {x y : α} (h : x ≠ y) : ray y x ⊂ line x y :=
by rw swap; exact ray_ssubs_of_ne h.symm

theorem rotate_of_ne {x y z : α} : x ≠ z → x ∈ line y z → y ∈ line x z :=
by finish using between.symm_iff

@[simp]
theorem rotate_iff_of_ne {x y z : α} :
  x ≠ z → y ≠ z → (x ∈ line y z ↔ y ∈ line x z) :=
λ h₁ h₂, ⟨rotate_of_ne h₁, rotate_of_ne h₂⟩

theorem eq_of_mem_same {x y : α} (h : x ∈ line y y) : x = y :=
begin
  rcases h with ⟨h | h⟩ | h,
    { exact interval.eq_of_mem_same h },
    { exact ray.eq_of_mem_same h },
    { exact ray.eq_of_mem_same h }
end

@[simp]
theorem eq_iff_mem_same (x y : α) : x ∈ line y y ↔ x = y :=
⟨eq_of_mem_same, λ h, by simp [h]⟩

end line

namespace collinear

@[simp]
theorem collin_def (p q r : α) : collinear p q r =
  ∃ v₀ v₁ : α, p ∈ line v₀ v₁ ∧ q ∈ line v₀ v₁ ∧ r ∈ line v₀ v₁ :=
rfl

theorem of_left (p q : α) : collinear p p q :=
⟨p, q, by simp⟩

theorem of_right (p q : α) : collinear p q q :=
⟨p, q, by simp⟩

theorem of_ends (p q : α) : collinear p q p :=
⟨p, q, by simp⟩

theorem of_same (p : α) : collinear p p p :=
of_left p p

theorem swap_iff (p q r : α) : collinear p q r ↔ collinear q p r :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  all_goals
    { rcases h with ⟨_, _, h⟩,
      rw [←and.assoc, @and.comm (_ ∈ _), and.assoc] at h,
      exact ⟨_, _, h⟩ }
end

theorem swap {p q r : α} : collinear p q r → collinear q p r :=
(swap_iff p q r).mp

theorem mem_of_mem_line {p q r : α} (h : p ∈ line q r) : collinear q r p :=
⟨q, r, by simp, by simp, h⟩

theorem mem_of_mem_ray {p q r : α} (h : p ∈ ray q r) : collinear q r p :=
mem_of_mem_line $ line.ray_subs _ _ h

theorem mem_of_mem_ray' {p q r : α} (h : p ∈ ray r q) : collinear q r p :=
mem_of_mem_line $ line.ray_subs' _ _ h

theorem mem_of_mem_intrv {p q r : α} (h : p ∈ interval q r) :
  collinear q r p :=
mem_of_mem_line $ line.intrv_subs _ _ h

theorem rotate' {p q r : α} (h : collinear p q r) : collinear r p q :=
begin
  rcases h with ⟨_, _, h⟩,
  rw [@and.comm (_ ∈ _), and.assoc, @and.comm (_ ∈ _), and.assoc] at h,
  exact ⟨_, _, h⟩
end

theorem rotate {p q r : α} : collinear p q r → collinear q r p :=
rotate' ∘ rotate'

theorem rotate_iff {p q r : α} : collinear p q r ↔ collinear q r p :=
⟨rotate, rotate'⟩

theorem swap_iff' (p q r : α) : collinear p q r ↔ collinear p r q :=
by rw [rotate_iff, swap_iff _ r q, rotate_iff]

theorem of_left' (p q : α) : collinear p p q :=
(of_ends _ _).rotate'

theorem ex_collinear_of_mem {p : α} {s : set α} (h : p ∈ s) :
  ∃ q r ∈ s, collinear p q r :=
⟨_, _, h, h, of_same _⟩

@[simp]
theorem none_collinear_iff_empty (s : set α) :
  (∀ p q r ∈ s, ¬ collinear p q r) ↔ s = ∅ :=
begin
  refine ⟨λ h, set.eq_empty_iff_forall_not_mem.mpr $ λ _, _, λ h _ _ _ hp, _⟩,
    { intro hx, exact h _ _ _ hx hx hx (of_same _) },
    { rw h at hp, exact (set.not_mem_empty _).elim hp }
end

@[simp]
theorem none_collinear_iff_empty_2 (s : set α) :
  (∀ p q ∈ s, ¬ collinear p p q) ↔ s = ∅ :=
begin
  refine ⟨λ h, set.eq_empty_iff_forall_not_mem.mpr $ λ _, _, λ h _ _ _ hp, _⟩,
    { intro hx, exact h _ _ hx hx (of_same _) },
    { rw h at hp, exact (set.not_mem_empty _).elim hp }
end

@[simp]
theorem none_collinear_iff_empty_2' (s : set α) :
  (∀ p q ∈ s, ¬ collinear p q q) ↔ s = ∅ :=
begin
  refine ⟨λ h, set.eq_empty_iff_forall_not_mem.mpr $ λ _, _, λ h _ _ _ hp, _⟩,
    { intro hx, exact h _ _ hx hx (of_same _) },
    { rw h at hp, exact (set.not_mem_empty _).elim hp }
end

@[simp]
theorem none_collinear_iff_empty_2'' (s : set α) :
  (∀ p q ∈ s, ¬ collinear p q p) ↔ s = ∅ :=
begin
  refine ⟨λ h, set.eq_empty_iff_forall_not_mem.mpr $ λ _, _, λ h _ _ _ hp, _⟩,
    { intro hx, exact h _ _ hx hx (of_same _) },
    { rw h at hp, exact (set.not_mem_empty _).elim hp }
end

@[simp]
theorem none_collinear_iff_empty_fixed_1 (s : set α) (p : α) :
  (∀ q r ∈ s, ¬ collinear p q r) ↔ s = ∅ :=
begin
  refine ⟨λ h, set.eq_empty_iff_forall_not_mem.mpr $ λ _, _, λ h _ _ _ hp, _⟩,
    { intro hx, exact h _ _ hx hx (of_right _ _) },
    { rw h at hp, exact (set.not_mem_empty _).elim hp }
end

@[simp]
theorem none_collinear_iff_empty_fixed_1' (s : set α) (p : α) :
  (∀ q r ∈ s, ¬ collinear q p r) ↔ s = ∅ :=
begin
  refine ⟨λ h, set.eq_empty_iff_forall_not_mem.mpr $ λ _, _, λ h _ _ _ hp, _⟩,
    { intro hx, exact h _ _ hx hx (of_ends _ _) },
    { rw h at hp, exact (set.not_mem_empty _).elim hp }
end

@[simp]
theorem none_collinear_iff_empty_fixed_1'' (s : set α) (p : α) :
  (∀ q r ∈ s, ¬ collinear q r p) ↔ s = ∅ :=
begin
  refine ⟨λ h, set.eq_empty_iff_forall_not_mem.mpr $ λ _, _, λ h _ _ _ hp, _⟩,
    { intro hx, exact h _ _ hx hx (of_left _ _) },
    { rw h at hp, exact (set.not_mem_empty _).elim hp }
end

@[simp]
theorem none_collinear_iff_empty_fixed_2 (s : set α) (p q : α)
  (hq : q ∈ s) : (∀ r ∈ s, ¬ collinear p q r) ↔ s = ∅ :=
begin
  refine ⟨λ h, set.eq_empty_iff_forall_not_mem.mpr $ λ _, _, λ h _ hp, _⟩,
    { intro hx, exact h _ hq (of_right _ _) },
    { rw h at hp, exact (set.not_mem_empty _).elim hp }
end

@[simp]
theorem none_collinear_iff_empty_fixed_2' (s : set α) (p q : α)
  (hq : q ∈ s) : (∀ r ∈ s, ¬ collinear p r q) ↔ s = ∅ :=
begin
  refine ⟨λ h, set.eq_empty_iff_forall_not_mem.mpr $ λ _, _, λ h _ hp, _⟩,
    { intro hx, exact h _ hq (of_right _ _) },
    { rw h at hp, exact (set.not_mem_empty _).elim hp }
end

@[simp]
theorem none_collinear_iff_empty_fixed_2'' (s : set α) (p q : α)
  (hq : q ∈ s) : (∀ r ∈ s, ¬ collinear r p q) ↔ s = ∅ :=
begin
  refine ⟨λ h, set.eq_empty_iff_forall_not_mem.mpr $ λ _, _, λ h _ hp, _⟩,
    { intro hx, exact h _ hq (of_ends _ _) },
    { rw h at hp, exact (set.not_mem_empty _).elim hp }
end

end collinear
end