/-
Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group_power.basic
import Mathlib.algebra.order_functions
import Mathlib.algebra.ordered_monoid
import Mathlib.PostPort

universes u_1 u

namespace Mathlib

/-!
# Basic operations on the natural numbers

This file contains:
- instances on the natural numbers
- some basic lemmas about natural numbers
- extra recursors:
  * `le_rec_on`, `le_induction`: recursion and induction principles starting at non-zero numbers
  * `decreasing_induction`: recursion growing downwards
  * `strong_rec'`: recursion based on strong inequalities
- decidability instances on predicates about the natural numbers

-/

/-! ### instances -/

protected instance nat.nontrivial : nontrivial ℕ :=
  nontrivial.mk (Exists.intro 0 (Exists.intro 1 nat.zero_ne_one))

protected instance nat.comm_semiring : comm_semiring ℕ :=
  comm_semiring.mk Nat.add nat.add_assoc 0 nat.zero_add nat.add_zero nat.add_comm Nat.mul nat.mul_assoc 1 nat.one_mul
    nat.mul_one nat.zero_mul nat.mul_zero nat.left_distrib nat.right_distrib nat.mul_comm

protected instance nat.linear_ordered_semiring : linear_ordered_semiring ℕ :=
  linear_ordered_semiring.mk comm_semiring.add comm_semiring.add_assoc comm_semiring.zero comm_semiring.zero_add
    comm_semiring.add_zero comm_semiring.add_comm comm_semiring.mul comm_semiring.mul_assoc comm_semiring.one
    comm_semiring.one_mul comm_semiring.mul_one comm_semiring.zero_mul comm_semiring.mul_zero comm_semiring.left_distrib
    comm_semiring.right_distrib nat.add_left_cancel nat.add_right_cancel linear_order.le nat.lt linear_order.le_refl
    linear_order.le_trans linear_order.le_antisymm nat.add_le_add_left nat.le_of_add_le_add_left sorry
    nat.mul_lt_mul_of_pos_left nat.mul_lt_mul_of_pos_right linear_order.le_total linear_order.decidable_le
    nat.decidable_eq linear_order.decidable_lt sorry

-- all the fields are already included in the linear_ordered_semiring instance

protected instance nat.linear_ordered_cancel_add_comm_monoid : linear_ordered_cancel_add_comm_monoid ℕ :=
  linear_ordered_cancel_add_comm_monoid.mk linear_ordered_semiring.add linear_ordered_semiring.add_assoc
    nat.add_left_cancel linear_ordered_semiring.zero linear_ordered_semiring.zero_add linear_ordered_semiring.add_zero
    linear_ordered_semiring.add_comm linear_ordered_semiring.add_right_cancel linear_ordered_semiring.le
    linear_ordered_semiring.lt linear_ordered_semiring.le_refl linear_ordered_semiring.le_trans
    linear_ordered_semiring.le_antisymm linear_ordered_semiring.add_le_add_left
    linear_ordered_semiring.le_of_add_le_add_left linear_ordered_semiring.le_total linear_ordered_semiring.decidable_le
    linear_ordered_semiring.decidable_eq linear_ordered_semiring.decidable_lt

protected instance nat.linear_ordered_comm_monoid_with_zero : linear_ordered_comm_monoid_with_zero ℕ :=
  linear_ordered_comm_monoid_with_zero.mk linear_ordered_semiring.le linear_ordered_semiring.lt
    linear_ordered_semiring.le_refl linear_ordered_semiring.le_trans linear_ordered_semiring.le_antisymm
    linear_ordered_semiring.le_total linear_ordered_semiring.decidable_le linear_ordered_semiring.decidable_eq
    linear_ordered_semiring.decidable_lt linear_ordered_semiring.mul linear_ordered_semiring.mul_assoc
    linear_ordered_semiring.one linear_ordered_semiring.one_mul linear_ordered_semiring.mul_one sorry
    linear_ordered_semiring.zero linear_ordered_semiring.zero_mul linear_ordered_semiring.mul_zero sorry sorry
    linear_ordered_semiring.zero_le_one

/-! Extra instances to short-circuit type class resolution -/

protected instance nat.add_comm_monoid : add_comm_monoid ℕ :=
  ordered_add_comm_monoid.to_add_comm_monoid ℕ

protected instance nat.add_monoid : add_monoid ℕ :=
  add_right_cancel_monoid.to_add_monoid ℕ

protected instance nat.monoid : monoid ℕ :=
  monoid_with_zero.to_monoid ℕ

protected instance nat.comm_monoid : comm_monoid ℕ :=
  ordered_comm_monoid.to_comm_monoid ℕ

protected instance nat.comm_semigroup : comm_semigroup ℕ :=
  comm_monoid.to_comm_semigroup ℕ

protected instance nat.semigroup : semigroup ℕ :=
  monoid.to_semigroup ℕ

protected instance nat.add_comm_semigroup : add_comm_semigroup ℕ :=
  add_comm_monoid.to_add_comm_semigroup ℕ

protected instance nat.add_semigroup : add_semigroup ℕ :=
  add_monoid.to_add_semigroup ℕ

protected instance nat.distrib : distrib ℕ :=
  semiring.to_distrib ℕ

protected instance nat.semiring : semiring ℕ :=
  ordered_semiring.to_semiring ℕ

protected instance nat.ordered_semiring : ordered_semiring ℕ :=
  linear_ordered_semiring.to_ordered_semiring ℕ

protected instance nat.canonically_ordered_comm_semiring : canonically_ordered_comm_semiring ℕ :=
  canonically_ordered_comm_semiring.mk ordered_add_comm_monoid.add sorry ordered_add_comm_monoid.zero sorry sorry sorry
    ordered_add_comm_monoid.le ordered_add_comm_monoid.lt sorry sorry sorry sorry sorry 0 nat.zero_le sorry
    linear_ordered_semiring.mul sorry linear_ordered_semiring.one sorry sorry sorry sorry sorry sorry sorry sorry

protected instance nat.subtype.semilattice_sup_bot (s : set ℕ) [decidable_pred s] [h : Nonempty ↥s] : semilattice_sup_bot ↥s :=
  semilattice_sup_bot.mk { val := nat.find sorry, property := sorry } linear_order.le linear_order.lt sorry sorry sorry
    sorry lattice.sup sorry sorry sorry

theorem nat.eq_of_mul_eq_mul_right {n : ℕ} {m : ℕ} {k : ℕ} (Hm : 0 < m) (H : n * m = k * m) : n = k :=
  nat.eq_of_mul_eq_mul_left Hm
    (eq.mp (Eq._oldrec (Eq.refl (m * n = k * m)) (mul_comm k m))
      (eq.mp (Eq._oldrec (Eq.refl (n * m = k * m)) (mul_comm n m)) H))

protected instance nat.comm_cancel_monoid_with_zero : comm_cancel_monoid_with_zero ℕ :=
  comm_cancel_monoid_with_zero.mk comm_monoid_with_zero.mul sorry comm_monoid_with_zero.one sorry sorry sorry
    comm_monoid_with_zero.zero sorry sorry sorry sorry

/-!
Inject some simple facts into the type class system.
This `fact` should not be confused with the factorial function `nat.fact`!
-/

protected instance succ_pos'' (n : ℕ) : fact (0 < Nat.succ n) :=
  nat.succ_pos n

protected instance pos_of_one_lt (n : ℕ) [h : fact (1 < n)] : fact (0 < n) :=
  lt_trans zero_lt_one h

namespace nat

/-!
### Recursion and `set.range`
-/

theorem zero_union_range_succ : singleton 0 ∪ set.range Nat.succ = set.univ := sorry

theorem range_of_succ {α : Type u_1} (f : ℕ → α) : singleton (f 0) ∪ set.range (f ∘ Nat.succ) = set.range f := sorry

theorem range_rec {α : Type u_1} (x : α) (f : ℕ → α → α) : (set.range fun (n : ℕ) => Nat.rec x f n) = singleton x ∪ set.range fun (n : ℕ) => Nat.rec (f 0 x) (f ∘ Nat.succ) n := sorry

theorem range_cases_on {α : Type u_1} (x : α) (f : ℕ → α) : (set.range fun (n : ℕ) => nat.cases_on n x f) = singleton x ∪ set.range f :=
  Eq.symm (range_of_succ fun (n : ℕ) => nat.cases_on n x f)

/-! ### The units of the natural numbers as a `monoid` and `add_monoid` -/

theorem units_eq_one (u : units ℕ) : u = 1 :=
  units.ext (eq_one_of_dvd_one (Exists.intro (units.inv u) (Eq.symm (units.val_inv u))))

theorem add_units_eq_zero (u : add_units ℕ) : u = 0 :=
  add_units.ext (and.left (eq_zero_of_add_eq_zero (add_units.val_neg u)))

@[simp] protected theorem is_unit_iff {n : ℕ} : is_unit n ↔ n = 1 := sorry

/-! ### Equalities and inequalities involving zero and one -/

theorem one_lt_iff_ne_zero_and_ne_one {n : ℕ} : 1 < n ↔ n ≠ 0 ∧ n ≠ 1 := sorry

protected theorem mul_ne_zero {n : ℕ} {m : ℕ} (n0 : n ≠ 0) (m0 : m ≠ 0) : n * m ≠ 0 :=
  fun (ᾰ : n * m = 0) => idRhs False (or.elim (eq_zero_of_mul_eq_zero ᾰ) n0 m0)

@[simp] protected theorem mul_eq_zero {a : ℕ} {b : ℕ} : a * b = 0 ↔ a = 0 ∨ b = 0 := sorry

@[simp] protected theorem zero_eq_mul {a : ℕ} {b : ℕ} : 0 = a * b ↔ a = 0 ∨ b = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 = a * b ↔ a = 0 ∨ b = 0)) (propext eq_comm)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b = 0 ↔ a = 0 ∨ b = 0)) (propext nat.mul_eq_zero))) (iff.refl (a = 0 ∨ b = 0)))

theorem eq_zero_of_double_le {a : ℕ} (h : bit0 1 * a ≤ a) : a = 0 := sorry

theorem eq_zero_of_mul_le {a : ℕ} {b : ℕ} (hb : bit0 1 ≤ b) (h : b * a ≤ a) : a = 0 :=
  eq_zero_of_double_le (le_trans (mul_le_mul_right a hb) h)

theorem le_zero_iff {i : ℕ} : i ≤ 0 ↔ i = 0 :=
  { mp := eq_zero_of_le_zero, mpr := fun (h : i = 0) => h ▸ le_refl i }

theorem zero_max {m : ℕ} : max 0 m = m :=
  max_eq_right (zero_le m)

theorem one_le_of_lt {n : ℕ} {m : ℕ} (h : n < m) : 1 ≤ m :=
  lt_of_le_of_lt (zero_le n) h

theorem eq_one_of_mul_eq_one_right {m : ℕ} {n : ℕ} (H : m * n = 1) : m = 1 :=
  eq_one_of_dvd_one (Exists.intro n (Eq.symm H))

theorem eq_one_of_mul_eq_one_left {m : ℕ} {n : ℕ} (H : m * n = 1) : n = 1 :=
  eq_one_of_mul_eq_one_right (eq.mpr (id (Eq._oldrec (Eq.refl (n * m = 1)) (mul_comm n m))) H)

/-! ### `succ` -/

theorem eq_of_lt_succ_of_not_lt {a : ℕ} {b : ℕ} (h1 : a < b + 1) (h2 : ¬a < b) : a = b :=
  (fun (h3 : a ≤ b) =>
      or.elim (eq_or_lt_of_not_lt h2) (fun (h : a = b) => h) fun (h : b < a) => absurd h (not_lt_of_ge h3))
    (le_of_lt_succ h1)

theorem one_add (n : ℕ) : 1 + n = Nat.succ n := sorry

@[simp] theorem succ_pos' {n : ℕ} : 0 < Nat.succ n :=
  succ_pos n

theorem succ_inj' {n : ℕ} {m : ℕ} : Nat.succ n = Nat.succ m ↔ n = m :=
  { mp := succ.inj, mpr := congr_arg fun {n : ℕ} => Nat.succ n }

theorem succ_injective : function.injective Nat.succ :=
  fun (x y : ℕ) => succ.inj

theorem succ_le_succ_iff {m : ℕ} {n : ℕ} : Nat.succ m ≤ Nat.succ n ↔ m ≤ n :=
  { mp := le_of_succ_le_succ, mpr := succ_le_succ }

theorem max_succ_succ {m : ℕ} {n : ℕ} : max (Nat.succ m) (Nat.succ n) = Nat.succ (max m n) := sorry

theorem not_succ_lt_self {n : ℕ} : ¬Nat.succ n < n :=
  not_lt_of_ge (le_succ n)

theorem lt_succ_iff {m : ℕ} {n : ℕ} : m < Nat.succ n ↔ m ≤ n :=
  succ_le_succ_iff

theorem succ_le_iff {m : ℕ} {n : ℕ} : Nat.succ m ≤ n ↔ m < n :=
  { mp := lt_of_succ_le, mpr := succ_le_of_lt }

theorem lt_iff_add_one_le {m : ℕ} {n : ℕ} : m < n ↔ m + 1 ≤ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m < n ↔ m + 1 ≤ n)) (propext succ_le_iff))) (iff.refl (m < n))

-- Just a restatement of `nat.lt_succ_iff` using `+1`.

theorem lt_add_one_iff {a : ℕ} {b : ℕ} : a < b + 1 ↔ a ≤ b :=
  lt_succ_iff

-- A flipped version of `lt_add_one_iff`.

theorem lt_one_add_iff {a : ℕ} {b : ℕ} : a < 1 + b ↔ a ≤ b := sorry

-- This is true reflexively, by the definition of `≤` on ℕ,

-- but it's still useful to have, to convince Lean to change the syntactic type.

theorem add_one_le_iff {a : ℕ} {b : ℕ} : a + 1 ≤ b ↔ a < b :=
  iff.refl (a + 1 ≤ b)

theorem one_add_le_iff {a : ℕ} {b : ℕ} : 1 + a ≤ b ↔ a < b := sorry

theorem of_le_succ {n : ℕ} {m : ℕ} (H : n ≤ Nat.succ m) : n ≤ m ∨ n = Nat.succ m :=
  or.imp le_of_lt_succ id (lt_or_eq_of_le H)

theorem succ_lt_succ_iff {m : ℕ} {n : ℕ} : Nat.succ m < Nat.succ n ↔ m < n :=
  { mp := lt_of_succ_lt_succ, mpr := succ_lt_succ }

/-! ### `add` -/

-- Sometimes a bare `nat.add` or similar appears as a consequence of unfolding

-- during pattern matching. These lemmas package them back up as typeclass

-- mediated operations.

@[simp] theorem add_def {a : ℕ} {b : ℕ} : Nat.add a b = a + b :=
  rfl

@[simp] theorem mul_def {a : ℕ} {b : ℕ} : Nat.mul a b = a * b :=
  rfl

theorem exists_eq_add_of_le {m : ℕ} {n : ℕ} : m ≤ n → ∃ (k : ℕ), n = m + k := sorry

theorem exists_eq_add_of_lt {m : ℕ} {n : ℕ} : m < n → ∃ (k : ℕ), n = m + k + 1 := sorry

theorem add_pos_left {m : ℕ} (h : 0 < m) (n : ℕ) : 0 < m + n :=
  gt_of_gt_of_ge (trans_rel_left gt (nat.add_lt_add_right h n) (nat.zero_add n)) (zero_le n)

theorem add_pos_right (m : ℕ) {n : ℕ} (h : 0 < n) : 0 < m + n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 < m + n)) (add_comm m n))) (add_pos_left h m)

theorem add_pos_iff_pos_or_pos (m : ℕ) (n : ℕ) : 0 < m + n ↔ 0 < m ∨ 0 < n := sorry

theorem add_eq_one_iff {a : ℕ} {b : ℕ} : a + b = 1 ↔ a = 0 ∧ b = 1 ∨ a = 1 ∧ b = 0 := sorry

theorem le_add_one_iff {i : ℕ} {j : ℕ} : i ≤ j + 1 ↔ i ≤ j ∨ i = j + 1 := sorry

theorem add_succ_lt_add {a : ℕ} {b : ℕ} {c : ℕ} {d : ℕ} (hab : a < b) (hcd : c < d) : a + c + 1 < b + d :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + c + 1 < b + d)) (add_assoc a c 1)))
    (add_lt_add_of_lt_of_le hab (iff.mpr succ_le_iff hcd))

/-! ### `pred` -/

@[simp] theorem add_succ_sub_one (n : ℕ) (m : ℕ) : n + Nat.succ m - 1 = n + m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n + Nat.succ m - 1 = n + m)) (add_succ n m)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (Nat.succ (n + m) - 1 = n + m)) (succ_sub_one (n + m)))) (Eq.refl (n + m)))

@[simp] theorem succ_add_sub_one (n : ℕ) (m : ℕ) : Nat.succ n + m - 1 = n + m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (Nat.succ n + m - 1 = n + m)) (succ_add n m)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (Nat.succ (n + m) - 1 = n + m)) (succ_sub_one (n + m)))) (Eq.refl (n + m)))

theorem pred_eq_sub_one (n : ℕ) : Nat.pred n = n - 1 :=
  rfl

theorem pred_eq_of_eq_succ {m : ℕ} {n : ℕ} (H : m = Nat.succ n) : Nat.pred m = n := sorry

@[simp] theorem pred_eq_succ_iff {n : ℕ} {m : ℕ} : Nat.pred n = Nat.succ m ↔ n = m + bit0 1 := sorry

theorem pred_sub (n : ℕ) (m : ℕ) : Nat.pred n - m = Nat.pred (n - m) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (Nat.pred n - m = Nat.pred (n - m))) (Eq.symm (sub_one n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (n - 1 - m = Nat.pred (n - m))) (nat.sub_sub n 1 m)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (n - (1 + m) = Nat.pred (n - m))) (one_add m))) (Eq.refl (n - Nat.succ m))))

theorem le_pred_of_lt {n : ℕ} {m : ℕ} (h : m < n) : m ≤ n - 1 :=
  nat.sub_le_sub_right h 1

theorem le_of_pred_lt {m : ℕ} {n : ℕ} : Nat.pred m < n → m ≤ n := sorry

/-- This ensures that `simp` succeeds on `pred (n + 1) = n`. -/
@[simp] theorem pred_one_add (n : ℕ) : Nat.pred (1 + n) = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (Nat.pred (1 + n) = n)) (add_comm 1 n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (Nat.pred (n + 1) = n)) (add_one n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (Nat.pred (Nat.succ n) = n)) (pred_succ n))) (Eq.refl n)))

/-! ### `sub` -/

protected theorem le_sub_add (n : ℕ) (m : ℕ) : n ≤ n - m + m := sorry

theorem sub_add_eq_max (n : ℕ) (m : ℕ) : n - m + m = max n m := sorry

theorem add_sub_eq_max (n : ℕ) (m : ℕ) : n + (m - n) = max n m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n + (m - n) = max n m)) (add_comm n (m - n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (m - n + n = max n m)) (max_comm n m)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (m - n + n = max m n)) (sub_add_eq_max m n))) (Eq.refl (max m n))))

theorem sub_add_min (n : ℕ) (m : ℕ) : n - m + min n m = n := sorry

protected theorem add_sub_cancel' {n : ℕ} {m : ℕ} (h : m ≤ n) : m + (n - m) = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m + (n - m) = n)) (add_comm m (n - m))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (n - m + m = n)) (nat.sub_add_cancel h))) (Eq.refl n))

protected theorem sub_add_sub_cancel {a : ℕ} {b : ℕ} {c : ℕ} (hab : b ≤ a) (hbc : c ≤ b) : a - b + (b - c) = a - c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b + (b - c) = a - c)) (Eq.symm (nat.add_sub_assoc hbc (a - b)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - b + b - c = a - c)) (Eq.symm (nat.sub_add_comm hab))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a + b - b - c = a - c)) (nat.add_sub_cancel a b))) (Eq.refl (a - c))))

protected theorem sub_eq_of_eq_add {m : ℕ} {n : ℕ} {k : ℕ} (h : k = m + n) : k - m = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (k - m = n)) h))
    (eq.mpr (id (Eq._oldrec (Eq.refl (m + n - m = n)) (nat.add_sub_cancel_left m n))) (Eq.refl n))

theorem sub_cancel {a : ℕ} {b : ℕ} {c : ℕ} (h₁ : a ≤ b) (h₂ : a ≤ c) (w : b - a = c - a) : b = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b = c)) (Eq.symm (nat.sub_add_cancel h₁))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b - a + a = c)) (Eq.symm (nat.sub_add_cancel h₂))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (b - a + a = c - a + a)) w)) (Eq.refl (c - a + a))))

theorem sub_sub_sub_cancel_right {a : ℕ} {b : ℕ} {c : ℕ} (h₂ : c ≤ b) : a - c - (b - c) = a - b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - c - (b - c) = a - b)) (nat.sub_sub a c (b - c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - (c + (b - c)) = a - b)) (Eq.symm (nat.add_sub_assoc h₂ c))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a - (c + b - c) = a - b)) (nat.add_sub_cancel_left c b))) (Eq.refl (a - b))))

theorem add_sub_cancel_right (n : ℕ) (m : ℕ) (k : ℕ) : n + (m + k) - k = n + m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n + (m + k) - k = n + m)) (nat.add_sub_assoc (le_add_left k m) n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (n + (m + k - k) = n + m)) (nat.add_sub_cancel m k))) (Eq.refl (n + m)))

protected theorem sub_add_eq_add_sub {a : ℕ} {b : ℕ} {c : ℕ} (h : b ≤ a) : a - b + c = a + c - b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b + c = a + c - b)) (add_comm a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - b + c = c + a - b)) (nat.add_sub_assoc h c)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a - b + c = c + (a - b))) (add_comm (a - b) c))) (Eq.refl (c + (a - b)))))

theorem sub_min (n : ℕ) (m : ℕ) : n - min n m = n - m :=
  nat.sub_eq_of_eq_add
    (eq.mpr (id (Eq._oldrec (Eq.refl (n = min n m + (n - m))) (add_comm (min n m) (n - m))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (n = n - m + min n m)) (sub_add_min n m))) (Eq.refl n)))

theorem sub_sub_assoc {a : ℕ} {b : ℕ} {c : ℕ} (h₁ : b ≤ a) (h₂ : c ≤ b) : a - (b - c) = a - b + c := sorry

protected theorem lt_of_sub_pos {m : ℕ} {n : ℕ} (h : 0 < n - m) : m < n :=
  lt_of_not_ge
    fun (this : n ≤ m) =>
      (fun (this : n - m = 0) => lt_irrefl 0 (eq.mp (Eq._oldrec (Eq.refl (0 < n - m)) this) h)) (sub_eq_zero_of_le this)

protected theorem lt_of_sub_lt_sub_right {m : ℕ} {n : ℕ} {k : ℕ} : m - k < n - k → m < n :=
  lt_imp_lt_of_le_imp_le fun (h : n ≤ m) => nat.sub_le_sub_right h k

protected theorem lt_of_sub_lt_sub_left {m : ℕ} {n : ℕ} {k : ℕ} : m - n < m - k → k < n :=
  lt_imp_lt_of_le_imp_le (nat.sub_le_sub_left m)

protected theorem sub_lt_self {m : ℕ} {n : ℕ} (h₁ : 0 < m) (h₂ : 0 < n) : m - n < m := sorry

protected theorem le_sub_right_of_add_le {m : ℕ} {n : ℕ} {k : ℕ} (h : m + k ≤ n) : m ≤ n - k :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m ≤ n - k)) (Eq.symm (nat.add_sub_cancel m k)))) (nat.sub_le_sub_right h k)

protected theorem le_sub_left_of_add_le {m : ℕ} {n : ℕ} {k : ℕ} (h : k + m ≤ n) : m ≤ n - k :=
  nat.le_sub_right_of_add_le (eq.mp (Eq._oldrec (Eq.refl (k + m ≤ n)) (add_comm k m)) h)

protected theorem lt_sub_right_of_add_lt {m : ℕ} {n : ℕ} {k : ℕ} (h : m + k < n) : m < n - k :=
  lt_of_succ_le
    (nat.le_sub_right_of_add_le
      (eq.mpr (id (Eq._oldrec (Eq.refl (Nat.succ m + k ≤ n)) (succ_add m k))) (succ_le_of_lt h)))

protected theorem lt_sub_left_of_add_lt {m : ℕ} {n : ℕ} {k : ℕ} (h : k + m < n) : m < n - k :=
  nat.lt_sub_right_of_add_lt (eq.mp (Eq._oldrec (Eq.refl (k + m < n)) (add_comm k m)) h)

protected theorem add_lt_of_lt_sub_right {m : ℕ} {n : ℕ} {k : ℕ} (h : m < n - k) : m + k < n :=
  nat.lt_of_sub_lt_sub_right (eq.mpr (id (Eq._oldrec (Eq.refl (m + k - k < n - k)) (nat.add_sub_cancel m k))) h)

protected theorem add_lt_of_lt_sub_left {m : ℕ} {n : ℕ} {k : ℕ} (h : m < n - k) : k + m < n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (k + m < n)) (add_comm k m))) (nat.add_lt_of_lt_sub_right h)

protected theorem le_add_of_sub_le_right {m : ℕ} {n : ℕ} {k : ℕ} : n - k ≤ m → n ≤ m + k :=
  le_imp_le_of_lt_imp_lt nat.lt_sub_right_of_add_lt

protected theorem le_add_of_sub_le_left {m : ℕ} {n : ℕ} {k : ℕ} : n - k ≤ m → n ≤ k + m :=
  le_imp_le_of_lt_imp_lt nat.lt_sub_left_of_add_lt

protected theorem lt_add_of_sub_lt_right {m : ℕ} {n : ℕ} {k : ℕ} : n - k < m → n < m + k :=
  lt_imp_lt_of_le_imp_le nat.le_sub_right_of_add_le

protected theorem lt_add_of_sub_lt_left {m : ℕ} {n : ℕ} {k : ℕ} : n - k < m → n < k + m :=
  lt_imp_lt_of_le_imp_le nat.le_sub_left_of_add_le

protected theorem sub_le_left_of_le_add {m : ℕ} {n : ℕ} {k : ℕ} : n ≤ k + m → n - k ≤ m :=
  le_imp_le_of_lt_imp_lt nat.add_lt_of_lt_sub_left

protected theorem sub_le_right_of_le_add {m : ℕ} {n : ℕ} {k : ℕ} : n ≤ m + k → n - k ≤ m :=
  le_imp_le_of_lt_imp_lt nat.add_lt_of_lt_sub_right

protected theorem sub_lt_left_iff_lt_add {m : ℕ} {n : ℕ} {k : ℕ} (H : n ≤ k) : k - n < m ↔ k < n + m := sorry

protected theorem le_sub_left_iff_add_le {m : ℕ} {n : ℕ} {k : ℕ} (H : m ≤ k) : n ≤ k - m ↔ m + n ≤ k :=
  iff.mpr le_iff_le_iff_lt_iff_lt (nat.sub_lt_left_iff_lt_add H)

protected theorem le_sub_right_iff_add_le {m : ℕ} {n : ℕ} {k : ℕ} (H : n ≤ k) : m ≤ k - n ↔ m + n ≤ k :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m ≤ k - n ↔ m + n ≤ k)) (propext (nat.le_sub_left_iff_add_le H))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (n + m ≤ k ↔ m + n ≤ k)) (add_comm n m))) (iff.refl (m + n ≤ k)))

protected theorem lt_sub_left_iff_add_lt {m : ℕ} {n : ℕ} {k : ℕ} : n < k - m ↔ m + n < k :=
  { mp := nat.add_lt_of_lt_sub_left, mpr := nat.lt_sub_left_of_add_lt }

protected theorem lt_sub_right_iff_add_lt {m : ℕ} {n : ℕ} {k : ℕ} : m < k - n ↔ m + n < k :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m < k - n ↔ m + n < k)) (propext nat.lt_sub_left_iff_add_lt)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (n + m < k ↔ m + n < k)) (add_comm n m))) (iff.refl (m + n < k)))

theorem sub_le_left_iff_le_add {m : ℕ} {n : ℕ} {k : ℕ} : m - n ≤ k ↔ m ≤ n + k :=
  iff.mpr le_iff_le_iff_lt_iff_lt nat.lt_sub_left_iff_add_lt

theorem sub_le_right_iff_le_add {m : ℕ} {n : ℕ} {k : ℕ} : m - k ≤ n ↔ m ≤ n + k :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m - k ≤ n ↔ m ≤ n + k)) (propext sub_le_left_iff_le_add)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (m ≤ k + n ↔ m ≤ n + k)) (add_comm k n))) (iff.refl (m ≤ n + k)))

protected theorem sub_lt_right_iff_lt_add {m : ℕ} {n : ℕ} {k : ℕ} (H : k ≤ m) : m - k < n ↔ m < n + k :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m - k < n ↔ m < n + k)) (propext (nat.sub_lt_left_iff_lt_add H))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (m < k + n ↔ m < n + k)) (add_comm k n))) (iff.refl (m < n + k)))

protected theorem sub_le_sub_left_iff {m : ℕ} {n : ℕ} {k : ℕ} (H : k ≤ m) : m - n ≤ m - k ↔ k ≤ n := sorry

protected theorem sub_lt_sub_right_iff {m : ℕ} {n : ℕ} {k : ℕ} (H : k ≤ m) : m - k < n - k ↔ m < n :=
  lt_iff_lt_of_le_iff_le (nat.sub_le_sub_right_iff n m k H)

protected theorem sub_lt_sub_left_iff {m : ℕ} {n : ℕ} {k : ℕ} (H : n ≤ m) : m - n < m - k ↔ k < n :=
  lt_iff_lt_of_le_iff_le (nat.sub_le_sub_left_iff H)

protected theorem sub_le_iff {m : ℕ} {n : ℕ} {k : ℕ} : m - n ≤ k ↔ m - k ≤ n :=
  iff.trans sub_le_left_iff_le_add (iff.symm sub_le_right_iff_le_add)

protected theorem sub_le_self (n : ℕ) (m : ℕ) : n - m ≤ n :=
  nat.sub_le_left_of_le_add (le_add_left n m)

protected theorem sub_lt_iff {m : ℕ} {n : ℕ} {k : ℕ} (h₁ : n ≤ m) (h₂ : k ≤ m) : m - n < k ↔ m - k < n :=
  iff.trans (nat.sub_lt_left_iff_lt_add h₁) (iff.symm (nat.sub_lt_right_iff_lt_add h₂))

theorem pred_le_iff {n : ℕ} {m : ℕ} : Nat.pred n ≤ m ↔ n ≤ Nat.succ m :=
  sub_le_right_iff_le_add

theorem lt_pred_iff {n : ℕ} {m : ℕ} : n < Nat.pred m ↔ Nat.succ n < m :=
  nat.lt_sub_right_iff_add_lt

theorem lt_of_lt_pred {a : ℕ} {b : ℕ} (h : a < b - 1) : a < b :=
  lt_of_succ_lt (iff.mp lt_pred_iff h)

/-! ### `mul` -/

theorem mul_self_le_mul_self {n : ℕ} {m : ℕ} (h : n ≤ m) : n * n ≤ m * m :=
  mul_le_mul h h (zero_le n) (zero_le m)

theorem mul_self_lt_mul_self {n : ℕ} {m : ℕ} : n < m → n * n < m * m := sorry

theorem mul_self_le_mul_self_iff {n : ℕ} {m : ℕ} : n ≤ m ↔ n * n ≤ m * m := sorry

theorem mul_self_lt_mul_self_iff {n : ℕ} {m : ℕ} : n < m ↔ n * n < m * m :=
  iff.trans (lt_iff_not_ge n m)
    (iff.trans (not_iff_not_of_iff mul_self_le_mul_self_iff) (iff.symm (lt_iff_not_ge (n * n) (m * m))))

theorem le_mul_self (n : ℕ) : n ≤ n * n := sorry

theorem le_mul_of_pos_left {m : ℕ} {n : ℕ} (h : 0 < n) : m ≤ n * m := sorry

theorem le_mul_of_pos_right {m : ℕ} {n : ℕ} (h : 0 < n) : m ≤ m * n := sorry

theorem two_mul_ne_two_mul_add_one {n : ℕ} {m : ℕ} : bit0 1 * n ≠ bit0 1 * m + 1 := sorry

theorem mul_eq_one_iff {a : ℕ} {b : ℕ} : a * b = 1 ↔ a = 1 ∧ b = 1 := sorry

protected theorem mul_left_inj {a : ℕ} {b : ℕ} {c : ℕ} (ha : 0 < a) : b * a = c * a ↔ b = c :=
  { mp := eq_of_mul_eq_mul_right ha, mpr := fun (e : b = c) => e ▸ rfl }

protected theorem mul_right_inj {a : ℕ} {b : ℕ} {c : ℕ} (ha : 0 < a) : a * b = a * c ↔ b = c :=
  { mp := eq_of_mul_eq_mul_left ha, mpr := fun (e : b = c) => e ▸ rfl }

theorem mul_left_injective {a : ℕ} (ha : 0 < a) : function.injective fun (x : ℕ) => x * a :=
  fun (_x _x_1 : ℕ) => eq_of_mul_eq_mul_right ha

theorem mul_right_injective {a : ℕ} (ha : 0 < a) : function.injective fun (x : ℕ) => a * x :=
  fun (_x _x_1 : ℕ) => eq_of_mul_eq_mul_left ha

theorem mul_right_eq_self_iff {a : ℕ} {b : ℕ} (ha : 0 < a) : a * b = a ↔ b = 1 :=
  (fun (this : a * b = a * 1 ↔ b = 1) => eq.mp (Eq._oldrec (Eq.refl (a * b = a * 1 ↔ b = 1)) (mul_one a)) this)
    (nat.mul_right_inj ha)

theorem mul_left_eq_self_iff {a : ℕ} {b : ℕ} (hb : 0 < b) : a * b = b ↔ a = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b = b ↔ a = 1)) (mul_comm a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b * a = b ↔ a = 1)) (propext (mul_right_eq_self_iff hb)))) (iff.refl (a = 1)))

theorem lt_succ_iff_lt_or_eq {n : ℕ} {i : ℕ} : n < Nat.succ i ↔ n < i ∨ n = i :=
  iff.trans lt_succ_iff le_iff_lt_or_eq

theorem mul_self_inj {n : ℕ} {m : ℕ} : n * n = m * m ↔ n = m :=
  iff.trans le_antisymm_iff
    (iff.symm (iff.trans le_antisymm_iff (and_congr mul_self_le_mul_self_iff mul_self_le_mul_self_iff)))

/-!
### Recursion and induction principles

This section is here due to dependencies -- the lemmas here require some of the lemmas
proved above, and some of the results in later sections depend on the definitions in this section.
-/

@[simp] theorem rec_zero {C : ℕ → Sort u} (h0 : C 0) (h : (n : ℕ) → C n → C (n + 1)) : Nat.rec h0 h 0 = h0 :=
  rfl

@[simp] theorem rec_add_one {C : ℕ → Sort u} (h0 : C 0) (h : (n : ℕ) → C n → C (n + 1)) (n : ℕ) : Nat.rec h0 h (n + 1) = h n (Nat.rec h0 h n) :=
  rfl

/-- Recursion starting at a non-zero number: given a map `C k → C (k+1)` for each `k`,
there is a map from `C n` to each `C m`, `n ≤ m`. -/
def le_rec_on {C : ℕ → Sort u} {n : ℕ} {m : ℕ} : n ≤ m → ({k : ℕ} → C k → C (k + 1)) → C n → C m :=
  sorry

theorem le_rec_on_self {C : ℕ → Sort u} {n : ℕ} {h : n ≤ n} {next : {k : ℕ} → C k → C (k + 1)} (x : C n) : le_rec_on h next x = x := sorry

theorem le_rec_on_succ {C : ℕ → Sort u} {n : ℕ} {m : ℕ} (h1 : n ≤ m) {h2 : n ≤ m + 1} {next : {k : ℕ} → C k → C (k + 1)} (x : C n) : le_rec_on h2 next x = next (le_rec_on h1 next x) := sorry

theorem le_rec_on_succ' {C : ℕ → Sort u} {n : ℕ} {h : n ≤ n + 1} {next : {k : ℕ} → C k → C (k + 1)} (x : C n) : le_rec_on h next x = next x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (le_rec_on h next x = next x)) (le_rec_on_succ (le_refl n) x)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (next (le_rec_on (le_refl n) next x) = next x)) (le_rec_on_self x)))
      (Eq.refl (next x)))

theorem le_rec_on_trans {C : ℕ → Sort u} {n : ℕ} {m : ℕ} {k : ℕ} (hnm : n ≤ m) (hmk : m ≤ k) {next : {k : ℕ} → C k → C (k + 1)} (x : C n) : le_rec_on (le_trans hnm hmk) next x = le_rec_on hmk next (le_rec_on hnm next x) := sorry

theorem le_rec_on_succ_left {C : ℕ → Sort u} {n : ℕ} {m : ℕ} (h1 : n ≤ m) (h2 : n + 1 ≤ m) {next : {k : ℕ} → C k → C (k + 1)} (x : C n) : le_rec_on h2 next (next x) = le_rec_on h1 next x := sorry

theorem le_rec_on_injective {C : ℕ → Sort u} {n : ℕ} {m : ℕ} (hnm : n ≤ m) (next : (n : ℕ) → C n → C (n + 1)) (Hnext : ∀ (n : ℕ), function.injective (next n)) : function.injective (le_rec_on hnm next) := sorry

theorem le_rec_on_surjective {C : ℕ → Sort u} {n : ℕ} {m : ℕ} (hnm : n ≤ m) (next : (n : ℕ) → C n → C (n + 1)) (Hnext : ∀ (n : ℕ), function.surjective (next n)) : function.surjective (le_rec_on hnm next) := sorry

/-- Recursion principle based on `<`. -/
protected def strong_rec' {p : ℕ → Sort u} (H : (n : ℕ) → ((m : ℕ) → m < n → p m) → p n) (n : ℕ) : p n :=
  sorry

/-- Recursion principle based on `<` applied to some natural number. -/
def strong_rec_on' {P : ℕ → Sort u_1} (n : ℕ) (h : (n : ℕ) → ((m : ℕ) → m < n → P m) → P n) : P n :=
  nat.strong_rec' h n

theorem strong_rec_on_beta' {P : ℕ → Sort u_1} {h : (n : ℕ) → ((m : ℕ) → m < n → P m) → P n} {n : ℕ} : strong_rec_on' n h = h n fun (m : ℕ) (hmn : m < n) => strong_rec_on' m h := sorry

/-- Induction principle starting at a non-zero number. For maps to a `Sort*` see `le_rec_on`. -/
theorem le_induction {P : ℕ → Prop} {m : ℕ} (h0 : P m) (h1 : ∀ (n : ℕ), m ≤ n → P n → P (n + 1)) (n : ℕ) : m ≤ n → P n :=
  less_than_or_equal._oldrec h0 h1

/-- Decreasing induction: if `P (k+1)` implies `P k`, then `P n` implies `P m` for all `m ≤ n`.
Also works for functions to `Sort*`. -/
def decreasing_induction {P : ℕ → Sort u_1} (h : (n : ℕ) → P (n + 1) → P n) {m : ℕ} {n : ℕ} (mn : m ≤ n) (hP : P n) : P m :=
  le_rec_on mn (fun (k : ℕ) (ih : P k → P m) (hsk : P (k + 1)) => ih (h k hsk)) (fun (h : P m) => h) hP

@[simp] theorem decreasing_induction_self {P : ℕ → Sort u_1} (h : (n : ℕ) → P (n + 1) → P n) {n : ℕ} (nn : n ≤ n) (hP : P n) : decreasing_induction h nn hP = hP := sorry

theorem decreasing_induction_succ {P : ℕ → Sort u_1} (h : (n : ℕ) → P (n + 1) → P n) {m : ℕ} {n : ℕ} (mn : m ≤ n) (msn : m ≤ n + 1) (hP : P (n + 1)) : decreasing_induction h msn hP = decreasing_induction h mn (h n hP) := sorry

@[simp] theorem decreasing_induction_succ' {P : ℕ → Sort u_1} (h : (n : ℕ) → P (n + 1) → P n) {m : ℕ} (msm : m ≤ m + 1) (hP : P (m + 1)) : decreasing_induction h msm hP = h m hP := sorry

theorem decreasing_induction_trans {P : ℕ → Sort u_1} (h : (n : ℕ) → P (n + 1) → P n) {m : ℕ} {n : ℕ} {k : ℕ} (mn : m ≤ n) (nk : n ≤ k) (hP : P k) : decreasing_induction h (le_trans mn nk) hP = decreasing_induction h mn (decreasing_induction h nk hP) := sorry

theorem decreasing_induction_succ_left {P : ℕ → Sort u_1} (h : (n : ℕ) → P (n + 1) → P n) {m : ℕ} {n : ℕ} (smn : m + 1 ≤ n) (mn : m ≤ n) (hP : P n) : decreasing_induction h mn hP = h m (decreasing_induction h smn hP) := sorry

/-! ### `div` -/

protected theorem div_le_of_le_mul' {m : ℕ} {n : ℕ} {k : ℕ} (h : m ≤ k * n) : m / k ≤ n := sorry

protected theorem div_le_self' (m : ℕ) (n : ℕ) : m / n ≤ m := sorry

/-- A version of `nat.div_lt_self` using successors, rather than additional hypotheses. -/
theorem div_lt_self' (n : ℕ) (b : ℕ) : (n + 1) / (b + bit0 1) < n + 1 :=
  div_lt_self (succ_pos n) (succ_lt_succ (succ_pos b))

theorem le_div_iff_mul_le' {x : ℕ} {y : ℕ} {k : ℕ} (k0 : 0 < k) : x ≤ y / k ↔ x * k ≤ y :=
  le_div_iff_mul_le x y k0

theorem div_lt_iff_lt_mul' {x : ℕ} {y : ℕ} {k : ℕ} (k0 : 0 < k) : x / k < y ↔ x < y * k :=
  lt_iff_lt_of_le_iff_le (le_div_iff_mul_le' k0)

protected theorem div_le_div_right {n : ℕ} {m : ℕ} (h : n ≤ m) {k : ℕ} : n / k ≤ m / k := sorry

theorem lt_of_div_lt_div {m : ℕ} {n : ℕ} {k : ℕ} (h : m / k < n / k) : m < n :=
  by_contradiction fun (h₁ : ¬m < n) => absurd h (not_lt_of_ge (nat.div_le_div_right (iff.mp not_lt h₁)))

protected theorem div_pos {a : ℕ} {b : ℕ} (hba : b ≤ a) (hb : 0 < b) : 0 < a / b := sorry

protected theorem div_lt_of_lt_mul {m : ℕ} {n : ℕ} {k : ℕ} (h : m < n * k) : m / n < k :=
  lt_of_mul_lt_mul_left (lt_of_le_of_lt (trans_rel_left LessEq (le_add_left (n * (m / n)) (m % n)) (mod_add_div m n)) h)
    (zero_le n)

theorem lt_mul_of_div_lt {a : ℕ} {b : ℕ} {c : ℕ} (h : a / c < b) (w : 0 < c) : a < b * c :=
  lt_of_not_ge (not_le_of_gt h ∘ iff.mpr (le_div_iff_mul_le b a w))

protected theorem div_eq_zero_iff {a : ℕ} {b : ℕ} (hb : 0 < b) : a / b = 0 ↔ a < b := sorry

protected theorem div_eq_zero {a : ℕ} {b : ℕ} (hb : a < b) : a / b = 0 :=
  iff.mpr (nat.div_eq_zero_iff (has_le.le.trans_lt (zero_le a) hb)) hb

theorem eq_zero_of_le_div {a : ℕ} {b : ℕ} (hb : bit0 1 ≤ b) (h : a ≤ a / b) : a = 0 :=
  eq_zero_of_mul_le hb
    (eq.mpr (id (Eq._oldrec (Eq.refl (b * a ≤ a)) (mul_comm b a)))
      (iff.mp (le_div_iff_mul_le' (lt_of_lt_of_le (of_as_true trivial) hb)) h))

theorem mul_div_le_mul_div_assoc (a : ℕ) (b : ℕ) (c : ℕ) : a * (b / c) ≤ a * b / c := sorry

theorem div_mul_div_le_div (a : ℕ) (b : ℕ) (c : ℕ) : a / c * b / a ≤ b / c := sorry

theorem eq_zero_of_le_half {a : ℕ} (h : a ≤ a / bit0 1) : a = 0 :=
  eq_zero_of_le_div (le_refl (bit0 1)) h

protected theorem eq_mul_of_div_eq_right {a : ℕ} {b : ℕ} {c : ℕ} (H1 : b ∣ a) (H2 : a / b = c) : a = b * c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b * c)) (Eq.symm H2)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = b * (a / b))) (nat.mul_div_cancel' H1))) (Eq.refl a))

protected theorem div_eq_iff_eq_mul_right {a : ℕ} {b : ℕ} {c : ℕ} (H : 0 < b) (H' : b ∣ a) : a / b = c ↔ a = b * c :=
  { mp := nat.eq_mul_of_div_eq_right H', mpr := nat.div_eq_of_eq_mul_right H }

protected theorem div_eq_iff_eq_mul_left {a : ℕ} {b : ℕ} {c : ℕ} (H : 0 < b) (H' : b ∣ a) : a / b = c ↔ a = c * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b = c ↔ a = c * b)) (mul_comm c b))) (nat.div_eq_iff_eq_mul_right H H')

protected theorem eq_mul_of_div_eq_left {a : ℕ} {b : ℕ} {c : ℕ} (H1 : b ∣ a) (H2 : a / b = c) : a = c * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = c * b)) (mul_comm c b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = b * c)) (nat.eq_mul_of_div_eq_right H1 H2))) (Eq.refl (b * c)))

protected theorem mul_div_cancel_left' {a : ℕ} {b : ℕ} (Hd : a ∣ b) : a * (b / a) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * (b / a) = b)) (mul_comm a (b / a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b / a * a = b)) (nat.div_mul_cancel Hd))) (Eq.refl b))

/-! ### `mod`, `dvd` -/

protected theorem div_mod_unique {n : ℕ} {k : ℕ} {m : ℕ} {d : ℕ} (h : 0 < k) : n / k = d ∧ n % k = m ↔ m + k * d = n ∧ m < k := sorry

theorem two_mul_odd_div_two {n : ℕ} (hn : n % bit0 1 = 1) : bit0 1 * (n / bit0 1) = n - 1 := sorry

theorem div_dvd_of_dvd {a : ℕ} {b : ℕ} (h : b ∣ a) : a / b ∣ a :=
  Exists.intro b (Eq.symm (nat.div_mul_cancel h))

protected theorem div_div_self {a : ℕ} {b : ℕ} : b ∣ a → 0 < a → a / (a / b) = b := sorry

theorem mod_mul_right_div_self (a : ℕ) (b : ℕ) (c : ℕ) : a % (b * c) / b = a / b % c := sorry

theorem mod_mul_left_div_self (a : ℕ) (b : ℕ) (c : ℕ) : a % (c * b) / b = a / b % c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a % (c * b) / b = a / b % c)) (mul_comm c b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a % (b * c) / b = a / b % c)) (mod_mul_right_div_self a b c)))
      (Eq.refl (a / b % c)))

@[simp] protected theorem dvd_one {n : ℕ} : n ∣ 1 ↔ n = 1 :=
  { mp := eq_one_of_dvd_one, mpr := fun (e : n = 1) => Eq.symm e ▸ dvd_refl 1 }

protected theorem dvd_add_left {k : ℕ} {m : ℕ} {n : ℕ} (h : k ∣ n) : k ∣ m + n ↔ k ∣ m :=
  iff.symm (nat.dvd_add_iff_left h)

protected theorem dvd_add_right {k : ℕ} {m : ℕ} {n : ℕ} (h : k ∣ m) : k ∣ m + n ↔ k ∣ n :=
  iff.symm (nat.dvd_add_iff_right h)

@[simp] protected theorem not_two_dvd_bit1 (n : ℕ) : ¬bit0 1 ∣ bit1 n :=
  mt (iff.mp (nat.dvd_add_right two_dvd_bit0)) (of_as_true trivial)

/-- A natural number `m` divides the sum `m + n` if and only if `m` divides `n`.-/
@[simp] protected theorem dvd_add_self_left {m : ℕ} {n : ℕ} : m ∣ m + n ↔ m ∣ n :=
  nat.dvd_add_right (dvd_refl m)

/-- A natural number `m` divides the sum `n + m` if and only if `m` divides `n`.-/
@[simp] protected theorem dvd_add_self_right {m : ℕ} {n : ℕ} : m ∣ n + m ↔ m ∣ n :=
  nat.dvd_add_left (dvd_refl m)

theorem not_dvd_of_pos_of_lt {a : ℕ} {b : ℕ} (h1 : 0 < b) (h2 : b < a) : ¬a ∣ b := sorry

protected theorem mul_dvd_mul_iff_left {a : ℕ} {b : ℕ} {c : ℕ} (ha : 0 < a) : a * b ∣ a * c ↔ b ∣ c := sorry

protected theorem mul_dvd_mul_iff_right {a : ℕ} {b : ℕ} {c : ℕ} (hc : 0 < c) : a * c ∣ b * c ↔ a ∣ b := sorry

theorem succ_div (a : ℕ) (b : ℕ) : (a + 1) / b = a / b + ite (b ∣ a + 1) 1 0 := sorry

theorem succ_div_of_dvd {a : ℕ} {b : ℕ} (hba : b ∣ a + 1) : (a + 1) / b = a / b + 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl ((a + 1) / b = a / b + 1)) (succ_div a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / b + ite (b ∣ a + 1) 1 0 = a / b + 1)) (if_pos hba))) (Eq.refl (a / b + 1)))

theorem succ_div_of_not_dvd {a : ℕ} {b : ℕ} (hba : ¬b ∣ a + 1) : (a + 1) / b = a / b :=
  eq.mpr (id (Eq._oldrec (Eq.refl ((a + 1) / b = a / b)) (succ_div a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / b + ite (b ∣ a + 1) 1 0 = a / b)) (if_neg hba)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a / b + 0 = a / b)) (add_zero (a / b)))) (Eq.refl (a / b))))

@[simp] theorem mod_mod_of_dvd (n : ℕ) {m : ℕ} {k : ℕ} (h : m ∣ k) : n % k % m = n % m := sorry

@[simp] theorem mod_mod (a : ℕ) (n : ℕ) : a % n % n = a % n := sorry

/--  If `a` and `b` are equal mod `c`, `a - b` is zero mod `c`. -/
theorem sub_mod_eq_zero_of_mod_eq {a : ℕ} {b : ℕ} {c : ℕ} (h : a % c = b % c) : (a - b) % c = 0 := sorry

@[simp] theorem one_mod (n : ℕ) : 1 % (n + bit0 1) = 1 :=
  mod_eq_of_lt (add_lt_add_right (succ_pos n) 1)

theorem dvd_sub_mod {n : ℕ} (k : ℕ) : n ∣ k - k % n :=
  Exists.intro (k / n) (nat.sub_eq_of_eq_add (Eq.symm (mod_add_div k n)))

@[simp] theorem mod_add_mod (m : ℕ) (n : ℕ) (k : ℕ) : (m % n + k) % n = (m + k) % n := sorry

@[simp] theorem add_mod_mod (m : ℕ) (n : ℕ) (k : ℕ) : (m + n % k) % k = (m + n) % k :=
  eq.mpr (id (Eq._oldrec (Eq.refl ((m + n % k) % k = (m + n) % k)) (add_comm m (n % k))))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((n % k + m) % k = (m + n) % k)) (mod_add_mod n k m)))
      (eq.mpr (id (Eq._oldrec (Eq.refl ((n + m) % k = (m + n) % k)) (add_comm n m))) (Eq.refl ((m + n) % k))))

theorem add_mod (a : ℕ) (b : ℕ) (n : ℕ) : (a + b) % n = (a % n + b % n) % n :=
  eq.mpr (id (Eq._oldrec (Eq.refl ((a + b) % n = (a % n + b % n) % n)) (add_mod_mod (a % n) b n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((a + b) % n = (a % n + b) % n)) (mod_add_mod a n b))) (Eq.refl ((a + b) % n)))

theorem add_mod_eq_add_mod_right {m : ℕ} {n : ℕ} {k : ℕ} (i : ℕ) (H : m % n = k % n) : (m + i) % n = (k + i) % n :=
  eq.mpr (id (Eq._oldrec (Eq.refl ((m + i) % n = (k + i) % n)) (Eq.symm (mod_add_mod m n i))))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((m % n + i) % n = (k + i) % n)) (Eq.symm (mod_add_mod k n i))))
      (eq.mpr (id (Eq._oldrec (Eq.refl ((m % n + i) % n = (k % n + i) % n)) H)) (Eq.refl ((k % n + i) % n))))

theorem add_mod_eq_add_mod_left {m : ℕ} {n : ℕ} {k : ℕ} (i : ℕ) (H : m % n = k % n) : (i + m) % n = (i + k) % n :=
  eq.mpr (id (Eq._oldrec (Eq.refl ((i + m) % n = (i + k) % n)) (add_comm i m)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((m + i) % n = (i + k) % n)) (add_mod_eq_add_mod_right i H)))
      (eq.mpr (id (Eq._oldrec (Eq.refl ((k + i) % n = (i + k) % n)) (add_comm k i))) (Eq.refl ((i + k) % n))))

theorem mul_mod (a : ℕ) (b : ℕ) (n : ℕ) : a * b % n = a % n * (b % n) % n := sorry

theorem dvd_div_of_mul_dvd {a : ℕ} {b : ℕ} {c : ℕ} (h : a * b ∣ c) : b ∣ c / a := sorry

theorem mul_dvd_of_dvd_div {a : ℕ} {b : ℕ} {c : ℕ} (hab : c ∣ b) (h : a ∣ b / c) : c * a ∣ b := sorry

theorem div_mul_div {a : ℕ} {b : ℕ} {c : ℕ} {d : ℕ} (hab : b ∣ a) (hcd : d ∣ c) : a / b * (c / d) = a * c / (b * d) := sorry

@[simp] theorem div_div_div_eq_div {a : ℕ} {b : ℕ} {c : ℕ} (dvd : b ∣ a) (dvd2 : a ∣ c) : c / (a / b) / b = c / a := sorry

theorem eq_of_dvd_of_div_eq_one {a : ℕ} {b : ℕ} (w : a ∣ b) (h : b / a = 1) : a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b)) (Eq.symm (nat.div_mul_cancel w))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = b / a * a)) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a = 1 * a)) (one_mul a))) (Eq.refl a)))

theorem eq_zero_of_dvd_of_div_eq_zero {a : ℕ} {b : ℕ} (w : a ∣ b) (h : b / a = 0) : b = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b = 0)) (Eq.symm (nat.div_mul_cancel w))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b / a * a = 0)) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 * a = 0)) (zero_mul a))) (Eq.refl 0)))

/-- If a small natural number is divisible by a larger natural number,
the small number is zero. -/
theorem eq_zero_of_dvd_of_lt {a : ℕ} {b : ℕ} (w : a ∣ b) (h : b < a) : b = 0 :=
  eq_zero_of_dvd_of_div_eq_zero w (iff.elim_right (nat.div_eq_zero_iff (lt_of_le_of_lt (zero_le b) h)) h)

theorem div_le_div_left {a : ℕ} {b : ℕ} {c : ℕ} (h₁ : c ≤ b) (h₂ : 0 < c) : a / b ≤ a / c :=
  iff.mpr (le_div_iff_mul_le (a / b) a h₂) (le_trans (mul_le_mul_left (a / b) h₁) (div_mul_le_self a b))

theorem div_eq_self {a : ℕ} {b : ℕ} : a / b = a ↔ a = 0 ∨ b = 1 := sorry

/-! ### `pow` -/

-- This is redundant with `canonically_ordered_semiring.pow_le_pow_of_le_left`,

-- but `canonically_ordered_semiring` is not such an obvious abstraction, and also quite long.

-- So, we leave a version in the `nat` namespace as well.

-- (The global `pow_le_pow_of_le_left` needs an extra hypothesis `0 ≤ x`.)

protected theorem pow_le_pow_of_le_left {x : ℕ} {y : ℕ} (H : x ≤ y) (i : ℕ) : x ^ i ≤ y ^ i :=
  canonically_ordered_semiring.pow_le_pow_of_le_left H

theorem pow_le_pow_of_le_right {x : ℕ} (H : x > 0) {i : ℕ} {j : ℕ} : i ≤ j → x ^ i ≤ x ^ j := sorry

theorem pow_lt_pow_of_lt_left {x : ℕ} {y : ℕ} (H : x < y) {i : ℕ} (h : 0 < i) : x ^ i < y ^ i := sorry

theorem pow_lt_pow_of_lt_right {x : ℕ} (H : x > 1) {i : ℕ} {j : ℕ} (h : i < j) : x ^ i < x ^ j := sorry

-- TODO: Generalize?

theorem pow_lt_pow_succ {p : ℕ} (h : 1 < p) (n : ℕ) : p ^ n < p ^ (n + 1) := sorry

theorem lt_pow_self {p : ℕ} (h : 1 < p) (n : ℕ) : n < p ^ n := sorry

theorem lt_two_pow (n : ℕ) : n < bit0 1 ^ n :=
  lt_pow_self (of_as_true trivial) n

theorem one_le_pow (n : ℕ) (m : ℕ) (h : 0 < m) : 1 ≤ m ^ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 ≤ m ^ n)) (Eq.symm (one_pow n)))) (nat.pow_le_pow_of_le_left h n)

theorem one_le_pow' (n : ℕ) (m : ℕ) : 1 ≤ (m + 1) ^ n :=
  one_le_pow n (m + 1) (succ_pos m)

theorem one_le_two_pow (n : ℕ) : 1 ≤ bit0 1 ^ n :=
  one_le_pow n (bit0 1) (of_as_true trivial)

theorem one_lt_pow (n : ℕ) (m : ℕ) (h₀ : 0 < n) (h₁ : 1 < m) : 1 < m ^ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 < m ^ n)) (Eq.symm (one_pow n)))) (pow_lt_pow_of_lt_left h₁ h₀)

theorem one_lt_pow' (n : ℕ) (m : ℕ) : 1 < (m + bit0 1) ^ (n + 1) :=
  one_lt_pow (n + 1) (m + bit0 1) (succ_pos n) (nat.lt_of_sub_eq_succ rfl)

theorem one_lt_two_pow (n : ℕ) (h₀ : 0 < n) : 1 < bit0 1 ^ n :=
  one_lt_pow n (bit0 1) h₀ (of_as_true trivial)

theorem one_lt_two_pow' (n : ℕ) : 1 < bit0 1 ^ (n + 1) :=
  one_lt_pow (n + 1) (bit0 1) (succ_pos n) (of_as_true trivial)

theorem pow_right_strict_mono {x : ℕ} (k : bit0 1 ≤ x) : strict_mono fun (n : ℕ) => x ^ n :=
  fun (_x _x_1 : ℕ) => pow_lt_pow_of_lt_right k

theorem pow_le_iff_le_right {x : ℕ} {m : ℕ} {n : ℕ} (k : bit0 1 ≤ x) : x ^ m ≤ x ^ n ↔ m ≤ n :=
  strict_mono.le_iff_le (pow_right_strict_mono k)

theorem pow_lt_iff_lt_right {x : ℕ} {m : ℕ} {n : ℕ} (k : bit0 1 ≤ x) : x ^ m < x ^ n ↔ m < n :=
  strict_mono.lt_iff_lt (pow_right_strict_mono k)

theorem pow_right_injective {x : ℕ} (k : bit0 1 ≤ x) : function.injective fun (n : ℕ) => x ^ n :=
  strict_mono.injective (pow_right_strict_mono k)

theorem pow_left_strict_mono {m : ℕ} (k : 1 ≤ m) : strict_mono fun (x : ℕ) => x ^ m :=
  fun (_x _x_1 : ℕ) (h : _x < _x_1) => pow_lt_pow_of_lt_left h k

end nat

theorem strict_mono.nat_pow {n : ℕ} (hn : 1 ≤ n) {f : ℕ → ℕ} (hf : strict_mono f) : strict_mono fun (m : ℕ) => f m ^ n :=
  strict_mono.comp (nat.pow_left_strict_mono hn) hf

namespace nat

theorem pow_le_iff_le_left {m : ℕ} {x : ℕ} {y : ℕ} (k : 1 ≤ m) : x ^ m ≤ y ^ m ↔ x ≤ y :=
  strict_mono.le_iff_le (pow_left_strict_mono k)

theorem pow_lt_iff_lt_left {m : ℕ} {x : ℕ} {y : ℕ} (k : 1 ≤ m) : x ^ m < y ^ m ↔ x < y :=
  strict_mono.lt_iff_lt (pow_left_strict_mono k)

theorem pow_left_injective {m : ℕ} (k : 1 ≤ m) : function.injective fun (x : ℕ) => x ^ m :=
  strict_mono.injective (pow_left_strict_mono k)

/-! ### `pow` and `mod` / `dvd` -/

theorem mod_pow_succ {b : ℕ} (b_pos : 0 < b) (w : ℕ) (m : ℕ) : m % b ^ Nat.succ w = b * (m / b % b ^ w) + m % b := sorry

theorem pow_dvd_pow_iff_pow_le_pow {k : ℕ} {l : ℕ} {x : ℕ} (w : 0 < x) : x ^ k ∣ x ^ l ↔ x ^ k ≤ x ^ l := sorry

/-- If `1 < x`, then `x^k` divides `x^l` if and only if `k` is at most `l`. -/
theorem pow_dvd_pow_iff_le_right {x : ℕ} {k : ℕ} {l : ℕ} (w : 1 < x) : x ^ k ∣ x ^ l ↔ k ≤ l :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ^ k ∣ x ^ l ↔ k ≤ l)) (propext (pow_dvd_pow_iff_pow_le_pow (lt_of_succ_lt w)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ^ k ≤ x ^ l ↔ k ≤ l)) (propext (pow_le_iff_le_right w)))) (iff.refl (k ≤ l)))

theorem pow_dvd_pow_iff_le_right' {b : ℕ} {k : ℕ} {l : ℕ} : (b + bit0 1) ^ k ∣ (b + bit0 1) ^ l ↔ k ≤ l :=
  pow_dvd_pow_iff_le_right (nat.lt_of_sub_eq_succ rfl)

theorem not_pos_pow_dvd {p : ℕ} {k : ℕ} (hp : 1 < p) (hk : 1 < k) : ¬p ^ k ∣ p := sorry

theorem pow_dvd_of_le_of_pow_dvd {p : ℕ} {m : ℕ} {n : ℕ} {k : ℕ} (hmn : m ≤ n) (hdiv : p ^ n ∣ k) : p ^ m ∣ k :=
  (fun (this : p ^ m ∣ p ^ n) => dvd_trans this hdiv) (pow_dvd_pow p hmn)

theorem dvd_of_pow_dvd {p : ℕ} {k : ℕ} {m : ℕ} (hk : 1 ≤ k) (hpk : p ^ k ∣ m) : p ∣ m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (p ∣ m)) (Eq.symm (pow_one p)))) (pow_dvd_of_le_of_pow_dvd hk hpk)

/-- `m` is not divisible by `n` iff it is between `n * k` and `n * (k + 1)` for some `k`. -/
theorem exists_lt_and_lt_iff_not_dvd (m : ℕ) {n : ℕ} (hn : 0 < n) : (∃ (k : ℕ), n * k < m ∧ m < n * (k + 1)) ↔ ¬n ∣ m := sorry

/-! ### `find` -/

theorem find_eq_iff {p : ℕ → Prop} [decidable_pred p] (h : ∃ (n : ℕ), p n) {m : ℕ} : nat.find h = m ↔ p m ∧ ∀ (n : ℕ), n < m → ¬p n := sorry

@[simp] theorem find_eq_zero {p : ℕ → Prop} [decidable_pred p] (h : ∃ (n : ℕ), p n) : nat.find h = 0 ↔ p 0 := sorry

@[simp] theorem find_pos {p : ℕ → Prop} [decidable_pred p] (h : ∃ (n : ℕ), p n) : 0 < nat.find h ↔ ¬p 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 < nat.find h ↔ ¬p 0)) (propext pos_iff_ne_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nat.find h ≠ 0 ↔ ¬p 0)) (propext not_iff_not)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (nat.find h = 0 ↔ p 0)) (propext (find_eq_zero h)))) (iff.refl (p 0))))

/-! ### `find_greatest` -/

/-- `find_greatest P b` is the largest `i ≤ bound` such that `P i` holds, or `0` if no such `i`
exists -/
protected def find_greatest (P : ℕ → Prop) [decidable_pred P] : ℕ → ℕ :=
  sorry

@[simp] theorem find_greatest_zero {P : ℕ → Prop} [decidable_pred P] : nat.find_greatest P 0 = 0 :=
  rfl

@[simp] theorem find_greatest_eq {P : ℕ → Prop} [decidable_pred P] {b : ℕ} : P b → nat.find_greatest P b = b := sorry

@[simp] theorem find_greatest_of_not {P : ℕ → Prop} [decidable_pred P] {b : ℕ} (h : ¬P (b + 1)) : nat.find_greatest P (b + 1) = nat.find_greatest P b := sorry

theorem find_greatest_eq_iff {P : ℕ → Prop} [decidable_pred P] {b : ℕ} {m : ℕ} : nat.find_greatest P b = m ↔ m ≤ b ∧ (m ≠ 0 → P m) ∧ ∀ {n : ℕ}, m < n → n ≤ b → ¬P n := sorry

theorem find_greatest_eq_zero_iff {P : ℕ → Prop} [decidable_pred P] {b : ℕ} : nat.find_greatest P b = 0 ↔ ∀ {n : ℕ}, 0 < n → n ≤ b → ¬P n := sorry

theorem find_greatest_spec {P : ℕ → Prop} [decidable_pred P] {b : ℕ} (h : ∃ (m : ℕ), m ≤ b ∧ P m) : P (nat.find_greatest P b) := sorry

theorem find_greatest_le {P : ℕ → Prop} [decidable_pred P] {b : ℕ} : nat.find_greatest P b ≤ b :=
  and.left (iff.mp find_greatest_eq_iff rfl)

theorem le_find_greatest {P : ℕ → Prop} [decidable_pred P] {b : ℕ} {m : ℕ} (hmb : m ≤ b) (hm : P m) : m ≤ nat.find_greatest P b :=
  le_of_not_lt
    fun (hlt : nat.find_greatest P b < m) => and.right (and.right (iff.mp find_greatest_eq_iff rfl)) m hlt hmb hm

theorem find_greatest_is_greatest {P : ℕ → Prop} [decidable_pred P] {b : ℕ} {k : ℕ} (hk : nat.find_greatest P b < k) (hkb : k ≤ b) : ¬P k :=
  and.right (and.right (iff.mp find_greatest_eq_iff rfl)) k hk hkb

theorem find_greatest_of_ne_zero {P : ℕ → Prop} [decidable_pred P] {b : ℕ} {m : ℕ} (h : nat.find_greatest P b = m) (h0 : m ≠ 0) : P m :=
  and.left (and.right (iff.mp find_greatest_eq_iff h)) h0

/-! ### `bodd_div2` and `bodd` -/

@[simp] theorem bodd_div2_eq (n : ℕ) : bodd_div2 n = (bodd n, div2 n) := sorry

@[simp] theorem bodd_bit0 (n : ℕ) : bodd (bit0 n) = false :=
  bodd_bit false n

@[simp] theorem bodd_bit1 (n : ℕ) : bodd (bit1 n) = tt :=
  bodd_bit tt n

@[simp] theorem div2_bit0 (n : ℕ) : div2 (bit0 n) = n :=
  div2_bit false n

@[simp] theorem div2_bit1 (n : ℕ) : div2 (bit1 n) = n :=
  div2_bit tt n

/-! ### `bit0` and `bit1` -/

protected theorem bit0_le {n : ℕ} {m : ℕ} (h : n ≤ m) : bit0 n ≤ bit0 m :=
  add_le_add h h

protected theorem bit1_le {n : ℕ} {m : ℕ} (h : n ≤ m) : bit1 n ≤ bit1 m :=
  succ_le_succ (add_le_add h h)

theorem bit_le (b : Bool) {n : ℕ} {m : ℕ} : n ≤ m → bit b n ≤ bit b m :=
  fun (ᾰ : n ≤ m) => bool.cases_on b (idRhs (bit0 n ≤ bit0 m) (nat.bit0_le ᾰ)) (idRhs (bit1 n ≤ bit1 m) (nat.bit1_le ᾰ))

theorem bit_ne_zero (b : Bool) {n : ℕ} (h : n ≠ 0) : bit b n ≠ 0 :=
  bool.cases_on b (nat.bit0_ne_zero h) (nat.bit1_ne_zero n)

theorem bit0_le_bit (b : Bool) {m : ℕ} {n : ℕ} : m ≤ n → bit0 m ≤ bit b n :=
  fun (ᾰ : m ≤ n) =>
    bool.cases_on b (idRhs (bit0 m ≤ bit0 n) (nat.bit0_le ᾰ)) (idRhs (bit0 m ≤ bit tt n) (le_of_lt (nat.bit0_lt_bit1 ᾰ)))

theorem bit_le_bit1 (b : Bool) {m : ℕ} {n : ℕ} : m ≤ n → bit b m ≤ bit1 n :=
  fun (ᾰ : m ≤ n) =>
    bool.cases_on b (idRhs (bit false m ≤ bit1 n) (le_of_lt (nat.bit0_lt_bit1 ᾰ)))
      (idRhs (bit1 m ≤ bit1 n) (nat.bit1_le ᾰ))

theorem bit_lt_bit0 (b : Bool) {n : ℕ} {m : ℕ} : n < m → bit b n < bit0 m :=
  fun (ᾰ : n < m) =>
    bool.cases_on b (idRhs (bit0 n < bit0 m) (nat.bit0_lt ᾰ)) (idRhs (bit1 n < bit0 m) (nat.bit1_lt_bit0 ᾰ))

theorem bit_lt_bit (a : Bool) (b : Bool) {n : ℕ} {m : ℕ} (h : n < m) : bit a n < bit b m :=
  lt_of_lt_of_le (bit_lt_bit0 a h) (bit0_le_bit b (le_refl m))

@[simp] theorem bit0_le_bit1_iff {n : ℕ} {k : ℕ} : bit0 k ≤ bit1 n ↔ k ≤ n := sorry

@[simp] theorem bit0_lt_bit1_iff {n : ℕ} {k : ℕ} : bit0 k < bit1 n ↔ k ≤ n :=
  { mp := fun (h : bit0 k < bit1 n) => iff.mp bit0_le_bit1_iff (le_of_lt h), mpr := nat.bit0_lt_bit1 }

@[simp] theorem bit1_le_bit0_iff {n : ℕ} {k : ℕ} : bit1 k ≤ bit0 n ↔ k < n := sorry

@[simp] theorem bit1_lt_bit0_iff {n : ℕ} {k : ℕ} : bit1 k < bit0 n ↔ k < n :=
  { mp := fun (h : bit1 k < bit0 n) => iff.mp bit1_le_bit0_iff (le_of_lt h), mpr := nat.bit1_lt_bit0 }

@[simp] theorem one_le_bit0_iff {n : ℕ} : 1 ≤ bit0 n ↔ 0 < n := sorry

@[simp] theorem one_lt_bit0_iff {n : ℕ} : 1 < bit0 n ↔ 1 ≤ n := sorry

@[simp] theorem bit_le_bit_iff {n : ℕ} {k : ℕ} {b : Bool} : bit b k ≤ bit b n ↔ k ≤ n :=
  bool.cases_on b (idRhs (bit0 k ≤ bit0 n ↔ k ≤ n) bit0_le_bit0) (idRhs (bit1 k ≤ bit1 n ↔ k ≤ n) bit1_le_bit1)

@[simp] theorem bit_lt_bit_iff {n : ℕ} {k : ℕ} {b : Bool} : bit b k < bit b n ↔ k < n :=
  bool.cases_on b (idRhs (bit0 k < bit0 n ↔ k < n) bit0_lt_bit0) (idRhs (bit1 k < bit1 n ↔ k < n) bit1_lt_bit1)

@[simp] theorem bit_le_bit1_iff {n : ℕ} {k : ℕ} {b : Bool} : bit b k ≤ bit1 n ↔ k ≤ n :=
  bool.cases_on b (idRhs (bit0 k ≤ bit1 n ↔ k ≤ n) bit0_le_bit1_iff) (idRhs (bit1 k ≤ bit1 n ↔ k ≤ n) bit1_le_bit1)

@[simp] theorem bit0_mod_two {n : ℕ} : bit0 n % bit0 1 = 0 := sorry

@[simp] theorem bit1_mod_two {n : ℕ} : bit1 n % bit0 1 = 1 := sorry

theorem pos_of_bit0_pos {n : ℕ} (h : 0 < bit0 n) : 0 < n := sorry

/-- Define a function on `ℕ` depending on parity of the argument. -/
def bit_cases {C : ℕ → Sort u} (H : (b : Bool) → (n : ℕ) → C (bit b n)) (n : ℕ) : C n :=
  eq.rec_on (bit_decomp n) (H (bodd n) (div2 n))

/-! ### `shiftl` and `shiftr` -/

theorem shiftl_eq_mul_pow (m : ℕ) (n : ℕ) : shiftl m n = m * bit0 1 ^ n := sorry

theorem shiftl'_tt_eq_mul_pow (m : ℕ) (n : ℕ) : shiftl' tt m n + 1 = (m + 1) * bit0 1 ^ n := sorry

theorem one_shiftl (n : ℕ) : shiftl 1 n = bit0 1 ^ n :=
  Eq.trans (shiftl_eq_mul_pow 1 n) (nat.one_mul (bit0 1 ^ n))

@[simp] theorem zero_shiftl (n : ℕ) : shiftl 0 n = 0 :=
  Eq.trans (shiftl_eq_mul_pow 0 n) (nat.zero_mul (bit0 1 ^ n))

theorem shiftr_eq_div_pow (m : ℕ) (n : ℕ) : shiftr m n = m / bit0 1 ^ n := sorry

@[simp] theorem zero_shiftr (n : ℕ) : shiftr 0 n = 0 :=
  Eq.trans (shiftr_eq_div_pow 0 n) (nat.zero_div (bit0 1 ^ n))

theorem shiftl'_ne_zero_left (b : Bool) {m : ℕ} (h : m ≠ 0) (n : ℕ) : shiftl' b m n ≠ 0 := sorry

theorem shiftl'_tt_ne_zero (m : ℕ) {n : ℕ} (h : n ≠ 0) : shiftl' tt m n ≠ 0 :=
  nat.cases_on n (fun (h : 0 ≠ 0) => idRhs (shiftl' tt m 0 ≠ 0) (absurd rfl h))
    (fun (n : ℕ) (h : Nat.succ n ≠ 0) => idRhs (bit1 (shiftl' tt m n) ≠ 0) (nat.bit1_ne_zero (shiftl' tt m n))) h

/-! ### `size` -/

@[simp] theorem size_zero : size 0 = 0 :=
  rfl

@[simp] theorem size_bit {b : Bool} {n : ℕ} (h : bit b n ≠ 0) : size (bit b n) = Nat.succ (size n) := sorry

@[simp] theorem size_bit0 {n : ℕ} (h : n ≠ 0) : size (bit0 n) = Nat.succ (size n) :=
  size_bit (nat.bit0_ne_zero h)

@[simp] theorem size_bit1 (n : ℕ) : size (bit1 n) = Nat.succ (size n) :=
  size_bit (nat.bit1_ne_zero n)

@[simp] theorem size_one : size 1 = 1 :=
  size_bit1 0

@[simp] theorem size_shiftl' {b : Bool} {m : ℕ} {n : ℕ} (h : shiftl' b m n ≠ 0) : size (shiftl' b m n) = size m + n := sorry

@[simp] theorem size_shiftl {m : ℕ} (h : m ≠ 0) (n : ℕ) : size (shiftl m n) = size m + n :=
  size_shiftl' (shiftl'_ne_zero_left false h n)

theorem lt_size_self (n : ℕ) : n < bit0 1 ^ size n := sorry

theorem size_le {m : ℕ} {n : ℕ} : size m ≤ n ↔ m < bit0 1 ^ n := sorry

theorem lt_size {m : ℕ} {n : ℕ} : m < size n ↔ bit0 1 ^ m ≤ n := sorry

theorem size_pos {n : ℕ} : 0 < size n ↔ 0 < n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 < size n ↔ 0 < n)) (propext lt_size))) (iff.refl (bit0 1 ^ 0 ≤ n))

theorem size_eq_zero {n : ℕ} : size n = 0 ↔ n = 0 := sorry

theorem size_pow {n : ℕ} : size (bit0 1 ^ n) = n + 1 :=
  le_antisymm (iff.mpr size_le (pow_lt_pow_of_lt_right (of_as_true trivial) (lt_succ_self n)))
    (iff.mpr lt_size (le_refl (bit0 1 ^ n)))

theorem size_le_size {m : ℕ} {n : ℕ} (h : m ≤ n) : size m ≤ size n :=
  iff.mpr size_le (lt_of_le_of_lt h (lt_size_self n))

/-! ### decidability of predicates -/

protected instance decidable_ball_lt (n : ℕ) (P : (k : ℕ) → k < n → Prop) [H : (n_1 : ℕ) → (h : n_1 < n) → Decidable (P n_1 h)] : Decidable (∀ (n_1 : ℕ) (h : n_1 < n), P n_1 h) :=
  Nat.rec (fun (P : (k : ℕ) → k < 0 → Prop) (H : (n : ℕ) → (h : n < 0) → Decidable (P n h)) => is_true sorry)
    (fun (n : ℕ)
      (IH :
      (P : (k : ℕ) → k < n → Prop) →
        [H : (n_1 : ℕ) → (h : n_1 < n) → Decidable (P n_1 h)] → Decidable (∀ (n_1 : ℕ) (h : n_1 < n), P n_1 h))
      (P : (k : ℕ) → k < Nat.succ n → Prop) (H : (n_1 : ℕ) → (h : n_1 < Nat.succ n) → Decidable (P n_1 h)) =>
      decidable.cases_on (IH fun (k : ℕ) (h : k < n) => P k (lt_succ_of_lt h))
        (fun (h : ¬∀ (n_1 : ℕ) (h : n_1 < n), (fun (k : ℕ) (h : k < n) => P k (lt_succ_of_lt h)) n_1 h) => isFalse sorry)
        fun (h : ∀ (n_1 : ℕ) (h : n_1 < n), (fun (k : ℕ) (h : k < n) => P k (lt_succ_of_lt h)) n_1 h) =>
          dite (P n (lt_succ_self n)) (fun (p : P n (lt_succ_self n)) => is_true sorry)
            fun (p : ¬P n (lt_succ_self n)) => isFalse sorry)
    n P

protected instance decidable_forall_fin {n : ℕ} (P : fin n → Prop) [H : decidable_pred P] : Decidable (∀ (i : fin n), P i) :=
  decidable_of_iff (∀ (k : ℕ) (h : k < n), P { val := k, property := h }) sorry

protected instance decidable_ball_le (n : ℕ) (P : (k : ℕ) → k ≤ n → Prop) [H : (n_1 : ℕ) → (h : n_1 ≤ n) → Decidable (P n_1 h)] : Decidable (∀ (n_1 : ℕ) (h : n_1 ≤ n), P n_1 h) :=
  decidable_of_iff (∀ (k : ℕ) (h : k < Nat.succ n), P k (le_of_lt_succ h)) sorry

protected instance decidable_lo_hi (lo : ℕ) (hi : ℕ) (P : ℕ → Prop) [H : decidable_pred P] : Decidable (∀ (x : ℕ), lo ≤ x → x < hi → P x) :=
  decidable_of_iff (∀ (x : ℕ), x < hi - lo → P (lo + x)) sorry

protected instance decidable_lo_hi_le (lo : ℕ) (hi : ℕ) (P : ℕ → Prop) [H : decidable_pred P] : Decidable (∀ (x : ℕ), lo ≤ x → x ≤ hi → P x) :=
  decidable_of_iff (∀ (x : ℕ), lo ≤ x → x < hi + 1 → P x) sorry

protected instance decidable_exists_lt {P : ℕ → Prop} [h : decidable_pred P] : decidable_pred fun (n : ℕ) => ∃ (m : ℕ), m < n ∧ P m :=
  sorry

/-! ### find -/

theorem find_le {p : ℕ → Prop} {q : ℕ → Prop} [decidable_pred p] [decidable_pred q] (h : ∀ (n : ℕ), q n → p n) (hp : ∃ (n : ℕ), p n) (hq : ∃ (n : ℕ), q n) : nat.find hp ≤ nat.find hq :=
  nat.find_min' hp (h (nat.find hq) (nat.find_spec hq))


import analysis.calculus.affine_map

/-!

# Lemmas about interaction of `ball` and `homothety`

TODO Generalise these lemmas appropriately.

-/

open set function metric affine_map

variables {F : Type*} [normed_add_comm_group F] [normed_space ℝ F]

-- Unused
@[simp] lemma range_affine_equiv_ball {p c : F} {s r : ℝ} (hr : 0 < r) :
  range (λ (x : ball p s), c +ᵥ homothety p r (x : F)) = ball (c + p) (r * s) :=
begin
  ext,
  simp only [homothety_apply, dist_eq_norm, vsub_eq_sub, vadd_eq_add, mem_range,
    set_coe.exists, mem_ball, subtype.coe_mk, exists_prop],
  refine ⟨_, λ h, ⟨p + r⁻¹ • (x - (c + p)), _, _⟩⟩,
  { rintros ⟨y, h, rfl⟩,
    simpa [norm_smul, abs_eq_self.mpr hr.le] using (mul_lt_mul_left hr).mpr h, },
  { simpa [norm_smul, abs_eq_self.mpr hr.le] using (inv_mul_lt_iff hr).mpr h, },
  { simp [← smul_assoc, hr.ne.symm.is_unit.mul_inv_cancel], abel, },
end

@[simp] lemma norm_coe_ball_lt (r : ℝ) (x : ball (0 : F) r) : ‖(x : F)‖ < r :=
by { cases x with x hx, simpa using hx, }

lemma maps_to_homothety_ball (c : F) {r : ℝ} (hr : 0 < r) :
  maps_to (λ y, homothety c r⁻¹ y -ᵥ c) (ball c r) (ball 0 1) :=
begin
  intros y hy,
  replace hy : r⁻¹ * ‖y - c‖ < 1,
  { rw [← mul_lt_mul_left hr, ← mul_assoc, mul_inv_cancel hr.ne.symm, mul_one, one_mul],
    simpa [dist_eq_norm] using hy, },
  simp only [homothety_apply, vsub_eq_sub, vadd_eq_add, add_sub_cancel, mem_ball_zero_iff,
    norm_smul, real.norm_eq_abs, abs_eq_self.2 (inv_pos.mpr hr).le, hy],
end

lemma cont_diff_homothety {n : ℕ∞} (c : F) (r : ℝ) : cont_diff ℝ n (homothety c r) :=
(⟨homothety c r, homothety_continuous c r⟩ : F →A[ℝ] F).cont_diff


/-
Copyright (c) 2020 Aaron Anderson, Jalex Stark, Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark, Kyle Miller, Alena Gusakov, Hunter Monroe
-/
import data.fintype.basic
import data.rel
import data.set.finite
import data.sym.sym2

/-!
# Simple graphs

This module defines simple graphs on a vertex type `V` as an
irreflexive symmetric relation.

There is a basic API for locally finite graphs and for graphs with
finitely many vertices.

## Main definitions

* `simple_graph` is a structure for symmetric, irreflexive relations

* `neighbor_set` is the `set` of vertices adjacent to a given vertex

* `common_neighbors` is the intersection of the neighbor sets of two given vertices

* `neighbor_finset` is the `finset` of vertices adjacent to a given vertex,
   if `neighbor_set` is finite

* `incidence_set` is the `set` of edges containing a given vertex

* `incidence_finset` is the `finset` of edges containing a given vertex,
   if `incidence_set` is finite

* `homo`, `embedding`, and `iso` for graph homomorphisms, graph embeddings, and
  graph isomorphisms. Note that a graph embedding is a stronger notion than an
  injective graph homomorphism, since its image is an induced subgraph.

* `boolean_algebra` instance: Under the subgraph relation, `simple_graph` forms a `boolean_algebra`.
  In other words, this is the lattice of spanning subgraphs of the complete graph.

## Notations

* `→g`, `↪g`, and `≃g` for graph homomorphisms, graph embeddings, and graph isomorphisms,
  respectively.

## Implementation notes

* A locally finite graph is one with instances `Π v, fintype (G.neighbor_set v)`.

* Given instances `decidable_rel G.adj` and `fintype V`, then the graph
  is locally finite, too.

* Morphisms of graphs are abbreviations for `rel_hom`, `rel_embedding`, and `rel_iso`.
  To make use of pre-existing simp lemmas, definitions involving morphisms are
  abbreviations as well.

## Naming Conventions

* If the vertex type of a graph is finite, we refer to its cardinality as `card_verts`.

## Todo

* Upgrade `simple_graph.boolean_algebra` to a `complete_boolean_algebra`.

* This is the simplest notion of an unoriented graph.  This should
  eventually fit into a more complete combinatorics hierarchy which
  includes multigraphs and directed graphs.  We begin with simple graphs
  in order to start learning what the combinatorics hierarchy should
  look like.
-/
open finset
universes u v w

/--
A simple graph is an irreflexive symmetric relation `adj` on a vertex type `V`.
The relation describes which pairs of vertices are adjacent.
There is exactly one edge for every pair of adjacent edges;
see `simple_graph.edge_set` for the corresponding edge set.
-/
@[ext]
structure simple_graph (V : Type u) :=
(adj : V → V → Prop)
(symm : symmetric adj . obviously)
(loopless : irreflexive adj . obviously)

/--
Construct the simple graph induced by the given relation.  It
symmetrizes the relation and makes it irreflexive.
-/
def simple_graph.from_rel {V : Type u} (r : V → V → Prop) : simple_graph V :=
{ adj := λ a b, (a ≠ b) ∧ (r a b ∨ r b a),
  symm := λ a b ⟨hn, hr⟩, ⟨hn.symm, hr.symm⟩,
  loopless := λ a ⟨hn, _⟩, hn rfl }

noncomputable instance {V : Type u} [fintype V] : fintype (simple_graph V) :=
by { classical, exact fintype.of_injective simple_graph.adj simple_graph.ext }

@[simp]
lemma simple_graph.from_rel_adj {V : Type u} (r : V → V → Prop) (v w : V) :
  (simple_graph.from_rel r).adj v w ↔ v ≠ w ∧ (r v w ∨ r w v) :=
iff.rfl

/-- The complete graph on a type `V` is the simple graph with all pairs of distinct vertices
adjacent. In `mathlib`, this is usually referred to as `⊤`. -/
def complete_graph (V : Type u) : simple_graph V := { adj := ne }

/-- The graph with no edges on a given vertex type `V`. `mathlib` prefers the notation `⊥`. -/
def empty_graph (V : Type u) : simple_graph V := { adj := λ i j, false }

/--
Two vertices are adjacent in the complete bipartite graph on two vertex types
if and only if they are not from the same side.
Bipartite graphs in general may be regarded as being subgraphs of one of these.

TODO also introduce complete multi-partite graphs, where the vertex type is a sigma type of an
indexed family of vertex types
-/
@[simps]
def complete_bipartite_graph (V W : Type*) : simple_graph (V ⊕ W) :=
{ adj := λ v w, (v.is_left ∧ w.is_right) ∨ (v.is_right ∧ w.is_left),
  symm := begin
    intros v w,
    cases v; cases w; simp,
  end,
  loopless := begin
    intro v,
    cases v; simp,
  end }

namespace simple_graph

variables {V : Type u} {W : Type v} {X : Type w} (G : simple_graph V) (G' : simple_graph W)

@[simp] lemma irrefl {v : V} : ¬G.adj v v := G.loopless v

lemma adj_comm (u v : V) : G.adj u v ↔ G.adj v u := ⟨λ x, G.symm x, λ x, G.symm x⟩

@[symm] lemma adj_symm {u v : V} (h : G.adj u v) : G.adj v u := G.symm h

lemma ne_of_adj {a b : V} (hab : G.adj a b) : a ≠ b :=
by { rintro rfl, exact G.irrefl hab }

section order

/-- The relation that one `simple_graph` is a subgraph of another.
Note that this should be spelled `≤`. -/
def is_subgraph (x y : simple_graph V) : Prop := ∀ ⦃v w : V⦄, x.adj v w → y.adj v w

instance : has_le (simple_graph V) := ⟨is_subgraph⟩

@[simp] lemma is_subgraph_eq_le : (is_subgraph : simple_graph V → simple_graph V → Prop) = (≤) :=
rfl

/-- The supremum of two graphs `x ⊔ y` has edges where either `x` or `y` have edges. -/
instance : has_sup (simple_graph V) := ⟨λ x y,
  { adj := x.adj ⊔ y.adj,
    symm := λ v w h, by rwa [pi.sup_apply, pi.sup_apply, x.adj_comm, y.adj_comm] }⟩

@[simp] lemma sup_adj (x y : simple_graph V) (v w : V) : (x ⊔ y).adj v w ↔ x.adj v w ∨ y.adj v w :=
iff.rfl

/-- The infinum of two graphs `x ⊓ y` has edges where both `x` and `y` have edges. -/
instance : has_inf (simple_graph V) := ⟨λ x y,
  { adj := x.adj ⊓ y.adj,
    symm := λ v w h, by rwa [pi.inf_apply, pi.inf_apply, x.adj_comm, y.adj_comm] }⟩

@[simp] lemma inf_adj (x y : simple_graph V) (v w : V) : (x ⊓ y).adj v w ↔ x.adj v w ∧ y.adj v w :=
iff.rfl

/--
We define `Gᶜ` to be the `simple_graph V` such that no two adjacent vertices in `G`
are adjacent in the complement, and every nonadjacent pair of vertices is adjacent
(still ensuring that vertices are not adjacent to themselves).
-/
instance : has_compl (simple_graph V) := ⟨λ G,
  { adj := λ v w, v ≠ w ∧ ¬G.adj v w,
    symm := λ v w ⟨hne, _⟩, ⟨hne.symm, by rwa adj_comm⟩,
    loopless := λ v ⟨hne, _⟩, (hne rfl).elim }⟩

@[simp] lemma compl_adj (G : simple_graph V) (v w : V) : Gᶜ.adj v w ↔ v ≠ w ∧ ¬G.adj v w := iff.rfl

/-- The difference of two graphs `x / y` has the edges of `x` with the edges of `y` removed. -/
instance : has_sdiff (simple_graph V) := ⟨λ x y,
  { adj := x.adj \ y.adj,
    symm := λ v w h, by change x.adj w v ∧ ¬ y.adj w v; rwa [x.adj_comm, y.adj_comm] }⟩

@[simp] lemma sdiff_adj (x y : simple_graph V) (v w : V) :
  (x \ y).adj v w ↔ (x.adj v w ∧ ¬ y.adj v w) := iff.rfl

instance : boolean_algebra (simple_graph V) :=
{ le := (≤),
  sup := (⊔),
  inf := (⊓),
  compl := has_compl.compl,
  sdiff := (\),
  top := complete_graph V,
  bot := empty_graph V,
  le_top := λ x v w h, x.ne_of_adj h,
  bot_le := λ x v w h, h.elim,
  sup_le := λ x y z hxy hyz v w h, h.cases_on (λ h, hxy h) (λ h, hyz h),
  sdiff_eq := λ x y, by { ext v w, refine ⟨λ h, ⟨h.1, ⟨_, h.2⟩⟩, λ h, ⟨h.1, h.2.2⟩⟩,
                          rintro rfl, exact x.irrefl h.1 },
  sup_inf_sdiff := λ a b, by { ext v w, refine ⟨λ h, _, λ h', _⟩,
                               obtain ⟨ha, _⟩|⟨ha, _⟩ := h; exact ha,
                               by_cases b.adj v w; exact or.inl ⟨h', h⟩ <|> exact or.inr ⟨h', h⟩ },
  inf_inf_sdiff := λ a b, by { ext v w, exact ⟨λ ⟨⟨_, hb⟩,⟨_, hb'⟩⟩, hb' hb, λ h, h.elim⟩ },
  le_sup_left := λ x y v w h, or.inl h,
  le_sup_right := λ x y v w h, or.inr h,
  le_inf := λ x y z hxy hyz v w h, ⟨hxy h, hyz h⟩,
  le_sup_inf := λ a b c v w h, or.dcases_on h.2 or.inl $
    or.dcases_on h.1 (λ h _, or.inl h) $ λ hb hc, or.inr ⟨hb, hc⟩,
  inf_compl_le_bot := λ a v w h, false.elim $ h.2.2 h.1,
  top_le_sup_compl := λ a v w ne, by { by_cases a.adj v w, exact or.inl h, exact or.inr ⟨ne, h⟩ },
  inf_le_left := λ x y v w h, h.1,
  inf_le_right := λ x y v w h, h.2,
  .. partial_order.lift adj ext }

@[simp] lemma top_adj (v w : V) : (⊤ : simple_graph V).adj v w ↔ v ≠ w := iff.rfl

@[simp] lemma bot_adj (v w : V) : (⊥ : simple_graph V).adj v w ↔ false := iff.rfl

@[simp] lemma complete_graph_eq_top (V : Type u) : complete_graph V = ⊤ := rfl

@[simp] lemma empty_graph_eq_bot (V : Type u) : empty_graph V = ⊥ := rfl

instance (V : Type u) : inhabited (simple_graph V) := ⟨⊤⟩

section decidable

variables (V) (H : simple_graph V) [decidable_rel G.adj] [decidable_rel H.adj]

instance bot.adj_decidable   : decidable_rel (⊥ : simple_graph V).adj := λ v w, decidable.false

instance sup.adj_decidable   : decidable_rel (G ⊔ H).adj := λ v w, or.decidable

instance inf.adj_decidable   : decidable_rel (G ⊓ H).adj := λ v w, and.decidable

instance sdiff.adj_decidable : decidable_rel (G \ H).adj := λ v w, and.decidable

variable [decidable_eq V]

instance top.adj_decidable   : decidable_rel (⊤ : simple_graph V).adj :=  λ v w, not.decidable

instance compl.adj_decidable : decidable_rel Gᶜ.adj := λ v w, and.decidable

end decidable

end order

/-- `G.support` is the set of vertices that form edges in `G`. -/
def support : set V := rel.dom G.adj

lemma mem_support {v : V} : v ∈ G.support ↔ ∃ w, G.adj v w := iff.rfl

lemma support_mono {G G' : simple_graph V} (h : G ≤ G') : G.support ⊆ G'.support :=
rel.dom_mono h

/-- `G.neighbor_set v` is the set of vertices adjacent to `v` in `G`. -/
def neighbor_set (v : V) : set V := set_of (G.adj v)

instance neighbor_set.mem_decidable (v : V) [decidable_rel G.adj] :
  decidable_pred (∈ G.neighbor_set v) := by { unfold neighbor_set, apply_instance }

/--
The edges of G consist of the unordered pairs of vertices related by
`G.adj`.

The way `edge_set` is defined is such that `mem_edge_set` is proved by `refl`.
(That is, `⟦(v, w)⟧ ∈ G.edge_set` is definitionally equal to `G.adj v w`.)
-/
def edge_set : set (sym2 V) := sym2.from_rel G.symm

/--
The `incidence_set` is the set of edges incident to a given vertex.
-/
def incidence_set (v : V) : set (sym2 V) := {e ∈ G.edge_set | v ∈ e}

lemma incidence_set_subset (v : V) : G.incidence_set v ⊆ G.edge_set :=
λ _ h, h.1

@[simp]
lemma mem_edge_set {v w : V} : ⟦(v, w)⟧ ∈ G.edge_set ↔ G.adj v w :=
iff.rfl

/--
Two vertices are adjacent iff there is an edge between them.  The
condition `v ≠ w` ensures they are different endpoints of the edge,
which is necessary since when `v = w` the existential
`∃ (e ∈ G.edge_set), v ∈ e ∧ w ∈ e` is satisfied by every edge
incident to `v`.
-/
lemma adj_iff_exists_edge {v w : V} :
  G.adj v w ↔ v ≠ w ∧ ∃ (e ∈ G.edge_set), v ∈ e ∧ w ∈ e :=
begin
  refine ⟨λ _, ⟨G.ne_of_adj ‹_›, ⟦(v,w)⟧, _⟩, _⟩,
  { simpa },
  { rintro ⟨hne, e, he, hv⟩,
    rw sym2.elems_iff_eq hne at hv,
    subst e,
    rwa mem_edge_set at he }
end

lemma edge_other_ne {e : sym2 V} (he : e ∈ G.edge_set) {v : V} (h : v ∈ e) : h.other ≠ v :=
begin
  erw [← sym2.mem_other_spec h, sym2.eq_swap] at he,
  exact G.ne_of_adj he,
end

instance decidable_mem_edge_set [decidable_rel G.adj] :
  decidable_pred (∈ G.edge_set) := sym2.from_rel.decidable_pred _

instance edges_fintype [decidable_eq V] [fintype V] [decidable_rel G.adj] :
  fintype G.edge_set := subtype.fintype _

instance decidable_mem_incidence_set [decidable_eq V] [decidable_rel G.adj] (v : V) :
  decidable_pred (∈ G.incidence_set v) := λ e, and.decidable

/--
The `edge_set` of the graph as a `finset`.
-/
def edge_finset [decidable_eq V] [fintype V] [decidable_rel G.adj] : finset (sym2 V) :=
set.to_finset G.edge_set

@[simp] lemma mem_edge_finset [decidable_eq V] [fintype V] [decidable_rel G.adj] (e : sym2 V) :
  e ∈ G.edge_finset ↔ e ∈ G.edge_set :=
set.mem_to_finset

@[simp] lemma edge_set_univ_card [decidable_eq V] [fintype V] [decidable_rel G.adj] :
  (univ : finset G.edge_set).card = G.edge_finset.card :=
fintype.card_of_subtype G.edge_finset (mem_edge_finset _)

@[simp] lemma mem_neighbor_set (v w : V) : w ∈ G.neighbor_set v ↔ G.adj v w :=
iff.rfl

@[simp] lemma mem_incidence_set (v w : V) : ⟦(v, w)⟧ ∈ G.incidence_set v ↔ G.adj v w :=
by simp [incidence_set]

lemma mem_incidence_iff_neighbor {v w : V} : ⟦(v, w)⟧ ∈ G.incidence_set v ↔ w ∈ G.neighbor_set v :=
by simp only [mem_incidence_set, mem_neighbor_set]

lemma adj_incidence_set_inter {v : V} {e : sym2 V} (he : e ∈ G.edge_set) (h : v ∈ e) :
  G.incidence_set v ∩ G.incidence_set h.other = {e} :=
begin
  ext e',
  simp only [incidence_set, set.mem_sep_eq, set.mem_inter_eq, set.mem_singleton_iff],
  split,
  { intro h', rw ←sym2.mem_other_spec h,
    exact (sym2.elems_iff_eq (edge_other_ne G he h).symm).mp ⟨h'.1.2, h'.2.2⟩, },
  { rintro rfl, use [he, h, he], apply sym2.mem_other_mem, },
end

lemma compl_neighbor_set_disjoint (G : simple_graph V) (v : V) :
  disjoint (G.neighbor_set v) (Gᶜ.neighbor_set v) :=
begin
  rw set.disjoint_iff,
  rintro w ⟨h, h'⟩,
  rw [mem_neighbor_set, compl_adj] at h',
  exact h'.2 h,
end

lemma neighbor_set_union_compl_neighbor_set_eq (G : simple_graph V) (v : V) :
  G.neighbor_set v ∪ Gᶜ.neighbor_set v = {v}ᶜ :=
begin
  ext w,
  have h := @ne_of_adj _ G,
  simp_rw [set.mem_union, mem_neighbor_set, compl_adj, set.mem_compl_eq, set.mem_singleton_iff],
  tauto,
end

/--
The set of common neighbors between two vertices `v` and `w` in a graph `G` is the
intersection of the neighbor sets of `v` and `w`.
-/
def common_neighbors (v w : V) : set V := G.neighbor_set v ∩ G.neighbor_set w

lemma common_neighbors_eq (v w : V) :
  G.common_neighbors v w = G.neighbor_set v ∩ G.neighbor_set w := rfl

lemma mem_common_neighbors {u v w : V} : u ∈ G.common_neighbors v w ↔ G.adj v u ∧ G.adj w u :=
by simp [common_neighbors]

lemma common_neighbors_symm (v w : V) : G.common_neighbors v w = G.common_neighbors w v :=
by { rw [common_neighbors, set.inter_comm], refl }

lemma not_mem_common_neighbors_left (v w : V) : v ∉ G.common_neighbors v w :=
λ h, ne_of_adj G h.1 rfl

lemma not_mem_common_neighbors_right (v w : V) : w ∉ G.common_neighbors v w :=
λ h, ne_of_adj G h.2 rfl

lemma common_neighbors_subset_neighbor_set (v w : V) : G.common_neighbors v w ⊆ G.neighbor_set v :=
by simp [common_neighbors]

instance decidable_mem_common_neighbors [decidable_rel G.adj] (v w : V) :
  decidable_pred (∈ G.common_neighbors v w) :=
λ a, and.decidable

section incidence
variable [decidable_eq V]

/--
Given an edge incident to a particular vertex, get the other vertex on the edge.
-/
def other_vertex_of_incident {v : V} {e : sym2 V} (h : e ∈ G.incidence_set v) : V := h.2.other'

lemma edge_mem_other_incident_set {v : V} {e : sym2 V} (h : e ∈ G.incidence_set v) :
  e ∈ G.incidence_set (G.other_vertex_of_incident h) :=
by { use h.1, simp [other_vertex_of_incident, sym2.mem_other_mem'] }

lemma incidence_other_prop {v : V} {e : sym2 V} (h : e ∈ G.incidence_set v) :
  G.other_vertex_of_incident h ∈ G.neighbor_set v :=
by { cases h with he hv, rwa [←sym2.mem_other_spec' hv, mem_edge_set] at he }

@[simp]
lemma incidence_other_neighbor_edge {v w : V} (h : w ∈ G.neighbor_set v) :
  G.other_vertex_of_incident (G.mem_incidence_iff_neighbor.mpr h) = w :=
sym2.congr_right.mp (sym2.mem_other_spec' (G.mem_incidence_iff_neighbor.mpr h).right)

/--
There is an equivalence between the set of edges incident to a given
vertex and the set of vertices adjacent to the vertex.
-/
@[simps] def incidence_set_equiv_neighbor_set (v : V) : G.incidence_set v ≃ G.neighbor_set v :=
{ to_fun := λ e, ⟨G.other_vertex_of_incident e.2, G.incidence_other_prop e.2⟩,
  inv_fun := λ w, ⟨⟦(v, w.1)⟧, G.mem_incidence_iff_neighbor.mpr w.2⟩,
  left_inv := λ x, by simp [other_vertex_of_incident],
  right_inv := λ ⟨w, hw⟩, by simp }

end incidence

section finite_at

/-!
## Finiteness at a vertex

This section contains definitions and lemmas concerning vertices that
have finitely many adjacent vertices.  We denote this condition by
`fintype (G.neighbor_set v)`.

We define `G.neighbor_finset v` to be the `finset` version of `G.neighbor_set v`.
Use `neighbor_finset_eq_filter` to rewrite this definition as a `filter`.
-/

variables (v : V) [fintype (G.neighbor_set v)]
/--
`G.neighbors v` is the `finset` version of `G.adj v` in case `G` is
locally finite at `v`.
-/
def neighbor_finset : finset V := (G.neighbor_set v).to_finset

@[simp] lemma mem_neighbor_finset (w : V) :
  w ∈ G.neighbor_finset v ↔ G.adj v w :=
set.mem_to_finset

/--
`G.degree v` is the number of vertices adjacent to `v`.
-/
def degree : ℕ := (G.neighbor_finset v).card

@[simp]
lemma card_neighbor_set_eq_degree : fintype.card (G.neighbor_set v) = G.degree v :=
(set.to_finset_card _).symm

lemma degree_pos_iff_exists_adj : 0 < G.degree v ↔ ∃ w, G.adj v w :=
by simp only [degree, card_pos, finset.nonempty, mem_neighbor_finset]

instance incidence_set_fintype [decidable_eq V] : fintype (G.incidence_set v) :=
fintype.of_equiv (G.neighbor_set v) (G.incidence_set_equiv_neighbor_set v).symm

/--
This is the `finset` version of `incidence_set`.
-/
def incidence_finset [decidable_eq V] : finset (sym2 V) := (G.incidence_set v).to_finset

@[simp]
lemma card_incidence_set_eq_degree [decidable_eq V] :
  fintype.card (G.incidence_set v) = G.degree v :=
by { rw fintype.card_congr (G.incidence_set_equiv_neighbor_set v), simp }

@[simp]
lemma mem_incidence_finset [decidable_eq V] (e : sym2 V) :
  e ∈ G.incidence_finset v ↔ e ∈ G.incidence_set v :=
set.mem_to_finset

end finite_at

section locally_finite

/--
A graph is locally finite if every vertex has a finite neighbor set.
-/
@[reducible]
def locally_finite := Π (v : V), fintype (G.neighbor_set v)

variable [locally_finite G]

/--
A locally finite simple graph is regular of degree `d` if every vertex has degree `d`.
-/
def is_regular_of_degree (d : ℕ) : Prop := ∀ (v : V), G.degree v = d

lemma is_regular_of_degree_eq {d : ℕ} (h : G.is_regular_of_degree d) (v : V) : G.degree v = d := h v

end locally_finite

section finite

variable [fintype V]

instance neighbor_set_fintype [decidable_rel G.adj] (v : V) : fintype (G.neighbor_set v) :=
@subtype.fintype _ _ (by { simp_rw mem_neighbor_set, apply_instance }) _

lemma neighbor_finset_eq_filter {v : V} [decidable_rel G.adj] :
  G.neighbor_finset v = finset.univ.filter (G.adj v) :=
by { ext, simp }

@[simp]
lemma complete_graph_degree [decidable_eq V] (v : V) :
  (⊤ : simple_graph V).degree v = fintype.card V - 1 :=
begin
  convert univ.card.pred_eq_sub_one,
  erw [degree, neighbor_finset_eq_filter, filter_ne, card_erase_of_mem (mem_univ v)],
end

lemma complete_graph_is_regular [decidable_eq V] :
  (⊤ : simple_graph V).is_regular_of_degree (fintype.card V - 1) :=
by { intro v, simp }

/--
The minimum degree of all vertices (and `0` if there are no vertices).
The key properties of this are given in `exists_minimal_degree_vertex`, `min_degree_le_degree`
and `le_min_degree_of_forall_le_degree`.
-/
def min_degree [decidable_rel G.adj] : ℕ :=
option.get_or_else (univ.image (λ v, G.degree v)).min 0

/--
There exists a vertex of minimal degree. Note the assumption of being nonempty is necessary, as
the lemma implies there exists a vertex.
-/
lemma exists_minimal_degree_vertex [decidable_rel G.adj] [nonempty V] :
  ∃ v, G.min_degree = G.degree v :=
begin
  obtain ⟨t, ht : _ = _⟩ := min_of_nonempty (univ_nonempty.image (λ v, G.degree v)),
  obtain ⟨v, _, rfl⟩ := mem_image.mp (mem_of_min ht),
  refine ⟨v, by simp [min_degree, ht]⟩,
end

/-- The minimum degree in the graph is at most the degree of any particular vertex. -/
lemma min_degree_le_degree [decidable_rel G.adj] (v : V) : G.min_degree ≤ G.degree v :=
begin
  obtain ⟨t, ht⟩ := finset.min_of_mem (mem_image_of_mem (λ v, G.degree v) (mem_univ v)),
  have := finset.min_le_of_mem (mem_image_of_mem _ (mem_univ v)) ht,
  rw option.mem_def at ht,
  rwa [min_degree, ht, option.get_or_else_some],
end

/--
In a nonempty graph, if `k` is at most the degree of every vertex, it is at most the minimum
degree. Note the assumption that the graph is nonempty is necessary as long as `G.min_degree` is
defined to be a natural.
-/
lemma le_min_degree_of_forall_le_degree [decidable_rel G.adj] [nonempty V] (k : ℕ)
  (h : ∀ v, k ≤ G.degree v) :
  k ≤ G.min_degree :=
begin
  rcases G.exists_minimal_degree_vertex with ⟨v, hv⟩,
  rw hv,
  apply h
end

/--
The maximum degree of all vertices (and `0` if there are no vertices).
The key properties of this are given in `exists_maximal_degree_vertex`, `degree_le_max_degree`
and `max_degree_le_of_forall_degree_le`.
-/
def max_degree [decidable_rel G.adj] : ℕ :=
option.get_or_else (univ.image (λ v, G.degree v)).max 0

/--
There exists a vertex of maximal degree. Note the assumption of being nonempty is necessary, as
the lemma implies there exists a vertex.
-/
lemma exists_maximal_degree_vertex [decidable_rel G.adj] [nonempty V] :
  ∃ v, G.max_degree = G.degree v :=
begin
  obtain ⟨t, ht⟩ := max_of_nonempty (univ_nonempty.image (λ v, G.degree v)),
  have ht₂ := mem_of_max ht,
  simp only [mem_image, mem_univ, exists_prop_of_true] at ht₂,
  rcases ht₂ with ⟨v, rfl⟩,
  rw option.mem_def at ht,
  refine ⟨v, _⟩,
  rw [max_degree, ht],
  refl
end

/-- The maximum degree in the graph is at least the degree of any particular vertex. -/
lemma degree_le_max_degree [decidable_rel G.adj] (v : V) : G.degree v ≤ G.max_degree :=
begin
  obtain ⟨t, ht : _ = _⟩ := finset.max_of_mem (mem_image_of_mem (λ v, G.degree v) (mem_univ v)),
  have := finset.le_max_of_mem (mem_image_of_mem _ (mem_univ v)) ht,
  rwa [max_degree, ht, option.get_or_else_some],
end

/--
In a graph, if `k` is at least the degree of every vertex, then it is at least the maximum
degree.
-/
lemma max_degree_le_of_forall_degree_le [decidable_rel G.adj] (k : ℕ)
  (h : ∀ v, G.degree v ≤ k) :
  G.max_degree ≤ k :=
begin
  by_cases hV : (univ : finset V).nonempty,
  { haveI : nonempty V := univ_nonempty_iff.mp hV,
    obtain ⟨v, hv⟩ := G.exists_maximal_degree_vertex,
    rw hv,
    apply h },
  { rw not_nonempty_iff_eq_empty at hV,
    rw [max_degree, hV, image_empty],
    exact zero_le k },
end

lemma degree_lt_card_verts [decidable_rel G.adj] (v : V) : G.degree v < fintype.card V :=
begin
  classical,
  apply finset.card_lt_card,
  rw finset.ssubset_iff,
  exact ⟨v, by simp, finset.subset_univ _⟩,
end

/--
The maximum degree of a nonempty graph is less than the number of vertices. Note that the assumption
that `V` is nonempty is necessary, as otherwise this would assert the existence of a
natural number less than zero.
-/
lemma max_degree_lt_card_verts [decidable_rel G.adj] [nonempty V] : G.max_degree < fintype.card V :=
begin
  cases G.exists_maximal_degree_vertex with v hv,
  rw hv,
  apply G.degree_lt_card_verts v,
end

lemma card_common_neighbors_le_degree_left [decidable_rel G.adj] (v w : V) :
  fintype.card (G.common_neighbors v w) ≤ G.degree v :=
begin
  rw [←card_neighbor_set_eq_degree],
  exact set.card_le_of_subset (set.inter_subset_left _ _),
end

lemma card_common_neighbors_lt_card_verts [decidable_rel G.adj] (v w : V) :
  fintype.card (G.common_neighbors v w) < fintype.card V :=
nat.lt_of_le_of_lt (G.card_common_neighbors_le_degree_left _ _) (G.degree_lt_card_verts v)

/--
If the condition `G.adj v w` fails, then `card_common_neighbors_le_degree` is
the best we can do in general.
-/
lemma adj.card_common_neighbors_lt_degree {G : simple_graph V} [decidable_rel G.adj]
  {v w : V} (h : G.adj v w) :
  fintype.card (G.common_neighbors v w) < G.degree v :=
begin
  classical,
  erw [←set.to_finset_card],
  apply finset.card_lt_card,
  rw finset.ssubset_iff,
  use w,
  split,
  { rw set.mem_to_finset,
    apply not_mem_common_neighbors_right },
  { rw finset.insert_subset,
    split,
    { simpa, },
    { rw [neighbor_finset, ← set.subset_iff_to_finset_subset],
      apply common_neighbors_subset_neighbor_set } },
end

end finite

section maps

/--
A graph homomorphism is a map on vertex sets that respects adjacency relations.

The notation `G →g G'` represents the type of graph homomorphisms.
-/
abbreviation hom := rel_hom G.adj G'.adj

/--
A graph embedding is an embedding `f` such that for vertices `v w : V`,
`G.adj f(v) f(w) ↔ G.adj v w `. Its image is an induced subgraph of G'.

The notation `G ↪g G'` represents the type of graph embeddings.
-/
abbreviation embedding := rel_embedding G.adj G'.adj

/--
A graph isomorphism is an bijective map on vertex sets that respects adjacency relations.

The notation `G ≃g G'` represents the type of graph isomorphisms.
-/
abbreviation iso := rel_iso G.adj G'.adj

infix ` →g ` : 50 := hom
infix ` ↪g ` : 50 := embedding
infix ` ≃g ` : 50 := iso

namespace hom
variables {G G'} (f : G →g G')

/-- The identity homomorphism from a graph to itself. -/
abbreviation id : G →g G := rel_hom.id _

lemma map_adj {v w : V} (h : G.adj v w) : G'.adj (f v) (f w) := f.map_rel' h

lemma map_mem_edge_set {e : sym2 V} (h : e ∈ G.edge_set) : e.map f ∈ G'.edge_set :=
quotient.ind (λ e h, sym2.from_rel_prop.mpr (f.map_rel' h)) e h

lemma apply_mem_neighbor_set {v w : V} (h : w ∈ G.neighbor_set v) : f w ∈ G'.neighbor_set (f v) :=
map_adj f h

/-- The map between edge sets induced by a homomorphism.
The underlying map on edges is given by `sym2.map`. -/
@[simps] def map_edge_set (e : G.edge_set) : G'.edge_set :=
⟨sym2.map f e, f.map_mem_edge_set e.property⟩

/-- The map between neighbor sets induced by a homomorphism. -/
@[simps] def map_neighbor_set (v : V) (w : G.neighbor_set v) : G'.neighbor_set (f v) :=
⟨f w, f.apply_mem_neighbor_set w.property⟩

/-- The induced map for spanning subgraphs, which is the identity on vertices. -/
def map_spanning_subgraphs {G G' : simple_graph V} (h : G ≤ G') : G →g G' :=
{ to_fun := λ x, x,
  map_rel' := h }

lemma map_edge_set.injective (hinj : function.injective f) : function.injective f.map_edge_set :=
begin
  rintros ⟨e₁, h₁⟩ ⟨e₂, h₂⟩,
  dsimp [hom.map_edge_set],
  repeat { rw subtype.mk_eq_mk },
  apply sym2.map.injective hinj,
end

variable {G'' : simple_graph X}

/-- Composition of graph homomorphisms. -/
abbreviation comp (f' : G' →g G'') (f : G →g G') : G →g G'' := f'.comp f

@[simp] lemma coe_comp (f' : G' →g G'') (f : G →g G') : ⇑(f'.comp f) = f' ∘ f := rfl

end hom

namespace embedding
variables {G G'} (f : G ↪g G')

/-- The identity embedding from a graph to itself. -/
abbreviation refl : G ↪g G := rel_embedding.refl _

/-- An embedding of graphs gives rise to a homomorphism of graphs. -/
abbreviation to_hom : G →g G' := f.to_rel_hom

lemma map_adj_iff {v w : V} : G'.adj (f v) (f w) ↔ G.adj v w := f.map_rel_iff

lemma map_mem_edge_set_iff {e : sym2 V} : e.map f ∈ G'.edge_set ↔ e ∈ G.edge_set :=
quotient.ind (λ ⟨v, w⟩, f.map_adj_iff) e

lemma apply_mem_neighbor_set_iff {v w : V} : f w ∈ G'.neighbor_set (f v) ↔ w ∈ G.neighbor_set v :=
map_adj_iff f

/-- A graph embedding induces an embedding of edge sets. -/
@[simps] def map_edge_set : G.edge_set ↪ G'.edge_set :=
{ to_fun := hom.map_edge_set f,
  inj' := hom.map_edge_set.injective f f.inj' }

/-- A graph embedding induces an embedding of neighbor sets. -/
@[simps] def map_neighbor_set (v : V) : G.neighbor_set v ↪ G'.neighbor_set (f v) :=
{ to_fun := λ w, ⟨f w, f.apply_mem_neighbor_set_iff.mpr w.2⟩,
  inj' := begin
    rintros ⟨w₁, h₁⟩ ⟨w₂, h₂⟩ h,
    rw subtype.mk_eq_mk at h ⊢,
    exact f.inj' h,
  end }

/-- Embeddings of types induce embeddings of complete graphs on those types. -/
def complete_graph.of_embedding {α β : Type*} (f : α ↪ β) : complete_graph α ↪g complete_graph β :=
{ to_fun := f,
  inj' := f.inj',
  map_rel_iff' := by simp }

variables {G'' : simple_graph X}

/-- Composition of graph embeddings. -/
abbreviation comp (f' : G' ↪g G'') (f : G ↪g G') : G ↪g G'' := f.trans f'

@[simp] lemma coe_comp (f' : G' ↪g G'') (f : G ↪g G') : ⇑(f'.comp f) = f' ∘ f := rfl

end embedding

namespace iso
variables {G G'} (f : G ≃g G')

/-- The identity isomorphism of a graph with itself. -/
abbreviation refl : G ≃g G := rel_iso.refl _

/-- An isomorphism of graphs gives rise to an embedding of graphs. -/
abbreviation to_embedding : G ↪g G' := f.to_rel_embedding

/-- An isomorphism of graphs gives rise to a homomorphism of graphs. -/
abbreviation to_hom : G →g G' := f.to_embedding.to_hom

/-- The inverse of a graph isomorphism. --/
abbreviation symm : G' ≃g G := f.symm

lemma map_adj_iff {v w : V} : G'.adj (f v) (f w) ↔ G.adj v w := f.map_rel_iff

lemma map_mem_edge_set_iff {e : sym2 V} : e.map f ∈ G'.edge_set ↔ e ∈ G.edge_set :=
quotient.ind (λ ⟨v, w⟩, f.map_adj_iff) e

lemma apply_mem_neighbor_set_iff {v w : V} : f w ∈ G'.neighbor_set (f v) ↔ w ∈ G.neighbor_set v :=
map_adj_iff f

/-- An isomorphism of graphs induces an equivalence of edge sets. -/
@[simps] def map_edge_set : G.edge_set ≃ G'.edge_set :=
{ to_fun := hom.map_edge_set f,
  inv_fun := hom.map_edge_set f.symm,
  left_inv := begin
    rintro ⟨e, h⟩,
    simp only [hom.map_edge_set, sym2.map_map, rel_iso.coe_coe_fn,
      rel_embedding.coe_coe_fn, subtype.mk_eq_mk, subtype.coe_mk, coe_coe],
    apply congr_fun,
    convert sym2.map_id,
    exact funext (λ _, rel_iso.symm_apply_apply _ _),
  end,
  right_inv := begin
    rintro ⟨e, h⟩,
    simp only [hom.map_edge_set, sym2.map_map, rel_iso.coe_coe_fn,
      rel_embedding.coe_coe_fn, subtype.mk_eq_mk, subtype.coe_mk, coe_coe],
    apply congr_fun,
    convert sym2.map_id,
    exact funext (λ _, rel_iso.apply_symm_apply _ _),
  end }

/-- A graph isomorphism induces an equivalence of neighbor sets. -/
@[simps] def map_neighbor_set (v : V) : G.neighbor_set v ≃ G'.neighbor_set (f v) :=
{ to_fun := λ w, ⟨f w, f.apply_mem_neighbor_set_iff.mpr w.2⟩,
  inv_fun := λ w, ⟨f.symm w, begin
    convert f.symm.apply_mem_neighbor_set_iff.mpr w.2,
    simp only [rel_iso.symm_apply_apply],
  end⟩,
  left_inv := λ w, by simp,
  right_inv := λ w, by simp }

lemma card_eq_of_iso [fintype V] [fintype W] (f : G ≃g G') : fintype.card V = fintype.card W :=
by convert (fintype.of_equiv_card f.to_equiv).symm

variables {G'' : simple_graph X}

/-- Composition of graph isomorphisms. -/
abbreviation comp (f' : G' ≃g G'') (f : G ≃g G') : G ≃g G'' := f.trans f'

@[simp] lemma coe_comp (f' : G' ≃g G'') (f : G ≃g G') : ⇑(f'.comp f) = f' ∘ f := rfl

end iso

end maps

end simple_graph


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import linear_algebra.clifford_algebra.grading
import algebra.module.opposites

/-!
# Conjugations

This file defines the grade reversal and grade involution functions on multivectors, `reverse` and
`involute`.
Together, these operations compose to form the "Clifford conjugate", hence the name of this file.

https://en.wikipedia.org/wiki/Clifford_algebra#Antiautomorphisms

## Main definitions

* `clifford_algebra.involute`: the grade involution, negating each basis vector
* `clifford_algebra.reverse`: the grade reversion, reversing the order of a product of vectors

## Main statements

* `clifford_algebra.involute_involutive`
* `clifford_algebra.reverse_involutive`
* `clifford_algebra.reverse_involute_commute`
* `clifford_algebra.involute_mem_even_odd_iff`
* `clifford_algebra.reverse_mem_even_odd_iff`

-/

variables {R : Type*} [comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {Q : quadratic_form R M}

namespace clifford_algebra

section involute

/-- Grade involution, inverting the sign of each basis vector. -/
def involute : clifford_algebra Q →ₐ[R] clifford_algebra Q :=
clifford_algebra.lift Q ⟨-(ι Q), λ m, by simp⟩

@[simp] lemma involute_ι (m : M) : involute (ι Q m) = -ι Q m :=
lift_ι_apply _ _ m

@[simp] lemma involute_comp_involute : involute.comp involute = alg_hom.id R (clifford_algebra Q) :=
by { ext, simp }

lemma involute_involutive : function.involutive (involute : _ → clifford_algebra Q) :=
alg_hom.congr_fun involute_comp_involute

@[simp] lemma involute_involute : ∀ a : clifford_algebra Q, involute (involute a) = a :=
involute_involutive

/-- `clifford_algebra.involute` as an `alg_equiv`. -/
@[simps] def involute_equiv : clifford_algebra Q ≃ₐ[R] clifford_algebra Q :=
alg_equiv.of_alg_hom involute involute
  (alg_hom.ext $ involute_involute) (alg_hom.ext $ involute_involute)

end involute

section reverse
open mul_opposite

/-- Grade reversion, inverting the multiplication order of basis vectors.
Also called *transpose* in some literature. -/
def reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q :=
(op_linear_equiv R).symm.to_linear_map.comp (
  clifford_algebra.lift Q ⟨(mul_opposite.op_linear_equiv R).to_linear_map.comp (ι Q),
    λ m, unop_injective $ by simp⟩).to_linear_map

@[simp] lemma reverse_ι (m : M) : reverse (ι Q m) = ι Q m :=
by simp [reverse]

@[simp] lemma reverse.commutes (r : R) :
  reverse (algebra_map R (clifford_algebra Q) r) = algebra_map R _ r :=
by simp [reverse]

@[simp] lemma reverse.map_one : reverse (1 : clifford_algebra Q) = 1 :=
by convert reverse.commutes (1 : R); simp

@[simp] lemma reverse.map_mul (a b : clifford_algebra Q) :
  reverse (a * b) = reverse b * reverse a :=
by simp [reverse]

@[simp] lemma reverse_comp_reverse :
  reverse.comp reverse = (linear_map.id : _ →ₗ[R] clifford_algebra Q) :=
begin
  ext m,
  simp only [linear_map.id_apply, linear_map.comp_apply],
  induction m using clifford_algebra.induction,
  -- simp can close these goals, but is slow
  case h_grade0 : { rw [reverse.commutes, reverse.commutes] },
  case h_grade1 : { rw [reverse_ι, reverse_ι] },
  case h_mul : a b ha hb { rw [reverse.map_mul, reverse.map_mul, ha, hb], },
  case h_add : a b ha hb { rw [reverse.map_add, reverse.map_add, ha, hb], },
end

@[simp] lemma reverse_involutive : function.involutive (reverse : _ → clifford_algebra Q) :=
linear_map.congr_fun reverse_comp_reverse

@[simp] lemma reverse_reverse : ∀ a : clifford_algebra Q, reverse (reverse a) = a :=
reverse_involutive

/-- `clifford_algebra.reverse` as a `linear_equiv`. -/
@[simps] def reverse_equiv : clifford_algebra Q ≃ₗ[R] clifford_algebra Q :=
linear_equiv.of_involutive reverse reverse_involutive

lemma reverse_comp_involute :
  reverse.comp involute.to_linear_map =
    (involute.to_linear_map.comp reverse : _ →ₗ[R] clifford_algebra Q) :=
begin
  ext,
  simp only [linear_map.comp_apply, alg_hom.to_linear_map_apply],
  induction x using clifford_algebra.induction,
  case h_grade0 : { simp },
  case h_grade1 : { simp },
  case h_mul : a b ha hb { simp only [ha, hb, reverse.map_mul, alg_hom.map_mul], },
  case h_add : a b ha hb { simp only [ha, hb, reverse.map_add, alg_hom.map_add], },
end

/-- `clifford_algebra.reverse` and `clifford_algebra.inverse` commute. Note that the composition
is sometimes referred to as the "clifford conjugate". -/
lemma reverse_involute_commute : function.commute (reverse : _ → clifford_algebra Q) involute :=
linear_map.congr_fun reverse_comp_involute

lemma reverse_involute : ∀ a : clifford_algebra Q, reverse (involute a) = involute (reverse a) :=
reverse_involute_commute

end reverse

/-!
### Statements about conjugations of products of lists
-/

section list

/-- Taking the reverse of the product a list of $n$ vectors lifted via `ι` is equivalent to
taking the product of the reverse of that list. -/
lemma reverse_prod_map_ι : ∀ (l : list M), reverse (l.map $ ι Q).prod = (l.map $ ι Q).reverse.prod
| [] := by simp
| (x :: xs) := by simp [reverse_prod_map_ι xs]

/-- Taking the involute of the product a list of $n$ vectors lifted via `ι` is equivalent to
premultiplying by ${-1}^n$. -/
lemma involute_prod_map_ι : ∀ l : list M,
  involute (l.map $ ι Q).prod = ((-1 : R)^l.length) • (l.map $ ι Q).prod
| [] := by simp
| (x :: xs) := by simp [pow_add, involute_prod_map_ι xs]

end list

/-!
### Statements about `submodule.map` and `submodule.comap`
-/

section submodule

variables (Q)

section involute

lemma submodule_map_involute_eq_comap (p : submodule R (clifford_algebra Q)) :
  p.map (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map
    = p.comap (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map :=
(submodule.map_equiv_eq_comap_symm involute_equiv.to_linear_equiv _)

@[simp] lemma ι_range_map_involute :
  (ι Q).range.map (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map
    = (ι Q).range :=
(ι_range_map_lift _ _).trans (linear_map.range_neg _)

@[simp] lemma ι_range_comap_involute :
  (ι Q).range.comap (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map
    = (ι Q).range :=
by rw [←submodule_map_involute_eq_comap, ι_range_map_involute]

@[simp]

@[simp] lemma even_odd_comap_involute (n : zmod 2) :
  (even_odd Q n).comap (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map
    = even_odd Q n :=
by rw [←submodule_map_involute_eq_comap, even_odd_map_involute]

end involute

section reverse

lemma submodule_map_reverse_eq_comap (p : submodule R (clifford_algebra Q)) :
  p.map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
    = p.comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q):=
(submodule.map_equiv_eq_comap_symm (reverse_equiv : _ ≃ₗ[R] _) _)

@[simp] lemma ι_range_map_reverse :
  (ι Q).range.map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) = (ι Q).range :=
begin
  rw [reverse, submodule.map_comp, ι_range_map_lift, linear_map.range_comp, ←submodule.map_comp],
  exact submodule.map_id _,
end

@[simp] lemma ι_range_comap_reverse :
  (ι Q).range.comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) = (ι Q).range :=
by rw [←submodule_map_reverse_eq_comap, ι_range_map_reverse]

/-- Like `submodule.map_mul`, but with the multiplication reversed. -/
lemma submodule_map_mul_reverse (p q : submodule R (clifford_algebra Q)) :
  (p * q).map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
    = q.map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
      * p.map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) :=
by simp_rw [reverse, submodule.map_comp, linear_equiv.to_linear_map_eq_coe, submodule.map_mul,
  submodule.map_unop_mul]

lemma submodule_comap_mul_reverse (p q : submodule R (clifford_algebra Q)) :
  (p * q).comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
    = q.comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
      * p.comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) :=
by simp_rw [←submodule_map_reverse_eq_comap, submodule_map_mul_reverse]

/-- Like `submodule.map_pow` -/
lemma submodule_map_pow_reverse (p : submodule R (clifford_algebra Q)) (n : ℕ) :
  (p ^ n).map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
    = p.map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) ^ n :=
by simp_rw [reverse, submodule.map_comp, linear_equiv.to_linear_map_eq_coe, submodule.map_pow,
  submodule.map_unop_pow]

lemma submodule_comap_pow_reverse  (p : submodule R (clifford_algebra Q)) (n : ℕ) :
  (p ^ n).comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
    = p.comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) ^ n :=
by simp_rw [←submodule_map_reverse_eq_comap, submodule_map_pow_reverse]

@[simp] lemma even_odd_map_reverse (n : zmod 2) :
  (even_odd Q n).map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) = even_odd Q n :=
by simp_rw [even_odd, submodule.map_supr, submodule_map_pow_reverse, ι_range_map_reverse]

@[simp] lemma even_odd_comap_reverse (n : zmod 2) :
  (even_odd Q n).comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) = even_odd Q n :=
by rw [←submodule_map_reverse_eq_comap, even_odd_map_reverse]

end reverse

@[simp] lemma involute_mem_even_odd_iff {x : clifford_algebra Q} {n : zmod 2} :
  involute x ∈ even_odd Q n ↔ x ∈ even_odd Q n :=
set_like.ext_iff.mp (even_odd_comap_involute Q n) x

@[simp] lemma reverse_mem_even_odd_iff {x : clifford_algebra Q} {n : zmod 2} :
  reverse x ∈ even_odd Q n ↔ x ∈ even_odd Q n :=
set_like.ext_iff.mp (even_odd_comap_reverse Q n) x

end submodule

/-!
### Related properties of the even and odd submodules

TODO: show that these are `iff`s when `invertible (2 : R)`.
-/

lemma involute_eq_of_mem_even {x : clifford_algebra Q} (h : x ∈ even_odd Q 0) :
  involute x = x :=
begin
  refine even_induction Q (alg_hom.commutes _) _ _ x h,
  { rintros x y hx hy ihx ihy,
    rw [map_add, ihx, ihy]},
  { intros m₁ m₂ x hx ihx,
    rw [map_mul, map_mul, involute_ι, involute_ι, ihx, neg_mul_neg], },
end

lemma involute_eq_of_mem_odd {x : clifford_algebra Q} (h : x ∈ even_odd Q 1) :
  involute x = -x :=
begin
  refine odd_induction Q involute_ι _ _ x h,
  { rintros x y hx hy ihx ihy,
    rw [map_add, ihx, ihy, neg_add] },
  { intros m₁ m₂ x hx ihx,
    rw [map_mul, map_mul, involute_ι, involute_ι, ihx, neg_mul_neg, mul_neg] },
end

end clifford_algebra