/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

! This file was ported from Lean 3 source module data.int.modeq
! leanprover-community/mathlib commit 2ed7e4aec72395b6a7c3ac4ac7873a7a43ead17c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Std.Data.Int.DivMod
import Mathlib.Data.Nat.ModEq
import Mathlib.Tactic.Ring

/-!

# Congruences modulo an integer

This file defines the equivalence relation `a ≡ b [ZMOD n]` on the integers, similarly to how
`Data.Nat.ModEq` defines them for the natural numbers. The notation is short for `n.ModEq a b`,
which is defined to be `a % n = b % n` for integers `a b n`.

## Tags

modeq, congruence, mod, MOD, modulo, integers

-/

namespace Int

/-- `a ≡ b [ZMOD n]` when `a % n = b % n`. -/
def ModEq (n a b : ℤ) :=
  a % n = b % n
#align int.modeq Int.ModEq

@[inherit_doc]
notation:50 a " ≡ " b " [ZMOD " n "]" => ModEq n a b

variable {m n a b c d : ℤ}

-- Porting note: This instance should be derivable automatically
instance : Decidable (ModEq n a b) := decEq (a % n) (b % n)

namespace ModEq

@[refl]
protected theorem refl (a : ℤ) : a ≡ a [ZMOD n] :=
  @rfl _ _
#align int.modeq.refl Int.ModEq.refl

protected theorem rfl : a ≡ a [ZMOD n] :=
  ModEq.refl _
#align int.modeq.rfl Int.ModEq.rfl

instance : IsRefl _ (ModEq n) :=
  ⟨ModEq.refl⟩

@[symm]
protected theorem symm : a ≡ b [ZMOD n] → b ≡ a [ZMOD n] :=
  Eq.symm
#align int.modeq.symm Int.ModEq.symm

@[trans]
protected theorem trans : a ≡ b [ZMOD n] → b ≡ c [ZMOD n] → a ≡ c [ZMOD n] :=
  Eq.trans
#align int.modeq.trans Int.ModEq.trans

instance : IsTrans ℤ (ModEq n) where
  trans := @Int.ModEq.trans n

end ModEq

theorem coe_nat_modEq_iff {a b n : ℕ} : a ≡ b [ZMOD n] ↔ a ≡ b [MOD n] := by
  unfold ModEq Nat.ModEq; rw [← Int.ofNat_inj]; simp [coe_nat_mod]
#align int.coe_nat_modeq_iff Int.coe_nat_modEq_iff

theorem _root_.Dvd.dvd.modEq_zero_int (h : n ∣ a) : a ≡ 0 [ZMOD n] :=
  modEq_zero_iff_dvd.2 h
#align has_dvd.dvd.modeq_zero_int Dvd.dvd.modEq_zero_int

theorem _root_.Dvd.dvd.zero_modEq_int (h : n ∣ a) : 0 ≡ a [ZMOD n] :=
  h.modEq_zero_int.symm
#align has_dvd.dvd.zero_modeq_int Dvd.dvd.zero_modEq_int

theorem modEq_iff_dvd : a ≡ b [ZMOD n] ↔ n ∣ b - a := by
  rw [ModEq, eq_comm]
  simp [emod_eq_emod_iff_emod_sub_eq_zero, dvd_iff_emod_eq_zero]

#align int.modeq_iff_dvd Int.modEq_iff_dvd

theorem modEq_iff_add_fac {a b n : ℤ} : a ≡ b [ZMOD n] ↔ ∃ t, b = a + n * t := by
  rw [modEq_iff_dvd]
  exact exists_congr fun t => sub_eq_iff_eq_add'
#align int.modeq_iff_add_fac Int.modEq_iff_add_fac

alias modEq_iff_dvd ↔ ModEq.dvd modEq_of_dvd
#align int.modeq.dvd Int.ModEq.dvd
#align int.modeq_of_dvd Int.modEq_of_dvd

theorem mod_modEq (a n) : a % n ≡ a [ZMOD n] :=
  emod_emod _ _
#align int.mod_modeq Int.mod_modEq

namespace ModEq

protected theorem of_dvd (d : m ∣ n) (h : a ≡ b [ZMOD n]) : a ≡ b [ZMOD m] :=
  modEq_iff_dvd.2 <| d.trans h.dvd
#align int.modeq.of_dvd Int.ModEq.of_dvd

protected theorem mul_left' (hc : 0 ≤ c) (h : a ≡ b [ZMOD n]) : c * a ≡ c * b [ZMOD c * n] :=
  match hc.lt_or_eq with
  | .inl hc => by
    unfold ModEq
    simp [mul_emod_mul_of_pos _ _ hc, show _ = _ from h]
  | .inr hc => by
    simp [hc.symm]
#align int.modeq.mul_left' Int.ModEq.mul_left'

protected theorem mul_right' (hc : 0 ≤ c) (h : a ≡ b [ZMOD n]) : a * c ≡ b * c [ZMOD n * c] := by
  rw [mul_comm a, mul_comm b, mul_comm n]; exact h.mul_left' hc
#align int.modeq.mul_right' Int.ModEq.mul_right'

protected theorem add (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a + c ≡ b + d [ZMOD n] :=
  modEq_iff_dvd.2 <| by
    convert dvd_add h₁.dvd h₂.dvd using 1
    ring
#align int.modeq.add Int.ModEq.add

protected theorem add_left (c : ℤ) (h : a ≡ b [ZMOD n]) : c + a ≡ c + b [ZMOD n] :=
  ModEq.rfl.add h
#align int.modeq.add_left Int.ModEq.add_left

protected theorem add_right (c : ℤ) (h : a ≡ b [ZMOD n]) : a + c ≡ b + c [ZMOD n] :=
  h.add ModEq.rfl
#align int.modeq.add_right Int.ModEq.add_right

protected theorem add_left_cancel (h₁ : a ≡ b [ZMOD n]) (h₂ : a + c ≡ b + d [ZMOD n]) :
    c ≡ d [ZMOD n] :=
  have : d - c = b + d - (a + c) - (b - a) := by ring
  modEq_iff_dvd.2 <| by
    rw [this]
    exact dvd_sub h₂.dvd h₁.dvd
#align int.modeq.add_left_cancel Int.ModEq.add_left_cancel

protected theorem add_left_cancel' (c : ℤ) (h : c + a ≡ c + b [ZMOD n]) : a ≡ b [ZMOD n] :=
  ModEq.rfl.add_left_cancel h
#align int.modeq.add_left_cancel' Int.ModEq.add_left_cancel'

protected theorem add_right_cancel (h₁ : c ≡ d [ZMOD n]) (h₂ : a + c ≡ b + d [ZMOD n]) :
    a ≡ b [ZMOD n] := by
  rw [add_comm a, add_comm b] at h₂
  exact h₁.add_left_cancel h₂
#align int.modeq.add_right_cancel Int.ModEq.add_right_cancel

protected theorem add_right_cancel' (c : ℤ) (h : a + c ≡ b + c [ZMOD n]) : a ≡ b [ZMOD n] :=
  ModEq.rfl.add_right_cancel h
#align int.modeq.add_right_cancel' Int.ModEq.add_right_cancel'

protected theorem neg (h : a ≡ b [ZMOD n]) : -a ≡ -b [ZMOD n] :=
  h.add_left_cancel (by simp_rw [← sub_eq_add_neg, sub_self]; rfl)
#align int.modeq.neg Int.ModEq.neg

protected theorem sub (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a - c ≡ b - d [ZMOD n] := by
  rw [sub_eq_add_neg, sub_eq_add_neg]
  exact h₁.add h₂.neg
#align int.modeq.sub Int.ModEq.sub

protected theorem sub_left (c : ℤ) (h : a ≡ b [ZMOD n]) : c - a ≡ c - b [ZMOD n] :=
  ModEq.rfl.sub h
#align int.modeq.sub_left Int.ModEq.sub_left

protected theorem sub_right (c : ℤ) (h : a ≡ b [ZMOD n]) : a - c ≡ b - c [ZMOD n] :=
  h.sub ModEq.rfl
#align int.modeq.sub_right Int.ModEq.sub_right

protected theorem mul_left (c : ℤ) (h : a ≡ b [ZMOD n]) : c * a ≡ c * b [ZMOD n] :=
  match (le_total 0 c) with
  | .inl hc => (h.mul_left' hc).of_dvd (dvd_mul_left _ _)
  | .inr hc => by
    rw [← neg_neg c, neg_mul, neg_mul _ b]
    exact ((h.mul_left' <| neg_nonneg.2 hc).of_dvd (dvd_mul_left _ _)).neg
#align int.modeq.mul_left Int.ModEq.mul_left

protected theorem mul_right (c : ℤ) (h : a ≡ b [ZMOD n]) : a * c ≡ b * c [ZMOD n] := by
  rw [mul_comm a, mul_comm b]
  exact h.mul_left c
#align int.modeq.mul_right Int.ModEq.mul_right

protected theorem mul (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a * c ≡ b * d [ZMOD n] :=
  (h₂.mul_left _).trans (h₁.mul_right _)
#align int.modeq.mul Int.ModEq.mul

protected theorem pow (m : ℕ) (h : a ≡ b [ZMOD n]) : a ^ m ≡ b ^ m [ZMOD n] := by
  induction' m with d hd; · rfl
  rw [pow_succ, pow_succ]
  exact h.mul hd
#align int.modeq.pow Int.ModEq.pow

lemma of_mul_left (m : ℤ) (h : a ≡ b [ZMOD m * n]) : a ≡ b [ZMOD n] := by
  rw [modEq_iff_dvd] at *; exact (dvd_mul_left n m).trans h
#align int.modeq.of_mul_left Int.ModEq.of_mul_left

lemma of_mul_right (m : ℤ) : a ≡ b [ZMOD n * m] → a ≡ b [ZMOD n] :=
  mul_comm m n ▸ of_mul_left _
#align int.modeq.of_mul_right Int.ModEq.of_mul_right

end ModEq

theorem modEq_one : a ≡ b [ZMOD 1] :=
  modEq_of_dvd (one_dvd _)
#align int.modeq_one Int.modEq_one

theorem modEq_sub (a b : ℤ) : a ≡ b [ZMOD a - b] :=
  (modEq_of_dvd dvd_rfl).symm
#align int.modeq_sub Int.modEq_sub

theorem modEq_and_modEq_iff_modEq_mul {a b m n : ℤ} (hmn : m.natAbs.coprime n.natAbs) :
    a ≡ b [ZMOD m] ∧ a ≡ b [ZMOD n] ↔ a ≡ b [ZMOD m * n] :=
  ⟨fun h => by
    rw [modEq_iff_dvd, modEq_iff_dvd] at h
    rw [modEq_iff_dvd, ← natAbs_dvd, ← dvd_natAbs, coe_nat_dvd, natAbs_mul]
    refine' hmn.mul_dvd_of_dvd_of_dvd _ _ <;> rw [← coe_nat_dvd, natAbs_dvd, dvd_natAbs] <;>
      tauto,
    fun h => ⟨h.of_mul_right _, h.of_mul_left _⟩⟩
#align int.modeq_and_modeq_iff_modeq_mul Int.modEq_and_modEq_iff_modEq_mul

theorem gcd_a_modEq (a b : ℕ) : (a : ℤ) * Nat.gcdA a b ≡ Nat.gcd a b [ZMOD b] := by
  rw [← add_zero ((a : ℤ) * _), Nat.gcd_eq_gcd_ab]
  exact (dvd_mul_right _ _).zero_modEq_int.add_left _
#align int.gcd_a_modeq Int.gcd_a_modEq

theorem modEq_add_fac {a b n : ℤ} (c : ℤ) (ha : a ≡ b [ZMOD n]) : a + n * c ≡ b [ZMOD n] :=
  calc
    a + n * c ≡ b + n * c [ZMOD n] := ha.add_right _
    _ ≡ b + 0 [ZMOD n] := (dvd_mul_right _ _).modEq_zero_int.add_left _
    _ ≡ b [ZMOD n] := by rw [add_zero]

#align int.modeq_add_fac Int.modEq_add_fac

theorem modEq_add_fac_self {a t n : ℤ} : a + n * t ≡ a [ZMOD n] :=
  modEq_add_fac _ ModEq.rfl
#align int.modeq_add_fac_self Int.modEq_add_fac_self

theorem mod_coprime {a b : ℕ} (hab : Nat.coprime a b) : ∃ y : ℤ, a * y ≡ 1 [ZMOD b] :=
  ⟨Nat.gcdA a b,
    have hgcd : Nat.gcd a b = 1 := Nat.coprime.gcd_eq_one hab
    calc
      ↑a * Nat.gcdA a b ≡ ↑a * Nat.gcdA a b + ↑b * Nat.gcdB a b [ZMOD ↑b] :=
        ModEq.symm <| modEq_add_fac _ <| ModEq.refl _
      _ ≡ 1 [ZMOD ↑b] := by rw [← Nat.gcd_eq_gcd_ab, hgcd]; rfl
      ⟩
#align int.mod_coprime Int.mod_coprime

theorem exists_unique_equiv (a : ℤ) {b : ℤ} (hb : 0 < b) :
    ∃ z : ℤ, 0 ≤ z ∧ z < b ∧ z ≡ a [ZMOD b] :=
  ⟨a % b, emod_nonneg _ (ne_of_gt hb),
    by
    have : a % b < |b| := emod_lt _ (ne_of_gt hb)
    rwa [abs_of_pos hb] at this, by simp [ModEq]⟩
#align int.exists_unique_equiv Int.exists_unique_equiv

theorem exists_unique_equiv_nat (a : ℤ) {b : ℤ} (hb : 0 < b) : ∃ z : ℕ, ↑z < b ∧ ↑z ≡ a [ZMOD b] :=
  let ⟨z, hz1, hz2, hz3⟩ := exists_unique_equiv a hb
  ⟨z.natAbs, by
    constructor <;> rw [ofNat_natAbs_eq_of_nonneg z hz1] <;> assumption⟩
#align int.exists_unique_equiv_nat Int.exists_unique_equiv_nat

theorem mod_mul_right_mod (a b c : ℤ) : a % (b * c) % b = a % b :=
  (mod_modEq _ _).of_mul_right _
#align int.mod_mul_right_mod Int.mod_mul_right_mod

theorem mod_mul_left_mod (a b c : ℤ) : a % (b * c) % c = a % c :=
  (mod_modEq _ _).of_mul_left _
#align int.mod_mul_left_mod Int.mod_mul_left_mod

end Int


/-
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
-/
import order.bounded_order
import order.complete_lattice
import order.cover
import order.iterate
import tactic.monotonicity

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

* `succ_order`: Order equipped with a sensible successor function.
* `pred_order`: Order equipped with a sensible predecessor function.
* `is_succ_archimedean`: `succ_order` where `succ` iterated to an element gives all the greater
  ones.
* `is_pred_archimedean`: `pred_order` where `pred` iterated to an element gives all the greater
  ones.

## Implementation notes

Maximal elements don't have a sensible successor. Thus the naïve typeclass
```lean
class naive_succ_order (α : 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 `order_top` 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
`maximal_of_succ_le`).
The stricter condition of every element having a sensible successor can be obtained through the
combination of `succ_order α` and `no_max_order α`.

## TODO

Is `galois_connection pred succ` always true? If not, we should introduce
```lean
class succ_pred_order (α : Type*) [preorder α] extends succ_order α, pred_order α :=
(pred_succ_gc : galois_connection (pred : α → α) succ)
```
`covers` should help here.
-/

open function

/-! ### Successor order -/

variables {α : Type*}

/-- Order equipped with a sensible successor function. -/
@[ext] class succ_order (α : Type*) [preorder α] :=
(succ : α → α)
(le_succ : ∀ a, a ≤ succ a)
(maximal_of_succ_le : ∀ ⦃a⦄, succ a ≤ a → ∀ ⦃b⦄, ¬a < b)
(succ_le_of_lt : ∀ {a b}, a < b → succ a ≤ b)
(le_of_lt_succ : ∀ {a b}, a < succ b → a ≤ b)

namespace succ_order
section preorder
variables [preorder α]

/-- A constructor for `succ_order α` usable when `α` has no maximal element. -/
def of_succ_le_iff_of_le_lt_succ (succ : α → α)
  (hsucc_le_iff : ∀ {a b}, succ a ≤ b ↔ a < b)
  (hle_of_lt_succ : ∀ {a b}, a < succ b → a ≤ b) :
  succ_order α :=
{ succ := succ,
  le_succ := λ a, (hsucc_le_iff.1 le_rfl).le,
  maximal_of_succ_le := λ a ha, (lt_irrefl a (hsucc_le_iff.1 ha)).elim,
  succ_le_of_lt := λ a b, hsucc_le_iff.2,
  le_of_lt_succ := λ a b, hle_of_lt_succ }

variables [succ_order α]

@[simp, mono] lemma succ_le_succ {a b : α} (h : a ≤ b) : succ a ≤ succ b :=
begin
  by_cases ha : ∀ ⦃c⦄, ¬a < c,
  { have hba : succ b ≤ a,
    { by_contra H,
      exact ha ((h.trans (le_succ b)).lt_of_not_le H) },
    by_contra H,
    exact ha ((h.trans (le_succ b)).trans_lt ((hba.trans (le_succ a)).lt_of_not_le H)) },
  { push_neg at ha,
    obtain ⟨c, hc⟩ := ha,
    exact succ_le_of_lt ((h.trans (le_succ b)).lt_of_not_le $ λ hba,
      maximal_of_succ_le (hba.trans h) (((le_succ b).trans hba).trans_lt hc)) }
end

lemma succ_mono : monotone (succ : α → α) := λ a b, succ_le_succ

lemma lt_succ_of_not_maximal {a b : α} (h : a < b) : a < succ a :=
(le_succ a).lt_of_not_le (λ ha, maximal_of_succ_le ha h)

alias lt_succ_of_not_maximal ← has_lt.lt.lt_succ

protected lemma _root_.has_lt.lt.covers_succ {a b : α} (h : a < b) : a ⋖ succ a :=
⟨h.lt_succ, λ c hc, (succ_le_of_lt hc).not_lt⟩

@[simp] lemma covers_succ_of_nonempty_Ioi {a : α} (h : (set.Ioi a).nonempty) : a ⋖ succ a :=
has_lt.lt.covers_succ h.some_mem

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

lemma lt_succ (a : α) : a < succ a :=
(le_succ a).lt_of_not_le $ λ h, not_exists.2 (maximal_of_succ_le h) (exists_gt a)

lemma lt_succ_iff : a < succ b ↔ a ≤ b :=
⟨le_of_lt_succ, λ h, h.trans_lt $ lt_succ b⟩

lemma succ_le_iff : succ a ≤ b ↔ a < b :=
⟨(lt_succ a).trans_le, succ_le_of_lt⟩

@[simp] lemma succ_le_succ_iff : succ a ≤ succ b ↔ a ≤ b :=
⟨λ h, le_of_lt_succ $ (lt_succ a).trans_le h, λ h, succ_le_of_lt $ h.trans_lt $ lt_succ b⟩

alias succ_le_succ_iff ↔ le_of_succ_le_succ _

lemma succ_lt_succ_iff : succ a < succ b ↔ a < b :=
by simp_rw [lt_iff_le_not_le, succ_le_succ_iff]

alias succ_lt_succ_iff ↔ lt_of_succ_lt_succ succ_lt_succ

lemma succ_strict_mono : strict_mono (succ : α → α) := λ a b, succ_lt_succ

lemma covers_succ (a : α) : a ⋖ succ a := ⟨lt_succ a, λ c hc, (succ_le_of_lt hc).not_lt⟩

end no_max_order

end preorder

section partial_order
variables [partial_order α]

/-- There is at most one way to define the successors in a `partial_order`. -/
instance : subsingleton (succ_order α) :=
begin
  refine subsingleton.intro (λ h₀ h₁, _),
  ext a,
  by_cases ha : @succ _ _ h₀ a ≤ a,
  { refine (ha.trans (@le_succ _ _ h₁ a)).antisymm _,
    by_contra H,
    exact @maximal_of_succ_le _ _ h₀ _ ha _
      ((@le_succ _ _ h₁ a).lt_of_not_le $ λ h, H $ h.trans $ @le_succ _ _ h₀ a) },
  { exact (@succ_le_of_lt _ _ h₀ _ _ $ (@le_succ _ _ h₁ a).lt_of_not_le $ λ h,
      @maximal_of_succ_le _ _ h₁ _ h _ $ (@le_succ _ _ h₀ a).lt_of_not_le ha).antisymm
      (@succ_le_of_lt _ _ h₁ _ _ $ (@le_succ _ _ h₀ a).lt_of_not_le ha) }
end

variables [succ_order α]

lemma le_le_succ_iff {a b : α} : a ≤ b ∧ b ≤ succ a ↔ b = a ∨ b = succ a :=
begin
  split,
  { rintro h,
    rw or_iff_not_imp_left,
    exact λ 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⟩ }
end

lemma _root_.covers.succ_eq {a b : α} (h : a ⋖ b) : succ a = b :=
(succ_le_of_lt h.lt).eq_of_not_lt $ λ h', h.2 (lt_succ_of_not_maximal h.lt) h'

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

lemma succ_injective : injective (succ : α → α) :=
begin
  rintro a b,
  simp_rw [eq_iff_le_not_lt, succ_le_succ_iff, succ_lt_succ_iff],
  exact id,
end

lemma succ_eq_succ_iff : succ a = succ b ↔ a = b :=
succ_injective.eq_iff

lemma succ_ne_succ_iff : succ a ≠ succ b ↔ a ≠ b :=
succ_injective.ne_iff

alias succ_ne_succ_iff ↔ ne_of_succ_ne_succ succ_ne_succ

lemma lt_succ_iff_lt_or_eq : a < succ b ↔ (a < b ∨ a = b) :=
lt_succ_iff.trans le_iff_lt_or_eq

lemma le_succ_iff_lt_or_eq : a ≤ succ b ↔ (a ≤ b ∨ a = succ b) :=
by rw [←lt_succ_iff, ←lt_succ_iff, lt_succ_iff_lt_or_eq]

lemma _root_.covers_iff_succ_eq : a ⋖ b ↔ succ a = b :=
⟨covers.succ_eq, by { rintro rfl, exact covers_succ _ }⟩

end no_max_order

end partial_order

section order_top
variables [partial_order α] [order_top α] [succ_order α]

@[simp] lemma succ_top : succ (⊤ : α) = ⊤ :=
le_top.antisymm (le_succ _)

@[simp] lemma succ_le_iff_eq_top {a : α} : succ a ≤ a ↔ a = ⊤ :=
⟨λ h, eq_top_of_maximal (maximal_of_succ_le h), λ h, by rw [h, succ_top]⟩

@[simp] lemma lt_succ_iff_ne_top {a : α} : a < succ a ↔ a ≠ ⊤ :=
begin
  simp only [lt_iff_le_not_le, true_and, le_succ a],
  exact not_iff_not.2 succ_le_iff_eq_top,
end

end order_top

section order_bot
variables [partial_order α] [order_bot α] [succ_order α] [nontrivial α]

lemma bot_lt_succ (a : α) : ⊥ < succ a :=
begin
  obtain ⟨b, hb⟩ := exists_ne (⊥ : α),
  refine bot_lt_iff_ne_bot.2 (λ h, _),
  have := eq_bot_iff.2 ((le_succ a).trans h.le),
  rw this at h,
  exact maximal_of_succ_le h.le (bot_lt_iff_ne_bot.2 hb),
end

lemma succ_ne_bot (a : α) : succ a ≠ ⊥ :=
(bot_lt_succ a).ne'

end order_bot

section linear_order
variables [linear_order α]

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

end linear_order

section complete_lattice
variables [complete_lattice α] [succ_order α]

lemma succ_eq_infi (a : α) : succ a = ⨅ (b : α) (h : a < b), b :=
begin
  refine le_antisymm (le_infi (λ b, le_infi succ_le_of_lt)) _,
  obtain rfl | ha := eq_or_ne a ⊤,
  { rw succ_top,
    exact le_top },
  exact binfi_le _ (lt_succ_iff_ne_top.2 ha),
end

end complete_lattice
end succ_order

/-! ### Predecessor order -/

/-- Order equipped with a sensible predecessor function. -/
@[ext] class pred_order (α : Type*) [preorder α] :=
(pred : α → α)
(pred_le : ∀ a, pred a ≤ a)
(minimal_of_le_pred : ∀ ⦃a⦄, a ≤ pred a → ∀ ⦃b⦄, ¬b < a)
(le_pred_of_lt : ∀ {a b}, a < b → a ≤ pred b)
(le_of_pred_lt : ∀ {a b}, pred a < b → a ≤ b)

namespace pred_order
section preorder
variables [preorder α]

/-- A constructor for `pred_order α` usable when `α` has no minimal element. -/
def of_le_pred_iff_of_pred_le_pred (pred : α → α)
  (hle_pred_iff : ∀ {a b}, a ≤ pred b ↔ a < b)
  (hle_of_pred_lt : ∀ {a b}, pred a < b → a ≤ b) :
  pred_order α :=
{ pred := pred,
  pred_le := λ a, (hle_pred_iff.1 le_rfl).le,
  minimal_of_le_pred := λ a ha, (lt_irrefl a (hle_pred_iff.1 ha)).elim,
  le_pred_of_lt := λ a b, hle_pred_iff.2,
  le_of_pred_lt := λ a b, hle_of_pred_lt }

variables [pred_order α]

@[simp, mono] lemma pred_le_pred {a b : α} (h : a ≤ b) : pred a ≤ pred b :=
begin
  by_cases hb : ∀ ⦃c⦄, ¬c < b,
  { have hba : b ≤ pred a,
    { by_contra H,
      exact hb (((pred_le a).trans h).lt_of_not_le H) },
    by_contra H,
    exact hb ((((pred_le b).trans hba).lt_of_not_le H).trans_le ((pred_le a).trans h)) },
  { push_neg at hb,
    obtain ⟨c, hc⟩ := hb,
    exact le_pred_of_lt (((pred_le a).trans h).lt_of_not_le $ λ hba,
      minimal_of_le_pred (h.trans hba) $ hc.trans_le $ hba.trans $ pred_le a) }
end

lemma pred_mono : monotone (pred : α → α) := λ a b, pred_le_pred

lemma pred_lt_of_not_minimal {a b : α} (h : b < a) : pred a < a :=
(pred_le a).lt_of_not_le (λ ha, minimal_of_le_pred ha h)

alias pred_lt_of_not_minimal ← has_lt.lt.pred_lt

protected lemma _root_.has_lt.lt.pred_covers {a b : α} (h : b < a) : pred a ⋖ a :=
⟨h.pred_lt, λ c hc, (le_of_pred_lt hc).not_lt⟩

@[simp] lemma pred_covers_of_nonempty_Iio {a : α} (h : (set.Iio a).nonempty) : pred a ⋖ a :=
has_lt.lt.pred_covers h.some_mem

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

lemma pred_lt (a : α) : pred a < a :=
(pred_le a).lt_of_not_le $ λ h, not_exists.2 (minimal_of_le_pred h) (exists_lt a)

lemma pred_lt_iff : pred a < b ↔ a ≤ b :=
⟨le_of_pred_lt, (pred_lt a).trans_le⟩

lemma le_pred_iff : a ≤ pred b ↔ a < b :=
⟨λ h, h.trans_lt (pred_lt b), le_pred_of_lt⟩

@[simp] lemma pred_le_pred_iff : pred a ≤ pred b ↔ a ≤ b :=
⟨λ h, le_of_pred_lt $ h.trans_lt (pred_lt b), λ h, le_pred_of_lt $ (pred_lt a).trans_le h⟩

alias pred_le_pred_iff ↔ le_of_pred_le_pred _

@[simp] lemma pred_lt_pred_iff : pred a < pred b ↔ a < b :=
by simp_rw [lt_iff_le_not_le, pred_le_pred_iff]

alias pred_lt_pred_iff ↔ lt_of_pred_lt_pred pred_lt_pred

lemma pred_strict_mono : strict_mono (pred : α → α) := λ a b, pred_lt_pred

lemma pred_covers (a : α) : pred a ⋖ a := ⟨pred_lt a, λ c hc, (le_of_pred_lt hc).not_lt⟩

end no_min_order

end preorder

section partial_order
variables [partial_order α]

/-- There is at most one way to define the predecessors in a `partial_order`. -/
instance : subsingleton (pred_order α) :=
begin
  refine subsingleton.intro (λ h₀ h₁, _),
  ext a,
  by_cases ha : a ≤ @pred _ _ h₀ a,
  { refine le_antisymm _ ((@pred_le _ _ h₁ a).trans ha),
    by_contra H,
    exact @minimal_of_le_pred _ _ h₀ _ ha _
      ((@pred_le _ _ h₁ a).lt_of_not_le $ λ h, H $ (@pred_le _ _ h₀ a).trans h) },
  { exact (@le_pred_of_lt _ _ h₁ _ _ $ (@pred_le _ _ h₀ a).lt_of_not_le ha).antisymm
    (@le_pred_of_lt _ _ h₀ _ _ $ (@pred_le _ _ h₁ a).lt_of_not_le $ λ h,
    @minimal_of_le_pred _ _ h₁ _ h _ $ (@pred_le _ _ h₀ a).lt_of_not_le ha) }
end

variables [pred_order α]

lemma pred_le_le_iff {a b : α} : pred a ≤ b ∧ b ≤ a ↔ b = a ∨ b = pred a :=
begin
  split,
  { rintro h,
    rw or_iff_not_imp_left,
    exact λ hba, (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⟩ }
end

lemma _root_.covers.pred_eq {a b : α} (h : a ⋖ b) : pred b = a :=
(le_pred_of_lt h.lt).eq_of_not_gt $ λ h', h.2 h' $ pred_lt_of_not_minimal h.lt

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

lemma pred_injective : injective (pred : α → α) :=
begin
  rintro a b,
  simp_rw [eq_iff_le_not_lt, pred_le_pred_iff, pred_lt_pred_iff],
  exact id,
end

lemma pred_eq_pred_iff : pred a = pred b ↔ a = b :=
pred_injective.eq_iff

lemma pred_ne_pred_iff : pred a ≠ pred b ↔ a ≠ b :=
pred_injective.ne_iff

lemma pred_lt_iff_lt_or_eq : pred a < b ↔ (a < b ∨ a = b) :=
pred_lt_iff.trans le_iff_lt_or_eq

lemma le_pred_iff_lt_or_eq : pred a ≤ b ↔ (a ≤ b ∨ pred a = b) :=
by rw [←pred_lt_iff, ←pred_lt_iff, pred_lt_iff_lt_or_eq]

lemma _root_.covers_iff_pred_eq : a ⋖ b ↔ pred b = a :=
⟨covers.pred_eq, by { rintro rfl, exact pred_covers _ }⟩

end no_min_order

end partial_order

section order_bot
variables [partial_order α] [order_bot α] [pred_order α]

@[simp] lemma pred_bot : pred (⊥ : α) = ⊥ :=
(pred_le _).antisymm bot_le

@[simp] lemma le_pred_iff_eq_bot {a : α} : a ≤ pred a ↔ a = ⊥ :=
⟨λ h, eq_bot_of_minimal (minimal_of_le_pred h), λ h, by rw [h, pred_bot]⟩

@[simp] lemma pred_lt_iff_ne_bot {a : α} : pred a < a ↔ a ≠ ⊥ :=
begin
  simp only [lt_iff_le_not_le, true_and, pred_le a],
  exact not_iff_not.2 le_pred_iff_eq_bot,
end

end order_bot

section order_top
variables [partial_order α] [order_top α] [pred_order α]

lemma pred_lt_top [nontrivial α] (a : α) : pred a < ⊤ :=
begin
  obtain ⟨b, hb⟩ := exists_ne (⊤ : α),
  refine lt_top_iff_ne_top.2 (λ h, _),
  have := eq_top_iff.2 (h.ge.trans (pred_le a)),
  rw this at h,
  exact minimal_of_le_pred h.ge (lt_top_iff_ne_top.2 hb),
end

lemma pred_ne_top [nontrivial α] (a : α) : pred a ≠ ⊤ :=
(pred_lt_top a).ne

end order_top

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

/-- A constructor for `pred_order α` usable when `α` is a linear order with no maximal element. -/
def of_le_pred_iff (pred : α → α) (hle_pred_iff : ∀ {a b}, a ≤ pred b ↔ a < b) :
  pred_order α :=
{ pred := pred,
  pred_le := λ a, (hle_pred_iff.1 le_rfl).le,
  minimal_of_le_pred := λ a ha, (lt_irrefl a (hle_pred_iff.1 ha)).elim,
  le_pred_of_lt := λ a b, hle_pred_iff.2,
  le_of_pred_lt := λ a b h, le_of_not_lt ((not_congr hle_pred_iff).1 h.not_le) }

end linear_order

section complete_lattice
variables [complete_lattice α] [pred_order α]

lemma pred_eq_supr (a : α) : pred a = ⨆ (b : α) (h : b < a), b :=
begin
  refine le_antisymm _ (supr_le (λ b, supr_le le_pred_of_lt)),
  obtain rfl | ha := eq_or_ne a ⊥,
  { rw pred_bot,
    exact bot_le },
  exact @le_bsupr _ _ _ (λ b, b < a) (λ a _, a) (pred a) (pred_lt_iff_ne_bot.2 ha),
end

end complete_lattice
end pred_order

open succ_order pred_order

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

section succ_pred_order
variables [partial_order α] [succ_order α] [pred_order α] {a b : α}

protected lemma _root_.has_lt.lt.succ_pred (h : b < a) : succ (pred a) = a := h.pred_covers.succ_eq
protected lemma _root_.has_lt.lt.pred_succ (h : a < b) : pred (succ a) = a := h.covers_succ.pred_eq

@[simp] lemma succ_pred_of_nonempty_Iio {a : α} (h : (set.Iio a).nonempty) : succ (pred a) = a :=
has_lt.lt.succ_pred h.some_mem

@[simp] lemma pred_succ_of_nonempty_Ioi {a : α} (h : (set.Ioi a).nonempty) : pred (succ a) = a :=
has_lt.lt.pred_succ h.some_mem

@[simp] lemma succ_pred [no_min_order α] (a : α) : succ (pred a) = a := (pred_covers _).succ_eq
@[simp] lemma pred_succ [no_max_order α] (a : α) : pred (succ a) = a := (covers_succ _).pred_eq

end succ_pred_order

/-! ### Dual order -/

section order_dual
variables [preorder α]

instance [pred_order α] : succ_order (order_dual α) :=
{ succ := (pred : α → α),
  le_succ := pred_le,
  maximal_of_succ_le := minimal_of_le_pred,
  succ_le_of_lt := λ a b h, le_pred_of_lt h,
  le_of_lt_succ := λ a b, le_of_pred_lt }

instance [succ_order α] : pred_order (order_dual α) :=
{ pred := (succ : α → α),
  pred_le := le_succ,
  minimal_of_le_pred := maximal_of_succ_le,
  le_pred_of_lt := λ a b h, succ_le_of_lt h,
  le_of_pred_lt := λ a b, le_of_lt_succ }

end order_dual

/-! ### `with_bot`, `with_top`
Adding a greatest/least element to a `succ_order` or to a `pred_order`.

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 `order_top`: Preserves `succ` and `pred`.
* Adding a `⊤` to a `no_max_order`: Preserves `succ`. Never preserves `pred`.
* Adding a `⊥` to an `order_bot`: Preserves `succ` and `pred`.
* Adding a `⊥` to a `no_min_order`: Preserves `pred`. Never preserves `succ`.
where "preserves `(succ/pred)`" means
`(succ/pred)_order α → (succ/pred)_order ((with_top/with_bot) α)`.
-/

section with_top
open with_top

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

instance [decidable_eq α] [partial_order α] [order_top α] [succ_order α] :
  succ_order (with_top α) :=
{ succ := λ a, match a with
    | ⊤        := ⊤
    | (some a) := ite (a = ⊤) ⊤ (some (succ a))
  end,
  le_succ := λ a, begin
    cases a,
    { exact le_top },
    change ((≤) : with_top α → with_top α → Prop) _ (ite _ _ _),
    split_ifs,
    { exact le_top },
    { exact some_le_some.2 (le_succ a) }
  end,
  maximal_of_succ_le := λ a ha b h, begin
    cases a,
    { exact not_top_lt h },
    change ((≤) : with_top α → with_top α → Prop) (ite _ _ _) _ at ha,
    split_ifs at ha with ha',
    { exact not_top_lt (ha.trans_lt h) },
    { rw [some_le_some, succ_le_iff_eq_top] at ha,
      exact ha' ha }
  end,
  succ_le_of_lt := λ a b h, begin
    cases b,
    { exact le_top },
    cases a,
    { exact (not_top_lt h).elim },
    rw some_lt_some at h,
    change ((≤) : with_top α → with_top α → Prop) (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) }
  end,
  le_of_lt_succ := λ a b h, begin
    cases a,
    { exact (not_top_lt h).elim },
    cases b,
    { exact le_top },
    change ((<) : with_top α → with_top α → Prop) _ (ite _ _ _) 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) }
  end }

instance [partial_order α] [order_top α] [pred_order α] : pred_order (with_top α) :=
{ pred := λ a, match a with
    | ⊤        := some ⊤
    | (some a) := some (pred a)
  end,
  pred_le := λ a, match a with
    | ⊤        := le_top
    | (some a) := some_le_some.2 (pred_le a)
  end,
  minimal_of_le_pred := λ a ha b h, begin
    cases a,
    { exact (coe_lt_top (⊤ : α)).not_le ha },
    cases b,
    { exact h.not_le le_top },
    { exact minimal_of_le_pred (some_le_some.1 ha) (some_lt_some.1 h) }
  end,
  le_pred_of_lt := λ a b h, begin
    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),
  end,
  le_of_pred_lt := λ a b h, begin
    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) }
  end }

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

instance with_top.succ_order_of_no_max_order [partial_order α] [no_max_order α] [succ_order α] :
  succ_order (with_top α) :=
{ succ := λ a, match a with
    | ⊤        := ⊤
    | (some a) := some (succ a)
  end,
  le_succ := λ a, begin
    cases a,
    { exact le_top },
    { exact some_le_some.2 (le_succ a) }
  end,
  maximal_of_succ_le := λ a ha b h, begin
    cases a,
    { exact not_top_lt h },
    { exact not_exists.2 (maximal_of_succ_le (some_le_some.1 ha)) (exists_gt a) }
  end,
  succ_le_of_lt := λ a b h, begin
    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) }
  end,
  le_of_lt_succ := λ a b h, begin
    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) }
  end }

instance [partial_order α] [no_max_order α] [hα : nonempty α] :
  is_empty (pred_order (with_top α)) :=
⟨begin
  introI,
  set b := pred (⊤ : with_top α) with h,
  cases pred (⊤ : with_top α) with a ha; change b with pred ⊤ at h,
  { exact hα.elim (λ a, minimal_of_le_pred h.ge (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⟩

end with_top

section with_bot
open with_bot

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

instance [preorder α] [order_bot α] [succ_order α] : succ_order (with_bot α) :=
{ succ := λ a, match a with
    | ⊥        := some ⊥
    | (some a) := some (succ a)
  end,
  le_succ := λ a, match a with
    | ⊥        := bot_le
    | (some a) := some_le_some.2 (le_succ a)
  end,
  maximal_of_succ_le := λ a ha b h, begin
    cases a,
    { exact (none_lt_some (⊥ : α)).not_le ha },
    cases b,
    { exact not_lt_bot h },
    { exact maximal_of_succ_le (some_le_some.1 ha) (some_lt_some.1 h) }
  end,
  succ_le_of_lt := λ a b h, begin
    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) }
  end,
  le_of_lt_succ := λ a b h, begin
    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) }
  end }

instance [decidable_eq α] [partial_order α] [order_bot α] [pred_order α] :
  pred_order (with_bot α) :=
{ pred := λ a, match a with
    | ⊥        := ⊥
    | (some a) := ite (a = ⊥) ⊥ (some (pred a))
  end,
  pred_le := λ a, begin
    cases a,
    { exact bot_le },
    change (ite _ _ _ : with_bot α) ≤ some a,
    split_ifs,
    { exact bot_le },
    { exact some_le_some.2 (pred_le a) }
  end,
  minimal_of_le_pred := λ a ha b h, begin
    cases a,
    { exact not_lt_bot h },
    change ((≤) : with_bot α → with_bot α → Prop) _ (ite _ _ _) at ha,
    split_ifs at ha with ha',
    { exact not_lt_bot (h.trans_le ha) },
    { rw [some_le_some, le_pred_iff_eq_bot] at ha,
      exact ha' ha }
  end,
  le_pred_of_lt := λ a b h, begin
    cases a,
    { exact bot_le },
    cases b,
    { exact (not_lt_bot h).elim },
    rw some_lt_some at h,
    change ((≤) : with_bot α → with_bot α → Prop) _ (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) }
  end,
  le_of_pred_lt := λ a b h, begin
    cases b,
    { exact (not_lt_bot h).elim },
    cases a,
    { exact bot_le },
    change ((<) : with_bot α → with_bot α → Prop) (ite _ _ _) _ 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) }
  end }

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

instance [partial_order α] [no_min_order α] [hα : nonempty α] :
  is_empty (succ_order (with_bot α)) :=
⟨begin
  introI,
  set b : with_bot α := succ ⊥ with h,
  cases succ (⊥ : with_bot α) with a ha; change b with succ ⊥ at h,
  { exact hα.elim (λ a, maximal_of_succ_le h.le (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⟩

instance with_bot.pred_order_of_no_min_order [partial_order α] [no_min_order α] [pred_order α] :
  pred_order (with_bot α) :=
{ pred := λ a, match a with
    | ⊥        := ⊥
    | (some a) := some (pred a)
  end,
  pred_le := λ a, begin
    cases a,
    { exact bot_le },
    { exact some_le_some.2 (pred_le a) }
  end,
  minimal_of_le_pred := λ a ha b h, begin
    cases a,
    { exact not_lt_bot h },
    { exact not_exists.2 (minimal_of_le_pred (some_le_some.1 ha)) (exists_lt a) }
  end,
  le_pred_of_lt := λ a b h, begin
    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) }
  end,
  le_of_pred_lt := λ a b h, begin
    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) }
  end }

end with_bot

/-! ### Archimedeanness -/

/-- A `succ_order` is succ-archimedean if one can go from any two comparable elements by iterating
`succ` -/
class is_succ_archimedean (α : Type*) [preorder α] [succ_order α] : Prop :=
(exists_succ_iterate_of_le {a b : α} (h : a ≤ b) : ∃ n, succ^[n] a = b)

/-- A `pred_order` is pred-archimedean if one can go from any two comparable elements by iterating
`pred` -/
class is_pred_archimedean (α : Type*) [preorder α] [pred_order α] : Prop :=
(exists_pred_iterate_of_le {a b : α} (h : a ≤ b) : ∃ n, pred^[n] b = a)

export is_succ_archimedean (exists_succ_iterate_of_le)
export is_pred_archimedean (exists_pred_iterate_of_le)

section preorder
variables [preorder α]

section succ_order
variables [succ_order α] [is_succ_archimedean α] {a b : α}

instance : is_pred_archimedean (order_dual α) :=
{ exists_pred_iterate_of_le := λ a b h, by convert @exists_succ_iterate_of_le α _ _ _ _ _ h }

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

lemma exists_succ_iterate_iff_le : (∃ n, succ^[n] a = b) ↔ a ≤ b :=
begin
  refine ⟨_, exists_succ_iterate_of_le⟩,
  rintro ⟨n, rfl⟩,
  exact id_le_iterate_of_id_le le_succ n a,
end

/-- Induction principle on a type with a `succ_order` for all elements above a given element `m`. -/
@[elab_as_eliminator] lemma succ.rec {P : α → Prop} {m : α}
  (h0 : P m) (h1 : ∀ n, m ≤ n → P n → P (succ n)) ⦃n : α⦄ (hmn : m ≤ n) : P n :=
begin
  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 }
end

lemma succ.rec_iff {p : α → Prop} (hsucc : ∀ a, p a ↔ p (succ a)) {a b : α} (h : a ≤ b) :
  p a ↔ p b :=
begin
  obtain ⟨n, rfl⟩ := h.exists_succ_iterate,
  exact iterate.rec (λ b, p a ↔ p b) (λ c hc, hc.trans (hsucc _)) iff.rfl n,
end

end succ_order

section pred_order
variables [pred_order α] [is_pred_archimedean α] {a b : α}

instance : is_succ_archimedean (order_dual α) :=
{ exists_succ_iterate_of_le := λ a b h, by convert @exists_pred_iterate_of_le α _ _ _ _ _ h }

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

lemma exists_pred_iterate_iff_le : (∃ n, pred^[n] b = a) ↔ a ≤ b :=
@exists_succ_iterate_iff_le (order_dual α) _ _ _ _ _

/-- Induction principle on a type with a `pred_order` for all elements below a given element `m`. -/
@[elab_as_eliminator] lemma 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 (order_dual α) _ _ _ _ _ h0 h1 _ hmn

lemma pred.rec_iff {p : α → Prop} (hsucc : ∀ a, p a ↔ p (pred a)) {a b : α} (h : a ≤ b) :
  p a ↔ p b :=
(@succ.rec_iff (order_dual α) _ _ _ _ hsucc _ _ h).symm

end pred_order
end preorder

section linear_order
variables [linear_order α]

section succ_order
variables [succ_order α] [is_succ_archimedean α] {a b : α}

lemma 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

lemma 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) (λ h, (succ.rec_iff hsucc h).symm)

end succ_order

section pred_order
variables [pred_order α] [is_pred_archimedean α] {a b : α}

lemma 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

lemma 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) (λ h, (pred.rec_iff hsucc h).symm)

end pred_order
end linear_order

section order_bot
variables [preorder α] [order_bot α] [succ_order α] [is_succ_archimedean α]

lemma succ.rec_bot (p : α → Prop) (hbot : p ⊥) (hsucc : ∀ a, p a → p (succ a)) (a : α) : p a :=
succ.rec hbot (λ x _ h, hsucc x h) (bot_le : ⊥ ≤ a)

end order_bot

section order_top
variables [preorder α] [order_top α] [pred_order α] [is_pred_archimedean α]

lemma pred.rec_top (p : α → Prop) (htop : p ⊤) (hpred : ∀ a, p a → p (pred a)) (a : α) : p a :=
pred.rec htop (λ x _ h, hpred x h) (le_top : a ≤ ⊤)

end order_top


/-
Copyright (c) 2021 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/
import topology.homeomorph

/-!
# Topological space structure on the opposite monoid and on the units group

In this file we define `topological_space` structure on `Mᵐᵒᵖ`, `Mᵃᵒᵖ`, `Mˣ`, and `add_units M`.
This file does not import definitions of a topological monoid and/or a continuous multiplicative
action, so we postpone the proofs of `has_continuous_mul Mᵐᵒᵖ` etc till we have these definitions.

## Tags

topological space, opposite monoid, units
-/

variables {M X : Type*}

open filter
open_locale topological_space

namespace mul_opposite

/-- Put the same topological space structure on the opposite monoid as on the original space. -/
@[to_additive] instance [topological_space M] : topological_space Mᵐᵒᵖ :=
topological_space.induced (unop : Mᵐᵒᵖ → M) ‹_›

variables [topological_space M]

@[continuity, to_additive] lemma continuous_unop : continuous (unop : Mᵐᵒᵖ → M) :=
continuous_induced_dom

@[continuity, to_additive] lemma continuous_op : continuous (op : M → Mᵐᵒᵖ) :=
continuous_induced_rng continuous_id

@[to_additive] instance [t2_space M] : t2_space Mᵐᵒᵖ :=
⟨λ x y h, separated_by_continuous mul_opposite.continuous_unop $ unop_injective.ne h⟩

/-- `mul_opposite.op` as a homeomorphism. -/
@[to_additive "`add_opposite.op` as a homeomorphism."]
def op_homeomorph : M ≃ₜ Mᵐᵒᵖ :=
{ to_equiv := op_equiv,
  continuous_to_fun := continuous_op,
  continuous_inv_fun := continuous_unop }

@[simp, to_additive] lemma map_op_nhds (x : M) : map (op : M → Mᵐᵒᵖ) (𝓝 x) = 𝓝 (op x) :=
op_homeomorph.map_nhds_eq x

@[simp, to_additive] lemma map_unop_nhds (x : Mᵐᵒᵖ) : map (unop : Mᵐᵒᵖ → M) (𝓝 x) = 𝓝 (unop x) :=
op_homeomorph.symm.map_nhds_eq x

@[simp, to_additive] lemma comap_op_nhds (x : Mᵐᵒᵖ) : comap (op : M → Mᵐᵒᵖ) (𝓝 x) = 𝓝 (unop x) :=
op_homeomorph.comap_nhds_eq x

@[simp, to_additive] lemma comap_unop_nhds (x : M) : comap (unop : Mᵐᵒᵖ → M) (𝓝 x) = 𝓝 (op x) :=
op_homeomorph.symm.comap_nhds_eq x

end mul_opposite

namespace units

open mul_opposite

variables [topological_space M] [monoid M]

/-- The units of a monoid are equipped with a topology, via the embedding into `M × M`. -/
@[to_additive] instance : topological_space Mˣ :=
topological_space.induced (embed_product M) prod.topological_space

@[to_additive] lemma continuous_embed_product : continuous (embed_product M) :=
continuous_induced_dom

@[to_additive] lemma continuous_coe : continuous (coe : Mˣ → M) :=
(@continuous_embed_product M _ _).fst

end units


/-
Copyright (c) 2020 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca
-/
import data.polynomial.algebra_map
import data.polynomial.monic

/-!
# Polynomials that lift

Given semirings `R` and `S` with a morphism `f : R →+* S`, we define a subsemiring `lifts` of
`polynomial S` by the image of `ring_hom.of (map f)`.
Then, we prove that a polynomial that lifts can always be lifted to a polynomial of the same degree
and that a monic polynomial that lifts can be lifted to a monic polynomial (of the same degree).

## Main definition

* `lifts (f : R →+* S)` : the subsemiring of polynomials that lift.

## Main results

* `lifts_and_degree_eq` : A polynomial lifts if and only if it can be lifted to a polynomial
of the same degree.
* `lifts_and_degree_eq_and_monic` : A monic polynomial lifts if and only if it can be lifted to a
monic polynomial of the same degree.
* `lifts_iff_alg` : if `R` is commutative, a polynomial lifts if and only if it is in the image of
`map_alg`, where `map_alg : polynomial R →ₐ[R] polynomial S` is the only `R`-algebra map
that sends `X` to `X`.

## Implementation details

In general `R` and `S` are semiring, so `lifts` is a semiring. In the case of rings, see
`lifts_iff_lifts_ring`.

Since we do not assume `R` to be commutative, we cannot say in general that the set of polynomials
that lift is a subalgebra. (By `lift_iff` this is true if `R` is commutative.)

-/

open_locale classical big_operators
noncomputable theory

namespace polynomial
universes u v w

section semiring

variables {R : Type u} [semiring R] {S : Type v} [semiring S] {f : R →+* S}

/-- We define the subsemiring of polynomials that lifts as the image of `ring_hom.of (map f)`. -/
def lifts (f : R →+* S) : subsemiring (polynomial S) := ring_hom.srange (map_ring_hom f)

lemma mem_lifts (p : polynomial S) : p ∈ lifts f ↔ ∃ (q : polynomial R), map f q = p :=
by simp only [coe_map_ring_hom, lifts, ring_hom.mem_srange]

lemma lifts_iff_ring_hom_srange (p : polynomial S) : p ∈ lifts f ↔ p ∈ (map_ring_hom f).srange :=
by simp only [coe_map_ring_hom, lifts, set.mem_range, ring_hom.mem_srange]

lemma lifts_iff_coeff_lifts (p : polynomial S) : p ∈ lifts f ↔ ∀ (n : ℕ), p.coeff n ∈ set.range f :=
by { rw [lifts_iff_ring_hom_srange, mem_map_srange f], refl }

/--If `(r : R)`, then `C (f r)` lifts. -/
lemma C_mem_lifts (f : R →+* S) (r : R) : (C (f r)) ∈ lifts f :=
⟨C r, by simp only [coe_map_ring_hom, map_C, set.mem_univ, subsemiring.coe_top, eq_self_iff_true,
  and_self]⟩

/-- If `(s : S)` is in the image of `f`, then `C s` lifts. -/
lemma C'_mem_lifts {f : R →+* S} {s : S} (h : s ∈ set.range f) : (C s) ∈ lifts f :=
begin
  obtain ⟨r, rfl⟩ := set.mem_range.1 h,
  use C r,
  simp only [coe_map_ring_hom, map_C, set.mem_univ, subsemiring.coe_top, eq_self_iff_true,
    and_self]
end

/-- The polynomial `X` lifts. -/
lemma X_mem_lifts (f : R →+* S) : (X : polynomial S) ∈ lifts f :=
⟨X, by simp only [coe_map_ring_hom, set.mem_univ, subsemiring.coe_top, eq_self_iff_true, map_X,
  and_self]⟩

/-- The polynomial `X ^ n` lifts. -/
lemma X_pow_mem_lifts (f : R →+* S) (n : ℕ) : (X ^ n : polynomial S) ∈ lifts f :=
⟨X ^ n, by simp only [coe_map_ring_hom, map_pow, set.mem_univ, subsemiring.coe_top,
  eq_self_iff_true, map_X, and_self]⟩

/-- If `p` lifts and `(r : R)` then `r * p` lifts. -/
lemma base_mul_mem_lifts {p : polynomial S} (r : R) (hp : p ∈ lifts f) : C (f r) * p ∈ lifts f :=
begin
  simp only [lifts, ring_hom.mem_srange] at hp ⊢,
  obtain ⟨p₁, rfl⟩ := hp,
  use C r * p₁,
  simp only [coe_map_ring_hom, map_C, map_mul]
end

/-- If `(s : S)` is in the image of `f`, then `monomial n s` lifts. -/
lemma monomial_mem_lifts {s : S} (n : ℕ) (h : s ∈ set.range f) : (monomial n s) ∈ lifts f :=
begin
  obtain ⟨r, rfl⟩ := set.mem_range.1 h,
  use monomial n r,
  simp only [coe_map_ring_hom, set.mem_univ, map_monomial, subsemiring.coe_top, eq_self_iff_true,
    and_self],
end

/-- If `p` lifts then `p.erase n` lifts. -/
lemma erase_mem_lifts {p : polynomial S} (n : ℕ) (h : p ∈ lifts f) : p.erase n ∈ lifts f :=
begin
  rw [lifts_iff_ring_hom_srange, mem_map_srange] at h ⊢,
  intros k,
  by_cases hk : k = n,
  { use 0,
    simp only [hk, ring_hom.map_zero, erase_same] },
  obtain ⟨i, hi⟩ := h k,
  use i,
  simp only [hi, hk, erase_ne, ne.def, not_false_iff],
end

section lift_deg

lemma monomial_mem_lifts_and_degree_eq {s : S} {n : ℕ} (hl : monomial n s ∈ lifts f) :
  ∃ (q : polynomial R), map f q = (monomial n s) ∧ q.degree = (monomial n s).degree :=
begin
  by_cases hzero : s = 0,
  { use 0,
    simp only [hzero, degree_zero, eq_self_iff_true, and_self, monomial_zero_right, map_zero] },
  rw lifts_iff_set_range at hl,
  obtain ⟨q, hq⟩ := hl,
  replace hq := (ext_iff.1 hq) n,
  have hcoeff : f (q.coeff n) = s,
  { simp [coeff_monomial] at hq,
    exact hq },
  use (monomial n (q.coeff n)),
  split,
  { simp only [hcoeff, map_monomial] },
  have hqzero : q.coeff n ≠ 0,
  { intro habs,
    simp only [habs, ring_hom.map_zero] at hcoeff,
    exact hzero hcoeff.symm },
  repeat {rw monomial_eq_C_mul_X},
  simp only [hzero, hqzero, ne.def, not_false_iff, degree_C_mul_X_pow],
end

/-- A polynomial lifts if and only if it can be lifted to a polynomial of the same degree. -/
lemma mem_lifts_and_degree_eq {p : polynomial S} (hlifts : p ∈ lifts f) :
  ∃ (q : polynomial R), map f q = p ∧ q.degree = p.degree :=
begin
  generalize' hd : p.nat_degree = d,
  revert hd p,
  apply nat.strong_induction_on d,
  intros n hn p hlifts hdeg,
  by_cases erase_zero : p.erase_lead = 0,
  { rw [← erase_lead_add_monomial_nat_degree_leading_coeff p, erase_zero, zero_add, leading_coeff],
    exact monomial_mem_lifts_and_degree_eq (monomial_mem_lifts p.nat_degree
    ((lifts_iff_coeff_lifts p).1 hlifts p.nat_degree)) },
  have deg_erase := or.resolve_right (erase_lead_nat_degree_lt_or_erase_lead_eq_zero p) erase_zero,
  have pzero : p ≠ 0,
  { intro habs,
    exfalso,
    rw [habs, erase_lead_zero, eq_self_iff_true, not_true] at erase_zero,
    exact erase_zero },
  have lead_zero : p.coeff p.nat_degree ≠ 0,
  { rw [← leading_coeff, ne.def, leading_coeff_eq_zero]; exact pzero },
  obtain ⟨lead, hlead⟩ := monomial_mem_lifts_and_degree_eq (monomial_mem_lifts p.nat_degree
    ((lifts_iff_coeff_lifts p).1 hlifts p.nat_degree)),
  have deg_lead : lead.degree = p.nat_degree,
  { rw [hlead.2, monomial_eq_C_mul_X, degree_C_mul_X_pow p.nat_degree lead_zero] },
  rw hdeg at deg_erase,
  obtain ⟨erase, herase⟩ := hn p.erase_lead.nat_degree deg_erase
    (erase_mem_lifts p.nat_degree hlifts) (refl p.erase_lead.nat_degree),
  use erase + lead,
  split,
  { simp only [hlead, herase, map_add],
    nth_rewrite 0 erase_lead_add_monomial_nat_degree_leading_coeff p },
  rw [←hdeg, erase_lead] at deg_erase,
  replace deg_erase := lt_of_le_of_lt degree_le_nat_degree (with_bot.coe_lt_coe.2 deg_erase),
  rw [← deg_lead, ← herase.2] at deg_erase,
  rw [degree_add_eq_right_of_degree_lt deg_erase, deg_lead, degree_eq_nat_degree pzero]
end

end lift_deg

section monic

/-- A monic polynomial lifts if and only if it can be lifted to a monic polynomial
of the same degree. -/
lemma lifts_and_degree_eq_and_monic [nontrivial S] {p : polynomial S} (hlifts :p ∈ lifts f)
  (hmonic : p.monic) : ∃ (q : polynomial R), map f q = p ∧ q.degree = p.degree ∧ q.monic :=
begin
  by_cases Rtrivial : nontrivial R,
  swap,
  { rw not_nontrivial_iff_subsingleton at Rtrivial,
    obtain ⟨q, hq⟩ := mem_lifts_and_degree_eq hlifts,
    use q,
    exact ⟨hq.1, hq.2, @monic_of_subsingleton _ _ Rtrivial q⟩ },
  by_cases er_zero : p.erase_lead = 0,
  { rw [← erase_lead_add_C_mul_X_pow p, er_zero, zero_add, monic.def.1 hmonic, C_1, one_mul],
    use X ^ p.nat_degree,
    repeat {split},
    { simp only [map_pow, map_X] },
    { rw [@degree_X_pow R _ Rtrivial, degree_X_pow] },
    {exact monic_pow monic_X p.nat_degree } },
  obtain ⟨q, hq⟩ := mem_lifts_and_degree_eq (erase_mem_lifts p.nat_degree hlifts),
  have deg_er : p.erase_lead.nat_degree < p.nat_degree :=
    or.resolve_right (erase_lead_nat_degree_lt_or_erase_lead_eq_zero p) er_zero,
  replace deg_er := with_bot.coe_lt_coe.2 deg_er,
  rw [← degree_eq_nat_degree er_zero, erase_lead, ← hq.2,
    ← @degree_X_pow R _ Rtrivial p.nat_degree] at deg_er,
  use q + X ^ p.nat_degree,
  repeat {split},
  { simp only [hq, map_add, map_pow, map_X],
    nth_rewrite 3 [← erase_lead_add_C_mul_X_pow p],
    rw [erase_lead, monic.leading_coeff hmonic, C_1, one_mul] },
  { rw [degree_add_eq_right_of_degree_lt deg_er, @degree_X_pow R _ Rtrivial p.nat_degree,
    degree_eq_nat_degree (monic.ne_zero hmonic)] },
  { rw [monic.def, leading_coeff_add_of_degree_lt deg_er],
    exact monic_pow monic_X p.nat_degree }
end

end monic

end semiring

section ring

variables {R : Type u} [ring R] {S : Type v} [ring S] (f : R →+* S)

/-- The subring of polynomials that lift. -/
def lifts_ring (f : R →+* S) : subring (polynomial S) := ring_hom.range (map_ring_hom f)

/-- If `R` and `S` are rings, `p` is in the subring of polynomials that lift if and only if it is in
the subsemiring of polynomials that lift. -/
lemma lifts_iff_lifts_ring (p : polynomial S) : p ∈ lifts f ↔ p ∈ lifts_ring f :=
by simp only [lifts, lifts_ring, ring_hom.mem_range, ring_hom.mem_srange]

end ring

section algebra

variables {R : Type u} [comm_semiring R] {S : Type v} [semiring S] [algebra R S]

/-- The map `polynomial R → polynomial S` as an algebra homomorphism. -/
def map_alg (R : Type u) [comm_semiring R] (S : Type v) [semiring S] [algebra R S] :
  polynomial R →ₐ[R] polynomial S := @aeval _ (polynomial S) _ _ _ (X : polynomial S)

/-- `map_alg` is the morphism induced by `R → S`. -/
lemma map_alg_eq_map (p : polynomial R) : map_alg R S p = map (algebra_map R S) p :=
by simp only [map_alg, aeval_def, eval₂, map, algebra_map_apply, ring_hom.coe_comp]

/-- A polynomial `p` lifts if and only if it is in the image of `map_alg`. -/
lemma mem_lifts_iff_mem_alg (R : Type u) [comm_semiring R] {S : Type v} [semiring S] [algebra R S]
  (p : polynomial S) :p ∈ lifts (algebra_map R S) ↔ p ∈ (alg_hom.range (@map_alg R _ S _ _)) :=
by simp only [coe_map_ring_hom, lifts, map_alg_eq_map, alg_hom.mem_range,
  ring_hom.mem_srange]

/-- If `p` lifts and `(r : R)` then `r • p` lifts. -/
lemma smul_mem_lifts {p : polynomial S} (r : R) (hp : p ∈ lifts (algebra_map R S)) :
  r • p ∈ lifts (algebra_map R S) :=
by { rw mem_lifts_iff_mem_alg at hp ⊢, exact subalgebra.smul_mem (map_alg R S).range hp r }

end algebra

end polynomial


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.semiconj
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Commuting pairs of elements in monoids

We define the predicate `commute a b := a * b = b * a` and provide some operations on terms `(h :
commute a b)`. E.g., if `a`, `b`, and c are elements of a semiring, and that `hb : commute a b` and
`hc : commute a c`.  Then `hb.pow_left 5` proves `commute (a ^ 5) b` and `(hb.pow_right 2).add_right
(hb.mul_right hc)` proves `commute a (b ^ 2 + b * c)`.

Lean does not immediately recognise these terms as equations, so for rewriting we need syntax like
`rw [(hb.pow_left 5).eq]` rather than just `rw [hb.pow_left 5]`.

This file defines only a few operations (`mul_left`, `inv_right`, etc).  Other operations
(`pow_right`, field inverse etc) are in the files that define corresponding notions.

## Implementation details

Most of the proofs come from the properties of `semiconj_by`.
-/

/-- Two elements commute if `a * b = b * a`. -/
def commute {S : Type u_1} [Mul S] (a : S) (b : S) :=
  semiconj_by a b b

namespace commute

/-- Equality behind `commute a b`; useful for rewriting. -/
protected theorem Mathlib.add_commute.eq {S : Type u_1} [Add S] {a : S} {b : S} (h : add_commute a b) : a + b = b + a :=
  h

/-- Any element commutes with itself. -/
@[simp] protected theorem refl {S : Type u_1} [Mul S] (a : S) : commute a a :=
  Eq.refl (a * a)

/-- If `a` commutes with `b`, then `b` commutes with `a`. -/
protected theorem Mathlib.add_commute.symm {S : Type u_1} [Add S] {a : S} {b : S} (h : add_commute a b) : add_commute b a :=
  Eq.symm h

protected theorem Mathlib.add_commute.symm_iff {S : Type u_1} [Add S] {a : S} {b : S} : add_commute a b ↔ add_commute b a :=
  { mp := add_commute.symm, mpr := add_commute.symm }

/-- If `a` commutes with both `b` and `c`, then it commutes with their product. -/
@[simp] theorem mul_right {S : Type u_1} [semigroup S] {a : S} {b : S} {c : S} (hab : commute a b) (hac : commute a c) : commute a (b * c) :=
  semiconj_by.mul_right hab hac

/-- If both `a` and `b` commute with `c`, then their product commutes with `c`. -/
@[simp] theorem Mathlib.add_commute.add_left {S : Type u_1} [add_semigroup S] {a : S} {b : S} {c : S} (hac : add_commute a c) (hbc : add_commute b c) : add_commute (a + b) c :=
  add_semiconj_by.add_left hac hbc

protected theorem Mathlib.add_commute.right_comm {S : Type u_1} [add_semigroup S] {b : S} {c : S} (h : add_commute b c) (a : S) : a + b + c = a + c + b := sorry

protected theorem left_comm {S : Type u_1} [semigroup S] {a : S} {b : S} (h : commute a b) (c : S) : a * (b * c) = b * (a * c) := sorry

protected theorem Mathlib.add_commute.all {S : Type u_1} [add_comm_semigroup S] (a : S) (b : S) : add_commute a b :=
  add_comm a b

@[simp] theorem one_right {M : Type u_1} [monoid M] (a : M) : commute a 1 :=
  semiconj_by.one_right a

@[simp] theorem Mathlib.add_commute.zero_left {M : Type u_1} [add_monoid M] (a : M) : add_commute 0 a :=
  add_semiconj_by.zero_left a

theorem Mathlib.add_commute.units_neg_right {M : Type u_1} [add_monoid M] {a : M} {u : add_units M} : add_commute a ↑u → add_commute a ↑(-u) :=
  add_semiconj_by.units_neg_right

@[simp] theorem Mathlib.add_commute.units_neg_right_iff {M : Type u_1} [add_monoid M] {a : M} {u : add_units M} : add_commute a ↑(-u) ↔ add_commute a ↑u :=
  add_semiconj_by.units_neg_right_iff

theorem Mathlib.add_commute.units_neg_left {M : Type u_1} [add_monoid M] {u : add_units M} {a : M} : add_commute (↑u) a → add_commute (↑(-u)) a :=
  add_semiconj_by.units_neg_symm_left

@[simp] theorem Mathlib.add_commute.units_neg_left_iff {M : Type u_1} [add_monoid M] {u : add_units M} {a : M} : add_commute (↑(-u)) a ↔ add_commute (↑u) a :=
  add_semiconj_by.units_neg_symm_left_iff

theorem Mathlib.add_commute.units_coe {M : Type u_1} [add_monoid M] {u₁ : add_units M} {u₂ : add_units M} : add_commute u₁ u₂ → add_commute ↑u₁ ↑u₂ :=
  add_semiconj_by.units_coe

theorem Mathlib.add_commute.units_of_coe {M : Type u_1} [add_monoid M] {u₁ : add_units M} {u₂ : add_units M} : add_commute ↑u₁ ↑u₂ → add_commute u₁ u₂ :=
  add_semiconj_by.units_of_coe

@[simp] theorem units_coe_iff {M : Type u_1} [monoid M] {u₁ : units M} {u₂ : units M} : commute ↑u₁ ↑u₂ ↔ commute u₁ u₂ :=
  semiconj_by.units_coe_iff

theorem Mathlib.add_commute.neg_right {G : Type u_1} [add_group G] {a : G} {b : G} : add_commute a b → add_commute a (-b) :=
  add_semiconj_by.neg_right

@[simp] theorem Mathlib.add_commute.neg_right_iff {G : Type u_1} [add_group G] {a : G} {b : G} : add_commute a (-b) ↔ add_commute a b :=
  add_semiconj_by.neg_right_iff

theorem inv_left {G : Type u_1} [group G] {a : G} {b : G} : commute a b → commute (a⁻¹) b :=
  semiconj_by.inv_symm_left

@[simp] theorem inv_left_iff {G : Type u_1} [group G] {a : G} {b : G} : commute (a⁻¹) b ↔ commute a b :=
  semiconj_by.inv_symm_left_iff

theorem Mathlib.add_commute.neg_neg {G : Type u_1} [add_group G] {a : G} {b : G} : add_commute a b → add_commute (-a) (-b) :=
  add_semiconj_by.neg_neg_symm

@[simp] theorem inv_inv_iff {G : Type u_1} [group G] {a : G} {b : G} : commute (a⁻¹) (b⁻¹) ↔ commute a b :=
  semiconj_by.inv_inv_symm_iff

protected theorem Mathlib.add_commute.neg_add_cancel {G : Type u_1} [add_group G] {a : G} {b : G} (h : add_commute a b) : -a + b + a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-a + b + a = b)) (add_commute.eq (add_commute.neg_left h))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b + -a + a = b)) (neg_add_cancel_right b a))) (Eq.refl b))

theorem inv_mul_cancel_assoc {G : Type u_1} [group G] {a : G} {b : G} (h : commute a b) : a⁻¹ * (b * a) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ * (b * a) = b)) (Eq.symm (mul_assoc (a⁻¹) b a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ * b * a = b)) (commute.inv_mul_cancel h))) (Eq.refl b))

protected theorem mul_inv_cancel {G : Type u_1} [group G] {a : G} {b : G} (h : commute a b) : a * b * (a⁻¹) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b * (a⁻¹) = b)) (commute.eq h)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b * a * (a⁻¹) = b)) (mul_inv_cancel_right b a))) (Eq.refl b))

theorem mul_inv_cancel_assoc {G : Type u_1} [group G] {a : G} {b : G} (h : commute a b) : a * (b * (a⁻¹)) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * (b * (a⁻¹)) = b)) (Eq.symm (mul_assoc a b (a⁻¹)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b * (a⁻¹) = b)) (commute.mul_inv_cancel h))) (Eq.refl b))

end commute

@[simp] theorem mul_inv_cancel_comm {G : Type u_1} [comm_group G] (a : G) (b : G) : a * b * (a⁻¹) = b :=
  commute.mul_inv_cancel (commute.all a b)

@[simp] theorem add_neg_cancel_comm_assoc {G : Type u_1} [add_comm_group G] (a : G) (b : G) : a + (b + -a) = b :=
  add_commute.add_neg_cancel_assoc (add_commute.all a b)

@[simp] theorem inv_mul_cancel_comm {G : Type u_1} [comm_group G] (a : G) (b : G) : a⁻¹ * b * a = b :=
  commute.inv_mul_cancel (commute.all a b)

@[simp] theorem inv_mul_cancel_comm_assoc {G : Type u_1} [comm_group G] (a : G) (b : G) : a⁻¹ * (b * a) = b :=
  commute.inv_mul_cancel_assoc (commute.all a b)


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import analysis.normed_space.basic
import analysis.normed_space.linear_isometry

/-!
# Conformal Linear Maps

A continuous linear map between `R`-normed spaces `X` and `Y` `is_conformal_map` if it is
a nonzero multiple of a linear isometry.

## Main definitions

* `is_conformal_map`: the main definition of conformal linear maps

## Main results

* The conformality of the composition of two conformal linear maps, the identity map
  and multiplications by nonzero constants as continuous linear maps
* `is_conformal_map_of_subsingleton`: all continuous linear maps on singleton spaces are conformal
* `is_conformal_map.preserves_angle`: if a continuous linear map is conformal, then it
                                      preserves all angles in the normed space

See `analysis.normed_space.conformal_linear_map.inner_product` for
* `is_conformal_map_iff`: a map between inner product spaces is conformal
  iff it preserves inner products up to a fixed scalar factor.

## Tags

conformal

## Warning

The definition of conformality in this file does NOT require the maps to be orientation-preserving.
-/

noncomputable theory

open function linear_isometry continuous_linear_map

/-- A continuous linear map `f'` is said to be conformal if it's
    a nonzero multiple of a linear isometry. -/
def is_conformal_map {R : Type*} {X Y : Type*} [normed_field R]
  [semi_normed_group X] [semi_normed_group Y] [normed_space R X] [normed_space R Y]
  (f' : X →L[R] Y) :=
∃ (c : R) (hc : c ≠ 0) (li : X →ₗᵢ[R] Y), f' = c • li.to_continuous_linear_map

variables {R M N G M' : Type*} [normed_field R]
  [semi_normed_group M] [semi_normed_group N] [semi_normed_group G]
  [normed_space R M] [normed_space R N] [normed_space R G]
  [normed_group M'] [normed_space R M']
  {f : M →L[R] N} {g : N →L[R] G} {c : R}

lemma is_conformal_map_id : is_conformal_map (id R M) :=
⟨1, one_ne_zero, id, by simp⟩

lemma is_conformal_map.smul (hf : is_conformal_map f) {c : R} (hc : c ≠ 0) :
  is_conformal_map (c • f) :=
begin
  rcases hf with ⟨c', hc', li, rfl⟩,
  exact ⟨c * c', mul_ne_zero hc hc', li, smul_smul _ _ _⟩
end

lemma is_conformal_map_const_smul (hc : c ≠ 0) : is_conformal_map (c • id R M) :=
is_conformal_map_id.smul hc

protected lemma linear_isometry.is_conformal_map (f' : M →ₗᵢ[R] N) :
  is_conformal_map f'.to_continuous_linear_map :=
⟨1, one_ne_zero, f', (one_smul _ _).symm⟩

@[nontriviality] lemma is_conformal_map_of_subsingleton [subsingleton M] (f' : M →L[R] N) :
  is_conformal_map f' :=
⟨1, one_ne_zero, ⟨0, λ x, by simp [subsingleton.elim x 0]⟩, subsingleton.elim _ _⟩

namespace is_conformal_map

lemma comp (hg : is_conformal_map g) (hf : is_conformal_map f) :
  is_conformal_map (g.comp f) :=
begin
  rcases hf with ⟨cf, hcf, lif, rfl⟩,
  rcases hg with ⟨cg, hcg, lig, rfl⟩,
  refine ⟨cg * cf, mul_ne_zero hcg hcf, lig.comp lif, _⟩,
  rw [smul_comp, comp_smul, mul_smul],
  refl
end

protected lemma injective {f : M' →L[R] N} (h : is_conformal_map f) : function.injective f :=
by { rcases h with ⟨c, hc, li, rfl⟩, exact (smul_right_injective _ hc).comp li.injective }

lemma ne_zero [nontrivial M'] {f' : M' →L[R] N} (hf' : is_conformal_map f') :
  f' ≠ 0 :=
begin
  rintro rfl,
  rcases exists_ne (0 : M') with ⟨a, ha⟩,
  exact ha (hf'.injective rfl)
end

end is_conformal_map


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne

! This file was ported from Lean 3 source module analysis.special_functions.exp
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Asymptotics.Theta
import Mathbin.Analysis.Complex.Basic
import Mathbin.Analysis.SpecificLimits.Normed
import Mathbin.Data.Complex.Exponential

/-!
# Complex and real exponential

In this file we prove continuity of `complex.exp` and `real.exp`. We also prove a few facts about
limits of `real.exp` at infinity.

## Tags

exp
-/

noncomputable section

open Finset Filter Metric Asymptotics Set Function

open Classical Topology

namespace Complex

variable {z y x : ℝ}

theorem exp_bound_sq (x z : ℂ) (hz : ‖z‖ ≤ 1) :
    ‖exp (x + z) - exp x - z • exp x‖ ≤ ‖exp x‖ * ‖z‖ ^ 2 :=
  calc
    ‖exp (x + z) - exp x - z * exp x‖ = ‖exp x * (exp z - 1 - z)‖ :=
      by
      congr
      rw [exp_add]
      ring
    _ = ‖exp x‖ * ‖exp z - 1 - z‖ := (norm_mul _ _)
    _ ≤ ‖exp x‖ * ‖z‖ ^ 2 :=
      mul_le_mul_of_nonneg_left (abs_exp_sub_one_sub_id_le hz) (norm_nonneg _)

#align complex.exp_bound_sq Complex.exp_bound_sq

theorem locally_lipschitz_exp {r : ℝ} (hr_nonneg : 0 ≤ r) (hr_le : r ≤ 1) (x y : ℂ)
    (hyx : ‖y - x‖ < r) : ‖exp y - exp x‖ ≤ (1 + r) * ‖exp x‖ * ‖y - x‖ :=
  by
  have hy_eq : y = x + (y - x) := by abel
  have hyx_sq_le : ‖y - x‖ ^ 2 ≤ r * ‖y - x‖ :=
    by
    rw [pow_two]
    exact mul_le_mul hyx.le le_rfl (norm_nonneg _) hr_nonneg
  have h_sq : ∀ z, ‖z‖ ≤ 1 → ‖exp (x + z) - exp x‖ ≤ ‖z‖ * ‖exp x‖ + ‖exp x‖ * ‖z‖ ^ 2 :=
    by
    intro z hz
    have : ‖exp (x + z) - exp x - z • exp x‖ ≤ ‖exp x‖ * ‖z‖ ^ 2 := exp_bound_sq x z hz
    rw [← sub_le_iff_le_add', ← norm_smul z]
    exact (norm_sub_norm_le _ _).trans this
  calc
    ‖exp y - exp x‖ = ‖exp (x + (y - x)) - exp x‖ := by nth_rw 1 [hy_eq]
    _ ≤ ‖y - x‖ * ‖exp x‖ + ‖exp x‖ * ‖y - x‖ ^ 2 := (h_sq (y - x) (hyx.le.trans hr_le))
    _ ≤ ‖y - x‖ * ‖exp x‖ + ‖exp x‖ * (r * ‖y - x‖) :=
      (add_le_add_left (mul_le_mul le_rfl hyx_sq_le (sq_nonneg _) (norm_nonneg _)) _)
    _ = (1 + r) * ‖exp x‖ * ‖y - x‖ := by ring

#align complex.locally_lipschitz_exp Complex.locally_lipschitz_exp

@[continuity]
theorem continuous_exp : Continuous exp :=
  continuous_iff_continuousAt.mpr fun x =>
    continuousAt_of_locally_lipschitz zero_lt_one (2 * ‖exp x‖)
      (locally_lipschitz_exp zero_le_one le_rfl x)
#align complex.continuous_exp Complex.continuous_exp

theorem continuousOn_exp {s : Set ℂ} : ContinuousOn exp s :=
  continuous_exp.ContinuousOn
#align complex.continuous_on_exp Complex.continuousOn_exp

end Complex

section ComplexContinuousExpComp

variable {α : Type _}

open Complex

theorem Filter.Tendsto.cexp {l : Filter α} {f : α → ℂ} {z : ℂ} (hf : Tendsto f l (𝓝 z)) :
    Tendsto (fun x => exp (f x)) l (𝓝 (exp z)) :=
  (continuous_exp.Tendsto _).comp hf
#align filter.tendsto.cexp Filter.Tendsto.cexp

variable [TopologicalSpace α] {f : α → ℂ} {s : Set α} {x : α}

theorem ContinuousWithinAt.cexp (h : ContinuousWithinAt f s x) :
    ContinuousWithinAt (fun y => exp (f y)) s x :=
  h.cexp
#align continuous_within_at.cexp ContinuousWithinAt.cexp

theorem ContinuousAt.cexp (h : ContinuousAt f x) : ContinuousAt (fun y => exp (f y)) x :=
  h.cexp
#align continuous_at.cexp ContinuousAt.cexp

theorem ContinuousOn.cexp (h : ContinuousOn f s) : ContinuousOn (fun y => exp (f y)) s :=
  fun x hx => (h x hx).cexp
#align continuous_on.cexp ContinuousOn.cexp

theorem Continuous.cexp (h : Continuous f) : Continuous fun y => exp (f y) :=
  continuous_iff_continuousAt.2 fun x => h.ContinuousAt.cexp
#align continuous.cexp Continuous.cexp

end ComplexContinuousExpComp

namespace Real

@[continuity]
theorem continuous_exp : Continuous exp :=
  Complex.continuous_re.comp Complex.continuous_of_real.cexp
#align real.continuous_exp Real.continuous_exp

theorem continuousOn_exp {s : Set ℝ} : ContinuousOn exp s :=
  continuous_exp.ContinuousOn
#align real.continuous_on_exp Real.continuousOn_exp

end Real

section RealContinuousExpComp

variable {α : Type _}

open Real

theorem Filter.Tendsto.exp {l : Filter α} {f : α → ℝ} {z : ℝ} (hf : Tendsto f l (𝓝 z)) :
    Tendsto (fun x => exp (f x)) l (𝓝 (exp z)) :=
  (continuous_exp.Tendsto _).comp hf
#align filter.tendsto.exp Filter.Tendsto.exp

variable [TopologicalSpace α] {f : α → ℝ} {s : Set α} {x : α}

theorem ContinuousWithinAt.exp (h : ContinuousWithinAt f s x) :
    ContinuousWithinAt (fun y => exp (f y)) s x :=
  h.exp
#align continuous_within_at.exp ContinuousWithinAt.exp

theorem ContinuousAt.exp (h : ContinuousAt f x) : ContinuousAt (fun y => exp (f y)) x :=
  h.exp
#align continuous_at.exp ContinuousAt.exp

theorem ContinuousOn.exp (h : ContinuousOn f s) : ContinuousOn (fun y => exp (f y)) s := fun x hx =>
  (h x hx).exp
#align continuous_on.exp ContinuousOn.exp

theorem Continuous.exp (h : Continuous f) : Continuous fun y => exp (f y) :=
  continuous_iff_continuousAt.2 fun x => h.ContinuousAt.exp
#align continuous.exp Continuous.exp

end RealContinuousExpComp

namespace Real

variable {α : Type _} {x y z : ℝ} {l : Filter α}

theorem exp_half (x : ℝ) : exp (x / 2) = sqrt (exp x) := by
  rw [eq_comm, sqrt_eq_iff_sq_eq, sq, ← exp_add, add_halves] <;> exact (exp_pos _).le
#align real.exp_half Real.exp_half

/-- The real exponential function tends to `+∞` at `+∞`. -/
theorem tendsto_exp_atTop : Tendsto exp atTop atTop :=
  by
  have A : tendsto (fun x : ℝ => x + 1) at_top at_top :=
    tendsto_at_top_add_const_right at_top 1 tendsto_id
  have B : ∀ᶠ x in at_top, x + 1 ≤ exp x := eventually_at_top.2 ⟨0, fun x hx => add_one_le_exp x⟩
  exact tendsto_at_top_mono' at_top B A
#align real.tendsto_exp_at_top Real.tendsto_exp_atTop

/-- The real exponential function tends to `0` at `-∞` or, equivalently, `exp(-x)` tends to `0`
at `+∞` -/
theorem tendsto_exp_neg_atTop_nhds_0 : Tendsto (fun x => exp (-x)) atTop (𝓝 0) :=
  (tendsto_inv_atTop_zero.comp tendsto_exp_atTop).congr fun x => (exp_neg x).symm
#align real.tendsto_exp_neg_at_top_nhds_0 Real.tendsto_exp_neg_atTop_nhds_0

/-- The real exponential function tends to `1` at `0`. -/
theorem tendsto_exp_nhds_0_nhds_1 : Tendsto exp (𝓝 0) (𝓝 1) :=
  by
  convert continuous_exp.tendsto 0
  simp
#align real.tendsto_exp_nhds_0_nhds_1 Real.tendsto_exp_nhds_0_nhds_1

theorem tendsto_exp_atBot : Tendsto exp atBot (𝓝 0) :=
  (tendsto_exp_neg_atTop_nhds_0.comp tendsto_neg_atBot_atTop).congr fun x =>
    congr_arg exp <| neg_neg x
#align real.tendsto_exp_at_bot Real.tendsto_exp_atBot

theorem tendsto_exp_atBot_nhdsWithin : Tendsto exp atBot (𝓝[>] 0) :=
  tendsto_inf.2 ⟨tendsto_exp_atBot, tendsto_principal.2 <| eventually_of_forall exp_pos⟩
#align real.tendsto_exp_at_bot_nhds_within Real.tendsto_exp_atBot_nhdsWithin

@[simp]
theorem isBoundedUnder_ge_exp_comp (l : Filter α) (f : α → ℝ) :
    IsBoundedUnder (· ≥ ·) l fun x => exp (f x) :=
  isBoundedUnder_of ⟨0, fun x => (exp_pos _).le⟩
#align real.is_bounded_under_ge_exp_comp Real.isBoundedUnder_ge_exp_comp

@[simp]
theorem isBoundedUnder_le_exp_comp {f : α → ℝ} :
    (IsBoundedUnder (· ≤ ·) l fun x => exp (f x)) ↔ IsBoundedUnder (· ≤ ·) l f :=
  exp_monotone.isBoundedUnder_le_comp tendsto_exp_atTop
#align real.is_bounded_under_le_exp_comp Real.isBoundedUnder_le_exp_comp

/-- The function `exp(x)/x^n` tends to `+∞` at `+∞`, for any natural number `n` -/
theorem tendsto_exp_div_pow_atTop (n : ℕ) : Tendsto (fun x => exp x / x ^ n) atTop atTop :=
  by
  refine' (at_top_basis_Ioi.tendsto_iff (at_top_basis' 1)).2 fun C hC₁ => _
  have hC₀ : 0 < C := zero_lt_one.trans_le hC₁
  have : 0 < (exp 1 * C)⁻¹ := inv_pos.2 (mul_pos (exp_pos _) hC₀)
  obtain ⟨N, hN⟩ : ∃ N, ∀ k ≥ N, (↑k ^ n : ℝ) / exp 1 ^ k < (exp 1 * C)⁻¹ :=
    eventually_at_top.1
      ((tendsto_pow_const_div_const_pow_of_one_lt n (one_lt_exp_iff.2 zero_lt_one)).Eventually
        (gt_mem_nhds this))
  simp only [← exp_nat_mul, mul_one, div_lt_iff, exp_pos, ← div_eq_inv_mul] at hN
  refine' ⟨N, trivial, fun x hx => _⟩
  rw [Set.mem_Ioi] at hx
  have hx₀ : 0 < x := N.cast_nonneg.trans_lt hx
  rw [Set.mem_Ici, le_div_iff (pow_pos hx₀ _), ← le_div_iff' hC₀]
  calc
    x ^ n ≤ ⌈x⌉₊ ^ n := pow_le_pow_of_le_left hx₀.le (Nat.le_ceil _) _
    _ ≤ exp ⌈x⌉₊ / (exp 1 * C) := (hN _ (Nat.lt_ceil.2 hx).le).le
    _ ≤ exp (x + 1) / (exp 1 * C) :=
      (div_le_div_of_le (mul_pos (exp_pos _) hC₀).le
        (exp_le_exp.2 <| (Nat.ceil_lt_add_one hx₀.le).le))
    _ = exp x / C := by rw [add_comm, exp_add, mul_div_mul_left _ _ (exp_pos _).ne']

#align real.tendsto_exp_div_pow_at_top Real.tendsto_exp_div_pow_atTop

/-- The function `x^n * exp(-x)` tends to `0` at `+∞`, for any natural number `n`. -/
theorem tendsto_pow_mul_exp_neg_atTop_nhds_0 (n : ℕ) :
    Tendsto (fun x => x ^ n * exp (-x)) atTop (𝓝 0) :=
  (tendsto_inv_atTop_zero.comp (tendsto_exp_div_pow_atTop n)).congr fun x => by
    rw [comp_app, inv_eq_one_div, div_div_eq_mul_div, one_mul, div_eq_mul_inv, exp_neg]
#align real.tendsto_pow_mul_exp_neg_at_top_nhds_0 Real.tendsto_pow_mul_exp_neg_atTop_nhds_0

/-- The function `(b * exp x + c) / (x ^ n)` tends to `+∞` at `+∞`, for any natural number
`n` and any real numbers `b` and `c` such that `b` is positive. -/
theorem tendsto_mul_exp_add_div_pow_atTop (b c : ℝ) (n : ℕ) (hb : 0 < b) :
    Tendsto (fun x => (b * exp x + c) / x ^ n) atTop atTop :=
  by
  rcases eq_or_ne n 0 with (rfl | hn)
  · simp only [pow_zero, div_one]
    exact (tendsto_exp_at_top.const_mul_at_top hb).atTop_add tendsto_const_nhds
  simp only [add_div, mul_div_assoc]
  exact
    ((tendsto_exp_div_pow_at_top n).const_mul_atTop hb).atTop_add
      (tendsto_const_nhds.div_at_top (tendsto_pow_at_top hn))
#align real.tendsto_mul_exp_add_div_pow_at_top Real.tendsto_mul_exp_add_div_pow_atTop

/-- The function `(x ^ n) / (b * exp x + c)` tends to `0` at `+∞`, for any natural number
`n` and any real numbers `b` and `c` such that `b` is nonzero. -/
theorem tendsto_div_pow_mul_exp_add_atTop (b c : ℝ) (n : ℕ) (hb : 0 ≠ b) :
    Tendsto (fun x => x ^ n / (b * exp x + c)) atTop (𝓝 0) :=
  by
  have H : ∀ d e, 0 < d → tendsto (fun x : ℝ => x ^ n / (d * exp x + e)) at_top (𝓝 0) :=
    by
    intro b' c' h
    convert(tendsto_mul_exp_add_div_pow_at_top b' c' n h).inv_tendsto_atTop
    ext x
    simpa only [Pi.inv_apply] using (inv_div _ _).symm
  cases lt_or_gt_of_ne hb
  · exact H b c h
  · convert(H (-b) (-c) (neg_pos.mpr h)).neg
    · ext x
      field_simp
      rw [← neg_add (b * exp x) c, neg_div_neg_eq]
    · exact neg_zero.symm
#align real.tendsto_div_pow_mul_exp_add_at_top Real.tendsto_div_pow_mul_exp_add_atTop

/-- `real.exp` as an order isomorphism between `ℝ` and `(0, +∞)`. -/
def expOrderIso : ℝ ≃o Ioi (0 : ℝ) :=
  StrictMono.orderIsoOfSurjective _ (exp_strictMono.codRestrict exp_pos) <|
    (continuous_exp.subtype_mk _).Surjective
      (by simp only [tendsto_Ioi_at_top, Subtype.coe_mk, tendsto_exp_at_top])
      (by simp [tendsto_exp_at_bot_nhds_within])
#align real.exp_order_iso Real.expOrderIso

@[simp]
theorem coe_expOrderIso_apply (x : ℝ) : (expOrderIso x : ℝ) = exp x :=
  rfl
#align real.coe_exp_order_iso_apply Real.coe_expOrderIso_apply

@[simp]
theorem coe_comp_expOrderIso : coe ∘ expOrderIso = exp :=
  rfl
#align real.coe_comp_exp_order_iso Real.coe_comp_expOrderIso

@[simp]
theorem range_exp : range exp = Ioi 0 := by
  rw [← coe_comp_exp_order_iso, range_comp, exp_order_iso.range_eq, image_univ, Subtype.range_coe]
#align real.range_exp Real.range_exp

@[simp]
theorem map_exp_atTop : map exp atTop = atTop := by
  rw [← coe_comp_exp_order_iso, ← Filter.map_map, OrderIso.map_atTop, map_coe_Ioi_at_top]
#align real.map_exp_at_top Real.map_exp_atTop

@[simp]
theorem comap_exp_atTop : comap exp atTop = atTop := by
  rw [← map_exp_at_top, comap_map exp_injective, map_exp_at_top]
#align real.comap_exp_at_top Real.comap_exp_atTop

@[simp]
theorem tendsto_exp_comp_atTop {f : α → ℝ} :
    Tendsto (fun x => exp (f x)) l atTop ↔ Tendsto f l atTop := by
  rw [← tendsto_comap_iff, comap_exp_at_top]
#align real.tendsto_exp_comp_at_top Real.tendsto_exp_comp_atTop

theorem tendsto_comp_exp_atTop {f : ℝ → α} :
    Tendsto (fun x => f (exp x)) atTop l ↔ Tendsto f atTop l := by
  rw [← tendsto_map'_iff, map_exp_at_top]
#align real.tendsto_comp_exp_at_top Real.tendsto_comp_exp_atTop

@[simp]
theorem map_exp_atBot : map exp atBot = 𝓝[>] 0 := by
  rw [← coe_comp_exp_order_iso, ← Filter.map_map, exp_order_iso.map_at_bot, ← map_coe_Ioi_atBot]
#align real.map_exp_at_bot Real.map_exp_atBot

@[simp]
theorem comap_exp_nhdsWithin_Ioi_zero : comap exp (𝓝[>] 0) = atBot := by
  rw [← map_exp_at_bot, comap_map exp_injective]
#align real.comap_exp_nhds_within_Ioi_zero Real.comap_exp_nhdsWithin_Ioi_zero

theorem tendsto_comp_exp_atBot {f : ℝ → α} :
    Tendsto (fun x => f (exp x)) atBot l ↔ Tendsto f (𝓝[>] 0) l := by
  rw [← map_exp_at_bot, tendsto_map'_iff]
#align real.tendsto_comp_exp_at_bot Real.tendsto_comp_exp_atBot

@[simp]
theorem comap_exp_nhds_zero : comap exp (𝓝 0) = atBot :=
  (comap_nhdsWithin_range exp 0).symm.trans <| by simp
#align real.comap_exp_nhds_zero Real.comap_exp_nhds_zero

@[simp]
theorem tendsto_exp_comp_nhds_zero {f : α → ℝ} :
    Tendsto (fun x => exp (f x)) l (𝓝 0) ↔ Tendsto f l atBot := by
  rw [← tendsto_comap_iff, comap_exp_nhds_zero]
#align real.tendsto_exp_comp_nhds_zero Real.tendsto_exp_comp_nhds_zero

theorem isOCat_pow_exp_atTop {n : ℕ} : (fun x => x ^ n) =o[atTop] Real.exp := by
  simpa [is_o_iff_tendsto fun x hx => ((exp_pos x).ne' hx).elim] using
    tendsto_div_pow_mul_exp_add_at_top 1 0 n zero_ne_one
#align real.is_o_pow_exp_at_top Real.isOCat_pow_exp_atTop

@[simp]
theorem isO_exp_comp_exp_comp {f g : α → ℝ} :
    ((fun x => exp (f x)) =O[l] fun x => exp (g x)) ↔ IsBoundedUnder (· ≤ ·) l (f - g) :=
  Iff.trans (isO_iff_isBoundedUnder_le_div <| eventually_of_forall fun x => exp_ne_zero _) <| by
    simp only [norm_eq_abs, abs_exp, ← exp_sub, is_bounded_under_le_exp_comp, Pi.sub_def]
#align real.is_O_exp_comp_exp_comp Real.isO_exp_comp_exp_comp

@[simp]
theorem isTheta_exp_comp_exp_comp {f g : α → ℝ} :
    ((fun x => exp (f x)) =Θ[l] fun x => exp (g x)) ↔
      IsBoundedUnder (· ≤ ·) l fun x => |f x - g x| :=
  by
  simp only [is_bounded_under_le_abs, ← is_bounded_under_le_neg, neg_sub, is_Theta,
    is_O_exp_comp_exp_comp, Pi.sub_def]
#align real.is_Theta_exp_comp_exp_comp Real.isTheta_exp_comp_exp_comp

@[simp]
theorem isOCat_exp_comp_exp_comp {f g : α → ℝ} :
    ((fun x => exp (f x)) =o[l] fun x => exp (g x)) ↔ Tendsto (fun x => g x - f x) l atTop := by
  simp only [is_o_iff_tendsto, exp_ne_zero, ← exp_sub, ← tendsto_neg_at_top_iff, false_imp_iff,
    imp_true_iff, tendsto_exp_comp_nhds_zero, neg_sub]
#align real.is_o_exp_comp_exp_comp Real.isOCat_exp_comp_exp_comp

@[simp]
theorem isOCat_one_exp_comp {f : α → ℝ} :
    ((fun x => 1 : α → ℝ) =o[l] fun x => exp (f x)) ↔ Tendsto f l atTop := by
  simp only [← exp_zero, is_o_exp_comp_exp_comp, sub_zero]
#align real.is_o_one_exp_comp Real.isOCat_one_exp_comp

/-- `real.exp (f x)` is bounded away from zero along a filter if and only if this filter is bounded
from below under `f`. -/
@[simp]
theorem isO_one_exp_comp {f : α → ℝ} :
    ((fun x => 1 : α → ℝ) =O[l] fun x => exp (f x)) ↔ IsBoundedUnder (· ≥ ·) l f := by
  simp only [← exp_zero, is_O_exp_comp_exp_comp, Pi.sub_def, zero_sub, is_bounded_under_le_neg]
#align real.is_O_one_exp_comp Real.isO_one_exp_comp

/-- `real.exp (f x)` is bounded away from zero along a filter if and only if this filter is bounded
from below under `f`. -/
theorem isO_exp_comp_one {f : α → ℝ} :
    (fun x => exp (f x)) =O[l] (fun x => 1 : α → ℝ) ↔ IsBoundedUnder (· ≤ ·) l f := by
  simp only [is_O_one_iff, norm_eq_abs, abs_exp, is_bounded_under_le_exp_comp]
#align real.is_O_exp_comp_one Real.isO_exp_comp_one

/-- `real.exp (f x)` is bounded away from zero and infinity along a filter `l` if and only if
`|f x|` is bounded from above along this filter. -/
@[simp]
theorem isTheta_exp_comp_one {f : α → ℝ} :
    (fun x => exp (f x)) =Θ[l] (fun x => 1 : α → ℝ) ↔ IsBoundedUnder (· ≤ ·) l fun x => |f x| := by
  simp only [← exp_zero, is_Theta_exp_comp_exp_comp, sub_zero]
#align real.is_Theta_exp_comp_one Real.isTheta_exp_comp_one

end Real

namespace Complex

theorem comap_exp_comap_abs_atTop : comap exp (comap abs atTop) = comap re atTop :=
  calc
    comap exp (comap abs atTop) = comap re (comap Real.exp atTop) := by
      simp only [comap_comap, (· ∘ ·), abs_exp]
    _ = comap re atTop := by rw [Real.comap_exp_atTop]

#align complex.comap_exp_comap_abs_at_top Complex.comap_exp_comap_abs_atTop

theorem comap_exp_nhds_zero : comap exp (𝓝 0) = comap re atBot :=
  calc
    comap exp (𝓝 0) = comap re (comap Real.exp (𝓝 0)) := by
      simp only [comap_comap, ← comap_abs_nhds_zero, (· ∘ ·), abs_exp]
    _ = comap re atBot := by rw [Real.comap_exp_nhds_zero]

#align complex.comap_exp_nhds_zero Complex.comap_exp_nhds_zero

theorem comap_exp_nhdsWithin_zero : comap exp (𝓝[≠] 0) = comap re atBot :=
  by
  have : exp ⁻¹' {0}ᶜ = univ := eq_univ_of_forall exp_ne_zero
  simp [nhdsWithin, comap_exp_nhds_zero, this]
#align complex.comap_exp_nhds_within_zero Complex.comap_exp_nhdsWithin_zero

theorem tendsto_exp_nhds_zero_iff {α : Type _} {l : Filter α} {f : α → ℂ} :
    Tendsto (fun x => exp (f x)) l (𝓝 0) ↔ Tendsto (fun x => re (f x)) l atBot := by
  rw [← tendsto_comap_iff, comap_exp_nhds_zero, tendsto_comap_iff]
#align complex.tendsto_exp_nhds_zero_iff Complex.tendsto_exp_nhds_zero_iff

/-- `complex.abs (complex.exp z) → ∞` as `complex.re z → ∞`. TODO: use `bornology.cobounded`. -/
theorem tendsto_exp_comap_re_atTop : Tendsto exp (comap re atTop) (comap abs atTop) :=
  comap_exp_comap_abs_atTop ▸ tendsto_comap
#align complex.tendsto_exp_comap_re_at_top Complex.tendsto_exp_comap_re_atTop

/-- `complex.exp z → 0` as `complex.re z → -∞`.-/
theorem tendsto_exp_comap_re_atBot : Tendsto exp (comap re atBot) (𝓝 0) :=
  comap_exp_nhds_zero ▸ tendsto_comap
#align complex.tendsto_exp_comap_re_at_bot Complex.tendsto_exp_comap_re_atBot

theorem tendsto_exp_comap_re_atBot_nhdsWithin : Tendsto exp (comap re atBot) (𝓝[≠] 0) :=
  comap_exp_nhdsWithin_zero ▸ tendsto_comap
#align complex.tendsto_exp_comap_re_at_bot_nhds_within Complex.tendsto_exp_comap_re_atBot_nhdsWithin

end Complex


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

! This file was ported from Lean 3 source module logic.equiv.list
! leanprover-community/mathlib commit d11893b411025250c8e61ff2f12ccbd7ee35ab15
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Sort
import Mathlib.Data.Vector.Basic
import Mathlib.Logic.Denumerable

/-!
# Equivalences involving `List`-like types

This file defines some additional constructive equivalences using `Encodable` and the pairing
function on `ℕ`.
-/

open Nat List

namespace Encodable

variable {α : Type _}

section List

variable [Encodable α]

/-- Explicit encoding function for `List α` -/
def encodeList : List α → ℕ
  | [] => 0
  | a :: l => succ (pair (encode a) (encodeList l))
#align encodable.encode_list Encodable.encodeList

/-- Explicit decoding function for `List α` -/
def decodeList : ℕ → Option (List α)
  | 0 => some []
  | succ v =>
    match unpair v, unpair_right_le v with
    | (v₁, v₂), h =>
      have : v₂ < succ v := lt_succ_of_le h
      (· :: ·) <$> decode (α := α) v₁ <*> decodeList v₂
#align encodable.decode_list Encodable.decodeList

/-- If `α` is encodable, then so is `List α`. This uses the `pair` and `unpair` functions from
`Data.Nat.Pairing`. -/
instance _root_.List.encodable : Encodable (List α) :=
  ⟨encodeList, decodeList, fun l => by
    induction' l with a l IH <;> simp [encodeList, decodeList, unpair_pair, encodek, *]⟩
#align list.encodable List.encodable

instance _root_.List.countable {α : Type _} [Countable α] : Countable (List α) := by
  haveI := Encodable.ofCountable α
  infer_instance
#align list.countable List.countable

@[simp]
theorem encode_list_nil : encode (@nil α) = 0 :=
  rfl
#align encodable.encode_list_nil Encodable.encode_list_nil

@[simp]
theorem encode_list_cons (a : α) (l : List α) :
    encode (a :: l) = succ (pair (encode a) (encode l)) :=
  rfl
#align encodable.encode_list_cons Encodable.encode_list_cons

@[simp]
theorem decode_list_zero : decode (α := List α) 0 = some [] :=
  show decodeList 0 = some [] by rw [decodeList]
#align encodable.decode_list_zero Encodable.decode_list_zero

@[simp, nolint unusedHavesSuffices] -- Porting note: false positive
theorem decode_list_succ (v : ℕ) :
    decode (α := List α) (succ v) =
      (· :: ·) <$> decode (α := α) v.unpair.1 <*> decode (α := List α) v.unpair.2 :=
  show decodeList (succ v) = _ by
    cases' e : unpair v with v₁ v₂
    simp [decodeList, e]; rfl
#align encodable.decode_list_succ Encodable.decode_list_succ

theorem length_le_encode : ∀ l : List α, length l ≤ encode l
  | [] => Nat.zero_le _
  | _ :: l => succ_le_succ <| (length_le_encode l).trans (right_le_pair _ _)
#align encodable.length_le_encode Encodable.length_le_encode

end List

section Finset

variable [Encodable α]

private def enle : α → α → Prop :=
  encode ⁻¹'o (· ≤ ·)

private theorem enle.isLinearOrder : IsLinearOrder α enle :=
  (RelEmbedding.preimage ⟨encode, encode_injective⟩ (· ≤ ·)).isLinearOrder

private def decidable_enle (a b : α) : Decidable (enle a b) := by
  unfold enle Order.Preimage
  infer_instance

attribute [local instance] enle.isLinearOrder decidable_enle

/-- Explicit encoding function for `Multiset α` -/
def encodeMultiset (s : Multiset α) : ℕ :=
  encode (s.sort enle)
#align encodable.encode_multiset Encodable.encodeMultiset

/-- Explicit decoding function for `Multiset α` -/
def decodeMultiset (n : ℕ) : Option (Multiset α) :=
  ((↑) : List α →  Multiset α) <$> decode (α := List α) n
#align encodable.decode_multiset Encodable.decodeMultiset

/-- If `α` is encodable, then so is `Multiset α`. -/
instance _root_.Multiset.encodable : Encodable (Multiset α) :=
  ⟨encodeMultiset, decodeMultiset, fun s => by simp [encodeMultiset, decodeMultiset, encodek]⟩
#align multiset.encodable Multiset.encodable

/-- If `α` is countable, then so is `Multiset α`. -/
instance _root_.Multiset.countable {α : Type _} [Countable α] : Countable (Multiset α) :=
  Quotient.countable
#align multiset.countable Multiset.countable

end Finset

/-- A listable type with decidable equality is encodable. -/
def encodableOfList [DecidableEq α] (l : List α) (H : ∀ x, x ∈ l) : Encodable α :=
  ⟨fun a => indexOf a l, l.get?, fun _ => indexOf_get? (H _)⟩
#align encodable.encodable_of_list Encodable.encodableOfList

/-- A finite type is encodable. Because the encoding is not unique, we wrap it in `Trunc` to
preserve computability. -/
def _root_.Fintype.truncEncodable (α : Type _) [DecidableEq α] [Fintype α] : Trunc (Encodable α) :=
  @Quot.recOnSubsingleton' _ _ (fun s : Multiset α => (∀ x : α, x ∈ s) → Trunc (Encodable α)) _
    Finset.univ.1 (fun l H => Trunc.mk <| encodableOfList l H) Finset.mem_univ
#align fintype.trunc_encodable Fintype.truncEncodable

/-- A noncomputable way to arbitrarily choose an ordering on a finite type.
It is not made into a global instance, since it involves an arbitrary choice.
This can be locally made into an instance with `local attribute [instance] Fintype.toEncodable`. -/
noncomputable def _root_.Fintype.toEncodable (α : Type _) [Fintype α] : Encodable α := by
  classical exact (Fintype.truncEncodable α).out
#align fintype.to_encodable Fintype.toEncodable

/-- If `α` is encodable, then so is `Vector α n`. -/
instance _root_.Vector.encodable [Encodable α] {n} : Encodable (Vector α n) :=
  Encodable.Subtype.encodable
#align vector.encodable Vector.encodable

/-- If `α` is countable, then so is `Vector α n`. -/
instance _root_.Vector.countable [Countable α] {n} : Countable (Vector α n) :=
  Subtype.countable
#align vector.countable Vector.countable

/-- If `α` is encodable, then so is `Fin n → α`. -/
instance finArrow [Encodable α] {n} : Encodable (Fin n → α) :=
  ofEquiv _ (Equiv.vectorEquivFin _ _).symm
#align encodable.fin_arrow Encodable.finArrow

instance finPi (n) (π : Fin n → Type _) [∀ i, Encodable (π i)] : Encodable (∀ i, π i) :=
  ofEquiv _ (Equiv.piEquivSubtypeSigma (Fin n) π)
#align encodable.fin_pi Encodable.finPi

/-- If `α` is encodable, then so is `Finset α`. -/
instance _root_.Finset.encodable [Encodable α] : Encodable (Finset α) :=
  haveI := decidableEqOfEncodable α
  ofEquiv { s : Multiset α // s.Nodup }
    ⟨fun ⟨a, b⟩ => ⟨a, b⟩, fun ⟨a, b⟩ => ⟨a, b⟩, fun ⟨_, _⟩ => rfl, fun ⟨_, _⟩ => rfl⟩
#align finset.encodable Finset.encodable

/-- If `α` is countable, then so is `Finset α`. -/
instance _root_.Finset.countable [Countable α] : Countable (Finset α) :=
  Finset.val_injective.countable
#align finset.countable Finset.countable

-- TODO: Unify with `fintypePi` and find a better name
/-- When `α` is finite and `β` is encodable, `α → β` is encodable too. Because the encoding is not
unique, we wrap it in `Trunc` to preserve computability. -/
def fintypeArrow (α : Type _) (β : Type _) [DecidableEq α] [Fintype α] [Encodable β] :
    Trunc (Encodable (α → β)) :=
  (Fintype.truncEquivFin α).map fun f =>
    Encodable.ofEquiv (Fin (Fintype.card α) → β) <| Equiv.arrowCongr f (Equiv.refl _)
#align encodable.fintype_arrow Encodable.fintypeArrow

/-- When `α` is finite and all `π a` are encodable, `Π a, π a` is encodable too. Because the
encoding is not unique, we wrap it in `Trunc` to preserve computability. -/
def fintypePi (α : Type _) (π : α → Type _) [DecidableEq α] [Fintype α] [∀ a, Encodable (π a)] :
    Trunc (Encodable (∀ a, π a)) :=
  (Fintype.truncEncodable α).bind fun a =>
    (@fintypeArrow α (Σa, π a) _ _ (@Encodable.Sigma.encodable _ _ a _)).bind fun f =>
      Trunc.mk <|
        @Encodable.ofEquiv _ _ (@Encodable.Subtype.encodable _ _ f _)
          (Equiv.piEquivSubtypeSigma α π)
#align encodable.fintype_pi Encodable.fintypePi

/-- The elements of a `Fintype` as a sorted list. -/
def sortedUniv (α) [Fintype α] [Encodable α] : List α :=
  Finset.univ.sort (Encodable.encode' α ⁻¹'o (· ≤ ·))
#align encodable.sorted_univ Encodable.sortedUniv

@[simp]
theorem mem_sortedUniv {α} [Fintype α] [Encodable α] (x : α) : x ∈ sortedUniv α :=
  (Finset.mem_sort _).2 (Finset.mem_univ _)
#align encodable.mem_sorted_univ Encodable.mem_sortedUniv

@[simp]
theorem length_sortedUniv (α) [Fintype α] [Encodable α] : (sortedUniv α).length = Fintype.card α :=
  Finset.length_sort _
#align encodable.length_sorted_univ Encodable.length_sortedUniv

@[simp]
theorem sortedUniv_nodup (α) [Fintype α] [Encodable α] : (sortedUniv α).Nodup :=
  Finset.sort_nodup _ _
#align encodable.sorted_univ_nodup Encodable.sortedUniv_nodup

@[simp]
theorem sortedUniv_toFinset (α) [Fintype α] [Encodable α] [DecidableEq α] :
    (sortedUniv α).toFinset = Finset.univ :=
  Finset.sort_toFinset _ _
#align encodable.sorted_univ_to_finset Encodable.sortedUniv_toFinset

/-- An encodable `Fintype` is equivalent to the same size `fin`. -/
def fintypeEquivFin {α} [Fintype α] [Encodable α] : α ≃ Fin (Fintype.card α) :=
  haveI : DecidableEq α := Encodable.decidableEqOfEncodable _
  -- Porting note: used the `trans` tactic
  ((sortedUniv_nodup α).getEquivOfForallMemList _ mem_sortedUniv).symm.trans <|
    Equiv.cast (congr_arg _ (length_sortedUniv α))
#align encodable.fintype_equiv_fin Encodable.fintypeEquivFin

/-- If `α` and `β` are encodable and `α` is a fintype, then `α → β` is encodable as well. -/
instance fintypeArrowOfEncodable {α β : Type _} [Encodable α] [Fintype α] [Encodable β] :
    Encodable (α → β) :=
  ofEquiv (Fin (Fintype.card α) → β) <| Equiv.arrowCongr fintypeEquivFin (Equiv.refl _)
#align encodable.fintype_arrow_of_encodable Encodable.fintypeArrowOfEncodable

end Encodable

namespace Denumerable

variable {α : Type _} {β : Type _} [Denumerable α] [Denumerable β]

open Encodable

section List

@[nolint unusedHavesSuffices] -- Porting note: false positive
theorem denumerable_list_aux : ∀ n : ℕ, ∃ a ∈ @decodeList α _ n, encodeList a = n
  | 0 => by rw [decodeList]; exact ⟨_, rfl, rfl⟩
  | succ v => by
    cases' e : unpair v with v₁ v₂
    have h := unpair_right_le v
    rw [e] at h
    rcases have : v₂ < succ v := lt_succ_of_le h
      denumerable_list_aux v₂ with
      ⟨a, h₁, h₂⟩
    rw [Option.mem_def] at h₁
    use ofNat α v₁ :: a
    simp [decodeList, e, h₂, h₁, encodeList, pair_unpair' e]
#align denumerable.denumerable_list_aux Denumerable.denumerable_list_aux

/-- If `α` is denumerable, then so is `List α`. -/
instance denumerableList : Denumerable (List α) :=
  ⟨denumerable_list_aux⟩
#align denumerable.denumerable_list Denumerable.denumerableList

@[simp]
theorem list_ofNat_zero : ofNat (List α) 0 = [] := by rw [← @encode_list_nil α, ofNat_encode]
#align denumerable.list_of_nat_zero Denumerable.list_ofNat_zero

@[simp, nolint unusedHavesSuffices] -- Porting note: false positive
theorem list_ofNat_succ (v : ℕ) :
    ofNat (List α) (succ v) = ofNat α v.unpair.1 :: ofNat (List α) v.unpair.2 :=
  ofNat_of_decode <|
    show decodeList (succ v) = _ by
      cases' e : unpair v with v₁ v₂
      simp [decodeList, e]
      rw [show decodeList v₂ = decode (α := List α) v₂ from rfl, decode_eq_ofNat, Option.seq_some,
        Option.some.injEq]
#align denumerable.list_of_nat_succ Denumerable.list_ofNat_succ

end List

section Multiset

/-- Outputs the list of differences of the input list, that is
`lower [a₁, a₂, ...] n = [a₁ - n, a₂ - a₁, ...]` -/
def lower : List ℕ → ℕ → List ℕ
  | [], _ => []
  | m :: l, n => (m - n) :: lower l m
#align denumerable.lower Denumerable.lower

/-- Outputs the list of partial sums of the input list, that is
`raise [a₁, a₂, ...] n = [n + a₁, n + a₁ + a₂, ...]` -/
def raise : List ℕ → ℕ → List ℕ
  | [], _ => []
  | m :: l, n => (m + n) :: raise l (m + n)
#align denumerable.raise Denumerable.raise

theorem lower_raise : ∀ l n, lower (raise l n) n = l
  | [], n => rfl
  | m :: l, n => by rw [raise, lower, add_tsub_cancel_right, lower_raise l]
#align denumerable.lower_raise Denumerable.lower_raise

theorem raise_lower : ∀ {l n}, List.Sorted (· ≤ ·) (n :: l) → raise (lower l n) n = l
  | [], n, _ => rfl
  | m :: l, n, h =>
    by
    have : n ≤ m := List.rel_of_sorted_cons h _ (l.mem_cons_self _)
    simp [raise, lower, tsub_add_cancel_of_le this, raise_lower h.of_cons]
#align denumerable.raise_lower Denumerable.raise_lower

theorem raise_chain : ∀ l n, List.Chain (· ≤ ·) n (raise l n)
  | [], _ => List.Chain.nil
  | _ :: _, _ => List.Chain.cons (Nat.le_add_left _ _) (raise_chain _ _)
#align denumerable.raise_chain Denumerable.raise_chain

/-- `raise l n` is an non-decreasing sequence. -/
theorem raise_sorted : ∀ l n, List.Sorted (· ≤ ·) (raise l n)
  | [], _ => List.sorted_nil
  | _ :: _, _ => List.chain_iff_pairwise.1 (raise_chain _ _)
#align denumerable.raise_sorted Denumerable.raise_sorted

/-- If `α` is denumerable, then so is `Multiset α`. Warning: this is *not* the same encoding as used
in `Multiset.encodable`. -/
instance multiset : Denumerable (Multiset α) :=
  mk'
    ⟨fun s : Multiset α => encode <| lower ((s.map encode).sort (· ≤ ·)) 0,
     fun n =>
      Multiset.map (ofNat α) (raise (ofNat (List ℕ) n) 0),
     fun s => by
      have :=
        raise_lower (List.sorted_cons.2 ⟨fun n _ => Nat.zero_le n, (s.map encode).sort_sorted _⟩)
      simp [-Multiset.coe_map, this],
     fun n => by
      simp [-Multiset.coe_map, List.mergeSort_eq_self _ (raise_sorted _ _), lower_raise]⟩
#align denumerable.multiset Denumerable.multiset

end Multiset

section Finset

/-- Outputs the list of differences minus one of the input list, that is
`lower' [a₁, a₂, a₃, ...] n = [a₁ - n, a₂ - a₁ - 1, a₃ - a₂ - 1, ...]`. -/
def lower' : List ℕ → ℕ → List ℕ
  | [], _ => []
  | m :: l, n => (m - n) :: lower' l (m + 1)
#align denumerable.lower' Denumerable.lower'

/-- Outputs the list of partial sums plus one of the input list, that is
`raise [a₁, a₂, a₃, ...] n = [n + a₁, n + a₁ + a₂ + 1, n + a₁ + a₂ + a₃ + 2, ...]`. Adding one each
time ensures the elements are distinct. -/
def raise' : List ℕ → ℕ → List ℕ
  | [], _ => []
  | m :: l, n => (m + n) :: raise' l (m + n + 1)
#align denumerable.raise' Denumerable.raise'

theorem lower_raise' : ∀ l n, lower' (raise' l n) n = l
  | [], n => rfl
  | m :: l, n => by simp [raise', lower', add_tsub_cancel_right, lower_raise']
#align denumerable.lower_raise' Denumerable.lower_raise'

theorem raise_lower' : ∀ {l n}, (∀ m ∈ l, n ≤ m) → List.Sorted (· < ·) l → raise' (lower' l n) n = l
  | [], n, _, _ => rfl
  | m :: l, n, h₁, h₂ => by
    have : n ≤ m := h₁ _ (l.mem_cons_self _)
    simp [raise', lower', tsub_add_cancel_of_le this,
      raise_lower' (List.rel_of_sorted_cons h₂ : ∀ a ∈ l, m < a) h₂.of_cons]
#align denumerable.raise_lower' Denumerable.raise_lower'

/-- `raise' l n` is a strictly increasing sequence. -/
theorem raise'_sorted : ∀ l n, List.Sorted (· < ·) (raise' l n)
  | [], _ => List.sorted_nil
  | _ :: _, _ => List.chain_iff_pairwise.1 (raise'_chain _ (lt_succ_self _))
#align denumerable.raise'_sorted Denumerable.raise'_sorted

/-- Makes `raise' l n` into a finset. Elements are distinct thanks to `raise'_sorted`. -/
def raise'Finset (l : List ℕ) (n : ℕ) : Finset ℕ :=
  ⟨raise' l n, (raise'_sorted _ _).imp (@ne_of_lt _ _)⟩
#align denumerable.raise'_finset Denumerable.raise'Finset

/-- If `α` is denumerable, then so is `finset α`. Warning: this is *not* the same encoding as used
in `finset.encodable`. -/
instance finset : Denumerable (Finset α) :=
  mk'
    ⟨fun s : Finset α => encode <| lower' ((s.map (eqv α).toEmbedding).sort (· ≤ ·)) 0, fun n =>
      Finset.map (eqv α).symm.toEmbedding (raise'Finset (ofNat (List ℕ) n) 0), fun s =>
      Finset.eq_of_veq <| by
        simp [-Multiset.coe_map, raise'Finset,
          raise_lower' (fun n _ => Nat.zero_le n) (Finset.sort_sorted_lt _)],
      fun n => by
      simp [-Multiset.coe_map, Finset.map, raise'Finset, Finset.sort,
        List.mergeSort_eq_self (· ≤ ·) ((raise'_sorted _ _).imp (@le_of_lt _ _)), lower_raise']⟩
#align denumerable.finset Denumerable.finset

end Finset

end Denumerable

namespace Equiv

/-- The type lists on unit is canonically equivalent to the natural numbers. -/
def listUnitEquiv : List Unit ≃ ℕ where
  toFun := List.length
  invFun n := List.replicate n ()
  left_inv u := List.length_injective (by simp)
  right_inv n := List.length_replicate n ()
#align equiv.list_unit_equiv Equiv.listUnitEquiv

/-- `List ℕ` is equivalent to `ℕ`. -/
def listNatEquivNat : List ℕ ≃ ℕ :=
  Denumerable.eqv _
#align equiv.list_nat_equiv_nat Equiv.listNatEquivNat

/-- If `α` is equivalent to `ℕ`, then `List α` is equivalent to `α`. -/
def listEquivSelfOfEquivNat {α : Type _} (e : α ≃ ℕ) : List α ≃ α :=
  calc
    List α ≃ List ℕ := listEquivOfEquiv e
    _ ≃ ℕ := listNatEquivNat
    _ ≃ α := e.symm

#align equiv.list_equiv_self_of_equiv_nat Equiv.listEquivSelfOfEquivNat

end Equiv