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

! This file was ported from Lean 3 source module order.succ_pred.basic
! leanprover-community/mathlib commit 0111834459f5d7400215223ea95ae38a1265a907
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.CompleteLattice
import Mathlib.Order.Cover
import Mathlib.Order.Iterate

/-!
# Successor and predecessor

This file defines successor and predecessor orders. `succ a`, the successor of an element `a : α` is
the least element greater than `a`. `pred a` is the greatest element less than `a`. Typical examples
include `ℕ`, `ℤ`, `ℕ+`, `Fin n`, but also `ENat`, the lexicographic order of a successor/predecessor
order...

## Typeclasses

* `SuccOrder`: Order equipped with a sensible successor function.
* `PredOrder`: Order equipped with a sensible predecessor function.
* `IsSuccArchimedean`: `SuccOrder` where `succ` iterated to an element gives all the greater
  ones.
* `IsPredArchimedean`: `PredOrder` where `pred` iterated to an element gives all the smaller
  ones.

## Implementation notes

Maximal elements don't have a sensible successor. Thus the naïve typeclass
```lean
class NaiveSuccOrder (α : Type _) [Preorder α] :=
(succ : α → α)
(succ_le_iff : ∀ {a b}, succ a ≤ b ↔ a < b)
(lt_succ_iff : ∀ {a b}, a < succ b ↔ a ≤ b)
```
can't apply to an `OrderTop` because plugging in `a = b = ⊤` into either of `succ_le_iff` and
`lt_succ_iff` yields `⊤ < ⊤` (or more generally `m < m` for a maximal element `m`).
The solution taken here is to remove the implications `≤ → <` and instead require that `a < succ a`
for all non maximal elements (enforced by the combination of `le_succ` and the contrapositive of
`max_of_succ_le`).
The stricter condition of every element having a sensible successor can be obtained through the
combination of `SuccOrder α` and `NoMaxOrder α`.

## TODO

Is `GaloisConnection pred succ` always true? If not, we should introduce
```lean
class SuccPredOrder (α : Type _) [Preorder α] extends SuccOrder α, PredOrder α :=
(pred_succ_gc : GaloisConnection (pred : α → α) succ)
```
`covby` should help here.
-/

open Function OrderDual Set

variable {α : Type _}

/-- Order equipped with a sensible successor function. -/
@[ext]
class SuccOrder (α : Type _) [Preorder α] where
  /--Successor function-/
  succ : α → α
  /--Proof of basic ordering with respect to `succ`-/
  le_succ : ∀ a, a ≤ succ a
  /--Proof of interaction between `succ` and maximal element-/
  max_of_succ_le {a} : succ a ≤ a → IsMax a
  /--Proof that `succ` satifies ordering invariants betweeen `LT` and `LE`-/
  succ_le_of_lt {a b} : a < b → succ a ≤ b
  /--Proof that `succ` satifies ordering invariants betweeen `LE` and `LT`-/
  le_of_lt_succ {a b} : a < succ b → a ≤ b
#align succ_order SuccOrder
#align succ_order.ext_iff SuccOrder.ext_iff
#align succ_order.ext SuccOrder.ext

/-- Order equipped with a sensible predecessor function. -/
@[ext]
class PredOrder (α : Type _) [Preorder α] where
  /--Predecessor function-/
  pred : α → α
  /--Proof of basic ordering with respect to `pred`-/
  pred_le : ∀ a, pred a ≤ a
  /--Proof of interaction between `pred` and minimal element-/
  min_of_le_pred {a} : a ≤ pred a → IsMin a
  /--Proof that `pred` satifies ordering invariants betweeen `LT` and `LE`-/
  le_pred_of_lt {a b} : a < b → a ≤ pred b
  /--Proof that `pred` satifies ordering invariants betweeen `LE` and `LT`-/
  le_of_pred_lt {a b} : pred a < b → a ≤ b
#align pred_order PredOrder
#align pred_order.ext PredOrder.ext
#align pred_order.ext_iff PredOrder.ext_iff

instance [Preorder α] [SuccOrder α] :
    PredOrder αᵒᵈ where
  pred := toDual ∘ SuccOrder.succ ∘ ofDual
  pred_le := by
    simp only [comp, OrderDual.forall, ofDual_toDual, toDual_le_toDual,
     SuccOrder.le_succ, implies_true]
  min_of_le_pred h := by apply SuccOrder.max_of_succ_le h
  le_pred_of_lt := by intro a b h; exact SuccOrder.succ_le_of_lt h
  le_of_pred_lt := SuccOrder.le_of_lt_succ

instance [Preorder α] [PredOrder α] :
    SuccOrder αᵒᵈ where
  succ := toDual ∘ PredOrder.pred ∘ ofDual
  le_succ := by
    simp only [comp, OrderDual.forall, ofDual_toDual, toDual_le_toDual,
     PredOrder.pred_le, implies_true]
  max_of_succ_le h := by apply PredOrder.min_of_le_pred h
  succ_le_of_lt := by intro a b h; exact PredOrder.le_pred_of_lt h
  le_of_lt_succ := PredOrder.le_of_pred_lt

section Preorder

variable [Preorder α]

/-- A constructor for `SuccOrder α` usable when `α` has no maximal element. -/
def SuccOrder.ofSuccLeIffOfLeLtSucc (succ : α → α) (hsucc_le_iff : ∀ {a b}, succ a ≤ b ↔ a < b)
    (hle_of_lt_succ : ∀ {a b}, a < succ b → a ≤ b) : SuccOrder α :=
  { succ
    le_succ := fun _ => (hsucc_le_iff.1 le_rfl).le
    max_of_succ_le := fun ha => (lt_irrefl _ <| hsucc_le_iff.1 ha).elim
    succ_le_of_lt := fun h => hsucc_le_iff.2 h
    le_of_lt_succ := fun h => hle_of_lt_succ h}
#align succ_order.of_succ_le_iff_of_le_lt_succ SuccOrder.ofSuccLeIffOfLeLtSucc

/-- A constructor for `PredOrder α` usable when `α` has no minimal element. -/
def PredOrder.ofLePredIffOfPredLePred (pred : α → α) (hle_pred_iff : ∀ {a b}, a ≤ pred b ↔ a < b)
    (hle_of_pred_lt : ∀ {a b}, pred a < b → a ≤ b) : PredOrder α :=
  { pred
    pred_le := fun _ => (hle_pred_iff.1 le_rfl).le
    min_of_le_pred := fun ha => (lt_irrefl _ <| hle_pred_iff.1 ha).elim
    le_pred_of_lt := fun h => hle_pred_iff.2 h
    le_of_pred_lt := fun h => hle_of_pred_lt h }
#align pred_order.of_le_pred_iff_of_pred_le_pred PredOrder.ofLePredIffOfPredLePred

end Preorder

section LinearOrder

variable [LinearOrder α]

/-- A constructor for `SuccOrder α` for `α` a linear order. -/
@[simps]
def SuccOrder.ofCore (succ : α → α) (hn : ∀ {a}, ¬IsMax a → ∀ b, a < b ↔ succ a ≤ b)
    (hm : ∀ a, IsMax a → succ a = a) : SuccOrder α :=
  { succ
    succ_le_of_lt := fun {a b} =>
      by_cases (fun h hab => (hm a h).symm ▸ hab.le) fun h => (hn h b).mp
    le_succ := fun a =>
      by_cases (fun h => (hm a h).symm.le) fun h => le_of_lt <| by simpa using (hn h a).not
    le_of_lt_succ := fun {a b} hab =>
      by_cases (fun h => hm b h ▸ hab.le) fun h => by simpa [hab] using (hn h a).not
    max_of_succ_le := fun {a} => not_imp_not.mp fun h => by simpa using (hn h a).not }
#align succ_order.of_core SuccOrder.ofCore
#align succ_order.of_core_succ SuccOrder.ofCore_succ

/-- A constructor for `PredOrder α` for `α` a linear order. -/
@[simps]
def PredOrder.ofCore {α} [LinearOrder α] (pred : α → α)
    (hn : ∀ {a}, ¬IsMin a → ∀ b, b ≤ pred a ↔ b < a) (hm : ∀ a, IsMin a → pred a = a) :
    PredOrder α :=
  { pred
    le_pred_of_lt := fun {a b} =>
      by_cases (fun h hab => (hm b h).symm ▸ hab.le) fun h => (hn h a).mpr
    pred_le := fun a =>
      by_cases (fun h => (hm a h).le) fun h => le_of_lt <| by simpa using (hn h a).not
    le_of_pred_lt :=  fun {a b} hab =>
      by_cases (fun h => hm a h ▸ hab.le) fun h => by simpa [hab] using (hn h b).not
    min_of_le_pred := fun {a} => not_imp_not.mp fun h => by simpa using (hn h a).not }
#align pred_order.of_core PredOrder.ofCore
#align pred_order.of_core_pred PredOrder.ofCore_pred

/-- A constructor for `SuccOrder α` usable when `α` is a linear order with no maximal element. -/
def SuccOrder.ofSuccLeIff (succ : α → α) (hsucc_le_iff : ∀ {a b}, succ a ≤ b ↔ a < b) :
    SuccOrder α :=
  { succ
    le_succ := fun _ => (hsucc_le_iff.1 le_rfl).le
    max_of_succ_le := fun ha => (lt_irrefl _ <| hsucc_le_iff.1 ha).elim
    succ_le_of_lt := fun h => hsucc_le_iff.2 h
    le_of_lt_succ := fun {_ _} h => le_of_not_lt ((not_congr hsucc_le_iff).1 h.not_le) }
#align succ_order.of_succ_le_iff SuccOrder.ofSuccLeIff

/-- A constructor for `PredOrder α` usable when `α` is a linear order with no minimal element. -/
def PredOrder.ofLePredIff (pred : α → α) (hle_pred_iff : ∀ {a b}, a ≤ pred b ↔ a < b) :
    PredOrder α :=
  { pred
    pred_le := fun _ => (hle_pred_iff.1 le_rfl).le
    min_of_le_pred := fun ha => (lt_irrefl _ <| hle_pred_iff.1 ha).elim
    le_pred_of_lt := fun h => hle_pred_iff.2 h
    le_of_pred_lt := fun {_ _} h => le_of_not_lt ((not_congr hle_pred_iff).1 h.not_le) }
#align pred_order.of_le_pred_iff PredOrder.ofLePredIff

end LinearOrder

/-! ### Successor order -/

namespace Order

section Preorder

variable [Preorder α] [SuccOrder α] {a b : α}

/-- The successor of an element. If `a` is not maximal, then `succ a` is the least element greater
than `a`. If `a` is maximal, then `succ a = a`. -/
def succ : α → α :=
  SuccOrder.succ
#align order.succ Order.succ

theorem le_succ : ∀ a : α, a ≤ succ a :=
  SuccOrder.le_succ
#align order.le_succ Order.le_succ

theorem max_of_succ_le {a : α} : succ a ≤ a → IsMax a :=
  SuccOrder.max_of_succ_le
#align order.max_of_succ_le Order.max_of_succ_le

theorem succ_le_of_lt {a b : α} : a < b → succ a ≤ b :=
  SuccOrder.succ_le_of_lt
#align order.succ_le_of_lt Order.succ_le_of_lt

theorem le_of_lt_succ {a b : α} : a < succ b → a ≤ b :=
  SuccOrder.le_of_lt_succ
#align order.le_of_lt_succ Order.le_of_lt_succ

@[simp]
theorem succ_le_iff_isMax : succ a ≤ a ↔ IsMax a :=
  ⟨max_of_succ_le, fun h => h <| le_succ _⟩
#align order.succ_le_iff_is_max Order.succ_le_iff_isMax

@[simp]
theorem lt_succ_iff_not_isMax : a < succ a ↔ ¬IsMax a :=
  ⟨not_isMax_of_lt, fun ha => (le_succ a).lt_of_not_le fun h => ha <| max_of_succ_le h⟩
#align order.lt_succ_iff_not_is_max Order.lt_succ_iff_not_isMax

alias lt_succ_iff_not_isMax ↔ _ lt_succ_of_not_isMax
#align order.lt_succ_of_not_is_max Order.lt_succ_of_not_isMax

theorem wcovby_succ (a : α) : a ⩿ succ a :=
  ⟨le_succ a, fun _ hb => (succ_le_of_lt hb).not_lt⟩
#align order.wcovby_succ Order.wcovby_succ

theorem covby_succ_of_not_isMax (h : ¬IsMax a) : a ⋖ succ a :=
  (wcovby_succ a).covby_of_lt <| lt_succ_of_not_isMax h
#align order.covby_succ_of_not_is_max Order.covby_succ_of_not_isMax

theorem lt_succ_iff_of_not_isMax (ha : ¬IsMax a) : b < succ a ↔ b ≤ a :=
  ⟨le_of_lt_succ, fun h => h.trans_lt <| lt_succ_of_not_isMax ha⟩
#align order.lt_succ_iff_of_not_is_max Order.lt_succ_iff_of_not_isMax

theorem succ_le_iff_of_not_isMax (ha : ¬IsMax a) : succ a ≤ b ↔ a < b :=
  ⟨(lt_succ_of_not_isMax ha).trans_le, succ_le_of_lt⟩
#align order.succ_le_iff_of_not_is_max Order.succ_le_iff_of_not_isMax

theorem succ_lt_succ_iff_of_not_isMax (ha : ¬IsMax a) (hb : ¬IsMax b) : succ a < succ b ↔ a < b :=
  by rw [lt_succ_iff_of_not_isMax hb, succ_le_iff_of_not_isMax ha]
#align order.succ_lt_succ_iff_of_not_is_max Order.succ_lt_succ_iff_of_not_isMax

theorem succ_le_succ_iff_of_not_isMax (ha : ¬IsMax a) (hb : ¬IsMax b) : succ a ≤ succ b ↔ a ≤ b :=
  by rw [succ_le_iff_of_not_isMax ha, lt_succ_iff_of_not_isMax hb]
#align order.succ_le_succ_iff_of_not_is_max Order.succ_le_succ_iff_of_not_isMax

@[simp, mono]
theorem succ_le_succ (h : a ≤ b) : succ a ≤ succ b := by
  by_cases hb : IsMax b
  · by_cases hba : b ≤ a
    · exact (hb <| hba.trans <| le_succ _).trans (le_succ _)
    · exact succ_le_of_lt ((h.lt_of_not_le hba).trans_le <| le_succ b)
  · rwa [succ_le_iff_of_not_isMax fun ha => hb <| ha.mono h, lt_succ_iff_of_not_isMax hb]
#align order.succ_le_succ Order.succ_le_succ

theorem succ_mono : Monotone (succ : α → α) := fun _ _ => succ_le_succ
#align order.succ_mono Order.succ_mono

theorem le_succ_iterate (k : ℕ) (x : α) : x ≤ (succ^[k]) x := by
  conv_lhs => rw [(by simp only [Function.iterate_id, id.def] : x = (id^[k]) x)]
  exact Monotone.le_iterate_of_le succ_mono le_succ k x
#align order.le_succ_iterate Order.le_succ_iterate

theorem isMax_iterate_succ_of_eq_of_lt {n m : ℕ} (h_eq : (succ^[n]) a = (succ^[m]) a)
    (h_lt : n < m) : IsMax ((succ^[n]) a) := by
  refine' max_of_succ_le (le_trans _ h_eq.symm.le)
  have : succ ((succ^[n]) a) = (succ^[n + 1]) a := by rw [Function.iterate_succ', comp]
  rw [this]
  have h_le : n + 1 ≤ m := Nat.succ_le_of_lt h_lt
  exact Monotone.monotone_iterate_of_le_map succ_mono (le_succ a) h_le
#align order.is_max_iterate_succ_of_eq_of_lt Order.isMax_iterate_succ_of_eq_of_lt

theorem isMax_iterate_succ_of_eq_of_ne {n m : ℕ} (h_eq : (succ^[n]) a = (succ^[m]) a)
    (h_ne : n ≠ m) : IsMax ((succ^[n]) a) := by
  cases' le_total n m with h h
  · exact isMax_iterate_succ_of_eq_of_lt h_eq (lt_of_le_of_ne h h_ne)
  · rw [h_eq]
    exact isMax_iterate_succ_of_eq_of_lt h_eq.symm (lt_of_le_of_ne h h_ne.symm)
#align order.is_max_iterate_succ_of_eq_of_ne Order.isMax_iterate_succ_of_eq_of_ne

theorem Iio_succ_of_not_isMax (ha : ¬IsMax a) : Iio (succ a) = Iic a :=
  Set.ext fun _ => lt_succ_iff_of_not_isMax ha
#align order.Iio_succ_of_not_is_max Order.Iio_succ_of_not_isMax

theorem Ici_succ_of_not_isMax (ha : ¬IsMax a) : Ici (succ a) = Ioi a :=
  Set.ext fun _ => succ_le_iff_of_not_isMax ha
#align order.Ici_succ_of_not_is_max Order.Ici_succ_of_not_isMax

theorem Ico_succ_right_of_not_isMax (hb : ¬IsMax b) : Ico a (succ b) = Icc a b := by
  rw [← Ici_inter_Iio, Iio_succ_of_not_isMax hb, Ici_inter_Iic]
#align order.Ico_succ_right_of_not_is_max Order.Ico_succ_right_of_not_isMax

theorem Ioo_succ_right_of_not_isMax (hb : ¬IsMax b) : Ioo a (succ b) = Ioc a b := by
  rw [← Ioi_inter_Iio, Iio_succ_of_not_isMax hb, Ioi_inter_Iic]
#align order.Ioo_succ_right_of_not_is_max Order.Ioo_succ_right_of_not_isMax

theorem Icc_succ_left_of_not_isMax (ha : ¬IsMax a) : Icc (succ a) b = Ioc a b := by
  rw [← Ici_inter_Iic, Ici_succ_of_not_isMax ha, Ioi_inter_Iic]
#align order.Icc_succ_left_of_not_is_max Order.Icc_succ_left_of_not_isMax

theorem Ico_succ_left_of_not_isMax (ha : ¬IsMax a) : Ico (succ a) b = Ioo a b := by
  rw [← Ici_inter_Iio, Ici_succ_of_not_isMax ha, Ioi_inter_Iio]
#align order.Ico_succ_left_of_not_is_max Order.Ico_succ_left_of_not_isMax

section NoMaxOrder

variable [NoMaxOrder α]

theorem lt_succ (a : α) : a < succ a :=
  lt_succ_of_not_isMax <| not_isMax a
#align order.lt_succ Order.lt_succ

@[simp]
theorem lt_succ_iff : a < succ b ↔ a ≤ b :=
  lt_succ_iff_of_not_isMax <| not_isMax b
#align order.lt_succ_iff Order.lt_succ_iff

@[simp]
theorem succ_le_iff : succ a ≤ b ↔ a < b :=
  succ_le_iff_of_not_isMax <| not_isMax a
#align order.succ_le_iff Order.succ_le_iff

theorem succ_le_succ_iff : succ a ≤ succ b ↔ a ≤ b := by simp
#align order.succ_le_succ_iff Order.succ_le_succ_iff

theorem succ_lt_succ_iff : succ a < succ b ↔ a < b := by simp
#align order.succ_lt_succ_iff Order.succ_lt_succ_iff

alias succ_le_succ_iff ↔ le_of_succ_le_succ _
#align order.le_of_succ_le_succ Order.le_of_succ_le_succ

alias succ_lt_succ_iff ↔ lt_of_succ_lt_succ succ_lt_succ
#align order.lt_of_succ_lt_succ Order.lt_of_succ_lt_succ
#align order.succ_lt_succ Order.succ_lt_succ

theorem succ_strictMono : StrictMono (succ : α → α) := fun _ _ => succ_lt_succ
#align order.succ_strict_mono Order.succ_strictMono

theorem covby_succ (a : α) : a ⋖ succ a :=
  covby_succ_of_not_isMax <| not_isMax a
#align order.covby_succ Order.covby_succ

@[simp]
theorem Iio_succ (a : α) : Iio (succ a) = Iic a :=
  Iio_succ_of_not_isMax <| not_isMax _
#align order.Iio_succ Order.Iio_succ

@[simp]
theorem Ici_succ (a : α) : Ici (succ a) = Ioi a :=
  Ici_succ_of_not_isMax <| not_isMax _
#align order.Ici_succ Order.Ici_succ

@[simp]
theorem Ico_succ_right (a b : α) : Ico a (succ b) = Icc a b :=
  Ico_succ_right_of_not_isMax <| not_isMax _
#align order.Ico_succ_right Order.Ico_succ_right

@[simp]
theorem Ioo_succ_right (a b : α) : Ioo a (succ b) = Ioc a b :=
  Ioo_succ_right_of_not_isMax <| not_isMax _
#align order.Ioo_succ_right Order.Ioo_succ_right

@[simp]
theorem Icc_succ_left (a b : α) : Icc (succ a) b = Ioc a b :=
  Icc_succ_left_of_not_isMax <| not_isMax _
#align order.Icc_succ_left Order.Icc_succ_left

@[simp]
theorem Ico_succ_left (a b : α) : Ico (succ a) b = Ioo a b :=
  Ico_succ_left_of_not_isMax <| not_isMax _
#align order.Ico_succ_left Order.Ico_succ_left

end NoMaxOrder

end Preorder

section PartialOrder

variable [PartialOrder α] [SuccOrder α] {a b : α}

@[simp]
theorem succ_eq_iff_isMax : succ a = a ↔ IsMax a :=
  ⟨fun h => max_of_succ_le h.le, fun h => h.eq_of_ge <| le_succ _⟩
#align order.succ_eq_iff_is_max Order.succ_eq_iff_isMax

alias succ_eq_iff_isMax ↔ _ _root_.IsMax.succ_eq
#align is_max.succ_eq IsMax.succ_eq

theorem succ_eq_succ_iff_of_not_isMax (ha : ¬IsMax a) (hb : ¬IsMax b) :
    succ a = succ b ↔ a = b := by
  rw [eq_iff_le_not_lt, eq_iff_le_not_lt, succ_le_succ_iff_of_not_isMax ha hb,
    succ_lt_succ_iff_of_not_isMax ha hb]
#align order.succ_eq_succ_iff_of_not_is_max Order.succ_eq_succ_iff_of_not_isMax

theorem le_le_succ_iff : a ≤ b ∧ b ≤ succ a ↔ b = a ∨ b = succ a := by
  refine'
    ⟨fun h =>
      or_iff_not_imp_left.2 fun hba : b ≠ a =>
        h.2.antisymm (succ_le_of_lt <| h.1.lt_of_ne <| hba.symm),
      _⟩
  rintro (rfl | rfl)
  · exact ⟨le_rfl, le_succ b⟩
  · exact ⟨le_succ a, le_rfl⟩
#align order.le_le_succ_iff Order.le_le_succ_iff

theorem Covby.succ_eq (h : a ⋖ b) : succ a = b :=
  (succ_le_of_lt h.lt).eq_of_not_lt fun h' => h.2 (lt_succ_of_not_isMax h.lt.not_isMax) h'
#align covby.succ_eq Order.Covby.succ_eq

theorem Wcovby.le_succ (h : a ⩿ b) : b ≤ succ a := by
  obtain h | rfl := h.covby_or_eq
  · exact (Covby.succ_eq h).ge
  · exact le_succ _
#align wcovby.le_succ Order.Wcovby.le_succ

theorem le_succ_iff_eq_or_le : a ≤ succ b ↔ a = succ b ∨ a ≤ b := by
  by_cases hb : IsMax b
  · rw [hb.succ_eq, or_iff_right_of_imp le_of_eq]
  · rw [← lt_succ_iff_of_not_isMax hb, le_iff_eq_or_lt]
#align order.le_succ_iff_eq_or_le Order.le_succ_iff_eq_or_le

theorem lt_succ_iff_eq_or_lt_of_not_isMax (hb : ¬IsMax b) : a < succ b ↔ a = b ∨ a < b :=
  (lt_succ_iff_of_not_isMax hb).trans le_iff_eq_or_lt
#align order.lt_succ_iff_eq_or_lt_of_not_is_max Order.lt_succ_iff_eq_or_lt_of_not_isMax

theorem Iic_succ (a : α) : Iic (succ a) = insert (succ a) (Iic a) :=
  ext fun _ => le_succ_iff_eq_or_le
#align order.Iic_succ Order.Iic_succ

theorem Icc_succ_right (h : a ≤ succ b) : Icc a (succ b) = insert (succ b) (Icc a b) := by
  simp_rw [← Ici_inter_Iic, Iic_succ, inter_insert_of_mem (mem_Ici.2 h)]
#align order.Icc_succ_right Order.Icc_succ_right

theorem Ioc_succ_right (h : a < succ b) : Ioc a (succ b) = insert (succ b) (Ioc a b) := by
  simp_rw [← Ioi_inter_Iic, Iic_succ, inter_insert_of_mem (mem_Ioi.2 h)]
#align order.Ioc_succ_right Order.Ioc_succ_right

theorem Iio_succ_eq_insert_of_not_isMax (h : ¬IsMax a) : Iio (succ a) = insert a (Iio a) :=
  ext fun _ => lt_succ_iff_eq_or_lt_of_not_isMax h
#align order.Iio_succ_eq_insert_of_not_is_max Order.Iio_succ_eq_insert_of_not_isMax

theorem Ico_succ_right_eq_insert_of_not_isMax (h₁ : a ≤ b) (h₂ : ¬IsMax b) :
    Ico a (succ b) = insert b (Ico a b) := by
  simp_rw [← Iio_inter_Ici, Iio_succ_eq_insert_of_not_isMax h₂, insert_inter_of_mem (mem_Ici.2 h₁)]
#align order.Ico_succ_right_eq_insert_of_not_is_max Order.Ico_succ_right_eq_insert_of_not_isMax

theorem Ioo_succ_right_eq_insert_of_not_isMax (h₁ : a < b) (h₂ : ¬IsMax b) :
    Ioo a (succ b) = insert b (Ioo a b) := by
  simp_rw [← Iio_inter_Ioi, Iio_succ_eq_insert_of_not_isMax h₂, insert_inter_of_mem (mem_Ioi.2 h₁)]
#align order.Ioo_succ_right_eq_insert_of_not_is_max Order.Ioo_succ_right_eq_insert_of_not_isMax

section NoMaxOrder

variable [NoMaxOrder α]

@[simp]
theorem succ_eq_succ_iff : succ a = succ b ↔ a = b :=
  succ_eq_succ_iff_of_not_isMax (not_isMax a) (not_isMax b)
#align order.succ_eq_succ_iff Order.succ_eq_succ_iff

theorem succ_injective : Injective (succ : α → α) := fun _ _ => succ_eq_succ_iff.1
#align order.succ_injective Order.succ_injective

theorem succ_ne_succ_iff : succ a ≠ succ b ↔ a ≠ b :=
  succ_injective.ne_iff
#align order.succ_ne_succ_iff Order.succ_ne_succ_iff

alias succ_ne_succ_iff ↔ _ succ_ne_succ
#align order.succ_ne_succ Order.succ_ne_succ

theorem lt_succ_iff_eq_or_lt : a < succ b ↔ a = b ∨ a < b :=
  lt_succ_iff.trans le_iff_eq_or_lt
#align order.lt_succ_iff_eq_or_lt Order.lt_succ_iff_eq_or_lt

theorem succ_eq_iff_covby : succ a = b ↔ a ⋖ b :=
  ⟨by
    rintro rfl
    exact covby_succ _, Covby.succ_eq⟩
#align order.succ_eq_iff_covby Order.succ_eq_iff_covby

theorem Iio_succ_eq_insert (a : α) : Iio (succ a) = insert a (Iio a) :=
  Iio_succ_eq_insert_of_not_isMax <| not_isMax a
#align order.Iio_succ_eq_insert Order.Iio_succ_eq_insert

theorem Ico_succ_right_eq_insert (h : a ≤ b) : Ico a (succ b) = insert b (Ico a b) :=
  Ico_succ_right_eq_insert_of_not_isMax h <| not_isMax b
#align order.Ico_succ_right_eq_insert Order.Ico_succ_right_eq_insert

theorem Ioo_succ_right_eq_insert (h : a < b) : Ioo a (succ b) = insert b (Ioo a b) :=
  Ioo_succ_right_eq_insert_of_not_isMax h <| not_isMax b
#align order.Ioo_succ_right_eq_insert Order.Ioo_succ_right_eq_insert

end NoMaxOrder

section OrderTop

variable [OrderTop α]

@[simp]
theorem succ_top : succ (⊤ : α) = ⊤ := by
  rw [succ_eq_iff_isMax, isMax_iff_eq_top]
#align order.succ_top Order.succ_top

--Porting note: removing @[simp],`simp` can prove it
theorem succ_le_iff_eq_top : succ a ≤ a ↔ a = ⊤ :=
  succ_le_iff_isMax.trans isMax_iff_eq_top
#align order.succ_le_iff_eq_top Order.succ_le_iff_eq_top

--Porting note: removing @[simp],`simp` can prove it
theorem lt_succ_iff_ne_top : a < succ a ↔ a ≠ ⊤ :=
  lt_succ_iff_not_isMax.trans not_isMax_iff_ne_top
#align order.lt_succ_iff_ne_top Order.lt_succ_iff_ne_top

end OrderTop

section OrderBot

variable [OrderBot α]

--Porting note: removing @[simp],`simp` can prove it
theorem lt_succ_bot_iff [NoMaxOrder α] : a < succ ⊥ ↔ a = ⊥ := by rw [lt_succ_iff, le_bot_iff]
#align order.lt_succ_bot_iff Order.lt_succ_bot_iff

theorem le_succ_bot_iff : a ≤ succ ⊥ ↔ a = ⊥ ∨ a = succ ⊥ := by
  rw [le_succ_iff_eq_or_le, le_bot_iff, or_comm]
#align order.le_succ_bot_iff Order.le_succ_bot_iff

variable [Nontrivial α]

theorem bot_lt_succ (a : α) : ⊥ < succ a :=
  (lt_succ_of_not_isMax not_isMax_bot).trans_le <| succ_mono bot_le
#align order.bot_lt_succ Order.bot_lt_succ

theorem succ_ne_bot (a : α) : succ a ≠ ⊥ :=
  (bot_lt_succ a).ne'
#align order.succ_ne_bot Order.succ_ne_bot

end OrderBot

end PartialOrder

/-- There is at most one way to define the successors in a `PartialOrder`. -/
instance [PartialOrder α] : Subsingleton (SuccOrder α) :=
  ⟨by
    intro h₀ h₁
    ext a
    by_cases ha : IsMax a
    · exact (@IsMax.succ_eq _ _ h₀ _ ha).trans ha.succ_eq.symm
    · exact @Covby.succ_eq _ _ h₀ _ _ (covby_succ_of_not_isMax ha)⟩

section CompleteLattice

variable [CompleteLattice α] [SuccOrder α]

theorem succ_eq_infᵢ (a : α) : succ a = ⨅ (b) (_h : a < b), b := by
  refine' le_antisymm (le_infᵢ fun b => le_infᵢ succ_le_of_lt) _
  obtain rfl | ha := eq_or_ne a ⊤
  · rw [succ_top]
    exact le_top
  exact infᵢ₂_le _ (lt_succ_iff_ne_top.2 ha)
#align order.succ_eq_infi Order.succ_eq_infᵢ

end CompleteLattice

/-! ### Predecessor order -/

section Preorder

variable [Preorder α] [PredOrder α] {a b : α}

/-- The predecessor of an element. If `a` is not minimal, then `pred a` is the greatest element less
than `a`. If `a` is minimal, then `pred a = a`. -/
def pred : α → α :=
  PredOrder.pred
#align order.pred Order.pred

theorem pred_le : ∀ a : α, pred a ≤ a :=
  PredOrder.pred_le
#align order.pred_le Order.pred_le

theorem min_of_le_pred {a : α} : a ≤ pred a → IsMin a :=
  PredOrder.min_of_le_pred
#align order.min_of_le_pred Order.min_of_le_pred

theorem le_pred_of_lt {a b : α} : a < b → a ≤ pred b :=
  PredOrder.le_pred_of_lt
#align order.le_pred_of_lt Order.le_pred_of_lt

theorem le_of_pred_lt {a b : α} : pred a < b → a ≤ b :=
  PredOrder.le_of_pred_lt
#align order.le_of_pred_lt Order.le_of_pred_lt

@[simp]
theorem le_pred_iff_isMin : a ≤ pred a ↔ IsMin a :=
  ⟨min_of_le_pred, fun h => h <| pred_le _⟩
#align order.le_pred_iff_is_min Order.le_pred_iff_isMin

@[simp]
theorem pred_lt_iff_not_isMin : pred a < a ↔ ¬IsMin a :=
  ⟨not_isMin_of_lt, fun ha => (pred_le a).lt_of_not_le fun h => ha <| min_of_le_pred h⟩
#align order.pred_lt_iff_not_is_min Order.pred_lt_iff_not_isMin

alias pred_lt_iff_not_isMin ↔ _ pred_lt_of_not_isMin
#align order.pred_lt_of_not_is_min Order.pred_lt_of_not_isMin

theorem pred_wcovby (a : α) : pred a ⩿ a :=
  ⟨pred_le a, fun _ hb => (le_of_pred_lt hb).not_lt⟩
#align order.pred_wcovby Order.pred_wcovby

theorem pred_covby_of_not_isMin (h : ¬IsMin a) : pred a ⋖ a :=
  (pred_wcovby a).covby_of_lt <| pred_lt_of_not_isMin h
#align order.pred_covby_of_not_is_min Order.pred_covby_of_not_isMin

theorem pred_lt_iff_of_not_isMin (ha : ¬IsMin a) : pred a < b ↔ a ≤ b :=
  ⟨le_of_pred_lt, (pred_lt_of_not_isMin ha).trans_le⟩
#align order.pred_lt_iff_of_not_is_min Order.pred_lt_iff_of_not_isMin

theorem le_pred_iff_of_not_isMin (ha : ¬IsMin a) : b ≤ pred a ↔ b < a :=
  ⟨fun h => h.trans_lt <| pred_lt_of_not_isMin ha, le_pred_of_lt⟩
#align order.le_pred_iff_of_not_is_min Order.le_pred_iff_of_not_isMin

@[simp, mono]
theorem pred_le_pred {a b : α} (h : a ≤ b) : pred a ≤ pred b :=
  succ_le_succ h.dual
#align order.pred_le_pred Order.pred_le_pred

theorem pred_mono : Monotone (pred : α → α) := fun _ _ => pred_le_pred
#align order.pred_mono Order.pred_mono

theorem pred_iterate_le (k : ℕ) (x : α) : (pred^[k]) x ≤ x := by
  conv_rhs => rw [(by simp only [Function.iterate_id, id.def] : x = (id^[k]) x)]
  exact Monotone.iterate_le_of_le pred_mono pred_le k x
#align order.pred_iterate_le Order.pred_iterate_le

theorem isMin_iterate_pred_of_eq_of_lt {n m : ℕ} (h_eq : (pred^[n]) a = (pred^[m]) a)
    (h_lt : n < m) : IsMin ((pred^[n]) a) :=
  @isMax_iterate_succ_of_eq_of_lt αᵒᵈ _ _ _ _ _ h_eq h_lt
#align order.is_min_iterate_pred_of_eq_of_lt Order.isMin_iterate_pred_of_eq_of_lt

theorem isMin_iterate_pred_of_eq_of_ne {n m : ℕ} (h_eq : (pred^[n]) a = (pred^[m]) a)
    (h_ne : n ≠ m) : IsMin ((pred^[n]) a) :=
  @isMax_iterate_succ_of_eq_of_ne αᵒᵈ _ _ _ _ _ h_eq h_ne
#align order.is_min_iterate_pred_of_eq_of_ne Order.isMin_iterate_pred_of_eq_of_ne

theorem Ioi_pred_of_not_isMin (ha : ¬IsMin a) : Ioi (pred a) = Ici a :=
  Set.ext fun _ => pred_lt_iff_of_not_isMin ha
#align order.Ioi_pred_of_not_is_min Order.Ioi_pred_of_not_isMin

theorem Iic_pred_of_not_isMin (ha : ¬IsMin a) : Iic (pred a) = Iio a :=
  Set.ext fun _ => le_pred_iff_of_not_isMin ha
#align order.Iic_pred_of_not_is_min Order.Iic_pred_of_not_isMin

theorem Ioc_pred_left_of_not_isMin (ha : ¬IsMin a) : Ioc (pred a) b = Icc a b := by
  rw [← Ioi_inter_Iic, Ioi_pred_of_not_isMin ha, Ici_inter_Iic]
#align order.Ioc_pred_left_of_not_is_min Order.Ioc_pred_left_of_not_isMin

theorem Ioo_pred_left_of_not_isMin (ha : ¬IsMin a) : Ioo (pred a) b = Ico a b := by
  rw [← Ioi_inter_Iio, Ioi_pred_of_not_isMin ha, Ici_inter_Iio]
#align order.Ioo_pred_left_of_not_is_min Order.Ioo_pred_left_of_not_isMin

theorem Icc_pred_right_of_not_isMin (ha : ¬IsMin b) : Icc a (pred b) = Ico a b := by
  rw [← Ici_inter_Iic, Iic_pred_of_not_isMin ha, Ici_inter_Iio]
#align order.Icc_pred_right_of_not_is_min Order.Icc_pred_right_of_not_isMin

theorem Ioc_pred_right_of_not_isMin (ha : ¬IsMin b) : Ioc a (pred b) = Ioo a b := by
  rw [← Ioi_inter_Iic, Iic_pred_of_not_isMin ha, Ioi_inter_Iio]
#align order.Ioc_pred_right_of_not_is_min Order.Ioc_pred_right_of_not_isMin

section NoMinOrder

variable [NoMinOrder α]

theorem pred_lt (a : α) : pred a < a :=
  pred_lt_of_not_isMin <| not_isMin a
#align order.pred_lt Order.pred_lt

@[simp]
theorem pred_lt_iff : pred a < b ↔ a ≤ b :=
  pred_lt_iff_of_not_isMin <| not_isMin a
#align order.pred_lt_iff Order.pred_lt_iff

@[simp]
theorem le_pred_iff : a ≤ pred b ↔ a < b :=
  le_pred_iff_of_not_isMin <| not_isMin b
#align order.le_pred_iff Order.le_pred_iff

theorem pred_le_pred_iff : pred a ≤ pred b ↔ a ≤ b := by simp
#align order.pred_le_pred_iff Order.pred_le_pred_iff

theorem pred_lt_pred_iff : pred a < pred b ↔ a < b := by simp
#align order.pred_lt_pred_iff Order.pred_lt_pred_iff

alias pred_le_pred_iff ↔ le_of_pred_le_pred _
#align order.le_of_pred_le_pred Order.le_of_pred_le_pred

alias pred_lt_pred_iff ↔ lt_of_pred_lt_pred pred_lt_pred
#align order.lt_of_pred_lt_pred Order.lt_of_pred_lt_pred
#align order.pred_lt_pred Order.pred_lt_pred

theorem pred_strictMono : StrictMono (pred : α → α) := fun _ _ => pred_lt_pred
#align order.pred_strict_mono Order.pred_strictMono

theorem pred_covby (a : α) : pred a ⋖ a :=
  pred_covby_of_not_isMin <| not_isMin a
#align order.pred_covby Order.pred_covby

@[simp]
theorem Ioi_pred (a : α) : Ioi (pred a) = Ici a :=
  Ioi_pred_of_not_isMin <| not_isMin a
#align order.Ioi_pred Order.Ioi_pred

@[simp]
theorem Iic_pred (a : α) : Iic (pred a) = Iio a :=
  Iic_pred_of_not_isMin <| not_isMin a
#align order.Iic_pred Order.Iic_pred

@[simp]
theorem Ioc_pred_left (a b : α) : Ioc (pred a) b = Icc a b :=
  Ioc_pred_left_of_not_isMin <| not_isMin _
#align order.Ioc_pred_left Order.Ioc_pred_left

@[simp]
theorem Ioo_pred_left (a b : α) : Ioo (pred a) b = Ico a b :=
  Ioo_pred_left_of_not_isMin <| not_isMin _
#align order.Ioo_pred_left Order.Ioo_pred_left

@[simp]
theorem Icc_pred_right (a b : α) : Icc a (pred b) = Ico a b :=
  Icc_pred_right_of_not_isMin <| not_isMin _
#align order.Icc_pred_right Order.Icc_pred_right

@[simp]
theorem Ioc_pred_right (a b : α) : Ioc a (pred b) = Ioo a b :=
  Ioc_pred_right_of_not_isMin <| not_isMin _
#align order.Ioc_pred_right Order.Ioc_pred_right

end NoMinOrder

end Preorder

section PartialOrder

variable [PartialOrder α] [PredOrder α] {a b : α}

@[simp]
theorem pred_eq_iff_isMin : pred a = a ↔ IsMin a :=
  ⟨fun h => min_of_le_pred h.ge, fun h => h.eq_of_le <| pred_le _⟩
#align order.pred_eq_iff_is_min Order.pred_eq_iff_isMin

alias pred_eq_iff_isMin ↔ _ _root_.IsMin.pred_eq
#align is_min.pred_eq IsMin.pred_eq

theorem pred_le_le_iff {a b : α} : pred a ≤ b ∧ b ≤ a ↔ b = a ∨ b = pred a := by
  refine'
    ⟨fun h =>
      or_iff_not_imp_left.2 fun hba : b ≠ a => (le_pred_of_lt <| h.2.lt_of_ne hba).antisymm h.1, _⟩
  rintro (rfl | rfl)
  · exact ⟨pred_le b, le_rfl⟩
  · exact ⟨le_rfl, pred_le a⟩
#align order.pred_le_le_iff Order.pred_le_le_iff

theorem Covby.pred_eq {a b : α} (h : a ⋖ b) : pred b = a :=
  (le_pred_of_lt h.lt).eq_of_not_gt fun h' => h.2 h' <| pred_lt_of_not_isMin h.lt.not_isMin
#align covby.pred_eq Order.Covby.pred_eq

theorem Wcovby.pred_le (h : a ⩿ b) : pred b ≤ a := by
  obtain h | rfl := h.covby_or_eq
  · exact (Covby.pred_eq h).le
  · exact pred_le _
#align wcovby.pred_le Order.Wcovby.pred_le

theorem pred_le_iff_eq_or_le : pred a ≤ b ↔ b = pred a ∨ a ≤ b := by
  by_cases ha : IsMin a
  · rw [ha.pred_eq, or_iff_right_of_imp ge_of_eq]
  · rw [← pred_lt_iff_of_not_isMin ha, le_iff_eq_or_lt, eq_comm]
#align order.pred_le_iff_eq_or_le Order.pred_le_iff_eq_or_le

theorem pred_lt_iff_eq_or_lt_of_not_isMin (ha : ¬IsMin a) : pred a < b ↔ a = b ∨ a < b :=
  (pred_lt_iff_of_not_isMin ha).trans le_iff_eq_or_lt
#align order.pred_lt_iff_eq_or_lt_of_not_is_min Order.pred_lt_iff_eq_or_lt_of_not_isMin

theorem Ici_pred (a : α) : Ici (pred a) = insert (pred a) (Ici a) :=
  ext fun _ => pred_le_iff_eq_or_le
#align order.Ici_pred Order.Ici_pred

theorem Ioi_pred_eq_insert_of_not_isMin (ha : ¬IsMin a) : Ioi (pred a) = insert a (Ioi a) := by
  ext x; simp only [insert, mem_setOf, @eq_comm _ x a, mem_Ioi, Set.insert]
  exact pred_lt_iff_eq_or_lt_of_not_isMin ha
#align order.Ioi_pred_eq_insert_of_not_is_min Order.Ioi_pred_eq_insert_of_not_isMin

theorem Icc_pred_left (h : pred a ≤ b) : Icc (pred a) b = insert (pred a) (Icc a b) := by
  simp_rw [← Ici_inter_Iic, Ici_pred, insert_inter_of_mem (mem_Iic.2 h)]
#align order.Icc_pred_left Order.Icc_pred_left

theorem Ico_pred_left (h : pred a < b) : Ico (pred a) b = insert (pred a) (Ico a b) := by
  simp_rw [← Ici_inter_Iio, Ici_pred, insert_inter_of_mem (mem_Iio.2 h)]
#align order.Ico_pred_left Order.Ico_pred_left

section NoMinOrder

variable [NoMinOrder α]

@[simp]
theorem pred_eq_pred_iff : pred a = pred b ↔ a = b := by
  simp_rw [eq_iff_le_not_lt, pred_le_pred_iff, pred_lt_pred_iff]
#align order.pred_eq_pred_iff Order.pred_eq_pred_iff

theorem pred_injective : Injective (pred : α → α) := fun _ _ => pred_eq_pred_iff.1
#align order.pred_injective Order.pred_injective

theorem pred_ne_pred_iff : pred a ≠ pred b ↔ a ≠ b :=
  pred_injective.ne_iff
#align order.pred_ne_pred_iff Order.pred_ne_pred_iff

alias pred_ne_pred_iff ↔ _ pred_ne_pred
#align order.pred_ne_pred Order.pred_ne_pred

theorem pred_lt_iff_eq_or_lt : pred a < b ↔ a = b ∨ a < b :=
  pred_lt_iff.trans le_iff_eq_or_lt
#align order.pred_lt_iff_eq_or_lt Order.pred_lt_iff_eq_or_lt

theorem pred_eq_iff_covby : pred b = a ↔ a ⋖ b :=
  ⟨by
    rintro rfl
    exact pred_covby _, Covby.pred_eq⟩
#align order.pred_eq_iff_covby Order.pred_eq_iff_covby

theorem Ioi_pred_eq_insert (a : α) : Ioi (pred a) = insert a (Ioi a) :=
  ext fun _ => pred_lt_iff_eq_or_lt.trans <| or_congr_left eq_comm
#align order.Ioi_pred_eq_insert Order.Ioi_pred_eq_insert

theorem Ico_pred_right_eq_insert (h : a ≤ b) : Ioc (pred a) b = insert a (Ioc a b) := by
  simp_rw [← Ioi_inter_Iic, Ioi_pred_eq_insert, insert_inter_of_mem (mem_Iic.2 h)]
#align order.Ico_pred_right_eq_insert Order.Ico_pred_right_eq_insert

theorem Ioo_pred_right_eq_insert (h : a < b) : Ioo (pred a) b = insert a (Ioo a b) := by
  simp_rw [← Ioi_inter_Iio, Ioi_pred_eq_insert, insert_inter_of_mem (mem_Iio.2 h)]
#align order.Ioo_pred_right_eq_insert Order.Ioo_pred_right_eq_insert

end NoMinOrder

section OrderBot

variable [OrderBot α]

@[simp]
theorem pred_bot : pred (⊥ : α) = ⊥ :=
  isMin_bot.pred_eq
#align order.pred_bot Order.pred_bot

--Porting note: removing @[simp],`simp` can prove it
theorem le_pred_iff_eq_bot : a ≤ pred a ↔ a = ⊥ :=
  @succ_le_iff_eq_top αᵒᵈ _ _ _ _
#align order.le_pred_iff_eq_bot Order.le_pred_iff_eq_bot

--Porting note: removing @[simp],`simp` can prove it
theorem pred_lt_iff_ne_bot : pred a < a ↔ a ≠ ⊥ :=
  @lt_succ_iff_ne_top αᵒᵈ _ _ _ _
#align order.pred_lt_iff_ne_bot Order.pred_lt_iff_ne_bot

end OrderBot

section OrderTop

variable [OrderTop α]

--Porting note: removing @[simp],`simp` can prove it
theorem pred_top_lt_iff [NoMinOrder α] : pred ⊤ < a ↔ a = ⊤ :=
  @lt_succ_bot_iff αᵒᵈ _ _ _ _ _
#align order.pred_top_lt_iff Order.pred_top_lt_iff

theorem pred_top_le_iff : pred ⊤ ≤ a ↔ a = ⊤ ∨ a = pred ⊤ :=
  @le_succ_bot_iff αᵒᵈ _ _ _ _
#align order.pred_top_le_iff Order.pred_top_le_iff

variable [Nontrivial α]

theorem pred_lt_top (a : α) : pred a < ⊤ :=
  (pred_mono le_top).trans_lt <| pred_lt_of_not_isMin not_isMin_top
#align order.pred_lt_top Order.pred_lt_top

theorem pred_ne_top (a : α) : pred a ≠ ⊤ :=
  (pred_lt_top a).ne
#align order.pred_ne_top Order.pred_ne_top

end OrderTop

end PartialOrder

/-- There is at most one way to define the predecessors in a `PartialOrder`. -/
instance [PartialOrder α] : Subsingleton (PredOrder α) :=
  ⟨by
    intro h₀ h₁
    ext a
    by_cases ha : IsMin a
    · exact (@IsMin.pred_eq _ _ h₀ _ ha).trans ha.pred_eq.symm
    · exact @Covby.pred_eq _ _ h₀ _ _ (pred_covby_of_not_isMin ha)⟩

section CompleteLattice

variable [CompleteLattice α] [PredOrder α]

theorem pred_eq_supᵢ (a : α) : pred a = ⨆ (b) (_h : b < a), b := by
  refine' le_antisymm _ (supᵢ_le fun b => supᵢ_le le_pred_of_lt)
  obtain rfl | ha := eq_or_ne a ⊥
  · rw [pred_bot]
    exact bot_le
  · exact @le_supᵢ₂ _ _ (fun b => b < a) _ (fun a _ => a) (pred a) (pred_lt_iff_ne_bot.2 ha)
#align order.pred_eq_supr Order.pred_eq_supᵢ

end CompleteLattice

/-! ### Successor-predecessor orders -/

section SuccPredOrder

variable [PartialOrder α] [SuccOrder α] [PredOrder α] {a b : α}

@[simp]
theorem succ_pred_of_not_isMin (h : ¬IsMin a) : succ (pred a) = a :=
  Covby.succ_eq (pred_covby_of_not_isMin h)
#align order.succ_pred_of_not_is_min Order.succ_pred_of_not_isMin

@[simp]
theorem pred_succ_of_not_isMax (h : ¬IsMax a) : pred (succ a) = a :=
  Covby.pred_eq (covby_succ_of_not_isMax h)
#align order.pred_succ_of_not_is_max Order.pred_succ_of_not_isMax

--Porting note: removing @[simp],`simp` can prove it
theorem succ_pred [NoMinOrder α] (a : α) : succ (pred a) = a :=
  Covby.succ_eq (pred_covby _)
#align order.succ_pred Order.succ_pred

--Porting note: removing @[simp],`simp` can prove it
theorem pred_succ [NoMaxOrder α] (a : α) : pred (succ a) = a :=
  Covby.pred_eq (covby_succ _)
#align order.pred_succ Order.pred_succ

theorem pred_succ_iterate_of_not_isMax (i : α) (n : ℕ) (hin : ¬IsMax ((succ^[n - 1]) i)) :
    (pred^[n]) ((succ^[n]) i) = i := by
  induction' n with n hn
  · simp only [Nat.zero_eq, Function.iterate_zero, id.def]
  rw [Nat.succ_sub_succ_eq_sub, Nat.sub_zero] at hin
  have h_not_max : ¬IsMax ((succ^[n - 1]) i) := by
    cases' n with n
    · simpa using hin
    rw [Nat.succ_sub_succ_eq_sub, Nat.sub_zero] at hn⊢
    have h_sub_le : (succ^[n]) i ≤ (succ^[n.succ]) i := by
      rw [Function.iterate_succ']
      exact le_succ _
    refine' fun h_max => hin fun j hj => _
    have hj_le : j ≤ (succ^[n]) i := h_max (h_sub_le.trans hj)
    exact hj_le.trans h_sub_le
  rw [Function.iterate_succ, Function.iterate_succ']
  simp only [Function.comp_apply]
  rw [pred_succ_of_not_isMax hin]
  exact hn h_not_max
#align order.pred_succ_iterate_of_not_is_max Order.pred_succ_iterate_of_not_isMax

theorem succ_pred_iterate_of_not_isMin (i : α) (n : ℕ) (hin : ¬IsMin ((pred^[n - 1]) i)) :
    (succ^[n]) ((pred^[n]) i) = i :=
  @pred_succ_iterate_of_not_isMax αᵒᵈ _ _ _ i n hin
#align order.succ_pred_iterate_of_not_is_min Order.succ_pred_iterate_of_not_isMin

end SuccPredOrder

end Order

open Order

/-! ### `WithBot`, `WithTop`
Adding a greatest/least element to a `SuccOrder` or to a `PredOrder`.

As far as successors and predecessors are concerned, there are four ways to add a bottom or top
element to an order:
* Adding a `⊤` to an `OrderTop`: Preserves `succ` and `pred`.
* Adding a `⊤` to a `NoMaxOrder`: Preserves `succ`. Never preserves `pred`.
* Adding a `⊥` to an `OrderBot`: Preserves `succ` and `pred`.
* Adding a `⊥` to a `NoMinOrder`: Preserves `pred`. Never preserves `succ`.
where "preserves `(succ/pred)`" means
`(Succ/Pred)Order α → (Succ/Pred)Order ((WithTop/WithBot) α)`.
-/

namespace WithTop

/-! #### Adding a `⊤` to an `OrderTop` -/

section Succ

variable [DecidableEq α] [PartialOrder α] [OrderTop α] [SuccOrder α]

instance : SuccOrder (WithTop α) where
  succ a :=
    match a with
    | ⊤ => ⊤
    | Option.some a => ite (a = ⊤) ⊤ (some (succ a))
  le_succ a := by
    cases' a with a a
    · exact le_top
    change _ ≤ ite _ _ _
    split_ifs
    . exact le_top
    · exact some_le_some.2 (le_succ a)
  max_of_succ_le {a} ha := by
    cases a
    · exact isMax_top
    dsimp only at ha
    split_ifs at ha with ha'
    · exact (not_top_le_coe _ ha).elim
    · rw [some_eq_coe, coe_le_coe, succ_le_iff_eq_top] at ha
      exact (ha' ha).elim
  succ_le_of_lt {a b} h := by
    cases b
    · exact le_top
    cases a
    · exact (not_top_lt h).elim
    rw [some_lt_some] at h
    change ite _ _ _ ≤ _
    split_ifs with ha
    · rw [ha] at h
      exact (not_top_lt h).elim
    · exact some_le_some.2 (succ_le_of_lt h)
  le_of_lt_succ {a b} h := by
    cases a
    · exact (not_top_lt h).elim
    cases b
    · exact le_top
    dsimp only at h
    rw [some_le_some]
    split_ifs  at h with hb
    · rw [hb]
      exact le_top
    · exact le_of_lt_succ (some_lt_some.1 h)

@[simp]
theorem succ_coe_top : succ ↑(⊤ : α) = (⊤ : WithTop α) :=
  dif_pos rfl
#align with_top.succ_coe_top WithTop.succ_coe_top

theorem succ_coe_of_ne_top {a : α} (h : a ≠ ⊤) : succ (↑a : WithTop α) = ↑(succ a) :=
  dif_neg h
#align with_top.succ_coe_of_ne_top WithTop.succ_coe_of_ne_top

end Succ

section Pred

variable [Preorder α] [OrderTop α] [PredOrder α]

instance : PredOrder (WithTop α) where
  pred a :=
    match a with
    | ⊤ => some ⊤
    | Option.some a => some (pred a)
  pred_le a :=
    match a with
    | ⊤ => le_top
    | Option.some a => some_le_some.2 (pred_le a)
  min_of_le_pred {a} ha := by
    cases a
    · exact ((coe_lt_top (⊤ : α)).not_le ha).elim
    · exact (min_of_le_pred <| some_le_some.1 ha).withTop
  le_pred_of_lt {a b} h := by
    cases a
    · exact (le_top.not_lt h).elim
    cases b
    · exact some_le_some.2 le_top
    exact some_le_some.2 (le_pred_of_lt <| some_lt_some.1 h)
  le_of_pred_lt {a b} h := by
    cases b
    · exact le_top
    cases a
    · exact (not_top_lt <| some_lt_some.1 h).elim
    · exact some_le_some.2 (le_of_pred_lt <| some_lt_some.1 h)

@[simp]
theorem pred_top : pred (⊤ : WithTop α) = ↑(⊤ : α) :=
  rfl
#align with_top.pred_top WithTop.pred_top

@[simp]
theorem pred_coe (a : α) : pred (↑a : WithTop α) = ↑(pred a) :=
  rfl
#align with_top.pred_coe WithTop.pred_coe

@[simp]
theorem pred_untop :
    ∀ (a : WithTop α) (ha : a ≠ ⊤),
      pred (a.untop ha) = (pred a).untop (by induction a using WithTop.recTopCoe <;> simp)
  | ⊤, ha => (ha rfl).elim
  | (a : α), _ => rfl
#align with_top.pred_untop WithTop.pred_untop

end Pred

/-! #### Adding a `⊤` to a `NoMaxOrder` -/

section Succ

variable [Preorder α] [NoMaxOrder α] [SuccOrder α]

instance succOrderOfNoMaxOrder : SuccOrder (WithTop α) where
  succ a :=
    match a with
    | ⊤ => ⊤
    | Option.some a => some (succ a)
  le_succ a := by
    cases' a with a a
    · exact le_top
    · exact some_le_some.2 (le_succ a)
  max_of_succ_le {a} ha := by
    cases a
    · exact isMax_top
    · exact (not_isMax _ <| max_of_succ_le <| some_le_some.1 ha).elim
  succ_le_of_lt {a b} h := by
    cases a
    · exact (not_top_lt h).elim
    cases b
    · exact le_top
    · exact some_le_some.2 (succ_le_of_lt <| some_lt_some.1 h)
  le_of_lt_succ {a b} h := by
    cases a
    · exact (not_top_lt h).elim
    cases b
    · exact le_top
    · exact some_le_some.2 (le_of_lt_succ <| some_lt_some.1 h)
#align with_top.succ_order_of_no_max_order WithTop.succOrderOfNoMaxOrder

@[simp]
theorem succ_coe (a : α) : succ (↑a : WithTop α) = ↑(succ a) :=
  rfl
#align with_top.succ_coe WithTop.succ_coe

end Succ

section Pred

variable [Preorder α] [NoMaxOrder α]

instance [hα : Nonempty α] : IsEmpty (PredOrder (WithTop α)) :=
  ⟨by
    intro
    cases' h : pred (⊤ : WithTop α) with a ha
    · exact hα.elim fun a => (min_of_le_pred h.ge).not_lt <| coe_lt_top a
    · obtain ⟨c, hc⟩ := exists_gt a
      rw [← some_lt_some, ← h] at hc
      exact (le_of_pred_lt hc).not_lt (some_lt_none _)⟩

end Pred

end WithTop

namespace WithBot

/-! #### Adding a `⊥` to an `OrderBot` -/

section Succ

variable [Preorder α] [OrderBot α] [SuccOrder α]

instance : SuccOrder (WithBot α) where
  succ a :=
    match a with
    | ⊥ => some ⊥
    | Option.some a => some (succ a)
  le_succ a :=
    match a with
    | ⊥ => bot_le
    | Option.some a => some_le_some.2 (le_succ a)
  max_of_succ_le {a} ha := by
    cases a
    · exact ((none_lt_some (⊥ : α)).not_le ha).elim
    · exact (max_of_succ_le <| some_le_some.1 ha).withBot
  succ_le_of_lt {a b} h := by
    cases b
    · exact (not_lt_bot h).elim
    cases a
    · exact some_le_some.2 bot_le
    · exact some_le_some.2 (succ_le_of_lt <| some_lt_some.1 h)
  le_of_lt_succ {a b} h := by
    cases a
    · exact bot_le
    cases b
    · exact (not_lt_bot <| some_lt_some.1 h).elim
    · exact some_le_some.2 (le_of_lt_succ <| some_lt_some.1 h)

@[simp]
theorem succ_bot : succ (⊥ : WithBot α) = ↑(⊥ : α) :=
  rfl
#align with_bot.succ_bot WithBot.succ_bot

@[simp]
theorem succ_coe (a : α) : succ (↑a : WithBot α) = ↑(succ a) :=
  rfl
#align with_bot.succ_coe WithBot.succ_coe

@[simp]
theorem succ_unbot :
    ∀ (a : WithBot α) (ha : a ≠ ⊥),
      succ (a.unbot ha) = (succ a).unbot (by induction a using WithBot.recBotCoe <;> simp)
  | ⊥, ha => (ha rfl).elim
  | (a : α), _ => rfl
#align with_bot.succ_unbot WithBot.succ_unbot

end Succ

section Pred

variable [DecidableEq α] [PartialOrder α] [OrderBot α] [PredOrder α]

instance : PredOrder (WithBot α) where
  pred a :=
    match a with
    | ⊥ => ⊥
    | Option.some a => ite (a = ⊥) ⊥ (some (pred a))
  pred_le a := by
    cases' a with a a
    · exact bot_le
    change ite _ _ _ ≤ _
    split_ifs
    · exact bot_le
    · exact some_le_some.2 (pred_le a)
  min_of_le_pred {a} ha := by
    cases' a with a a
    · exact isMin_bot
    dsimp only at ha
    split_ifs  at ha with ha'
    · exact (not_coe_le_bot _ ha).elim
    · rw [some_eq_coe, coe_le_coe, le_pred_iff_eq_bot] at ha
      exact (ha' ha).elim
  le_pred_of_lt {a b} h := by
    cases a
    · exact bot_le
    cases b
    · exact (not_lt_bot h).elim
    rw [some_lt_some] at h
    change _ ≤ ite _ _ _
    split_ifs with hb
    · rw [hb] at h
      exact (not_lt_bot h).elim
    · exact some_le_some.2 (le_pred_of_lt h)
  le_of_pred_lt {a b} h := by
    cases b
    · exact (not_lt_bot h).elim
    cases a
    · exact bot_le
    dsimp only at h
    rw [some_le_some]
    split_ifs  at h with ha
    · rw [ha]
      exact bot_le
    · exact le_of_pred_lt (some_lt_some.1 h)

@[simp]
theorem pred_coe_bot : pred ↑(⊥ : α) = (⊥ : WithBot α) :=
  dif_pos rfl
#align with_bot.pred_coe_bot WithBot.pred_coe_bot

end Pred

/-! #### Adding a `⊥` to a `NoMinOrder` -/

section Succ

variable [Preorder α] [NoMinOrder α]

instance [hα : Nonempty α] : IsEmpty (SuccOrder (WithBot α)) :=
  ⟨by
    intro
    cases' h : succ (⊥ : WithBot α) with a ha
    · exact hα.elim fun a => (max_of_succ_le h.le).not_lt <| bot_lt_coe a
    · obtain ⟨c, hc⟩ := exists_lt a
      rw [← some_lt_some, ← h] at hc
      exact (le_of_lt_succ hc).not_lt (none_lt_some _)⟩

end Succ

section Pred

variable [Preorder α] [NoMinOrder α] [PredOrder α]

instance predOrderOfNoMinOrder : PredOrder (WithBot α) where
  pred a :=
    match a with
    | ⊥ => ⊥
    | Option.some a => some (pred a)
  pred_le a := by
    cases' a with a a
    · exact bot_le
    · exact some_le_some.2 (pred_le a)
  min_of_le_pred {a} ha := by
    cases a
    · exact isMin_bot
    · exact (not_isMin _ <| min_of_le_pred <| some_le_some.1 ha).elim
  le_pred_of_lt {a b} h := by
    cases b
    · exact (not_lt_bot h).elim
    cases a
    · exact bot_le
    · exact some_le_some.2 (le_pred_of_lt <| some_lt_some.1 h)
  le_of_pred_lt {a b} h := by
    cases b
    · exact (not_lt_bot h).elim
    cases a
    · exact bot_le
    · exact some_le_some.2 (le_of_pred_lt <| some_lt_some.1 h)
#align with_bot.pred_order_of_no_min_order WithBot.predOrderOfNoMinOrder

@[simp]
theorem pred_coe (a : α) : pred (↑a : WithBot α) = ↑(pred a) :=
  rfl
#align with_bot.pred_coe WithBot.pred_coe

end Pred

end WithBot

/-! ### Archimedeanness -/

/-- A `SuccOrder` is succ-archimedean if one can go from any two comparable elements by iterating
`succ` -/
class IsSuccArchimedean (α : Type _) [Preorder α] [SuccOrder α] : Prop where
  /-- If `a ≤ b` then one can get to `a` from `b` by iterating `succ` -/
  exists_succ_iterate_of_le {a b : α} (h : a ≤ b) : ∃ n, (succ^[n]) a = b
#align is_succ_archimedean IsSuccArchimedean

/-- A `PredOrder` is pred-archimedean if one can go from any two comparable elements by iterating
`pred` -/
class IsPredArchimedean (α : Type _) [Preorder α] [PredOrder α] : Prop where
  /-- If `a ≤ b` then one can get to `b` from `a` by iterating `pred` -/
  exists_pred_iterate_of_le {a b : α} (h : a ≤ b) : ∃ n, (pred^[n]) b = a
#align is_pred_archimedean IsPredArchimedean

export IsSuccArchimedean (exists_succ_iterate_of_le)

export IsPredArchimedean (exists_pred_iterate_of_le)

section Preorder

variable [Preorder α]

section SuccOrder

variable [SuccOrder α] [IsSuccArchimedean α] {a b : α}

instance : IsPredArchimedean αᵒᵈ :=
  ⟨fun {a b} h => by convert exists_succ_iterate_of_le h.ofDual⟩

theorem LE.le.exists_succ_iterate (h : a ≤ b) : ∃ n, (succ^[n]) a = b :=
  exists_succ_iterate_of_le h
#align has_le.le.exists_succ_iterate LE.le.exists_succ_iterate

theorem exists_succ_iterate_iff_le : (∃ n, (succ^[n]) a = b) ↔ a ≤ b := by
  refine' ⟨_, exists_succ_iterate_of_le⟩
  rintro ⟨n, rfl⟩
  exact id_le_iterate_of_id_le le_succ n a
#align exists_succ_iterate_iff_le exists_succ_iterate_iff_le

/-- Induction principle on a type with a `SuccOrder` for all elements above a given element `m`. -/
@[elab_as_elim]
theorem Succ.rec {P : α → Prop} {m : α} (h0 : P m) (h1 : ∀ n, m ≤ n → P n → P (succ n)) ⦃n : α⦄
    (hmn : m ≤ n) : P n := by
  obtain ⟨n, rfl⟩ := hmn.exists_succ_iterate; clear hmn
  induction' n with n ih
  · exact h0
  · rw [Function.iterate_succ_apply']
    exact h1 _ (id_le_iterate_of_id_le le_succ n m) ih
#align succ.rec Succ.rec

theorem Succ.rec_iff {p : α → Prop} (hsucc : ∀ a, p a ↔ p (succ a)) {a b : α} (h : a ≤ b) :
    p a ↔ p b := by
  obtain ⟨n, rfl⟩ := h.exists_succ_iterate
  exact Iterate.rec (fun b => p a ↔ p b) (fun c hc => hc.trans (hsucc _)) Iff.rfl n
#align succ.rec_iff Succ.rec_iff

end SuccOrder

section PredOrder

variable [PredOrder α] [IsPredArchimedean α] {a b : α}

instance : IsSuccArchimedean αᵒᵈ :=
  ⟨fun {a b} h => by convert exists_pred_iterate_of_le h.ofDual⟩

theorem LE.le.exists_pred_iterate (h : a ≤ b) : ∃ n, (pred^[n]) b = a :=
  exists_pred_iterate_of_le h
#align has_le.le.exists_pred_iterate LE.le.exists_pred_iterate

theorem exists_pred_iterate_iff_le : (∃ n, (pred^[n]) b = a) ↔ a ≤ b :=
  @exists_succ_iterate_iff_le αᵒᵈ _ _ _ _ _
#align exists_pred_iterate_iff_le exists_pred_iterate_iff_le

/-- Induction principle on a type with a `PredOrder` for all elements below a given element `m`. -/
@[elab_as_elim]
theorem Pred.rec {P : α → Prop} {m : α} (h0 : P m) (h1 : ∀ n, n ≤ m → P n → P (pred n)) ⦃n : α⦄
    (hmn : n ≤ m) : P n :=
  @Succ.rec αᵒᵈ _ _ _ _ _ h0 h1 _ hmn
#align pred.rec Pred.rec

theorem Pred.rec_iff {p : α → Prop} (hsucc : ∀ a, p a ↔ p (pred a)) {a b : α} (h : a ≤ b) :
    p a ↔ p b :=
  (@Succ.rec_iff αᵒᵈ _ _ _ _ hsucc _ _ h).symm
#align pred.rec_iff Pred.rec_iff

end PredOrder

end Preorder

section LinearOrder

variable [LinearOrder α]

section SuccOrder

variable [SuccOrder α] [IsSuccArchimedean α] {a b : α}

theorem exists_succ_iterate_or : (∃ n, (succ^[n]) a = b) ∨ ∃ n, (succ^[n]) b = a :=
  (le_total a b).imp exists_succ_iterate_of_le exists_succ_iterate_of_le
#align exists_succ_iterate_or exists_succ_iterate_or

theorem Succ.rec_linear {p : α → Prop} (hsucc : ∀ a, p a ↔ p (succ a)) (a b : α) : p a ↔ p b :=
  (le_total a b).elim (Succ.rec_iff hsucc) fun h => (Succ.rec_iff hsucc h).symm
#align succ.rec_linear Succ.rec_linear

end SuccOrder

section PredOrder

variable [PredOrder α] [IsPredArchimedean α] {a b : α}

theorem exists_pred_iterate_or : (∃ n, (pred^[n]) b = a) ∨ ∃ n, (pred^[n]) a = b :=
  (le_total a b).imp exists_pred_iterate_of_le exists_pred_iterate_of_le
#align exists_pred_iterate_or exists_pred_iterate_or

theorem Pred.rec_linear {p : α → Prop} (hsucc : ∀ a, p a ↔ p (pred a)) (a b : α) : p a ↔ p b :=
  (le_total a b).elim (Pred.rec_iff hsucc) fun h => (Pred.rec_iff hsucc h).symm
#align pred.rec_linear Pred.rec_linear

end PredOrder

end LinearOrder

section IsWellOrder

variable [LinearOrder α]

instance (priority := 100) IsWellOrder.toIsPredArchimedean [h : IsWellOrder α (· < ·)]
    [PredOrder α] : IsPredArchimedean α :=
  ⟨fun {a b} => by
    refine' WellFounded.fix (C := fun b => a ≤ b → ∃ n, Nat.iterate pred n b = a)
      h.wf _ b
    intros b ih hab
    replace hab := eq_or_lt_of_le hab
    rcases hab with (rfl | hab)
    · exact ⟨0, rfl⟩
    cases' le_or_lt b (pred b) with hb hb
    · cases (min_of_le_pred hb).not_lt hab
    dsimp at ih
    obtain ⟨k, hk⟩ := ih (pred b) hb (le_pred_of_lt hab)
    refine' ⟨k + 1, _⟩
    rw [iterate_add_apply, iterate_one, hk]⟩
#align is_well_order.to_is_pred_archimedean IsWellOrder.toIsPredArchimedean

instance (priority := 100) IsWellOrder.toIsSuccArchimedean [h : IsWellOrder α (· > ·)]
    [SuccOrder α] : IsSuccArchimedean α :=
  let h : IsPredArchimedean αᵒᵈ := by infer_instance
  ⟨h.1⟩
#align is_well_order.to_is_succ_archimedean IsWellOrder.toIsSuccArchimedean

end IsWellOrder

section OrderBot

variable [Preorder α] [OrderBot α] [SuccOrder α] [IsSuccArchimedean α]

theorem Succ.rec_bot (p : α → Prop) (hbot : p ⊥) (hsucc : ∀ a, p a → p (succ a)) (a : α) : p a :=
  Succ.rec hbot (fun x _ h => hsucc x h) (bot_le : ⊥ ≤ a)
#align succ.rec_bot Succ.rec_bot

end OrderBot

section OrderTop

variable [Preorder α] [OrderTop α] [PredOrder α] [IsPredArchimedean α]

theorem Pred.rec_top (p : α → Prop) (htop : p ⊤) (hpred : ∀ a, p a → p (pred a)) (a : α) : p a :=
  Pred.rec htop (fun x _ h => hpred x h) (le_top : a ≤ ⊤)
#align pred.rec_top Pred.rec_top

end OrderTop


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

! This file was ported from Lean 3 source module order.heyting.boundary
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.BooleanAlgebra
import Mathlib.Tactic.ScopedNS

/-!
# Co-Heyting boundary

The boundary of an element of a co-Heyting algebra is the intersection of its Heyting negation with
itself. The boundary in the co-Heyting algebra of closed sets coincides with the topological
boundary.

## Main declarations

* `Coheyting.boundary`: Co-Heyting boundary. `Coheyting.boundary a = a ⊓ ￢a`

## Notation

`∂ a` is notation for `Coheyting.boundary a` in locale `Heyting`.
-/

variable {α : Type _}

namespace Coheyting

variable [CoheytingAlgebra α] {a b : α}

/-- The boundary of an element of a co-Heyting algebra is the intersection of its Heyting negation
with itself. Note that this is always `⊥` for a boolean algebra. -/
def boundary (a : α) : α :=
  a ⊓ ￢a
#align coheyting.boundary Coheyting.boundary

/-- The boundary of an element of a co-Heyting algebra. -/
scoped[Heyting] prefix:120 "∂ " => Coheyting.boundary
-- Porting note: Should the notation be automatically included in the current scope?
open Heyting

-- Porting note: Should hnot be named hNot?
theorem inf_hnot_self (a : α) : a ⊓ ￢a = ∂ a :=
  rfl
#align coheyting.inf_hnot_self Coheyting.inf_hnot_self

theorem boundary_le : ∂ a ≤ a :=
  inf_le_left
#align coheyting.boundary_le Coheyting.boundary_le

theorem boundary_le_hnot : ∂ a ≤ ￢a :=
  inf_le_right
#align coheyting.boundary_le_hnot Coheyting.boundary_le_hnot

@[simp]
theorem boundary_bot : ∂ (⊥ : α) = ⊥ :=
  bot_inf_eq
#align coheyting.boundary_bot Coheyting.boundary_bot

@[simp]
theorem boundary_top : ∂ (⊤ : α) = ⊥ := by rw [boundary, hnot_top, inf_bot_eq]
#align coheyting.boundary_top Coheyting.boundary_top

theorem boundary_hnot_le (a : α) : ∂ (￢a) ≤ ∂ a :=
  inf_comm.trans_le <| inf_le_inf_right _ hnot_hnot_le
#align coheyting.boundary_hnot_le Coheyting.boundary_hnot_le

@[simp]

@[simp]
theorem hnot_boundary (a : α) : ￢∂ a = ⊤ := by rw [boundary, hnot_inf_distrib, sup_hnot_self]
#align coheyting.hnot_boundary Coheyting.hnot_boundary

/-- **Leibniz rule** for the co-Heyting boundary. -/
theorem boundary_inf (a b : α) : ∂ (a ⊓ b) = ∂ a ⊓ b ⊔ a ⊓ ∂ b := by
  unfold boundary
  rw [hnot_inf_distrib, inf_sup_left, inf_right_comm, ← inf_assoc]
#align coheyting.boundary_inf Coheyting.boundary_inf

theorem boundary_inf_le : ∂ (a ⊓ b) ≤ ∂ a ⊔ ∂ b :=
  (boundary_inf _ _).trans_le <| sup_le_sup inf_le_left inf_le_right
#align coheyting.boundary_inf_le Coheyting.boundary_inf_le

theorem boundary_sup_le : ∂ (a ⊔ b) ≤ ∂ a ⊔ ∂ b := by
  rw [boundary, inf_sup_right]
  exact
    sup_le_sup (inf_le_inf_left _ <| hnot_anti le_sup_left)
      (inf_le_inf_left _ <| hnot_anti le_sup_right)
#align coheyting.boundary_sup_le Coheyting.boundary_sup_le

/- The intuitionistic version of `Coheyting.boundary_le_boundary_sup_sup_boundary_inf_left`. Either
proof can be obtained from the other using the equivalence of Heyting algebras and intuitionistic
logic and duality between Heyting and co-Heyting algebras. It is crucial that the following proof be
intuitionistic. -/
example (a b : Prop) : (a ∧ b ∨ ¬(a ∧ b)) ∧ ((a ∨ b) ∨ ¬(a ∨ b)) → a ∨ ¬a := by
  rintro ⟨⟨ha, _⟩ | hnab, (ha | hb) | hnab⟩ <;> try exact Or.inl ha
  · exact Or.inr fun ha => hnab ⟨ha, hb⟩
  · exact Or.inr fun ha => hnab <| Or.inl ha

theorem boundary_le_boundary_sup_sup_boundary_inf_left : ∂ a ≤ ∂ (a ⊔ b) ⊔ ∂ (a ⊓ b) := by
  -- Porting note: the following simp generates the same term as mathlib3 if you remove
  -- sup_inf_right from both. With sup_inf_right included, mathlib4 and mathlib3 generate
  -- different terms
  simp only [boundary, sup_inf_left, sup_inf_right, sup_right_idem, le_inf_iff, sup_assoc,
    @sup_comm _ _ _ a]
  refine ⟨⟨⟨?_, ?_⟩, ⟨?_, ?_⟩⟩, ?_, ?_⟩ <;> try { exact le_sup_of_le_left inf_le_left } <;>
    refine inf_le_of_right_le ?_
  · rw [hnot_le_iff_codisjoint_right, codisjoint_left_comm]
    exact codisjoint_hnot_left
  · refine le_sup_of_le_right ?_
    rw [hnot_le_iff_codisjoint_right]
    exact codisjoint_hnot_right.mono_right (hnot_anti inf_le_left)
#align coheyting.boundary_le_boundary_sup_sup_boundary_inf_left Coheyting.boundary_le_boundary_sup_sup_boundary_inf_left

theorem boundary_le_boundary_sup_sup_boundary_inf_right : ∂ b ≤ ∂ (a ⊔ b) ⊔ ∂ (a ⊓ b) := by
  rw [@sup_comm _ _ a, inf_comm]
  exact boundary_le_boundary_sup_sup_boundary_inf_left
#align coheyting.boundary_le_boundary_sup_sup_boundary_inf_right Coheyting.boundary_le_boundary_sup_sup_boundary_inf_right

theorem boundary_sup_sup_boundary_inf (a b : α) : ∂ (a ⊔ b) ⊔ ∂ (a ⊓ b) = ∂ a ⊔ ∂ b :=
  le_antisymm (sup_le boundary_sup_le boundary_inf_le) <|
    sup_le boundary_le_boundary_sup_sup_boundary_inf_left
      boundary_le_boundary_sup_sup_boundary_inf_right
#align coheyting.boundary_sup_sup_boundary_inf Coheyting.boundary_sup_sup_boundary_inf

@[simp]
theorem boundary_idem (a : α) : ∂ ∂ a = ∂ a := by rw [boundary, hnot_boundary, inf_top_eq]
#align coheyting.boundary_idem Coheyting.boundary_idem

theorem hnot_hnot_sup_boundary (a : α) : ￢￢a ⊔ ∂ a = a := by
  rw [boundary, sup_inf_left, hnot_sup_self, inf_top_eq, sup_eq_right]
  exact hnot_hnot_le
#align coheyting.hnot_hnot_sup_boundary Coheyting.hnot_hnot_sup_boundary

theorem hnot_eq_top_iff_exists_boundary : ￢a = ⊤ ↔ ∃ b, ∂ b = a :=
  ⟨fun h => ⟨a, by rw [boundary, h, inf_top_eq]⟩, by
    rintro ⟨b, rfl⟩
    exact hnot_boundary _⟩
#align coheyting.hnot_eq_top_iff_exists_boundary Coheyting.hnot_eq_top_iff_exists_boundary

end Coheyting

open Heyting

section BooleanAlgebra

variable [BooleanAlgebra α]

@[simp]
theorem Coheyting.boundary_eq_bot (a : α) : ∂ a = ⊥ :=
  inf_compl_eq_bot
#align coheyting.boundary_eq_bot Coheyting.boundary_eq_bot

end BooleanAlgebra


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Sébastien Gouëzel

Construction of a good coupling between nonempty compact metric spaces, minimizing
their Hausdorff distance. This construction is instrumental to study the Gromov-Hausdorff
distance between nonempty compact metric spaces -/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.metric_space.gluing
import Mathlib.topology.metric_space.hausdorff_distance
import Mathlib.PostPort

universes u v

namespace Mathlib

namespace Gromov_Hausdorff

/- This section shows that the Gromov-Hausdorff distance
is realized. For this, we consider candidate distances on the disjoint union
α ⊕ β of two compact nonempty metric spaces, almost realizing the Gromov-Hausdorff
distance, and show that they form a compact family by applying Arzela-Ascoli
theorem. The existence of a minimizer follows. -/

/-- The set of functions on α ⊕ β that are candidates distances to realize the
minimum of the Hausdorff distances between α and β in a coupling -/
def candidates (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] : set (prod_space_fun α β) :=
  set_of
    fun (f : prod_space_fun α β) =>
      (((((∀ (x y : α), f (sum.inl x, sum.inl y) = dist x y) ∧ ∀ (x y : β), f (sum.inr x, sum.inr y) = dist x y) ∧
              ∀ (x y : α ⊕ β), f (x, y) = f (y, x)) ∧
            ∀ (x y z : α ⊕ β), f (x, z) ≤ f (x, y) + f (y, z)) ∧
          ∀ (x : α ⊕ β), f (x, x) = 0) ∧
        ∀ (x y : α ⊕ β), f (x, y) ≤ ↑(max_var α β)

/-- Version of the set of candidates in bounded_continuous_functions, to apply
Arzela-Ascoli -/
/-- candidates are bounded by max_var α β -/
/-- Technical lemma to prove that candidates are Lipschitz -/
/-- Candidates are Lipschitz -/
/-- candidates give rise to elements of bounded_continuous_functions -/
def candidates_b_of_candidates {α : Type u} {β : Type v} [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] (f : prod_space_fun α β) (fA : f ∈ candidates α β) : Cb α β :=
  bounded_continuous_function.mk_of_compact f sorry

theorem candidates_b_of_candidates_mem {α : Type u} {β : Type v} [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] (f : prod_space_fun α β) (fA : f ∈ candidates α β) : candidates_b_of_candidates f fA ∈ candidates_b α β :=
  fA

/-- The distance on α ⊕ β is a candidate -/
def candidates_b_dist (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Inhabited α] [metric_space β] [compact_space β] [Inhabited β] : Cb α β :=
  candidates_b_of_candidates (fun (p : (α ⊕ β) × (α ⊕ β)) => dist (prod.fst p) (prod.snd p)) sorry

theorem candidates_b_dist_mem_candidates_b {α : Type u} {β : Type v} [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] : candidates_b_dist α β ∈ candidates_b α β :=
  candidates_b_of_candidates_mem (fun (p : (α ⊕ β) × (α ⊕ β)) => dist (prod.fst p) (prod.snd p))
    (candidates_b_dist._proof_1 α β)

/-- To apply Arzela-Ascoli, we need to check that the set of candidates is closed and equicontinuous.
Equicontinuity follows from the Lipschitz control, we check closedness -/
/-- Compactness of candidates (in bounded_continuous_functions) follows -/
/-- We will then choose the candidate minimizing the Hausdorff distance. Except that we are not
in a metric space setting, so we need to define our custom version of Hausdorff distance,
called HD, and prove its basic properties. -/
def HD {α : Type u} {β : Type v} [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] (f : Cb α β) : ℝ :=
  max (supr fun (x : α) => infi fun (y : β) => coe_fn f (sum.inl x, sum.inr y))
    (supr fun (y : β) => infi fun (x : α) => coe_fn f (sum.inl x, sum.inr y))

/- We will show that HD is continuous on bounded_continuous_functions, to deduce that its
minimum on the compact set candidates_b is attained. Since it is defined in terms of
infimum and supremum on ℝ, which is only conditionnally complete, we will need all the time
to check that the defining sets are bounded below or above. This is done in the next few
technical lemmas -/

theorem HD_below_aux1 {α : Type u} {β : Type v} [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] {f : Cb α β} (C : ℝ) {x : α} : bdd_below (set.range fun (y : β) => coe_fn f (sum.inl x, sum.inr y) + C) := sorry

theorem HD_below_aux2 {α : Type u} {β : Type v} [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] {f : Cb α β} (C : ℝ) {y : β} : bdd_below (set.range fun (x : α) => coe_fn f (sum.inl x, sum.inr y) + C) := sorry

/-- Explicit bound on HD (dist). This means that when looking for minimizers it will
be sufficient to look for functions with HD(f) bounded by this bound. -/
theorem HD_candidates_b_dist_le {α : Type u} {β : Type v} [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] : HD (candidates_b_dist α β) ≤ metric.diam set.univ + 1 + metric.diam set.univ := sorry

/- To check that HD is continuous, we check that it is Lipschitz. As HD is a max, we
prove separately inequalities controlling the two terms (relying too heavily on copy-paste...) -/

/-- Conclude that HD, being Lipschitz, is continuous -/
/- Now that we have proved that the set of candidates is compact, and that HD is continuous,
we can finally select a candidate minimizing HD. This will be the candidate realizing the
optimal coupling. -/

/-- With the optimal candidate, construct a premetric space structure on α ⊕ β, on which the
predistance is given by the candidate. Then, we will identify points at 0 predistance
to obtain a genuine metric space -/
def premetric_optimal_GH_dist (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] : premetric_space (α ⊕ β) :=
  premetric_space.mk sorry sorry sorry

/-- A metric space which realizes the optimal coupling between α and β -/
def optimal_GH_coupling (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] :=
  premetric.metric_quot (α ⊕ β)

/-- Injection of α in the optimal coupling between α and β -/
def optimal_GH_injl (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] (x : α) : optimal_GH_coupling α β :=
  quotient.mk (sum.inl x)

/-- The injection of α in the optimal coupling between α and β is an isometry. -/
theorem isometry_optimal_GH_injl (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] : isometry (optimal_GH_injl α β) :=
  iff.mpr isometry_emetric_iff_metric fun (x y : α) => id (candidates_dist_inl (optimal_GH_dist_mem_candidates_b α β) x y)

/-- Injection of β  in the optimal coupling between α and β -/
def optimal_GH_injr (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] (y : β) : optimal_GH_coupling α β :=
  quotient.mk (sum.inr y)

/-- The injection of β in the optimal coupling between α and β is an isometry. -/
theorem isometry_optimal_GH_injr (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] : isometry (optimal_GH_injr α β) :=
  iff.mpr isometry_emetric_iff_metric fun (x y : β) => id (candidates_dist_inr (optimal_GH_dist_mem_candidates_b α β) x y)

/-- The optimal coupling between two compact spaces α and β is still a compact space -/
protected instance compact_space_optimal_GH_coupling (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] : compact_space (optimal_GH_coupling α β) := sorry

/-- For any candidate f, HD(f) is larger than or equal to the Hausdorff distance in the
optimal coupling. This follows from the fact that HD of the optimal candidate is exactly
the Hausdorff distance in the optimal coupling, although we only prove here the inequality
we need. -/
theorem Hausdorff_dist_optimal_le_HD (α : Type u) (β : Type v) [metric_space α] [compact_space α] [Nonempty α] [metric_space β] [compact_space β] [Nonempty β] {f : Cb α β} (h : f ∈ candidates_b α β) : metric.Hausdorff_dist (set.range (optimal_GH_injl α β)) (set.range (optimal_GH_injr α β)) ≤ HD f := sorry


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.multiset.powerset

/-!
# The antidiagonal on a multiset.

The antidiagonal of a multiset `s` consists of all pairs `(t₁, t₂)`
such that `t₁ + t₂ = s`. These pairs are counted with multiplicities.
-/

namespace multiset
open list

variables {α β : Type*}

/-- The antidiagonal of a multiset `s` consists of all pairs `(t₁, t₂)`
    such that `t₁ + t₂ = s`. These pairs are counted with multiplicities. -/
def antidiagonal (s : multiset α) : multiset (multiset α × multiset α) :=
quot.lift_on s
  (λ l, (revzip (powerset_aux l) : multiset (multiset α × multiset α)))
  (λ l₁ l₂ h, quot.sound (revzip_powerset_aux_perm h))

theorem antidiagonal_coe (l : list α) :
  @antidiagonal α l = revzip (powerset_aux l) := rfl

@[simp] theorem antidiagonal_coe' (l : list α) :
  @antidiagonal α l = revzip (powerset_aux' l) :=
quot.sound revzip_powerset_aux_perm_aux'

/-- A pair `(t₁, t₂)` of multisets is contained in `antidiagonal s`
    if and only if `t₁ + t₂ = s`. -/
@[simp] theorem mem_antidiagonal {s : multiset α} {x : multiset α × multiset α} :
  x ∈ antidiagonal s ↔ x.1 + x.2 = s :=
quotient.induction_on s $ λ l, begin
  simp [antidiagonal_coe], refine ⟨λ h, revzip_powerset_aux h, λ h, _⟩,
  haveI := classical.dec_eq α,
  simp [revzip_powerset_aux_lemma l revzip_powerset_aux, h.symm],
  cases x with x₁ x₂,
  dsimp only,
  exact ⟨x₁, le_add_right _ _, by rw add_tsub_cancel_left x₁ x₂⟩
end

@[simp] theorem antidiagonal_map_fst (s : multiset α) :
  (antidiagonal s).map prod.fst = powerset s :=
quotient.induction_on s $ λ l,
by simp [powerset_aux']

@[simp] theorem antidiagonal_map_snd (s : multiset α) :
  (antidiagonal s).map prod.snd = powerset s :=
quotient.induction_on s $ λ l,
by simp [powerset_aux']

@[simp] theorem antidiagonal_zero : @antidiagonal α 0 = {(0, 0)} := rfl

@[simp] theorem antidiagonal_cons (a : α) (s) : antidiagonal (a ::ₘ s) =
  map (prod.map id (cons a)) (antidiagonal s) +
  map (prod.map (cons a) id) (antidiagonal s) :=
quotient.induction_on s $ λ l, begin
  simp only [revzip, reverse_append, quot_mk_to_coe, coe_eq_coe, powerset_aux'_cons, cons_coe,
    coe_map, antidiagonal_coe', coe_add],
  rw [← zip_map, ← zip_map, zip_append, (_ : _++_=_)],
  {congr; simp}, {simp}
end

@[simp] theorem card_antidiagonal (s : multiset α) :
  card (antidiagonal s) = 2 ^ card s :=
by have := card_powerset s;
   rwa [← antidiagonal_map_fst, card_map] at this

lemma prod_map_add [comm_semiring β] {s : multiset α} {f g : α → β} :
  prod (s.map (λa, f a + g a)) =
  sum ((antidiagonal s).map (λp, (p.1.map f).prod * (p.2.map g).prod)) :=
begin
  refine s.induction_on _ _,
  { simp },
  { assume a s ih,
    have := @sum_map_mul_left α β _,
    simp [ih, add_mul, mul_comm, mul_left_comm (f a), mul_left_comm (g a), mul_assoc,
      sum_map_mul_left.symm],
    cc },
end

end multiset


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis

The power operation on monoids and groups. We separate this from group, because it depends on
nat, which in turn depends on other parts of algebra.

We have "pow a n" for natural number powers, and "gpow a i" for integer powers. The notation
a^n is used for the first, but users can locally redefine it to gpow when needed.

Note: power adopts the convention that 0^0=1.
-/
import algebra.char_zero algebra.group algebra.ordered_field
import data.int.basic data.list.basic

universes u v
variable {α : Type u}

@[simp] theorem inv_one [division_ring α] : (1⁻¹ : α) = 1 := by rw [inv_eq_one_div, one_div_one]

@[simp] theorem inv_inv' [discrete_field α] {a:α} : a⁻¹⁻¹ = a :=
by rw [inv_eq_one_div, inv_eq_one_div, div_div_eq_mul_div, one_mul, div_one]

/-- The power operation in a monoid. `a^n = a*a*...*a` n times. -/
def monoid.pow [monoid α] (a : α) : ℕ → α
| 0     := 1
| (n+1) := a * monoid.pow n

def add_monoid.smul [add_monoid α] (n : ℕ) (a : α) : α :=
@monoid.pow (multiplicative α) _ a n

precedence `•`:70
local infix ` • ` := add_monoid.smul

@[priority 5] instance monoid.has_pow [monoid α] : has_pow α ℕ := ⟨monoid.pow⟩

 /- monoid -/
section monoid
variables [monoid α] {β : Type u} [add_monoid β]

@[simp] theorem pow_zero (a : α) : a^0 = 1 := rfl
@[simp] theorem add_monoid.zero_smul (a : β) : 0 • a = 0 := rfl
attribute [to_additive add_monoid.zero_smul] pow_zero

theorem pow_succ (a : α) (n : ℕ) : a^(n+1) = a * a^n := rfl
theorem succ_smul (a : β) (n : ℕ) : (n+1)•a = a + n•a := rfl
attribute [to_additive succ_smul] pow_succ

@[simp] theorem pow_one (a : α) : a^1 = a := mul_one _
@[simp] theorem add_monoid.one_smul (a : β) : 1•a = a := add_zero _
attribute [to_additive add_monoid.one_smul] pow_one

theorem pow_mul_comm' (a : α) (n : ℕ) : a^n * a = a * a^n :=
by induction n with n ih; [rw [pow_zero, one_mul, mul_one],
  rw [pow_succ, mul_assoc, ih]]
theorem smul_add_comm' : ∀ (a : β) (n : ℕ), n•a + a = a + n•a :=
@pow_mul_comm' (multiplicative β) _

theorem pow_succ' (a : α) (n : ℕ) : a^(n+1) = a^n * a :=
by rw [pow_succ, pow_mul_comm']
theorem succ_smul' (a : β) (n : ℕ) : (n+1)•a = n•a + a :=
by rw [succ_smul, smul_add_comm']
attribute [to_additive succ_smul'] pow_succ'

theorem pow_two (a : α) : a^2 = a * a :=
show a*(a*1)=a*a, by rw mul_one
theorem two_smul (a : β) : 2•a = a + a :=
show a+(a+0)=a+a, by rw add_zero
attribute [to_additive two_smul] pow_two

theorem pow_add (a : α) (m n : ℕ) : a^(m + n) = a^m * a^n :=
by induction n with n ih; [rw [add_zero, pow_zero, mul_one],
  rw [pow_succ, ← pow_mul_comm', ← mul_assoc, ← ih, ← pow_succ']]; refl
theorem add_monoid.add_smul : ∀ (a : β) (m n : ℕ), (m + n)•a = m•a + n•a :=
@pow_add (multiplicative β) _
attribute [to_additive add_monoid.add_smul] pow_add

@[simp] theorem one_pow (n : ℕ) : (1 : α)^n = (1:α) :=
by induction n with n ih; [refl, rw [pow_succ, ih, one_mul]]
@[simp] theorem add_monoid.smul_zero (n : ℕ) : n•(0 : β) = (0:β) :=
by induction n with n ih; [refl, rw [succ_smul, ih, zero_add]]
attribute [to_additive add_monoid.smul_zero] one_pow

theorem pow_mul (a : α) (m n : ℕ) : a^(m * n) = (a^m)^n :=
by induction n with n ih; [rw mul_zero, rw [nat.mul_succ, pow_add, pow_succ', ih]]; refl
theorem add_monoid.mul_smul' : ∀ (a : β) (m n : ℕ), m * n • a = n•(m•a) :=
@pow_mul (multiplicative β) _
attribute [to_additive add_monoid.mul_smul'] pow_mul

theorem pow_mul' (a : α) (m n : ℕ) : a^(m * n) = (a^n)^m :=
by rw [mul_comm, pow_mul]
theorem add_monoid.mul_smul (a : β) (m n : ℕ) : m * n • a = m•(n•a) :=
by rw [mul_comm, add_monoid.mul_smul']
attribute [to_additive add_monoid.mul_smul] pow_mul'

@[simp] theorem add_monoid.smul_one [has_one β] : ∀ n : ℕ, n • (1 : β) = n :=
nat.eq_cast _ (add_monoid.zero_smul _) (add_monoid.one_smul _) (add_monoid.add_smul _)

theorem pow_bit0 (a : α) (n : ℕ) : a ^ bit0 n = a^n * a^n := pow_add _ _ _
theorem bit0_smul (a : β) (n : ℕ) : bit0 n • a = n•a + n•a := add_monoid.add_smul _ _ _
attribute [to_additive bit0_smul] pow_bit0

theorem pow_bit1 (a : α) (n : ℕ) : a ^ bit1 n = a^n * a^n * a :=
by rw [bit1, pow_succ', pow_bit0]
theorem bit1_smul : ∀ (a : β) (n : ℕ), bit1 n • a = n•a + n•a + a :=
@pow_bit1 (multiplicative β) _
attribute [to_additive bit1_smul] pow_bit1

theorem pow_mul_comm (a : α) (m n : ℕ) : a^m * a^n = a^n * a^m :=
by rw [←pow_add, ←pow_add, add_comm]
theorem smul_add_comm : ∀ (a : β) (m n : ℕ), m•a + n•a = n•a + m•a :=
@pow_mul_comm (multiplicative β) _
attribute [to_additive smul_add_comm] pow_mul_comm

@[simp] theorem list.prod_repeat (a : α) (n : ℕ) : (list.repeat a n).prod = a ^ n :=
by induction n with n ih; [refl, rw [list.repeat_succ, list.prod_cons, ih]]; refl
@[simp] theorem list.sum_repeat : ∀ (a : β) (n : ℕ), (list.repeat a n).sum = n • a :=
@list.prod_repeat (multiplicative β) _
attribute [to_additive list.sum_repeat] list.prod_repeat

@[simp] lemma units.coe_pow (u : units α) (n : ℕ) : ((u ^ n : units α) : α) = u ^ n :=
by induction n; simp [*, pow_succ]

end monoid

namespace is_monoid_hom
variables {β : Type v} [monoid α] [monoid β] (f : α → β) [is_monoid_hom f]

theorem map_pow (a : α) : ∀(n : ℕ), f (a ^ n) = (f a) ^ n
| 0            := is_monoid_hom.map_one f
| (nat.succ n) := by rw [pow_succ, is_monoid_hom.map_mul f, map_pow n]; refl

end is_monoid_hom

namespace is_add_monoid_hom
variables {β : Type*} [add_monoid α] [add_monoid β] (f : α → β) [is_add_monoid_hom f]

theorem map_smul (a : α) : ∀(n : ℕ), f (n • a) = n • (f a)
| 0            := is_add_monoid_hom.map_zero f
| (nat.succ n) := by rw [succ_smul, is_add_monoid_hom.map_add f, map_smul n]; refl

end is_add_monoid_hom

attribute [to_additive is_add_monoid_hom.map_smul] is_monoid_hom.map_pow

@[simp] theorem nat.pow_eq_pow (p q : ℕ) :
  @has_pow.pow _ _ monoid.has_pow p q = p ^ q :=
by induction q with q ih; [refl, rw [nat.pow_succ, pow_succ, mul_comm, ih]]

@[simp] theorem nat.smul_eq_mul (m n : ℕ) : m • n = m * n :=
by induction m with m ih; [rw [add_monoid.zero_smul, zero_mul],
  rw [succ_smul', ih, nat.succ_mul]]

/- commutative monoid -/

section comm_monoid
variables [comm_monoid α] {β : Type*} [add_comm_monoid β]

theorem mul_pow (a b : α) (n : ℕ) : (a * b)^n = a^n * b^n :=
by induction n with n ih; [exact (mul_one _).symm,
  simp only [pow_succ, ih, mul_assoc, mul_left_comm]]
theorem add_monoid.smul_add : ∀ (a b : β) (n : ℕ), n•(a + b) = n•a + n•b :=
@mul_pow (multiplicative β) _
attribute [to_additive add_monoid.add_smul] mul_pow

instance pow.is_monoid_hom (n : ℕ) : is_monoid_hom ((^ n) : α → α) :=
by refine_struct {..}; simp [mul_pow, one_pow]

instance add_monoid.smul.is_add_monoid_hom (n : ℕ) : is_add_monoid_hom (add_monoid.smul n : β → β) :=
by refine_struct {..}; simp [add_monoid.smul_zero, add_monoid.smul_add]

attribute [to_additive add_monoid.smul.is_add_monoid_hom] pow.is_monoid_hom

end comm_monoid

section group
variables [group α] {β : Type*} [add_group β]

section nat

@[simp] theorem inv_pow (a : α) (n : ℕ) : (a⁻¹)^n = (a^n)⁻¹ :=
by induction n with n ih; [exact one_inv.symm,
  rw [pow_succ', pow_succ, ih, mul_inv_rev]]
@[simp] theorem add_monoid.neg_smul : ∀ (a : β) (n : ℕ), n•(-a) = -(n•a) :=
@inv_pow (multiplicative β) _
attribute [to_additive add_monoid.neg_smul] inv_pow

theorem pow_sub (a : α) {m n : ℕ} (h : m ≥ n) : a^(m - n) = a^m * (a^n)⁻¹ :=
have h1 : m - n + n = m, from nat.sub_add_cancel h,
have h2 : a^(m - n) * a^n = a^m, by rw [←pow_add, h1],
eq_mul_inv_of_mul_eq h2
theorem add_monoid.smul_sub : ∀ (a : β) {m n : ℕ}, m ≥ n → (m - n)•a = m•a - n•a :=
@pow_sub (multiplicative β) _
attribute [to_additive add_monoid.smul_sub] inv_pow

theorem pow_inv_comm (a : α) (m n : ℕ) : (a⁻¹)^m * a^n = a^n * (a⁻¹)^m :=
by rw inv_pow; exact inv_comm_of_comm (pow_mul_comm _ _ _)
theorem add_monoid.smul_neg_comm : ∀ (a : β) (m n : ℕ), m•(-a) + n•a = n•a + m•(-a) :=
@pow_inv_comm (multiplicative β) _
attribute [to_additive add_monoid.smul_neg_comm] pow_inv_comm
end nat

open int

/--
The power operation in a group. This extends `monoid.pow` to negative integers
with the definition `a^(-n) = (a^n)⁻¹`.
-/
def gpow (a : α) : ℤ → α
| (of_nat n) := a^n
| -[1+n]     := (a^(nat.succ n))⁻¹

def gsmul (n : ℤ) (a : β) : β :=
@gpow (multiplicative β) _ a n

@[priority 10] instance group.has_pow : has_pow α ℤ := ⟨gpow⟩

local infix ` • `:70 := gsmul
local infix ` •ℕ `:70 := add_monoid.smul

@[simp] theorem gpow_coe_nat (a : α) (n : ℕ) : a ^ (n:ℤ) = a ^ n := rfl
@[simp] theorem gsmul_coe_nat (a : β) (n : ℕ) : (n:ℤ) • a = n •ℕ a := rfl
attribute [to_additive gsmul_coe_nat] gpow_coe_nat

@[simp] theorem gpow_of_nat (a : α) (n : ℕ) : a ^ of_nat n = a ^ n := rfl
@[simp] theorem gsmul_of_nat (a : β) (n : ℕ) : of_nat n • a = n •ℕ a := rfl
attribute [to_additive gsmul_of_nat] gpow_of_nat

@[simp] theorem gpow_neg_succ (a : α) (n : ℕ) : a ^ -[1+n] = (a ^ n.succ)⁻¹ := rfl
@[simp] theorem gsmul_neg_succ (a : β) (n : ℕ) : -[1+n] • a = - (n.succ •ℕ a) := rfl
attribute [to_additive gsmul_neg_succ] gpow_neg_succ

local attribute [ematch] le_of_lt
open nat

@[simp] theorem gpow_zero (a : α) : a ^ (0:ℤ) = 1 := rfl
@[simp] theorem zero_gsmul (a : β) : (0:ℤ) • a = 0 := rfl
attribute [to_additive zero_gsmul] gpow_zero

@[simp] theorem gpow_one (a : α) : a ^ (1:ℤ) = a := mul_one _
@[simp] theorem one_gsmul (a : β) : (1:ℤ) • a = a := add_zero _
attribute [to_additive one_gsmul] gpow_one

@[simp] theorem one_gpow : ∀ (n : ℤ), (1 : α) ^ n = 1
| (n : ℕ) := one_pow _
| -[1+ n] := show _⁻¹=(1:α), by rw [_root_.one_pow, one_inv]
@[simp] theorem gsmul_zero : ∀ (n : ℤ), n • (0 : β) = 0 :=
@one_gpow (multiplicative β) _
attribute [to_additive gsmul_zero] one_gpow

@[simp] theorem gpow_neg (a : α) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹
| (n+1:ℕ) := rfl
| 0       := one_inv.symm
| -[1+ n] := (inv_inv _).symm

@[simp] theorem neg_gsmul : ∀ (a : β) (n : ℤ), -n • a = -(n • a) :=
@gpow_neg (multiplicative β) _
attribute [to_additive neg_gsmul] gpow_neg

theorem gpow_neg_one (x : α) : x ^ (-1:ℤ) = x⁻¹ := congr_arg has_inv.inv $ pow_one x
theorem neg_one_gsmul (x : β) : (-1:ℤ) • x = -x := congr_arg has_neg.neg $ add_monoid.one_smul x
attribute [to_additive neg_one_gsmul] gpow_neg_one

theorem inv_gpow (a : α) : ∀n:ℤ, a⁻¹ ^ n = (a ^ n)⁻¹
| (n : ℕ) := inv_pow a n
| -[1+ n] := congr_arg has_inv.inv $ inv_pow a (n+1)

private lemma gpow_add_aux (a : α) (m n : nat) :
  a ^ ((of_nat m) + -[1+n]) = a ^ of_nat m * a ^ -[1+n] :=
or.elim (nat.lt_or_ge m (nat.succ n))
 (assume h1 : m < succ n,
  have h2 : m ≤ n, from le_of_lt_succ h1,
  suffices a ^ -[1+ n-m] = a ^ of_nat m * a ^ -[1+n],
    by rwa [of_nat_add_neg_succ_of_nat_of_lt h1],
  show (a ^ nat.succ (n - m))⁻¹ = a ^ of_nat m * a ^ -[1+n],
  by rw [← succ_sub h2, pow_sub _ (le_of_lt h1), mul_inv_rev, inv_inv]; refl)
 (assume : m ≥ succ n,
  suffices a ^ (of_nat (m - succ n)) = (a ^ (of_nat m)) * (a ^ -[1+ n]),
    by rw [of_nat_add_neg_succ_of_nat_of_ge]; assumption,
  suffices a ^ (m - succ n) = a ^ m * (a ^ n.succ)⁻¹, from this,
  by rw pow_sub; assumption)

theorem gpow_add (a : α) : ∀ (i j : ℤ), a ^ (i + j) = a ^ i * a ^ j
| (of_nat m) (of_nat n) := pow_add _ _ _
| (of_nat m) -[1+n]     := gpow_add_aux _ _ _
| -[1+m]     (of_nat n) := by rw [add_comm, gpow_add_aux,
  gpow_neg_succ, gpow_of_nat, ← inv_pow, ← pow_inv_comm]
| -[1+m]     -[1+n]     :=
  suffices (a ^ (m + succ (succ n)))⁻¹ = (a ^ m.succ)⁻¹ * (a ^ n.succ)⁻¹, from this,
  by rw [← succ_add_eq_succ_add, add_comm, _root_.pow_add, mul_inv_rev]

theorem add_gsmul : ∀ (a : β) (i j : ℤ), (i + j) • a = i • a + j • a :=
@gpow_add (multiplicative β) _

theorem gpow_add_one (a : α) (i : ℤ) : a ^ (i + 1) = a ^ i * a :=
by rw [gpow_add, gpow_one]
theorem add_one_gsmul : ∀ (a : β) (i : ℤ), (i + 1) • a = i • a + a :=
@gpow_add_one (multiplicative β) _
attribute [to_additive add_one_gsmul] gpow_add_one

theorem gpow_one_add (a : α) (i : ℤ) : a ^ (1 + i) = a * a ^ i :=
by rw [gpow_add, gpow_one]
theorem one_add_gsmul : ∀ (a : β) (i : ℤ), (1 + i) • a = a + i • a :=
@gpow_one_add (multiplicative β) _
attribute [to_additive one_add_gsmul] gpow_one_add

theorem gpow_mul_comm (a : α) (i j : ℤ) : a ^ i * a ^ j = a ^ j * a ^ i :=
by rw [← gpow_add, ← gpow_add, add_comm]
theorem gsmul_add_comm : ∀ (a : β) (i j), i • a + j • a = j • a + i • a :=
@gpow_mul_comm (multiplicative β) _
attribute [to_additive gsmul_add_comm] gpow_mul_comm

theorem gpow_mul (a : α) : ∀ m n : ℤ, a ^ (m * n) = (a ^ m) ^ n
| (m : ℕ) (n : ℕ) := pow_mul _ _ _
| (m : ℕ) -[1+ n] := (gpow_neg _ (m * succ n)).trans $
  show (a ^ (m * succ n))⁻¹ = _, by rw pow_mul; refl
| -[1+ m] (n : ℕ) := (gpow_neg _ (succ m * n)).trans $
  show (a ^ (m.succ * n))⁻¹ = _, by rw [pow_mul, ← inv_pow]; refl
| -[1+ m] -[1+ n] := (pow_mul a (succ m) (succ n)).trans $
  show _ = (_⁻¹^_)⁻¹, by rw [inv_pow, inv_inv]
theorem gsmul_mul' : ∀ (a : β) (m n : ℤ), m * n • a = n • (m • a) :=
@gpow_mul (multiplicative β) _
attribute [to_additive gsmul_mul'] gpow_mul

theorem gpow_mul' (a : α) (m n : ℤ) : a ^ (m * n) = (a ^ n) ^ m :=
by rw [mul_comm, gpow_mul]
theorem gsmul_mul (a : β) (m n : ℤ) : m * n • a = m • (n • a) :=
by rw [mul_comm, gsmul_mul']
attribute [to_additive gsmul_mul] gpow_mul'

theorem gpow_bit0 (a : α) (n : ℤ) : a ^ bit0 n = a ^ n * a ^ n := gpow_add _ _ _
theorem bit0_gsmul (a : β) (n : ℤ) : bit0 n • a = n • a + n • a := gpow_add _ _ _
attribute [to_additive bit0_gsmul] gpow_bit0

theorem gpow_bit1 (a : α) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a :=
by rw [bit1, gpow_add]; simp [gpow_bit0]
theorem bit1_gsmul : ∀ (a : β) (n : ℤ), bit1 n • a = n • a + n • a + a :=
@gpow_bit1 (multiplicative β) _
attribute [to_additive bit1_gsmul] gpow_bit1

theorem gsmul_neg (a : β) (n : ℤ) : gsmul n (- a) = - gsmul n a :=
begin
  induction n using int.induction_on with z ih z ih,
  { simp },
  { rw [add_comm] {occs := occurrences.pos [1]}, simp [add_gsmul, ih, -add_comm] },
  { rw [sub_eq_add_neg, add_comm] {occs := occurrences.pos [1]},
    simp [ih, add_gsmul, neg_gsmul, -add_comm] }
end
attribute [to_additive gsmul_neg] gpow_neg

end group

namespace is_group_hom
variables {β : Type v} [group α] [group β] (f : α → β) [is_group_hom f]

theorem pow (a : α) (n : ℕ) : f (a ^ n) = f a ^ n :=
is_monoid_hom.map_pow f a n

theorem gpow (a : α) (n : ℤ) : f (a ^ n) = f a ^ n :=
by cases n; [exact is_group_hom.pow f _ _,
  exact (is_group_hom.inv f _).trans (congr_arg _ $ is_group_hom.pow f _ _)]

end is_group_hom

namespace is_add_group_hom
variables {β : Type v} [add_group α] [add_group β] (f : α → β) [is_add_group_hom f]

theorem smul (a : α) (n : ℕ) : f (n • a) = n • f a :=
is_add_monoid_hom.map_smul f a n

theorem gsmul (a : α) (n : ℤ) : f (gsmul n a) = gsmul n (f a) :=
begin
  induction n using int.induction_on with z ih z ih,
  { simp [is_add_group_hom.zero f] },
  { simp [is_add_group_hom.add f, add_gsmul, ih] },
  { simp [is_add_group_hom.add f, is_add_group_hom.neg f, add_gsmul, ih] }
end

end is_add_group_hom

local infix ` •ℤ `:70 := gsmul

section comm_monoid
variables [comm_group α] {β : Type*} [add_comm_group β]

theorem mul_gpow (a b : α) : ∀ n:ℤ, (a * b)^n = a^n * b^n
| (n : ℕ) := mul_pow a b n
| -[1+ n] := show _⁻¹=_⁻¹*_⁻¹, by rw [mul_pow, mul_inv_rev, mul_comm]
theorem gsmul_add : ∀ (a b : β) (n : ℤ), n •ℤ (a + b) = n •ℤ a + n •ℤ b :=
@mul_gpow (multiplicative β) _
attribute [to_additive gsmul_add] mul_gpow

theorem gsmul_sub : ∀ (a b : β) (n : ℤ), gsmul n (a - b) = gsmul n a - gsmul n b :=
by simp [gsmul_add, gsmul_neg]

instance gpow.is_group_hom (n : ℤ) : is_group_hom ((^ n) : α → α) :=
⟨λ _ _, mul_gpow _ _ n⟩

instance gsmul.is_add_group_hom (n : ℤ) : is_add_group_hom (gsmul n : β → β) :=
⟨λ _ _, gsmul_add _ _ n⟩

attribute [to_additive gsmul.is_add_group_hom] gpow.is_group_hom

end comm_monoid

section group

@[instance]
theorem is_add_group_hom_gsmul
  {α β} [add_group α] [add_comm_group β] (f : α → β) [is_add_group_hom f] (z : ℤ) :
  is_add_group_hom (λa, gsmul z (f a)) :=
⟨assume a b, by rw [is_add_group_hom.add f, gsmul_add]⟩

end group

@[simp] lemma with_bot.coe_smul [add_monoid α] (a : α) (n : ℕ) :
  ((add_monoid.smul n a : α) : with_bot α) = add_monoid.smul n a :=
by induction n; simp [*, succ_smul]; refl

theorem add_monoid.smul_eq_mul' [semiring α] (a : α) (n : ℕ) : n • a = a * n :=
by induction n with n ih; [rw [add_monoid.zero_smul, nat.cast_zero, mul_zero],
  rw [succ_smul', ih, nat.cast_succ, mul_add, mul_one]]

theorem add_monoid.smul_eq_mul [semiring α] (n : ℕ) (a : α) : n • a = n * a :=
by rw [add_monoid.smul_eq_mul', nat.mul_cast_comm]

theorem add_monoid.mul_smul_left [semiring α] (a b : α) (n : ℕ) : n • (a * b) = a * (n • b) :=
by rw [add_monoid.smul_eq_mul', add_monoid.smul_eq_mul', mul_assoc]

theorem add_monoid.mul_smul_assoc [semiring α] (a b : α) (n : ℕ) : n • (a * b) = n • a * b :=
by rw [add_monoid.smul_eq_mul, add_monoid.smul_eq_mul, mul_assoc]

lemma zero_pow [semiring α] : ∀ {n : ℕ}, 0 < n → (0 : α) ^ n = 0
| (n+1) _ := zero_mul _

@[simp] theorem nat.cast_pow [semiring α] (n m : ℕ) : (↑(n ^ m) : α) = ↑n ^ m :=
by induction m with m ih; [exact nat.cast_one, rw [nat.pow_succ, pow_succ', nat.cast_mul, ih]]

@[simp] theorem int.coe_nat_pow (n m : ℕ) : ((n ^ m : ℕ) : ℤ) = n ^ m :=
by induction m with m ih; [exact int.coe_nat_one, rw [nat.pow_succ, pow_succ', int.coe_nat_mul, ih]]

theorem int.nat_abs_pow (n : ℤ) (k : ℕ) : int.nat_abs (n ^ k) = (int.nat_abs n) ^ k :=
by induction k with k ih; [refl, rw [pow_succ', int.nat_abs_mul, nat.pow_succ, ih]]

theorem is_semiring_hom.map_pow {β} [semiring α] [semiring β]
  (f : α → β) [is_semiring_hom f] (x : α) (n : ℕ) : f (x ^ n) = f x ^ n :=
by induction n with n ih; [exact is_semiring_hom.map_one f,
  rw [pow_succ, pow_succ, is_semiring_hom.map_mul f, ih]]

theorem neg_one_pow_eq_or {R} [ring R] : ∀ n : ℕ, (-1 : R)^n = 1 ∨ (-1 : R)^n = -1
| 0     := or.inl rfl
| (n+1) := (neg_one_pow_eq_or n).swap.imp
  (λ h, by rw [pow_succ, h, neg_one_mul, neg_neg])
  (λ h, by rw [pow_succ, h, mul_one])

lemma pow_dvd_pow [comm_semiring α] (a : α) {m n : ℕ} (h : m ≤ n) :
  a ^ m ∣ a ^ n := ⟨a ^ (n - m), by rw [← pow_add, nat.add_sub_cancel' h]⟩

theorem gsmul_eq_mul [ring α] (a : α) : ∀ n, n •ℤ a = n * a
| (n : ℕ) := add_monoid.smul_eq_mul _ _
| -[1+ n] := show -(_•_)=-_*_, by rw [neg_mul_eq_neg_mul_symm, add_monoid.smul_eq_mul, nat.cast_succ]

theorem gsmul_eq_mul' [ring α] (a : α) (n : ℤ) : n •ℤ a = a * n :=
by rw [gsmul_eq_mul, int.mul_cast_comm]

theorem mul_gsmul_left [ring α] (a b : α) (n : ℤ) : n •ℤ (a * b) = a * (n •ℤ b) :=
by rw [gsmul_eq_mul', gsmul_eq_mul', mul_assoc]

theorem mul_gsmul_assoc [ring α] (a b : α) (n : ℤ) : n •ℤ (a * b) = n •ℤ a * b :=
by rw [gsmul_eq_mul, gsmul_eq_mul, mul_assoc]

@[simp] theorem int.cast_pow [ring α] (n : ℤ) (m : ℕ) : (↑(n ^ m) : α) = ↑n ^ m :=
by induction m with m ih; [exact int.cast_one,
  rw [pow_succ, pow_succ, int.cast_mul, ih]]

lemma neg_one_pow_eq_pow_mod_two [ring α] {n : ℕ} : (-1 : α) ^ n = -1 ^ (n % 2) :=
by rw [← nat.mod_add_div n 2, pow_add, pow_mul]; simp [pow_two]

theorem pow_eq_zero [domain α] {x : α} {n : ℕ} (H : x^n = 0) : x = 0 :=
begin
  induction n with n ih,
  { rw pow_zero at H,
    rw [← mul_one x, H, mul_zero] },
  exact or.cases_on (mul_eq_zero.1 H) id ih
end

theorem pow_ne_zero [domain α] {a : α} (n : ℕ) (h : a ≠ 0) : a ^ n ≠ 0 :=
mt pow_eq_zero h

@[simp] theorem one_div_pow [division_ring α] {a : α} (ha : a ≠ 0) (n : ℕ) : (1 / a) ^ n = 1 / a ^ n :=
by induction n with n ih; [exact (div_one _).symm,
  rw [pow_succ', ih, division_ring.one_div_mul_one_div (pow_ne_zero _ ha) ha]]; refl

@[simp] theorem division_ring.inv_pow [division_ring α] {a : α} (ha : a ≠ 0) (n : ℕ) : a⁻¹ ^ n = (a ^ n)⁻¹ :=
by simpa only [inv_eq_one_div] using one_div_pow ha n

@[simp] theorem div_pow [field α] (a : α) {b : α} (hb : b ≠ 0) (n : ℕ) : (a / b) ^ n = a ^ n / b ^ n :=
by rw [div_eq_mul_one_div, mul_pow, one_div_pow hb, ← div_eq_mul_one_div]

theorem add_monoid.smul_nonneg [ordered_comm_monoid α] {a : α} (H : 0 ≤ a) : ∀ n : ℕ, 0 ≤ n • a
| 0     := le_refl _
| (n+1) := add_nonneg' H (add_monoid.smul_nonneg n)

lemma pow_abs [decidable_linear_ordered_comm_ring α] (a : α) (n : ℕ) : (abs a)^n = abs (a^n) :=
by induction n with n ih; [exact (abs_one).symm,
  rw [pow_succ, pow_succ, ih, abs_mul]]

lemma inv_pow' [discrete_field α] (a : α) (n : ℕ) : (a ^ n)⁻¹ = a⁻¹ ^ n :=
by induction n; simp [*, pow_succ, mul_inv', mul_comm]

lemma pow_inv [division_ring α] (a : α) : ∀ n : ℕ, a ≠ 0 → (a^n)⁻¹ = (a⁻¹)^n
| 0     ha := inv_one
| (n+1) ha := by rw [pow_succ, pow_succ', mul_inv_eq (pow_ne_zero _ ha) ha, pow_inv _ ha]

namespace add_monoid
variable [ordered_comm_monoid α]

theorem smul_le_smul {a : α} {n m : ℕ} (ha : 0 ≤ a) (h : n ≤ m) : n • a ≤ m • a :=
let ⟨k, hk⟩ := nat.le.dest h in
calc n • a = n • a + 0 : (add_zero _).symm
  ... ≤ n • a + k • a : add_le_add_left' (smul_nonneg ha _)
  ... = m • a : by rw [← hk, add_smul]

lemma smul_le_smul_of_le_right {a b : α} (hab : a ≤ b) : ∀ i : ℕ, i • a ≤ i • b
| 0 := by simp
| (k+1) := add_le_add' hab (smul_le_smul_of_le_right _)

end add_monoid

section linear_ordered_semiring
variable [linear_ordered_semiring α]

theorem pow_pos {a : α} (H : 0 < a) : ∀ (n : ℕ), 0 < a ^ n
| 0     := zero_lt_one
| (n+1) := mul_pos H (pow_pos _)

theorem pow_nonneg {a : α} (H : 0 ≤ a) : ∀ (n : ℕ), 0 ≤ a ^ n
| 0     := zero_le_one
| (n+1) := mul_nonneg H (pow_nonneg _)

theorem pow_lt_pow_of_lt_left {x y : α} {n : ℕ} (Hxy : x < y) (Hxpos : 0 ≤ x) (Hnpos : 0 < n) : x ^ n < y ^ n :=
begin
  cases lt_or_eq_of_le Hxpos,
  { rw ←nat.sub_add_cancel Hnpos,
    induction (n - 1), { simpa only [pow_one] },
    rw [pow_add, pow_add, nat.succ_eq_add_one, pow_one, pow_one],
    apply mul_lt_mul ih (le_of_lt Hxy) h (le_of_lt (pow_pos (lt_trans h Hxy) _)) },
  { rw [←h, zero_pow Hnpos], apply pow_pos (by rwa ←h at Hxy : 0 < y),}
end

theorem pow_right_inj {x y : α} {n : ℕ} (Hxpos : 0 ≤ x) (Hypos : 0 ≤ y) (Hnpos : 0 < n) (Hxyn : x ^ n = y ^ n) : x = y :=
begin
  rcases lt_trichotomy x y with hxy | rfl | hyx,
  { exact absurd Hxyn (ne_of_lt (pow_lt_pow_of_lt_left hxy Hxpos Hnpos)) },
  { refl },
  { exact absurd Hxyn (ne_of_gt (pow_lt_pow_of_lt_left hyx Hypos Hnpos)) },
end

theorem one_le_pow_of_one_le {a : α} (H : 1 ≤ a) : ∀ (n : ℕ), 1 ≤ a ^ n
| 0     := le_refl _
| (n+1) := by simpa only [mul_one] using mul_le_mul H (one_le_pow_of_one_le n)
    zero_le_one (le_trans zero_le_one H)

theorem pow_ge_one_add_mul {a : α} (H : a ≥ 0) :
  ∀ (n : ℕ), 1 + n • a ≤ (1 + a) ^ n
| 0     := le_of_eq $ add_zero _
| (n+1) := begin
  rw [pow_succ', succ_smul'],
  refine le_trans _ (mul_le_mul_of_nonneg_right
    (pow_ge_one_add_mul n) (add_nonneg zero_le_one H)),
  rw [mul_add, mul_one, ← add_assoc, add_le_add_iff_left],
  simpa only [one_mul] using mul_le_mul_of_nonneg_right
    ((le_add_iff_nonneg_right 1).2 (add_monoid.smul_nonneg H n)) H
end

theorem pow_le_pow {a : α} {n m : ℕ} (ha : 1 ≤ a) (h : n ≤ m) : a ^ n ≤ a ^ m :=
let ⟨k, hk⟩ := nat.le.dest h in
calc a ^ n = a ^ n * 1 : (mul_one _).symm
  ... ≤ a ^ n * a ^ k : mul_le_mul_of_nonneg_left
    (one_le_pow_of_one_le ha _)
    (pow_nonneg (le_trans zero_le_one ha) _)
  ... = a ^ m : by rw [←hk, pow_add]

lemma pow_le_pow_of_le_left {a b : α} (ha : 0 ≤ a) (hab : a ≤ b) : ∀ i : ℕ, a^i ≤ b^i
| 0     := by simp
| (k+1) := mul_le_mul hab (pow_le_pow_of_le_left _) (pow_nonneg ha _) (le_trans ha hab)

lemma lt_of_pow_lt_pow {a b : α} (n : ℕ) (hb : 0 ≤ b) (h : a ^ n < b ^ n) : a < b :=
lt_of_not_ge $ λ hn, not_lt_of_ge (pow_le_pow_of_le_left hb hn _) h

private lemma pow_lt_pow_of_lt_one_aux {a : α} (h : 0 < a) (ha : a < 1) (i : ℕ) :
  ∀ k : ℕ, a ^ (i + k + 1) < a ^ i
| 0 := begin simp, rw ←one_mul (a^i), exact mul_lt_mul ha (le_refl _) (pow_pos h _) zero_le_one end
| (k+1) :=
  begin
    rw ←one_mul (a^i),
    apply mul_lt_mul ha _ _ zero_le_one,
    { apply le_of_lt, apply pow_lt_pow_of_lt_one_aux },
    { show 0 < a ^ (i + (k + 1) + 0), apply pow_pos h }
  end

private lemma pow_le_pow_of_le_one_aux {a : α}  (h : 0 ≤ a) (ha : a ≤ 1) (i : ℕ) :
  ∀ k : ℕ, a ^ (i + k) ≤ a ^ i
| 0 := by simp
| (k+1) := by rw [←add_assoc, ←one_mul (a^i)];
              exact mul_le_mul ha (pow_le_pow_of_le_one_aux _) (pow_nonneg h _) zero_le_one

lemma pow_lt_pow_of_lt_one  {a : α} (h : 0 < a) (ha : a < 1)
  {i j : ℕ} (hij : i < j) : a ^ j < a ^ i :=
let ⟨k, hk⟩ := nat.exists_eq_add_of_lt hij in
by rw hk; exact pow_lt_pow_of_lt_one_aux h ha _ _

lemma pow_le_pow_of_le_one  {a : α} (h : 0 ≤ a) (ha : a ≤ 1)
  {i j : ℕ} (hij : i ≤ j) : a ^ j ≤ a ^ i :=
let ⟨k, hk⟩ := nat.exists_eq_add_of_le hij in
by rw hk; exact pow_le_pow_of_le_one_aux h ha _ _

lemma pow_le_one {x : α} : ∀ (n : ℕ) (h0 : 0 ≤ x) (h1 : x ≤ 1), x ^ n ≤ 1
| 0     h0 h1 := le_refl (1 : α)
| (n+1) h0 h1 := mul_le_one h1 (pow_nonneg h0 _) (pow_le_one n h0 h1)

end linear_ordered_semiring

theorem pow_two_nonneg [linear_ordered_ring α] (a : α) : 0 ≤ a ^ 2 :=
by rw pow_two; exact mul_self_nonneg _

theorem pow_ge_one_add_sub_mul [linear_ordered_ring α]
  {a : α} (H : a ≥ 1) (n : ℕ) : 1 + n • (a - 1) ≤ a ^ n :=
by simpa only [add_sub_cancel'_right] using pow_ge_one_add_mul (sub_nonneg.2 H) n

namespace int

lemma units_pow_two (u : units ℤ) : u ^ 2 = 1 :=
(units_eq_one_or u).elim (λ h, h.symm ▸ rfl) (λ h, h.symm ▸ rfl)

lemma units_pow_eq_pow_mod_two (u : units ℤ) (n : ℕ) : u ^ n = u ^ (n % 2) :=
by conv {to_lhs, rw ← nat.mod_add_div n 2}; rw [pow_add, pow_mul, units_pow_two, one_pow, mul_one]

end int

@[simp] lemma neg_square {α} [ring α] (z : α) : (-z)^2 = z^2 :=
by simp [pow, monoid.pow]

lemma div_sq_cancel {α} [field α] {a : α} (ha : a ≠ 0) (b : α) : a^2 * b / a = a * b :=
by rw [pow_two, mul_assoc, mul_div_cancel_left _ ha]