/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import data.list.perm

/-!
# Sorting algorithms on lists

In this file we define `list.sorted r l` to be an alias for `pairwise r l`. This alias is preferred
in the case that `r` is a `<` or `≤`-like relation. Then we define two sorting algorithms:
`list.insertion_sort` and `list.merge_sort`, and prove their correctness.
-/

open list.perm

universe uu

namespace list

/-!
### The predicate `list.sorted`
-/

section sorted

variables {α : Type uu} {r : α → α → Prop} {a : α} {l : list α}

/-- `sorted r l` is the same as `pairwise r l`, preferred in the case that `r`
  is a `<` or `≤`-like relation (transitive and antisymmetric or asymmetric) -/
def sorted := @pairwise

instance decidable_sorted [decidable_rel r] (l : list α) : decidable (sorted r l) :=
list.decidable_pairwise _

@[simp] theorem sorted_nil : sorted r [] := pairwise.nil

lemma sorted.of_cons : sorted r (a :: l) → sorted r l := pairwise.of_cons

theorem sorted.tail {r : α → α → Prop} {l : list α} (h : sorted r l) : sorted r l.tail :=
h.tail

theorem rel_of_sorted_cons {a : α} {l : list α} : sorted r (a :: l) →
  ∀ b ∈ l, r a b :=
rel_of_pairwise_cons

@[simp] theorem sorted_cons {a : α} {l : list α} :
  sorted r (a :: l) ↔ (∀ b ∈ l, r a b) ∧ sorted r l :=
pairwise_cons

protected theorem sorted.nodup {r : α → α → Prop} [is_irrefl α r] {l : list α} (h : sorted r l) :
  nodup l :=
h.nodup

theorem eq_of_perm_of_sorted [is_antisymm α r]
  {l₁ l₂ : list α} (p : l₁ ~ l₂) (s₁ : sorted r l₁) (s₂ : sorted r l₂) : l₁ = l₂ :=
begin
  induction s₁ with a l₁ h₁ s₁ IH generalizing l₂,
  { exact p.nil_eq },
  { have : a ∈ l₂ := p.subset (mem_cons_self _ _),
    rcases mem_split this with ⟨u₂, v₂, rfl⟩,
    have p' := (perm_cons a).1 (p.trans perm_middle),
    have := IH p' (s₂.sublist $ by simp), subst l₁,
    change a::u₂ ++ v₂ = u₂ ++ ([a] ++ v₂), rw ← append_assoc, congr,
    have : ∀ (x : α) (h : x ∈ u₂), x = a := λ x m,
      antisymm ((pairwise_append.1 s₂).2.2 _ m a (mem_cons_self _ _))
        (h₁ _ (by simp [m])),
    rw [(@eq_repeat _ a (length u₂ + 1) (a::u₂)).2,
        (@eq_repeat _ a (length u₂ + 1) (u₂++[a])).2];
    split; simp [iff_true_intro this, or_comm] }
end

theorem sublist_of_subperm_of_sorted [is_antisymm α r]
  {l₁ l₂ : list α} (p : l₁ <+~ l₂) (s₁ : l₁.sorted r) (s₂ : l₂.sorted r) : l₁ <+ l₂ :=
let ⟨_, h, h'⟩ := p in by rwa ←eq_of_perm_of_sorted h (s₂.sublist h') s₁

@[simp] theorem sorted_singleton (a : α) : sorted r [a] := pairwise_singleton _ _

lemma sorted.rel_nth_le_of_lt {l : list α}
  (h : l.sorted r) {a b : ℕ} (ha : a < l.length) (hb : b < l.length) (hab : a < b) :
  r (l.nth_le a ha) (l.nth_le b hb) :=
list.pairwise_iff_nth_le.1 h a b hb hab

lemma sorted.rel_nth_le_of_le [is_refl α r] {l : list α}
  (h : l.sorted r) {a b : ℕ} (ha : a < l.length) (hb : b < l.length) (hab : a ≤ b) :
  r (l.nth_le a ha) (l.nth_le b hb) :=
begin
  cases eq_or_lt_of_le hab with H H,
  { subst H, exact refl _ },
  { exact h.rel_nth_le_of_lt _ _ H }
end

lemma sorted.rel_of_mem_take_of_mem_drop {l : list α} (h : list.sorted r l)
  {k : ℕ} {x y : α} (hx : x ∈ list.take k l) (hy : y ∈ list.drop k l) :
  r x y :=
begin
  obtain ⟨iy, hiy, rfl⟩ := nth_le_of_mem hy,
  obtain ⟨ix, hix, rfl⟩ := nth_le_of_mem hx,
  rw [nth_le_take', nth_le_drop'],
  rw length_take at hix,
  exact h.rel_nth_le_of_lt _ _ (ix.lt_add_right _ _ (lt_min_iff.mp hix).left)
end

end sorted

section sort
variables {α : Type uu} (r : α → α → Prop) [decidable_rel r]
local infix ` ≼ ` : 50 := r

/-! ### Insertion sort -/

section insertion_sort

/-- `ordered_insert a l` inserts `a` into `l` at such that
  `ordered_insert a l` is sorted if `l` is. -/
@[simp] def ordered_insert (a : α) : list α → list α
| []       := [a]
| (b :: l) := if a ≼ b then a :: b :: l else b :: ordered_insert l

/-- `insertion_sort l` returns `l` sorted using the insertion sort algorithm. -/
@[simp] def insertion_sort : list α → list α
| []       := []
| (b :: l) := ordered_insert r b (insertion_sort l)

@[simp] lemma ordered_insert_nil (a : α) : [].ordered_insert r a = [a] := rfl

theorem ordered_insert_length : Π (L : list α) (a : α), (L.ordered_insert r a).length = L.length + 1
| [] a := rfl
| (hd :: tl) a := by { dsimp [ordered_insert], split_ifs; simp [ordered_insert_length], }

/-- An alternative definition of `ordered_insert` using `take_while` and `drop_while`. -/
lemma ordered_insert_eq_take_drop (a : α) : ∀ l : list α,
  l.ordered_insert r a = l.take_while (λ b, ¬(a ≼ b)) ++ (a :: l.drop_while (λ b, ¬(a ≼ b)))
| [] := rfl
| (b :: l) := by { dsimp only [ordered_insert], split_ifs; simp [take_while, drop_while, *] }

lemma insertion_sort_cons_eq_take_drop (a : α) (l : list α) :
  insertion_sort r (a :: l) = (insertion_sort r l).take_while (λ b, ¬(a ≼ b)) ++
    (a :: (insertion_sort r l).drop_while (λ b, ¬(a ≼ b))) :=
ordered_insert_eq_take_drop r a _

section correctness
open perm

theorem perm_ordered_insert (a) : ∀ l : list α, ordered_insert r a l ~ a :: l
| []       := perm.refl _
| (b :: l) := by by_cases a ≼ b; [simp [ordered_insert, h],
  simpa [ordered_insert, h] using
    ((perm_ordered_insert l).cons _).trans (perm.swap _ _ _)]

theorem ordered_insert_count [decidable_eq α] (L : list α) (a b : α) :
  count a (L.ordered_insert r b) = count a L + if (a = b) then 1 else 0 :=
begin
  rw [(L.perm_ordered_insert r b).count_eq, count_cons],
  split_ifs; simp only [nat.succ_eq_add_one, add_zero],
end

theorem perm_insertion_sort : ∀ l : list α, insertion_sort r l ~ l
| []       := perm.nil
| (b :: l) := by simpa [insertion_sort] using
  (perm_ordered_insert _ _ _).trans ((perm_insertion_sort l).cons b)

variable {r}

/-- If `l` is already `list.sorted` with respect to `r`, then `insertion_sort` does not change
it. -/
lemma sorted.insertion_sort_eq : ∀ {l : list α} (h : sorted r l), insertion_sort r l = l
| [] _ := rfl
| [a] _ := rfl
| (a :: b :: l) h :=
  begin
    rw [insertion_sort, sorted.insertion_sort_eq, ordered_insert, if_pos],
    exacts [rel_of_sorted_cons h _ (or.inl rfl), h.tail]
  end

section total_and_transitive
variables [is_total α r] [is_trans α r]

theorem sorted.ordered_insert (a : α) : ∀ l, sorted r l → sorted r (ordered_insert r a l)
| []       h := sorted_singleton a
| (b :: l) h := begin
  by_cases h' : a ≼ b,
  { simpa [ordered_insert, h', h] using λ b' bm, trans h' (rel_of_sorted_cons h _ bm) },
  { suffices : ∀ (b' : α), b' ∈ ordered_insert r a l → r b b',
    { simpa [ordered_insert, h', h.of_cons.ordered_insert l] },
    intros b' bm,
    cases (show b' = a ∨ b' ∈ l, by simpa using
      (perm_ordered_insert _ _ _).subset bm) with be bm,
    { subst b', exact (total_of r _ _).resolve_left h' },
    { exact rel_of_sorted_cons h _ bm } }
end

variable (r)

/-- The list `list.insertion_sort r l` is `list.sorted` with respect to `r`. -/
theorem sorted_insertion_sort : ∀ l, sorted r (insertion_sort r l)
| []       := sorted_nil
| (a :: l) := (sorted_insertion_sort l).ordered_insert a _

end total_and_transitive
end correctness
end insertion_sort

/-! ### Merge sort -/

section merge_sort

-- TODO(Jeremy): observation: if instead we write (a :: (split l).1, b :: (split l).2), the
-- equation compiler can't prove the third equation

/-- Split `l` into two lists of approximately equal length.

     split [1, 2, 3, 4, 5] = ([1, 3, 5], [2, 4]) -/
@[simp] def split : list α → list α × list α
| []       := ([], [])
| (a :: l) := let (l₁, l₂) := split l in (a :: l₂, l₁)

theorem split_cons_of_eq (a : α) {l l₁ l₂ : list α} (h : split l = (l₁, l₂)) :
  split (a :: l) = (a :: l₂, l₁) :=
by rw [split, h]; refl

theorem length_split_le : ∀ {l l₁ l₂ : list α},
  split l = (l₁, l₂) → length l₁ ≤ length l ∧ length l₂ ≤ length l
| []     ._  ._  rfl := ⟨nat.le_refl 0, nat.le_refl 0⟩
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ h₂, nat.le_succ_of_le h₁⟩
end

theorem length_split_lt {a b} {l l₁ l₂ : list α} (h : split (a::b::l) = (l₁, l₂)) :
  length l₁ < length (a::b::l) ∧ length l₂ < length (a::b::l) :=
begin
  cases e : split l with l₁' l₂',
  injection (split_cons_of_eq _ (split_cons_of_eq _ e)).symm.trans h, substs l₁ l₂,
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ (nat.succ_le_succ h₁), nat.succ_le_succ (nat.succ_le_succ h₂)⟩
end

theorem perm_split : ∀ {l l₁ l₂ : list α}, split l = (l₁, l₂) → l ~ l₁ ++ l₂
| []     ._  ._  rfl := perm.refl _
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  exact ((perm_split e).trans perm_append_comm).cons a,
end

/-- Merge two sorted lists into one in linear time.

     merge [1, 2, 4, 5] [0, 1, 3, 4] = [0, 1, 1, 2, 3, 4, 4, 5] -/
def merge : list α → list α → list α
| []       l'        := l'
| l        []        := l
| (a :: l) (b :: l') := if a ≼ b then a :: merge l (b :: l') else b :: merge (a :: l) l'

include r
/-- Implementation of a merge sort algorithm to sort a list. -/
def merge_sort : list α → list α
| []        := []
| [a]       := [a]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  exact merge r (merge_sort l₁) (merge_sort l₂)
end
using_well_founded
{ rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_cons_cons {a b} {l l₁ l₂ : list α}
  (h : split (a::b::l) = (l₁, l₂)) :
  merge_sort r (a::b::l) = merge r (merge_sort r l₁) (merge_sort r l₂) :=
begin
  suffices : ∀ (L : list α) h1, @@and.rec
    (λ a a (_ : length l₁ < length l + 1 + 1 ∧
      length l₂ < length l + 1 + 1), L) h1 h1 = L,
  { simp [merge_sort, h], apply this },
  intros, cases h1, refl
end

section correctness

theorem perm_merge : ∀ (l l' : list α), merge r l l' ~ l ++ l'
| []       []        := by simp [merge]
| []       (b :: l') := by simp [merge]
| (a :: l) []        := by simp [merge]
| (a :: l) (b :: l') := begin
  by_cases a ≼ b,
  { simpa [merge, h] using perm_merge _ _ },
  { suffices : b :: merge r (a :: l) l' ~ a :: (l ++ b :: l'), {simpa [merge, h]},
    exact ((perm_merge _ _).cons _).trans ((swap _ _ _).trans (perm_middle.symm.cons _)) }
end

theorem perm_merge_sort : ∀ l : list α, merge_sort r l ~ l
| []        := by simp [merge_sort]
| [a]       := by simp [merge_sort]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  apply (perm_merge r _ _).trans,
  exact ((perm_merge_sort l₁).append (perm_merge_sort l₂)).trans (perm_split e).symm
end
using_well_founded
{ rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

@[simp] lemma length_merge_sort (l : list α) : (merge_sort r l).length = l.length :=
(perm_merge_sort r _).length_eq

section total_and_transitive
variables {r} [is_total α r] [is_trans α r]

theorem sorted.merge : ∀ {l l' : list α}, sorted r l → sorted r l' → sorted r (merge r l l')
| []       []        h₁ h₂ := by simp [merge]
| []       (b :: l') h₁ h₂ := by simpa [merge] using h₂
| (a :: l) []        h₁ h₂ := by simpa [merge] using h₁
| (a :: l) (b :: l') h₁ h₂ := begin
  by_cases a ≼ b,
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r l (b :: l')), r a b',
    { simpa [merge, h, h₁.of_cons.merge h₂] },
    intros b' bm,
    rcases (show b' = b ∨ b' ∈ l ∨ b' ∈ l', by simpa [or.left_comm] using
      (perm_merge _ _ _).subset bm) with be | bl | bl',
    { subst b', assumption },
    { exact rel_of_sorted_cons h₁ _ bl },
    { exact trans h (rel_of_sorted_cons h₂ _ bl') } },
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r (a :: l) l'), r b b',
    { simpa [merge, h, h₁.merge h₂.of_cons] },
    intros b' bm,
    have ba : b ≼ a := (total_of r _ _).resolve_left h,
    rcases (show b' = a ∨ b' ∈ l ∨ b' ∈ l', by simpa using
      (perm_merge _ _ _).subset bm) with be | bl | bl',
    { subst b', assumption },
    { exact trans ba (rel_of_sorted_cons h₁ _ bl) },
    { exact rel_of_sorted_cons h₂ _ bl' } }
end

variable (r)

theorem sorted_merge_sort : ∀ l : list α, sorted r (merge_sort r l)
| []        := by simp [merge_sort]
| [a]       := by simp [merge_sort]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  exact (sorted_merge_sort l₁).merge (sorted_merge_sort l₂)
end
using_well_founded
{ rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_eq_self [is_antisymm α r] {l : list α} : sorted r l → merge_sort r l = l :=
eq_of_perm_of_sorted (perm_merge_sort _ _) (sorted_merge_sort _ _)

theorem merge_sort_eq_insertion_sort [is_antisymm α r] (l : list α) :
  merge_sort r l = insertion_sort r l :=
eq_of_perm_of_sorted ((perm_merge_sort r l).trans (perm_insertion_sort r l).symm)
  (sorted_merge_sort r l) (sorted_insertion_sort r l)

end total_and_transitive
end correctness

@[simp] theorem merge_sort_nil : [].merge_sort r = [] :=
by rw list.merge_sort

@[simp] theorem merge_sort_singleton (a : α) : [a].merge_sort r = [a] :=
by rw list.merge_sort

end merge_sort
end sort

/- try them out! -/

--#eval insertion_sort (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

--#eval merge_sort     (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

end list


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann, Kyle Miller, Mario Carneiro
-/
import data.nat.gcd
import logic.function.iterate
import data.finset.nat_antidiagonal
import algebra.big_operators.basic
import tactic.ring
import tactic.zify

/-!
# The Fibonacci Sequence

## Summary

Definition of the Fibonacci sequence `F₀ = 0, F₁ = 1, Fₙ₊₂ = Fₙ + Fₙ₊₁`.

## Main Definitions

- `nat.fib` returns the stream of Fibonacci numbers.

## Main Statements

- `nat.fib_add_two`: shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.`.
- `nat.fib_gcd`: `fib n` is a strong divisibility sequence.
- `nat.fib_succ_eq_sum_choose`: `fib` is given by the sum of `nat.choose` along an antidiagonal.
- `nat.fib_succ_eq_succ_sum`: shows that `F₀ + F₁ + ⋯ + Fₙ = Fₙ₊₂ - 1`.
- `nat.fib_two_mul` and `nat.fib_two_mul_add_one` are the basis for an efficient algorithm to
  compute `fib` (see `nat.fast_fib`). There are `bit0`/`bit1` variants of these can be used to
  simplify `fib` expressions: `simp only [nat.fib_bit0, nat.fib_bit1, nat.fib_bit0_succ,
  nat.fib_bit1_succ, nat.fib_one, nat.fib_two]`.

## Implementation Notes

For efficiency purposes, the sequence is defined using `stream.iterate`.

## Tags

fib, fibonacci
-/

open_locale big_operators

namespace nat

/--
Implementation of the fibonacci sequence satisfying
`fib 0 = 0, fib 1 = 1, fib (n + 2) = fib n + fib (n + 1)`.

*Note:* We use a stream iterator for better performance when compared to the naive recursive
implementation.
-/
@[pp_nodot]
def fib (n : ℕ) : ℕ := ((λ p : ℕ × ℕ, (p.snd, p.fst + p.snd))^[n] (0, 1)).fst

@[simp] lemma fib_zero : fib 0 = 0 := rfl
@[simp] lemma fib_one : fib 1 = 1 := rfl
@[simp] lemma fib_two : fib 2 = 1 := rfl

/-- Shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.` -/
lemma fib_add_two {n : ℕ} : fib (n + 2) = fib n + fib (n + 1) :=
by simp only [fib, function.iterate_succ']

lemma fib_le_fib_succ {n : ℕ} : fib n ≤ fib (n + 1) := by { cases n; simp [fib_add_two] }

@[mono] lemma fib_mono : monotone fib :=
monotone_nat_of_le_succ $ λ _, fib_le_fib_succ

lemma fib_pos {n : ℕ} (n_pos : 0 < n) : 0 < fib n :=
calc 0 < fib 1 : dec_trivial
   ... ≤ fib n : fib_mono n_pos

lemma fib_add_two_sub_fib_add_one {n : ℕ} : fib (n + 2) - fib (n + 1) = fib n :=
by rw [fib_add_two, add_tsub_cancel_right]

lemma fib_lt_fib_succ {n : ℕ} (hn : 2 ≤ n) : fib n < fib (n + 1) :=
begin
  rcases le_iff_exists_add.1 hn with ⟨n, rfl⟩,
  rw [← tsub_pos_iff_lt, add_comm 2, fib_add_two_sub_fib_add_one],
  apply fib_pos (succ_pos n),
end

/-- `fib (n + 2)` is strictly monotone. -/
lemma fib_add_two_strict_mono : strict_mono (λ n, fib (n + 2)) :=
begin
  refine strict_mono_nat_of_lt_succ (λ n, _),
  rw add_right_comm,
  exact fib_lt_fib_succ (self_le_add_left _ _)
end

lemma le_fib_self {n : ℕ} (five_le_n : 5 ≤ n) : n ≤ fib n :=
begin
  induction five_le_n with n five_le_n IH,
  { -- 5 ≤ fib 5
    refl },
  { -- n + 1 ≤ fib (n + 1) for 5 ≤ n
    rw succ_le_iff,
    calc n ≤ fib n       : IH
       ... < fib (n + 1) : fib_lt_fib_succ (le_trans dec_trivial five_le_n) }
end

/-- Subsequent Fibonacci numbers are coprime,
  see https://proofwiki.org/wiki/Consecutive_Fibonacci_Numbers_are_Coprime -/
lemma fib_coprime_fib_succ (n : ℕ) : nat.coprime (fib n) (fib (n + 1)) :=
begin
  induction n with n ih,
  { simp },
  { rw [fib_add_two, coprime_add_self_right],
    exact ih.symm }
end

/-- See https://proofwiki.org/wiki/Fibonacci_Number_in_terms_of_Smaller_Fibonacci_Numbers -/
lemma fib_add (m n : ℕ) :
  fib (m + n + 1) = fib m * fib n + fib (m + 1) * fib (n + 1) :=
begin
  induction n with n ih generalizing m,
  { simp },
  { intros,
    specialize ih (m + 1),
    rw [add_assoc m 1 n, add_comm 1 n] at ih,
    simp only [fib_add_two, ih],
    ring, }
end

lemma fib_two_mul (n : ℕ) : fib (2 * n) = fib n * (2 * fib (n + 1) - fib n) :=
begin
  cases n,
  { simp },
  { rw [nat.succ_eq_add_one, two_mul, ←add_assoc, fib_add, fib_add_two, two_mul],
    simp only [← add_assoc, add_tsub_cancel_right],
    ring, },
end

lemma fib_two_mul_add_one (n : ℕ) : fib (2 * n + 1) = fib (n + 1) ^ 2 + fib n ^ 2 :=
by { rw [two_mul, fib_add], ring }

lemma fib_bit0 (n : ℕ) : fib (bit0 n) = fib n * (2 * fib (n + 1) - fib n) :=
by rw [bit0_eq_two_mul, fib_two_mul]

lemma fib_bit1 (n : ℕ) : fib (bit1 n) = fib (n + 1) ^ 2 + fib n ^ 2 :=
by rw [nat.bit1_eq_succ_bit0, bit0_eq_two_mul, fib_two_mul_add_one]

lemma fib_bit0_succ (n : ℕ) : fib (bit0 n + 1) = fib (n + 1) ^ 2 + fib n ^ 2 := fib_bit1 n

lemma fib_bit1_succ (n : ℕ) : fib (bit1 n + 1) = fib (n + 1) * (2 * fib n + fib (n + 1)) :=
begin
  rw [nat.bit1_eq_succ_bit0, fib_add_two, fib_bit0, fib_bit0_succ],
  have : fib n ≤ 2 * fib (n + 1),
  { rw two_mul,
    exact le_add_left fib_le_fib_succ, },
  zify,
  ring,
end

/-- Computes `(nat.fib n, nat.fib (n + 1))` using the binary representation of `n`.
Supports `nat.fast_fib`. -/
def fast_fib_aux : ℕ → ℕ × ℕ :=
nat.binary_rec (fib 0, fib 1) (λ b n p,
  if b
  then (p.2^2 + p.1^2, p.2 * (2 * p.1 + p.2))
  else (p.1 * (2 * p.2 - p.1), p.2^2 + p.1^2))

/-- Computes `nat.fib n` using the binary representation of `n`.
Proved to be equal to `nat.fib` in `nat.fast_fib_eq`. -/
def fast_fib (n : ℕ) : ℕ := (fast_fib_aux n).1

lemma fast_fib_aux_bit_ff (n : ℕ) :
  fast_fib_aux (bit ff n) = let p := fast_fib_aux n in (p.1 * (2 * p.2 - p.1), p.2^2 + p.1^2) :=
begin
  rw [fast_fib_aux, binary_rec_eq],
  { refl },
  { simp },
end

lemma fast_fib_aux_bit_tt (n : ℕ) :
  fast_fib_aux (bit tt n) = let p := fast_fib_aux n in (p.2^2 + p.1^2, p.2 * (2 * p.1 + p.2)) :=
begin
  rw [fast_fib_aux, binary_rec_eq],
  { refl },
  { simp },
end

lemma fast_fib_aux_eq (n : ℕ) :
  fast_fib_aux n = (fib n, fib (n + 1)) :=
begin
  apply nat.binary_rec _ (λ b n' ih, _) n,
  { simp [fast_fib_aux] },
  { cases b; simp only [fast_fib_aux_bit_ff, fast_fib_aux_bit_tt,
      congr_arg prod.fst ih, congr_arg prod.snd ih, prod.mk.inj_iff]; split;
    simp [bit, fib_bit0, fib_bit1, fib_bit0_succ, fib_bit1_succ], },
end

lemma fast_fib_eq (n : ℕ) : fast_fib n = fib n :=
by rw [fast_fib, fast_fib_aux_eq]

lemma gcd_fib_add_self (m n : ℕ) : gcd (fib m) (fib (n + m)) = gcd (fib m) (fib n) :=
begin
  cases nat.eq_zero_or_pos n,
  { rw h, simp },
  replace h := nat.succ_pred_eq_of_pos h, rw [← h, succ_eq_add_one],
  calc gcd (fib m) (fib (n.pred + 1 + m))
        = gcd (fib m) (fib (n.pred) * (fib m) + fib (n.pred + 1) * fib (m + 1)) :
    by { rw ← fib_add n.pred _, ring_nf }
    ... = gcd (fib m) (fib (n.pred + 1) * fib (m + 1)) :
    by rw [add_comm, gcd_add_mul_right_right (fib m) _ (fib (n.pred))]
    ... = gcd (fib m) (fib (n.pred + 1)) :
    coprime.gcd_mul_right_cancel_right
      (fib (n.pred + 1)) (coprime.symm (fib_coprime_fib_succ m))
end

lemma gcd_fib_add_mul_self (m n : ℕ) : ∀ k, gcd (fib m) (fib (n + k * m)) = gcd (fib m) (fib n)
| 0     := by simp
| (k+1) := by rw [← gcd_fib_add_mul_self k, add_mul, ← add_assoc, one_mul, gcd_fib_add_self _ _]

/-- `fib n` is a strong divisibility sequence,
  see https://proofwiki.org/wiki/GCD_of_Fibonacci_Numbers -/

lemma fib_dvd (m n : ℕ) (h : m ∣ n) : fib m ∣ fib n :=
by rwa [gcd_eq_left_iff_dvd, ← fib_gcd, gcd_eq_left_iff_dvd.mp]

lemma fib_succ_eq_sum_choose :
  ∀ (n : ℕ), fib (n + 1) = ∑ p in finset.nat.antidiagonal n, choose p.1 p.2 :=
two_step_induction rfl rfl (λ n h1 h2, by
{ rw [fib_add_two, h1, h2, finset.nat.antidiagonal_succ_succ', finset.nat.antidiagonal_succ'],
  simp [choose_succ_succ, finset.sum_add_distrib, add_left_comm] })

lemma fib_succ_eq_succ_sum (n : ℕ):
  fib (n + 1) = (∑ k in finset.range n, fib k) + 1 :=
begin
  induction n with n ih,
  { simp },
  { calc fib (n + 2) = fib n + fib (n + 1)                        : fib_add_two
                 ... = fib n + (∑ k in finset.range n, fib k) + 1 : by rw [ih, add_assoc]
                 ... = (∑ k in finset.range (n + 1), fib k) + 1   : by simp [finset.range_add_one] }
end
end nat

namespace norm_num
open tactic nat

/-! ### `norm_num` plugin for `fib`

The `norm_num` plugin uses a strategy parallel to that of `nat.fast_fib`, but it instead
produces proofs of what `nat.fib` evaluates to.
-/

/-- Auxiliary definition for `prove_fib` plugin. -/
def is_fib_aux (n a b : ℕ) := fib n = a ∧ fib (n + 1) = b

lemma is_fib_aux_one : is_fib_aux 1 1 1 := ⟨fib_one, fib_two⟩

lemma is_fib_aux_bit0 {n a b c a2 b2 a' b' : ℕ} (H : is_fib_aux n a b)
  (h1 : a + c = bit0 b) (h2 : a * c = a')
  (h3 : a * a = a2) (h4 : b * b = b2) (h5 : a2 + b2 = b') :
  is_fib_aux (bit0 n) a' b' :=
⟨by rw [fib_bit0, H.1, H.2, ← bit0_eq_two_mul,
  show bit0 b-a=c, by rw [← h1, nat.add_sub_cancel_left], h2],
 by rw [fib_bit0_succ, H.1, H.2, pow_two, pow_two, h3, h4, add_comm, h5]⟩

lemma is_fib_aux_bit1 {n a b c a2 b2 a' b' : ℕ} (H : is_fib_aux n a b)
  (h1 : a * a = a2) (h2 : b * b = b2) (h3 : a2 + b2 = a')
  (h4 : bit0 a + b = c) (h5 : b * c = b') :
  is_fib_aux (bit1 n) a' b' :=
⟨by rw [fib_bit1, H.1, H.2, pow_two, pow_two, h1, h2, add_comm, h3],
 by rw [fib_bit1_succ, H.1, H.2, ← bit0_eq_two_mul, h4, h5]⟩

lemma is_fib_aux_bit0_done {n a b c a' : ℕ} (H : is_fib_aux n a b)
  (h1 : a + c = bit0 b) (h2 : a * c = a') : fib (bit0 n) = a' :=
(is_fib_aux_bit0 H h1 h2 rfl rfl rfl).1

lemma is_fib_aux_bit1_done {n a b a2 b2 a' : ℕ} (H : is_fib_aux n a b)
  (h1 : a * a = a2) (h2 : b * b = b2) (h3 : a2 + b2 = a') : fib (bit1 n) = a' :=
(is_fib_aux_bit1 H h1 h2 h3 rfl rfl).1

/-- `prove_fib_aux ic n` returns `(ic', a, b, ⊢ is_fib_aux n a b)`, where `n` is a numeral. -/
meta def prove_fib_aux (ic : instance_cache) :
  expr → tactic (instance_cache × expr × expr × expr)
| e :=
  match match_numeral e with
  | match_numeral_result.one := pure (ic, `(1:ℕ), `(1:ℕ), `(is_fib_aux_one))
  | match_numeral_result.bit0 e := do
    (ic, a, b, H) ← prove_fib_aux e,
    na ← a.to_nat, nb ← b.to_nat,
    (ic, c) ← ic.of_nat (2*nb - na),
    (ic, h1) ← prove_add_nat ic a c (`(bit0:ℕ→ℕ).mk_app [b]),
    (ic, a', h2) ← prove_mul_nat ic a c,
    (ic, a2, h3) ← prove_mul_nat ic a a,
    (ic, b2, h4) ← prove_mul_nat ic b b,
    (ic, b', h5) ← prove_add_nat' ic a2 b2,
    pure (ic, a', b', `(@is_fib_aux_bit0).mk_app
      [e, a, b, c, a2, b2, a', b', H, h1, h2, h3, h4, h5])
  | match_numeral_result.bit1 e := do
    (ic, a, b, H) ← prove_fib_aux e,
    na ← a.to_nat, nb ← b.to_nat,
    (ic, c) ← ic.of_nat (2*na + nb),
    (ic, a2, h1) ← prove_mul_nat ic a a,
    (ic, b2, h2) ← prove_mul_nat ic b b,
    (ic, a', h3) ← prove_add_nat' ic a2 b2,
    (ic, h4) ← prove_add_nat ic (`(bit0:ℕ→ℕ).mk_app [a]) b c,
    (ic, b', h5) ← prove_mul_nat ic b c,
    pure (ic, a', b', `(@is_fib_aux_bit1).mk_app
      [e, a, b, c, a2, b2, a', b', H, h1, h2, h3, h4, h5])
  | _ := failed
  end

/-- A `norm_num` plugin for `fib n` when `n` is a numeral.
Uses the binary representation of `n` like `nat.fast_fib`. -/
meta def prove_fib (ic : instance_cache) (e : expr) : tactic (instance_cache × expr × expr) :=
match match_numeral e with
| match_numeral_result.zero := pure (ic, `(0:ℕ), `(fib_zero))
| match_numeral_result.one := pure (ic, `(1:ℕ), `(fib_one))
| match_numeral_result.bit0 e := do
  (ic, a, b, H) ← prove_fib_aux ic e,
  na ← a.to_nat, nb ← b.to_nat,
  (ic, c) ← ic.of_nat (2*nb - na),
  (ic, h1) ← prove_add_nat ic a c (`(bit0:ℕ→ℕ).mk_app [b]),
  (ic, a', h2) ← prove_mul_nat ic a c,
  pure (ic, a', `(@is_fib_aux_bit0_done).mk_app [e, a, b, c, a', H, h1, h2])
| match_numeral_result.bit1 e := do
  (ic, a, b, H) ← prove_fib_aux ic e,
  (ic, a2, h1) ← prove_mul_nat ic a a,
  (ic, b2, h2) ← prove_mul_nat ic b b,
  (ic, a', h3) ← prove_add_nat' ic a2 b2,
  pure (ic, a', `(@is_fib_aux_bit1_done).mk_app [e, a, b, a2, b2, a', H, h1, h2, h3])
| _ := failed
end

/-- A `norm_num` plugin for `fib n` when `n` is a numeral.
Uses the binary representation of `n` like `nat.fast_fib`. -/
@[norm_num] meta def eval_fib : expr → tactic (expr × expr)
| `(fib %%en) := do
    n ← en.to_nat,
    match n with
    | 0 := pure (`(0:ℕ), `(fib_zero))
    | 1 := pure (`(1:ℕ), `(fib_one))
    | 2 := pure (`(1:ℕ), `(fib_two))
    | _ := do
      c ← mk_instance_cache `(ℕ),
      prod.snd <$> prove_fib c en
    end
| _ := failed

end norm_num


/-
Defines an additional theorem over orders.
-/

/-- Show that for linear orders le is equivalent to not_gt.

N.B. This is the inverse of lt_iff_not_ge.
-/
protected lemma le_iff_not_gt  {α : Type} [linear_order α] (x y : α)
: (x ≤ y) ↔ ¬(x > y) :=
  iff.intro not_lt_of_ge le_of_not_gt


/-
Copyright (c) 2022 Jon Eugster. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jon Eugster

! This file was ported from Lean 3 source module algebra.char_p.local_ring
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.CharP.Basic
import Mathbin.RingTheory.Ideal.LocalRing
import Mathbin.Algebra.IsPrimePow
import Mathbin.Data.Nat.Factorization.Basic

/-!
# Characteristics of local rings

## Main result

- `char_p_zero_or_prime_power`: In a commutative local ring the characteristics is either
  zero or a prime power.

-/

/-- In a local ring the characteristics is either zero or a prime power. -/
theorem charP_zero_or_prime_power (R : Type _) [CommRing R] [LocalRing R] (q : ℕ)
    [char_R_q : CharP R q] : q = 0 ∨ IsPrimePow q :=
  by
  -- Assume `q := char(R)` is not zero.
  apply or_iff_not_imp_left.2
  intro q_pos
  let K := LocalRing.ResidueField R
  haveI RM_char := ringChar.charP K
  let r := ringChar K
  let n := q.factorization r
  -- `r := char(R/m)` is either prime or zero:
  cases' CharP.char_is_prime_or_zero K r with r_prime r_zero
  · let a := q / r ^ n
    -- If `r` is prime, we can write it as `r = a * q^n` ...
    have q_eq_a_mul_rn : q = r ^ n * a := by rw [Nat.mul_div_cancel' (Nat.ord_proj_dvd q r)]
    have r_ne_dvd_a := Nat.not_dvd_ord_compl r_prime q_pos
    have rn_dvd_q : r ^ n ∣ q := ⟨a, q_eq_a_mul_rn⟩
    rw [mul_comm] at q_eq_a_mul_rn
    have a_dvd_q : a ∣ q := ⟨r ^ n, q_eq_a_mul_rn⟩
    -- ... where `a` is a unit.
    have a_unit : IsUnit (a : R) := by
      by_contra g
      rw [← mem_nonunits_iff] at g
      rw [← LocalRing.mem_maximalIdeal] at g
      have a_cast_zero := Ideal.Quotient.eq_zero_iff_mem.2 g
      rw [map_natCast] at a_cast_zero
      have r_dvd_a := (ringChar.spec K a).1 a_cast_zero
      exact absurd r_dvd_a r_ne_dvd_a
    -- Let `b` be the inverse of `a`.
    cases' a_unit.exists_left_inv with a_inv h_inv_mul_a
    have rn_cast_zero : ↑(r ^ n) = (0 : R) :=
      by
      rw [Nat.cast_pow, ← @mul_one R _ (r ^ n), mul_comm, ←
        Classical.choose_spec a_unit.exists_left_inv, mul_assoc, ← Nat.cast_pow, ← Nat.cast_mul, ←
        q_eq_a_mul_rn, CharP.cast_eq_zero R q]
      simp
    have q_eq_rn := Nat.dvd_antisymm ((CharP.cast_eq_zero_iff R q (r ^ n)).mp rn_cast_zero) rn_dvd_q
    have n_pos : n ≠ 0 := fun n_zero =>
      absurd (by simpa [n_zero] using q_eq_rn) (CharP.char_ne_one R q)
    -- Definition of prime power: `∃ r n, prime r ∧ 0 < n ∧ r ^ n = q`.
    exact ⟨r, ⟨n, ⟨r_prime.prime, ⟨pos_iff_ne_zero.mpr n_pos, q_eq_rn.symm⟩⟩⟩⟩
  · haveI K_char_p_0 := ringChar.of_eq r_zero
    haveI K_char_zero : CharZero K := CharP.charP_to_charZero K
    haveI R_char_zero := RingHom.charZero (LocalRing.residue R)
    -- Finally, `r = 0` would lead to a contradiction:
    have q_zero := CharP.eq R char_R_q (CharP.ofCharZero R)
    exact absurd q_zero q_pos
#align char_p_zero_or_prime_power charP_zero_or_prime_power


/-
Copyright (c) 2022 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez
-/
import set_theory.cardinal.ordinal
import ring_theory.artinian

/-!
# Cardinality of localizations

In this file, we establish the cardinality of localizations. In most cases, a localization has
cardinality equal to the base ring. If there are zero-divisors, however, this is no longer true -
for example, `zmod 6` localized at `{2, 4}` is equal to `zmod 3`, and if you have zero in your
submonoid, then your localization is trivial (see `is_localization.unique_of_zero_mem`).

## Main statements

* `is_localization.card_le`: A localization has cardinality no larger than the base ring.
* `is_localization.card`: If you don't localize at zero-divisors, the localization of a ring has
  cardinality equal to its base ring,

-/

open_locale cardinal non_zero_divisors

universes u v

namespace is_localization

variables {R : Type u} [comm_ring R] (S : submonoid R) {L : Type u} [comm_ring L]
          [algebra R L] [is_localization S L]
include S

/-- A localization always has cardinality less than or equal to the base ring. -/
lemma card_le : #L ≤ #R :=
begin
  classical,
  casesI fintype_or_infinite R,
  { exact cardinal.mk_le_of_surjective (is_artinian_ring.localization_surjective S _) },
  erw [←cardinal.mul_eq_self $ cardinal.aleph_0_le_mk R],
  set f : R × R → L := λ aa, is_localization.mk' _ aa.1 (if h : aa.2 ∈ S then ⟨aa.2, h⟩ else 1),
  refine @cardinal.mk_le_of_surjective _ _ f (λ a, _),
  obtain ⟨x, y, h⟩ := is_localization.mk'_surjective S a,
  use (x, y),
  dsimp [f],
  rwa [dif_pos $ show ↑y ∈ S, from y.2, set_like.eta]
end

variables (L)

/-- If you do not localize at any zero-divisors, localization preserves cardinality. -/
lemma card (hS : S ≤ R⁰) : #R = #L :=
(cardinal.mk_le_of_injective (is_localization.injective L hS)).antisymm (card_le S)

end is_localization


import game.sets.sets_level03 -- hide

namespace xena -- hide

open_locale classical -- hide

variable X : Type --hide

/-
# Chapter 1 : Sets

## Level 4
-/

/- Axiom : ext_iff :
A = B ↔ ∀ x : X, x ∈ A ↔ x ∈ B
-/

/-

To prove that two sets are equal, one needs to use the axiom
of extensionality: two sets are equal if and only if they have
the same elements.

In Lean's maths library this axiom is called `ext_iff`.

```
lemma ext_diff : A = B ↔ ∀ x : X, x ∈ A ↔ x ∈ B
```
-/

/- Hint: A word on coding style

After a `split` statement, one goal turns into two. A good programming style
would be to use `{}` brackets to work on each goal individually, like this:
```
begin
  split,
  { insert,
    proof of,
    first goal
  },
  { insert,
    proof of,
    second goal
  }
end
```

This way you only ever have one goal to work on, and your code becomes
easier to read. After `split` you might want to write
```
{ sorry},
{ sorry}
```
so that your code has no errors while you're working on it.
-/

/- Hint : Stuck?
To prove the theorem below, remember that you can use `split` to
change the goal into two goals, corresponding to the left-right and
right-left implication, respectively. For the first goal, after
`intro h,` the equality of the two sets can be manipulated
using `rw ext_iff`.
-/

/- Hint: rewrite failures and the `simp_rw` tactic
`rw` doesn't work "under a binder". In other words, if your goal is
`⊢	∀ (x : X), x ∈ B ↔ x ∈ A ∪ B` then `rw mem_union_iff` won't work!
It's the `∀` which is blocking it. Either do `intro x` (and then
the `rw` will work), or use a more powerful rewrite tactic
called `simp_rw`, which will work

-/

/- Lemma
If $A$ and $B$ are sets of any type $X$, then
$$ A \subseteq B \iff A \cup B = B.$$
-/
theorem subset_iff_union_eq (A : set X) (B : set X) : A ⊆ B ↔ B = A ∪ B :=
begin
  rw subset_iff,
  split,
  { intro h,
    rw ext_iff,
     -- can't rewrite under a binder
    simp_rw mem_union_iff,
    intro x,
    specialize h x, -- or replace h := h x,
    tauto! },
  { intro h,
    intros x hA,
    rw h,
    rw mem_union_iff,
    tauto!
  }

end

--begin hide
-- theorem subset_iff_union_eq' (A : set X) (B : set X) : A ⊆ B ↔ B = A ∪ B :=
-- begin
--   rw subset_iff,
--   rw ext_iff,
--   apply forall_congr,
--   intro x,
--   rw mem_union_iff,
--   tauto!,
-- end
--end hide

end xena --hide


/-
This file defines rational segments 𝕊,
here defined as a subtype of ℚ × ℚ
Also defines relations on 𝕊, like ≤, ⊑ and ≈
-/

import data.rat
import algebra.order

/--
Rational segments 𝕊
Each s in 𝕊 is a pair of rational numbers (p, q) such that p ≤ q
Rational segments can be interpreted as intervals, [p, q], with rational end points
-/
def segment := {s : ℚ × ℚ // s.fst ≤ s.snd}

notation `𝕊` := segment

namespace segment

def fst (s : 𝕊) : ℚ := (subtype.val s).fst

def snd (s : 𝕊) : ℚ := (subtype.val s).snd

def proper (s : 𝕊) : Prop := s.fst < s.snd

def contained (s t : 𝕊) : Prop := t.fst ≤ s.fst ∧ s.snd ≤ t.snd

infix `⊑`:50 := contained

def proper_contained (s t : 𝕊) : Prop := t.fst < s.fst ∧ s.snd < t.snd

infix `⊏`:50 := proper_contained

def lt (s t : 𝕊) : Prop := s.snd < t.fst

infix `<` := lt

def le (s t : 𝕊) : Prop := s.fst ≤ t.snd

infix `≤` := le

def inclusion (q : ℚ) : 𝕊 :=
    subtype.mk (q, q)
    begin
        refl,
    end

@[instance] def has_zero : has_zero 𝕊 := { zero := inclusion 0 }

def two_sided_inclusion (q : ℚ) (hq : q > 0) : 𝕊 :=
    subtype.mk (-q, q)
    begin
        simp,
        rwa [neg_le_iff_add_nonneg, ← two_mul],
        apply rat.mul_nonneg,
        {-- need to prove: 0 ≤ 2
            exact rat.le_def'.mpr trivial
        },
        {-- need to prove: 0 ≤ q
            apply le_of_lt,
            rw ← gt_from_lt,
            exact hq,
        }
    end

lemma two_sided_inclusion_contained {q₁ q₂ : ℚ} {hq₁ : q₁ > 0} {hq₂ : q₂ > 0} (h : q₁ ≤ q₂) :
    two_sided_inclusion q₁ hq₁ ⊑ two_sided_inclusion q₂ hq₂ :=
begin
    simp [two_sided_inclusion, contained, fst, snd, h],
end

@[trans] theorem contained_trans (s t v : 𝕊) (h₁ : s ⊑ t) (h₂ : t ⊑ v) : s ⊑ v :=
begin
    split,
    {-- need to prove: fst v ≤ fst s
        transitivity t.fst,
        exact h₂.elim_left,
        exact h₁.elim_left,
    },
    {-- need to prove: snd s ≤ snd v
        transitivity t.snd,
        exact h₁.elim_right,
        exact h₂.elim_right,
    }
end

@[trans] theorem proper_contained_trans (s t v : 𝕊) (h₁ : s ⊏ t) (h₂ : t ⊏ v) : s ⊏ v :=
begin
    split,
    {-- need to prove: fst v < fst s
        transitivity t.fst,
        exact h₂.elim_left,
        exact h₁.elim_left,
    },
    {-- need to prove: snd s < snd v
        transitivity t.snd,
        exact h₁.elim_right,
        exact h₂.elim_right,
    }
end

@[refl] theorem contained_refl (s : 𝕊) : s ⊑ s :=
begin
    split,
    refl,
    refl,
end

-- This lemma immediately follows from a similar statement about ℚ
lemma le_iff_not_lt (s t : 𝕊) : s ≤ t ↔ ¬ t < s :=
begin
    split,
    {-- need to prove: s ≤ t → ¬ t < s
        intro h,
        apply not_lt_of_le,
        exact h,
    },
    {-- need to prove: ¬ t < s → s ≤ t
        intro h,
        apply le_of_not_lt,
        exact h,
    }
end

lemma lt_iff_not_le (s t : 𝕊) : s < t ↔ ¬ t ≤ s :=
begin
    split,
    {-- need to prove: s < t → ¬ t ≤ s
        intro h,
        apply not_le_of_lt,
        exact h,
    },
    {-- need to prove: ¬ t ≤ s → s < t
        intro h,
        apply lt_of_not_ge,
        rw ge_iff_le,
        exact h,
    }
end

@[trans] theorem lt_trans (s t v : 𝕊) (h₁ : s < t) (h₂ : t < v) : s < v :=
begin
    have ht := subtype.property t,
    have h₃ : s.snd < t.snd := lt_of_lt_of_le h₁ ht,
    rw segment.lt,
    transitivity t.snd,
    exact h₃,
    exact h₂,
end

@[refl] theorem le_refl (s : 𝕊) : s ≤ s :=
begin
    exact (subtype.property s),
end

/--
We say that two rational segments 'touch' if they partially cover eachother
-/
def touches (s t : 𝕊) : Prop := s ≤ t ∧ t ≤ s

infix `≈` := touches

@[refl] theorem touches_refl (s : 𝕊) : s ≈ s :=
begin
    split,
    refl,
    refl,
end

@[symm] theorem touches_symm (s t : 𝕊) : s ≈ t ↔ t ≈ s :=
begin
    exact and.comm,
end

def add (s t : 𝕊) : 𝕊 := subtype.mk (s.fst + t.fst, s.snd + t.snd)
    begin
        apply add_le_add,
        exact subtype.property s,
        exact subtype.property t,
    end

theorem add_assoc (s t v : 𝕊) : add (add s t) v = add s (add t v) :=
begin
    repeat {rw add},
    rw subtype.mk_eq_mk,
    rw prod.mk.inj_iff,
    split,
    {
        repeat {rw fst},
        rw add_assoc,
        rw add_left_inj,
        refl,
    },
    {
        repeat {rw snd},
        rw add_assoc,
        rw add_left_inj,
        refl,
    }
end

lemma fst_add_comm {s t : 𝕊} : fst (add s t) = fst s + fst t := rfl

lemma snd_add_comm {s t : 𝕊} : snd (add s t) = snd s + snd t := rfl

theorem add_comm (s t : 𝕊) : add s t = add t s :=
begin
    apply subtype.eq,
    simp [add],
    split,
        exact rat.add_comm (fst s) (fst t),
        exact rat.add_comm (snd s) (snd t),
end

-- We use this lemma in proving that addition on ℛ is well-defined
lemma contained_bounds_le (s t : 𝕊) (h : s ⊑ t) : s.snd - s.fst ≤ t.snd - t.fst :=
begin
    apply sub_le_sub,
    exact h.elim_right,
    exact h.elim_left,
end

instance : add_comm_semigroup 𝕊 :=
{
    add := segment.add,
    add_assoc := segment.add_assoc,
    add_comm := segment.add_comm,
}

def neg (s : 𝕊) : 𝕊 := subtype.mk (-s.snd, -s.fst)
    begin
        simp,
        exact subtype.property s,
    end

end segment


/-
Copyright (c) 2022 David Loeffler. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Loeffler
-/
import measure_theory.integral.interval_integral
import analysis.special_functions.exponential
import analysis.special_functions.integrals
import measure_theory.integral.integral_eq_improper

/-!
# Integrals with exponential decay at ∞

As easy special cases of general theorems in the library, we prove the following test
for integrability:

* `integrable_of_is_O_exp_neg`: If `f` is continuous on `[a,∞)`, for some `a ∈ ℝ`, and there
  exists `b > 0` such that `f(x) = O(exp(-b x))` as `x → ∞`, then `f` is integrable on `(a, ∞)`.
-/

noncomputable theory
open real interval_integral measure_theory set filter

/-- Integral of `exp (-b * x)` over `(a, X)` is bounded as `X → ∞`. -/
lemma integral_exp_neg_le {b : ℝ} (a X : ℝ) (h2 : 0 < b) :
  (∫ x in a .. X, exp (-b * x)) ≤ exp (-b * a) / b :=
begin
  rw integral_deriv_eq_sub' (λ x, -exp (-b * x) / b),
  -- goal 1/4: F(X) - F(a) is bounded
  { simp only [tsub_le_iff_right],
    rw [neg_div b (exp (-b * a)), neg_div b (exp (-b * X)), add_neg_self, neg_le, neg_zero],
    exact (div_pos (exp_pos _) h2).le, },
  -- goal 2/4: the derivative of F is exp(-b x)
  { ext1, simp [h2.ne'] },
  -- goal 3/4: F is differentiable
  { intros x hx, simp [h2.ne'], },
  -- goal 4/4: exp(-b x) is continuous
  { apply continuous.continuous_on, continuity }
end

/-- `exp (-b * x)` is integrable on `(a, ∞)`. -/
lemma exp_neg_integrable_on_Ioi (a : ℝ) {b : ℝ} (h : 0 < b) :
  integrable_on (λ x : ℝ, exp (-b * x)) (Ioi a) :=
begin
  have : ∀ (X : ℝ), integrable_on (λ x : ℝ, exp (-b * x) ) (Ioc a X),
  { intro X, exact (continuous_const.mul continuous_id).exp.integrable_on_Ioc },
  apply (integrable_on_Ioi_of_interval_integral_norm_bounded (exp (-b * a) / b) a this tendsto_id),
  simp only [eventually_at_top, norm_of_nonneg (exp_pos _).le],
  exact ⟨a, λ b2 hb2, integral_exp_neg_le a b2 h⟩,
end

/-- If `f` is continuous on `[a, ∞)`, and is `O (exp (-b * x))` at `∞` for some `b > 0`, then
`f` is integrable on `(a, ∞)`. -/
lemma integrable_of_is_O_exp_neg {f : ℝ → ℝ} {a b : ℝ} (h0 : 0 < b)
  (h1 : continuous_on f (Ici a)) (h2 : asymptotics.is_O f (λ x, exp (-b * x)) at_top) :
  integrable_on f (Ioi a) :=
begin
  cases h2.is_O_with with c h3,
  rw [asymptotics.is_O_with_iff, eventually_at_top] at h3,
  cases h3 with r bdr,
  let v := max a r,
  -- show integrable on `(a, v]` from continuity
  have int_left : integrable_on f (Ioc a v),
  { rw ←(interval_integrable_iff_integrable_Ioc_of_le (le_max_left a r)),
    have u : Icc a v ⊆ Ici a := Icc_subset_Ici_self,
    exact (h1.mono u).interval_integrable_of_Icc (le_max_left a r), },
  suffices : integrable_on f (Ioi v),
  { have t : integrable_on f (Ioc a v ∪ Ioi v) := integrable_on_union.mpr ⟨int_left, this⟩,
    simpa only [Ioc_union_Ioi_eq_Ioi, le_max_iff, le_refl, true_or] using t },
  -- now show integrable on `(v, ∞)` from asymptotic
  split,
  { exact (h1.mono $ Ioi_subset_Ici $ le_max_left a r).ae_strongly_measurable measurable_set_Ioi },
  have : has_finite_integral (λ x : ℝ, c * exp (-b * x)) (volume.restrict (Ioi v)),
  { exact (exp_neg_integrable_on_Ioi v h0).has_finite_integral.const_mul c },
  apply this.mono,
  refine (ae_restrict_iff' measurable_set_Ioi).mpr _,
  refine ae_of_all _ (λ x h1x, _),
  rw [norm_mul, norm_eq_abs],
  rw [mem_Ioi] at h1x,
  specialize bdr x ((le_max_right a r).trans h1x.le),
  exact bdr.trans (mul_le_mul_of_nonneg_right (le_abs_self c) (norm_nonneg _))
end


/-
Copyright (c) 2014 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Jeremy Avigad

! This file was ported from Lean 3 source module data.nat.dist
! leanprover-community/mathlib commit d50b12ae8e2bd910d08a94823976adae9825718b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Order.Basic

/-!
#  Distance function on ℕ

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

This file defines a simple distance function on naturals from truncated subtraction.
-/

namespace Nat

#print Nat.dist /-
/-- Distance (absolute value of difference) between natural numbers. -/
def dist (n m : ℕ) :=
  n - m + (m - n)
#align nat.dist Nat.dist
-/

#print Nat.dist.def /-
theorem dist.def (n m : ℕ) : dist n m = n - m + (m - n) :=
  rfl
#align nat.dist.def Nat.dist.def
-/

#print Nat.dist_comm /-
theorem dist_comm (n m : ℕ) : dist n m = dist m n := by simp [dist.def, add_comm]
#align nat.dist_comm Nat.dist_comm
-/

#print Nat.dist_self /-
@[simp]
theorem dist_self (n : ℕ) : dist n n = 0 := by simp [dist.def, tsub_self]
#align nat.dist_self Nat.dist_self
-/

#print Nat.eq_of_dist_eq_zero /-
theorem eq_of_dist_eq_zero {n m : ℕ} (h : dist n m = 0) : n = m :=
  have : n - m = 0 := Nat.eq_zero_of_add_eq_zero_right h
  have : n ≤ m := tsub_eq_zero_iff_le.mp this
  have : m - n = 0 := Nat.eq_zero_of_add_eq_zero_left h
  have : m ≤ n := tsub_eq_zero_iff_le.mp this
  le_antisymm ‹n ≤ m› ‹m ≤ n›
#align nat.eq_of_dist_eq_zero Nat.eq_of_dist_eq_zero
-/

#print Nat.dist_eq_zero /-
theorem dist_eq_zero {n m : ℕ} (h : n = m) : dist n m = 0 := by rw [h, dist_self]
#align nat.dist_eq_zero Nat.dist_eq_zero
-/

#print Nat.dist_eq_sub_of_le /-
theorem dist_eq_sub_of_le {n m : ℕ} (h : n ≤ m) : dist n m = m - n := by
  rw [dist.def, tsub_eq_zero_iff_le.mpr h, zero_add]
#align nat.dist_eq_sub_of_le Nat.dist_eq_sub_of_le
-/

#print Nat.dist_eq_sub_of_le_right /-
theorem dist_eq_sub_of_le_right {n m : ℕ} (h : m ≤ n) : dist n m = n - m := by rw [dist_comm];
  apply dist_eq_sub_of_le h
#align nat.dist_eq_sub_of_le_right Nat.dist_eq_sub_of_le_right
-/

#print Nat.dist_tri_left /-
theorem dist_tri_left (n m : ℕ) : m ≤ dist n m + n :=
  le_trans le_tsub_add (add_le_add_right (Nat.le_add_left _ _) _)
#align nat.dist_tri_left Nat.dist_tri_left
-/

#print Nat.dist_tri_right /-
theorem dist_tri_right (n m : ℕ) : m ≤ n + dist n m := by rw [add_comm] <;> apply dist_tri_left
#align nat.dist_tri_right Nat.dist_tri_right
-/

#print Nat.dist_tri_left' /-
theorem dist_tri_left' (n m : ℕ) : n ≤ dist n m + m := by rw [dist_comm] <;> apply dist_tri_left
#align nat.dist_tri_left' Nat.dist_tri_left'
-/

#print Nat.dist_tri_right' /-
theorem dist_tri_right' (n m : ℕ) : n ≤ m + dist n m := by rw [dist_comm] <;> apply dist_tri_right
#align nat.dist_tri_right' Nat.dist_tri_right'
-/

#print Nat.dist_zero_right /-
theorem dist_zero_right (n : ℕ) : dist n 0 = n :=
  Eq.trans (dist_eq_sub_of_le_right (zero_le n)) (tsub_zero n)
#align nat.dist_zero_right Nat.dist_zero_right
-/

#print Nat.dist_zero_left /-
theorem dist_zero_left (n : ℕ) : dist 0 n = n :=
  Eq.trans (dist_eq_sub_of_le (zero_le n)) (tsub_zero n)
#align nat.dist_zero_left Nat.dist_zero_left
-/

#print Nat.dist_add_add_right /-
theorem dist_add_add_right (n k m : ℕ) : dist (n + k) (m + k) = dist n m :=
  calc
    dist (n + k) (m + k) = n + k - (m + k) + (m + k - (n + k)) := rfl
    _ = n - m + (m + k - (n + k)) := by rw [add_tsub_add_eq_tsub_right]
    _ = n - m + (m - n) := by rw [add_tsub_add_eq_tsub_right]

#align nat.dist_add_add_right Nat.dist_add_add_right
-/

#print Nat.dist_add_add_left /-
theorem dist_add_add_left (k n m : ℕ) : dist (k + n) (k + m) = dist n m := by
  rw [add_comm k n, add_comm k m]; apply dist_add_add_right
#align nat.dist_add_add_left Nat.dist_add_add_left
-/

#print Nat.dist_eq_intro /-
theorem dist_eq_intro {n m k l : ℕ} (h : n + m = k + l) : dist n k = dist l m :=
  calc
    dist n k = dist (n + m) (k + m) := by rw [dist_add_add_right]
    _ = dist (k + l) (k + m) := by rw [h]
    _ = dist l m := by rw [dist_add_add_left]

#align nat.dist_eq_intro Nat.dist_eq_intro
-/

#print Nat.dist.triangle_inequality /-
theorem dist.triangle_inequality (n m k : ℕ) : dist n k ≤ dist n m + dist m k :=
  by
  have : dist n m + dist m k = n - m + (m - k) + (k - m + (m - n)) := by
    simp [dist.def, add_comm, add_left_comm]
  rw [this, dist.def]
  exact add_le_add tsub_le_tsub_add_tsub tsub_le_tsub_add_tsub
#align nat.dist.triangle_inequality Nat.dist.triangle_inequality
-/

#print Nat.dist_mul_right /-
theorem dist_mul_right (n k m : ℕ) : dist (n * k) (m * k) = dist n m * k := by
  rw [dist.def, dist.def, right_distrib, tsub_mul, tsub_mul]
#align nat.dist_mul_right Nat.dist_mul_right
-/

#print Nat.dist_mul_left /-
theorem dist_mul_left (k n m : ℕ) : dist (k * n) (k * m) = k * dist n m := by
  rw [mul_comm k n, mul_comm k m, dist_mul_right, mul_comm]
#align nat.dist_mul_left Nat.dist_mul_left
-/

#print Nat.dist_succ_succ /-
-- TODO(Jeremy): do when we have max and minx
--theorem dist_eq_max_sub_min {i j : nat} : dist i j = (max i j) - min i j :=
--sorry
/-
or.elim (lt_or_ge i j)
  (assume : i < j,
    by rw [max_eq_right_of_lt this, min_eq_left_of_lt this, dist_eq_sub_of_lt this])
  (assume : i ≥ j,
    by rw [max_eq_left this , min_eq_right this, dist_eq_sub_of_le_right this])
-/
theorem dist_succ_succ {i j : Nat} : dist (succ i) (succ j) = dist i j := by
  simp [dist.def, succ_sub_succ]
#align nat.dist_succ_succ Nat.dist_succ_succ
-/

#print Nat.dist_pos_of_ne /-
theorem dist_pos_of_ne {i j : Nat} : i ≠ j → 0 < dist i j := fun hne =>
  Nat.ltByCases
    (fun this : i < j => by rw [dist_eq_sub_of_le (le_of_lt this)]; apply tsub_pos_of_lt this)
    (fun this : i = j => by contradiction) fun this : i > j => by
    rw [dist_eq_sub_of_le_right (le_of_lt this)]; apply tsub_pos_of_lt this
#align nat.dist_pos_of_ne Nat.dist_pos_of_ne
-/

end Nat


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

This file defines Fibonacci numbers and their reductions mod `n`.
It was intended to make computation efficient, but does not
succeed very well.  Some better approaches were discussed on
Zulip by Mario and Kenny; they should be incorporated here.
-/

import data.real.basic data.fintype.basic algebra.big_operators data.nat.modeq
import tactic.find tactic.squeeze tactic.norm_num tactic.ring

namespace combinatorics

/- This is the basic definition of fibonacci numbers.  It
   is not good for efficient evaluation.
-/

def fibonacci : ℕ → ℕ
| 0 := 0
| 1 := 1
| (n + 2) := (fibonacci n) + (fibonacci (n + 1))

/- We now do a more efficient version, and prove that it is
   consistent with the original one.
-/

def fibonacci_step : ℕ × ℕ → ℕ × ℕ :=
 λ ⟨a,b⟩, ⟨b, a + b⟩

def fibonacci_pair : ℕ → ℕ × ℕ
| 0 := ⟨0,1⟩
| (n + 1) := fibonacci_step (fibonacci_pair n)

lemma fibonacci_pair_spec : ∀ n ,
 fibonacci_pair n = ⟨fibonacci n,fibonacci n.succ⟩
| 0 := rfl
| (nat.succ n) := begin
 rw[fibonacci_pair,fibonacci_pair_spec n,fibonacci_step,fibonacci],
 ext,refl,refl,
end

lemma fibonacci_from_pair (n : ℕ) :
 fibonacci n = (fibonacci_pair n).fst :=
  by rw[fibonacci_pair_spec n].

/- We now prove a fact about the fibonacci numbers mod 2.
   Later we will generalise this for an arbitrary modulus.
-/

lemma fibonacci_bodd_step (n : ℕ) :
 (fibonacci (n + 3)).bodd = (fibonacci n).bodd :=
begin
 rw[fibonacci,fibonacci,nat.bodd_add,nat.bodd_add],
 cases (fibonacci (n + 1)).bodd;
 cases (fibonacci n).bodd;
 refl,
end

lemma fibonacci_bodd : ∀ n, (fibonacci n).bodd = bnot (n % 3 = 0)
| 0 := rfl
| 1 := rfl
| 2 := rfl
| (n + 3) := begin
 rw[fibonacci_bodd_step n,fibonacci_bodd n,nat.add_mod_right]
end

/-
 We now do a more general theory of modular periodicity
 of fibonacci numbers.  For computational efficiency, we
 give an inductive definition of modular fibonacci numbers
 that does not require us to calculate the non-modular ones.
 We then prove that it is consistent with the original
 definition.
-/

def pair_mod (p : ℕ) : ℕ × ℕ → ℕ × ℕ :=
 λ ⟨a,b⟩, ⟨a % p,b % p⟩

lemma pair_mod_mod (p : ℕ) : ∀ (c : ℕ × ℕ),
 pair_mod p (pair_mod p c) = pair_mod p c :=
λ ⟨a,b⟩, by {simp[pair_mod,nat.mod_mod],}

def fibonacci_pair_mod (p : ℕ) : ℕ → ℕ × ℕ
| 0 := pair_mod p ⟨0,1⟩
| (n + 1) := pair_mod p (fibonacci_step (fibonacci_pair_mod n))

lemma fibonacci_pair_mod_mod (p : ℕ) : ∀ n,
 pair_mod p (fibonacci_pair_mod p n) = fibonacci_pair_mod p n
| 0 := by {rw[fibonacci_pair_mod,pair_mod_mod],}
| (n + 1) := by {rw[fibonacci_pair_mod,pair_mod_mod],}

lemma mod_step_mod (p : ℕ) : ∀ (c : ℕ × ℕ),
 pair_mod p (fibonacci_step c) =
  pair_mod p (fibonacci_step (pair_mod p c)) :=
λ ⟨a,b⟩, begin
 change (⟨b % p,(a + b) % p⟩ : ℕ × ℕ) =
  ⟨b % p % p,(a % p + b % p) % p⟩,
 have e0 : b % p % p = b % p := nat.mod_mod b p,
 have e1 : (a % p + b % p) % p = (a + b) % p :=
  nat.modeq.add (nat.mod_mod a p) (nat.mod_mod b p),
 rw[e0,e1],
end

lemma fibonacci_pair_mod_spec (p : ℕ) : ∀ n,
 fibonacci_pair_mod p n = pair_mod p (fibonacci_pair n)
| 0 := rfl
| (n + 1) := begin
 rw[fibonacci_pair_mod,fibonacci_pair,fibonacci_pair_mod_spec n],
 rw[← mod_step_mod],
end

lemma fibonacci_mod_spec (p : ℕ) (n : ℕ) :
 (fibonacci_pair_mod p n).fst = (fibonacci n) % p :=
begin
 rw[fibonacci_pair_mod_spec,fibonacci_pair_spec,pair_mod],
 refl,
end

lemma fibonacci_pair_period₀ {p : ℕ} {d : ℕ}
 (h : fibonacci_pair_mod p d = pair_mod p ⟨0,1⟩) :
  ∀ n, fibonacci_pair_mod p (n + d) = fibonacci_pair_mod p n
| 0 := by {rw[zero_add,h,fibonacci_pair_mod],}
| (n + 1) := by {
  rw[add_assoc,add_comm 1 d,← add_assoc],
  rw[fibonacci_pair_mod,fibonacci_pair_mod],
  rw[fibonacci_pair_period₀ n],
}

lemma fibonacci_pair_period₁ {p : ℕ} {d : ℕ}
 (h : fibonacci_pair_mod p d = pair_mod p ⟨0,1⟩) (m : ℕ) :
  ∀ n, fibonacci_pair_mod p (m + d * n) = fibonacci_pair_mod p m
| 0 := by {rw[mul_zero,add_zero]}
| (n + 1) := by {
  have : m + d * (n + 1) = (m + d * n) + d := by ring,
  rw[this,fibonacci_pair_period₀ h,fibonacci_pair_period₁],
}

lemma fibonacci_pair_period {p : ℕ} {d : ℕ}
 (h : fibonacci_pair_mod p d = pair_mod p ⟨0,1⟩) (n : ℕ) :
  fibonacci_pair_mod p n = fibonacci_pair_mod p (n % d) :=
calc
 fibonacci_pair_mod p n = fibonacci_pair_mod p (n % d + d * (n / d)) :
  congr_arg (fibonacci_pair_mod p) (nat.mod_add_div n d).symm
  ... = fibonacci_pair_mod p (n % d) : fibonacci_pair_period₁ h (n % d) (n / d)

lemma fibonacci_period  {p : ℕ} {d : ℕ}
 (h : fibonacci_pair_mod p d = pair_mod p ⟨0,1⟩) (n : ℕ) :
  (fibonacci n) ≡ (fibonacci (n % d)) [MOD p] :=
begin
 rw[nat.modeq,← fibonacci_mod_spec,← fibonacci_mod_spec],
 rw[fibonacci_pair_period],
 exact h,
end

/-
 Prove the identity

 (fibonacci n) = (choose n 0) + (choose n-1 1) + (choose n-2 2) + ...
-/

end combinatorics


import algebra.group

variable {G: Type*}

-- mathlib's constructor for `group` asks only for a (two-sided) identity
-- alongside a left inverse. This exercise shows it is possible to produce
-- both of those things if given a right identity and a right inverse.
theorem Q_12 (G: Type*) (mul: G → G → G) (e: G) (y: G → G):
  (∀ a b c: G, (mul (mul a b) c) = (mul a (mul b c))) ∧
  (∀ a: G, mul a e = a) ∧
  (∀ a: G, mul a (y a) = e)
  → group G :=
λ ⟨h1, ⟨h2, h3⟩⟩, begin

  -- the right inverse is also a left inverse
  have h4: ∀ a: G, mul (y a) a = e, from λ a, calc
  mul (y a) a
    = mul (mul (y a) a) e                              : (h2 _).symm
... = mul (mul (y a) a) (mul (y a) (y (y a))) : by rw ←h3
... = mul (y a) (mul a (mul (y a) (y (y a)))) : h1 _ _ _
... = mul (y a) (mul (mul a (y a)) (y (y a))) : by rw h1
... = mul (y a) (mul e (y (y a)))                : by rw h3
... = mul (mul (y a) e) (y (y a))                : by rw ←h1
... = mul (y a) (y (y a))                        : by rw h2
... = e                                                   : h3 _,

  -- the right identity is also the left identity
  have h5: ∀ a: G, mul e a = a, from λ a, calc
  mul e a
    = mul (mul a (y a)) a : by rw h3
... = mul a (mul (y a) a) : h1 _ _ _
... = mul a e                : by rw h4
... = a                      : h2 _,

  -- we have now shown everything we need to
  -- synthesise an instance of group G:
  exact {
    mul := mul,
    mul_assoc := h1,
    one := e,
    one_mul := h5,
    mul_one := h2,
    inv := y,
    mul_left_inv := h4
  },
end


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

/-!
# 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 αᵒᵈ :=
⟨λ a, @exists_not_le α _ _ a⟩

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

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

instance order_dual.no_max_order (α : Type*) [has_lt α] [no_min_order α] : no_max_order αᵒᵈ :=
⟨λ 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 : αᵒᵈ} : is_bot (of_dual a) ↔ is_top a := iff.rfl
@[simp] lemma is_top_of_dual_iff {a : αᵒᵈ} : is_top (of_dual a) ↔ is_bot a := iff.rfl
@[simp] lemma is_min_of_dual_iff {a : αᵒᵈ} : is_min (of_dual a) ↔ is_max a := iff.rfl
@[simp] lemma is_max_of_dual_iff {a : αᵒᵈ} : 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
@[simp] lemma not_is_min_of_lt (h : b < a) : ¬ is_min a := λ ha, ha.not_lt h
@[simp] lemma not_is_max_of_lt (h : a < b) : ¬ is_max a := λ ha, ha.not_lt h

alias not_is_min_of_lt ← has_lt.lt.not_is_min
alias not_is_max_of_lt ← has_lt.lt.not_is_max

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 prod
variables [preorder α] [preorder β] {a a₁ a₂ : α} {b b₁ b₂ : β} {x y : α × β}

lemma is_bot.prod_mk (ha : is_bot a) (hb : is_bot b) : is_bot (a, b) := λ c, ⟨ha _, hb _⟩
lemma is_top.prod_mk (ha : is_top a) (hb : is_top b) : is_top (a, b) := λ c, ⟨ha _, hb _⟩
lemma is_min.prod_mk (ha : is_min a) (hb : is_min b) : is_min (a, b) := λ c hc, ⟨ha hc.1, hb hc.2⟩
lemma is_max.prod_mk (ha : is_max a) (hb : is_max b) : is_max (a, b) := λ c hc, ⟨ha hc.1, hb hc.2⟩

lemma is_bot.fst (hx : is_bot x) : is_bot x.1 := λ c, (hx (c, x.2)).1
lemma is_bot.snd (hx : is_bot x) : is_bot x.2 := λ c, (hx (x.1, c)).2
lemma is_top.fst (hx : is_top x) : is_top x.1 := λ c, (hx (c, x.2)).1
lemma is_top.snd (hx : is_top x) : is_top x.2 := λ c, (hx (x.1, c)).2

lemma is_min.fst (hx : is_min x) : is_min x.1 :=
λ c hc, (hx $ show (c, x.2) ≤ x, from (and_iff_left le_rfl).2 hc).1

lemma is_min.snd (hx : is_min x) : is_min x.2 :=
λ c hc, (hx $ show (x.1, c) ≤ x, from (and_iff_right le_rfl).2 hc).2

lemma is_max.fst (hx : is_max x) : is_max x.1 :=
λ c hc, (hx $ show x ≤ (c, x.2), from (and_iff_left le_rfl).2 hc).1

lemma is_max.snd (hx : is_max x) : is_max x.2 :=
λ c hc, (hx $ show x ≤ (x.1, c), from (and_iff_right le_rfl).2 hc).2

lemma prod.is_bot_iff : is_bot x ↔ is_bot x.1 ∧ is_bot x.2 :=
⟨λ hx, ⟨hx.fst, hx.snd⟩, λ h, h.1.prod_mk h.2⟩

lemma prod.is_top_iff : is_top x ↔ is_top x.1 ∧ is_top x.2 :=
⟨λ hx, ⟨hx.fst, hx.snd⟩, λ h, h.1.prod_mk h.2⟩

lemma prod.is_min_iff : is_min x ↔ is_min x.1 ∧ is_min x.2 :=
⟨λ hx, ⟨hx.fst, hx.snd⟩, λ h, h.1.prod_mk h.2⟩

lemma prod.is_max_iff : is_max x ↔ is_max x.1 ∧ is_max x.2 :=
⟨λ hx, ⟨hx.fst, hx.snd⟩, λ h, h.1.prod_mk h.2⟩

end prod