/-
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

! This file was ported from Lean 3 source module data.nat.order.basic
! leanprover-community/mathlib commit 26f081a2fb920140ed5bc5cc5344e84bcc7cb2b2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Ring.Canonical
import Mathlib.Data.Nat.Basic
import Mathlib.Data.Nat.Bits

/-!
# The natural numbers as a linearly ordered commutative semiring

We also have a variety of lemmas which have been deferred from `Data.Nat.Basic` because it is
easier to prove them with this ordered semiring instance available.

You may find that some theorems can be moved back to `Data.Nat.Basic` by modifying their proofs.
-/

universe u v

namespace Nat

/-! ### instances -/

instance orderBot : OrderBot ℕ where
  bot := 0
  bot_le := Nat.zero_le
#align nat.order_bot Nat.orderBot

instance linearOrderedCommSemiring : LinearOrderedCommSemiring ℕ :=
  { Nat.commSemiring, Nat.linearOrder with
    lt := Nat.lt, add_le_add_left := @Nat.add_le_add_left,
    le_of_add_le_add_left := @Nat.le_of_add_le_add_left,
    zero_le_one := Nat.le_of_lt (Nat.zero_lt_succ 0),
    mul_lt_mul_of_pos_left := @Nat.mul_lt_mul_of_pos_left,
    mul_lt_mul_of_pos_right := @Nat.mul_lt_mul_of_pos_right,
    exists_pair_ne := ⟨0, 1, ne_of_lt Nat.zero_lt_one⟩ }

instance linearOrderedCommMonoidWithZero : LinearOrderedCommMonoidWithZero ℕ :=
  { Nat.linearOrderedCommSemiring, (inferInstance : CommMonoidWithZero ℕ) with
    mul_le_mul_left := fun _ _ h c => Nat.mul_le_mul_left c h }

/-! Extra instances to short-circuit type class resolution and ensure computability -/

-- Not using `infer_instance` avoids `classical.choice` in the following two
instance linearOrderedSemiring : LinearOrderedSemiring ℕ :=
  inferInstance

instance strictOrderedSemiring : StrictOrderedSemiring ℕ :=
  inferInstance

instance strictOrderedCommSemiring : StrictOrderedCommSemiring ℕ :=
  inferInstance

instance orderedSemiring : OrderedSemiring ℕ :=
  StrictOrderedSemiring.toOrderedSemiring'

instance orderedCommSemiring : OrderedCommSemiring ℕ :=
  StrictOrderedCommSemiring.toOrderedCommSemiring'

instance linearOrderedCancelAddCommMonoid : LinearOrderedCancelAddCommMonoid ℕ :=
  inferInstance

instance canonicallyOrderedCommSemiring : CanonicallyOrderedCommSemiring ℕ :=
  { Nat.nontrivial, Nat.orderBot, (inferInstance : OrderedAddCommMonoid ℕ),
    (inferInstance : LinearOrderedSemiring ℕ), (inferInstance : CommSemiring ℕ) with
    exists_add_of_le := fun {_ _} h => (Nat.le.dest h).imp fun _ => Eq.symm,
    le_self_add := Nat.le_add_right,
    eq_zero_or_eq_zero_of_mul_eq_zero := Nat.eq_zero_of_mul_eq_zero }

instance canonicallyLinearOrderedAddMonoid : CanonicallyLinearOrderedAddMonoid ℕ :=
  { (inferInstance : CanonicallyOrderedAddMonoid ℕ), Nat.linearOrder with }

variable {m n k l : ℕ}

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

theorem one_le_iff_ne_zero : 1 ≤ n ↔ n ≠ 0 :=
  Nat.add_one_le_iff.trans pos_iff_ne_zero
#align nat.one_le_iff_ne_zero Nat.one_le_iff_ne_zero

theorem one_lt_iff_ne_zero_and_ne_one : ∀ {n : ℕ}, 1 < n ↔ n ≠ 0 ∧ n ≠ 1
  | 0 => by decide
  | 1 => by decide
  | n + 2 => by simp
#align nat.one_lt_iff_ne_zero_and_ne_one Nat.one_lt_iff_ne_zero_and_ne_one

#align nat.mul_ne_zero Nat.mul_ne_zero

-- Porting note: already in Std
#align nat.mul_eq_zero Nat.mul_eq_zero

--Porting note: removing `simp` attribute
protected theorem zero_eq_mul : 0 = m * n ↔ m = 0 ∨ n = 0 := by rw [eq_comm, Nat.mul_eq_zero]
#align nat.zero_eq_mul Nat.zero_eq_mul

theorem eq_zero_of_double_le (h : 2 * n ≤ n) : n = 0 :=
  add_right_eq_self.mp <| le_antisymm ((two_mul n).symm.trans_le h) le_add_self
#align nat.eq_zero_of_double_le Nat.eq_zero_of_double_le

theorem eq_zero_of_mul_le (hb : 2 ≤ n) (h : n * m ≤ m) : m = 0 :=
  eq_zero_of_double_le <| le_trans (Nat.mul_le_mul_right _ hb) h
#align nat.eq_zero_of_mul_le Nat.eq_zero_of_mul_le

theorem zero_max : max 0 n = n :=
  max_eq_right (zero_le _)
#align nat.zero_max Nat.zero_max

@[simp]
theorem min_eq_zero_iff : min m n = 0 ↔ m = 0 ∨ n = 0 := by
  constructor
  · intro h
    cases' le_total m n with H H
    · simpa [H] using Or.inl h
    · simpa [H] using Or.inr h
  · rintro (rfl | rfl) <;> simp
#align nat.min_eq_zero_iff Nat.min_eq_zero_iff

@[simp]
theorem max_eq_zero_iff : max m n = 0 ↔ m = 0 ∧ n = 0 := by
  constructor
  · intro h
    cases' le_total m n with H H
    · simp only [H, max_eq_right] at h
      exact ⟨le_antisymm (H.trans h.le) (zero_le _), h⟩
    · simp only [H, max_eq_left] at h
      exact ⟨h, le_antisymm (H.trans h.le) (zero_le _)⟩
  · rintro ⟨rfl, rfl⟩
    simp
#align nat.max_eq_zero_iff Nat.max_eq_zero_iff

theorem add_eq_max_iff : m + n = max m n ↔ m = 0 ∨ n = 0 := by
  rw [← min_eq_zero_iff]
  cases' le_total m n with H H <;> simp [H]
#align nat.add_eq_max_iff Nat.add_eq_max_iff

theorem add_eq_min_iff : m + n = min m n ↔ m = 0 ∧ n = 0 := by
  rw [← max_eq_zero_iff]
  cases' le_total m n with H H <;> simp [H]
#align nat.add_eq_min_iff Nat.add_eq_min_iff

theorem one_le_of_lt (h : n < m) : 1 ≤ m :=
  lt_of_le_of_lt (Nat.zero_le _) h
#align nat.one_le_of_lt Nat.one_le_of_lt

theorem eq_one_of_mul_eq_one_right (H : m * n = 1) : m = 1 :=
  eq_one_of_dvd_one ⟨n, H.symm⟩
#align nat.eq_one_of_mul_eq_one_right Nat.eq_one_of_mul_eq_one_right

theorem eq_one_of_mul_eq_one_left (H : m * n = 1) : n = 1 :=
  eq_one_of_mul_eq_one_right (by rwa [mul_comm])
#align nat.eq_one_of_mul_eq_one_left Nat.eq_one_of_mul_eq_one_left

/-! ### `succ` -/

theorem two_le_iff : ∀ n, 2 ≤ n ↔ n ≠ 0 ∧ n ≠ 1
  | 0 => by simp
  | 1 => by simp
  | n + 2 => by simp
#align nat.two_le_iff Nat.two_le_iff

@[simp]
theorem lt_one_iff {n : ℕ} : n < 1 ↔ n = 0 :=
  lt_succ_iff.trans nonpos_iff_eq_zero
#align nat.lt_one_iff Nat.lt_one_iff

/-! ### `add` -/

theorem add_pos_left {m : ℕ} (h : 0 < m) (n : ℕ) : 0 < m + n :=
  calc
    m + n > 0 + n := Nat.add_lt_add_right h n
    _ = n := Nat.zero_add n
    _ ≥ 0 := zero_le n

#align nat.add_pos_left Nat.add_pos_left

theorem add_pos_right (m : ℕ) {n : ℕ} (h : 0 < n) : 0 < m + n := by
  rw [add_comm]
  exact add_pos_left h m
#align nat.add_pos_right Nat.add_pos_right

theorem add_pos_iff_pos_or_pos (m n : ℕ) : 0 < m + n ↔ 0 < m ∨ 0 < n :=
  Iff.intro
    (by
      intro h
      cases' m with m
      · simp [zero_add] at h
        exact Or.inr h
      exact Or.inl (succ_pos _))
    (by
      intro h; cases' h with mpos npos
      · apply add_pos_left mpos
      apply add_pos_right _ npos)
#align nat.add_pos_iff_pos_or_pos Nat.add_pos_iff_pos_or_pos

theorem add_eq_one_iff : m + n = 1 ↔ m = 0 ∧ n = 1 ∨ m = 1 ∧ n = 0 := by
  cases n <;> simp [succ_eq_add_one, ← add_assoc, succ_inj']
#align nat.add_eq_one_iff Nat.add_eq_one_iff

theorem add_eq_two_iff : m + n = 2 ↔ m = 0 ∧ n = 2 ∨ m = 1 ∧ n = 1 ∨ m = 2 ∧ n = 0 := by
  cases n <;>
  simp [(succ_ne_zero 1).symm, (show 2 = Nat.succ 1 from rfl),
    succ_eq_add_one, ← add_assoc, succ_inj', add_eq_one_iff]

#align nat.add_eq_two_iff Nat.add_eq_two_iff

theorem add_eq_three_iff :
    m + n = 3 ↔ m = 0 ∧ n = 3 ∨ m = 1 ∧ n = 2 ∨ m = 2 ∧ n = 1 ∨ m = 3 ∧ n = 0 := by
  cases n <;>
  simp [(succ_ne_zero 1).symm, succ_eq_add_one, (show 3 = Nat.succ 2 from rfl),
    ← add_assoc, succ_inj', add_eq_two_iff]
#align nat.add_eq_three_iff Nat.add_eq_three_iff

theorem le_add_one_iff : m ≤ n + 1 ↔ m ≤ n ∨ m = n + 1 :=
  ⟨fun h =>
    match Nat.eq_or_lt_of_le h with
    | Or.inl h => Or.inr h
    | Or.inr h => Or.inl <| Nat.le_of_succ_le_succ h,
    Or.rec (fun h => le_trans h <| Nat.le_add_right _ _) le_of_eq⟩
#align nat.le_add_one_iff Nat.le_add_one_iff

theorem le_and_le_add_one_iff : n ≤ m ∧ m ≤ n + 1 ↔ m = n ∨ m = n + 1 := by
  rw [le_add_one_iff, and_or_left, ← le_antisymm_iff, eq_comm, and_iff_right_of_imp]
  rintro rfl
  exact n.le_succ
#align nat.le_and_le_add_one_iff Nat.le_and_le_add_one_iff

theorem add_succ_lt_add (hab : m < n) (hcd : k < l) : m + k + 1 < n + l := by
  rw [add_assoc]
  exact add_lt_add_of_lt_of_le hab (Nat.succ_le_iff.2 hcd)
#align nat.add_succ_lt_add Nat.add_succ_lt_add

/-! ### `pred` -/

theorem pred_le_iff : pred m ≤ n ↔ m ≤ succ n :=
  ⟨le_succ_of_pred_le, by
    cases m
    · exact fun _ => zero_le n
    exact le_of_succ_le_succ⟩
#align nat.pred_le_iff Nat.pred_le_iff

/-! ### `sub`

Most lemmas come from the `OrderedSub` instance on `ℕ`. -/

instance : OrderedSub ℕ := by
  constructor
  intro m n k
  induction' n with n ih generalizing k
  · simp
  · simp only [sub_succ, pred_le_iff, ih, succ_add, add_succ]

theorem lt_pred_iff : n < pred m ↔ succ n < m :=
  show n < m - 1 ↔ n + 1 < m from lt_tsub_iff_right
#align nat.lt_pred_iff Nat.lt_pred_iff

theorem lt_of_lt_pred (h : m < n - 1) : m < n :=
  lt_of_succ_lt (lt_pred_iff.1 h)
#align nat.lt_of_lt_pred Nat.lt_of_lt_pred

theorem le_or_le_of_add_eq_add_pred (h : k + l = m + n - 1) : m ≤ k ∨ n ≤ l := by
  cases' le_or_lt m k with h' h' <;> [left, right]
  · exact h'
  · replace h' := add_lt_add_right h' l
    rw [h] at h'
    cases' n.eq_zero_or_pos with hn hn
    · rw [hn]
      exact zero_le l
    rw [n.add_sub_assoc (Nat.succ_le_of_lt hn), add_lt_add_iff_left] at h'
    exact Nat.le_of_pred_lt h'
#align nat.le_or_le_of_add_eq_add_pred Nat.le_or_le_of_add_eq_add_pred

/-- A version of `Nat.sub_succ` in the form `_ - 1` instead of `Nat.pred _`. -/
theorem sub_succ' (m n : ℕ) : m - n.succ = m - n - 1 :=
  rfl
#align nat.sub_succ' Nat.sub_succ'

/-! ### `mul` -/

theorem mul_eq_one_iff : ∀ {m n : ℕ}, m * n = 1 ↔ m = 1 ∧ n = 1
  | 0, 0 => by decide
  | 0, 1 => by decide
  | 1, 0 => by decide
  | m + 2, 0 => by simp
  | 0, n + 2 => by simp
  | m + 1, n + 1 =>
    ⟨fun h => by
      simp only [succ_mul, mul_succ, add_succ, one_mul, mul_one, (add_assoc _ _ _).symm,
          ← succ_eq_add_one, add_eq_zero_iff, (show 1 = succ 0 from rfl), succ_inj'] at h
      simp [h],
      fun h => by simp only [h, mul_one]⟩
#align nat.mul_eq_one_iff Nat.mul_eq_one_iff

theorem succ_mul_pos (m : ℕ) (hn : 0 < n) : 0 < succ m * n :=
  mul_pos (succ_pos m) hn
#align nat.succ_mul_pos Nat.succ_mul_pos

theorem mul_self_le_mul_self (h : m ≤ n) : m * m ≤ n * n :=
  mul_le_mul h h (zero_le _) (zero_le _)
#align nat.mul_self_le_mul_self Nat.mul_self_le_mul_self

theorem mul_self_lt_mul_self : ∀ {m n : ℕ}, m < n → m * m < n * n
  | 0, _, h => mul_pos h h
  | succ _, _, h => mul_lt_mul h (le_of_lt h) (succ_pos _) (zero_le _)
#align nat.mul_self_lt_mul_self Nat.mul_self_lt_mul_self

theorem mul_self_le_mul_self_iff : m ≤ n ↔ m * m ≤ n * n :=
  ⟨mul_self_le_mul_self, le_imp_le_of_lt_imp_lt mul_self_lt_mul_self⟩
#align nat.mul_self_le_mul_self_iff Nat.mul_self_le_mul_self_iff

theorem mul_self_lt_mul_self_iff : m < n ↔ m * m < n * n :=
  le_iff_le_iff_lt_iff_lt.1 mul_self_le_mul_self_iff
#align nat.mul_self_lt_mul_self_iff Nat.mul_self_lt_mul_self_iff

theorem le_mul_self : ∀ n : ℕ, n ≤ n * n
  | 0 => le_rfl
  | n + 1 => by simp
#align nat.le_mul_self Nat.le_mul_self

theorem le_mul_of_pos_left (h : 0 < n) : m ≤ n * m := by
  conv =>
    lhs
    rw [← one_mul m]
  exact mul_le_mul_of_nonneg_right h.nat_succ_le (zero_le _)
#align nat.le_mul_of_pos_left Nat.le_mul_of_pos_left

theorem le_mul_of_pos_right (h : 0 < n) : m ≤ m * n := by
  conv =>
    lhs
    rw [← mul_one m]
  exact mul_le_mul_of_nonneg_left h.nat_succ_le (zero_le _)
#align nat.le_mul_of_pos_right Nat.le_mul_of_pos_right

theorem mul_self_inj : m * m = n * n ↔ m = n :=
  le_antisymm_iff.trans
    (le_antisymm_iff.trans (and_congr mul_self_le_mul_self_iff mul_self_le_mul_self_iff)).symm
#align nat.mul_self_inj Nat.mul_self_inj

theorem le_add_pred_of_pos (n : ℕ) {i : ℕ} (hi : i ≠ 0) : n ≤ i + (n - 1) := by
  refine le_trans ?_ add_tsub_le_assoc
  simp [add_comm, Nat.add_sub_assoc, one_le_iff_ne_zero.2 hi]
#align nat.le_add_pred_of_pos Nat.le_add_pred_of_pos

@[simp]
theorem lt_mul_self_iff : ∀ {n : ℕ}, n < n * n ↔ 1 < n
  | 0 => iff_of_false (lt_irrefl _) zero_le_one.not_lt
  | n + 1 => lt_mul_iff_one_lt_left n.succ_pos
#align nat.lt_mul_self_iff Nat.lt_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.
-/

/-- Given a predicate on two naturals `P : ℕ → ℕ → Prop`, `P a b` is true for all `a < b` if
`P (a + 1) (a + 1)` is true for all `a`, `P 0 (b + 1)` is true for all `b` and for all
`a < b`, `P (a + 1) b` is true and `P a (b + 1)` is true implies `P (a + 1) (b + 1)` is true. -/
@[elab_as_elim]
theorem diag_induction (P : ℕ → ℕ → Prop) (ha : ∀ a, P (a + 1) (a + 1)) (hb : ∀ b, P 0 (b + 1))
    (hd : ∀ a b, a < b → P (a + 1) b → P a (b + 1) → P (a + 1) (b + 1)) : ∀ a b, a < b → P a b
  | 0, b + 1, _ => hb _
  | a + 1, b + 1, h => by
    apply hd _ _ ((add_lt_add_iff_right _).1 h)
    · have this : a + 1 = b ∨ a + 1 < b := by rwa [← le_iff_eq_or_lt, ← Nat.lt_succ_iff]
      have wf : (a + 1) + b < (a + 1) + (b + 1) := by simp
      rcases this with (rfl | h)
      · exact ha _
      apply diag_induction P ha hb hd (a + 1) b h
    have _ : a + (b + 1) < (a + 1) + (b + 1) := by simp
    apply diag_induction P ha hb hd a (b + 1)
    apply lt_of_le_of_lt (Nat.le_succ _) h
  termination_by _ a b c => a + b
  decreasing_by { assumption }
#align nat.diag_induction Nat.diag_induction

/-- A subset of `ℕ` containing `k : ℕ` and closed under `Nat.succ` contains every `n ≥ k`. -/
theorem set_induction_bounded {S : Set ℕ} (hk : k ∈ S) (h_ind : ∀ k : ℕ, k ∈ S → k + 1 ∈ S)
    (hnk : k ≤ n) : n ∈ S :=
  @leRecOn (fun n => n ∈ S) k n hnk @h_ind hk
#align nat.set_induction_bounded Nat.set_induction_bounded

/-- A subset of `ℕ` containing zero and closed under `Nat.succ` contains all of `ℕ`. -/
theorem set_induction {S : Set ℕ} (hb : 0 ∈ S) (h_ind : ∀ k : ℕ, k ∈ S → k + 1 ∈ S) (n : ℕ) :
    n ∈ S :=
  set_induction_bounded hb h_ind (zero_le n)
#align nat.set_induction Nat.set_induction

/-! ### `div` -/

protected theorem div_le_of_le_mul' (h : m ≤ k * n) : m / k ≤ n :=
  (Nat.eq_zero_or_pos k).elim (fun k0 => by rw [k0, Nat.div_zero] ; apply zero_le) fun k0 =>
    le_of_mul_le_mul_left
      (calc
        k * (m / k) ≤ m % k + k * (m / k) := Nat.le_add_left _ _
        _ = m := mod_add_div _ _
        _ ≤ k * n := h) k0

#align nat.div_le_of_le_mul' Nat.div_le_of_le_mul'

protected theorem div_le_self' (m n : ℕ) : m / n ≤ m :=
  (Nat.eq_zero_or_pos n).elim (fun n0 => by rw [n0, Nat.div_zero]; apply zero_le) fun n0 =>
    Nat.div_le_of_le_mul' <|
      calc
        m = 1 * m := (one_mul _).symm
        _ ≤ n * m := Nat.mul_le_mul_right _ n0

#align nat.div_le_self' Nat.div_le_self'

protected theorem div_lt_of_lt_mul (h : m < n * k) : m / n < k :=
  lt_of_mul_lt_mul_left
    (calc
      n * (m / n) ≤ m % n + n * (m / n) := Nat.le_add_left _ _
      _ = m := mod_add_div _ _
      _ < n * k := h
      )
    (Nat.zero_le n)
#align nat.div_lt_of_lt_mul Nat.div_lt_of_lt_mul

theorem eq_zero_of_le_div (hn : 2 ≤ n) (h : m ≤ m / n) : m = 0 :=
  eq_zero_of_mul_le hn <| by
    rw [mul_comm]; exact (Nat.le_div_iff_mul_le' (lt_of_lt_of_le (by decide) hn)).1 h
#align nat.eq_zero_of_le_div Nat.eq_zero_of_le_div

theorem div_mul_div_le_div (m n k : ℕ) : m / k * n / m ≤ n / k :=
  if hm0 : m = 0 then by simp [hm0]
  else
    calc
      m / k * n / m ≤ n * m / k / m :=
        Nat.div_le_div_right (by rw [mul_comm] ; exact mul_div_le_mul_div_assoc _ _ _)
      _ = n / k := by
        { rw [Nat.div_div_eq_div_mul, mul_comm n, mul_comm k,
            Nat.mul_div_mul_left _ _ (Nat.pos_of_ne_zero hm0)] }

#align nat.div_mul_div_le_div Nat.div_mul_div_le_div

theorem eq_zero_of_le_half (h : n ≤ n / 2) : n = 0 :=
  eq_zero_of_le_div le_rfl h
#align nat.eq_zero_of_le_half Nat.eq_zero_of_le_half

theorem mul_div_mul_comm_of_dvd_dvd (hmk : k ∣ m) (hnl : l ∣ n) :
    m * n / (k * l) = m / k * (n / l) := by
  rcases k.eq_zero_or_pos with (rfl | hk0); · simp
  rcases l.eq_zero_or_pos with (rfl | hl0); · simp
  obtain ⟨_, rfl⟩ := hmk
  obtain ⟨_, rfl⟩ := hnl
  rw [mul_mul_mul_comm, Nat.mul_div_cancel_left _ hk0, Nat.mul_div_cancel_left _ hl0,
    Nat.mul_div_cancel_left _ (mul_pos hk0 hl0)]
#align nat.mul_div_mul_comm_of_dvd_dvd Nat.mul_div_mul_comm_of_dvd_dvd

theorem le_half_of_half_lt_sub {a b : ℕ} (h : a / 2 < a - b) : b ≤ a / 2 := by
  rw [Nat.le_div_iff_mul_le two_pos]
  rw [Nat.div_lt_iff_lt_mul two_pos, Nat.mul_sub_right_distrib, lt_tsub_iff_right, mul_two a] at h
  exact le_of_lt (Nat.lt_of_add_lt_add_left h)
#align nat.le_half_of_half_lt_sub Nat.le_half_of_half_lt_sub

theorem half_le_of_sub_le_half {a b : ℕ} (h : a - b ≤ a / 2) : a / 2 ≤ b := by
  rw [Nat.le_div_iff_mul_le two_pos, Nat.mul_sub_right_distrib, tsub_le_iff_right, mul_two,
    add_le_add_iff_left] at h
  rw [← Nat.mul_div_left b two_pos]
  exact Nat.div_le_div_right h
#align nat.half_le_of_sub_le_half Nat.half_le_of_sub_le_half

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

theorem two_mul_odd_div_two (hn : n % 2 = 1) : 2 * (n / 2) = n - 1 := by
  conv =>
    rhs
    rw [← Nat.mod_add_div n 2, hn, @add_tsub_cancel_left]
#align nat.two_mul_odd_div_two Nat.two_mul_odd_div_two

theorem div_dvd_of_dvd (h : n ∣ m) : m / n ∣ m :=
  ⟨n, (Nat.div_mul_cancel h).symm⟩
#align nat.div_dvd_of_dvd Nat.div_dvd_of_dvd

protected theorem div_div_self (h : n ∣ m) (hm : m ≠ 0) : m / (m / n) = n := by
  rcases h with ⟨_, rfl⟩
  rw [mul_ne_zero_iff] at hm
  rw [mul_div_right _ (Nat.pos_of_ne_zero hm.1), mul_div_left _ (Nat.pos_of_ne_zero hm.2)]
#align nat.div_div_self Nat.div_div_self

--Porting note: later `simp [mod_zero]` can be changed to `simp` once `mod_zero` is given
--a `simp` attribute.
theorem mod_mul_right_div_self (m n k : ℕ) : m % (n * k) / n = m / n % k := by
  rcases Nat.eq_zero_or_pos n with (rfl | hn); simp [mod_zero]
  rcases Nat.eq_zero_or_pos k with (rfl | hk); simp [mod_zero]
  conv_rhs => rw [← mod_add_div m (n * k)]
  rw [mul_assoc, add_mul_div_left _ _ hn, add_mul_mod_self_left,
    mod_eq_of_lt (Nat.div_lt_of_lt_mul (mod_lt _ (mul_pos hn hk)))]
#align nat.mod_mul_right_div_self Nat.mod_mul_right_div_self

theorem mod_mul_left_div_self (m n k : ℕ) : m % (k * n) / n = m / n % k := by
  rw [mul_comm k, mod_mul_right_div_self]
#align nat.mod_mul_left_div_self Nat.mod_mul_left_div_self

theorem not_dvd_of_pos_of_lt (h1 : 0 < n) (h2 : n < m) : ¬m ∣ n := by
  rintro ⟨k, rfl⟩
  rcases Nat.eq_zero_or_pos k with (rfl | hk)
  · exact lt_irrefl 0 h1
  · exact not_lt.2 (le_mul_of_pos_right hk) h2
#align nat.not_dvd_of_pos_of_lt Nat.not_dvd_of_pos_of_lt

/-- If `m` and `n` are equal mod `k`, `m - n` is zero mod `k`. -/
theorem sub_mod_eq_zero_of_mod_eq (h : m % k = n % k) : (m - n) % k = 0 := by
  rw [← Nat.mod_add_div m k, ← Nat.mod_add_div n k, ← h, tsub_add_eq_tsub_tsub,
    @add_tsub_cancel_left, ← mul_tsub k, Nat.mul_mod_right]
#align nat.sub_mod_eq_zero_of_mod_eq Nat.sub_mod_eq_zero_of_mod_eq

@[simp]
theorem one_mod (n : ℕ) : 1 % (n + 2) = 1 :=
  Nat.mod_eq_of_lt (add_lt_add_right n.succ_pos 1)
#align nat.one_mod Nat.one_mod

theorem dvd_sub_mod (k : ℕ) : n ∣ k - k % n :=
  ⟨k / n, tsub_eq_of_eq_add_rev (Nat.mod_add_div k n).symm⟩
#align nat.dvd_sub_mod Nat.dvd_sub_mod

theorem add_mod_eq_ite :
    (m + n) % k = if k ≤ m % k + n % k then m % k + n % k - k else m % k + n % k := by
  cases k; simp [mod_zero]
  rw [Nat.add_mod]
  split_ifs with h
  · rw [Nat.mod_eq_sub_mod h, Nat.mod_eq_of_lt]
    exact
      (tsub_lt_iff_right h).mpr (Nat.add_lt_add (m.mod_lt (zero_lt_succ _))
        (n.mod_lt (zero_lt_succ _)))
  · exact Nat.mod_eq_of_lt (lt_of_not_ge h)
#align nat.add_mod_eq_ite Nat.add_mod_eq_ite

theorem div_mul_div_comm (hmn : n ∣ m) (hkl : l ∣ k) : m / n * (k / l) = m * k / (n * l) :=
  have exi1 : ∃ x, m = n * x := hmn
  have exi2 : ∃ y, k = l * y := hkl
  if hn : n = 0 then by simp [hn]
  else
    have : 0 < n := Nat.pos_of_ne_zero hn
    if hl : l = 0 then by simp [hl]
    else by
      have : 0 < l := Nat.pos_of_ne_zero hl
      cases' exi1 with x hx
      cases' exi2 with y hy
      rw [hx, hy, Nat.mul_div_cancel_left, Nat.mul_div_cancel_left]
      apply Eq.symm
      apply Nat.div_eq_of_eq_mul_left
      apply mul_pos
      repeat' assumption
      -- Porting note: this line was `cc` in Lean3
      simp only [mul_comm, mul_left_comm, mul_assoc]

#align nat.div_mul_div_comm Nat.div_mul_div_comm

theorem div_eq_self : m / n = m ↔ m = 0 ∨ n = 1 := by
  constructor
  · intro
    match n with
    | 0 => simp_all
    | 1 =>
      right
      rfl
    | n+2 =>
      left
      have : m / (n + 2) ≤ m / 2 := div_le_div_left (by simp) (by decide)
      refine eq_zero_of_le_half ?_
      simp_all
  · rintro (rfl | rfl) <;> simp
#align nat.div_eq_self Nat.div_eq_self

theorem div_eq_sub_mod_div : m / n = (m - m % n) / n := by
  by_cases n0 : n = 0
  · rw [n0, Nat.div_zero, Nat.div_zero]
  · have : m - m % n = n * (m / n) := by
      rw [tsub_eq_iff_eq_add_of_le (Nat.mod_le _ _), add_comm, mod_add_div]
    rw [this, mul_div_right _ (Nat.pos_of_ne_zero n0)]
#align nat.div_eq_sub_mod_div Nat.div_eq_sub_mod_div

/-- `m` is not divisible by `n` if it is between `n * k` and `n * (k + 1)` for some `k`. -/
theorem not_dvd_of_between_consec_multiples (h1 : n * k < m) (h2 : m < n * (k + 1)) : ¬n ∣ m := by
  rintro ⟨d, rfl⟩
  exact Monotone.ne_of_lt_of_lt_nat (Covariant.monotone_of_const n) k h1 h2 d rfl
#align nat.not_dvd_of_between_consec_multiples Nat.not_dvd_of_between_consec_multiples

/-! ### `find` -/

section Find

variable {p q : ℕ → Prop} [DecidablePred p] [DecidablePred q]

--Porting note: removing `simp` attribute as `simp` can prove it
theorem find_pos (h : ∃ n : ℕ, p n) : 0 < Nat.find h ↔ ¬p 0 := by
  rw [pos_iff_ne_zero, Ne, Nat.find_eq_zero]
#align nat.find_pos Nat.find_pos

theorem find_add {hₘ : ∃ m, p (m + n)} {hₙ : ∃ n, p n} (hn : n ≤ Nat.find hₙ) :
    Nat.find hₘ + n = Nat.find hₙ := by
  refine ((le_find_iff _ _).2 fun m hm hpm => hm.not_le ?_).antisymm ?_
  · have hnm : n ≤ m := hn.trans (find_le hpm)
    refine add_le_of_le_tsub_right_of_le hnm (find_le ?_)
    rwa [tsub_add_cancel_of_le hnm]
  · rw [← tsub_le_iff_right]
    refine (le_find_iff _ _).2 fun m hm hpm => hm.not_le ?_
    rw [tsub_le_iff_right]
    exact find_le hpm
#align nat.find_add Nat.find_add

end Find

/-! ### `find_greatest` -/

section FindGreatest

variable {P Q : ℕ → Prop} [DecidablePred P]

theorem findGreatest_eq_iff :
    Nat.findGreatest P k = m ↔ m ≤ k ∧ (m ≠ 0 → P m) ∧ ∀ ⦃n⦄, m < n → n ≤ k → ¬P n := by
  induction' k with k ihk generalizing m
  · rw [eq_comm, Iff.comm]
    simp only [zero_eq, nonpos_iff_eq_zero, ne_eq, findGreatest_zero, and_iff_left_iff_imp]
    rintro rfl
    exact ⟨fun h => (h rfl).elim, fun n hlt heq => (hlt.ne heq.symm).elim⟩
  · by_cases hk : P (k + 1)
    · rw [findGreatest_eq hk]
      constructor
      · rintro rfl
        exact ⟨le_rfl, fun _ => hk, fun n hlt hle => (hlt.not_le hle).elim⟩
      · rintro ⟨hle, h0, hm⟩
        rcases Decidable.eq_or_lt_of_le hle with (rfl | hlt)
        exacts[rfl, (hm hlt le_rfl hk).elim]
    · rw [findGreatest_of_not hk, ihk]
      constructor
      · rintro ⟨hle, hP, hm⟩
        refine ⟨hle.trans k.le_succ, hP, fun n hlt hle => ?_⟩
        rcases Decidable.eq_or_lt_of_le hle with (rfl | hlt')
        exacts[hk, hm hlt <| lt_succ_iff.1 hlt']
      · rintro ⟨hle, hP, hm⟩
        refine ⟨lt_succ_iff.1 (hle.lt_of_ne ?_), hP, fun n hlt hle => hm hlt (hle.trans k.le_succ)⟩
        rintro rfl
        exact hk (hP k.succ_ne_zero)
#align nat.find_greatest_eq_iff Nat.findGreatest_eq_iff

theorem findGreatest_eq_zero_iff : Nat.findGreatest P k = 0 ↔ ∀ ⦃n⦄, 0 < n → n ≤ k → ¬P n := by
  simp [findGreatest_eq_iff]
#align nat.find_greatest_eq_zero_iff Nat.findGreatest_eq_zero_iff

theorem findGreatest_spec (hmb : m ≤ n) (hm : P m) : P (Nat.findGreatest P n) := by
  by_cases h : Nat.findGreatest P n = 0
  · cases m
    · rwa [h]
    exact ((findGreatest_eq_zero_iff.1 h) (zero_lt_succ _) hmb hm).elim
  · exact (findGreatest_eq_iff.1 rfl).2.1 h
#align nat.find_greatest_spec Nat.findGreatest_spec

theorem findGreatest_le (n : ℕ) : Nat.findGreatest P n ≤ n :=
  (findGreatest_eq_iff.1 rfl).1
#align nat.find_greatest_le Nat.findGreatest_le

theorem le_findGreatest (hmb : m ≤ n) (hm : P m) : m ≤ Nat.findGreatest P n :=
  le_of_not_lt fun hlt => (findGreatest_eq_iff.1 rfl).2.2 hlt hmb hm
#align nat.le_find_greatest Nat.le_findGreatest

theorem findGreatest_mono_right (P : ℕ → Prop) [DecidablePred P] :
    Monotone (Nat.findGreatest P) := by
  refine monotone_nat_of_le_succ fun n => ?_
  rw [findGreatest_succ]
  split_ifs
  · exact (findGreatest_le n).trans (le_succ _)
  · rfl
#align nat.find_greatest_mono_right Nat.findGreatest_mono_right

theorem findGreatest_mono [DecidablePred Q] (hPQ : P ≤ Q) (hmn : m ≤ n) :
    Nat.findGreatest P m ≤ Nat.findGreatest Q n :=
  (Nat.findGreatest_mono_right _ hmn).trans <| findGreatest_mono_left hPQ _
#align nat.find_greatest_mono Nat.findGreatest_mono

theorem findGreatest_is_greatest (hk : Nat.findGreatest P n < k) (hkb : k ≤ n) : ¬P k :=
  (findGreatest_eq_iff.1 rfl).2.2 hk hkb
#align nat.find_greatest_is_greatest Nat.findGreatest_is_greatest

theorem findGreatest_of_ne_zero (h : Nat.findGreatest P n = m) (h0 : m ≠ 0) : P m :=
  (findGreatest_eq_iff.1 h).2.1 h0
#align nat.find_greatest_of_ne_zero Nat.findGreatest_of_ne_zero

end FindGreatest

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

set_option linter.deprecated false

protected theorem bit0_le {n m : ℕ} (h : n ≤ m) : bit0 n ≤ bit0 m :=
  add_le_add h h
#align nat.bit0_le Nat.bit0_le

protected theorem bit1_le {n m : ℕ} (h : n ≤ m) : bit1 n ≤ bit1 m :=
  succ_le_succ (add_le_add h h)
#align nat.bit1_le Nat.bit1_le

theorem bit_le : ∀ (b : Bool) {m n : ℕ}, m ≤ n → bit b m ≤ bit b n
  | true, _, _, h => Nat.bit1_le  h
  | false, _, _, h => Nat.bit0_le h
#align nat.bit_le Nat.bit_le

theorem bit0_le_bit : ∀ (b) {m n : ℕ}, m ≤ n → bit0 m ≤ bit b n
  | true, _, _, h => le_of_lt <| Nat.bit0_lt_bit1 h
  | false, _, _, h => Nat.bit0_le h
#align nat.bit0_le_bit Nat.bit0_le_bit

theorem bit_le_bit1 : ∀ (b) {m n : ℕ}, m ≤ n → bit b m ≤ bit1 n
  | false, _, _, h => le_of_lt <| Nat.bit0_lt_bit1 h
  | true, _, _, h => Nat.bit1_le h
#align nat.bit_le_bit1 Nat.bit_le_bit1

theorem bit_lt_bit0 : ∀ (b) {m n : ℕ}, m < n → bit b m < bit0 n
  | true, _, _, h => Nat.bit1_lt_bit0 h
  | false, _, _, h => Nat.bit0_lt h
#align nat.bit_lt_bit0 Nat.bit_lt_bit0

theorem bit_lt_bit (a b) (h : m < n) : bit a m < bit b n :=
  lt_of_lt_of_le (bit_lt_bit0 _ h) (bit0_le_bit _ le_rfl)
#align nat.bit_lt_bit Nat.bit_lt_bit

@[simp]
theorem bit0_le_bit1_iff : bit0 m ≤ bit1 n ↔ m ≤ n :=
  ⟨fun h => by
    rwa [← Nat.lt_succ_iff, n.bit1_eq_succ_bit0,
    ← n.bit0_succ_eq, bit0_lt_bit0, Nat.lt_succ_iff] at h,
    fun h => le_of_lt (Nat.bit0_lt_bit1 h)⟩
#align nat.bit0_le_bit1_iff Nat.bit0_le_bit1_iff

@[simp]
theorem bit0_lt_bit1_iff : bit0 m < bit1 n ↔ m ≤ n :=
  ⟨fun h => bit0_le_bit1_iff.1 (le_of_lt h), Nat.bit0_lt_bit1⟩
#align nat.bit0_lt_bit1_iff Nat.bit0_lt_bit1_iff

@[simp]
theorem bit1_le_bit0_iff : bit1 m ≤ bit0 n ↔ m < n :=
  ⟨fun h => by rwa [m.bit1_eq_succ_bit0, succ_le_iff, bit0_lt_bit0] at h, fun h =>
    le_of_lt (Nat.bit1_lt_bit0 h)⟩
#align nat.bit1_le_bit0_iff Nat.bit1_le_bit0_iff

@[simp]
theorem bit1_lt_bit0_iff : bit1 m < bit0 n ↔ m < n :=
  ⟨fun h => bit1_le_bit0_iff.1 (le_of_lt h), Nat.bit1_lt_bit0⟩
#align nat.bit1_lt_bit0_iff Nat.bit1_lt_bit0_iff

-- Porting note: temporarily porting only needed portions
/-
@[simp]
theorem one_le_bit0_iff : 1 ≤ bit0 n ↔ 0 < n := by
  convert bit1_le_bit0_iff
  rfl
#align nat.one_le_bit0_iff Nat.one_le_bit0_iff

@[simp]
theorem one_lt_bit0_iff : 1 < bit0 n ↔ 1 ≤ n := by
  convert bit1_lt_bit0_iff
  rfl
#align nat.one_lt_bit0_iff Nat.one_lt_bit0_iff

@[simp]
theorem bit_le_bit_iff : ∀ {b : Bool}, bit b m ≤ bit b n ↔ m ≤ n
  | false => bit0_le_bit0
  | true => bit1_le_bit1
#align nat.bit_le_bit_iff Nat.bit_le_bit_iff

@[simp]
theorem bit_lt_bit_iff : ∀ {b : Bool}, bit b m < bit b n ↔ m < n
  | false => bit0_lt_bit0
  | true => bit1_lt_bit1
#align nat.bit_lt_bit_iff Nat.bit_lt_bit_iff

@[simp]
theorem bit_le_bit1_iff : ∀ {b : Bool}, bit b m ≤ bit1 n ↔ m ≤ n
  | false => bit0_le_bit1_iff
  | true => bit1_le_bit1
#align nat.bit_le_bit1_iff Nat.bit_le_bit1_iff
-/

end Bit

/-! ### decidability of predicates -/

instance decidableLoHi (lo hi : ℕ) (P : ℕ → Prop) [H : DecidablePred P] :
    Decidable (∀ x, lo ≤ x → x < hi → P x) :=
  decidable_of_iff (∀ x < hi - lo, P (lo + x))
    ⟨fun al x hl hh => by
      have := al (x - lo) ((tsub_lt_tsub_iff_right hl).mpr hh)
      rwa [add_tsub_cancel_of_le hl] at this, fun al x h =>
      al _ (Nat.le_add_right _ _) (lt_tsub_iff_left.mp h)⟩
#align nat.decidable_lo_hi Nat.decidableLoHi

instance decidableLoHiLe (lo hi : ℕ) (P : ℕ → Prop) [DecidablePred P] :
    Decidable (∀ x, lo ≤ x → x ≤ hi → P x) :=
  decidable_of_iff (∀ x, lo ≤ x → x < hi + 1 → P x) <|
    ball_congr fun _ _ => imp_congr lt_succ_iff Iff.rfl
#align nat.decidable_lo_hi_le Nat.decidableLoHiLe

end Nat


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fin.tuple.basic
import data.list.join
import data.list.pairwise

/-!
# Lists from functions

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

Theorems and lemmas for dealing with `list.of_fn`, which converts a function on `fin n` to a list
of length `n`.

## Main Statements

The main statements pertain to lists generated using `of_fn`

- `list.length_of_fn`, which tells us the length of such a list
- `list.nth_of_fn`, which tells us the nth element of such a list
- `list.array_eq_of_fn`, which interprets the list form of an array as such a list.
- `list.equiv_sigma_tuple`, which is an `equiv` between lists and the functions that generate them
  via `list.of_fn`.
-/

universes u

variables {α : Type u}

open nat
namespace list

lemma length_of_fn_aux {n} (f : fin n → α) :
  ∀ m h l, length (of_fn_aux f m h l) = length l + m
| 0        h l := rfl
| (succ m) h l := (length_of_fn_aux m _ _).trans (succ_add _ _)

/-- The length of a list converted from a function is the size of the domain. -/
@[simp] theorem length_of_fn {n} (f : fin n → α) : length (of_fn f) = n :=
(length_of_fn_aux f _ _ _).trans (zero_add _)

lemma nth_of_fn_aux {n} (f : fin n → α) (i) :
  ∀ m h l,
    (∀ i, nth l i = of_fn_nth_val f (i + m)) →
     nth (of_fn_aux f m h l) i = of_fn_nth_val f i
| 0        h l H := H i
| (succ m) h l H := nth_of_fn_aux m _ _ begin
  intro j, cases j with j,
  { simp only [nth, of_fn_nth_val, zero_add, dif_pos (show m < n, from h)] },
  { simp only [nth, H, add_succ, succ_add] }
end

/-- The `n`th element of a list -/
@[simp] theorem nth_of_fn {n} (f : fin n → α) (i) :
  nth (of_fn f) i = of_fn_nth_val f i :=
nth_of_fn_aux f _ _ _ _ $ λ i,
by simp only [of_fn_nth_val, dif_neg (not_lt.2 (nat.le_add_left n i))]; refl

theorem nth_le_of_fn {n} (f : fin n → α) (i : fin n) :
  nth_le (of_fn f) i ((length_of_fn f).symm ▸ i.2) = f i :=
option.some.inj $ by rw [← nth_le_nth];
  simp only [list.nth_of_fn, of_fn_nth_val, fin.eta, dif_pos i.is_lt]

@[simp] theorem nth_le_of_fn' {n} (f : fin n → α) {i : ℕ} (h : i < (of_fn f).length) :
  nth_le (of_fn f) i h = f ⟨i, ((length_of_fn f) ▸ h)⟩ :=
nth_le_of_fn f ⟨i, ((length_of_fn f) ▸ h)⟩

@[simp] lemma map_of_fn {β : Type*} {n : ℕ} (f : fin n → α) (g : α → β) :
  map g (of_fn f) = of_fn (g ∘ f) :=
ext_le (by simp) (λ i h h', by simp)

/-- Arrays converted to lists are the same as `of_fn` on the indexing function of the array. -/
theorem array_eq_of_fn {n} (a : array n α) : a.to_list = of_fn a.read :=
suffices ∀ {m h l}, d_array.rev_iterate_aux a
  (λ i, cons) m h l = of_fn_aux (d_array.read a) m h l, from this,
begin
  intros, induction m with m IH generalizing l, {refl},
  simp only [d_array.rev_iterate_aux, of_fn_aux, IH]
end

@[congr]
theorem of_fn_congr {m n : ℕ} (h : m = n) (f : fin m → α) :
  of_fn f = of_fn (λ i : fin n, f (fin.cast h.symm i)) :=
begin
  subst h,
  simp_rw [fin.cast_refl, order_iso.refl_apply],
end

/-- `of_fn` on an empty domain is the empty list. -/
@[simp] theorem of_fn_zero (f : fin 0 → α) : of_fn f = [] := rfl

@[simp] theorem of_fn_succ {n} (f : fin (succ n) → α) :
  of_fn f = f 0 :: of_fn (λ i, f i.succ) :=
suffices ∀ {m h l}, of_fn_aux f (succ m) (succ_le_succ h) l =
  f 0 :: of_fn_aux (λ i, f i.succ) m h l, from this,
begin
  intros, induction m with m IH generalizing l, {refl},
  rw [of_fn_aux, IH], refl
end

theorem of_fn_succ' {n} (f : fin (succ n) → α) :
  of_fn f = (of_fn (λ i, f i.cast_succ)).concat (f (fin.last _)) :=
begin
  induction n with n IH,
  { rw [of_fn_zero, concat_nil, of_fn_succ, of_fn_zero], refl },
  { rw [of_fn_succ, IH, of_fn_succ, concat_cons, fin.cast_succ_zero],
    congr' 3,
    simp_rw [fin.cast_succ_fin_succ], }
end

@[simp] lemma of_fn_eq_nil_iff {n : ℕ} {f : fin n → α} :
  of_fn f = [] ↔ n = 0 :=
by cases n; simp only [of_fn_zero, of_fn_succ, eq_self_iff_true, nat.succ_ne_zero]

lemma last_of_fn {n : ℕ} (f : fin n → α) (h : of_fn f ≠ [])
  (hn : n - 1 < n := nat.pred_lt $ of_fn_eq_nil_iff.not.mp h) :
  last (of_fn f) h = f ⟨n - 1, hn⟩ :=
by simp [last_eq_nth_le]

lemma last_of_fn_succ {n : ℕ} (f : fin n.succ → α)
  (h : of_fn f ≠ [] := mt of_fn_eq_nil_iff.mp (nat.succ_ne_zero _)) :
  last (of_fn f) h = f (fin.last _) :=
last_of_fn f h

/-- Note this matches the convention of `list.of_fn_succ'`, putting the `fin m` elements first. -/
theorem of_fn_add {m n} (f : fin (m + n) → α) :
  list.of_fn f = list.of_fn (λ i, f (fin.cast_add n i)) ++ list.of_fn (λ j, f (fin.nat_add m j)) :=
begin
  induction n with n IH,
  { rw [of_fn_zero, append_nil, fin.cast_add_zero, fin.cast_refl], refl },
  { rw [of_fn_succ', of_fn_succ', IH, append_concat], refl, },
end

@[simp] theorem of_fn_fin_append {m n} (a : fin m → α) (b : fin n → α) :
  list.of_fn (fin.append a b) = list.of_fn a ++ list.of_fn b :=
by simp_rw [of_fn_add, fin.append_left, fin.append_right]

/-- This breaks a list of `m*n` items into `m` groups each containing `n` elements. -/
theorem of_fn_mul {m n} (f : fin (m * n) → α) :
  list.of_fn f = list.join (list.of_fn $ λ i : fin m, list.of_fn $ λ j : fin n,
  f ⟨i * n + j,
    calc ↑i * n + j < (i + 1) *n : (add_lt_add_left j.prop _).trans_eq (add_one_mul _ _).symm
                ... ≤ _ : nat.mul_le_mul_right _ i.prop⟩) :=
begin
  induction m with m IH,
  { simp_rw [of_fn_zero, zero_mul, of_fn_zero, join], },
  { simp_rw [of_fn_succ', succ_mul, join_concat, of_fn_add, IH], refl, },
end

/-- This breaks a list of `m*n` items into `n` groups each containing `m` elements. -/
theorem of_fn_mul' {m n} (f : fin (m * n) → α) :
  list.of_fn f = list.join (list.of_fn $ λ i : fin n, list.of_fn $ λ j : fin m,
  f ⟨m * i + j,
    calc m * i + j < m * (i + 1) : (add_lt_add_left j.prop _).trans_eq (mul_add_one _ _).symm
               ... ≤ _ : nat.mul_le_mul_left _ i.prop⟩) :=
by simp_rw [mul_comm m n, mul_comm m, of_fn_mul, fin.cast_mk]

theorem of_fn_nth_le : ∀ l : list α, of_fn (λ i, nth_le l i i.2) = l
| [] := rfl
| (a::l) := by { rw of_fn_succ, congr, simp only [fin.coe_succ], exact of_fn_nth_le l }

-- not registered as a simp lemma, as otherwise it fires before `forall_mem_of_fn_iff` which
-- is much more useful
lemma mem_of_fn {n} (f : fin n → α) (a : α) :
  a ∈ of_fn f ↔ a ∈ set.range f :=
begin
  simp only [mem_iff_nth_le, set.mem_range, nth_le_of_fn'],
  exact ⟨λ ⟨i, hi, h⟩, ⟨_, h⟩, λ ⟨i, hi⟩, ⟨i.1, (length_of_fn f).symm ▸ i.2, by simpa using hi⟩⟩
end

@[simp] lemma forall_mem_of_fn_iff {n : ℕ} {f : fin n → α} {P : α → Prop} :
  (∀ i ∈ of_fn f, P i) ↔ ∀ j : fin n, P (f j) :=
by simp only [mem_of_fn, set.forall_range_iff]

@[simp] lemma of_fn_const (n : ℕ) (c : α) :
  of_fn (λ i : fin n, c) = replicate n c :=
nat.rec_on n (by simp) $ λ n ihn, by simp [ihn]

@[simp] theorem of_fn_fin_repeat {m} (a : fin m → α) (n : ℕ) :
  list.of_fn (fin.repeat n a) = (list.replicate n (list.of_fn a)).join :=
by simp_rw [of_fn_mul, ←of_fn_const, fin.repeat, fin.mod_nat, fin.coe_mk,
  add_comm, nat.add_mul_mod_self_right, nat.mod_eq_of_lt (fin.is_lt _), fin.eta]

@[simp] lemma pairwise_of_fn {R : α → α → Prop} {n} {f : fin n → α} :
  (of_fn f).pairwise R ↔ ∀ ⦃i j⦄, i < j → R (f i) (f j) :=
by { simp only [pairwise_iff_nth_le, fin.forall_iff, length_of_fn, nth_le_of_fn', fin.mk_lt_mk],
  exact ⟨λ h i hi j hj hij, h _ _ hj hij, λ h i j hj hij, h _ (hij.trans hj) _ hj hij⟩ }

/-- Lists are equivalent to the sigma type of tuples of a given length. -/
@[simps]
def equiv_sigma_tuple : list α ≃ Σ n, fin n → α :=
{ to_fun := λ l, ⟨l.length, λ i, l.nth_le ↑i i.2⟩,
  inv_fun := λ f, list.of_fn f.2,
  left_inv := list.of_fn_nth_le,
  right_inv := λ ⟨n, f⟩, fin.sigma_eq_of_eq_comp_cast (length_of_fn _) $ funext $ λ i,
    nth_le_of_fn' f i.prop }

/-- A recursor for lists that expands a list into a function mapping to its elements.

This can be used with `induction l using list.of_fn_rec`. -/
@[elab_as_eliminator]
def of_fn_rec {C : list α → Sort*} (h : Π n (f : fin n → α), C (list.of_fn f)) (l : list α) : C l :=
cast (congr_arg _ l.of_fn_nth_le) $ h l.length (λ i, l.nth_le ↑i i.2)

@[simp]
lemma of_fn_rec_of_fn {C : list α → Sort*} (h : Π n (f : fin n → α), C (list.of_fn f))
  {n : ℕ} (f : fin n → α) : @of_fn_rec _ C h (list.of_fn f) = h _ f :=
equiv_sigma_tuple.right_inverse_symm.cast_eq (λ s, h s.1 s.2) ⟨n, f⟩

lemma exists_iff_exists_tuple {P : list α → Prop} :
  (∃ l : list α, P l) ↔ ∃ n (f : fin n → α), P (list.of_fn f) :=
equiv_sigma_tuple.symm.surjective.exists.trans sigma.exists

lemma forall_iff_forall_tuple {P : list α → Prop} :
  (∀ l : list α, P l) ↔ ∀ n (f : fin n → α), P (list.of_fn f) :=
equiv_sigma_tuple.symm.surjective.forall.trans sigma.forall

/-- `fin.sigma_eq_iff_eq_comp_cast` may be useful to work with the RHS of this expression. -/
lemma of_fn_inj' {m n : ℕ} {f : fin m → α} {g : fin n → α} :
  of_fn f = of_fn g ↔ (⟨m, f⟩ : Σ n, fin n → α) = ⟨n, g⟩ :=
iff.symm $ equiv_sigma_tuple.symm.injective.eq_iff.symm

/-- Note we can only state this when the two functions are indexed by defeq `n`. -/
lemma of_fn_injective {n : ℕ} : function.injective (of_fn : (fin n → α) → list α) :=
λ f g h, eq_of_heq $ by injection of_fn_inj'.mp h

/-- A special case of `list.of_fn_inj'` for when the two functions are indexed by defeq `n`. -/
@[simp] lemma of_fn_inj {n : ℕ} {f g : fin n → α} : of_fn f = of_fn g ↔ f = g :=
of_fn_injective.eq_iff

end list


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Heather Macbeth
-/
import geometry.euclidean.angle.oriented.basic

/-!
# Rotations by oriented angles.

This file defines rotations by oriented angles in real inner product spaces.

## Main definitions

* `orientation.rotation` is the rotation by an oriented angle with respect to an orientation.

-/

noncomputable theory

open finite_dimensional complex
open_locale real real_inner_product_space complex_conjugate

namespace orientation

local attribute [instance] fact_finite_dimensional_of_finrank_eq_succ
local attribute [instance] complex.finrank_real_complex_fact

variables {V V' : Type*}
variables [normed_add_comm_group V] [normed_add_comm_group V']
variables [inner_product_space ℝ V] [inner_product_space ℝ V']
variables [fact (finrank ℝ V = 2)] [fact (finrank ℝ V' = 2)] (o : orientation ℝ V (fin 2))

local notation `J` := o.right_angle_rotation

/-- Auxiliary construction to build a rotation by the oriented angle `θ`. -/
def rotation_aux (θ : real.angle) : V →ₗᵢ[ℝ] V :=
linear_map.isometry_of_inner
  (real.angle.cos θ • linear_map.id
        + real.angle.sin θ • ↑(linear_isometry_equiv.to_linear_equiv J))
  begin
    intros x y,
    simp only [is_R_or_C.conj_to_real, id.def, linear_map.smul_apply, linear_map.add_apply,
      linear_map.id_coe, linear_equiv.coe_coe, linear_isometry_equiv.coe_to_linear_equiv,
      orientation.area_form_right_angle_rotation_left,
      orientation.inner_right_angle_rotation_left,
      orientation.inner_right_angle_rotation_right,
      inner_add_left, inner_smul_left, inner_add_right, inner_smul_right],
    linear_combination inner x y * θ.cos_sq_add_sin_sq,
  end

@[simp] lemma rotation_aux_apply (θ : real.angle) (x : V) :
  o.rotation_aux θ x = real.angle.cos θ • x + real.angle.sin θ • J x :=
rfl

/-- A rotation by the oriented angle `θ`. -/
def rotation (θ : real.angle) : V ≃ₗᵢ[ℝ] V :=
linear_isometry_equiv.of_linear_isometry
  (o.rotation_aux θ)
  (real.angle.cos θ • linear_map.id - real.angle.sin θ • ↑(linear_isometry_equiv.to_linear_equiv J))
  begin
    ext x,
    convert congr_arg (λ t : ℝ, t • x) θ.cos_sq_add_sin_sq using 1,
    { simp only [o.right_angle_rotation_right_angle_rotation, o.rotation_aux_apply,
        function.comp_app, id.def, linear_equiv.coe_coe, linear_isometry.coe_to_linear_map,
        linear_isometry_equiv.coe_to_linear_equiv, map_smul, map_sub, linear_map.coe_comp,
        linear_map.id_coe, linear_map.smul_apply, linear_map.sub_apply, ← mul_smul, add_smul,
        smul_add, smul_neg, smul_sub, mul_comm, sq],
      abel },
    { simp },
  end
  begin
    ext x,
    convert congr_arg (λ t : ℝ, t • x) θ.cos_sq_add_sin_sq using 1,
    { simp only [o.right_angle_rotation_right_angle_rotation, o.rotation_aux_apply,
        function.comp_app, id.def, linear_equiv.coe_coe, linear_isometry.coe_to_linear_map,
        linear_isometry_equiv.coe_to_linear_equiv, map_add, map_smul, linear_map.coe_comp,
        linear_map.id_coe, linear_map.smul_apply, linear_map.sub_apply, add_smul, ← mul_smul,
        mul_comm, smul_add, smul_neg, sq],
      abel },
    { simp },
  end

lemma rotation_apply (θ : real.angle) (x : V) :
  o.rotation θ x = real.angle.cos θ • x + real.angle.sin θ • J x :=
rfl

lemma rotation_symm_apply (θ : real.angle) (x : V) :
  (o.rotation θ).symm x = real.angle.cos θ • x - real.angle.sin θ • J x :=
rfl

attribute [irreducible] rotation

lemma rotation_eq_matrix_to_lin (θ : real.angle) {x : V} (hx : x ≠ 0) :
  (o.rotation θ).to_linear_map
  = matrix.to_lin
      (o.basis_right_angle_rotation x hx) (o.basis_right_angle_rotation x hx)
      !![θ.cos, -θ.sin; θ.sin, θ.cos] :=
begin
  apply (o.basis_right_angle_rotation x hx).ext,
  intros i,
  fin_cases i,
  { rw matrix.to_lin_self,
    simp [rotation_apply, fin.sum_univ_succ] },
  { rw matrix.to_lin_self,
    simp [rotation_apply, fin.sum_univ_succ, add_comm] },
end

/-- The determinant of `rotation` (as a linear map) is equal to `1`. -/
@[simp] lemma det_rotation (θ : real.angle) :
  (o.rotation θ).to_linear_map.det = 1 :=
begin
  haveI : nontrivial V :=
    finite_dimensional.nontrivial_of_finrank_eq_succ (fact.out (finrank ℝ V = 2)),
  obtain ⟨x, hx⟩ : ∃ x, x ≠ (0:V) := exists_ne (0:V),
  rw o.rotation_eq_matrix_to_lin θ hx,
  simpa [sq] using θ.cos_sq_add_sin_sq,
end

/-- The determinant of `rotation` (as a linear equiv) is equal to `1`. -/
@[simp] lemma linear_equiv_det_rotation (θ : real.angle) :
  (o.rotation θ).to_linear_equiv.det = 1 :=
units.ext $ o.det_rotation θ

/-- The inverse of `rotation` is rotation by the negation of the angle. -/
@[simp] lemma rotation_symm (θ : real.angle) : (o.rotation θ).symm = o.rotation (-θ) :=
by ext; simp [o.rotation_apply, o.rotation_symm_apply, sub_eq_add_neg]

/-- Rotation by 0 is the identity. -/
@[simp] lemma rotation_zero : o.rotation 0 = linear_isometry_equiv.refl ℝ V :=
by ext; simp [rotation]

/-- Rotation by π is negation. -/
@[simp] lemma rotation_pi : o.rotation π = linear_isometry_equiv.neg ℝ :=
begin
  ext x,
  simp [rotation]
end

/-- Rotation by π is negation. -/
lemma rotation_pi_apply (x : V) : o.rotation π x = -x :=
by simp

/-- Rotation by π / 2 is the "right-angle-rotation" map `J`. -/
lemma rotation_pi_div_two : o.rotation (π / 2 : ℝ) = J :=
begin
  ext x,
  simp [rotation],
end

/-- Rotating twice is equivalent to rotating by the sum of the angles. -/
@[simp] lemma rotation_rotation (θ₁ θ₂ : real.angle) (x : V) :
  o.rotation θ₁ (o.rotation θ₂ x) = o.rotation (θ₁ + θ₂) x :=
begin
  simp only [o.rotation_apply, ←mul_smul, real.angle.cos_add, real.angle.sin_add, add_smul,
    sub_smul, linear_isometry_equiv.trans_apply, smul_add, linear_isometry_equiv.map_add,
    linear_isometry_equiv.map_smul, right_angle_rotation_right_angle_rotation, smul_neg],
  ring_nf,
  abel,
end

/-- Rotating twice is equivalent to rotating by the sum of the angles. -/
@[simp] lemma rotation_trans (θ₁ θ₂ : real.angle) :
  (o.rotation θ₁).trans (o.rotation θ₂) = o.rotation (θ₂ + θ₁) :=
linear_isometry_equiv.ext $ λ _, by rw [←rotation_rotation, linear_isometry_equiv.trans_apply]

/-- Rotating the first of two vectors by `θ` scales their Kahler form by `cos θ - sin θ * I`. -/
@[simp] lemma kahler_rotation_left (x y : V) (θ : real.angle) :
  o.kahler (o.rotation θ x) y = conj (θ.exp_map_circle : ℂ) * o.kahler x y :=
begin
  simp only [o.rotation_apply, map_add, map_mul, linear_map.map_smulₛₗ, ring_hom.id_apply,
    linear_map.add_apply, linear_map.smul_apply, real_smul, kahler_right_angle_rotation_left,
    real.angle.coe_exp_map_circle, is_R_or_C.conj_of_real, conj_I],
  ring,
end

/-- Negating a rotation is equivalent to rotation by π plus the angle. -/
lemma neg_rotation (θ : real.angle) (x : V) : -o.rotation θ x = o.rotation (π + θ) x :=
by rw [←o.rotation_pi_apply, rotation_rotation]

/-- Negating a rotation by -π / 2 is equivalent to rotation by π / 2. -/
@[simp] lemma neg_rotation_neg_pi_div_two (x : V) :
  -o.rotation (-π / 2 : ℝ) x = o.rotation (π / 2 : ℝ) x :=
by rw [neg_rotation, ←real.angle.coe_add, neg_div, ←sub_eq_add_neg, sub_half]

/-- Negating a rotation by π / 2 is equivalent to rotation by -π / 2. -/
lemma neg_rotation_pi_div_two (x : V) : -o.rotation (π / 2 : ℝ) x = o.rotation (-π / 2 : ℝ) x :=
(neg_eq_iff_eq_neg.mp $ o.neg_rotation_neg_pi_div_two _).symm

/-- Rotating the first of two vectors by `θ` scales their Kahler form by `cos (-θ) + sin (-θ) * I`.
-/
lemma kahler_rotation_left' (x y : V) (θ : real.angle) :
  o.kahler (o.rotation θ x) y = (-θ).exp_map_circle * o.kahler x y :=
by simpa [coe_inv_circle_eq_conj, -kahler_rotation_left] using o.kahler_rotation_left x y θ

/-- Rotating the second of two vectors by `θ` scales their Kahler form by `cos θ + sin θ * I`. -/
@[simp] lemma kahler_rotation_right (x y : V) (θ : real.angle) :
  o.kahler x (o.rotation θ y) = θ.exp_map_circle * o.kahler x y :=
begin
  simp only [o.rotation_apply, map_add, linear_map.map_smulₛₗ, ring_hom.id_apply, real_smul,
    kahler_right_angle_rotation_right, real.angle.coe_exp_map_circle],
  ring,
end

/-- Rotating the first vector by `θ` subtracts `θ` from the angle between two vectors. -/
@[simp] lemma oangle_rotation_left {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) (θ : real.angle) :
  o.oangle (o.rotation θ x) y = o.oangle x y - θ :=
begin
  simp only [oangle, o.kahler_rotation_left'],
  rw [complex.arg_mul_coe_angle, real.angle.arg_exp_map_circle],
  { abel },
  { exact ne_zero_of_mem_circle _ },
  { exact o.kahler_ne_zero hx hy },
end

/-- Rotating the second vector by `θ` adds `θ` to the angle between two vectors. -/
@[simp] lemma oangle_rotation_right {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) (θ : real.angle) :
  o.oangle x (o.rotation θ y) = o.oangle x y + θ :=
begin
  simp only [oangle, o.kahler_rotation_right],
  rw [complex.arg_mul_coe_angle, real.angle.arg_exp_map_circle],
  { abel },
  { exact ne_zero_of_mem_circle _ },
  { exact o.kahler_ne_zero hx hy },
end

/-- The rotation of a vector by `θ` has an angle of `-θ` from that vector. -/
@[simp] lemma oangle_rotation_self_left {x : V} (hx : x ≠ 0) (θ : real.angle) :
  o.oangle (o.rotation θ x) x = -θ :=
by simp [hx]

/-- A vector has an angle of `θ` from the rotation of that vector by `θ`. -/
@[simp] lemma oangle_rotation_self_right {x : V} (hx : x ≠ 0) (θ : real.angle) :
  o.oangle x (o.rotation θ x) = θ :=
by simp [hx]

/-- Rotating the first vector by the angle between the two vectors results an an angle of 0. -/
@[simp] lemma oangle_rotation_oangle_left (x y : V) :
  o.oangle (o.rotation (o.oangle x y) x) y = 0 :=
begin
  by_cases hx : x = 0,
  { simp [hx] },
  { by_cases hy : y = 0,
    { simp [hy] },
    { simp [hx, hy] } }
end

/-- Rotating the first vector by the angle between the two vectors and swapping the vectors
results an an angle of 0. -/
@[simp] lemma oangle_rotation_oangle_right (x y : V) :
  o.oangle y (o.rotation (o.oangle x y) x) = 0 :=
begin
  rw [oangle_rev],
  simp
end

/-- Rotating both vectors by the same angle does not change the angle between those vectors. -/
@[simp] lemma oangle_rotation (x y : V) (θ : real.angle) :
  o.oangle (o.rotation θ x) (o.rotation θ y) = o.oangle x y :=
begin
  by_cases hx : x = 0; by_cases hy : y = 0;
    simp [hx, hy]
end

/-- A rotation of a nonzero vector equals that vector if and only if the angle is zero. -/
@[simp] lemma rotation_eq_self_iff_angle_eq_zero {x : V} (hx : x ≠ 0) (θ : real.angle) :
  o.rotation θ x = x ↔ θ = 0 :=
begin
  split,
  { intro h,
    rw eq_comm,
    simpa [hx, h] using o.oangle_rotation_right hx hx θ },
  { intro h,
    simp [h] }
end

/-- A nonzero vector equals a rotation of that vector if and only if the angle is zero. -/
@[simp] lemma eq_rotation_self_iff_angle_eq_zero {x : V} (hx : x ≠ 0) (θ : real.angle) :
  x = o.rotation θ x ↔ θ = 0 :=
by rw [←o.rotation_eq_self_iff_angle_eq_zero hx, eq_comm]

/-- A rotation of a vector equals that vector if and only if the vector or the angle is zero. -/
lemma rotation_eq_self_iff (x : V) (θ : real.angle) :
  o.rotation θ x = x ↔ x = 0 ∨ θ = 0 :=
begin
  by_cases h : x = 0;
    simp [h]
end

/-- A vector equals a rotation of that vector if and only if the vector or the angle is zero. -/
lemma eq_rotation_self_iff (x : V) (θ : real.angle) :
  x = o.rotation θ x ↔ x = 0 ∨ θ = 0 :=
by rw [←rotation_eq_self_iff, eq_comm]

/-- Rotating a vector by the angle to another vector gives the second vector if and only if the
norms are equal. -/
@[simp] lemma rotation_oangle_eq_iff_norm_eq (x y : V) :
  o.rotation (o.oangle x y) x = y ↔ ‖x‖ = ‖y‖ :=
begin
  split,
  { intro h,
    rw [←h, linear_isometry_equiv.norm_map] },
  { intro h,
    rw o.eq_iff_oangle_eq_zero_of_norm_eq;
      simp [h] }
end

/-- The angle between two nonzero vectors is `θ` if and only if the second vector is the first
rotated by `θ` and scaled by the ratio of the norms. -/
lemma oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0)
  (θ : real.angle) : o.oangle x y = θ ↔ y = (‖y‖ / ‖x‖) • o.rotation θ x :=
begin
  have hp := div_pos (norm_pos_iff.2 hy) (norm_pos_iff.2 hx),
  split,
  { rintro rfl,
    rw [←linear_isometry_equiv.map_smul, ←o.oangle_smul_left_of_pos x y hp,
        eq_comm, rotation_oangle_eq_iff_norm_eq, norm_smul, real.norm_of_nonneg hp.le,
        div_mul_cancel _ (norm_ne_zero_iff.2 hx)] },
  { intro hye,
    rw [hye, o.oangle_smul_right_of_pos _ _ hp, o.oangle_rotation_self_right hx] }
end

/-- The angle between two nonzero vectors is `θ` if and only if the second vector is the first
rotated by `θ` and scaled by a positive real. -/
lemma oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0)
  (θ : real.angle) : o.oangle x y = θ ↔ ∃ r : ℝ, 0 < r ∧ y = r • o.rotation θ x :=
begin
  split,
  { intro h,
    rw o.oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero hx hy at h,
    exact ⟨‖y‖ / ‖x‖, div_pos (norm_pos_iff.2 hy) (norm_pos_iff.2 hx), h⟩ },
  { rintro ⟨r, hr, rfl⟩,
    rw [o.oangle_smul_right_of_pos _ _ hr, o.oangle_rotation_self_right hx] }
end

/-- The angle between two vectors is `θ` if and only if they are nonzero and the second vector
is the first rotated by `θ` and scaled by the ratio of the norms, or `θ` and at least one of the
vectors are zero. -/
lemma oangle_eq_iff_eq_norm_div_norm_smul_rotation_or_eq_zero {x y : V} (θ : real.angle) :
  o.oangle x y = θ ↔
    (x ≠ 0 ∧ y ≠ 0 ∧ y = (‖y‖ / ‖x‖) • o.rotation θ x) ∨ (θ = 0 ∧ (x = 0 ∨ y = 0)) :=
begin
  by_cases hx : x = 0,
  { simp [hx, eq_comm] },
  { by_cases hy : y = 0,
    { simp [hy, eq_comm] },
    { rw o.oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero hx hy,
      simp [hx, hy] } }
end

/-- The angle between two vectors is `θ` if and only if they are nonzero and the second vector
is the first rotated by `θ` and scaled by a positive real, or `θ` and at least one of the
vectors are zero. -/
lemma oangle_eq_iff_eq_pos_smul_rotation_or_eq_zero {x y : V} (θ : real.angle) :
  o.oangle x y = θ ↔
    (x ≠ 0 ∧ y ≠ 0 ∧ ∃ r : ℝ, 0 < r ∧ y = r • o.rotation θ x) ∨ (θ = 0 ∧ (x = 0 ∨ y = 0)) :=
begin
  by_cases hx : x = 0,
  { simp [hx, eq_comm] },
  { by_cases hy : y = 0,
    { simp [hy, eq_comm] },
    { rw o.oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero hx hy,
      simp [hx, hy] } }
end

/-- Any linear isometric equivalence in `V` with positive determinant is `rotation`. -/
lemma exists_linear_isometry_equiv_eq_of_det_pos {f : V ≃ₗᵢ[ℝ] V}
  (hd : 0 < (f.to_linear_equiv : V →ₗ[ℝ] V).det) : ∃ θ : real.angle, f = o.rotation θ :=
begin
  haveI : nontrivial V :=
    finite_dimensional.nontrivial_of_finrank_eq_succ (fact.out (finrank ℝ V = 2)),
  obtain ⟨x, hx⟩ : ∃ x, x ≠ (0:V) := exists_ne (0:V),
  use o.oangle x (f x),
  apply linear_isometry_equiv.to_linear_equiv_injective,
  apply linear_equiv.to_linear_map_injective,
  apply (o.basis_right_angle_rotation x hx).ext,
  intros i,
  symmetry,
  fin_cases i,
  { simp },
  have : o.oangle (J x) (f (J x)) = o.oangle x (f x),
  { simp only [oangle, o.linear_isometry_equiv_comp_right_angle_rotation f hd,
      o.kahler_comp_right_angle_rotation] },
  simp [← this],
end

lemma rotation_map (θ : real.angle) (f : V ≃ₗᵢ[ℝ] V') (x : V') :
  (orientation.map (fin 2) f.to_linear_equiv o).rotation θ x
  = f (o.rotation θ (f.symm x)) :=
by simp [rotation_apply, o.right_angle_rotation_map]

@[simp] protected lemma _root_.complex.rotation (θ : real.angle) (z : ℂ) :
  complex.orientation.rotation θ z = θ.exp_map_circle * z :=
begin
  simp only [rotation_apply, complex.right_angle_rotation, real.angle.coe_exp_map_circle,
    real_smul],
  ring
end

/-- Rotation in an oriented real inner product space of dimension 2 can be evaluated in terms of a
complex-number representation of the space. -/
lemma rotation_map_complex (θ : real.angle) (f : V ≃ₗᵢ[ℝ] ℂ)
  (hf : (orientation.map (fin 2) f.to_linear_equiv o) = complex.orientation) (x : V) :
  f (o.rotation θ x) = θ.exp_map_circle * f x :=
begin
  rw [← complex.rotation, ← hf, o.rotation_map],
  simp,
end

/-- Negating the orientation negates the angle in `rotation`. -/
lemma rotation_neg_orientation_eq_neg (θ : real.angle) :
  (-o).rotation θ = o.rotation (-θ) :=
linear_isometry_equiv.ext $ by simp [rotation_apply]

/-- The inner product between a `π / 2` rotation of a vector and that vector is zero. -/
@[simp]

/-- The inner product between a vector and a `π / 2` rotation of that vector is zero. -/
@[simp] lemma inner_rotation_pi_div_two_right (x : V) : ⟪x, o.rotation (π / 2 : ℝ) x⟫ = 0 :=
by rw [real_inner_comm, inner_rotation_pi_div_two_left]

/-- The inner product between a multiple of a `π / 2` rotation of a vector and that vector is
zero. -/
@[simp] lemma inner_smul_rotation_pi_div_two_left (x : V) (r : ℝ) :
  ⟪r • o.rotation (π / 2 : ℝ) x, x⟫ = 0 :=
by rw [inner_smul_left, inner_rotation_pi_div_two_left, mul_zero]

/-- The inner product between a vector and a multiple of a `π / 2` rotation of that vector is
zero. -/
@[simp] lemma inner_smul_rotation_pi_div_two_right (x : V) (r : ℝ) :
  ⟪x, r • o.rotation (π / 2 : ℝ) x⟫ = 0 :=
by rw [real_inner_comm, inner_smul_rotation_pi_div_two_left]

/-- The inner product between a `π / 2` rotation of a vector and a multiple of that vector is
zero. -/
@[simp] lemma inner_rotation_pi_div_two_left_smul (x : V) (r : ℝ) :
  ⟪o.rotation (π / 2 : ℝ) x, r • x⟫ = 0 :=
by rw [inner_smul_right, inner_rotation_pi_div_two_left, mul_zero]

/-- The inner product between a multiple of a vector and a `π / 2` rotation of that vector is
zero. -/
@[simp] lemma inner_rotation_pi_div_two_right_smul (x : V) (r : ℝ) :
  ⟪r • x, o.rotation (π / 2 : ℝ) x⟫ = 0 :=
by rw [real_inner_comm, inner_rotation_pi_div_two_left_smul]

/-- The inner product between a multiple of a `π / 2` rotation of a vector and a multiple of
that vector is zero. -/
@[simp] lemma inner_smul_rotation_pi_div_two_smul_left (x : V) (r₁ r₂ : ℝ) :
  ⟪r₁ • o.rotation (π / 2 : ℝ) x, r₂ • x⟫ = 0 :=
by rw [inner_smul_right, inner_smul_rotation_pi_div_two_left, mul_zero]

/-- The inner product between a multiple of a vector and a multiple of a `π / 2` rotation of
that vector is zero. -/
@[simp] lemma inner_smul_rotation_pi_div_two_smul_right (x : V) (r₁ r₂ : ℝ) :
  ⟪r₂ • x, r₁ • o.rotation (π / 2 : ℝ) x⟫ = 0 :=
by rw [real_inner_comm, inner_smul_rotation_pi_div_two_smul_left]

/-- The inner product between two vectors is zero if and only if the first vector is zero or
the second is a multiple of a `π / 2` rotation of that vector. -/
lemma inner_eq_zero_iff_eq_zero_or_eq_smul_rotation_pi_div_two {x y : V} :
  ⟪x, y⟫ = 0 ↔ (x = 0 ∨ ∃ r : ℝ, r • o.rotation (π / 2 : ℝ) x = y) :=
begin
  rw ←o.eq_zero_or_oangle_eq_iff_inner_eq_zero,
  refine ⟨λ h, _, λ h, _⟩,
  { rcases h with rfl | rfl | h | h,
    { exact or.inl rfl },
    { exact or.inr ⟨0, zero_smul _ _⟩ },
    { obtain ⟨r, hr, rfl⟩ := (o.oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero
        (o.left_ne_zero_of_oangle_eq_pi_div_two h)
        (o.right_ne_zero_of_oangle_eq_pi_div_two h) _).1 h,
      exact or.inr ⟨r, rfl⟩ },
    { obtain ⟨r, hr, rfl⟩ := (o.oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero
        (o.left_ne_zero_of_oangle_eq_neg_pi_div_two h)
        (o.right_ne_zero_of_oangle_eq_neg_pi_div_two h) _).1 h,
      refine or.inr ⟨-r, _⟩,
      rw [neg_smul, ←smul_neg, o.neg_rotation_pi_div_two] } },
  { rcases h with rfl | ⟨r, rfl⟩,
    { exact or.inl rfl },
    { by_cases hx : x = 0, { exact or.inl hx },
      rcases lt_trichotomy r 0 with hr | rfl | hr,
      { refine or.inr (or.inr (or.inr _)),
        rw [o.oangle_smul_right_of_neg _ _ hr, o.neg_rotation_pi_div_two,
            o.oangle_rotation_self_right hx] },
      { exact or.inr (or.inl (zero_smul _ _)) },
      { refine or.inr (or.inr (or.inl _)),
        rw [o.oangle_smul_right_of_pos _ _ hr, o.oangle_rotation_self_right hx] } } }
end

end orientation


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Manuel Candales
-/
import geometry.euclidean.angle.oriented.affine
import geometry.euclidean.angle.unoriented.affine
import tactic.interval_cases

/-!
# Triangles

This file proves basic geometrical results about distances and angles
in (possibly degenerate) triangles in real inner product spaces and
Euclidean affine spaces.  More specialized results, and results
developed for simplices in general rather than just for triangles, are
in separate files.  Definitions and results that make sense in more
general affine spaces rather than just in the Euclidean case go under
`linear_algebra.affine_space`.

## Implementation notes

Results in this file are generally given in a form with only those
non-degeneracy conditions needed for the particular result, rather
than requiring affine independence of the points of a triangle
unnecessarily.

## References

* https://en.wikipedia.org/wiki/Law_of_cosines
* https://en.wikipedia.org/wiki/Pons_asinorum
* https://en.wikipedia.org/wiki/Sum_of_angles_of_a_triangle

-/

noncomputable theory
open_locale big_operators
open_locale classical
open_locale real
open_locale real_inner_product_space

namespace inner_product_geometry

/-!
### Geometrical results on triangles in real inner product spaces

This section develops some results on (possibly degenerate) triangles
in real inner product spaces, where those definitions and results can
most conveniently be developed in terms of vectors and then used to
deduce corresponding results for Euclidean affine spaces.
-/

variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V]

/-- Law of cosines (cosine rule), vector angle form. -/
lemma norm_sub_sq_eq_norm_sq_add_norm_sq_sub_two_mul_norm_mul_norm_mul_cos_angle
    (x y : V) :
  ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ - 2 * ‖x‖ * ‖y‖ * real.cos (angle x y) :=
by rw [(show 2 * ‖x‖ * ‖y‖ * real.cos (angle x y) =
             2 * (real.cos (angle x y) * (‖x‖ * ‖y‖)), by ring),
       cos_angle_mul_norm_mul_norm, ←real_inner_self_eq_norm_mul_norm,
       ←real_inner_self_eq_norm_mul_norm, ←real_inner_self_eq_norm_mul_norm,
       real_inner_sub_sub_self, sub_add_eq_add_sub]

/-- Pons asinorum, vector angle form. -/
lemma angle_sub_eq_angle_sub_rev_of_norm_eq {x y : V} (h : ‖x‖ = ‖y‖) :
  angle x (x - y) = angle y (y - x) :=
begin
  refine real.inj_on_cos ⟨angle_nonneg _ _, angle_le_pi _ _⟩ ⟨angle_nonneg _ _, angle_le_pi _ _⟩ _,
  rw [cos_angle, cos_angle, h, ←neg_sub, norm_neg, neg_sub,
    inner_sub_right, inner_sub_right, real_inner_self_eq_norm_mul_norm,
    real_inner_self_eq_norm_mul_norm, h, real_inner_comm x y]
end

/-- Converse of pons asinorum, vector angle form. -/
lemma norm_eq_of_angle_sub_eq_angle_sub_rev_of_angle_ne_pi {x y : V}
    (h : angle x (x - y) = angle y (y - x)) (hpi : angle x y ≠ π) : ‖x‖ = ‖y‖ :=
begin
  replace h := real.arccos_inj_on
    (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x (x - y)))
    (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one y (y - x))) h,
  by_cases hxy : x = y,
  { rw hxy },
  { rw [←norm_neg (y - x), neg_sub, mul_comm, mul_comm ‖y‖, div_eq_mul_inv, div_eq_mul_inv,
        mul_inv_rev, mul_inv_rev, ←mul_assoc, ←mul_assoc] at h,
    replace h :=
      mul_right_cancel₀ (inv_ne_zero (λ hz, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 hz)))) h,
    rw [inner_sub_right, inner_sub_right, real_inner_comm x y, real_inner_self_eq_norm_mul_norm,
        real_inner_self_eq_norm_mul_norm, mul_sub_right_distrib, mul_sub_right_distrib,
        mul_self_mul_inv, mul_self_mul_inv, sub_eq_sub_iff_sub_eq_sub,
        ←mul_sub_left_distrib] at h,
    by_cases hx0 : x = 0,
    { rw [hx0, norm_zero, inner_zero_left, zero_mul, zero_sub, neg_eq_zero] at h,
      rw [hx0, norm_zero, h] },
    { by_cases hy0 : y = 0,
      { rw [hy0, norm_zero, inner_zero_right, zero_mul, sub_zero] at h,
        rw [hy0, norm_zero, h] },
      { rw [inv_sub_inv (λ hz, hx0 (norm_eq_zero.1 hz)) (λ hz, hy0 (norm_eq_zero.1 hz)),
            ←neg_sub, ←mul_div_assoc, mul_comm, mul_div_assoc, ←mul_neg_one] at h,
        symmetry,
        by_contradiction hyx,
        replace h := (mul_left_cancel₀ (sub_ne_zero_of_ne hyx) h).symm,
        rw [real_inner_div_norm_mul_norm_eq_neg_one_iff, ←angle_eq_pi_iff] at h,
        exact hpi h } } }
end

/-- The cosine of the sum of two angles in a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
lemma cos_angle_sub_add_angle_sub_rev_eq_neg_cos_angle {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  real.cos (angle x (x - y) + angle y (y - x)) = -real.cos (angle x y) :=
begin
  by_cases hxy : x = y,
  { rw [hxy, angle_self hy],
    simp },
  { rw [real.cos_add, cos_angle, cos_angle, cos_angle],
    have hxn : ‖x‖ ≠ 0 := (λ h, hx (norm_eq_zero.1 h)),
    have hyn : ‖y‖ ≠ 0 := (λ h, hy (norm_eq_zero.1 h)),
    have hxyn : ‖x - y‖ ≠ 0 := (λ h, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 h))),
    apply mul_right_cancel₀ hxn,
    apply mul_right_cancel₀ hyn,
    apply mul_right_cancel₀ hxyn,
    apply mul_right_cancel₀ hxyn,
    have H1 : real.sin (angle x (x - y)) * real.sin (angle y (y - x)) *
                ‖x‖ * ‖y‖ * ‖x - y‖ * ‖x - y‖ =
              (real.sin (angle x (x - y)) * (‖x‖ * ‖x - y‖)) *
                (real.sin (angle y (y - x)) * (‖y‖ * ‖x - y‖)), { ring },
    have H2 : ⟪x, x⟫ * (⟪x, x⟫ - ⟪x, y⟫ - (⟪x, y⟫ - ⟪y, y⟫)) -
                (⟪x, x⟫ - ⟪x, y⟫) * (⟪x, x⟫ - ⟪x, y⟫) =
              ⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫ * ⟪x, y⟫, { ring },
    have H3 : ⟪y, y⟫ * (⟪y, y⟫ - ⟪x, y⟫ - (⟪x, y⟫ - ⟪x, x⟫)) -
                (⟪y, y⟫ - ⟪x, y⟫) * (⟪y, y⟫ - ⟪x, y⟫) =
              ⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫ * ⟪x, y⟫, { ring },
    rw [mul_sub_right_distrib, mul_sub_right_distrib, mul_sub_right_distrib,
        mul_sub_right_distrib, H1, sin_angle_mul_norm_mul_norm, norm_sub_rev x y,
        sin_angle_mul_norm_mul_norm, norm_sub_rev y x, inner_sub_left, inner_sub_left,
        inner_sub_right, inner_sub_right, inner_sub_right, inner_sub_right, real_inner_comm x y, H2,
        H3, real.mul_self_sqrt (sub_nonneg_of_le (real_inner_mul_inner_self_le x y)),
        real_inner_self_eq_norm_mul_norm, real_inner_self_eq_norm_mul_norm,
        real_inner_eq_norm_mul_self_add_norm_mul_self_sub_norm_sub_mul_self_div_two],
    field_simp [hxn, hyn, hxyn],
    ring }
end

/-- The sine of the sum of two angles in a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
lemma sin_angle_sub_add_angle_sub_rev_eq_sin_angle {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  real.sin (angle x (x - y) + angle y (y - x)) = real.sin (angle x y) :=
begin
  by_cases hxy : x = y,
  { rw [hxy, angle_self hy],
    simp },
  { rw [real.sin_add, cos_angle, cos_angle],
    have hxn : ‖x‖ ≠ 0 := (λ h, hx (norm_eq_zero.1 h)),
    have hyn : ‖y‖ ≠ 0 := (λ h, hy (norm_eq_zero.1 h)),
    have hxyn : ‖x - y‖ ≠ 0 := (λ h, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 h))),
    apply mul_right_cancel₀ hxn,
    apply mul_right_cancel₀ hyn,
    apply mul_right_cancel₀ hxyn,
    apply mul_right_cancel₀ hxyn,
    have H1 : real.sin (angle x (x - y)) * (⟪y, y - x⟫ / (‖y‖ * ‖y - x‖)) * ‖x‖ * ‖y‖ * ‖x - y‖ =
                real.sin (angle x (x - y)) * (‖x‖ * ‖x - y‖) *
                  (⟪y, y - x⟫ / (‖y‖ * ‖y - x‖)) * ‖y‖, { ring },
    have H2 : ⟪x, x - y⟫ / (‖x‖ * ‖y - x‖) * real.sin (angle y (y - x)) * ‖x‖ * ‖y‖ * ‖y - x‖ =
                ⟪x, x - y⟫ / (‖x‖ * ‖y - x‖) *
                  (real.sin (angle y (y - x)) * (‖y‖ * ‖y - x‖)) * ‖x‖, { ring },
    have H3 : ⟪x, x⟫ * (⟪x, x⟫ - ⟪x, y⟫ - (⟪x, y⟫ - ⟪y, y⟫)) -
                (⟪x, x⟫ - ⟪x, y⟫) * (⟪x, x⟫ - ⟪x, y⟫) =
              ⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫ * ⟪x, y⟫, { ring },
    have H4 : ⟪y, y⟫ * (⟪y, y⟫ - ⟪x, y⟫ - (⟪x, y⟫ - ⟪x, x⟫)) -
                (⟪y, y⟫ - ⟪x, y⟫) * (⟪y, y⟫ - ⟪x, y⟫) =
              ⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫  * ⟪x, y⟫, { ring },
    rw [right_distrib, right_distrib, right_distrib, right_distrib, H1,
        sin_angle_mul_norm_mul_norm, norm_sub_rev x y, H2, sin_angle_mul_norm_mul_norm,
        norm_sub_rev y x, mul_assoc (real.sin (angle x y)), sin_angle_mul_norm_mul_norm,
        inner_sub_left, inner_sub_left, inner_sub_right, inner_sub_right, inner_sub_right,
        inner_sub_right, real_inner_comm x y, H3, H4, real_inner_self_eq_norm_mul_norm,
        real_inner_self_eq_norm_mul_norm,
        real_inner_eq_norm_mul_self_add_norm_mul_self_sub_norm_sub_mul_self_div_two],
    field_simp [hxn, hyn, hxyn],
    ring }
end

/-- The cosine of the sum of the angles of a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
lemma cos_angle_add_angle_sub_add_angle_sub_eq_neg_one {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  real.cos (angle x y + angle x (x - y) + angle y (y - x)) = -1 :=
by rw [add_assoc, real.cos_add, cos_angle_sub_add_angle_sub_rev_eq_neg_cos_angle hx hy,
       sin_angle_sub_add_angle_sub_rev_eq_sin_angle hx hy, mul_neg, ←neg_add',
       add_comm, ←sq, ←sq, real.sin_sq_add_cos_sq]

/-- The sine of the sum of the angles of a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
lemma sin_angle_add_angle_sub_add_angle_sub_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  real.sin (angle x y + angle x (x - y) + angle y (y - x)) = 0 :=
begin
  rw [add_assoc, real.sin_add, cos_angle_sub_add_angle_sub_rev_eq_neg_cos_angle hx hy,
      sin_angle_sub_add_angle_sub_rev_eq_sin_angle hx hy],
  ring
end

/-- The sum of the angles of a possibly degenerate triangle (where the
two given sides are nonzero), vector angle form. -/
lemma angle_add_angle_sub_add_angle_sub_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  angle x y + angle x (x - y) + angle y (y - x) = π :=
begin
  have hcos := cos_angle_add_angle_sub_add_angle_sub_eq_neg_one hx hy,
  have hsin := sin_angle_add_angle_sub_add_angle_sub_eq_zero hx hy,
  rw real.sin_eq_zero_iff at hsin,
  cases hsin with n hn,
  symmetry' at hn,
  have h0 : 0 ≤ angle x y + angle x (x - y) + angle y (y - x) :=
    add_nonneg (add_nonneg (angle_nonneg _ _) (angle_nonneg _ _)) (angle_nonneg _ _),
  have h3 : angle x y + angle x (x - y) + angle y (y - x) ≤ π + π + π :=
    add_le_add (add_le_add (angle_le_pi _ _) (angle_le_pi _ _)) (angle_le_pi _ _),
  have h3lt : angle x y + angle x (x - y) + angle y (y - x) < π + π + π,
  { by_contradiction hnlt,
    have hxy : angle x y = π,
    { by_contradiction hxy,
      exact hnlt (add_lt_add_of_lt_of_le (add_lt_add_of_lt_of_le
                                           (lt_of_le_of_ne (angle_le_pi _ _) hxy)
                                         (angle_le_pi _ _)) (angle_le_pi _ _)) },
    rw hxy at hnlt,
    rw angle_eq_pi_iff at hxy,
    rcases hxy with ⟨hx, ⟨r, ⟨hr, hxr⟩⟩⟩,
    rw [hxr, ←one_smul ℝ x, ←mul_smul, mul_one, ←sub_smul, one_smul, sub_eq_add_neg,
        angle_smul_right_of_pos _ _ (add_pos zero_lt_one (neg_pos_of_neg hr)), angle_self hx,
        add_zero] at hnlt,
    apply hnlt,
    rw add_assoc,
    exact add_lt_add_left (lt_of_le_of_lt (angle_le_pi _ _)
                                          (lt_add_of_pos_right π real.pi_pos)) _ },
  have hn0 : 0 ≤ n,
  { rw [hn, mul_nonneg_iff_left_nonneg_of_pos real.pi_pos] at h0,
    norm_cast at h0,
    exact h0 },
  have hn3 : n < 3,
  { rw [hn, (show π + π + π = 3 * π, by ring)] at h3lt,
    replace h3lt := lt_of_mul_lt_mul_right h3lt (le_of_lt real.pi_pos),
    norm_cast at h3lt,
    exact h3lt },
  interval_cases n,
  { rw hn at hcos,
    simp at hcos,
    norm_num at hcos },
  { rw hn,
    norm_num },
  { rw hn at hcos,
    simp at hcos,
    norm_num at hcos },
end

end inner_product_geometry

namespace euclidean_geometry
/-!
### Geometrical results on triangles in Euclidean affine spaces

This section develops some geometrical definitions and results on
(possible degenerate) triangles in Euclidean affine spaces.
-/
open inner_product_geometry

open_locale euclidean_geometry

variables {V : Type*} {P : Type*}
  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
include V

/-- **Law of cosines** (cosine rule), angle-at-point form. -/
lemma dist_sq_eq_dist_sq_add_dist_sq_sub_two_mul_dist_mul_dist_mul_cos_angle
    (p1 p2 p3 : P) :
  dist p1 p3 * dist p1 p3 =
    dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 -
      2 * dist p1 p2 * dist p3 p2 * real.cos (∠ p1 p2 p3) :=
begin
  rw [dist_eq_norm_vsub V p1 p3, dist_eq_norm_vsub V p1 p2, dist_eq_norm_vsub V p3 p2],
  unfold angle,
  convert norm_sub_sq_eq_norm_sq_add_norm_sq_sub_two_mul_norm_mul_norm_mul_cos_angle
          (p1 -ᵥ p2 : V) (p3 -ᵥ p2 : V),
  { exact (vsub_sub_vsub_cancel_right p1 p3 p2).symm },
  { exact (vsub_sub_vsub_cancel_right p1 p3 p2).symm }
end

alias dist_sq_eq_dist_sq_add_dist_sq_sub_two_mul_dist_mul_dist_mul_cos_angle ← law_cos

/-- **Isosceles Triangle Theorem**: Pons asinorum, angle-at-point form. -/
lemma angle_eq_angle_of_dist_eq {p1 p2 p3 : P} (h : dist p1 p2 = dist p1 p3) :
  ∠ p1 p2 p3 = ∠ p1 p3 p2 :=
begin
  rw [dist_eq_norm_vsub V p1 p2, dist_eq_norm_vsub V p1 p3] at h,
  unfold angle,
  convert angle_sub_eq_angle_sub_rev_of_norm_eq h,
  { exact (vsub_sub_vsub_cancel_left p3 p2 p1).symm },
  { exact (vsub_sub_vsub_cancel_left p2 p3 p1).symm }
end

/-- Converse of pons asinorum, angle-at-point form. -/
lemma dist_eq_of_angle_eq_angle_of_angle_ne_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = ∠ p1 p3 p2)
    (hpi : ∠ p2 p1 p3 ≠ π) : dist p1 p2 = dist p1 p3 :=
begin
  unfold angle at h hpi,
  rw [dist_eq_norm_vsub V p1 p2, dist_eq_norm_vsub V p1 p3],
  rw [←angle_neg_neg, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] at hpi,
  rw [←vsub_sub_vsub_cancel_left p3 p2 p1, ←vsub_sub_vsub_cancel_left p2 p3 p1] at h,
  exact norm_eq_of_angle_sub_eq_angle_sub_rev_of_angle_ne_pi h hpi
end

/-- The **sum of the angles of a triangle** (possibly degenerate, where the
given vertex is distinct from the others), angle-at-point. -/
lemma angle_add_angle_add_angle_eq_pi {p1 p2 p3 : P} (h2 : p2 ≠ p1) (h3 : p3 ≠ p1) :
  ∠ p1 p2 p3 + ∠ p2 p3 p1 + ∠ p3 p1 p2 = π :=
begin
  rw [add_assoc, add_comm, add_comm (∠ p2 p3 p1), angle_comm p2 p3 p1],
  unfold angle,
  rw [←angle_neg_neg (p1 -ᵥ p3), ←angle_neg_neg (p1 -ᵥ p2), neg_vsub_eq_vsub_rev,
      neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev,
      ←vsub_sub_vsub_cancel_right p3 p2 p1, ←vsub_sub_vsub_cancel_right p2 p3 p1],
  exact angle_add_angle_sub_add_angle_sub_eq_pi (λ he, h3 (vsub_eq_zero_iff_eq.1 he))
                                                (λ he, h2 (vsub_eq_zero_iff_eq.1 he))
end

/-- The **sum of the angles of a triangle** (possibly degenerate, where the triangle is a line),
oriented angles at point. -/
lemma oangle_add_oangle_add_oangle_eq_pi
  [module.oriented ℝ V (fin 2)] [fact (finite_dimensional.finrank ℝ V = 2)] {p1 p2 p3 : P}
  (h21 : p2 ≠ p1) (h32 : p3 ≠ p2) (h13 : p1 ≠ p3) : ∡ p1 p2 p3 + ∡ p2 p3 p1 + ∡ p3 p1 p2 = π :=
by simpa only [neg_vsub_eq_vsub_rev] using
    positive_orientation.oangle_add_cyc3_neg_left
      (vsub_ne_zero.mpr h21) (vsub_ne_zero.mpr h32) (vsub_ne_zero.mpr h13)

/-- **Stewart's Theorem**. -/
theorem dist_sq_mul_dist_add_dist_sq_mul_dist (a b c p : P) (h : ∠ b p c = π) :
  dist a b ^ 2 * dist c p + dist a c ^ 2 * dist b p =
  dist b c * (dist a p ^ 2 + dist b p * dist c p) :=
begin
  rw [pow_two, pow_two, law_cos a p b, law_cos a p c,
      eq_sub_of_add_eq (angle_add_angle_eq_pi_of_angle_eq_pi a h), real.cos_pi_sub,
      dist_eq_add_dist_of_angle_eq_pi h],
  ring,
end

/-- **Apollonius's Theorem**. -/
theorem dist_sq_add_dist_sq_eq_two_mul_dist_midpoint_sq_add_half_dist_sq (a b c : P) :
  dist a b ^ 2 + dist a c ^ 2 = 2 * (dist a (midpoint ℝ b c) ^ 2 + (dist b c / 2) ^ 2) :=
begin
  by_cases hbc : b = c,
  { simp [hbc, midpoint_self, dist_self, two_mul] },
  { let m := midpoint ℝ b c,
    have : dist b c ≠ 0 := (dist_pos.mpr hbc).ne',
    have hm := dist_sq_mul_dist_add_dist_sq_mul_dist a b c m (angle_midpoint_eq_pi b c hbc),
    simp only [dist_left_midpoint, dist_right_midpoint, real.norm_two] at hm,
    calc  dist a b ^ 2 + dist a c ^ 2
        = 2 / dist b c * (dist a b ^ 2 * (2⁻¹ * dist b c) + dist a c ^ 2 * (2⁻¹ * dist b c)) :
          by { field_simp, ring }
    ... = 2 * (dist a (midpoint ℝ b c) ^ 2 + (dist b c / 2) ^ 2) :
          by { rw hm, field_simp, ring } },
end

lemma dist_mul_of_eq_angle_of_dist_mul (a b c a' b' c' : P) (r : ℝ) (h : ∠ a' b' c' = ∠ a b c)
  (hab : dist a' b' = r * dist a b) (hcb : dist c' b' = r * dist c b) :
  dist a' c' = r * dist a c :=
begin
  have h' : dist a' c' ^ 2 = (r * dist a c) ^ 2,
    calc  dist a' c' ^ 2
        = dist a' b' ^ 2 + dist c' b' ^ 2 - 2 * dist a' b' * dist c' b' * real.cos (∠ a' b' c') :
          by { simp [pow_two, law_cos a' b' c'] }
    ... = r ^ 2 * (dist a b ^ 2 + dist c b ^ 2 - 2 * dist a b * dist c b * real.cos (∠ a b c)) :
          by { rw [h, hab, hcb], ring }
    ... = (r * dist a c) ^ 2 : by simp [pow_two, ← law_cos a b c, mul_pow],
  by_cases hab₁ : a = b,
  { have hab'₁ : a' = b', { rw [← dist_eq_zero, hab, dist_eq_zero.mpr hab₁, mul_zero r] },
    rw [hab₁, hab'₁, dist_comm b' c', dist_comm b c, hcb] },
  { have h1 : 0 ≤ r * dist a b, { rw ← hab, exact dist_nonneg },
    have h2 : 0 ≤ r := nonneg_of_mul_nonneg_left h1 (dist_pos.mpr hab₁),
    exact (sq_eq_sq dist_nonneg (mul_nonneg h2 dist_nonneg)).mp h' },
end

end euclidean_geometry


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

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers
import solutions.section02reals.sheet3 -- import the definition of `tendsto` from a previous sheet

-- you can maybe do this one now
theorem tendsto_neg {a : ℕ → ℝ} {t : ℝ} (ha : tendsto a t) :
  tendsto (λ n, - a n) (-t) :=
begin
  rw tendsto at *,
  have q: ∀n, |a n -  t|=| -a n- -t|,
  {intro,rw abs_sub_comm,ring_nf,congr' 1,ring,},
  simpa [q] using ha,
end

/-
`tendsto_add` is quite a challenge. In a few weeks' time I'll
show you a two-line proof using filters, but right now
as you're still learning I think it's important that you
try and suffer and struggle through the first principles proof.
BIG piece of advice: write down a complete maths proof first,
with all the details there. Then, once you know the maths
proof, try translating it into Lean. Note that a bunch
of the results we proved in sheet 4 will be helpful.
-/

/-- If `a(n)` tends to `t` and `b(n)` tends to `u` then `a(n) + b(n)`
tends to `t + u`. -/
theorem tendsto_add {a b : ℕ → ℝ} {t u : ℝ}
  (ha : tendsto a t) (hb : tendsto b u) :
  tendsto (λ n, a n + b n) (t + u) :=
begin
  rw tendsto at *,intros ε ε1,specialize ha (ε/2) (by linarith),specialize hb  (ε/2) (by linarith),
  cases ha with Ba a,
  cases hb with Bb b,use max Ba Bb,
  intros n m, rw max_le_iff at m,cases m,specialize a n m_left,specialize b n m_right,
  rw abs_lt at *,
  split;
  linarith,
end
/-- If `a(n)` tends to t and `b(n)` tends to `u` then `a(n) - b(n)`
tends to `t - u`. -/
theorem tendsto_sub {a b : ℕ → ℝ} {t u : ℝ}
  (ha : tendsto a t) (hb : tendsto b u) :
  tendsto (λ n, a n - b n) (t - u) :=
begin
  simpa [sub_eq_add_neg] using tendsto_add ha (tendsto_neg hb),
end


/- ** Propositions and truth judgments ** -/

/-
A proposition is a mathematically precise assertion that
some state of affairs is true in some domain of interest.

For example, in the domain of basic arithmetic, the claim
that 0 = 0 is a proposition. So is the claim that 0 = 1.

As another example, in the domain of some family unit, a
perfectly good proposition is that "Mary is the mother of
Bob." It might or might not be true in a given family,
but it's a perfectly good proposition: a claim that a
certain state of affairs holds in that domain.

Logic, then, is about making propositions precise and
above precise rules for ascertaining when any given
proposition can be judged to be true.

Clearly we would judge the proposition, 0 = 0, to be
true, in the domain of arithmetic. Similarly, we would
not judge the proposition 0 = 1 to be true.

Logicians will sometimes write "0 = 0 : true" as a
way to assert that the proposition, 0 = 0, is (has
been judged to be) true. We call this a truth
judgment. More generally, if P is a proposition,
then "P : true" denotes the judgment that P is true.

EXERCISE: Write a truth judgment (just type it
in as part of this comment) for the proposition
that "Mary is the mother of Bob."

Another example of a proposition is the claim that
zero does not equal one, which we would write like
this: ¬ (0 = 1). You could pronounce this as "it is
NOT the case that 0 = 1." We would naturally judge
this proposition to be true (albeit currently just
based on our intuition, not on any specific rules).

EXERCISE: Write a truth judgment here (just type it
in as part of this comment) that expresses the
judgement that ¬ (0 = 1) is true.

Propositions, then, are claims that certain states
of affairs hold, and logic provides us with rules
for determining when a given proposition is (can be
judged to be) true.

Propositions are basically declarative statements,
asserting that "such and such" is true. What makes
them, and logic, formal is that they have a precise
syntax, or form, and a precise semantics, or meaning.
-/

/- * syntax * -/

/-
Just as with computer programs, there are strict
rules that define the forms that propositions can
take, i.e., their syntax. For example, 0 = 0 is a
syntactically well-formed proposition, but 00= is
not.
-/

/- * semantics *-/

/-
Moreover, propositions in a given logic also have
meanings, in that they can be judged to be true,
or not, in a given domain. For example "Mary is
the mom of Bob" (perhaps written more formally as
mother_of(Mary,Bob) is a proposition that can be
judged to be true in some domains (family units)
and not true in others. It's true in a domain in
which Mary really is the mother of Bob, and it is
not true otherwise.

A proposition cannot generally be judged to be
true or false on its own. Rather, it is judged
in some domain: under an *interpretation* that
explains what each symbol in the proposition is
meant  to refer to.

For example, we could judge "Mary is the mother
of Bob" to be true if and only if "Mary" refers
to some person, "Bob" refers to another person,
and under some definition of what it means to
be the mother of, that the person referred to
as Mary really is the mother of that person
referred to as Bob.

When we talk about the semantics of a logic, we
are talking about rules for determining when some
given proposition can be judged to be true with
respect to some particular interpretation that
"maps" the symbols in the proposition to things
in the domain of discourse.

The rules for determining whether a proposition
in a particular logic is true in a given such a
domain and interpretation is, again, called the
semantics of that logic.

Logics thus provide rules that define the syntax
and the semantics of propositions: their forms,
and their meanings (that is, whether they are,
i.e., can be judged to be, true or not) under
any given interpretation.

We'll dive deeper into the syntax and semantics
of various logics as we go along. In particular,
we will discuss a simple logic, propositional
logic, and a much more useful logic, the logic
of everyday mathematics and computer science,
called predicate logic.

For purposes of this unit, we'll just assume
that one particular form of valid proposition
in predicate logic is a proposition that the
values of two terms are equal. For example,
0 = 0, 1 + 1 = 2, and 1 + 1 = 3 are valid
(syntactically well formed) propositions in
the predicate logic of everyday mathematics
and computer science.

In the next section, we'll meet an inference
rules that from proofs of two propositions,
such as 0 = 0 and 1 = 1, will allow us to
derive proofs of their conjunctions, e.g.,
of the proposition that 0 = 0 AND 1 = 1.

In everyday logical notation, we write this
as 0 = 0 ∧ 1 = 1. The ∧ symbol, which is
pronounced "and", is the first so-called
logical connective that we will meet. The
logical connectives allow us to build bigger
propositions out of smaller onces, and to
to with each such connective we will have
inference rules giving us ways to prove
such bigger propositions and to derive
proofs of other propositions from such
proofs.
-/


-- Pruebas_de_length(xs_++_ys)_Ig_length_xs+length_ys.lean
-- Pruebas de length(xs ++ ys) = length(xs) + length(ys)
-- José A. Alonso Jiménez
-- Sevilla, 9 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean están definidas las funciones
--    length : list α → nat
--    (++)   : list α → list α → list α
-- tales que
-- + (length xs) es la longitud de xs. Por ejemplo,
--      length [2,3,5,3] = 4
-- + (xs ++ ys) es la lista obtenida concatenando xs e ys. Por ejemplo.
--      [1,2] ++ [2,3,5,3] = [1,2,2,3,5,3]
-- Dichas funciones están caracterizadas por los siguientes lemas:
--    length_nil  : length [] = 0
--    length_cons : length (x :: xs) = length xs + 1
--    nil_append  : [] ++ ys = ys
--    cons_append : (x :: xs) ++ y = x :: (xs ++ ys)
--
-- Demostrar que
--    length (xs ++ ys) = length xs + length ys
-- ---------------------------------------------------------------------

import tactic
open list

variable  {α : Type}
variable  (x : α)
variables (xs ys zs : list α)

lemma length_nil  : length ([] : list α) = 0 := rfl

-- 1ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { rw nil_append,
    rw length_nil,
    rw zero_add, },
  { rw cons_append,
    rw length_cons,
    rw HI,
    rw length_cons,
    rw add_assoc,
    rw add_comm (length ys),
    rw add_assoc, },
end

-- 2ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { rw nil_append,
    rw length_nil,
    rw zero_add, },
  { rw cons_append,
    rw length_cons,
    rw HI,
    rw length_cons,
    -- library_search,
    exact add_right_comm (length as) (length ys) 1 },
end

-- 3ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { rw nil_append,
    rw length_nil,
    rw zero_add, },
  { rw cons_append,
    rw length_cons,
    rw HI,
    rw length_cons,
    -- by hint,
    linarith, },
end

-- 4ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { simp, },
  { simp [HI],
    linarith, },
end

-- 5ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { simp, },
  { finish [HI],},
end

-- 6ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
by induction xs ; finish [*]

-- 7ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { calc length ([] ++ ys)
         = length ys                    : congr_arg length (nil_append ys)
     ... = 0 + length ys                : (zero_add (length ys)).symm
     ... = length [] + length ys        : congr_arg2 (+) length_nil.symm rfl, },
  { calc length ((a :: as) ++ ys)
         = length (a :: (as ++ ys))     : congr_arg length (cons_append a as ys)
     ... = length (as ++ ys) + 1        : length_cons a (as ++ ys)
     ... = (length as + length ys) + 1  : congr_arg2 (+) HI rfl
     ... = (length as + 1) + length ys  : add_right_comm (length as) (length ys) 1
     ... = length (a :: as) + length ys : congr_arg2 (+) (length_cons a as).symm rfl, },
end

-- 8ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { calc length ([] ++ ys)
         = length ys                    : by rw nil_append
     ... = 0 + length ys                : (zero_add (length ys)).symm
     ... = length [] + length ys        : by rw length_nil },
  { calc length ((a :: as) ++ ys)
         = length (a :: (as ++ ys))     : by rw cons_append
     ... = length (as ++ ys) + 1        : by rw length_cons
     ... = (length as + length ys) + 1  : by rw HI
     ... = (length as + 1) + length ys  : add_right_comm (length as) (length ys) 1
     ... = length (a :: as) + length ys : by rw length_cons, },
end

-- 9ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
list.rec_on xs
  ( show length ([] ++ ys) = length [] + length ys, from
      calc length ([] ++ ys)
           = length ys                    : by rw nil_append
       ... = 0 + length ys                : (zero_add (length ys)).symm
       ... = length [] + length ys        : by rw length_nil )
  ( assume a as,
    assume HI : length (as ++ ys) = length as + length ys,
    show length ((a :: as) ++ ys) = length (a :: as) + length ys, from
      calc length ((a :: as) ++ ys)
           = length (a :: (as ++ ys))     : by rw cons_append
       ... = length (as ++ ys) + 1        : by rw length_cons
       ... = (length as + length ys) + 1  : by rw HI
       ... = (length as + 1) + length ys  : add_right_comm (length as) (length ys) 1
       ... = length (a :: as) + length ys : by rw length_cons)

-- 10ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
list.rec_on xs
  ( by simp)
  ( λ a as HI, by simp [HI, add_right_comm])

-- 11ª demostración
lemma longitud_conc_1 :
  ∀ xs, length (xs ++ ys) = length xs + length ys
| [] := by calc
    length ([] ++ ys)
        = length ys                    : by rw nil_append
    ... = 0 + length ys                : by rw zero_add
    ... = length [] + length ys        : by rw length_nil
| (a :: as) := by calc
    length ((a :: as) ++ ys)
        = length (a :: (as ++ ys))     : by rw cons_append
    ... = length (as ++ ys) + 1        : by rw length_cons
    ... = (length as + length ys) + 1  : by rw longitud_conc_1
    ... = (length as + 1) + length ys  : add_right_comm (length as) (length ys) 1
    ... = length (a :: as) + length ys : by rw length_cons

-- 12ª demostración
lemma longitud_conc_2 :
  ∀ xs, length (xs ++ ys) = length xs + length ys
| []        := by simp
| (a :: as) := by simp [longitud_conc_2 as, add_right_comm]

-- 13ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
-- by library_search
length_append xs ys

-- 14ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
by simp


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Yury Kudryashov, Yaël Dillies
-/
import order.order_dual

/-!
# Minimal/maximal and bottom/top elements

This file defines predicates for elements to be minimal/maximal or bottom/top and typeclasses
saying that there are no such elements.

## Predicates

* `is_bot`: An element is *bottom* if all elements are greater than it.
* `is_top`: An element is *top* if all elements are less than it.
* `is_min`: An element is *minimal* if no element is strictly less than it.
* `is_max`: An element is *maximal* if no element is strictly greater than it.

See also `is_bot_iff_is_min` and `is_top_iff_is_max` for the equivalences in a (co)directed order.

## Typeclasses

* `no_bot_order`: An order without bottom elements.
* `no_top_order`: An order without top elements.
* `no_min_order`: An order without minimal elements.
* `no_max_order`: An order without maximal elements.
-/

open order_dual

variables {α : Type*}

/-- Order without bottom elements. -/
class no_bot_order (α : Type*) [has_le α] : Prop :=
(exists_not_ge (a : α) : ∃ b, ¬ a ≤ b)

/-- Order without top elements. -/
class no_top_order (α : Type*) [has_le α] : Prop :=
(exists_not_le (a : α) : ∃ b, ¬ b ≤ a)

/-- Order without minimal elements. Sometimes called coinitial or dense. -/
class no_min_order (α : Type*) [has_lt α] : Prop :=
(exists_lt (a : α) : ∃ b, b < a)

/-- Order without maximal elements. Sometimes called cofinal. -/
class no_max_order (α : Type*) [has_lt α] : Prop :=
(exists_gt (a : α) : ∃ b, a < b)

export no_bot_order (exists_not_ge)
export no_top_order (exists_not_le)
export no_min_order (exists_lt)
export no_max_order (exists_gt)

instance nonempty_lt [has_lt α] [no_min_order α] (a : α) : nonempty {x // x < a} :=
nonempty_subtype.2 (exists_lt a)

instance nonempty_gt [has_lt α] [no_max_order α] (a : α) : nonempty {x // a < x} :=
nonempty_subtype.2 (exists_gt a)

instance order_dual.no_bot_order (α : Type*) [has_le α] [no_top_order α] :
  no_bot_order (order_dual α) :=
⟨λ a, @exists_not_le α _ _ a⟩

instance order_dual.no_top_order (α : Type*) [has_le α] [no_bot_order α] :
  no_top_order (order_dual α) :=
⟨λ a, @exists_not_ge α _ _ a⟩

instance order_dual.no_min_order (α : Type*) [has_lt α] [no_max_order α] :
  no_min_order (order_dual α) :=
⟨λ a, @exists_gt α _ _ a⟩

instance order_dual.no_max_order (α : Type*) [has_lt α] [no_min_order α] :
  no_max_order (order_dual α) :=
⟨λ a, @exists_lt α _ _ a⟩

@[priority 100] -- See note [lower instance priority]
instance no_min_order.to_no_bot_order (α : Type*) [preorder α] [no_min_order α] : no_bot_order α :=
⟨λ a, (exists_lt a).imp $ λ _, not_le_of_lt⟩

@[priority 100] -- See note [lower instance priority]
instance no_max_order.to_no_top_order (α : Type*) [preorder α] [no_max_order α] : no_top_order α :=
⟨λ a, (exists_gt a).imp $ λ _, not_le_of_lt⟩

section has_le
variables [has_le α] {a b : α}

/-- `a : α` is a bottom element of `α` if it is less than or equal to any other element of `α`.
This predicate is roughly an unbundled version of `order_bot`, except that a preorder may have
several bottom elements. When `α` is linear, this is useful to make a case disjunction on
`no_min_order α` within a proof. -/
def is_bot (a : α) : Prop := ∀ b, a ≤ b

/-- `a : α` is a top element of `α` if it is greater than or equal to any other element of `α`.
This predicate is roughly an unbundled version of `order_bot`, except that a preorder may have
several top elements. When `α` is linear, this is useful to make a case disjunction on
`no_max_order α` within a proof. -/
def is_top (a : α) : Prop := ∀ b, b ≤ a

/-- `a` is a minimal element of `α` if no element is strictly less than it. We spell it without `<`
to avoid having to convert between `≤` and `<`. Instead, `is_min_iff_forall_not_lt` does the
conversion. -/
def is_min (a : α) : Prop := ∀ ⦃b⦄, b ≤ a → a ≤ b

/-- `a` is a maximal element of `α` if no element is strictly greater than it. We spell it without
`<` to avoid having to convert between `≤` and `<`. Instead, `is_max_iff_forall_not_lt` does the
conversion. -/
def is_max (a : α) : Prop := ∀ ⦃b⦄, a ≤ b → b ≤ a

@[simp] lemma not_is_bot [no_bot_order α] (a : α) : ¬is_bot a :=
λ h, let ⟨b, hb⟩ := exists_not_ge a in hb $ h _

@[simp] lemma not_is_top [no_top_order α] (a : α) : ¬is_top a :=
λ h, let ⟨b, hb⟩ := exists_not_le a in hb $ h _

protected lemma is_bot.is_min (h : is_bot a) : is_min a := λ b _, h b
protected lemma is_top.is_max (h : is_top a) : is_max a := λ b _, h b

@[simp] lemma is_bot_to_dual_iff : is_bot (to_dual a) ↔ is_top a := iff.rfl
@[simp] lemma is_top_to_dual_iff : is_top (to_dual a) ↔ is_bot a := iff.rfl
@[simp] lemma is_min_to_dual_iff : is_min (to_dual a) ↔ is_max a := iff.rfl
@[simp] lemma is_max_to_dual_iff : is_max (to_dual a) ↔ is_min a := iff.rfl
@[simp] lemma is_bot_of_dual_iff {a : order_dual α} : is_bot (of_dual a) ↔ is_top a := iff.rfl
@[simp] lemma is_top_of_dual_iff {a : order_dual α} : is_top (of_dual a) ↔ is_bot a := iff.rfl
@[simp] lemma is_min_of_dual_iff {a : order_dual α} : is_min (of_dual a) ↔ is_max a := iff.rfl
@[simp] lemma is_max_of_dual_iff {a : order_dual α} : is_max (of_dual a) ↔ is_min a := iff.rfl

alias is_bot_to_dual_iff ↔ _ is_top.to_dual
alias is_top_to_dual_iff ↔ _ is_bot.to_dual
alias is_min_to_dual_iff ↔ _ is_max.to_dual
alias is_max_to_dual_iff ↔ _ is_min.to_dual
alias is_bot_of_dual_iff ↔ _ is_top.of_dual
alias is_top_of_dual_iff ↔ _ is_bot.of_dual
alias is_min_of_dual_iff ↔ _ is_max.of_dual
alias is_max_of_dual_iff ↔ _ is_min.of_dual

end has_le

section preorder
variables [preorder α] {a b : α}

lemma is_bot.mono (ha : is_bot a) (h : b ≤ a) : is_bot b := λ c, h.trans $ ha _
lemma is_top.mono (ha : is_top a) (h : a ≤ b) : is_top b := λ c, (ha _).trans h
lemma is_min.mono (ha : is_min a) (h : b ≤ a) : is_min b := λ c hc, h.trans $ ha $ hc.trans h
lemma is_max.mono (ha : is_max a) (h : a ≤ b) : is_max b := λ c hc, (ha $ h.trans hc).trans h

lemma is_min.not_lt (h : is_min a) : ¬ b < a := λ hb, hb.not_le $ h hb.le
lemma is_max.not_lt (h : is_max a) : ¬ a < b := λ hb, hb.not_le $ h hb.le

lemma is_min_iff_forall_not_lt : is_min a ↔ ∀ b, ¬ b < a :=
⟨λ h _, h.not_lt, λ h b hba, of_not_not $ λ hab, h _ $ hba.lt_of_not_le hab⟩

lemma is_max_iff_forall_not_lt : is_max a ↔ ∀ b, ¬ a < b :=
⟨λ h _, h.not_lt, λ h b hba, of_not_not $ λ hab, h _ $ hba.lt_of_not_le hab⟩

@[simp] lemma not_is_min_iff : ¬ is_min a ↔ ∃ b, b < a :=
by simp_rw [lt_iff_le_not_le, is_min, not_forall, exists_prop]

@[simp] lemma not_is_max_iff : ¬ is_max a ↔ ∃ b, a < b :=
by simp_rw [lt_iff_le_not_le, is_max, not_forall, exists_prop]

@[simp] lemma not_is_min [no_min_order α] (a : α) : ¬ is_min a := not_is_min_iff.2 $ exists_lt a
@[simp] lemma not_is_max [no_max_order α] (a : α) : ¬ is_max a := not_is_max_iff.2 $ exists_gt a

namespace subsingleton
variable [subsingleton α]

protected lemma is_bot (a : α) : is_bot a := λ _, (subsingleton.elim _ _).le
protected lemma is_top (a : α) : is_top a := λ _, (subsingleton.elim _ _).le
protected lemma is_min (a : α) : is_min a := (subsingleton.is_bot _).is_min
protected lemma is_max (a : α) : is_max a := (subsingleton.is_top _).is_max

end subsingleton
end preorder

section partial_order
variables [partial_order α] {a b : α}

protected lemma is_min.eq_of_le (ha : is_min a) (h : b ≤ a) : b = a := h.antisymm $ ha h
protected lemma is_min.eq_of_ge (ha : is_min a) (h : b ≤ a) : a = b := h.antisymm' $ ha h
protected lemma is_max.eq_of_le (ha : is_max a) (h : a ≤ b) : a = b := h.antisymm $ ha h
protected lemma is_max.eq_of_ge (ha : is_max a) (h : a ≤ b) : b = a := h.antisymm' $ ha h

end partial_order

section linear_order
variables [linear_order α]

--TODO: Delete in favor of the directed version
lemma is_top_or_exists_gt (a : α) : is_top a ∨ ∃ b, a < b :=
by simpa only [or_iff_not_imp_left, is_top, not_forall, not_le] using id

lemma is_bot_or_exists_lt (a : α) : is_bot a ∨ ∃ b, b < a := @is_top_or_exists_gt (order_dual α) _ a

end linear_order


theorem tst0 {p q : Prop } (h : p ∨ q) : q ∨ p :=
by {
  induction h;
  { apply Or.inr; assumption };
  { apply Or.inl; assumption }
}

theorem tst0' {p q : Prop } (h : p ∨ q) : q ∨ p := by
induction h
focus
  apply Or.inr
  assumption
focus
  apply Or.inl
  assumption

theorem tst1 {p q : Prop } (h : p ∨ q) : q ∨ p := by
induction h with
| inr h2 => exact Or.inl h2
| inl h1 => exact Or.inr h1

theorem tst6 {p q : Prop } (h : p ∨ q) : q ∨ p :=
by {
  cases h with
  | inr h2 => exact Or.inl h2
  | inl h1 => exact Or.inr h1
}

theorem tst7 {α : Type} (xs : List α) (h : (a : α) → (as : List α) → xs ≠ a :: as) : xs = [] :=
by {
  induction xs with
  | nil          => exact rfl
  | cons z zs ih => exact absurd rfl (h z zs)
}

theorem tst8 {α : Type} (xs : List α) (h : (a : α) → (as : List α) → xs ≠ a :: as) : xs = [] := by {
  induction xs;
  exact rfl;
  exact absurd rfl $ h _ _
}

theorem tst9 {α : Type} (xs : List α) (h : (a : α) → (as : List α) → xs ≠ a :: as) : xs = [] := by
  cases xs with
     | nil       => exact rfl
     | cons z zs => exact absurd rfl (h z zs)

theorem tst10 {p q : Prop } (h₁ : p ↔ q) (h₂ : p) : q := by
  induction h₁ with
  | intro h _ => exact h h₂

def Iff2 (m p q : Prop) := p ↔ q

theorem tst11 {p q r : Prop } (h₁ : Iff2 r p q) (h₂ : p) : q := by
  induction h₁ using Iff.rec with
  | intro h _ => exact h h₂

theorem tst12 {p q : Prop } (h₁ : p ∨ q) (h₂ : p ↔ q) (h₃ : p) : q := by
  fail_if_success induction h₁ using Iff.casesOn
  induction h₂ using Iff.casesOn with
  | intro h _ =>
    exact h h₃

inductive Tree
  | leaf₁
  | leaf₂
  | node : Tree → Tree → Tree

def Tree.isLeaf₁ : Tree → Bool
  | leaf₁ => true
  | _     => false

theorem tst13 (x : Tree) (h : x = Tree.leaf₁) : x.isLeaf₁ = true := by
  cases x with
  | leaf₁ => rfl
  | _     => injection h

theorem tst14 (x : Tree) (h : x = Tree.leaf₁) : x.isLeaf₁ = true := by
  induction x with
  | leaf₁ => rfl
  | _     => injection h

inductive Vec (α : Type) : Nat → Type
  | nil  : Vec α 0
  | cons : (a : α) → {n : Nat} → (as : Vec α n) → Vec α (n+1)

def getHeads {α β} {n} (xs : Vec α (n+1)) (ys : Vec β (n+1)) : α × β := by
  cases xs
  cases ys
  apply Prod.mk
  repeat
    trace_state
    assumption
  done

theorem ex1 (n m o : Nat) : n = m + 0 → m = o → m = o := by
  intro (h₁ : n = m) h₂
  rw [← h₁, ← h₂]
  assumption