import group_theory.subgroup
import group_theory.coset
import data.fintype.card
import data.set.finite
import data.zmod.basic
import algebra.gcd_monoid
import basic
import tactic

open_locale classical big_operators
noncomputable theory

-- set_option profiler true

variables {p r n m: ℕ}-- [fact p.prime] [0 < n] [0 < m] [1 ≤ r]

def C2 (k : ℕ) : subgroup (units (zmod k)) :=
{
    carrier := {1, -1},
    one_mem' := by simp,
    mul_mem' := λ a b (ha : a ∈ {1, -1}) (hb : b ∈ {1, -1}), by finish,
    inv_mem' := λ a (ha : a ∈ {1, -1}), by finish,
}

lemma pr_eq_p_mul_pr1 (h : 1 ≤ r) : p^r = p * p^(r-1) :=
begin
    induction r with d hd,
    linarith,
    refl,
end

lemma zero_iff_n_divides (x : zmod n) (h : 0 < n) : x = 0 ↔ n  ∣ x.val :=
begin
    split,
    {
        intro h,
        finish,
    },
    {
        intro h,
        cases h with w hw,
        suffices : w = 0, by finish,
        {
            haveI : fact(0 < n) := {out := h},
            have H : x.val < n := zmod.val_lt x,
            rw hw at H,
            suffices : w < 1, by linarith,
            exact (mul_lt_iff_lt_one_right h).mp H,
        }
    }
end

lemma zero_iff_n_divides' (x : ℤ) : (x : zmod n) = 0 ↔ (n : ℤ) ∣ x := char_p.int_cast_eq_zero_iff (zmod n) n x

lemma eq_iff_n_divides' {x y : ℤ} (hp: p.prime) : (x : zmod (p^r)) = y ↔ (p^r : ℤ) ∣ x - y :=
begin
    haveI hp_prime : p.prime := by assumption,
    have p_pos : 0 < p := nat.prime.pos hp_prime,
    haveI pr_pos : 0 < p^r := pow_pos (nat.prime.pos hp_prime) r,

    split,
    {
        intro h,
        have h' : (((x - y) : ℤ) : zmod (p^r)) = 0,
        {
            rw← sub_eq_zero at h,
            finish,
        },
        apply_mod_cast (char_p.int_cast_eq_zero_iff (zmod (p^r)) (p^r) (x-y)).mp h',
    },
    {
        intro h,
        suffices : (((x - y) : ℤ) : zmod (p^r)) = 0,
        {
            rw←  sub_eq_zero,
            finish,
        },
        replace h : ((p^r : ℕ) : ℤ) ∣ (x - y),
        {
            finish,
        },
        exact_mod_cast (char_p.int_cast_eq_zero_iff (zmod (p^r)) (p^r) (x-y)).mpr h,
    }
end

lemma coerce_down (x y: zmod (p^r)) (h : x = y) : (x : zmod p) = (y : zmod p) :=
    by exact congr_arg coe h

lemma int.prime_dvd_mul {p : ℕ} {a b : ℤ} (hp : p.prime) (h: (p : ℤ) ∣ a * b) : (p : ℤ) ∣ a ∨ (p : ℤ) ∣ b :=
begin
    obtain ⟨a1, ha1⟩ := int.eq_coe_or_neg a,
    obtain ⟨b1, hb1⟩ := int.eq_coe_or_neg b,
    cases ha1;
    {   subst ha1,
        cases hb1;
        {
            subst hb1,
            replace h : (p : ℤ) ∣ a1 * b1, by finish,
            repeat {rw dvd_neg},
            rw [←int.coe_nat_mul, int.coe_nat_dvd]  at h,
            repeat {rw int.coe_nat_dvd},
            exact (nat.prime.dvd_mul hp).mp h,
        } }
end

lemma key_lemma (x : ℤ) (h : (x : zmod (p^r))^2 = 1) (hr : 1 ≤ r) (hp : p.prime) : (x : zmod p) = 1 ∨ (x : zmod p) = -1 :=
begin
    rw ←sub_eq_zero at h,
    rw_mod_cast zmod.int_coe_zmod_eq_zero_iff_dvd at h,
    have h_p_dvd : (p : ℤ) ∣ (x - 1) * (x + 1),
    {
        obtain ⟨w, hw⟩ := h,
        ring_nf,
        rw hw,
        refine dvd_mul_of_dvd_left _ w,
        casesI r,
        exact absurd nat.one_pos (not_lt_of_le hr),
        {
            use p^r,
            exact int.coe_nat_pow p (r + 1),
        }
    },
    have h3 := int.prime_dvd_mul hp h_p_dvd,
    simpa [←zmod.int_coe_zmod_eq_zero_iff_dvd, ←sub_eq_zero]  using h3,

end

lemma part1 {x ε : ℤ} (hprime : p.prime) (one_le_r : 1 ≤ r)
    (h : (x : zmod (p^r))^2 = 1) (h_odd : 2 < p) (h_eps : ε = 1 ∨ ε = -1) :
    (x : zmod p) = ε → (p^r : ℤ) ∣ (x-ε) :=
begin
    haveI p_ne_zero : (p : ℤ) ≠ 0 :=
        by exact_mod_cast nat.prime.ne_zero hprime,
    haveI p_pos : 0 < p := nat.prime.pos hprime,
    haveI pr_pos : 0 < p^r := pow_pos p_pos r,
    have h_prdiv : (p^r : ℤ) ∣ (x^2 - 1),
    {
        rw ←eq_iff_n_divides' hprime,
        exact_mod_cast h,
    },
    have h_fact : (p^r : ℤ) = p * p^(r-1),
        by exact_mod_cast pr_eq_p_mul_pr1 one_le_r,
    obtain ⟨ f, hf ⟩ := h_prdiv,
    intro hp,
    replace hp : ((x - ε :ℤ) : zmod p) = 0, by exact_mod_cast sub_eq_zero.mpr hp,
    rw zero_iff_n_divides' at hp,
    cases hp with e he,
    suffices : (p^(r-1) : ℤ) ∣ e,
    {
        cases this with f hf,
        use f,
        rw [he, hf, ←mul_assoc, ←h_fact],
    },
    have hcalc :=
        calc
        (p : ℤ) * (p ^ (r-1) * f) = p^r * f : by rw [←mul_assoc, h_fact]
        ...    = x^2 - 1 : by rw hf
        ...    = x^2 - ε^2 :
        begin
          rcases h_eps with rfl | rfl;
          simp,
        end
        ...    = (x-ε)^2 + 2*ε*(x-ε) : by ring
        ...    =  (p * e)^2 + 2 * ε * (p*e) : by rw he at *
        ...    = p * (2 * ε * e + p * e^2)  : by ring,
    rw mul_right_inj' p_ne_zero at hcalc,
    replace hcalc : (p^(r-1) : ℤ) ∣ 2 * ε * e + p * e^2 := dvd.intro f hcalc,
    rw [mul_comm, mul_comm (p : ℤ), pow_two, mul_assoc, ←mul_add e] at hcalc,
    have p_not_dvd_2pe : ¬ (p : ℤ) ∣ (2 * ε + e * p),
    {
        rintro ⟨ s, hs ⟩,
        have p_dvd_2 : (p : ℤ) ∣ 2,
        {
            use ε * (s-e),
            rw mul_sub,
            rcases h_eps with rfl | rfl;
            {
              simp at hs ⊢,
              rw mul_sub,
              rw ← hs,
              ring,
            },
        },
        replace p_dvd_2 := int.dvd_nat_abs_of_of_nat_dvd p_dvd_2,
        rw_mod_cast nat.prime_dvd_prime_iff_eq hprime nat.prime_two at p_dvd_2,
        rw p_dvd_2 at h_odd,
        exact nat.lt_asymm h_odd h_odd,
    },
    have h_coprime : (p^(r-1)).coprime (2 * ε + e * p).nat_abs,
    {
        suffices : p.coprime (2 * ε + e *p).nat_abs, from nat.coprime.pow_left (r - 1) this,
        refine (nat.prime.coprime_iff_not_dvd hprime).mpr _,
        intro hc,
        apply p_not_dvd_2pe,
        simpa [←int.coe_nat_dvd_left, mul_comm] using hc,
    },
    have pow_div_abs : p^(r-1) ∣ e.nat_abs,
    {
        apply nat.coprime.dvd_of_dvd_mul_right h_coprime,
        obtain ⟨s, hs⟩ := hcalc,
        use s.nat_abs,
        rw [←int.nat_abs_mul, hs, int.nat_abs_mul],
        norm_cast,
    },
    obtain ⟨ t, ht ⟩ := pow_div_abs,
    use (t * e.sign),
    replace ht : e.sign * abs e = p^(r-1) * (t * e.sign),
    {
        rw [int.abs_eq_nat_abs, ht],
        simp only [int.coe_nat_pow, int.coe_nat_mul],
        ring,
    },
    simpa [int.sign_mul_abs e] using ht,
end

lemma pr_dvd_xm1_or_xp1 (x : ℤ) (hprime : p.prime) (one_le_r : 1 ≤ r)
    (h : (x : zmod (p^r))^2 = 1) (h_odd : 2 < p) :
    (p^r : ℤ) ∣ (x - 1) ∨ (p^r : ℤ) ∣ (x + 1) :=
begin
    have : (x + 1) = x - (-1), by ring,
    refine (@@key_lemma x h one_le_r hprime).imp _ _;
    {
        intro H,
        try { rw this },
        apply @@part1 hprime one_le_r h h_odd,
        dec_trivial,
        exact_mod_cast H,
    },
end

lemma two_torsion_subgroup_of_primepow (hp : p.prime) (one_le_r : 1 ≤ r) (h_odd : 2 < p) :
    two_torsion_subgroup (units (zmod (p^r))) = C2 (p^r) :=
begin
    ext1 x,
    fconstructor,
    {
        intro hx,
        change x * x = 1 at hx,
        unfold C2 at ⊢,
        suffices h : x = 1 ∨ x = -1, by assumption,
        have e_lift : ∃ (x' : ℤ), (x' : zmod (p^r)) = x, by apply zmod.int_cast_surjective,
        cases e_lift with x' hx',
        have pr_dvd_xpm1 : (p^r : ℤ) ∣ (x' - 1) ∨ (p^r : ℤ) ∣ (x' + 1),
        {
            apply pr_dvd_xm1_or_xp1 x' hp one_le_r,
            {
                rw [hx', pow_two],
                injections_and_clear,
                assumption,
            },
            exact h_odd,
        },
        cases pr_dvd_xpm1,
        left,
        swap,
        right,
        all_goals
        {
            ext1,
            try {rw ←sub_neg_eq_add at pr_dvd_xpm1},
            rw ←eq_iff_n_divides' at pr_dvd_xpm1,
            rw [←hx', pr_dvd_xpm1],
            norm_num,
            exact hp,
        },
    },
    {
        intro hx,
        ext1,
        cases hx; finish,
    },
end


import order.bounded_lattice

theorem abs_le_abs {α : Type*} [decidable_linear_ordered_comm_group α] {a b : α}
  (h₀ : a ≤ b) (h₁ : -a ≤ b) :
  abs a ≤ abs b :=
calc  abs a
    ≤ b : by { apply abs_le_of_le_of_neg_le; assumption }
... ≤ abs b : le_abs_self _


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .cons fin.choice

lemma tup.choice {α : Type*} {n : ℕ} {p : fin n → α → Prop} :
(∀ i, ∃ x : α, p i x) → (∃ xs : α ^ n, ∀ i : fin n, p i xs[i]) :=
assume h,
have nonempty (Π i, { x : α // p i x }),
from fin.choice (λ i, exists.elim (h i) (λ x hx, nonempty.intro ⟨x, hx⟩)),
nonempty.elim this (λ z, ⟨λ i, (z i).val, λ i, (z i).property⟩)


import data.list
import data.stream

import util.classical

universe variables u

namespace stream

open nat

lemma map_app {α β} (f : α → β) (s : stream α) (i : ℕ)
: stream.map f s i = f (s i) := rfl

def sprefix {α} : ℕ → stream α → list α
  | 0 _ := []
  | (succ n) x := x 0 :: sprefix n (stream.tail x)

def sums (x : stream ℕ) : stream ℕ
  | 0 := 0
  | (succ n) := x n + sums n

def range : ℕ → list ℕ
  | 0 := []
  | (succ n) := n :: range n

def prepend {α} : list α → stream α → stream α
  | [] xs := xs
  | (list.cons x xs) ys := stream.cons x (prepend xs ys)

def coinduct {α β} (f : α → (β × α)) (x : α) : stream β
  := stream.corec (prod.fst ∘ f) (prod.snd ∘ f) x

def rounds.f : ℕ × ℕ → ℕ × ℕ × ℕ
  | (n, 0) := (0, succ n, succ n)
  | (n, succ p) := (succ p, n, p)

lemma stream.head_corec {α β} (f : α → α) (g : α → β) (x : α) :
  stream.head (stream.corec g f x) = g x :=
begin
  refl
end

section s

variables {α β : Type u} (f : α → α) (g : α → β) (x : α)
variables i : ℕ
variables s : stream α

lemma stream.nth_tail : stream.nth i (stream.tail s) = stream.nth (succ i) s := rfl

lemma stream.tail_corec :
  stream.tail (stream.corec g f x) = stream.corec g f (f x) :=
begin
  apply stream.ext, intro i,
  unfold stream.corec,
  rw [stream.map_iterate,stream.tail_map,stream.tail_iterate],
  rw [stream.map_iterate],
end

theorem head_drop : head (drop i s) = nth i s :=
begin
  change nth 0 (drop i s) = _,
  rw nth_drop 0 i s,
  simp
end

end s

universe variables u₀ u₁

variables {α : Type u₀}
variables {β : Type u₁}

def zip' (x : stream α) (y : stream β) : stream (α × β) :=
λ i, (x i, y i)

lemma fst_comp_zip' (x : stream α) (y : stream β)
: prod.fst ∘ zip' x y = x := rfl

lemma fst_zip' (x : stream α) (y : stream β) (i : ℕ)
: prod.fst (zip' x y i) = x i := rfl

lemma snd_zip' (x : stream α) (y : stream β) (i : ℕ)
: prod.snd (zip' x y i) = y i := rfl

lemma length_approx (i : ℕ) (s : stream α)
: list.length (approx i s) = i :=
begin
  revert s,
  induction i with i IH
  ; intro s,
  { refl },
  { simp [approx_succ,IH], }
end

lemma approx_succ_eq_append (i : ℕ) (s : stream α)
: approx (succ i) s = approx i s ++ [s i] :=
begin
  revert s,
  induction i with i IH
  ; intros s,
  { refl },
  { have H : tail s i = s (succ i), { refl },
    rw [approx_succ,IH,approx_succ,list.cons_append,H], }
end

lemma approx_succ_eq_concat (i : ℕ) (s : stream α)
: approx (succ i) s = list.concat (approx i s) (s i) :=
by rw [list.concat_eq_append,approx_succ_eq_append]

section next

parameter {p : ℕ → Prop}
parameter Hp : ∀ i, ∃ j, i ≤ j ∧ p j

noncomputable def solutions : stream ℕ
  | 0 := classical.some (Hp 0)
  | (succ n) := classical.some $ Hp $ succ $ solutions n

lemma solutions_spec (i : ℕ)
: p (solutions i) :=
begin
  cases i with i,
  { apply classical.some_spec',
    intro, apply and.right },
  { apply classical.some_spec',
    intro, apply and.right },
end
lemma solutions_increases {i j : ℕ}
  (H : i < j)
: solutions i < solutions j :=
begin
  rw ← add_sub_of_le H,
  clear H,
  generalize : (j - succ i) = k,
  clear j,
  rw [succ_add],
  induction k,
  case zero
  { dsimp [solutions], simp,
    apply_some_spec, },
  case succ : j
  { unfold solutions,
    apply classical.some_spec',
    intros x Hx,
    transitivity solutions Hp (succ (i + j)),
    { apply k_ih },
    { simp [stream.solutions], apply Hx.left } },
end

lemma solutions_injective
: function.injective solutions :=
begin
  intros i j H,
  apply classical.by_contradiction,
  intros H',
  revert H,
  apply (@ne_iff_lt_or_gt ℕ _ _ _).mpr,
  cases (@ne_iff_lt_or_gt ℕ _ _ _).mp H' with H₁ H₁,
  { left, apply solutions_increases _ H₁, },
  { right, apply solutions_increases _ H₁, },
end

end next

end stream


/-
Copyright (c) 2021 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import algebra.continued_fractions.computation.approximations
import algebra.continued_fractions.convergents_equiv
import algebra.order.archimedean
import topology.algebra.ordered.basic
/-!
# Corollaries From Approximation Lemmas (`algebra.continued_fractions.computation.approximations`)

## Summary

We show that the generalized_continued_fraction given by `generalized_continued_fraction.of` in fact
is a (regular) continued fraction. Using the equivalence of the convergents computations
(`generalized_continued_fraction.convergents` and `generalized_continued_fraction.convergents'`) for
continued fractions (see `algebra.continued_fractions.convergents_equiv`), it follows that the
convergents computations for `generalized_continued_fraction.of` are equivalent.

Moreover, we show the convergence of the continued fractions computations, that is
`(generalized_continued_fraction.of v).convergents` indeed computes `v` in the limit.

## Main Definitions

- `continued_fraction.of` returns the (regular) continued fraction of a value.

## Main Theorems

- `generalized_continued_fraction.of_convergents_eq_convergents'` shows that the convergents
  computations for `generalized_continued_fraction.of` are equivalent.
- `generalized_continued_fraction.of_convergence` shows that
  `(generalized_continued_fraction.of v).convergents` converges to `v`.

## Tags

convergence, fractions
-/

variables {K : Type*} (v : K) [linear_ordered_field K] [floor_ring K]

open generalized_continued_fraction (of)
open generalized_continued_fraction

lemma generalized_continued_fraction.of_is_simple_continued_fraction :
  (of v).is_simple_continued_fraction :=
(λ _ _ nth_part_num_eq, of_part_num_eq_one nth_part_num_eq)

/-- Creates the simple continued fraction of a value. -/
def simple_continued_fraction.of : simple_continued_fraction K :=
⟨of v, generalized_continued_fraction.of_is_simple_continued_fraction v⟩

lemma simple_continued_fraction.of_is_continued_fraction :
  (simple_continued_fraction.of v).is_continued_fraction :=
(λ _ denom nth_part_denom_eq, lt_of_lt_of_le zero_lt_one
  (of_one_le_nth_part_denom nth_part_denom_eq))

/-- Creates the continued fraction of a value. -/
def continued_fraction.of : continued_fraction K :=
⟨simple_continued_fraction.of v, simple_continued_fraction.of_is_continued_fraction v⟩

namespace generalized_continued_fraction

lemma of_convergents_eq_convergents' :
  (of v).convergents = (of v).convergents' :=
@continued_fraction.convergents_eq_convergents'  _ _ (continued_fraction.of v)

section convergence
/-!
### Convergence

We next show that `(generalized_continued_fraction.of v).convergents v` converges to `v`.
-/

variable [archimedean K]
open nat

theorem of_convergence_epsilon :
  ∀ (ε > (0 : K)), ∃ (N : ℕ), ∀ (n ≥ N), |v - (of v).convergents n| < ε :=
begin
  assume ε ε_pos,
  -- use the archimedean property to obtian a suitable N
  rcases (exists_nat_gt (1 / ε) : ∃ (N' : ℕ), 1 / ε < N') with ⟨N', one_div_ε_lt_N'⟩,
  let N := max N' 5, -- set minimum to 5 to have N ≤ fib N work
  existsi N,
  assume n n_ge_N,
  let g := of v,
  cases decidable.em (g.terminated_at n) with terminated_at_n not_terminated_at_n,
  { have : v = g.convergents n, from of_correctness_of_terminated_at terminated_at_n,
    have : v - g.convergents n = 0, from sub_eq_zero.elim_right this,
    rw [this],
    exact_mod_cast ε_pos },
  { let B := g.denominators n,
    let nB := g.denominators (n + 1),
    have abs_v_sub_conv_le : |v - g.convergents n| ≤ 1 / (B * nB), from
      abs_sub_convergents_le not_terminated_at_n,
    suffices : 1 / (B * nB) < ε, from lt_of_le_of_lt abs_v_sub_conv_le this,
    -- show that `0 < (B * nB)` and then multiply by `B * nB` to get rid of the division
    have nB_ineq : (fib (n + 2) : K) ≤ nB, by
    { have : ¬g.terminated_at (n + 1 - 1), from not_terminated_at_n,
      exact (succ_nth_fib_le_of_nth_denom (or.inr this)) },
    have B_ineq : (fib (n + 1) : K) ≤ B, by
    { have : ¬g.terminated_at (n - 1), from mt (terminated_stable n.pred_le) not_terminated_at_n,
      exact (succ_nth_fib_le_of_nth_denom (or.inr this)) },
    have zero_lt_B : 0 < B, by
    { have : (0 : K) < fib (n + 1), by exact_mod_cast fib_pos n.zero_lt_succ,
      exact (lt_of_lt_of_le this B_ineq) },
    have zero_lt_mul_conts : 0 < B * nB, by
    { have : 0 < nB, by
      { have : (0 : K) < fib (n + 2), by exact_mod_cast fib_pos (n + 1).zero_lt_succ,
        exact (lt_of_lt_of_le this nB_ineq) },
      solve_by_elim [mul_pos] },
    suffices : 1 < ε * (B * nB), from (div_lt_iff zero_lt_mul_conts).elim_right this,
    -- use that `N ≥ n` was obtained from the archimedean property to show the following
    have one_lt_ε_mul_N : 1 < ε * n, by
    { have one_lt_ε_mul_N' : 1 < ε * (N' : K), from (div_lt_iff' ε_pos).elim_left one_div_ε_lt_N',
      have : (N' : K) ≤ N, by exact_mod_cast (le_max_left  _ _),
      have : ε * N' ≤ ε * n, from
        (mul_le_mul_left ε_pos).elim_right (le_trans this (by exact_mod_cast n_ge_N)),
      exact (lt_of_lt_of_le one_lt_ε_mul_N' this) },
    suffices : ε * n ≤ ε * (B * nB), from lt_of_lt_of_le one_lt_ε_mul_N this,
    -- cancel `ε`
    suffices : (n : K) ≤ B * nB, from (mul_le_mul_left ε_pos).elim_right this,
    show (n : K) ≤ B * nB,
      calc (n : K)
          ≤ fib n                     : by exact_mod_cast (le_fib_self $ le_trans
                                           (le_max_right N' 5) n_ge_N)
      ... ≤ fib (n + 1)               : by exact_mod_cast fib_le_fib_succ
      ... ≤ fib (n + 1) * fib (n + 1) : by exact_mod_cast ((fib (n + 1)).le_mul_self)
      ... ≤ fib (n + 1) * fib (n + 2) : mul_le_mul_of_nonneg_left
                                          (by exact_mod_cast fib_le_fib_succ)
                                          (by exact_mod_cast (fib (n + 1)).zero_le)
      ... ≤ B * nB                    : mul_le_mul B_ineq nB_ineq
                                          (by exact_mod_cast (fib (n + 2)).zero_le)
                                          (le_of_lt zero_lt_B) }
end

local attribute [instance] preorder.topology

theorem of_convergence [order_topology K] :
  filter.tendsto ((of v).convergents) filter.at_top $ nhds v :=
by simpa [linear_ordered_add_comm_group.tendsto_nhds, abs_sub_comm] using (of_convergence_epsilon v)

end convergence

end generalized_continued_fraction


import Std.Data.Int.Lemmas
import Std.Data.Rat.Basic

/-! # Additional lemmas about the Rational Numbers -/

namespace Rat

@[simp] theorem maybeNormalize_eq {num den g} (den_nz reduced) :
    maybeNormalize num den g den_nz reduced =
    { num := num.div g, den := den / g, den_nz, reduced } := by
  unfold maybeNormalize; split
  · subst g; simp
  · rfl

theorem normalize.reduced' {num : Int} {den g : Nat} (den_nz : den ≠ 0)
    (e : g = num.natAbs.gcd den) : (num / g).natAbs.coprime (den / g) := by
  rw [← Int.div_eq_ediv_of_dvd (e ▸ Int.ofNat_dvd_left.2 (Nat.gcd_dvd_left ..))]
  exact normalize.reduced den_nz e

theorem normalize_eq {num den} (den_nz) : normalize num den den_nz =
    { num := num / num.natAbs.gcd den
      den := den / num.natAbs.gcd den
      den_nz := normalize.den_nz den_nz rfl
      reduced := normalize.reduced' den_nz rfl } := by
  simp only [normalize, maybeNormalize_eq,
    Int.div_eq_ediv_of_dvd (Int.ofNat_dvd_left.2 (Nat.gcd_dvd_left ..))]

@[simp] theorem normalize_zero (nz) : normalize 0 d nz = 0 := by
  simp [normalize, Int.zero_div, Int.natAbs_zero, Nat.div_self (Nat.pos_of_ne_zero nz)]; rfl

theorem mk_eq_normalize (num den nz c) : ⟨num, den, nz, c⟩ = normalize num den nz := by
  simp [normalize_eq, c.gcd_eq_one]

theorem normalize_self (r : Rat) : normalize r.num r.den r.den_nz = r := (mk_eq_normalize ..).symm

theorem normalize_mul_left {a : Nat} (d0 : d ≠ 0) (a0 : a ≠ 0) :
    normalize (↑a * n) (a * d) (Nat.mul_ne_zero a0 d0) = normalize n d d0 := by
  simp [normalize_eq, mk'.injEq, Int.natAbs_mul, Nat.gcd_mul_left,
    Nat.mul_div_mul_left _ _ (Nat.pos_of_ne_zero a0), Int.ofNat_mul,
    Int.mul_ediv_mul_of_pos _ _ (Int.ofNat_pos.2 <| Nat.pos_of_ne_zero a0)]

theorem normalize_mul_right {a : Nat} (d0 : d ≠ 0) (a0 : a ≠ 0) :
    normalize (n * a) (d * a) (Nat.mul_ne_zero d0 a0) = normalize n d d0 := by
  rw [← normalize_mul_left (d0 := d0) a0]; congr 1 <;> [apply Int.mul_comm, apply Nat.mul_comm]

theorem normalize_eq_iff (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) :
    normalize n₁ d₁ z₁ = normalize n₂ d₂ z₂ ↔ n₁ * d₂ = n₂ * d₁ := by
  constructor <;> intro h
  · simp only [normalize_eq, mk'.injEq] at h
    have' hn₁ := Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left n₁.natAbs d₁
    have' hn₂ := Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left n₂.natAbs d₂
    have' hd₁ := Int.ofNat_dvd.2 <| Nat.gcd_dvd_right n₁.natAbs d₁
    have' hd₂ := Int.ofNat_dvd.2 <| Nat.gcd_dvd_right n₂.natAbs d₂
    rw [← Int.ediv_mul_cancel (Int.dvd_trans hd₂ (Int.dvd_mul_left ..)),
      Int.mul_ediv_assoc _ hd₂, ← Int.ofNat_ediv, ← h.2, Int.ofNat_ediv,
      ← Int.mul_ediv_assoc _ hd₁, Int.mul_ediv_assoc' _ hn₁,
      Int.mul_right_comm, h.1, Int.ediv_mul_cancel hn₂]
  · rw [← normalize_mul_right _ z₂, ← normalize_mul_left z₂ z₁, Int.mul_comm d₁, h]

theorem maybeNormalize_eq_normalize {num : Int} {den g : Nat} (den_nz reduced)
    (hn : ↑g ∣ num) (hd : g ∣ den) :
    maybeNormalize num den g den_nz reduced = normalize num den (mt (by simp [·]) den_nz) := by
  simp only [maybeNormalize_eq, mk_eq_normalize, Int.div_eq_ediv_of_dvd hn]
  have : g ≠ 0 := mt (by simp [·]) den_nz
  rw [← normalize_mul_right _ this, Int.ediv_mul_cancel hn]
  congr 1; exact Nat.div_mul_cancel hd

@[simp] theorem normalize_eq_zero (d0 : d ≠ 0) : normalize n d d0 = 0 ↔ n = 0 := by
  have' := normalize_eq_iff d0 Nat.one_ne_zero
  rw [normalize_zero (d := 1)] at this; rw [this]; simp

theorem normalize_num_den' (num den nz) : ∃ d : Nat, d ≠ 0 ∧
    num = (normalize num den nz).num * d ∧ den = (normalize num den nz).den * d := by
  refine ⟨num.natAbs.gcd den, Nat.gcd_ne_zero_right nz, ?_⟩
  simp [normalize_eq, Int.ediv_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..),
    Nat.div_mul_cancel (Nat.gcd_dvd_right ..)]

theorem normalize_num_den (h : normalize n d z = ⟨n', d', z', c⟩) :
    ∃ m : Nat, m ≠ 0 ∧ n = n' * m ∧ d = d' * m := by
  have := normalize_num_den' n d z; rwa [h] at this

theorem normalize_eq_mkRat {num den} (den_nz) : normalize num den den_nz = mkRat num den := by
  simp [mkRat, den_nz]

theorem mkRat_num_den (z : d ≠ 0) (h : mkRat n d = ⟨n', d', z', c⟩) :
    ∃ m : Nat, m ≠ 0 ∧ n = n' * m ∧ d = d' * m :=
  normalize_num_den ((normalize_eq_mkRat z).symm ▸ h)

theorem mkRat_def (n d) : mkRat n d = if d0 : d = 0 then 0 else normalize n d d0 := rfl

theorem mkRat_self (a : Rat) : mkRat a.num a.den = a := by
  rw [← normalize_eq_mkRat a.den_nz, normalize_self]

theorem mk_eq_mkRat (num den nz c) : ⟨num, den, nz, c⟩ = mkRat num den := by
  simp [mk_eq_normalize, normalize_eq_mkRat]

@[simp] theorem zero_mkRat (n) : mkRat 0 n = 0 := by simp [mkRat_def]; apply ite_self

@[simp] theorem mkRat_zero (n) : mkRat n 0 = 0 := by simp [mkRat_def]

theorem mkRat_eq_zero (d0 : d ≠ 0) : mkRat n d = 0 ↔ n = 0 := by simp [mkRat_def, d0]

theorem mkRat_ne_zero (d0 : d ≠ 0) : mkRat n d ≠ 0 ↔ n ≠ 0 := not_congr (mkRat_eq_zero d0)

theorem mkRat_mul_left {a : Nat} (a0 : a ≠ 0) : mkRat (↑a * n) (a * d) = mkRat n d := by
  if d0 : d = 0 then simp [d0] else
  rw [← normalize_eq_mkRat d0, ← normalize_mul_left d0 a0, normalize_eq_mkRat]

theorem mkRat_mul_right {a : Nat} (a0 : a ≠ 0) : mkRat (n * a) (d * a) = mkRat n d := by
  rw [← mkRat_mul_left (d := d) a0]; congr 1 <;> [apply Int.mul_comm, apply Nat.mul_comm]

theorem mkRat_eq_iff (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) :
    mkRat n₁ d₁ = mkRat n₂ d₂ ↔ n₁ * d₂ = n₂ * d₁ := by
  rw [← normalize_eq_mkRat z₁, ← normalize_eq_mkRat z₂, normalize_eq_iff]

@[simp] theorem divInt_ofNat (num den) : num /. (den : Nat) = mkRat num den := by
  simp [divInt, normalize_eq_mkRat]

theorem mk_eq_divInt (num den nz c) : ⟨num, den, nz, c⟩ = num /. (den : Nat) := by
  simp [mk_eq_mkRat]

theorem divInt_self (a : Rat) : a.num /. a.den = a := by rw [divInt_ofNat, mkRat_self]

@[simp] theorem zero_divInt (n) : 0 /. n = 0 := by cases n <;> simp [divInt]

@[simp] theorem divInt_zero (n) : n /. 0 = 0 := mkRat_zero n

theorem neg_divInt_neg (num den) : -num /. -den = num /. den := by
  match den with
  | Nat.succ n => simp [divInt, Int.neg_ofNat_succ, normalize_eq_mkRat, Int.neg_neg]
  | 0 => rfl
  | Int.negSucc n => simp [divInt, Int.neg_negSucc, normalize_eq_mkRat, Int.neg_neg]

theorem divInt_neg' (num den) : num /. -den = -num /. den := by rw [← neg_divInt_neg, Int.neg_neg]

theorem divInt_eq_iff (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) :
    n₁ /. d₁ = n₂ /. d₂ ↔ n₁ * d₂ = n₂ * d₁ := by
  rcases Int.eq_nat_or_neg d₁ with ⟨_, rfl | rfl⟩ <;>
  rcases Int.eq_nat_or_neg d₂ with ⟨_, rfl | rfl⟩ <;>
  simp_all [divInt_neg', Int.ofNat_eq_zero, Int.neg_eq_zero,
    mkRat_eq_iff, Int.neg_mul, Int.mul_neg, Int.eq_neg_comm, eq_comm]

theorem divInt_mul_left {a : Int} (a0 : a ≠ 0) : (a * n) /. (a * d) = n /. d := by
  if d0 : d = 0 then simp [d0] else
  simp [divInt_eq_iff (Int.mul_ne_zero a0 d0) d0, Int.mul_assoc, Int.mul_left_comm]

theorem divInt_mul_right {a : Int} (a0 : a ≠ 0) : (n * a) /. (d * a) = n /. d := by
  simp [← divInt_mul_left (d := d) a0, Int.mul_comm]

theorem divInt_num_den (z : d ≠ 0) (h : n /. d = ⟨n', d', z', c⟩) :
    ∃ m, m ≠ 0 ∧ n = n' * m ∧ d = d' * m := by
  rcases Int.eq_nat_or_neg d with ⟨_, rfl | rfl⟩ <;>
    simp_all [divInt_neg', Int.ofNat_eq_zero, Int.neg_eq_zero]
  · have ⟨m, h₁, h₂⟩ := mkRat_num_den z h; exists m
    simp [Int.ofNat_eq_zero, Int.ofNat_mul, h₁, h₂]
  · have ⟨m, h₁, h₂⟩ := mkRat_num_den z h; exists -m
    rw [← Int.neg_inj, Int.neg_neg] at h₂
    simp [Int.ofNat_eq_zero, Int.ofNat_mul, h₁, h₂, Int.mul_neg, Int.neg_eq_zero]

@[simp] theorem ofInt_ofNat : ofInt (OfNat.ofNat n) = OfNat.ofNat n := rfl

@[simp] theorem ofInt_num : (ofInt n : Rat).num = n := rfl
@[simp] theorem ofInt_den : (ofInt n : Rat).den = 1 := rfl

@[simp] theorem ofNat_num : (OfNat.ofNat n : Rat).num = OfNat.ofNat n := rfl
@[simp] theorem ofNat_den : (OfNat.ofNat n : Rat).den = 1 := rfl

theorem add_def (a b : Rat) :
    a + b = normalize (a.num * b.den + b.num * a.den) (a.den * b.den)
      (Nat.mul_ne_zero a.den_nz b.den_nz) := by
  show Rat.add .. = _; delta Rat.add; dsimp only; split
  · exact (normalize_self _).symm
  · have : a.den.gcd b.den ≠ 0 := Nat.gcd_ne_zero_left a.den_nz
    rw [maybeNormalize_eq_normalize _ _
        (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..)
        (Nat.dvd_trans (Nat.gcd_dvd_right ..) <|
         Nat.dvd_trans (Nat.gcd_dvd_right ..) (Nat.dvd_mul_left ..)),
      ← normalize_mul_right _ this]; congr 1
    · simp only [Int.add_mul, Int.mul_assoc, Int.ofNat_mul_ofNat,
        Nat.div_mul_cancel (Nat.gcd_dvd_left ..), Nat.div_mul_cancel (Nat.gcd_dvd_right ..)]
    · rw [Nat.mul_right_comm, Nat.div_mul_cancel (Nat.gcd_dvd_left ..)]

theorem add_def' (a b : Rat) : a + b = mkRat (a.num * b.den + b.num * a.den) (a.den * b.den) := by
  rw [add_def, normalize_eq_mkRat]

theorem normalize_add_normalize (n₁ n₂) {d₁ d₂} (z₁ z₂) :
    normalize n₁ d₁ z₁ + normalize n₂ d₂ z₂ =
    normalize (n₁ * d₂ + n₂ * d₁) (d₁ * d₂) (Nat.mul_ne_zero z₁ z₂) := by
  cases e₁ : normalize n₁ d₁ z₁; rcases normalize_num_den e₁ with ⟨g₁, zg₁, rfl, rfl⟩
  cases e₂ : normalize n₂ d₂ z₂; rcases normalize_num_den e₂ with ⟨g₂, zg₂, rfl, rfl⟩
  simp only [add_def]; rw [← normalize_mul_right _ (Nat.mul_ne_zero zg₁ zg₂)]; congr 1
  · rw [Int.add_mul]; simp [Int.ofNat_mul, Int.mul_assoc, Int.mul_left_comm, Int.mul_comm]
  · simp [Nat.mul_left_comm, Nat.mul_comm]

theorem mkRat_add_mkRat (n₁ n₂ : Int) {d₁ d₂} (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) :
    mkRat n₁ d₁ + mkRat n₂ d₂ = mkRat (n₁ * d₂ + n₂ * d₁) (d₁ * d₂) := by
  rw [← normalize_eq_mkRat z₁, ← normalize_eq_mkRat z₂, normalize_add_normalize, normalize_eq_mkRat]

theorem divInt_add_divInt (n₁ n₂ : Int) {d₁ d₂} (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) :
    n₁ /. d₁ + n₂ /. d₂ = (n₁ * d₂ + n₂ * d₁) /. (d₁ * d₂) := by
  rcases Int.eq_nat_or_neg d₁ with ⟨_, rfl | rfl⟩ <;>
  rcases Int.eq_nat_or_neg d₂ with ⟨_, rfl | rfl⟩ <;>
  simp_all [Int.ofNat_eq_zero, Int.neg_eq_zero, divInt_neg', Int.mul_neg,
    Int.ofNat_mul_ofNat, Int.neg_add, Int.neg_mul, mkRat_add_mkRat]

@[simp] theorem neg_num (a : Rat) : (-a).num = -a.num := rfl
@[simp] theorem neg_den (a : Rat) : (-a).den = a.den := rfl

theorem neg_normalize (n d z) : -normalize n d z = normalize (-n) d z := by
  simp [normalize, maybeNormalize_eq]; ext <;> simp [Int.neg_div]

theorem neg_mkRat (n d) : -mkRat n d = mkRat (-n) d := by
  if z : d = 0 then simp [z] else simp [← normalize_eq_mkRat z, neg_normalize]

theorem neg_divInt (n d) : -(n /. d) = -n /. d := by
  rcases Int.eq_nat_or_neg d with ⟨_, rfl | rfl⟩ <;> simp [divInt_neg', neg_mkRat]

theorem sub_def (a b : Rat) :
    a - b = normalize (a.num * b.den - b.num * a.den) (a.den * b.den)
      (Nat.mul_ne_zero a.den_nz b.den_nz) := by
  show Rat.sub .. = _; delta Rat.sub; dsimp only; split
  · exact (normalize_self _).symm
  · have : a.den.gcd b.den ≠ 0 := Nat.gcd_ne_zero_left a.den_nz
    rw [maybeNormalize_eq_normalize _ _
        (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..)
        (Nat.dvd_trans (Nat.gcd_dvd_right ..) <|
         Nat.dvd_trans (Nat.gcd_dvd_right ..) (Nat.dvd_mul_left ..)),
      ← normalize_mul_right _ this]; congr 1
    · simp only [Int.sub_mul, Int.mul_assoc, Int.ofNat_mul_ofNat,
        Nat.div_mul_cancel (Nat.gcd_dvd_left ..), Nat.div_mul_cancel (Nat.gcd_dvd_right ..)]
    · rw [Nat.mul_right_comm, Nat.div_mul_cancel (Nat.gcd_dvd_left ..)]

theorem sub_def' (a b : Rat) : a - b = mkRat (a.num * b.den - b.num * a.den) (a.den * b.den) := by
  rw [sub_def, normalize_eq_mkRat]

protected theorem sub_eq_add_neg (a b : Rat) : a - b = a + -b := by
  simp [add_def, sub_def, Int.neg_mul, Int.sub_eq_add_neg]

theorem divInt_sub_divInt (n₁ n₂ : Int) {d₁ d₂} (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) :
    n₁ /. d₁ - n₂ /. d₂ = (n₁ * d₂ - n₂ * d₁) /. (d₁ * d₂) := by
  simp only [Rat.sub_eq_add_neg, neg_divInt,
    divInt_add_divInt _ _ z₁ z₂, Int.neg_mul, Int.sub_eq_add_neg]

theorem mul_def (a b : Rat) :
    a * b = normalize (a.num * b.num) (a.den * b.den) (Nat.mul_ne_zero a.den_nz b.den_nz) := by
  show Rat.mul .. = _; delta Rat.mul; dsimp only
  have H1 : a.num.natAbs.gcd b.den ≠ 0 := Nat.gcd_ne_zero_right b.den_nz
  have H2 : b.num.natAbs.gcd a.den ≠ 0 := Nat.gcd_ne_zero_right a.den_nz
  rw [mk_eq_normalize, ← normalize_mul_right _ (Nat.mul_ne_zero H1 H2)]; congr 1
  · rw [Int.ofNat_mul, ← Int.mul_assoc, Int.mul_right_comm (Int.div ..),
      Int.div_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..), Int.mul_assoc,
      Int.div_mul_cancel (Int.ofNat_dvd_left.2 <| Nat.gcd_dvd_left ..)]
  · rw [← Nat.mul_assoc, Nat.mul_right_comm, Nat.mul_right_comm (_/_),
      Nat.div_mul_cancel (Nat.gcd_dvd_right ..), Nat.mul_assoc,
      Nat.div_mul_cancel (Nat.gcd_dvd_right ..)]

protected

@[simp] protected theorem zero_mul (a : Rat) : 0 * a = 0 := by simp [mul_def]
@[simp] protected theorem mul_zero (a : Rat) : a * 0 = 0 := by simp [mul_def]
@[simp] protected theorem one_mul (a : Rat) : 1 * a = a := by simp [mul_def, normalize_self]
@[simp] protected theorem mul_one (a : Rat) : a * 1 = a := by simp [mul_def, normalize_self]

theorem normalize_mul_normalize (n₁ n₂) {d₁ d₂} (z₁ z₂) :
    normalize n₁ d₁ z₁ * normalize n₂ d₂ z₂ =
    normalize (n₁ * n₂) (d₁ * d₂) (Nat.mul_ne_zero z₁ z₂) := by
  cases e₁ : normalize n₁ d₁ z₁; rcases normalize_num_den e₁ with ⟨g₁, zg₁, rfl, rfl⟩
  cases e₂ : normalize n₂ d₂ z₂; rcases normalize_num_den e₂ with ⟨g₂, zg₂, rfl, rfl⟩
  simp only [mul_def]; rw [← normalize_mul_right _ (Nat.mul_ne_zero zg₁ zg₂)]; congr 1
  · simp [Int.ofNat_mul, Int.mul_assoc, Int.mul_left_comm]
  · simp [Nat.mul_left_comm, Nat.mul_comm]

theorem mkRat_mul_mkRat (n₁ n₂ : Int) (d₁ d₂) :
    mkRat n₁ d₁ * mkRat n₂ d₂ = mkRat (n₁ * n₂) (d₁ * d₂) := by
  if z₁ : d₁ = 0 then simp [z₁] else if z₂ : d₂ = 0 then simp [z₂] else
  rw [← normalize_eq_mkRat z₁, ← normalize_eq_mkRat z₂, normalize_mul_normalize, normalize_eq_mkRat]

theorem divInt_mul_divInt (n₁ n₂ : Int) {d₁ d₂} (z₁ : d₁ ≠ 0) (z₂ : d₂ ≠ 0) :
    (n₁ /. d₁) * (n₂ /. d₂) = (n₁ * n₂) /. (d₁ * d₂) := by
  rcases Int.eq_nat_or_neg d₁ with ⟨_, rfl | rfl⟩ <;>
  rcases Int.eq_nat_or_neg d₂ with ⟨_, rfl | rfl⟩ <;>
  simp_all [divInt_neg', Int.mul_neg, Int.ofNat_mul_ofNat,  Int.neg_mul, mkRat_mul_mkRat]

theorem inv_def (a : Rat) : a.inv = a.den /. a.num := by
  unfold Rat.inv; split
  · next h => rw [mk_eq_divInt, ← Int.natAbs_neg,
      Int.natAbs_of_nonneg (Int.le_of_lt <| Int.neg_pos_of_neg h), neg_divInt_neg]
  split
  · next h => rw [mk_eq_divInt, Int.natAbs_of_nonneg (Int.le_of_lt h)]
  · next h₁ h₂ =>
    apply (divInt_self _).symm.trans
    simp [Int.le_antisymm (Int.not_lt.1 h₂) (Int.not_lt.1 h₁)]

@[simp] theorem inv_divInt (n d : Int) : (n /. d).inv = d /. n := by
  if z : d = 0 then simp [z] else
  cases e : n /. d; rcases divInt_num_den z e with ⟨g, zg, rfl, rfl⟩
  simp [inv_def, divInt_mul_right zg]

theorem div_def (a b : Rat) : a / b = a * b.inv := rfl

theorem ofScientific_true_def : Rat.ofScientific m true e = mkRat m (10 ^ e) := by
  unfold Rat.ofScientific; rw [normalize_eq_mkRat]; rfl

theorem ofScientific_false_def : Rat.ofScientific m false e = (m * 10 ^ e : Nat) := by
  unfold Rat.ofScientific; rfl

theorem ofScientific_def : Rat.ofScientific m s e =
    if s then mkRat m (10 ^ e) else (m * 10 ^ e : Nat) := by
  cases s; exact ofScientific_false_def; exact ofScientific_true_def


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis, Leonardo de Moura, Mario Carneiro, Floris van Doorn
-/
import algebra.field.basic
import algebra.group_power.order
import algebra.order.ring
import order.bounds
import tactic.monotonicity.basic

/-!
# Linear ordered fields

A linear ordered field is a field equipped with a linear order such that
* addition respects the order: `a ≤ b → c + a ≤ c + b`;
* multiplication of positives is positive: `0 < a → 0 < b → 0 < a * b`;
* `0 < 1`.

## Main Definitions

* `linear_ordered_field`: the class of linear ordered fields.
-/

set_option old_structure_cmd true

variable {α : Type*}

/-- A linear ordered field is a field with a linear order respecting the operations. -/
@[protect_proj] class linear_ordered_field (α : Type*) extends linear_ordered_comm_ring α, field α

section linear_ordered_field
variables [linear_ordered_field α] {a b c d e : α}

section

/-- `equiv.mul_left₀` as an order_iso. -/
@[simps {simp_rhs := tt}]
def order_iso.mul_left₀ (a : α) (ha : 0 < a) : α ≃o α :=
{ map_rel_iff' := λ _ _, mul_le_mul_left ha, ..equiv.mul_left₀ a ha.ne' }

/-- `equiv.mul_right₀` as an order_iso. -/
@[simps {simp_rhs := tt}]
def order_iso.mul_right₀ (a : α) (ha : 0 < a) : α ≃o α :=
{ map_rel_iff' := λ _ _, mul_le_mul_right ha, ..equiv.mul_right₀ a ha.ne' }

end

/-!
### Lemmas about pos, nonneg, nonpos, neg
-/

@[simp] lemma inv_pos : 0 < a⁻¹ ↔ 0 < a :=
suffices ∀ a : α, 0 < a → 0 < a⁻¹,
from ⟨λ h, inv_inv₀ a ▸ this _ h, this a⟩,
assume a ha, flip lt_of_mul_lt_mul_left ha.le $ by simp [ne_of_gt ha, zero_lt_one]

@[simp] lemma inv_nonneg : 0 ≤ a⁻¹ ↔ 0 ≤ a :=
by simp only [le_iff_eq_or_lt, inv_pos, zero_eq_inv]

@[simp] lemma inv_lt_zero : a⁻¹ < 0 ↔ a < 0 :=
by simp only [← not_le, inv_nonneg]

@[simp] lemma inv_nonpos : a⁻¹ ≤ 0 ↔ a ≤ 0 :=
by simp only [← not_lt, inv_pos]

lemma one_div_pos : 0 < 1 / a ↔ 0 < a :=
inv_eq_one_div a ▸ inv_pos

lemma one_div_neg : 1 / a < 0 ↔ a < 0 :=
inv_eq_one_div a ▸ inv_lt_zero

lemma one_div_nonneg : 0 ≤ 1 / a ↔ 0 ≤ a :=
inv_eq_one_div a ▸ inv_nonneg

lemma one_div_nonpos : 1 / a ≤ 0 ↔ a ≤ 0 :=
inv_eq_one_div a ▸ inv_nonpos

lemma div_pos_iff : 0 < a / b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 :=
by simp [division_def, mul_pos_iff]

lemma div_neg_iff : a / b < 0 ↔ 0 < a ∧ b < 0 ∨ a < 0 ∧ 0 < b :=
by simp [division_def, mul_neg_iff]

lemma div_nonneg_iff : 0 ≤ a / b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 :=
by simp [division_def, mul_nonneg_iff]

lemma div_nonpos_iff : a / b ≤ 0 ↔ 0 ≤ a ∧ b ≤ 0 ∨ a ≤ 0 ∧ 0 ≤ b :=
by simp [division_def, mul_nonpos_iff]

lemma div_pos (ha : 0 < a) (hb : 0 < b) : 0 < a / b :=
div_pos_iff.2 $ or.inl ⟨ha, hb⟩

lemma div_pos_of_neg_of_neg (ha : a < 0) (hb : b < 0) : 0 < a / b :=
div_pos_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_neg_of_neg_of_pos (ha : a < 0) (hb : 0 < b) : a / b < 0 :=
div_neg_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_neg_of_pos_of_neg (ha : 0 < a) (hb : b < 0) : a / b < 0 :=
div_neg_iff.2 $ or.inl ⟨ha, hb⟩

lemma div_nonneg (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a / b :=
div_nonneg_iff.2 $ or.inl ⟨ha, hb⟩

lemma div_nonneg_of_nonpos (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a / b :=
div_nonneg_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_nonpos_of_nonpos_of_nonneg (ha : a ≤ 0) (hb : 0 ≤ b) : a / b ≤ 0 :=
div_nonpos_iff.2 $ or.inr ⟨ha, hb⟩

lemma div_nonpos_of_nonneg_of_nonpos (ha : 0 ≤ a) (hb : b ≤ 0) : a / b ≤ 0 :=
div_nonpos_iff.2 $ or.inl ⟨ha, hb⟩

/-!
### Relating one division with another term.
-/

lemma le_div_iff (hc : 0 < c) : a ≤ b / c ↔ a * c ≤ b :=
⟨λ h, div_mul_cancel b (ne_of_lt hc).symm ▸ mul_le_mul_of_nonneg_right h hc.le,
  λ h, calc
    a   = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc).symm
    ... ≤ b * (1 / c)     : mul_le_mul_of_nonneg_right h (one_div_pos.2 hc).le
    ... = b / c           : (div_eq_mul_one_div b c).symm⟩

lemma le_div_iff' (hc : 0 < c) : a ≤ b / c ↔ c * a ≤ b :=
by rw [mul_comm, le_div_iff hc]

lemma div_le_iff (hb : 0 < b) : a / b ≤ c ↔ a ≤ c * b :=
⟨λ h, calc
  a = a / b * b : by rw (div_mul_cancel _ (ne_of_lt hb).symm)
  ... ≤ c * b     : mul_le_mul_of_nonneg_right h hb.le,
  λ h, calc
  a / b = a * (1 / b)     : div_eq_mul_one_div a b
  ... ≤ (c * b) * (1 / b) : mul_le_mul_of_nonneg_right h (one_div_pos.2 hb).le
  ... = (c * b) / b       : (div_eq_mul_one_div (c * b) b).symm
  ... = c                 : by refine (div_eq_iff (ne_of_gt hb)).mpr rfl⟩

lemma div_le_iff' (hb : 0 < b) : a / b ≤ c ↔ a ≤ b * c :=
by rw [mul_comm, div_le_iff hb]

lemma lt_div_iff (hc : 0 < c) : a < b / c ↔ a * c < b :=
lt_iff_lt_of_le_iff_le $ div_le_iff hc

lemma lt_div_iff' (hc : 0 < c) : a < b / c ↔ c * a < b :=
by rw [mul_comm, lt_div_iff hc]

lemma div_lt_iff (hc : 0 < c) : b / c < a ↔ b < a * c :=
lt_iff_lt_of_le_iff_le (le_div_iff hc)

lemma div_lt_iff' (hc : 0 < c) : b / c < a ↔ b < c * a :=
by rw [mul_comm, div_lt_iff hc]

lemma inv_mul_le_iff (h : 0 < b) : b⁻¹ * a ≤ c ↔ a ≤ b * c :=
begin
  rw [inv_eq_one_div, mul_comm, ← div_eq_mul_one_div],
  exact div_le_iff' h,
end

lemma inv_mul_le_iff' (h : 0 < b) : b⁻¹ * a ≤ c ↔ a ≤ c * b :=
by rw [inv_mul_le_iff h, mul_comm]

lemma mul_inv_le_iff (h : 0 < b) : a * b⁻¹ ≤ c ↔ a ≤ b * c :=
by rw [mul_comm, inv_mul_le_iff h]

lemma mul_inv_le_iff' (h : 0 < b) : a * b⁻¹ ≤ c ↔ a ≤ c * b :=
by rw [mul_comm, inv_mul_le_iff' h]

lemma div_self_le_one (a : α) : a / a ≤ 1 :=
if h : a = 0 then by simp [h] else by simp [h]

lemma inv_mul_lt_iff (h : 0 < b) : b⁻¹ * a < c ↔ a < b * c :=
begin
  rw [inv_eq_one_div, mul_comm, ← div_eq_mul_one_div],
  exact div_lt_iff' h,
end

lemma inv_mul_lt_iff' (h : 0 < b) : b⁻¹ * a < c ↔ a < c * b :=
by rw [inv_mul_lt_iff h, mul_comm]

lemma mul_inv_lt_iff (h : 0 < b) : a * b⁻¹ < c ↔ a < b * c :=
by rw [mul_comm, inv_mul_lt_iff h]

lemma mul_inv_lt_iff' (h : 0 < b) : a * b⁻¹ < c ↔ a < c * b :=
by rw [mul_comm, inv_mul_lt_iff' h]

lemma inv_pos_le_iff_one_le_mul (ha : 0 < a) : a⁻¹ ≤ b ↔ 1 ≤ b * a :=
by { rw [inv_eq_one_div], exact div_le_iff ha }

lemma inv_pos_le_iff_one_le_mul' (ha : 0 < a) : a⁻¹ ≤ b ↔ 1 ≤ a * b :=
by { rw [inv_eq_one_div], exact div_le_iff' ha }

lemma inv_pos_lt_iff_one_lt_mul (ha : 0 < a) : a⁻¹ < b ↔ 1 < b * a :=
by { rw [inv_eq_one_div], exact div_lt_iff ha }

lemma inv_pos_lt_iff_one_lt_mul' (ha : 0 < a) : a⁻¹ < b ↔ 1 < a * b :=
by { rw [inv_eq_one_div], exact div_lt_iff' ha }

lemma div_le_iff_of_neg (hc : c < 0) : b / c ≤ a ↔ a * c ≤ b :=
⟨λ h, div_mul_cancel b (ne_of_lt hc) ▸ mul_le_mul_of_nonpos_right h hc.le,
  λ h, calc
    a = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc)
  ... ≥ b * (1 / c)     : mul_le_mul_of_nonpos_right h (one_div_neg.2 hc).le
  ... = b / c           : (div_eq_mul_one_div b c).symm⟩

lemma div_le_iff_of_neg' (hc : c < 0) : b / c ≤ a ↔ c * a ≤ b :=
by rw [mul_comm, div_le_iff_of_neg hc]

lemma le_div_iff_of_neg (hc : c < 0) : a ≤ b / c ↔ b ≤ a * c :=
by rw [← neg_neg c, mul_neg_eq_neg_mul_symm, div_neg, le_neg,
    div_le_iff (neg_pos.2 hc), neg_mul_eq_neg_mul_symm]

lemma le_div_iff_of_neg' (hc : c < 0) : a ≤ b / c ↔ b ≤ c * a :=
by rw [mul_comm, le_div_iff_of_neg hc]

lemma div_lt_iff_of_neg (hc : c < 0) : b / c < a ↔ a * c < b :=
lt_iff_lt_of_le_iff_le $ le_div_iff_of_neg hc

lemma div_lt_iff_of_neg' (hc : c < 0) : b / c < a ↔ c * a < b :=
by rw [mul_comm, div_lt_iff_of_neg hc]

lemma lt_div_iff_of_neg (hc : c < 0) : a < b / c ↔ b < a * c :=
lt_iff_lt_of_le_iff_le $ div_le_iff_of_neg hc

lemma lt_div_iff_of_neg' (hc : c < 0) : a < b / c ↔ b < c * a :=
by rw [mul_comm, lt_div_iff_of_neg hc]

/-- One direction of `div_le_iff` where `b` is allowed to be `0` (but `c` must be nonnegative) -/
lemma div_le_of_nonneg_of_le_mul (hb : 0 ≤ b) (hc : 0 ≤ c) (h : a ≤ c * b) : a / b ≤ c :=
by { rcases eq_or_lt_of_le hb with rfl|hb', simp [hc], rwa [div_le_iff hb'] }

lemma div_le_one_of_le (h : a ≤ b) (hb : 0 ≤ b) : a / b ≤ 1 :=
div_le_of_nonneg_of_le_mul hb zero_le_one $ by rwa one_mul

/-!
### Bi-implications of inequalities using inversions
-/

lemma inv_le_inv_of_le (ha : 0 < a) (h : a ≤ b) : b⁻¹ ≤ a⁻¹ :=
by rwa [← one_div a, le_div_iff' ha, ← div_eq_mul_inv, div_le_iff (ha.trans_le h), one_mul]

/-- See `inv_le_inv_of_le` for the implication from right-to-left with one fewer assumption. -/
lemma inv_le_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
by rw [← one_div, div_le_iff ha, ← div_eq_inv_mul, le_div_iff hb, one_mul]

/-- In a linear ordered field, for positive `a` and `b` we have `a⁻¹ ≤ b ↔ b⁻¹ ≤ a`.
See also `inv_le_of_inv_le` for a one-sided implication with one fewer assumption. -/
lemma inv_le (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a :=
by rw [← inv_le_inv hb (inv_pos.2 ha), inv_inv₀]

lemma inv_le_of_inv_le (ha : 0 < a) (h : a⁻¹ ≤ b) : b⁻¹ ≤ a :=
(inv_le ha ((inv_pos.2 ha).trans_le h)).1 h

lemma le_inv (ha : 0 < a) (hb : 0 < b) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ :=
by rw [← inv_le_inv (inv_pos.2 hb) ha, inv_inv₀]

lemma inv_lt_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b⁻¹ ↔ b < a :=
lt_iff_lt_of_le_iff_le (inv_le_inv hb ha)

/-- In a linear ordered field, for positive `a` and `b` we have `a⁻¹ < b ↔ b⁻¹ < a`.
See also `inv_lt_of_inv_lt` for a one-sided implication with one fewer assumption. -/
lemma inv_lt (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b ↔ b⁻¹ < a :=
lt_iff_lt_of_le_iff_le (le_inv hb ha)

lemma inv_lt_of_inv_lt (ha : 0 < a) (h : a⁻¹ < b) : b⁻¹ < a :=
(inv_lt ha ((inv_pos.2 ha).trans h)).1 h

lemma lt_inv (ha : 0 < a) (hb : 0 < b) : a < b⁻¹ ↔ b < a⁻¹ :=
lt_iff_lt_of_le_iff_le (inv_le hb ha)

lemma inv_le_inv_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
by rw [← one_div, div_le_iff_of_neg ha, ← div_eq_inv_mul, div_le_iff_of_neg hb, one_mul]

lemma inv_le_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a :=
by rw [← inv_le_inv_of_neg hb (inv_lt_zero.2 ha), inv_inv₀]

lemma le_inv_of_neg (ha : a < 0) (hb : b < 0) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ :=
by rw [← inv_le_inv_of_neg (inv_lt_zero.2 hb) ha, inv_inv₀]

lemma inv_lt_inv_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ < b⁻¹ ↔ b < a :=
lt_iff_lt_of_le_iff_le (inv_le_inv_of_neg hb ha)

lemma inv_lt_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ < b ↔ b⁻¹ < a :=
lt_iff_lt_of_le_iff_le (le_inv_of_neg hb ha)

lemma lt_inv_of_neg (ha : a < 0) (hb : b < 0) : a < b⁻¹ ↔ b < a⁻¹ :=
lt_iff_lt_of_le_iff_le (inv_le_of_neg hb ha)

lemma inv_lt_one (ha : 1 < a) : a⁻¹ < 1 :=
by rwa [inv_lt ((@zero_lt_one α _ _).trans ha) zero_lt_one, inv_one]

lemma one_lt_inv (h₁ : 0 < a) (h₂ : a < 1) : 1 < a⁻¹ :=
by rwa [lt_inv (@zero_lt_one α _ _) h₁, inv_one]

lemma inv_le_one (ha : 1 ≤ a) : a⁻¹ ≤ 1 :=
by rwa [inv_le ((@zero_lt_one α _ _).trans_le ha) zero_lt_one, inv_one]

lemma one_le_inv (h₁ : 0 < a) (h₂ : a ≤ 1) : 1 ≤ a⁻¹ :=
by rwa [le_inv (@zero_lt_one α _ _) h₁, inv_one]

lemma inv_lt_one_iff_of_pos (h₀ : 0 < a) : a⁻¹ < 1 ↔ 1 < a :=
⟨λ h₁, inv_inv₀ a ▸ one_lt_inv (inv_pos.2 h₀) h₁, inv_lt_one⟩

lemma inv_lt_one_iff : a⁻¹ < 1 ↔ a ≤ 0 ∨ 1 < a :=
begin
  cases le_or_lt a 0 with ha ha,
  { simp [ha, (inv_nonpos.2 ha).trans_lt zero_lt_one] },
  { simp only [ha.not_le, false_or, inv_lt_one_iff_of_pos ha] }
end

lemma one_lt_inv_iff : 1 < a⁻¹ ↔ 0 < a ∧ a < 1 :=
⟨λ h, ⟨inv_pos.1 (zero_lt_one.trans h), inv_inv₀ a ▸ inv_lt_one h⟩, and_imp.2 one_lt_inv⟩

lemma inv_le_one_iff : a⁻¹ ≤ 1 ↔ a ≤ 0 ∨ 1 ≤ a :=
begin
  rcases em (a = 1) with (rfl|ha),
  { simp [le_rfl] },
  { simp only [ne.le_iff_lt (ne.symm ha), ne.le_iff_lt (mt inv_eq_one₀.1 ha), inv_lt_one_iff] }
end

lemma one_le_inv_iff : 1 ≤ a⁻¹ ↔ 0 < a ∧ a ≤ 1 :=
⟨λ h, ⟨inv_pos.1 (zero_lt_one.trans_le h), inv_inv₀ a ▸ inv_le_one h⟩, and_imp.2 one_le_inv⟩

/-!
### Relating two divisions.
-/

@[mono] lemma div_le_div_of_le (hc : 0 ≤ c) (h : a ≤ b) : a / c ≤ b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_le_mul_of_nonneg_right h (one_div_nonneg.2 hc)
end

-- Not a `mono` lemma b/c `div_le_div` is strictly more general
lemma div_le_div_of_le_left (ha : 0 ≤ a) (hc : 0 < c) (h : c ≤ b) : a / b ≤ a / c :=
begin
  rw [div_eq_mul_inv, div_eq_mul_inv],
  exact mul_le_mul_of_nonneg_left ((inv_le_inv (hc.trans_le h) hc).mpr h) ha
end

lemma div_le_div_of_le_of_nonneg (hab : a ≤ b) (hc : 0 ≤ c) : a / c ≤ b / c :=
div_le_div_of_le hc hab

lemma div_le_div_of_nonpos_of_le (hc : c ≤ 0) (h : b ≤ a) : a / c ≤ b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_le_mul_of_nonpos_right h (one_div_nonpos.2 hc)
end

lemma div_lt_div_of_lt (hc : 0 < c) (h : a < b) : a / c < b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_lt_mul_of_pos_right h (one_div_pos.2 hc)
end

lemma div_lt_div_of_neg_of_lt (hc : c < 0) (h : b < a) : a / c < b / c :=
begin
  rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c],
  exact mul_lt_mul_of_neg_right h (one_div_neg.2 hc)
end

lemma div_le_div_right (hc : 0 < c) : a / c ≤ b / c ↔ a ≤ b :=
⟨le_imp_le_of_lt_imp_lt $ div_lt_div_of_lt hc, div_le_div_of_le $ hc.le⟩

lemma div_le_div_right_of_neg (hc : c < 0) : a / c ≤ b / c ↔ b ≤ a :=
⟨le_imp_le_of_lt_imp_lt $ div_lt_div_of_neg_of_lt hc, div_le_div_of_nonpos_of_le $ hc.le⟩

lemma div_lt_div_right (hc : 0 < c) : a / c < b / c ↔ a < b :=
lt_iff_lt_of_le_iff_le $ div_le_div_right hc

lemma div_lt_div_right_of_neg (hc : c < 0) : a / c < b / c ↔ b < a :=
lt_iff_lt_of_le_iff_le $ div_le_div_right_of_neg hc

lemma div_lt_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b < a / c ↔ c < b :=
by simp only [div_eq_mul_inv, mul_lt_mul_left ha, inv_lt_inv hb hc]

lemma div_le_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b ≤ a / c ↔ c ≤ b :=
le_iff_le_iff_lt_iff_lt.2 (div_lt_div_left ha hc hb)

lemma div_lt_div_iff (b0 : 0 < b) (d0 : 0 < d) :
  a / b < c / d ↔ a * d < c * b :=
by rw [lt_div_iff d0, div_mul_eq_mul_div, div_lt_iff b0]

lemma div_le_div_iff (b0 : 0 < b) (d0 : 0 < d) : a / b ≤ c / d ↔ a * d ≤ c * b :=
by rw [le_div_iff d0, div_mul_eq_mul_div, div_le_iff b0]

@[mono] lemma div_le_div (hc : 0 ≤ c) (hac : a ≤ c) (hd : 0 < d) (hbd : d ≤ b) : a / b ≤ c / d :=
by { rw div_le_div_iff (hd.trans_le hbd) hd, exact mul_le_mul hac hbd hd.le hc }

lemma div_lt_div (hac : a < c) (hbd : d ≤ b) (c0 : 0 ≤ c) (d0 : 0 < d) :
  a / b < c / d :=
(div_lt_div_iff (d0.trans_le hbd) d0).2 (mul_lt_mul hac hbd d0 c0)

lemma div_lt_div' (hac : a ≤ c) (hbd : d < b) (c0 : 0 < c) (d0 : 0 < d) :
  a / b < c / d :=
(div_lt_div_iff (d0.trans hbd) d0).2 (mul_lt_mul' hac hbd d0.le c0)

lemma div_lt_div_of_lt_left (hc : 0 < c) (hb : 0 < b) (h : b < a) : c / a < c / b :=
(div_lt_div_left hc (hb.trans h) hb).mpr h

/-!
### Relating one division and involving `1`
-/

lemma div_le_self (ha : 0 ≤ a) (hb : 1 ≤ b) : a / b ≤ a :=
by simpa only [div_one] using div_le_div_of_le_left ha zero_lt_one hb

lemma div_lt_self (ha : 0 < a) (hb : 1 < b) : a / b < a :=
by simpa only [div_one] using div_lt_div_of_lt_left ha zero_lt_one hb

lemma one_le_div (hb : 0 < b) : 1 ≤ a / b ↔ b ≤ a :=
by rw [le_div_iff hb, one_mul]

lemma div_le_one (hb : 0 < b) : a / b ≤ 1 ↔ a ≤ b :=
by rw [div_le_iff hb, one_mul]

lemma one_lt_div (hb : 0 < b) : 1 < a / b ↔ b < a :=
by rw [lt_div_iff hb, one_mul]

lemma div_lt_one (hb : 0 < b) : a / b < 1 ↔ a < b :=
by rw [div_lt_iff hb, one_mul]

lemma one_le_div_of_neg (hb : b < 0) : 1 ≤ a / b ↔ a ≤ b :=
by rw [le_div_iff_of_neg hb, one_mul]

lemma div_le_one_of_neg (hb : b < 0) : a / b ≤ 1 ↔ b ≤ a :=
by rw [div_le_iff_of_neg hb, one_mul]

lemma one_lt_div_of_neg (hb : b < 0) : 1 < a / b ↔ a < b :=
by rw [lt_div_iff_of_neg hb, one_mul]

lemma div_lt_one_of_neg (hb : b < 0) : a / b < 1 ↔ b < a :=
by rw [div_lt_iff_of_neg hb, one_mul]

lemma one_div_le (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ b ↔ 1 / b ≤ a :=
by simpa using inv_le ha hb

lemma one_div_lt (ha : 0 < a) (hb : 0 < b) : 1 / a < b ↔ 1 / b < a :=
by simpa using inv_lt ha hb

lemma le_one_div (ha : 0 < a) (hb : 0 < b) : a ≤ 1 / b ↔ b ≤ 1 / a :=
by simpa using le_inv ha hb

lemma lt_one_div (ha : 0 < a) (hb : 0 < b) : a < 1 / b ↔ b < 1 / a :=
by simpa using lt_inv ha hb

lemma one_div_le_of_neg (ha : a < 0) (hb : b < 0) : 1 / a ≤ b ↔ 1 / b ≤ a :=
by simpa using inv_le_of_neg ha hb

lemma one_div_lt_of_neg (ha : a < 0) (hb : b < 0) : 1 / a < b ↔ 1 / b < a :=
by simpa using inv_lt_of_neg ha hb

lemma le_one_div_of_neg (ha : a < 0) (hb : b < 0) : a ≤ 1 / b ↔ b ≤ 1 / a :=
by simpa using le_inv_of_neg ha hb

lemma lt_one_div_of_neg (ha : a < 0) (hb : b < 0) : a < 1 / b ↔ b < 1 / a :=
by simpa using lt_inv_of_neg ha hb

lemma one_lt_div_iff : 1 < a / b ↔ 0 < b ∧ b < a ∨ b < 0 ∧ a < b :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, one_lt_div_of_neg] },
  { simp [lt_irrefl, zero_le_one] },
  { simp [hb, hb.not_lt, one_lt_div] }
end

lemma one_le_div_iff : 1 ≤ a / b ↔ 0 < b ∧ b ≤ a ∨ b < 0 ∧ a ≤ b :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, one_le_div_of_neg] },
  { simp [lt_irrefl, zero_lt_one.not_le, zero_lt_one] },
  { simp [hb, hb.not_lt, one_le_div] }
end

lemma div_lt_one_iff : a / b < 1 ↔ 0 < b ∧ a < b ∨ b = 0 ∨ b < 0 ∧ b < a :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, hb.ne, div_lt_one_of_neg] },
  { simp [zero_lt_one], },
  { simp [hb, hb.not_lt, div_lt_one, hb.ne.symm] }
end

lemma div_le_one_iff : a / b ≤ 1 ↔ 0 < b ∧ a ≤ b ∨ b = 0 ∨ b < 0 ∧ b ≤ a :=
begin
  rcases lt_trichotomy b 0 with (hb|rfl|hb),
  { simp [hb, hb.not_lt, hb.ne, div_le_one_of_neg] },
  { simp [zero_le_one], },
  { simp [hb, hb.not_lt, div_le_one, hb.ne.symm] }
end

/-!
### Relating two divisions, involving `1`
-/
lemma one_div_le_one_div_of_le (ha : 0 < a) (h : a ≤ b) : 1 / b ≤ 1 / a :=
by simpa using inv_le_inv_of_le ha h

lemma one_div_lt_one_div_of_lt (ha : 0 < a) (h : a < b) : 1 / b < 1 / a :=
by rwa [lt_div_iff' ha, ← div_eq_mul_one_div, div_lt_one (ha.trans h)]

lemma one_div_le_one_div_of_neg_of_le (hb : b < 0) (h : a ≤ b) : 1 / b ≤ 1 / a :=
by rwa [div_le_iff_of_neg' hb, ← div_eq_mul_one_div, div_le_one_of_neg (h.trans_lt hb)]

lemma one_div_lt_one_div_of_neg_of_lt (hb : b < 0) (h : a < b) : 1 / b < 1 / a :=
by rwa [div_lt_iff_of_neg' hb, ← div_eq_mul_one_div, div_lt_one_of_neg (h.trans hb)]

lemma le_of_one_div_le_one_div (ha : 0 < a) (h : 1 / a ≤ 1 / b) : b ≤ a :=
le_imp_le_of_lt_imp_lt (one_div_lt_one_div_of_lt ha) h

lemma lt_of_one_div_lt_one_div (ha : 0 < a) (h : 1 / a < 1 / b) : b < a :=
lt_imp_lt_of_le_imp_le (one_div_le_one_div_of_le ha) h

lemma le_of_neg_of_one_div_le_one_div (hb : b < 0) (h : 1 / a ≤ 1 / b) : b ≤ a :=
le_imp_le_of_lt_imp_lt (one_div_lt_one_div_of_neg_of_lt hb) h

lemma lt_of_neg_of_one_div_lt_one_div (hb : b < 0) (h : 1 / a < 1 / b) : b < a :=
lt_imp_lt_of_le_imp_le (one_div_le_one_div_of_neg_of_le hb) h

/-- For the single implications with fewer assumptions, see `one_div_le_one_div_of_le` and
  `le_of_one_div_le_one_div` -/
lemma one_div_le_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ 1 / b ↔ b ≤ a :=
div_le_div_left zero_lt_one ha hb

/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_lt` and
  `lt_of_one_div_lt_one_div` -/
lemma one_div_lt_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a < 1 / b ↔ b < a :=
div_lt_div_left zero_lt_one ha hb

/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_neg_of_lt` and
  `lt_of_one_div_lt_one_div` -/
lemma one_div_le_one_div_of_neg (ha : a < 0) (hb : b < 0) : 1 / a ≤ 1 / b ↔ b ≤ a :=
by simpa [one_div] using inv_le_inv_of_neg ha hb

/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_lt` and
  `lt_of_one_div_lt_one_div` -/
lemma one_div_lt_one_div_of_neg (ha : a < 0) (hb : b < 0) : 1 / a < 1 / b ↔ b < a :=
lt_iff_lt_of_le_iff_le (one_div_le_one_div_of_neg hb ha)

lemma one_lt_one_div (h1 : 0 < a) (h2 : a < 1) : 1 < 1 / a :=
by rwa [lt_one_div (@zero_lt_one α _ _) h1, one_div_one]

lemma one_le_one_div (h1 : 0 < a) (h2 : a ≤ 1) : 1 ≤ 1 / a :=
by rwa [le_one_div (@zero_lt_one α _ _) h1, one_div_one]

lemma one_div_lt_neg_one (h1 : a < 0) (h2 : -1 < a) : 1 / a < -1 :=
suffices 1 / a < 1 / -1, by rwa one_div_neg_one_eq_neg_one at this,
one_div_lt_one_div_of_neg_of_lt h1 h2

lemma one_div_le_neg_one (h1 : a < 0) (h2 : -1 ≤ a) : 1 / a ≤ -1 :=
suffices 1 / a ≤ 1 / -1, by rwa one_div_neg_one_eq_neg_one at this,
one_div_le_one_div_of_neg_of_le h1 h2

/-!
### Results about halving.

The equalities also hold in fields of characteristic `0`. -/
lemma add_halves (a : α) : a / 2 + a / 2 = a :=
by rw [div_add_div_same, ← two_mul, mul_div_cancel_left a two_ne_zero]

lemma sub_self_div_two (a : α) : a - a / 2 = a / 2 :=
suffices a / 2 + a / 2 - a / 2 = a / 2, by rwa add_halves at this,
by rw [add_sub_cancel]

lemma div_two_sub_self (a : α) : a / 2 - a = - (a / 2) :=
suffices a / 2 - (a / 2 + a / 2) = - (a / 2), by rwa add_halves at this,
by rw [sub_add_eq_sub_sub, sub_self, zero_sub]

lemma add_self_div_two (a : α) : (a + a) / 2 = a :=
by rw [← mul_two, mul_div_cancel a two_ne_zero]

lemma half_pos (h : 0 < a) : 0 < a / 2 := div_pos h zero_lt_two

lemma one_half_pos : (0:α) < 1 / 2 := half_pos zero_lt_one

lemma div_two_lt_of_pos (h : 0 < a) : a / 2 < a :=
by { rw [div_lt_iff (@zero_lt_two α _ _)], exact lt_mul_of_one_lt_right h one_lt_two }

lemma half_lt_self : 0 < a → a / 2 < a := div_two_lt_of_pos

lemma half_le_self (ha_nonneg : 0 ≤ a) : a / 2 ≤ a :=
begin
  by_cases h0 : a = 0,
  { simp [h0], },
  { rw ← ne.def at h0,
    exact (half_lt_self (lt_of_le_of_ne ha_nonneg h0.symm)).le, },
end

lemma one_half_lt_one : (1 / 2 : α) < 1 := half_lt_self zero_lt_one

lemma add_sub_div_two_lt (h : a < b) : a + (b - a) / 2 < b :=
begin
  rwa [← div_sub_div_same, sub_eq_add_neg, add_comm (b/2), ← add_assoc, ← sub_eq_add_neg,
    ← lt_sub_iff_add_lt, sub_self_div_two, sub_self_div_two, div_lt_div_right (@zero_lt_two α _ _)]
end

lemma left_lt_add_div_two : a < (a + b) / 2 ↔ a < b := by simp [lt_div_iff, mul_two]

lemma add_div_two_lt_right : (a + b) / 2 < b ↔ a < b := by simp [div_lt_iff, mul_two]

/--  An inequality involving `2`. -/
lemma sub_one_div_inv_le_two (a2 : 2 ≤ a) :
  (1 - 1 / a)⁻¹ ≤ 2 :=
begin
  -- Take inverses on both sides to obtain `2⁻¹ ≤ 1 - 1 / a`
  refine trans (inv_le_inv_of_le (inv_pos.mpr zero_lt_two) _) (inv_inv₀ (2 : α)).le,
  -- move `1 / a` to the left and `1 - 1 / 2 = 1 / 2` to the right to obtain `1 / a ≤ ⅟ 2`
  refine trans ((le_sub_iff_add_le.mpr ((_ : _ + 2⁻¹ = _ ).le))) ((sub_le_sub_iff_left 1).mpr _),
  { -- show 2⁻¹ + 2⁻¹ = 1
    exact trans (two_mul _).symm (mul_inv_cancel two_ne_zero) },
  { -- take inverses on both sides and use the assumption `2 ≤ a`.
    exact (one_div a).le.trans (inv_le_inv_of_le zero_lt_two a2) }
end

/-!
### Miscellaneous lemmas
-/

/-- Pullback a `linear_ordered_field` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def function.injective.linear_ordered_field {β : Type*}
  [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_inv β] [has_div β]
  (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y)
  (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) :
  linear_ordered_field β :=
{ ..hf.linear_ordered_ring f zero one add mul neg sub,
  ..hf.field f zero one add mul neg sub inv div}

lemma mul_sub_mul_div_mul_neg_iff (hc : c ≠ 0) (hd : d ≠ 0) :
  (a * d - b * c) / (c * d) < 0 ↔ a / c < b / d :=
by rw [mul_comm b c, ← div_sub_div _ _ hc hd, sub_lt_zero]

alias mul_sub_mul_div_mul_neg_iff ↔ div_lt_div_of_mul_sub_mul_div_neg mul_sub_mul_div_mul_neg

lemma mul_sub_mul_div_mul_nonpos_iff (hc : c ≠ 0) (hd : d ≠ 0) :
      (a * d - b * c) / (c * d) ≤ 0 ↔ a / c ≤ b / d :=
by rw [mul_comm b c, ← div_sub_div _ _ hc hd, sub_nonpos]

alias mul_sub_mul_div_mul_nonpos_iff ↔
  div_le_div_of_mul_sub_mul_div_nonpos mul_sub_mul_div_mul_nonpos

lemma mul_le_mul_of_mul_div_le (h : a * (b / c) ≤ d) (hc : 0 < c) : b * a ≤ d * c :=
begin
  rw [← mul_div_assoc] at h,
  rwa [mul_comm b, ← div_le_iff hc],
end

lemma div_mul_le_div_mul_of_div_le_div (h : a / b ≤ c / d) (he : 0 ≤ e) :
  a / (b * e) ≤ c / (d * e) :=
begin
  rw [div_mul_eq_div_mul_one_div, div_mul_eq_div_mul_one_div],
  exact mul_le_mul_of_nonneg_right h (one_div_nonneg.2 he)
end

lemma exists_add_lt_and_pos_of_lt (h : b < a) : ∃ c : α, b + c < a ∧ 0 < c :=
⟨(a - b) / 2, add_sub_div_two_lt h, div_pos (sub_pos_of_lt h) zero_lt_two⟩

lemma exists_pos_mul_lt {a : α} (h : 0 < a) (b : α) : ∃ c : α, 0 < c ∧ b * c < a :=
begin
  have : 0 < a / max (b + 1) 1, from div_pos h (lt_max_iff.2 (or.inr zero_lt_one)),
  refine ⟨a / max (b + 1) 1, this, _⟩,
  rw [← lt_div_iff this, div_div_cancel' h.ne'],
  exact lt_max_iff.2 (or.inl $ lt_add_one _)
end

lemma le_of_forall_sub_le (h : ∀ ε > 0, b - ε ≤ a) : b ≤ a :=
begin
  contrapose! h,
  simpa only [and_comm ((0 : α) < _), lt_sub_iff_add_lt, gt_iff_lt]
    using exists_add_lt_and_pos_of_lt h,
end

lemma monotone.div_const {β : Type*} [preorder β] {f : β → α} (hf : monotone f)
  {c : α} (hc : 0 ≤ c) : monotone (λ x, (f x) / c) :=
by simpa only [div_eq_mul_inv] using hf.mul_const (inv_nonneg.2 hc)

lemma strict_mono.div_const {β : Type*} [preorder β] {f : β → α} (hf : strict_mono f)
  {c : α} (hc : 0 < c) :
  strict_mono (λ x, (f x) / c) :=
by simpa only [div_eq_mul_inv] using hf.mul_const (inv_pos.2 hc)

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_field.to_densely_ordered : densely_ordered α :=
{ dense := λ a₁ a₂ h, ⟨(a₁ + a₂) / 2,
  calc a₁ = (a₁ + a₁) / 2 : (add_self_div_two a₁).symm
      ... < (a₁ + a₂) / 2 : div_lt_div_of_lt zero_lt_two (add_lt_add_left h _),
  calc (a₁ + a₂) / 2 < (a₂ + a₂) / 2 : div_lt_div_of_lt zero_lt_two (add_lt_add_right h _)
                 ... = a₂            : add_self_div_two a₂⟩ }

lemma mul_self_inj_of_nonneg (a0 : 0 ≤ a) (b0 : 0 ≤ b) : a * a = b * b ↔ a = b :=
mul_self_eq_mul_self_iff.trans $ or_iff_left_of_imp $
  λ h, by { subst a, have : b = 0 := le_antisymm (neg_nonneg.1 a0) b0, rw [this, neg_zero] }

lemma min_div_div_right {c : α} (hc : 0 ≤ c) (a b : α) : min (a / c) (b / c) = (min a b) / c :=
eq.symm $ monotone.map_min (λ x y, div_le_div_of_le hc)

lemma max_div_div_right {c : α} (hc : 0 ≤ c) (a b : α) : max (a / c) (b / c) = (max a b) / c :=
eq.symm $ monotone.map_max (λ x y, div_le_div_of_le hc)

lemma min_div_div_right_of_nonpos {c : α} (hc : c ≤ 0) (a b : α) :
  min (a / c) (b / c) = (max a b) / c :=
eq.symm $ @monotone.map_max α (order_dual α) _ _ _ _ _ (λ x y, div_le_div_of_nonpos_of_le hc)

lemma max_div_div_right_of_nonpos {c : α} (hc : c ≤ 0) (a b : α) :
  max (a / c) (b / c) = (min a b) / c :=
eq.symm $ @monotone.map_min α (order_dual α) _ _ _ _ _ (λ x y, div_le_div_of_nonpos_of_le hc)

lemma abs_div (a b : α) : |a / b| = |a| / |b| := (abs_hom : α →*₀ α).map_div a b

lemma abs_one_div (a : α) : |1 / a| = 1 / |a| :=
by rw [abs_div, abs_one]

lemma abs_inv (a : α) : |a⁻¹| = (|a|)⁻¹ := (abs_hom : α →*₀ α).map_inv a

-- TODO: add lemmas with `a⁻¹`.
lemma one_div_strict_anti_on : strict_anti_on (λ x : α, 1 / x) (set.Ioi 0) :=
λ x x1 y y1 xy, (one_div_lt_one_div (set.mem_Ioi.mp y1) (set.mem_Ioi.mp x1)).mpr xy

lemma one_div_pow_le_one_div_pow_of_le (a1 : 1 ≤ a) {m n : ℕ} (mn : m ≤ n) :
  1 / a ^ n ≤ 1 / a ^ m :=
by refine (one_div_le_one_div _ _).mpr (pow_le_pow a1 mn);
  exact pow_pos (zero_lt_one.trans_le a1) _

lemma one_div_pow_lt_one_div_pow_of_lt (a1 : 1 < a) {m n : ℕ} (mn : m < n) :
  1 / a ^ n < 1 / a ^ m :=
by refine (one_div_lt_one_div _ _).mpr (pow_lt_pow a1 mn);
  exact pow_pos (trans zero_lt_one a1) _

lemma one_div_pow_mono (a1 : 1 ≤ a) : monotone (λ n : ℕ, order_dual.to_dual 1 / a ^ n) :=
λ m n, one_div_pow_le_one_div_pow_of_le a1

lemma one_div_pow_strict_mono (a1 : 1 < a) : strict_mono (λ n : ℕ, order_dual.to_dual 1 / a ^ n) :=
λ m n, one_div_pow_lt_one_div_pow_of_lt a1

/-! ### Results about `is_lub` and `is_glb` -/

lemma is_lub.mul_left {s : set α} (ha : 0 ≤ a) (hs : is_lub s b) :
  is_lub ((λ b, a * b) '' s) (a * b) :=
begin
  rcases lt_or_eq_of_le ha with ha | rfl,
  { exact (order_iso.mul_left₀ _ ha).is_lub_image'.2 hs, },
  { simp_rw zero_mul,
    rw hs.nonempty.image_const,
    exact is_lub_singleton },
end

lemma is_lub.mul_right {s : set α} (ha : 0 ≤ a) (hs : is_lub s b) :
  is_lub ((λ b, b * a) '' s) (b * a) :=
by simpa [mul_comm] using hs.mul_left ha

lemma is_glb.mul_left {s : set α} (ha : 0 ≤ a) (hs : is_glb s b) :
  is_glb ((λ b, a * b) '' s) (a * b) :=
begin
  rcases lt_or_eq_of_le ha with ha | rfl,
  { exact (order_iso.mul_left₀ _ ha).is_glb_image'.2 hs, },
  { simp_rw zero_mul,
    rw hs.nonempty.image_const,
    exact is_glb_singleton },
end

lemma is_glb.mul_right {s : set α} (ha : 0 ≤ a) (hs : is_glb s b) :
  is_glb ((λ b, b * a) '' s) (b * a) :=
by simpa [mul_comm] using hs.mul_left ha

end linear_ordered_field


/-
Copyright (c) 2021 Aaron Anderson, Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Kevin Buzzard, Yaël Dillies, Eric Wieser

! This file was ported from Lean 3 source module order.sup_indep
! leanprover-community/mathlib commit 1c857a1f6798cb054be942199463c2cf904cb937
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Pairwise
import Mathlib.Data.Finset.Powerset
import Mathlib.Data.Fintype.Basic

/-!
# Supremum independence

In this file, we define supremum independence of indexed sets. An indexed family `f : ι → α` is
sup-independent if, for all `a`, `f a` and the supremum of the rest are disjoint.

## Main definitions

* `Finset.SupIndep s f`: a family of elements `f` are supremum independent on the finite set `s`.
* `CompleteLattice.SetIndependent s`: a set of elements are supremum independent.
* `CompleteLattice.Independent f`: a family of elements are supremum independent.

## Main statements

* In a distributive lattice, supremum independence is equivalent to pairwise disjointness:
  * `Finset.supIndep_iff_pairwiseDisjoint`
  * `CompleteLattice.setIndependent_iff_pairwiseDisjoint`
  * `CompleteLattice.independent_iff_pairwiseDisjoint`
* Otherwise, supremum independence is stronger than pairwise disjointness:
  * `Finset.SupIndep.pairwiseDisjoint`
  * `CompleteLattice.SetIndependent.pairwiseDisjoint`
  * `CompleteLattice.Independent.pairwiseDisjoint`

## Implementation notes

For the finite version, we avoid the "obvious" definition
`∀ i ∈ s, Disjoint (f i) ((s.erase i).sup f)` because `erase` would require decidable equality on
`ι`.
-/

variable {α β ι ι' : Type _}

/-! ### On lattices with a bottom element, via `Finset.sup` -/

namespace Finset

section Lattice

variable [Lattice α] [OrderBot α]

/-- Supremum independence of finite sets. We avoid the "obvious" definition using `s.erase i`
because `erase` would require decidable equality on `ι`. -/
def SupIndep (s : Finset ι) (f : ι → α) : Prop :=
  ∀ ⦃t⦄, t ⊆ s → ∀ ⦃i⦄, i ∈ s → i ∉ t → Disjoint (f i) (t.sup f)
#align finset.sup_indep Finset.SupIndep

variable {s t : Finset ι} {f : ι → α} {i : ι}

instance [DecidableEq ι] [DecidableEq α] : Decidable (SupIndep s f) := by
  refine @Finset.decidableForallOfDecidableSubsets _ _ _ (?_)
  rintro t -
  refine @Finset.decidableDforallFinset _ _ _ (?_)
  rintro i -
  have : Decidable (Disjoint (f i) (sup t f)) := decidable_of_iff' (_ = ⊥) disjoint_iff
  infer_instance

theorem SupIndep.subset (ht : t.SupIndep f) (h : s ⊆ t) : s.SupIndep f := fun _ hu _ hi =>
  ht (hu.trans h) (h hi)
#align finset.sup_indep.subset Finset.SupIndep.subset

theorem supIndep_empty (f : ι → α) : (∅ : Finset ι).SupIndep f := fun _ _ a ha =>
  (not_mem_empty a ha).elim
#align finset.sup_indep_empty Finset.supIndep_empty

theorem supIndep_singleton (i : ι) (f : ι → α) : ({i} : Finset ι).SupIndep f :=
  fun s hs j hji hj => by
    rw [eq_empty_of_ssubset_singleton ⟨hs, fun h => hj (h hji)⟩, sup_empty]
    exact disjoint_bot_right
#align finset.sup_indep_singleton Finset.supIndep_singleton

theorem SupIndep.pairwiseDisjoint (hs : s.SupIndep f) : (s : Set ι).PairwiseDisjoint f :=
  fun _ ha _ hb hab =>
    sup_singleton.subst <| hs (singleton_subset_iff.2 hb) ha <| not_mem_singleton.2 hab
#align finset.sup_indep.pairwise_disjoint Finset.SupIndep.pairwiseDisjoint

/-- The RHS looks like the definition of `CompleteLattice.Independent`. -/
theorem supIndep_iff_disjoint_erase [DecidableEq ι] :
    s.SupIndep f ↔ ∀ i ∈ s, Disjoint (f i) ((s.erase i).sup f) :=
  ⟨fun hs _ hi => hs (erase_subset _ _) hi (not_mem_erase _ _), fun hs _ ht i hi hit =>
    (hs i hi).mono_right (sup_mono fun _ hj => mem_erase.2 ⟨ne_of_mem_of_not_mem hj hit, ht hj⟩)⟩
#align finset.sup_indep_iff_disjoint_erase Finset.supIndep_iff_disjoint_erase

@[simp]
theorem supIndep_pair [DecidableEq ι] {i j : ι} (hij : i ≠ j) :
    ({i, j} : Finset ι).SupIndep f ↔ Disjoint (f i) (f j) :=
  ⟨fun h => h.pairwiseDisjoint (by simp) (by simp) hij,
   fun h => by
    rw [supIndep_iff_disjoint_erase]
    intro k hk
    rw [Finset.mem_insert, Finset.mem_singleton] at hk
    obtain rfl | rfl := hk
    · convert h using 1
      rw [Finset.erase_insert, Finset.sup_singleton]
      simpa using hij
    · convert h.symm using 1
      have : ({i, k} : Finset ι).erase k = {i} := by
        ext
        rw [mem_erase, mem_insert, mem_singleton, mem_singleton, and_or_left, Ne.def,
          not_and_self_iff, or_false_iff, and_iff_right_of_imp]
        rintro rfl
        exact hij
      rw [this, Finset.sup_singleton]⟩
#align finset.sup_indep_pair Finset.supIndep_pair

theorem supIndep_univ_bool (f : Bool → α) :
    (Finset.univ : Finset Bool).SupIndep f ↔ Disjoint (f false) (f true) :=
  haveI : true ≠ false := by simp only [Ne.def, not_false_iff]
  (supIndep_pair this).trans disjoint_comm
#align finset.sup_indep_univ_bool Finset.supIndep_univ_bool

@[simp]
theorem supIndep_univ_fin_two (f : Fin 2 → α) :
    (Finset.univ : Finset (Fin 2)).SupIndep f ↔ Disjoint (f 0) (f 1) :=
  haveI : (0 : Fin 2) ≠ 1 := by simp
  supIndep_pair this
#align finset.sup_indep_univ_fin_two Finset.supIndep_univ_fin_two

theorem SupIndep.attach (hs : s.SupIndep f) : s.attach.SupIndep (f ∘ Subtype.val) := by
  intro t _ i _ hi
  classical
    rw [← Finset.sup_image]
    refine' hs (image_subset_iff.2 fun (j : { x // x ∈ s }) _ => j.2) i.2 fun hi' => hi _
    rw [mem_image] at hi'
    obtain ⟨j, hj, hji⟩ := hi'
    rwa [Subtype.ext hji] at hj
#align finset.sup_indep.attach Finset.SupIndep.attach

end Lattice

section DistribLattice

variable [DistribLattice α] [OrderBot α] {s : Finset ι} {f : ι → α}

theorem supIndep_iff_pairwiseDisjoint : s.SupIndep f ↔ (s : Set ι).PairwiseDisjoint f :=
  ⟨SupIndep.pairwiseDisjoint, fun hs _ ht _ hi hit =>
    Finset.disjoint_sup_right.2 fun _ hj => hs hi (ht hj) (ne_of_mem_of_not_mem hj hit).symm⟩
#align finset.sup_indep_iff_pairwise_disjoint Finset.supIndep_iff_pairwiseDisjoint

alias supIndep_iff_pairwiseDisjoint ↔
  sup_indep.pairwise_disjoint _root_.Set.PairwiseDisjoint.supIndep
#align set.pairwise_disjoint.sup_indep Set.PairwiseDisjoint.supIndep

/-- Bind operation for `SupIndep`. -/
theorem SupIndep.sup [DecidableEq ι] {s : Finset ι'} {g : ι' → Finset ι} {f : ι → α}
    (hs : s.SupIndep fun i => (g i).sup f) (hg : ∀ i' ∈ s, (g i').SupIndep f) :
    (s.sup g).SupIndep f := by
  simp_rw [supIndep_iff_pairwiseDisjoint] at hs hg⊢
  rw [sup_eq_bunionᵢ, coe_bunionᵢ]
  exact hs.bunionᵢ_finset hg
#align finset.sup_indep.sup Finset.SupIndep.sup

/-- Bind operation for `SupIndep`. -/
theorem SupIndep.bunionᵢ [DecidableEq ι] {s : Finset ι'} {g : ι' → Finset ι} {f : ι → α}
    (hs : s.SupIndep fun i => (g i).sup f) (hg : ∀ i' ∈ s, (g i').SupIndep f) :
    (s.bunionᵢ g).SupIndep f := by
  rw [← sup_eq_bunionᵢ]
  exact hs.sup hg
#align finset.sup_indep.bUnion Finset.SupIndep.bunionᵢ

end DistribLattice

end Finset

/-! ### On complete lattices via `supₛ` -/

namespace CompleteLattice

variable [CompleteLattice α]

open Set Function

/-- An independent set of elements in a complete lattice is one in which every element is disjoint
  from the `Sup` of the rest. -/
def SetIndependent (s : Set α) : Prop :=
  ∀ ⦃a⦄, a ∈ s → Disjoint a (supₛ (s \ {a}))
#align complete_lattice.set_independent CompleteLattice.SetIndependent

variable {s : Set α} (hs : SetIndependent s)

@[simp]
theorem setIndependent_empty : SetIndependent (∅ : Set α) := fun x hx =>
  (Set.not_mem_empty x hx).elim
#align complete_lattice.set_independent_empty CompleteLattice.setIndependent_empty

theorem SetIndependent.mono {t : Set α} (hst : t ⊆ s) : SetIndependent t := fun _ ha =>
  (hs (hst ha)).mono_right (supₛ_le_supₛ (diff_subset_diff_left hst))
#align complete_lattice.set_independent.mono CompleteLattice.SetIndependent.mono

/-- If the elements of a set are independent, then any pair within that set is disjoint. -/
theorem SetIndependent.pairwiseDisjoint : s.PairwiseDisjoint id := fun _ hx y hy h =>
  disjoint_supₛ_right (hs hx) ((mem_diff y).mpr ⟨hy, h.symm⟩)
#align complete_lattice.set_independent.pairwise_disjoint CompleteLattice.SetIndependent.pairwiseDisjoint

theorem setIndependent_pair {a b : α} (hab : a ≠ b) :
    SetIndependent ({a, b} : Set α) ↔ Disjoint a b := by
  constructor
  · intro h
    exact h.pairwiseDisjoint (mem_insert _ _) (mem_insert_of_mem _ (mem_singleton _)) hab
  · rintro h c ((rfl : c = a) | (rfl : c = b))
    · convert h using 1
      simp [hab, supₛ_singleton]
    · convert h.symm using 1
      simp [hab, supₛ_singleton]
#align complete_lattice.set_independent_pair CompleteLattice.setIndependent_pair

/-- If the elements of a set are independent, then any element is disjoint from the `supₛ` of some
subset of the rest. -/
theorem SetIndependent.disjoint_supₛ {x : α} {y : Set α} (hx : x ∈ s) (hy : y ⊆ s) (hxy : x ∉ y) :
    Disjoint x (supₛ y) := by
  have := (hs.mono <| insert_subset.mpr ⟨hx, hy⟩) (mem_insert x _)
  rw [insert_diff_of_mem _ (mem_singleton _), diff_singleton_eq_self hxy] at this
  exact this
#align complete_lattice.set_independent.disjoint_Sup CompleteLattice.SetIndependent.disjoint_supₛ

/-- An independent indexed family of elements in a complete lattice is one in which every element
  is disjoint from the `supᵢ` of the rest.

  Example: an indexed family of non-zero elements in a
  vector space is linearly independent iff the indexed family of subspaces they generate is
  independent in this sense.

  Example: an indexed family of submodules of a module is independent in this sense if
  and only the natural map from the direct sum of the submodules to the module is injective. -/
-- Porting note: needed to use `_H`
def Independent {ι : Sort _} {α : Type _} [CompleteLattice α] (t : ι → α) : Prop :=
  ∀ i : ι, Disjoint (t i) (⨆ (j) (_H : j ≠ i), t j)

#align complete_lattice.independent CompleteLattice.Independent

theorem setIndependent_iff {α : Type _} [CompleteLattice α] (s : Set α) :
    SetIndependent s ↔ Independent ((↑) : s → α) := by
  simp_rw [Independent, SetIndependent, SetCoe.forall, supₛ_eq_supᵢ]
  refine' forall₂_congr fun a ha => _
  simp [supᵢ_subtype, supᵢ_and]
#align complete_lattice.set_independent_iff CompleteLattice.setIndependent_iff

variable {t : ι → α} (ht : Independent t)

theorem independent_def : Independent t ↔ ∀ i : ι, Disjoint (t i) (⨆ (j) (_H : j ≠ i), t j) :=
  Iff.rfl
#align complete_lattice.independent_def CompleteLattice.independent_def

theorem independent_def' : Independent t ↔ ∀ i, Disjoint (t i) (supₛ (t '' { j | j ≠ i })) := by
  simp_rw [supₛ_image]
  rfl
#align complete_lattice.independent_def' CompleteLattice.independent_def'

theorem independent_def'' :
    Independent t ↔ ∀ i, Disjoint (t i) (supₛ { a | ∃ (j : _)(_ : j ≠ i), t j = a }) := by
  rw [independent_def']
  aesop
#align complete_lattice.independent_def'' CompleteLattice.independent_def''

@[simp]
theorem independent_empty (t : Empty → α) : Independent t :=
  fun.
#align complete_lattice.independent_empty CompleteLattice.independent_empty

@[simp]
theorem independent_pempty (t : PEmpty → α) : Independent t :=
  fun.
#align complete_lattice.independent_pempty CompleteLattice.independent_pempty

/-- If the elements of a set are independent, then any pair within that set is disjoint. -/
theorem Independent.pairwiseDisjoint : Pairwise (Disjoint on t) := fun x y h =>
  disjoint_supₛ_right (ht x) ⟨y, supᵢ_pos h.symm⟩
#align complete_lattice.independent.pairwise_disjoint CompleteLattice.Independent.pairwiseDisjoint

theorem Independent.mono {s t : ι → α} (hs : Independent s) (hst : t ≤ s) : Independent t :=
  fun i => (hs i).mono (hst i) <| supᵢ₂_mono fun j _ => hst j
#align complete_lattice.independent.mono CompleteLattice.Independent.mono

/-- Composing an independent indexed family with an injective function on the index results in
another indepedendent indexed family. -/
theorem Independent.comp {ι ι' : Sort _} {t : ι → α} {f : ι' → ι} (ht : Independent t)
    (hf : Injective f) : Independent (t ∘ f) := fun i =>
  (ht (f i)).mono_right <| by
    refine' (supᵢ_mono fun i => _).trans (supᵢ_comp_le _ f)
    exact supᵢ_const_mono hf.ne
#align complete_lattice.independent.comp CompleteLattice.Independent.comp

theorem Independent.comp' {ι ι' : Sort _} {t : ι → α} {f : ι' → ι} (ht : Independent <| t ∘ f)
    (hf : Surjective f) : Independent t := by
  intro i
  obtain ⟨i', rfl⟩ := hf i
  rw [← hf.supᵢ_comp]
  exact (ht i').mono_right (bsupᵢ_mono fun j' hij => mt (congr_arg f) hij)
#align complete_lattice.independent.comp' CompleteLattice.Independent.comp'

theorem Independent.setIndependent_range (ht : Independent t) : SetIndependent <| range t := by
  rw [setIndependent_iff]
  rw [← coe_comp_rangeFactorization t] at ht
  exact ht.comp' surjective_onto_range
#align complete_lattice.independent.set_independent_range CompleteLattice.Independent.setIndependent_range

theorem Independent.injective (ht : Independent t) (h_ne_bot : ∀ i, t i ≠ ⊥) : Injective t := by
  intro i j h
  by_contra' contra
  apply h_ne_bot j
  suffices t j ≤ ⨆ (k) (_hk : k ≠ i), t k by
    replace ht := (ht i).mono_right this
    rwa [h, disjoint_self] at ht
  replace contra : j ≠ i
  · exact Ne.symm contra
  -- Porting note: needs explicit `f`
  exact @le_supᵢ₂ _ _ _ _ (fun x _ => t x) j contra
#align complete_lattice.independent.injective CompleteLattice.Independent.injective

theorem independent_pair {i j : ι} (hij : i ≠ j) (huniv : ∀ k, k = i ∨ k = j) :
    Independent t ↔ Disjoint (t i) (t j) := by
  constructor
  · exact fun h => h.pairwiseDisjoint hij
  · rintro h k
    obtain rfl | rfl := huniv k
    · refine' h.mono_right (supᵢ_le fun i => supᵢ_le fun hi => Eq.le _)
      rw [(huniv i).resolve_left hi]
    · refine' h.symm.mono_right (supᵢ_le fun j => supᵢ_le fun hj => Eq.le _)
      rw [(huniv j).resolve_right hj]
#align complete_lattice.independent_pair CompleteLattice.independent_pair

/-- Composing an indepedent indexed family with an order isomorphism on the elements results in
another indepedendent indexed family. -/
theorem Independent.map_orderIso {ι : Sort _} {α β : Type _} [CompleteLattice α]
    [CompleteLattice β] (f : α ≃o β) {a : ι → α} (ha : Independent a) : Independent (f ∘ a) :=
  fun i => ((ha i).map_orderIso f).mono_right (f.monotone.le_map_supᵢ₂ _)
#align complete_lattice.independent.map_order_iso CompleteLattice.Independent.map_orderIso

@[simp]
theorem independent_map_orderIso_iff {ι : Sort _} {α β : Type _} [CompleteLattice α]
    [CompleteLattice β] (f : α ≃o β) {a : ι → α} : Independent (f ∘ a) ↔ Independent a :=
  ⟨fun h =>
    have hf : f.symm ∘ f ∘ a = a := congr_arg (· ∘ a) f.left_inv.comp_eq_id
    hf ▸ h.map_orderIso f.symm,
    fun h => h.map_orderIso f⟩
#align complete_lattice.independent_map_order_iso_iff CompleteLattice.independent_map_orderIso_iff

/-- If the elements of a set are independent, then any element is disjoint from the `supr` of some
subset of the rest. -/
theorem Independent.disjoint_bsupᵢ {ι : Type _} {α : Type _} [CompleteLattice α] {t : ι → α}
    (ht : Independent t) {x : ι} {y : Set ι} (hx : x ∉ y) : Disjoint (t x) (⨆ i ∈ y, t i) :=
  Disjoint.mono_right (bsupᵢ_mono fun _ hi => (ne_of_mem_of_not_mem hi hx : _)) (ht x)
#align complete_lattice.independent.disjoint_bsupr CompleteLattice.Independent.disjoint_bsupᵢ

end CompleteLattice

theorem CompleteLattice.independent_iff_supIndep [CompleteLattice α] {s : Finset ι} {f : ι → α} :
    CompleteLattice.Independent (f ∘ ((↑) : s → ι)) ↔ s.SupIndep f := by
  classical
    rw [Finset.supIndep_iff_disjoint_erase]
    refine' Subtype.forall.trans (forall₂_congr fun a b => _)
    rw [Finset.sup_eq_supᵢ]
    congr! 1
    refine' supᵢ_subtype.trans _
    congr! 1
    simp [supᵢ_and, @supᵢ_comm _ (_ ∈ s)]
#align complete_lattice.independent_iff_sup_indep CompleteLattice.independent_iff_supIndep

alias CompleteLattice.independent_iff_supIndep ↔
  CompleteLattice.Independent.supIndep Finset.SupIndep.independent
#align complete_lattice.independent.sup_indep CompleteLattice.Independent.supIndep
#align finset.sup_indep.independent Finset.SupIndep.independent

/-- A variant of `CompleteLattice.independent_iff_supIndep` for `Fintype`s. -/
theorem CompleteLattice.independent_iff_supIndep_univ [CompleteLattice α] [Fintype ι] {f : ι → α} :
    CompleteLattice.Independent f ↔ Finset.univ.SupIndep f := by
  classical
    simp [Finset.supIndep_iff_disjoint_erase, CompleteLattice.Independent, Finset.sup_eq_supᵢ]
#align complete_lattice.independent_iff_sup_indep_univ CompleteLattice.independent_iff_supIndep_univ

alias CompleteLattice.independent_iff_supIndep_univ ↔
  CompleteLattice.Independent.sup_indep_univ Finset.SupIndep.independent_of_univ
#align complete_lattice.independent.sup_indep_univ CompleteLattice.Independent.sup_indep_univ
#align finset.sup_indep.independent_of_univ Finset.SupIndep.independent_of_univ

section Frame

namespace CompleteLattice

variable [Order.Frame α]

theorem setIndependent_iff_pairwiseDisjoint {s : Set α} :
    SetIndependent s ↔ s.PairwiseDisjoint id :=
  ⟨SetIndependent.pairwiseDisjoint, fun hs _ hi =>
    disjoint_supₛ_iff.2 fun _ hj => hs hi hj.1 <| Ne.symm hj.2⟩
#align complete_lattice.set_independent_iff_pairwise_disjoint CompleteLattice.setIndependent_iff_pairwiseDisjoint

alias setIndependent_iff_pairwiseDisjoint ↔ _ _root_.Set.PairwiseDisjoint.setIndependent
#align set.pairwise_disjoint.set_independent Set.PairwiseDisjoint.setIndependent

theorem independent_iff_pairwiseDisjoint {f : ι → α} : Independent f ↔ Pairwise (Disjoint on f) :=
  ⟨Independent.pairwiseDisjoint, fun hs _ =>
    disjoint_supᵢ_iff.2 fun _ => disjoint_supᵢ_iff.2 fun hij => hs hij.symm⟩
#align complete_lattice.independent_iff_pairwise_disjoint CompleteLattice.independent_iff_pairwiseDisjoint

end CompleteLattice

end Frame


prelude
import .my_tactics

namespace hott
open_locale hott

localized "notation f ` $ `:1 a:0 := f a" in hott

variables {α β γ δ : Type*}

def id : α → α := λ a, a

namespace Eq
-- Path induction
@[elab_as_eliminator]
def ind {C : Π (a b : α), a = b → Type*}
  (c : Π (a : α), C a a rfl) :
  Π {a b : α} (p : a = b), C a b p :=
λ a b p, @Eq.rec α a (C a) (c a) b p

-- Based path induction
@[elab_as_eliminator]
def ind_on' (a : α)
  {C : Π (b : α), a = b → Type*}
  {b : α} (p : a = b)
  (c : C a rfl) :
  C b p :=
@Eq.rec α a C c b p

-- Based path induction, proven using `ind`
def ind_on'₁ (a : α)
  {C : Π (b : α), a = b → Type*}
  {b : α} (p : a = b)
  (c : C a rfl) :
  C b p :=
let D : Π (a b : α), a = b → Type* :=
    λ a b p, Π (C : Π (z : α), a = z → Type*), C a rfl → C b p,
  d : Π (a : α), D a a rfl := λ x C, id,
  f : D a b p := Eq.ind_on p d in
f C c

example {P : α → Type*} {a : α} : @@transport P (refl a) = id := rfl
example {f : α → β} {a : α} : f ▸ refl a = refl (f a) := rfl

-- The following results were not proven in ch1 but they are needed
-- for some of the exercises
def symm {a b : α} : a = b → b = a :=
λ p, p∗ (refl a)

localized "postfix `⁻¹`:1034 := Eq.symm" in hott

end Eq

-- Names such as `refl`, `ap` and `transport` are so ubiquitous that
-- I choose to make them top-level names
open Eq

inductive prod (α : Type*) (β : Type*)
| mk : α → β → prod

localized "infixr ` × `:51 := prod" in hott

variables {x : γ}

namespace prod
-- The recursor, i.e. non-dependent eliminator
def rec' : (α → β → γ) → α × β → γ := @prod.rec α β (λ _, γ)

-- The induction principle, i.e. dependent eliminator
-- This is just the Lean-given `prod.rec` with rearranged arguments
@[elab_as_eliminator]
def ind {C : α × β → Type*}
  (c : Π (a : α) (b : β), C ⟨a, b⟩) :
  Π (x : α × β), C x :=
@prod.rec α β C c

def pr₁ : α × β → α := prod.rec' (λ a b, a)
def pr₂ : α × β → β := prod.rec' (λ a b, b)

-- The definitional equality satisfied by `rec`, or the computation rule.
-- That is to say, the LHS is *definitionally equal* to the RHS.
example {f : α → β → γ} {a : α} {b : β} : prod.rec' f ⟨a, b⟩ = f a b := rfl
example {a : α} {b : β} : pr₁ ⟨a, b⟩ = a := rfl
example {a : α} {b : β} : pr₂ ⟨a, b⟩ = b := rfl

-- The uniqueness principle
def uniq : Π (x : α × β), x = ⟨x.pr₁, x.pr₂⟩ :=
@@prod.ind (λ x, x = ⟨x.pr₁, x.pr₂⟩) (λ a b, rfl)

end prod

inductive sigma {α : Type*} (f : α → Type*)
| mk : Π (a : α), f a → sigma

-- I just copy pasted this line, I have no idea how it works
localized "notation `Σ` binders `, ` r:(scoped f, sigma f) := r" in hott

namespace sigma
variable {f : α → Type*}

def rec' : (Π (a : α), f a → β) → (Σ (a : α), f a) → β :=
@sigma.rec α f (λ _, β)

@[elab_as_eliminator]
def ind {C : (Σ (a : α), f a) → Type*}
  (c : Π (a : α) (b : f a), C ⟨a, b⟩) :
  Π (p : Σ (a : α), f a), C p :=
@sigma.rec α f C c

def pr₁ : (Σ (a : α), f a) → α := sigma.rec' (λ a b, a)

def pr₂ : Π (x : Σ (a : α), f a), f x.pr₁ :=
@@sigma.ind f (λ (x : sigma f), f x.pr₁) (λ a b, b)

-- A naive type-theoretic formulation of the axiom of choice,
-- which is trivial in this case.
def fake_ac (R : α → β → Type*) (total : Π (a : α), Σ (b : β), R a b) :
  Σ (f : α → β), Π (a : α), R a (f a) :=
sigma.mk (λ a, pr₁ (total a)) (λ a, pr₂ (total a))

end sigma

inductive sum (α : Type*) (β : Type*)
| inl : α → sum
| inr : β → sum

localized "infixr ` ⊕ `:51 := sum" in hott

namespace sum
def rec' : (α → γ) → (β → γ) → α ⊕ β → γ := @sum.rec α β (λ _, γ)

@[elab_as_eliminator]
def ind {C : α ⊕ β → Type*} :
  (Π (a : α), C (inl a)) → (Π (b : β), C (inr b)) → Π (x : α ⊕ β), C x :=
λ c, @sum.rec α β C c

end sum

inductive empty : Type

namespace empty
def rec' : empty → α := empty.rec (λ _, α)

@[elab_as_eliminator]
def ind {C : empty → Type*} : Π (x : empty), C x := empty.rec C

end empty

inductive unit
| star : unit

namespace unit
def rec' : α → unit → α := @unit.rec (λ _, α)

@[elab_as_eliminator]
def ind : Π {C : unit → Type*}, C star → Π (x : unit), C x := @unit.rec

def uniq : Π (x : unit), x = star :=
@@unit.ind (λ x, x = star) rfl

end unit

inductive bool
| ff : bool
| tt : bool

namespace bool
def rec' : α → α → bool → α := @bool.rec (λ _, α)

@[elab_as_eliminator]
def ind : Π {C : bool → Type*}, C ff → C tt → Π (x : bool), C x := @bool.rec

def uniq : Π (x : bool), (x = ff) ⊕ (x = tt) :=
@@bool.ind (λ x, (x = ff) ⊕ (x = tt)) (sum.inl rfl) (sum.inr rfl)

end bool

inductive nat
| zero : nat
| succ : nat → nat

localized "notation `ℕ` := nat" in hott

namespace nat
def rec' : α → (ℕ → α → α) → ℕ → α := @nat.rec (λ _, α)

@[elab_as_eliminator]
def ind : Π {C : ℕ → Type*}, C zero →
  (Π (n : ℕ), C n → C (succ n)) → Π (n : ℕ), C n :=
@nat.rec

@[elab_as_eliminator]
def ind_on : Π {C : ℕ → Type*} (n : ℕ),
  C zero → (Π (n : ℕ), C n → C (succ n)) → C n :=
@nat.rec_on

def double : ℕ → ℕ := nat.rec' zero (λ n y, succ (succ y))
def add : ℕ → ℕ → ℕ := nat.rec' id (λ m f n, succ (f n))

example : double (zero.succ.succ) = zero.succ.succ.succ.succ := rfl
example : add zero.succ zero.succ.succ = zero.succ.succ.succ := rfl

def le (n m : ℕ) := Σ k, add k n = m
def lt (n m : ℕ) := Σ (k : ℕ), add k.succ n = m

end nat

localized "infix ` + `:65 := nat.add" in hott
localized "infix ` < `:50 := nat.lt" in hott
localized "infix ` ≤ `:50 := nat.le" in hott

-- Propositional reasoning, by encoding propositions as types
localized "prefix `¬`:1034 := λ a, a → empty" in hott

namespace prop
variables {A B : Type*} -- Think of these as representing propositions

example : ¬ A × ¬ B → ¬ (A ⊕ B) :=
λ h, sum.rec' h.pr₁ h.pr₂

example : ¬ (A ⊕ B) → ¬ A × ¬ B :=
λ h, ⟨λ a, h (sum.inl a),
  λ b, h (sum.inr b)⟩

variables {P Q : A → Type*}
example : (Π (a : A), P a × Q a) → (Π (a : A), P a) × (Π (a : A), Q a) :=
λ h, ⟨λ a, (h a).pr₁,
  λ a, (h a).pr₂⟩

end prop

open_locale hott

-- Exercise 1.1
def comp (g : β → γ) (f : α → β) : α → γ := λ x, g (f x)
localized "infix ` ∘ `:76 := comp" in hott
example {f : α → β} {g : β → γ} {h : γ → δ} : h ∘ (g ∘ f) = (h ∘ g) ∘ f := rfl

-- Exercise 1.2
def prod.rec₁ : (α → β → γ) → α × β → γ := λ f x, f x.pr₁ x.pr₂
example {f : α → β → γ} {a : α} {b : β} : prod.rec₁ f ⟨a, b⟩ = f a b := rfl

variable {f : α → Type*}
def sigma.rec₁ : (Π (a : α), f a → β) → (Σ (a : α), f a) → β := λ g x, g x.pr₁ x.pr₂
example {g : Π (a : α), f a → β} {a : α} {b : f a} : sigma.rec₁ g ⟨a, b⟩ = g a b := rfl

-- Exercise 1.3
def prod.ind₁ {C : α × β → Type*}
  (c : Π (a : α) (b : β), C ⟨a, b⟩) :
  Π (x : α × β), C x :=
λ x, (x.uniq)⁻¹∗ (c x.pr₁ x.pr₂)

-- Full derivation:
-- prod.ind₁ c ⟨a, b⟩
-- ≡ (⟨a, b⟩.uniq)⁻¹∗ (c a b)
-- ≡ rfl∗ (c a b)
-- ≡ id (c a b)
-- ≡ (c a b)
example {C : α × β → Type*} {c : Π (a : α) (b : β), C ⟨a, b⟩}
  {a : α} {b : β} : prod.ind₁ c ⟨a, b⟩ = c a b :=
rfl

def sigma.uniq : Π (x : Σ (a : α), f a), x = ⟨x.pr₁, x.pr₂⟩ :=
let C := λ (x : Σ (a : α), f a), x = ⟨x.pr₁, x.pr₂⟩ in
@@sigma.ind f C (λ a b, rfl)

-- Basically the same proof as prod.ind₁ (the characters are exactly
-- the same even!)
def sigma.ind₁ {C : (Σ (a : α), f a) → Type*}
  (c : Π (a : α) (b : f a), C ⟨a, b⟩) :
  Π (x : Σ (a : α), f a), C x :=
λ x, (x.uniq)⁻¹∗ (c x.pr₁ x.pr₂)

example {C : (Σ (a : α), f a) → Type*}
  {c : Π (a : α) (b : f a), C ⟨a, b⟩}
  {a : α} {b : f a} : sigma.ind₁ c ⟨a, b⟩ = c a b :=
rfl

-- Exercise 1.4
def nat.iter : α → (α → α) → ℕ → α := λ a f, nat.rec' a (λ n y, f y)

example {a : α} {f : α → α} : nat.iter a f nat.zero = a := rfl
example {a : α} {f : α → α} {n : ℕ} : nat.iter a f n.succ = f (nat.iter a f n) := rfl

def G (f : ℕ → α → α) : ℕ × α → ℕ × α := λ y, ⟨y.pr₁.succ, f y.pr₁ y.pr₂⟩

-- Name comes from the `zip` function in Python.
-- The function is like zip(ℕ, nat.rec' a f).
def zip (a : α) (f : ℕ → α → α) : ℕ → ℕ × α :=
nat.iter ⟨nat.zero, a⟩ (G f)

def nat.rec₁ : α → (ℕ → α → α) → ℕ → α :=
λ a f n, (zip a f n).pr₂

-- Full derivation:
-- nat.rec₁ a f 0
-- ≡ (zip a f 0).pr₂
-- ≡ (nat.iter ⟨0, a⟩ (G f) 0).pr₂
-- ≡ ⟨0, a⟩.pr₂
-- ≡ a
example {a : α} {f : ℕ → α → α} : nat.rec₁ a f nat.zero = a := rfl

-- Proving the other computation rule of `nat.rec₁` requires some
-- intermediate results

-- This is NOT definitionally true, and it must be proven via induction.
-- Full derivation for the inductive step:
-- zip a f n.succ
-- ≡ nat.iter ⟨0, a⟩ G n.succ
-- ≡ G (nat.iter ⟨0, a⟩ G n)
-- = G ⟨n, nat.rec' a f n⟩  (this is the non-judgmental equality that needs to proven)
-- ≡ ⟨n.succ, f n (nat.rec' a f n)⟩
-- ≡ ⟨n.succ, nat.rec' a f n.succ⟩
def aux (a : α) (f : ℕ → α → α) (n : ℕ) : zip a f n = ⟨n, nat.rec' a f n⟩ :=
nat.ind_on n rfl (λ n h, G f ▸ h)

-- Full derivation:
-- nat.rec₁ a f n.succ
-- ≡ (zip a f n.succ).pr₂
-- = nat.rec' a f n.succ  (essentially h₁)
-- ≡ f n (nat.rec' a f n)
-- = f n (zip a f n).pr₂  (h₂)
-- ≡ f n (nat.rec₁ a f n)
example {a : α} {f : ℕ → α → α} {n : ℕ} :
  nat.rec₁ a f n.succ = f n (nat.rec₁ a f n) :=
let h₁ : (zip a f n.succ).pr₂ = nat.rec' a f n.succ :=
  prod.pr₂ ▸ (aux a f n.succ),
h₂ : f n (nat.rec' a f n) = f n (zip a f n).pr₂ :=
  (λ (x : ℕ × α), f n x.pr₂) ▸ (aux a f n)⁻¹ in
h₁ ⬝ h₂

-- Exercise 1.5
-- Note α and β are forced to be in the same universe,
-- since α and β must have the same type in the call to `bool.rec'`.
-- This makes the definition somewhat weaker than the original.
def sum₁ (α β : Type*) : Type* := Σ (x : bool), bool.rec' α β x

namespace sum₁
def ind {α β : Type*} {C : sum₁ α β → Type*}
  (c₁ : Π (a : α), C ⟨bool.ff, a⟩)
  (c₂ : Π (b : β), C ⟨bool.tt, b⟩) :
  Π (x : sum₁ α β), C x :=
sigma.ind (
  let C' := λ a, Π (b : bool.rec' α β a), C ⟨a, b⟩ in
  @@bool.ind C' c₁ c₂
)

-- Full derivation:
-- sum₁.ind C c₁ c₂ ⟨bool.ff, a⟩
-- ≡ sigma.ind C (bool.ind _ c₁ c₂) ⟨bool.ff, a⟩
-- ≡ bool.ind _ c₁ c₂ bool.ff a
-- ≡ c₁ a
example {α β : Type*} {C : sum₁ α β → Type*}
  {c₁ : Π (a : α), C ⟨bool.ff, a⟩}
  {c₂ : Π (b : β), C ⟨bool.tt, b⟩}
  {a : α} :
sum₁.ind c₁ c₂ ⟨bool.ff, a⟩ = c₁ a := rfl

example {α β : Type*} {C : sum₁ α β → Type*}
  {c₁ : Π (a : α), C ⟨bool.ff, a⟩}
  {c₂ : Π (b : β), C ⟨bool.tt, b⟩}
  {b : β} :
sum₁.ind c₁ c₂ ⟨bool.tt, b⟩ = c₂ b := rfl

end sum₁

-- Exercise 1.8, 1.16
namespace nat
def mul : ℕ → ℕ → ℕ := nat.rec' (λ _, zero) (λ _ f n, add n (f n))
-- Following the convention of `add` and `mul`,
-- I define `exp m n` so that `exp 0 n = 1`. Thus `exp m n = n ^ m`.
def exp : ℕ → ℕ → ℕ := nat.rec' (λ _, zero.succ) (λ _ f n, mul n (f n))

end nat

localized "infix ` * `:66 := nat.mul" in hott

namespace nat
example {n : ℕ} : mul zero n = zero := rfl
example {n m : ℕ} : mul m.succ n = add n (mul m n) := rfl
example {n : ℕ} : exp zero n = zero.succ := rfl
example {n m : ℕ} : exp m.succ n = mul n (exp m n) := rfl

-- The rest is proving that ℕ is a commutative semiring
variables (k n m : ℕ)

-- I have no idea why the hell removing the @ breaks the proof
-- Full derivation of the inductive step left as an exercise to the reader
def add_assoc : (k + n) + m = k + (n + m) :=
nat.ind_on k rfl (λ k h, succ ▸ h)

def add_zero : n + zero = n :=
nat.ind_on n rfl (λ k h, succ ▸ h)

-- Recall `zero_add : zero + n = n` is a definitional equality.

-- The proof is not trivial; it requires double induction
def add_comm : n + m = m + n :=
begin
  revert m,
  induction n with n hn,
  { exact λ m, (add_zero _)⁻¹ },
  { intro m, induction m with m hm,
    { exact (add_zero _) },
    hrw (succ ▸ hn m.succ),
    hrw (succ ∘ succ ▸ (hn m)⁻¹),
    hrw (succ ▸ hm) }
end

def one_mul : zero.succ * k = k := add_zero k

def mul_one : k * zero.succ = k :=
nat.ind_on k rfl (λ k h, add zero.succ ▸ h)

def mul_zero : k * zero = zero :=
nat.ind_on k rfl (λ k h, h)

-- `zero_mul : zero * k = zero` holds definitionally

def mul_add : k * (n + m) = k * n + k * m :=
begin
  induction k with k hk, spamrfl,
  hrw (add (n + m) ▸ hk),
  hrw (add_assoc n m _),
  hrw (add n ▸ (add_assoc _ _ _)⁻¹),
  hrw ((λ x, n + (x + k * m)) ▸ add_comm m (k * n)),
  hrw (add n ▸ add_assoc (k * n) m (k * m)),
  hrw (add_assoc n (k * n) _)⁻¹
end

def add_mul : (n + m) * k = n * k + m * k :=
begin
  induction n with n hn, spamrfl,
  hrw (add k ▸ hn),
  hrw (add_assoc _ _ _)⁻¹
end

def mul_assoc : (k * n) * m = k * (n * m) :=
begin
  induction k with k hk, spamrfl,
  hrw (add_mul _ _ _),
  hrw (add (n * m) ▸ hk)
end

def mul_comm : n * m = m * n :=
begin
  induction n with n hn,
    exact (mul_zero m)⁻¹,
  hrw (add_comm _ _),
  hrw ((λ x, x + m) ▸ hn),
  hrw (add (m * n) ▸ (mul_one m)⁻¹),
  hrw (mul_add _ _ _)⁻¹,
  hrw (mul m ▸ add_comm _ _)
end

end nat

-- Exercise 1.9
def fin : ℕ → Type* := λ n, Σ m, m < n
def fmax : Π (n : ℕ), fin n.succ := λ n, ⟨n, ⟨nat.zero, rfl⟩⟩

-- Exercise 1.10
namespace nat
def ack : ℕ → ℕ → ℕ :=
  nat.rec' succ (λ _ f, nat.rec' (f zero.succ) (λ _ y, f y))

variables {m n : ℕ}
example : ack zero n = n.succ := rfl
example : ack m.succ zero = ack m zero.succ := rfl
example : ack m.succ n.succ = ack m (ack m.succ n) := rfl

end nat

-- Exercises 1.11-1.13
namespace prop
variables {A B : Type*}
example : ¬¬¬ A → ¬ A := λ (f : ¬¬ A → empty) a, f (λ g : ¬ A, g a)
example : A → B → A := λ a b, a
example : A → ¬¬ A := λ a (f : A → empty), f a
example : ¬ A ⊕ ¬ B → ¬ (A × B) :=
  λ p q, sum.rec' (λ hna : ¬ A, hna q.pr₁) (λ hnb : ¬ B, hnb q.pr₂) p
example : ¬¬ (A ⊕ ¬ A) :=
  λ (f : A ⊕ ¬ A → empty), f (sum.inr (λ A, f (sum.inl A)))

-- Exercise 1.15: see definition of `Eq.rec`

end prop

end hott