/-
Copyright (c) 2021 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.set.pointwise
import order.antichain
import order.order_iso_nat
import order.well_founded

/-!
# Well-founded sets

A well-founded subset of an ordered type is one on which the relation `<` is well-founded.

## Main Definitions
 * `set.well_founded_on s r` indicates that the relation `r` is
  well-founded when restricted to the set `s`.
 * `set.is_wf s` indicates that `<` is well-founded when restricted to `s`.
 * `set.partially_well_ordered_on s r` indicates that the relation `r` is
  partially well-ordered (also known as well quasi-ordered) when restricted to the set `s`.
 * `set.is_pwo s` indicates that any infinite sequence of elements in `s`
  contains an infinite monotone subsequence. Note that

### Definitions for Hahn Series
 * `set.add_antidiagonal s t a` and `set.mul_antidiagonal s t a` are the sets of pairs of elements
  from `s` and `t` that add/multiply to `a`.
 * `finset.add_antidiagonal` and `finset.mul_antidiagonal` are finite versions of
  `set.add_antidiagonal` and `set.mul_antidiagonal` defined when `s` and `t` are well-founded.

## Main Results
 * Higman's Lemma, `set.partially_well_ordered_on.partially_well_ordered_on_sublist_forall₂`,
  shows that if `r` is partially well-ordered on `s`, then `list.sublist_forall₂` is partially
  well-ordered on the set of lists of elements of `s`. The result was originally published by
  Higman, but this proof more closely follows Nash-Williams.
 * `set.well_founded_on_iff` relates `well_founded_on` to the well-foundedness of a relation on the
 original type, to avoid dealing with subtypes.
 * `set.is_wf.mono` shows that a subset of a well-founded subset is well-founded.
 * `set.is_wf.union` shows that the union of two well-founded subsets is well-founded.
 * `finset.is_wf` shows that all `finset`s are well-founded.

## TODO

Prove that `s` is partial well ordered iff it has no infinite descending chain or antichain.

## References
 * [Higman, *Ordering by Divisibility in Abstract Algebras*][Higman52]
 * [Nash-Williams, *On Well-Quasi-Ordering Finite Trees*][Nash-Williams63]
-/

open_locale pointwise

variables {α : Type*}

namespace set

/-- `s.well_founded_on r` indicates that the relation `r` is well-founded when restricted to `s`. -/
def well_founded_on (s : set α) (r : α → α → Prop) : Prop :=
well_founded (λ (a : s) (b : s), r a b)

lemma well_founded_on_iff {s : set α} {r : α → α → Prop} :
  s.well_founded_on r ↔ well_founded (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
begin
  have f : rel_embedding (λ (a : s) (b : s), r a b) (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
    ⟨⟨coe, subtype.coe_injective⟩, λ a b, by simp⟩,
  refine ⟨λ h, _, f.well_founded⟩,
  rw well_founded.well_founded_iff_has_min,
  intros t ht,
  by_cases hst : (s ∩ t).nonempty,
  { rw ← subtype.preimage_coe_nonempty at hst,
    rcases well_founded.well_founded_iff_has_min.1 h (coe ⁻¹' t) hst with ⟨⟨m, ms⟩, mt, hm⟩,
    exact ⟨m, mt, λ x xt ⟨xm, xs, ms⟩, hm ⟨x, xs⟩ xt xm⟩ },
  { rcases ht with ⟨m, mt⟩,
    exact ⟨m, mt, λ x xt ⟨xm, xs, ms⟩, hst ⟨m, ⟨ms, mt⟩⟩⟩ }
end

lemma well_founded_on.induction {s : set α} {r : α → α → Prop} (hs : s.well_founded_on r) {x : α}
  (hx : x ∈ s) {P : α → Prop} (hP : ∀ (y ∈ s), (∀ (z ∈ s), r z y → P z) → P y) :
  P x :=
begin
  let Q : s → Prop := λ y, P y,
  change Q ⟨x, hx⟩,
  refine well_founded.induction hs ⟨x, hx⟩ _,
  rintros ⟨y, ys⟩ ih,
  exact hP _ ys (λ z zs zy, ih ⟨z, zs⟩ zy),
end

instance is_strict_order.subset {s : set α} {r : α → α → Prop} [is_strict_order α r] :
  is_strict_order α (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
{ to_is_irrefl := ⟨λ a con, irrefl_of r a con.1 ⟩,
  to_is_trans := ⟨λ a b c ab bc, ⟨trans_of r ab.1 bc.1, ab.2.1, bc.2.2⟩ ⟩ }

theorem well_founded_on_iff_no_descending_seq {s : set α} {r : α → α → Prop} [is_strict_order α r] :
  s.well_founded_on r ↔ ∀ (f : ((>) : ℕ → ℕ → Prop) ↪r r), ¬ (range f) ⊆ s :=
begin
  rw [well_founded_on_iff, rel_embedding.well_founded_iff_no_descending_seq],
  refine ⟨λ h f con, begin
      refine h.elim' ⟨⟨f, f.injective⟩, λ a b, _⟩,
       simp only [con (mem_range_self a), con (mem_range_self b), and_true, gt_iff_lt,
        function.embedding.coe_fn_mk, f.map_rel_iff]
    end, λ h, ⟨λ con, _⟩⟩,
  rcases con with ⟨f, hf⟩,
  have hfs' : ∀ n : ℕ, f n ∈ s := λ n, (hf.2 n.lt_succ_self).2.2,
  refine h ⟨f, λ a b, _⟩ (λ n hn, _),
  { rw ← hf,
    exact ⟨λ h, ⟨h, hfs' _, hfs' _⟩, λ h, h.1⟩ },
  { rcases set.mem_range.1 hn with ⟨m, hm⟩,
    rw ← hm,
    apply hfs' }
end

section has_lt
variables [has_lt α]

/-- `s.is_wf` indicates that `<` is well-founded when restricted to `s`. -/
def is_wf (s : set α) : Prop := well_founded_on s (<)

lemma is_wf_univ_iff : is_wf (univ : set α) ↔ well_founded ((<) : α → α → Prop) :=
by simp [is_wf, well_founded_on_iff]

variables {s t : set α}

theorem is_wf.mono (h : is_wf t) (st : s ⊆ t) : is_wf s :=
begin
  rw [is_wf, well_founded_on_iff] at *,
  refine subrelation.wf (λ x y xy, _) h,
  exact ⟨xy.1, st xy.2.1, st xy.2.2⟩,
end
end has_lt

section partial_order
variables [partial_order α] {s t : set α} {a : α}

theorem is_wf_iff_no_descending_seq :
  is_wf s ↔ ∀ (f : (order_dual ℕ) ↪o α), ¬ (range f) ⊆ s :=
begin
  haveI : is_strict_order α (λ (a b : α), a < b ∧ a ∈ s ∧ b ∈ s) :=
  { to_is_irrefl := ⟨λ x con, lt_irrefl x con.1⟩,
    to_is_trans := ⟨λ a b c ab bc, ⟨lt_trans ab.1 bc.1, ab.2.1, bc.2.2⟩⟩, },
  rw [is_wf, well_founded_on_iff_no_descending_seq],
  exact ⟨λ h f, h f.lt_embedding, λ h f, h (order_embedding.of_strict_mono
    f (λ _ _, f.map_rel_iff.2))⟩,
end

theorem is_wf.union (hs : is_wf s) (ht : is_wf t) : is_wf (s ∪ t) :=
begin
  classical,
  rw [is_wf_iff_no_descending_seq] at *,
  rintros f fst,
  have h : infinite (f ⁻¹' s) ∨ infinite (f ⁻¹' t),
  { have h : infinite (univ : set ℕ) := infinite_univ,
    have hpre : f ⁻¹' (s ∪ t) = set.univ,
    { rw [← image_univ, image_subset_iff, univ_subset_iff] at fst,
      exact fst },
    rw preimage_union at hpre,
    rw ← hpre at h,
    rw [infinite, infinite],
    rw infinite at h,
    contrapose! h,
    exact finite.union h.1 h.2, },
  rw [← infinite_coe_iff, ← infinite_coe_iff] at h,
  cases h with inf inf; haveI := inf,
  { apply hs ((nat.order_embedding_of_set (f ⁻¹' s)).dual.trans f),
    change range (function.comp f (nat.order_embedding_of_set (f ⁻¹' s))) ⊆ s,
    rw [range_comp, image_subset_iff],
      simp },
  { apply ht ((nat.order_embedding_of_set (f ⁻¹' t)).dual.trans f),
    change range (function.comp f (nat.order_embedding_of_set (f ⁻¹' t))) ⊆ t,
    rw [range_comp, image_subset_iff],
      simp }
end
end partial_order

end set

namespace set

/-- A subset is partially well-ordered by a relation `r` when any infinite sequence contains
  two elements where the first is related to the second by `r`. -/
def partially_well_ordered_on (s) (r : α → α → Prop) : Prop :=
  ∀ (f : ℕ → α), range f ⊆ s → ∃ (m n : ℕ), m < n ∧ r (f m) (f n)

/-- A subset of a preorder is partially well-ordered when any infinite sequence contains
  a monotone subsequence of length 2 (or equivalently, an infinite monotone subsequence). -/
def is_pwo [preorder α] (s) : Prop :=
partially_well_ordered_on s ((≤) : α → α → Prop)

theorem partially_well_ordered_on.mono {s t : set α} {r : α → α → Prop}
  (ht : t.partially_well_ordered_on r) (hsub : s ⊆ t) :
  s.partially_well_ordered_on r :=
λ f hf, ht f (set.subset.trans hf hsub)

theorem is_pwo.mono [preorder α] {s t : set α}
  (ht : t.is_pwo) (hsub : s ⊆ t) :
  s.is_pwo :=
partially_well_ordered_on.mono ht hsub

theorem partially_well_ordered_on.image_of_monotone_on {s : set α}
  {r : α → α → Prop} {β : Type*} {r' : β → β → Prop}
  (hs : s.partially_well_ordered_on r) {f : α → β}
  (hf : ∀ a1 a2 : α, a1 ∈ s → a2 ∈ s → r a1 a2 → r' (f a1) (f a2)) :
  (f '' s).partially_well_ordered_on r' :=
λ g hg, begin
  have h := λ (n : ℕ), ((mem_image _ _ _).1 (hg (mem_range_self n))),
  obtain ⟨m, n, hlt, hmn⟩ := hs (λ n, classical.some (h n)) _,
  { refine ⟨m, n, hlt, _⟩,
    rw [← (classical.some_spec (h m)).2,
      ← (classical.some_spec (h n)).2],
    exact hf _ _ (classical.some_spec (h m)).1 (classical.some_spec (h n)).1 hmn },
  { rintros _ ⟨n, rfl⟩,
    exact (classical.some_spec (h n)).1 }
end

lemma _root_.is_antichain.finite_of_partially_well_ordered_on {s : set α} {r : α → α → Prop}
  (ha : is_antichain r s) (hp : s.partially_well_ordered_on r) :
  s.finite :=
begin
  refine finite_or_infinite.resolve_right (λ hi, _),
  obtain ⟨m, n, hmn, h⟩ := hp (λ n, hi.nat_embedding _ n) (range_subset_iff.2 $
    λ n, (hi.nat_embedding _ n).2),
  exact hmn.ne ((hi.nat_embedding _).injective $ subtype.val_injective $
    ha.eq (hi.nat_embedding _ m).2 (hi.nat_embedding _ n).2 h),
end

lemma finite.partially_well_ordered_on {s : set α} {r : α → α → Prop} [is_refl α r]
  (hs : s.finite) :
  s.partially_well_ordered_on r :=
begin
  intros f hf,
  obtain ⟨m, n, hmn, h⟩ := hs.exists_lt_map_eq_of_range_subset hf,
  exact ⟨m, n, hmn, h.subst $ refl (f m)⟩,
end

lemma _root_.is_antichain.partially_well_ordered_on_iff {s : set α} {r : α → α → Prop} [is_refl α r]
  (hs : is_antichain r s) :
  s.partially_well_ordered_on r ↔ s.finite :=
⟨hs.finite_of_partially_well_ordered_on, finite.partially_well_ordered_on⟩

lemma partially_well_ordered_on_iff_finite_antichains {s : set α} {r : α → α → Prop} [is_refl α r]
  [is_symm α r] :
  s.partially_well_ordered_on r ↔ ∀ t ⊆ s, is_antichain r t → t.finite :=
begin
  refine ⟨λ h t ht hrt, hrt.finite_of_partially_well_ordered_on (h.mono ht), _⟩,
  rintro hs f hf,
  by_contra' H,
  refine set.infinite_range_of_injective (λ m n hmn, _) (hs _ hf _),
  { obtain h | h | h := lt_trichotomy m n,
    { refine (H _ _ h _).elim,
      rw hmn,
      exact refl _ },
    { exact h },
    { refine (H _ _ h _).elim,
      rw hmn,
      exact refl _ } },
  rintro _ ⟨m, hm, rfl⟩ _ ⟨n, hn, rfl⟩ hmn,
  obtain h | h  := (ne_of_apply_ne _ hmn).lt_or_lt,
  { exact H _ _ h },
  { exact mt symm (H _ _ h) }
end

section partial_order
variables {s : set α} {t : set α} {r : α → α → Prop}

theorem partially_well_ordered_on.exists_monotone_subseq [is_refl α r] [is_trans α r]
  (h : s.partially_well_ordered_on r) (f : ℕ → α) (hf : range f ⊆ s) :
  ∃ (g : ℕ ↪o ℕ), ∀ m n : ℕ, m ≤ n → r (f (g m)) (f (g n)) :=
begin
  obtain ⟨g, h1 | h2⟩ := exists_increasing_or_nonincreasing_subseq r f,
  { refine ⟨g, λ m n hle, _⟩,
    obtain hlt | heq := lt_or_eq_of_le hle,
    { exact h1 m n hlt, },
    { rw [heq],
      apply refl_of r } },
  { exfalso,
    obtain ⟨m, n, hlt, hle⟩ := h (f ∘ g) (subset.trans (range_comp_subset_range _ _) hf),
    exact h2 m n hlt hle }
end

theorem partially_well_ordered_on_iff_exists_monotone_subseq [is_refl α r] [is_trans α r] :
  s.partially_well_ordered_on r ↔
    ∀ f : ℕ → α, range f ⊆ s → ∃ (g : ℕ ↪o ℕ), ∀ m n : ℕ, m ≤ n → r (f (g m)) (f (g n)) :=
begin
  classical,
  split; intros h f hf,
  { exact h.exists_monotone_subseq f hf },
  { obtain ⟨g, gmon⟩ := h f hf,
    refine ⟨g 0, g 1, g.lt_iff_lt.2 zero_lt_one, gmon _ _ zero_le_one⟩, }
end

lemma partially_well_ordered_on.well_founded_on [is_partial_order α r]
  (h : s.partially_well_ordered_on r) :
  s.well_founded_on (λ a b, r a b ∧ a ≠ b) :=
begin
  haveI : is_strict_order α (λ a b, r a b ∧ a ≠ b) :=
  { to_is_irrefl := ⟨λ a con, con.2 rfl⟩,
    to_is_trans := ⟨λ a b c ab bc, ⟨trans ab.1 bc.1,
      λ ac, ab.2 (antisymm ab.1 (ac.symm ▸ bc.1))⟩⟩ },
  rw well_founded_on_iff_no_descending_seq,
  intros f con,
  obtain ⟨m, n, hlt, hle⟩ := h f con,
  exact (f.map_rel_iff.2 hlt).2 (antisymm hle (f.map_rel_iff.2 hlt).1).symm,
end

variables [partial_order α]

lemma is_pwo.is_wf (h : s.is_pwo) :
  s.is_wf :=
begin
  rw [is_wf],
  convert h.well_founded_on,
  ext x y,
  rw lt_iff_le_and_ne,
end

theorem is_pwo.exists_monotone_subseq
  (h : s.is_pwo) (f : ℕ → α) (hf : range f ⊆ s) :
  ∃ (g : ℕ ↪o ℕ), monotone (f ∘ g) :=
h.exists_monotone_subseq f hf

theorem is_pwo_iff_exists_monotone_subseq :
  s.is_pwo ↔
    ∀ f : ℕ → α, range f ⊆ s → ∃ (g : ℕ ↪o ℕ), monotone (f ∘ g) :=
partially_well_ordered_on_iff_exists_monotone_subseq

lemma is_pwo.prod (hs : s.is_pwo)
  (ht : t.is_pwo) :
  (s ×ˢ t : set _).is_pwo :=
begin
  classical,
  rw is_pwo_iff_exists_monotone_subseq at *,
  intros f hf,
  obtain ⟨g1, h1⟩ := hs (prod.fst ∘ f) _,
  swap,
  { rw [range_comp, image_subset_iff],
    refine subset.trans hf _,
    rintros ⟨x1, x2⟩ hx,
    simp only [mem_preimage, hx.1] },
  obtain ⟨g2, h2⟩ := ht (prod.snd ∘ f ∘ g1) _,
  refine ⟨g2.trans g1, λ m n mn, _⟩,
  swap,
  { rw [range_comp, image_subset_iff],
    refine subset.trans (range_comp_subset_range _ _) (subset.trans hf _),
    rintros ⟨x1, x2⟩ hx,
    simp only [mem_preimage, hx.2] },
  simp only [rel_embedding.coe_trans, function.comp_app],
  exact ⟨h1 (g2.le_iff_le.2 mn), h2 mn⟩,
end

theorem is_pwo.image_of_monotone {β : Type*} [partial_order β]
  (hs : s.is_pwo) {f : α → β} (hf : monotone f) :
  is_pwo (f '' s) :=
hs.image_of_monotone_on (λ _ _ _ _ ab, hf ab)

theorem is_pwo.union (hs : is_pwo s) (ht : is_pwo t) : is_pwo (s ∪ t) :=
begin
  classical,
  rw [is_pwo_iff_exists_monotone_subseq] at *,
  rintros f fst,
  have h : infinite (f ⁻¹' s) ∨ infinite (f ⁻¹' t),
  { have h : infinite (univ : set ℕ) := infinite_univ,
    have hpre : f ⁻¹' (s ∪ t) = set.univ,
    { rw [← image_univ, image_subset_iff, univ_subset_iff] at fst,
      exact fst },
    rw preimage_union at hpre,
    rw ← hpre at h,
    rw [infinite, infinite],
    rw infinite at h,
    contrapose! h,
    exact finite.union h.1 h.2, },
  rw [← infinite_coe_iff, ← infinite_coe_iff] at h,
  cases h with inf inf; haveI := inf,
  { obtain ⟨g, hg⟩ := hs (f ∘ (nat.order_embedding_of_set (f ⁻¹' s))) _,
    { rw [function.comp.assoc, ← rel_embedding.coe_trans] at hg,
      exact ⟨_, hg⟩ },
    rw [range_comp, image_subset_iff],
    simp },
  { obtain ⟨g, hg⟩ := ht (f ∘ (nat.order_embedding_of_set (f ⁻¹' t))) _,
    { rw [function.comp.assoc, ← rel_embedding.coe_trans] at hg,
      exact ⟨_, hg⟩ },
    rw [range_comp, image_subset_iff],
    simp }
end

end partial_order

theorem is_wf.is_pwo [linear_order α] {s : set α}
  (hs : s.is_wf) : s.is_pwo :=
λ f hf, begin
  rw [is_wf, well_founded_on_iff] at hs,
  have hrange : (range f).nonempty := ⟨f 0, mem_range_self 0⟩,
  let a := hs.min (range f) hrange,
  obtain ⟨m, hm⟩ := hs.min_mem (range f) hrange,
  refine ⟨m, m.succ, m.lt_succ_self, le_of_not_lt (λ con, _)⟩,
  rw hm at con,
  apply hs.not_lt_min (range f) hrange (mem_range_self m.succ)
    ⟨con, hf (mem_range_self m.succ), hf _⟩,
  rw ← hm,
  apply mem_range_self,
end

theorem is_wf_iff_is_pwo [linear_order α] {s : set α} :
  s.is_wf ↔ s.is_pwo :=
⟨is_wf.is_pwo, is_pwo.is_wf⟩

end set

namespace finset

@[simp] lemma partially_well_ordered_on {r : α → α → Prop} [is_refl α r] (s : finset α) :
  (s : set α).partially_well_ordered_on r :=
s.finite_to_set.partially_well_ordered_on

@[simp]
theorem is_pwo [partial_order α] (f : finset α) :
  set.is_pwo (↑f : set α) :=
f.partially_well_ordered_on

@[simp]
theorem well_founded_on {r : α → α → Prop} [is_strict_order α r] (f : finset α) :
  set.well_founded_on (↑f : set α) r :=
begin
  rw [set.well_founded_on_iff_no_descending_seq],
  intros g con,
  apply set.infinite_of_injective_forall_mem g.injective (set.range_subset_iff.1 con),
  exact f.finite_to_set,
end

@[simp]
theorem is_wf [partial_order α] (f : finset α) : set.is_wf (↑f : set α) :=
f.is_pwo.is_wf

end finset

namespace set
variables [partial_order α] {s : set α} {a : α}

theorem finite.is_pwo (h : s.finite) : s.is_pwo :=
begin
  rw ← h.coe_to_finset,
  exact h.to_finset.is_pwo,
end

@[simp]
theorem fintype.is_pwo [fintype α] : s.is_pwo := (finite.of_fintype s).is_pwo

@[simp]
theorem is_pwo_empty : is_pwo (∅ : set α) :=
finite_empty.is_pwo

@[simp]
theorem is_pwo_singleton (a) : is_pwo ({a} : set α) :=
(finite_singleton a).is_pwo

theorem is_pwo.insert (a) (hs : is_pwo s) : is_pwo (insert a s) :=
by { rw ← union_singleton, exact hs.union (is_pwo_singleton a) }

/-- `is_wf.min` returns a minimal element of a nonempty well-founded set. -/
noncomputable def is_wf.min (hs : is_wf s) (hn : s.nonempty) : α :=
hs.min univ (nonempty_iff_univ_nonempty.1 hn.to_subtype)

lemma is_wf.min_mem (hs : is_wf s) (hn : s.nonempty) : hs.min hn ∈ s :=
(well_founded.min hs univ (nonempty_iff_univ_nonempty.1 hn.to_subtype)).2

lemma is_wf.not_lt_min (hs : is_wf s) (hn : s.nonempty) (ha : a ∈ s) : ¬ a < hs.min hn :=
hs.not_lt_min univ (nonempty_iff_univ_nonempty.1 hn.to_subtype) (mem_univ (⟨a, ha⟩ : s))

@[simp]
lemma is_wf_min_singleton (a) {hs : is_wf ({a} : set α)} {hn : ({a} : set α).nonempty} :
  hs.min hn = a :=
eq_of_mem_singleton (is_wf.min_mem hs hn)

end set

theorem finset.is_wf_sup {ι : Type*} [partial_order α] (f : finset ι) (g : ι → set α)
  (hf : ∀ i : ι, i ∈ f → (g i).is_wf) : (f.sup g).is_wf :=
finset.sup_induction set.is_pwo_empty.is_wf (λ a ha b hb, ha.union hb) hf

theorem finset.is_pwo_sup {ι : Type*} [partial_order α] (f : finset ι) (g : ι → set α)
  (hf : ∀ i : ι, i ∈ f → (g i).is_pwo) : (f.sup g).is_pwo :=
finset.sup_induction set.is_pwo_empty (λ a ha b hb, ha.union hb) hf

namespace set
variables [linear_order α] {s t : set α} {a : α}

lemma is_wf.min_le
  (hs : s.is_wf) (hn : s.nonempty) (ha : a ∈ s) : hs.min hn ≤ a :=
le_of_not_lt (hs.not_lt_min hn ha)

lemma is_wf.le_min_iff
  (hs : s.is_wf) (hn : s.nonempty) :
  a ≤ hs.min hn ↔ ∀ b, b ∈ s → a ≤ b :=
⟨λ ha b hb, le_trans ha (hs.min_le hn hb), λ h, h _ (hs.min_mem _)⟩

lemma is_wf.min_le_min_of_subset
  {hs : s.is_wf} {hsn : s.nonempty} {ht : t.is_wf} {htn : t.nonempty} (hst : s ⊆ t) :
  ht.min htn ≤ hs.min hsn :=
(is_wf.le_min_iff _ _).2 (λ b hb, ht.min_le htn (hst hb))

lemma is_wf.min_union (hs : s.is_wf) (hsn : s.nonempty) (ht : t.is_wf) (htn : t.nonempty) :
  (hs.union ht).min (union_nonempty.2 (or.intro_left _ hsn)) = min (hs.min hsn) (ht.min htn) :=
begin
  refine le_antisymm (le_min (is_wf.min_le_min_of_subset (subset_union_left _ _))
      (is_wf.min_le_min_of_subset (subset_union_right _ _))) _,
  rw min_le_iff,
  exact ((mem_union _ _ _).1 ((hs.union ht).min_mem
    (union_nonempty.2 (or.intro_left _ hsn)))).imp (hs.min_le _) (ht.min_le _),
end

end set

namespace set

variables {s : set α} {t : set α}

@[to_additive]
theorem is_pwo.mul [ordered_cancel_comm_monoid α] (hs : s.is_pwo) (ht : t.is_pwo) :
  is_pwo (s * t) :=
begin
  rw ← image_mul_prod,
  exact (is_pwo.prod hs ht).image_of_monotone (λ _ _ h, mul_le_mul' h.1 h.2),
end

variable [linear_ordered_cancel_comm_monoid α]

@[to_additive]
theorem is_wf.mul (hs : s.is_wf) (ht : t.is_wf) : is_wf (s * t) :=
(hs.is_pwo.mul ht.is_pwo).is_wf

@[to_additive]
theorem is_wf.min_mul (hs : s.is_wf) (ht : t.is_wf) (hsn : s.nonempty) (htn : t.nonempty) :
  (hs.mul ht).min (hsn.mul htn) = hs.min hsn * ht.min htn :=
begin
  refine le_antisymm (is_wf.min_le _ _ (mem_mul.2 ⟨_, _, hs.min_mem _, ht.min_mem _, rfl⟩)) _,
  rw is_wf.le_min_iff,
  rintros _ ⟨x, y, hx, hy, rfl⟩,
  exact mul_le_mul' (hs.min_le _ hx) (ht.min_le _ hy),
end

end set

namespace set
namespace partially_well_ordered_on

/-- In the context of partial well-orderings, a bad sequence is a nonincreasing sequence
  whose range is contained in a particular set `s`. One exists if and only if `s` is not
  partially well-ordered. -/
def is_bad_seq (r : α → α → Prop) (s : set α) (f : ℕ → α) : Prop :=
set.range f ⊆ s ∧ ∀ (m n : ℕ), m < n → ¬ r (f m) (f n)

lemma iff_forall_not_is_bad_seq (r : α → α → Prop) (s : set α) :
  s.partially_well_ordered_on r ↔
    ∀ f, ¬ is_bad_seq r s f :=
begin
  rw [set.partially_well_ordered_on],
  apply forall_congr (λ f, _),
  simp [is_bad_seq]
end

/-- This indicates that every bad sequence `g` that agrees with `f` on the first `n`
  terms has `rk (f n) ≤ rk (g n)`. -/
def is_min_bad_seq (r : α → α → Prop) (rk : α → ℕ) (s : set α) (n : ℕ) (f : ℕ → α) : Prop :=
  ∀ g : ℕ → α, (∀ (m : ℕ), m < n → f m = g m) → rk (g n) < rk (f n) → ¬ is_bad_seq r s g

/-- Given a bad sequence `f`, this constructs a bad sequence that agrees with `f` on the first `n`
  terms and is minimal at `n`.
-/
noncomputable def min_bad_seq_of_bad_seq (r : α → α → Prop) (rk : α → ℕ) (s : set α)
  (n : ℕ) (f : ℕ → α) (hf : is_bad_seq r s f) :
  { g : ℕ → α // (∀ (m : ℕ), m < n → f m = g m) ∧ is_bad_seq r s g ∧ is_min_bad_seq r rk s n g } :=
begin
  classical,
  have h : ∃ (k : ℕ) (g : ℕ → α), (∀ m, m < n → f m = g m) ∧ is_bad_seq r s g
        ∧ rk (g n) = k :=
  ⟨_, f, λ _ _, rfl, hf, rfl⟩,
  obtain ⟨h1, h2, h3⟩ := classical.some_spec (nat.find_spec h),
  refine ⟨classical.some (nat.find_spec h), h1, by convert h2, λ g hg1 hg2 con, _⟩,
  refine nat.find_min h _ ⟨g, λ m mn, (h1 m mn).trans (hg1 m mn), by convert con, rfl⟩,
  rwa ← h3,
end

lemma exists_min_bad_of_exists_bad (r : α → α → Prop) (rk : α → ℕ) (s : set α) :
  (∃ f, is_bad_seq r s f) → ∃ f, is_bad_seq r s f ∧ ∀ n, is_min_bad_seq r rk s n f :=
begin
  rintro ⟨f0, (hf0 : is_bad_seq r s f0)⟩,
  let fs : Π (n : ℕ), { f :  ℕ → α // is_bad_seq r s f ∧ is_min_bad_seq r rk s n f },
  { refine nat.rec _ _,
    { exact ⟨(min_bad_seq_of_bad_seq r rk s 0 f0 hf0).1,
        (min_bad_seq_of_bad_seq r rk s 0 f0 hf0).2.2⟩, },
    { exact λ n fn, ⟨(min_bad_seq_of_bad_seq r rk s (n + 1) fn.1 fn.2.1).1,
        (min_bad_seq_of_bad_seq r rk s (n + 1) fn.1 fn.2.1).2.2⟩ } },
  have h : ∀ m n, m ≤ n → (fs m).1 m = (fs n).1 m,
  { intros m n mn,
    obtain ⟨k, rfl⟩ := exists_add_of_le mn,
    clear mn,
    induction k with k ih,
    { refl },
    rw [ih, ((min_bad_seq_of_bad_seq r rk s (m + k).succ (fs (m + k)).1 (fs (m + k)).2.1).2.1 m
        (nat.lt_succ_iff.2 (nat.add_le_add_left k.zero_le m)))],
    refl },
  refine ⟨λ n, (fs n).1 n, ⟨set.range_subset_iff.2 (λ n, ((fs n).2).1.1 (mem_range_self n)),
    λ m n mn, _⟩, λ n g hg1 hg2, _⟩,
  { dsimp,
    rw [← subtype.val_eq_coe, h m n (le_of_lt mn)],
    convert (fs n).2.1.2 m n mn },
  { convert (fs n).2.2 g (λ m mn, eq.trans _ (hg1 m mn)) (lt_of_lt_of_le hg2 le_rfl),
    rw ← h m n (le_of_lt mn) },
end

lemma iff_not_exists_is_min_bad_seq {r : α → α → Prop} (rk : α → ℕ) {s : set α} :
  s.partially_well_ordered_on r ↔ ¬ ∃ f, is_bad_seq r s f ∧ ∀ n, is_min_bad_seq r rk s n f :=
begin
  rw [iff_forall_not_is_bad_seq, ← not_exists, not_congr],
  split,
  { apply exists_min_bad_of_exists_bad },
  rintro ⟨f, hf1, hf2⟩,
  exact ⟨f, hf1⟩,
end

/-- Higman's Lemma, which states that for any reflexive, transitive relation `r` which is
  partially well-ordered on a set `s`, the relation `list.sublist_forall₂ r` is partially
  well-ordered on the set of lists of elements of `s`. That relation is defined so that
  `list.sublist_forall₂ r l₁ l₂` whenever `l₁` related pointwise by `r` to a sublist of `l₂`.  -/
lemma partially_well_ordered_on_sublist_forall₂ (r : α → α → Prop) [is_refl α r] [is_trans α r]
  {s : set α} (h : s.partially_well_ordered_on r) :
  { l : list α | ∀ x, x ∈ l → x ∈ s }.partially_well_ordered_on (list.sublist_forall₂ r) :=
begin
  rcases s.eq_empty_or_nonempty with rfl | ⟨as, has⟩,
  { apply partially_well_ordered_on.mono (finset.partially_well_ordered_on {list.nil}),
    { intros l hl,
      rw [finset.mem_coe, finset.mem_singleton, list.eq_nil_iff_forall_not_mem],
      exact hl, },
    apply_instance },
  haveI : inhabited α := ⟨as⟩,
  rw [iff_not_exists_is_min_bad_seq (list.length)],
  rintro ⟨f, hf1, hf2⟩,
  have hnil : ∀ n, f n ≠ list.nil :=
    λ n con, (hf1).2 n n.succ n.lt_succ_self (con.symm ▸ list.sublist_forall₂.nil),
  obtain ⟨g, hg⟩ := h.exists_monotone_subseq (list.head ∘ f) _,
  swap, { simp only [set.range_subset_iff, function.comp_apply],
    exact λ n, hf1.1 (set.mem_range_self n) _ (list.head_mem_self (hnil n)) },
  have hf' := hf2 (g 0) (λ n, if n < g 0 then f n else list.tail (f (g (n - g 0))))
    (λ m hm, (if_pos hm).symm) _,
  swap, { simp only [if_neg (lt_irrefl (g 0)), tsub_self],
    rw [list.length_tail, ← nat.pred_eq_sub_one],
    exact nat.pred_lt (λ con, hnil _ (list.length_eq_zero.1 con)) },
  rw [is_bad_seq] at hf',
  push_neg at hf',
  obtain ⟨m, n, mn, hmn⟩ := hf' _,
  swap, { rw set.range_subset_iff,
    rintro n x hx,
    split_ifs at hx with hn hn,
    { exact hf1.1 (set.mem_range_self _) _ hx },
    { refine hf1.1 (set.mem_range_self _) _ (list.tail_subset _ hx), } },
  by_cases hn : n < g 0,
  { apply hf1.2 m n mn,
    rwa [if_pos hn, if_pos (mn.trans hn)] at hmn },
  { obtain ⟨n', rfl⟩ := le_iff_exists_add.1 (not_lt.1 hn),
    rw [if_neg hn, add_comm (g 0) n', add_tsub_cancel_right] at hmn,
    split_ifs at hmn with hm hm,
    { apply hf1.2 m (g n') (lt_of_lt_of_le hm (g.monotone n'.zero_le)),
      exact trans hmn (list.tail_sublist_forall₂_self _) },
    { rw [← (tsub_lt_iff_left (le_of_not_lt hm))] at mn,
      apply hf1.2 _ _ (g.lt_iff_lt.2 mn),
      rw [← list.cons_head_tail (hnil (g (m - g 0))), ← list.cons_head_tail (hnil (g n'))],
      exact list.sublist_forall₂.cons (hg _ _ (le_of_lt mn)) hmn, } }
end

end partially_well_ordered_on

namespace is_pwo

@[to_additive]
lemma submonoid_closure [ordered_cancel_comm_monoid α] {s : set α} (hpos : ∀ x : α, x ∈ s → 1 ≤ x)
  (h : s.is_pwo) : is_pwo ((submonoid.closure s) : set α) :=
begin
  have hl : ((submonoid.closure s) : set α) ⊆ list.prod '' { l : list α | ∀ x, x ∈ l → x ∈ s },
  { intros x hx,
    rw set_like.mem_coe at hx,
    refine submonoid.closure_induction hx (λ x hx, ⟨_, λ y hy, _, list.prod_singleton⟩)
      ⟨_, λ y hy, (list.not_mem_nil _ hy).elim, list.prod_nil⟩ _,
    { rwa list.mem_singleton.1 hy },
    rintros _ _ ⟨l, hl, rfl⟩ ⟨l', hl', rfl⟩,
    refine ⟨_, λ y hy, _, list.prod_append⟩,
    cases list.mem_append.1 hy with hy hy,
    { exact hl _ hy },
    { exact hl' _ hy } },
  apply ((h.partially_well_ordered_on_sublist_forall₂ (≤)).image_of_monotone_on _).mono hl,
  intros l1 l2 hl1 hl2 h12,
  obtain ⟨l, hll1, hll2⟩ := list.sublist_forall₂_iff.1 h12,
  refine le_trans (list.rel_prod (le_refl 1) (λ a b ab c d cd, mul_le_mul' ab cd) hll1) _,
  obtain ⟨l', hl'⟩ := hll2.exists_perm_append,
  rw [hl'.prod_eq, list.prod_append, ← mul_one l.prod, mul_assoc, one_mul],
  apply mul_le_mul_left',
  have hl's := λ x hx, hl2 x (list.subset.trans (l.subset_append_right _) hl'.symm.subset hx),
  clear hl',
  induction l' with x1 x2 x3 x4 x5,
  { refl },
  rw [list.prod_cons, ← one_mul (1 : α)],
  exact mul_le_mul' (hpos x1 (hl's x1 (list.mem_cons_self x1 x2)))
    (x3 (λ x hx, hl's x (list.mem_cons_of_mem _ hx)))
end

end is_pwo

/-- `set.mul_antidiagonal s t a` is the set of all pairs of an element in `s` and an element in `t`
  that multiply to `a`. -/
@[to_additive "`set.add_antidiagonal s t a` is the set of all pairs of an element in `s`
  and an element in `t` that add to `a`."]
def mul_antidiagonal [monoid α] (s t : set α) (a : α) : set (α × α) :=
{ x | x.1 * x.2 = a ∧ x.1 ∈ s ∧ x.2 ∈ t }

namespace mul_antidiagonal

@[simp, to_additive]
lemma mem_mul_antidiagonal [monoid α] {s t : set α} {a : α} {x : α × α} :
  x ∈ mul_antidiagonal s t a ↔ x.1 * x.2 = a ∧ x.1 ∈ s ∧ x.2 ∈ t := iff.refl _

section cancel_comm_monoid
variables [cancel_comm_monoid α] {s t : set α} {a : α}

@[to_additive]
lemma fst_eq_fst_iff_snd_eq_snd {x y : (mul_antidiagonal s t a)} :
  (x : α × α).fst = (y : α × α).fst ↔ (x : α × α).snd = (y : α × α).snd :=
⟨λ h, begin
  have hx := x.2.1,
  rw [subtype.val_eq_coe, h] at hx,
  apply mul_left_cancel (hx.trans y.2.1.symm),
end, λ h, begin
  have hx := x.2.1,
  rw [subtype.val_eq_coe, h] at hx,
  apply mul_right_cancel (hx.trans y.2.1.symm),
end⟩

@[to_additive]
lemma eq_of_fst_eq_fst {x y : (mul_antidiagonal s t a)}
  (h : (x : α × α).fst = (y : α × α).fst) : x = y :=
subtype.ext (prod.ext h (mul_antidiagonal.fst_eq_fst_iff_snd_eq_snd.1 h))

@[to_additive]
lemma eq_of_snd_eq_snd {x y : (mul_antidiagonal s t a)}
  (h : (x : α × α).snd = (y : α × α).snd) : x = y :=
subtype.ext (prod.ext (mul_antidiagonal.fst_eq_fst_iff_snd_eq_snd.2 h) h)

end cancel_comm_monoid

section ordered_cancel_comm_monoid
variables [ordered_cancel_comm_monoid α] (s t : set α) (a : α)

@[to_additive]
lemma eq_of_fst_le_fst_of_snd_le_snd {x y : (mul_antidiagonal s t a)}
  (h1 : (x : α × α).fst ≤ (y : α × α).fst) (h2 : (x : α × α).snd ≤ (y : α × α).snd ) :
  x = y :=
begin
  apply eq_of_fst_eq_fst,
  cases eq_or_lt_of_le h1 with heq hlt,
  { exact heq },
  exfalso,
  exact ne_of_lt (mul_lt_mul_of_lt_of_le hlt h2)
    ((mem_mul_antidiagonal.1 x.2).1.trans (mem_mul_antidiagonal.1 y.2).1.symm)
end

variables {s} {t}

@[to_additive]
theorem finite_of_is_pwo (hs : s.is_pwo) (ht : t.is_pwo) (a) :
  (mul_antidiagonal s t a).finite :=
begin
  by_contra h,
  rw [← set.infinite] at h,
  have h1 : (mul_antidiagonal s t a).partially_well_ordered_on (prod.fst ⁻¹'o (≤)),
  { intros f hf,
    refine hs (prod.fst ∘ f) _,
    rw range_comp,
    rintros _ ⟨⟨x, y⟩, hxy, rfl⟩,
    exact (mem_mul_antidiagonal.1 (hf hxy)).2.1 },
  have h2 : (mul_antidiagonal s t a).partially_well_ordered_on (prod.snd ⁻¹'o (≤)),
  { intros f hf,
    refine ht (prod.snd ∘ f) _,
    rw range_comp,
    rintros _ ⟨⟨x, y⟩, hxy, rfl⟩,
    exact (mem_mul_antidiagonal.1 (hf hxy)).2.2 },
  obtain ⟨g, hg⟩ := h1.exists_monotone_subseq (λ x, h.nat_embedding _ x) _,
  swap, { rintro _ ⟨k, rfl⟩,
    exact ((infinite.nat_embedding (s.mul_antidiagonal t a) h) _).2 },
  obtain ⟨m, n, mn, h2'⟩ := h2 (λ x, (h.nat_embedding _) (g x)) _,
  swap, { rintro _ ⟨k, rfl⟩,
    exact ((infinite.nat_embedding (s.mul_antidiagonal t a) h) _).2, },
  apply ne_of_lt mn (g.injective ((h.nat_embedding _).injective _)),
  exact eq_of_fst_le_fst_of_snd_le_snd _ _ _ (hg _ _ (le_of_lt mn)) h2',
end

end ordered_cancel_comm_monoid

@[to_additive]
theorem finite_of_is_wf [linear_ordered_cancel_comm_monoid α] {s t : set α}
  (hs : s.is_wf) (ht : t.is_wf) (a) :
  (mul_antidiagonal s t a).finite :=
finite_of_is_pwo hs.is_pwo ht.is_pwo a

end mul_antidiagonal
end set

namespace finset

variables [ordered_cancel_comm_monoid α]
variables {s t : set α} (hs : s.is_pwo) (ht : t.is_pwo) (a : α)

/-- `finset.mul_antidiagonal_of_is_wf hs ht a` is the set of all pairs of an element in
  `s` and an element in `t` that multiply to `a`, but its construction requires proofs
  `hs` and `ht` that `s` and `t` are well-ordered. -/
@[to_additive "`finset.add_antidiagonal_of_is_wf hs ht a` is the set of all pairs of an element in
  `s` and an element in `t` that add to `a`, but its construction requires proofs
  `hs` and `ht` that `s` and `t` are well-ordered."]
noncomputable def mul_antidiagonal : finset (α × α) :=
(set.mul_antidiagonal.finite_of_is_pwo hs ht a).to_finset

variables {hs} {ht} {u : set α} {hu : u.is_pwo} {a} {x : α × α}

@[simp, to_additive]
lemma mem_mul_antidiagonal :
  x ∈ mul_antidiagonal hs ht a ↔ x.1 * x.2 = a ∧ x.1 ∈ s ∧ x.2 ∈ t :=
by simp [mul_antidiagonal]

@[to_additive]
lemma mul_antidiagonal_mono_left (hus : u ⊆ s) :
  (finset.mul_antidiagonal hu ht a) ⊆ (finset.mul_antidiagonal hs ht a) :=
λ x hx, begin
  rw mem_mul_antidiagonal at *,
  exact ⟨hx.1, hus hx.2.1, hx.2.2⟩,
end

@[to_additive]
lemma mul_antidiagonal_mono_right (hut : u ⊆ t) :
  (finset.mul_antidiagonal hs hu a) ⊆ (finset.mul_antidiagonal hs ht a) :=
λ x hx, begin
  rw mem_mul_antidiagonal at *,
  exact ⟨hx.1, hx.2.1, hut hx.2.2⟩,
end

@[to_additive]
lemma support_mul_antidiagonal_subset_mul :
  { a : α | (mul_antidiagonal hs ht a).nonempty } ⊆ s * t :=
(λ x ⟨⟨a1, a2⟩, ha⟩, begin
  obtain ⟨hmul, h1, h2⟩ := mem_mul_antidiagonal.1 ha,
  exact ⟨a1, a2, h1, h2, hmul⟩,
end)

@[to_additive]
theorem is_pwo_support_mul_antidiagonal :
  { a : α | (mul_antidiagonal hs ht a).nonempty }.is_pwo :=
(hs.mul ht).mono support_mul_antidiagonal_subset_mul

@[to_additive]
theorem mul_antidiagonal_min_mul_min {α} [linear_ordered_cancel_comm_monoid α] {s t : set α}
  (hs : s.is_wf) (ht : t.is_wf)
  (hns : s.nonempty) (hnt : t.nonempty) :
  mul_antidiagonal hs.is_pwo ht.is_pwo ((hs.min hns) * (ht.min hnt)) =
    {(hs.min hns, ht.min hnt)} :=
begin
  ext ⟨a1, a2⟩,
  rw [mem_mul_antidiagonal, finset.mem_singleton, prod.ext_iff],
  split,
  { rintro ⟨hast, has, hat⟩,
    cases eq_or_lt_of_le (hs.min_le hns has) with heq hlt,
    { refine ⟨heq.symm, _⟩,
      rw heq at hast,
      exact mul_left_cancel hast },
    { contrapose hast,
      exact ne_of_gt (mul_lt_mul_of_lt_of_le hlt (ht.min_le hnt hat)) } },
  { rintro ⟨ha1, ha2⟩,
    rw [ha1, ha2],
    exact ⟨rfl, hs.min_mem _, ht.min_mem _⟩ }
end

end finset

lemma well_founded.is_wf [has_lt α] (h : well_founded ((<) : α → α → Prop)) (s : set α) :
  s.is_wf :=
(set.is_wf_univ_iff.2 h).mono (set.subset_univ s)

/-- A version of **Dickson's lemma** any subset of functions `Π s : σ, α s` is partially well
ordered, when `σ` is a `fintype` and each `α s` is a linear well order.
This includes the classical case of Dickson's lemma that `ℕ ^ n` is a well partial order.
Some generalizations would be possible based on this proof, to include cases where the target
is partially well ordered, and also to consider the case of `partially_well_ordered_on` instead of
`is_pwo`. -/
lemma pi.is_pwo {σ : Type*} {α : σ → Type*} [∀ s, linear_order (α s)] [∀ s, is_well_order (α s) (<)]
  [fintype σ] (S : set (Π s : σ, α s)) : S.is_pwo :=
begin
  classical,
  refine set.is_pwo.mono _ (set.subset_univ _),
  rw set.is_pwo_iff_exists_monotone_subseq,
  simp_rw [monotone, pi.le_def],
  suffices : ∀ s : finset σ, ∀ (f : ℕ → (Π s, α s)), set.range f ⊆ set.univ → ∃ (g : ℕ ↪o ℕ),
    ∀ ⦃a b : ℕ⦄, a ≤ b → ∀ (x : σ) (hs : x ∈ s), (f ∘ g) a x ≤ (f ∘ g) b x,
  { simpa only [forall_true_left, finset.mem_univ] using this finset.univ, },
  apply' finset.induction,
  { intros f hf, existsi rel_embedding.refl (≤),
    simp only [forall_false_left, implies_true_iff, forall_const, finset.not_mem_empty], },
  { intros x s hx ih f hf,
    obtain ⟨g, hg⟩ := (is_well_order.wf.is_wf (set.univ : set _)).is_pwo.exists_monotone_subseq
      ((λ mo : Π s : σ, α s, mo x) ∘ f) (set.subset_univ _),
    obtain ⟨g', hg'⟩ := ih (f ∘ g) (set.subset_univ _),
    refine ⟨g'.trans g, λ a b hab, _⟩,
    simp only [finset.mem_insert, rel_embedding.coe_trans, function.comp_app, forall_eq_or_imp],
    exact ⟨hg (order_hom_class.mono g' hab), hg' hab⟩, },
end


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.calculus.mean_value

/-!
# L'Hôpital's rule for 0/0 indeterminate forms

In this file, we prove several forms of "L'Hopital's rule" for computing 0/0
indeterminate forms. The proof of `has_deriv_at.lhopital_zero_right_on_Ioo`
is based on the one given in the corresponding
[Wikibooks](https://en.wikibooks.org/wiki/Calculus/L%27H%C3%B4pital%27s_Rule)
chapter, and all other statements are derived from this one by composing by
carefully chosen functions.

Note that the filter `f'/g'` tends to isn't required to be one of `𝓝 a`,
`at_top` or `at_bot`. In fact, we give a slightly stronger statement by
allowing it to be any filter on `ℝ`.

Each statement is available in a `has_deriv_at` form and a `deriv` form, which
is denoted by each statement being in either the `has_deriv_at` or the `deriv`
namespace.
-/

open filter set
open_locale filter topological_space

variables {a b : ℝ} (hab : a < b) {l : filter ℝ} {f f' g g' : ℝ → ℝ}

/-!
## Interval-based versions

We start by proving statements where all conditions (derivability, `g' ≠ 0`) have
to be satisfied on an explicitely-provided interval.
-/

namespace has_deriv_at

include hab

theorem lhopital_zero_right_on_Ioo
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 0)) (hga : tendsto g (𝓝[Ioi a] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[Ioi a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Ioi a] a) l :=
begin
  have sub : ∀ x ∈ Ioo a b, Ioo a x ⊆ Ioo a b := λ x hx, Ioo_subset_Ioo (le_refl a) (le_of_lt hx.2),
  have hg : ∀ x ∈ (Ioo a b), g x ≠ 0,
  { intros x hx h,
    have : tendsto g (𝓝[Iio x] x) (𝓝 0),
    { rw [← h, ← nhds_within_Ioo_eq_nhds_within_Iio hx.1],
      exact ((hgg' x hx).continuous_at.continuous_within_at.mono $ sub x hx).tendsto },
    obtain ⟨y, hyx, hy⟩ : ∃ c ∈ Ioo a x, g' c = 0,
      from exists_has_deriv_at_eq_zero' hx.1 hga this (λ y hy, hgg' y $ sub x hx hy),
    exact hg' y (sub x hx hyx) hy },
  have : ∀ x ∈ Ioo a b, ∃ c ∈ Ioo a x, (f x) * (g' c) = (g x) * (f' c),
  { intros x hx,
    rw [← sub_zero (f x), ← sub_zero (g x)],
    exact exists_ratio_has_deriv_at_eq_ratio_slope' g g' hx.1 f f'
      (λ y hy, hgg' y $ sub x hx hy) (λ y hy, hff' y $ sub x hx hy) hga hfa
      (tendsto_nhds_within_of_tendsto_nhds (hgg' x hx).continuous_at.tendsto)
      (tendsto_nhds_within_of_tendsto_nhds (hff' x hx).continuous_at.tendsto) },
  choose! c hc using this,
  have : ∀ x ∈ Ioo a b, ((λ x', (f' x') / (g' x')) ∘ c) x = f x / g x,
  { intros x hx,
    rcases hc x hx with ⟨h₁, h₂⟩,
    field_simp [hg x hx, hg' (c x) ((sub x hx) h₁)],
    simp only [h₂],
    rwa mul_comm },
  have cmp : ∀ x ∈ Ioo a b, a < c x ∧ c x < x,
    from λ x hx, (hc x hx).1,
  rw ← nhds_within_Ioo_eq_nhds_within_Ioi hab,
  apply tendsto_nhds_within_congr this,
  simp only,
  apply hdiv.comp,
  refine tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
    (tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds
      (tendsto_nhds_within_of_tendsto_nhds tendsto_id) _ _) _,
  all_goals
  { apply eventually_nhds_with_of_forall,
    intros x hx,
    have := cmp x hx,
    try {simp},
    linarith [this] }
end

theorem lhopital_zero_right_on_Ico
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hcf : continuous_on f (Ico a b)) (hcg : continuous_on g (Ico a b))
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfa : f a = 0) (hga : g a = 0)
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within a (Ioi a)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within a (Ioi a)) l :=
begin
  refine lhopital_zero_right_on_Ioo hab hff' hgg' hg' _ _ hdiv,
  { rw [← hfa, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcf a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
  { rw [← hga, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcg a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
end

theorem lhopital_zero_left_on_Ioo
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfb : tendsto f (nhds_within b (Iio b)) (𝓝 0)) (hgb : tendsto g (nhds_within b (Iio b)) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within b (Iio b)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l :=
begin
  -- Here, we essentially compose by `has_neg.neg`. The following is mostly technical details.
  have hdnf : ∀ x ∈ -Ioo a b, has_deriv_at (f ∘ has_neg.neg) (f' (-x) * (-1)) x,
    from λ x hx, comp x (hff' (-x) hx) (has_deriv_at_neg x),
  have hdng : ∀ x ∈ -Ioo a b, has_deriv_at (g ∘ has_neg.neg) (g' (-x) * (-1)) x,
    from λ x hx, comp x (hgg' (-x) hx) (has_deriv_at_neg x),
  rw preimage_neg_Ioo at hdnf,
  rw preimage_neg_Ioo at hdng,
  have := lhopital_zero_right_on_Ioo (neg_lt_neg hab) hdnf hdng
    (by { intros x hx h,
          apply hg' _ (by {rw ← preimage_neg_Ioo at hx, exact hx}),
          rwa [mul_comm, ← neg_eq_neg_one_mul, neg_eq_zero] at h })
    (hfb.comp tendsto_neg_nhds_within_Ioi_neg)
    (hgb.comp tendsto_neg_nhds_within_Ioi_neg)
    (by { simp only [neg_div_neg_eq, mul_one, mul_neg_eq_neg_mul_symm],
          exact (tendsto_congr $ λ x, rfl).mp (hdiv.comp tendsto_neg_nhds_within_Ioi_neg) }),
  have := this.comp tendsto_neg_nhds_within_Iio,
  unfold function.comp at this,
  simpa only [neg_neg]
end

theorem lhopital_zero_left_on_Ioc
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hcf : continuous_on f (Ioc a b)) (hcg : continuous_on g (Ioc a b))
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfb : f b = 0) (hgb : g b = 0)
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within b (Iio b)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l :=
begin
  refine lhopital_zero_left_on_Ioo hab hff' hgg' hg' _ _ hdiv,
  { rw [← hfb, ← nhds_within_Ioo_eq_nhds_within_Iio hab],
    exact ((hcf b $ right_mem_Ioc.mpr hab).mono Ioo_subset_Ioc_self).tendsto },
  { rw [← hgb, ← nhds_within_Ioo_eq_nhds_within_Iio hab],
    exact ((hcg b $ right_mem_Ioc.mpr hab).mono Ioo_subset_Ioc_self).tendsto },
end

omit hab

theorem lhopital_zero_at_top_on_Ioi
  (hff' : ∀ x ∈ Ioi a, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioi a, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioi a, g' x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  obtain ⟨ a', haa', ha'⟩ : ∃ a', a < a' ∧ 0 < a' :=
    ⟨1 + max a 0, ⟨lt_of_le_of_lt (le_max_left a 0) (lt_one_add _),
                   lt_of_le_of_lt (le_max_right a 0) (lt_one_add _)⟩⟩,
  have fact1 : ∀ (x:ℝ), x ∈ Ioo 0 a'⁻¹ → x ≠ 0 := λ _ hx, (ne_of_lt hx.1).symm,
  have fact2 : ∀ x ∈ Ioo 0 a'⁻¹, a < x⁻¹,
    from λ _ hx, lt_trans haa' ((lt_inv ha' hx.1).mpr hx.2),
  have hdnf : ∀ x ∈ Ioo 0 a'⁻¹, has_deriv_at (f ∘ has_inv.inv) (f' (x⁻¹) * (-(x^2)⁻¹)) x,
    from λ x hx, comp x (hff' (x⁻¹) $ fact2 x hx) (has_deriv_at_inv $ fact1 x hx),
  have hdng : ∀ x ∈ Ioo 0 a'⁻¹, has_deriv_at (g ∘ has_inv.inv) (g' (x⁻¹) * (-(x^2)⁻¹)) x,
    from λ x hx, comp x (hgg' (x⁻¹) $ fact2 x hx) (has_deriv_at_inv $ fact1 x hx),
  have := lhopital_zero_right_on_Ioo (inv_pos.mpr ha') hdnf hdng
    (by { intros x hx,
          refine mul_ne_zero _ (neg_ne_zero.mpr $ inv_ne_zero $ pow_ne_zero _ $ fact1 x hx),
          exact hg' _ (fact2 x hx) })
    (hftop.comp tendsto_inv_zero_at_top)
    (hgtop.comp tendsto_inv_zero_at_top)
    (by { refine (tendsto_congr' _).mp (hdiv.comp tendsto_inv_zero_at_top),
          rw eventually_eq_iff_exists_mem,
          use [Ioi 0, self_mem_nhds_within],
          intros x hx,
          unfold function.comp,
          erw mul_div_mul_right,
          refine neg_ne_zero.mpr (inv_ne_zero $ pow_ne_zero _ $ ne_of_gt hx) }),
  have := this.comp tendsto_inv_at_top_zero',
  unfold function.comp at this,
  simpa only [inv_inv'],
end

theorem lhopital_zero_at_bot_on_Iio
  (hff' : ∀ x ∈ Iio a, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Iio a, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Iio a, g' x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  -- Here, we essentially compose by `has_neg.neg`. The following is mostly technical details.
  have hdnf : ∀ x ∈ -Iio a, has_deriv_at (f ∘ has_neg.neg) (f' (-x) * (-1)) x,
    from λ x hx, comp x (hff' (-x) hx) (has_deriv_at_neg x),
  have hdng : ∀ x ∈ -Iio a, has_deriv_at (g ∘ has_neg.neg) (g' (-x) * (-1)) x,
    from λ x hx, comp x (hgg' (-x) hx) (has_deriv_at_neg x),
  rw preimage_neg_Iio at hdnf,
  rw preimage_neg_Iio at hdng,
  have := lhopital_zero_at_top_on_Ioi hdnf hdng
    (by { intros x hx h,
          apply hg' _ (by {rw ← preimage_neg_Iio at hx, exact hx}),
          rwa [mul_comm, ← neg_eq_neg_one_mul, neg_eq_zero] at h })
    (hfbot.comp tendsto_neg_at_top_at_bot)
    (hgbot.comp tendsto_neg_at_top_at_bot)
    (by { simp only [mul_one, mul_neg_eq_neg_mul_symm, neg_div_neg_eq],
          exact (tendsto_congr $ λ x, rfl).mp (hdiv.comp tendsto_neg_at_top_at_bot) }),
  have := this.comp tendsto_neg_at_bot_at_top,
  unfold function.comp at this,
  simpa only [neg_neg],
end

end has_deriv_at

namespace deriv

include hab

theorem lhopital_zero_right_on_Ioo
  (hdf : differentiable_on ℝ f (Ioo a b)) (hg' : ∀ x ∈ Ioo a b, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 0)) (hga : tendsto g (𝓝[Ioi a] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[Ioi a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Ioi a] a) l :=
begin
  have hdf : ∀ x ∈ Ioo a b, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioo_mem_nhds hx.1 hx.2),
  have hdg : ∀ x ∈ Ioo a b, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_right_on_Ioo hab (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfa hga hdiv
end

theorem lhopital_zero_right_on_Ico
  (hdf : differentiable_on ℝ f (Ioo a b))
  (hcf : continuous_on f (Ico a b)) (hcg : continuous_on g (Ico a b))
  (hg' : ∀ x ∈ (Ioo a b), (deriv g) x ≠ 0)
  (hfa : f a = 0) (hga : g a = 0)
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (nhds_within a (Ioi a)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within a (Ioi a)) l :=
begin
  refine lhopital_zero_right_on_Ioo hab hdf hg' _ _ hdiv,
  { rw [← hfa, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcf a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
  { rw [← hga, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcg a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
end

theorem lhopital_zero_left_on_Ioo
  (hdf : differentiable_on ℝ f (Ioo a b))
  (hg' : ∀ x ∈ (Ioo a b), (deriv g) x ≠ 0)
  (hfb : tendsto f (nhds_within b (Iio b)) (𝓝 0)) (hgb : tendsto g (nhds_within b (Iio b)) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (nhds_within b (Iio b)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l :=
begin
  have hdf : ∀ x ∈ Ioo a b, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioo_mem_nhds hx.1 hx.2),
  have hdg : ∀ x ∈ Ioo a b, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_left_on_Ioo hab (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfb hgb hdiv
end

omit hab

theorem lhopital_zero_at_top_on_Ioi
  (hdf : differentiable_on ℝ f (Ioi a))
  (hg' : ∀ x ∈ (Ioi a), (deriv g) x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  have hdf : ∀ x ∈ Ioi a, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioi_mem_nhds hx),
  have hdg : ∀ x ∈ Ioi a, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_at_top_on_Ioi (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hftop hgtop hdiv,
end

theorem lhopital_zero_at_bot_on_Iio
  (hdf : differentiable_on ℝ f (Iio a))
  (hg' : ∀ x ∈ (Iio a), (deriv g) x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  have hdf : ∀ x ∈ Iio a, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Iio_mem_nhds hx),
  have hdg : ∀ x ∈ Iio a, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_at_bot_on_Iio (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfbot hgbot hdiv,
end

end deriv

/-!
## Generic versions

The following statements no longer any explicit interval, as they only require
conditions holding eventually.
-/

namespace has_deriv_at

/-- L'Hôpital's rule for approaching a real from the right, `has_deriv_at` version -/
theorem lhopital_zero_nhds_right
  (hff' : ∀ᶠ x in 𝓝[Ioi a] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[Ioi a] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[Ioi a] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 0)) (hga : tendsto g (𝓝[Ioi a] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[Ioi a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Ioi a] a) l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ 𝓝[Ioi a] a := inter_mem_sets (inter_mem_sets hs₁ hs₂) hs₃,
  rw mem_nhds_within_Ioi_iff_exists_Ioo_subset at hs,
  rcases hs with ⟨u, hau, hu⟩,
  refine lhopital_zero_right_on_Ioo hau _ _ _ hfa hga hdiv;
  intros x hx;
  apply_assumption;
  exact (hu hx).1.1 <|> exact (hu hx).1.2 <|> exact (hu hx).2
end

/-- L'Hôpital's rule for approaching a real from the left, `has_deriv_at` version -/
theorem lhopital_zero_nhds_left
  (hff' : ∀ᶠ x in 𝓝[Iio a] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[Iio a] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[Iio a] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[Iio a] a) (𝓝 0)) (hga : tendsto g (𝓝[Iio a] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[Iio a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Iio a] a) l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ 𝓝[Iio a] a := inter_mem_sets (inter_mem_sets hs₁ hs₂) hs₃,
  rw mem_nhds_within_Iio_iff_exists_Ioo_subset at hs,
  rcases hs with ⟨l, hal, hl⟩,
  refine lhopital_zero_left_on_Ioo hal _ _ _ hfa hga hdiv;
  intros x hx;
  apply_assumption;
  exact (hl hx).1.1 <|> exact (hl hx).1.2 <|> exact (hl hx).2
end

/-- L'Hôpital's rule for approaching a real, `has_deriv_at` version. This
  does not require anything about the situation at `a` -/
theorem lhopital_zero_nhds'
  (hff' : ∀ᶠ x in 𝓝[univ \ {a}] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[univ \ {a}] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[univ \ {a}] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[univ \ {a}] a) (𝓝 0)) (hga : tendsto g (𝓝[univ \ {a}] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[univ \ {a}] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l :=
begin
  have : univ \ {a} = Iio a ∪ Ioi a,
  { ext, rw [mem_diff_singleton, eq_true_intro $ mem_univ x, true_and, ne_iff_lt_or_gt], refl },
  simp only [this, nhds_within_union, tendsto_sup, eventually_sup] at *,
  exact ⟨lhopital_zero_nhds_left hff'.1 hgg'.1 hg'.1 hfa.1 hga.1 hdiv.1,
          lhopital_zero_nhds_right hff'.2 hgg'.2 hg'.2 hfa.2 hga.2 hdiv.2⟩
end

/-- L'Hôpital's rule for approaching a real, `has_deriv_at` version -/
theorem lhopital_zero_nhds
  (hff' : ∀ᶠ x in 𝓝 a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝 a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝 a, g' x ≠ 0)
  (hfa : tendsto f (𝓝 a) (𝓝 0)) (hga : tendsto g (𝓝 a) (𝓝 0))
  (hdiv : tendsto (λ x, f' x / g' x) (𝓝 a) l) :
  tendsto (λ x, f x / g x) (𝓝[univ \ {a}] a) l :=
begin
  apply @lhopital_zero_nhds' _ _ _ f' _ g';
  apply eventually_nhds_within_of_eventually_nhds <|> apply tendsto_nhds_within_of_tendsto_nhds;
  assumption
end

/-- L'Hôpital's rule for approaching +∞, `has_deriv_at` version -/
theorem lhopital_zero_at_top
  (hff' : ∀ᶠ x in at_top, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in at_top, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in at_top, g' x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ at_top := inter_mem_sets (inter_mem_sets hs₁ hs₂) hs₃,
  rw mem_at_top_sets at hs,
  rcases hs with ⟨l, hl⟩,
  have hl' : Ioi l ⊆ s := λ x hx, hl x (le_of_lt hx),
  refine lhopital_zero_at_top_on_Ioi _ _ (λ x hx, hg' x $ (hl' hx).2) hftop hgtop hdiv;
  intros x hx;
  apply_assumption;
  exact (hl' hx).1.1 <|> exact (hl' hx).1.2
end

/-- L'Hôpital's rule for approaching -∞, `has_deriv_at` version -/
theorem lhopital_zero_at_bot
  (hff' : ∀ᶠ x in at_bot, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in at_bot, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in at_bot, g' x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ at_bot := inter_mem_sets (inter_mem_sets hs₁ hs₂) hs₃,
  rw mem_at_bot_sets at hs,
  rcases hs with ⟨l, hl⟩,
  have hl' : Iio l ⊆ s := λ x hx, hl x (le_of_lt hx),
  refine lhopital_zero_at_bot_on_Iio _ _ (λ x hx, hg' x $ (hl' hx).2) hfbot hgbot hdiv;
  intros x hx;
  apply_assumption;
  exact (hl' hx).1.1 <|> exact (hl' hx).1.2
end

end has_deriv_at

namespace deriv

/-- L'Hôpital's rule for approaching a real from the right, `deriv` version -/
theorem lhopital_zero_nhds_right
  (hdf : ∀ᶠ x in 𝓝[Ioi a] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[Ioi a] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[Ioi a] a) (𝓝 0)) (hga : tendsto g (𝓝[Ioi a] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[Ioi a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Ioi a] a) l :=
begin
  have hdg : ∀ᶠ x in 𝓝[Ioi a] a, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in 𝓝[Ioi a] a, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in 𝓝[Ioi a] a, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_nhds_right hdf' hdg' hg' hfa hga hdiv
end

/-- L'Hôpital's rule for approaching a real from the left, `deriv` version -/
theorem lhopital_zero_nhds_left
  (hdf : ∀ᶠ x in 𝓝[Iio a] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[Iio a] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[Iio a] a) (𝓝 0)) (hga : tendsto g (𝓝[Iio a] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[Iio a] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[Iio a] a) l :=
begin
  have hdg : ∀ᶠ x in 𝓝[Iio a] a, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in 𝓝[Iio a] a, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in 𝓝[Iio a] a, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_nhds_left hdf' hdg' hg' hfa hga hdiv
end

/-- L'Hôpital's rule for approaching a real, `deriv` version. This
  does not require anything about the situation at `a` -/
theorem lhopital_zero_nhds'
  (hdf : ∀ᶠ x in 𝓝[univ \ {a}] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[univ \ {a}] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[univ \ {a}] a) (𝓝 0)) (hga : tendsto g (𝓝[univ \ {a}] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[univ \ {a}] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l :=
begin
  have : univ \ {a} = Iio a ∪ Ioi a,
  { ext, rw [mem_diff_singleton, eq_true_intro $ mem_univ x, true_and, ne_iff_lt_or_gt], refl },
  simp only [this, nhds_within_union, tendsto_sup, eventually_sup] at *,
  exact ⟨lhopital_zero_nhds_left hdf.1 hg'.1 hfa.1 hga.1 hdiv.1,
          lhopital_zero_nhds_right hdf.2 hg'.2 hfa.2 hga.2 hdiv.2⟩,
end

/-- L'Hôpital's rule for approaching a real, `deriv` version -/
theorem lhopital_zero_nhds
  (hdf : ∀ᶠ x in 𝓝 a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝 a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝 a) (𝓝 0)) (hga : tendsto g (𝓝 a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝 a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l :=
begin
  apply lhopital_zero_nhds';
  apply eventually_nhds_within_of_eventually_nhds <|> apply tendsto_nhds_within_of_tendsto_nhds;
  assumption
end

/-- L'Hôpital's rule for approaching +∞, `deriv` version -/
theorem lhopital_zero_at_top
  (hdf : ∀ᶠ (x : ℝ) in at_top, differentiable_at ℝ f x)
  (hg' : ∀ᶠ (x : ℝ) in at_top, deriv g x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  have hdg : ∀ᶠ x in at_top, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in at_top, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in at_top, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_at_top hdf' hdg' hg' hftop hgtop hdiv
end

/-- L'Hôpital's rule for approaching -∞, `deriv` version -/
theorem lhopital_zero_at_bot
  (hdf : ∀ᶠ (x : ℝ) in at_bot, differentiable_at ℝ f x)
  (hg' : ∀ᶠ (x : ℝ) in at_bot, deriv g x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  have hdg : ∀ᶠ x in at_bot, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in at_bot, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in at_bot, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_at_bot hdf' hdg' hg' hfbot hgbot hdiv
end

end deriv


import GMLInit.Data.Index.Basic

namespace Index
variable {α β} (f : α → β)

@[inline]
def map'impl {xs : List α} (i : Index xs) : Index (xs.map f) :=
  Index.ofFin ⟨i.toNat, xs.length_map f ▸ i.toNat_lt_length⟩

@[implemented_by map'impl]
def map : {xs : List α} → Index xs → Index (xs.map f)
| _, Index.head => Index.head
| _, Index.tail i => Index.tail (map i)

@[inline]
def unmap'impl {xs : List α} (i : Index (xs.map f)) : Index xs :=
  Index.ofFin ⟨i.toNat, xs.length_map f ▸ i.toNat_lt_length⟩

@[implemented_by unmap'impl]
def unmap : {xs : List α} → Index (xs.map f) → Index xs
| _::_, Index.head => Index.head
| _::_, Index.tail i => Index.tail (unmap i)

theorem unmap_map {xs : List α} (i : Index xs) : (i.map f).unmap f = i := by
  induction i with
  | head => rfl
  | tail i ih => exact congrArg tail ih

theorem map_unmap {xs : List α} (i : Index (xs.map f)) : (i.unmap f).map f = i := by
  induction xs with
  | nil => contradiction
  | cons x xs ih =>
    match i with
    | head => rfl
    | tail i => exact congrArg tail (ih i)

theorem map_eq_iff_eq_unmap {xs : List α} (i : Index xs) (j : Index (xs.map f)) : i.map f = j ↔ i = j.unmap f := by
  constr
  · intro h; rw [←h, unmap_map]
  · intro h; rw [h, map_unmap]

theorem unmap_eq_iff_eq_map {xs : List α} (i : Index (xs.map f)) (j : Index xs) : i.unmap f = j ↔ i = j.map f := by
  constr
  · intro h; rw [←h, map_unmap]
  · intro h; rw [h, unmap_map]

def mapEquiv (xs : List α) : Equiv (Index xs) (Index (xs.map f)) where
  fwd := map f
  rev := unmap f
  spec := by
    intros
    constr
    · intro | rfl => exact unmap_map ..
    · intro | rfl => exact map_unmap ..

theorem val_map {xs : List α} (i : Index xs) : (i.map f).val = f i.val := by
  induction i with
  | head => rfl
  | tail _ ih => exact ih

theorem val_unmap {xs : List α} (i : Index (xs.map f)) : i.val = f (i.unmap f).val := by
  rw [←map_unmap f i, val_map, unmap_map]

end Index


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.generator
import category_theory.preadditive.yoneda

/-!
# Separators in preadditive categories

This file contains characterizations of separating sets and objects that are valid in all
preadditive categories.

-/

universes v u

open category_theory opposite

namespace category_theory
variables {C : Type u} [category.{v} C] [preadditive C]

lemma preadditive.is_separating_iff (𝒢 : set C) :
  is_separating 𝒢 ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ (G ∈ 𝒢) (h : G ⟶ X), h ≫ f = 0) → f = 0 :=
⟨λ h𝒢 X Y f hf, h𝒢 _ _ (by simpa only [limits.comp_zero] using hf),
 λ h𝒢 X Y f g hfg, sub_eq_zero.1 $ h𝒢 _
  (by simpa only [preadditive.comp_sub, sub_eq_zero] using hfg)⟩

lemma preadditive.is_coseparating_iff (𝒢 : set C) :
  is_coseparating 𝒢 ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ (G ∈ 𝒢) (h : Y ⟶ G), f ≫ h = 0) → f = 0 :=
⟨λ h𝒢 X Y f hf, h𝒢 _ _ (by simpa only [limits.zero_comp] using hf),
 λ h𝒢 X Y f g hfg, sub_eq_zero.1 $ h𝒢 _
  (by simpa only [preadditive.sub_comp, sub_eq_zero] using hfg)⟩

lemma preadditive.is_separator_iff (G : C) :
  is_separator G ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ h : G ⟶ X, h ≫ f = 0) → f = 0 :=
⟨λ hG X Y f hf, hG.def _ _ (by simpa only [limits.comp_zero] using hf),
 λ hG, (is_separator_def _).2 $ λ X Y f g hfg, sub_eq_zero.1 $ hG _
  (by simpa only [preadditive.comp_sub, sub_eq_zero] using hfg)⟩

lemma preadditive.is_coseparator_iff (G : C) :
  is_coseparator G ↔ ∀ ⦃X Y : C⦄ (f : X ⟶ Y), (∀ h : Y ⟶ G, f ≫ h = 0) → f = 0 :=
⟨λ hG X Y f hf, hG.def _ _ (by simpa only [limits.zero_comp] using hf),
 λ hG, (is_coseparator_def _).2 $ λ X Y f g hfg, sub_eq_zero.1 $ hG _
  (by simpa only [preadditive.sub_comp, sub_eq_zero] using hfg)⟩

lemma is_separator_iff_faithful_preadditive_coyoneda_obj (G : C) :
  is_separator G ↔ faithful (preadditive_coyoneda_obj (op G)) :=
begin
  rw [is_separator_iff_faithful_preadditive_coyoneda, preadditive_coyoneda_obj_2],
  exact ⟨λ h, by exactI faithful.of_comp _ (forget₂ _ AddCommGroup.{v}),
         λ h, by exactI faithful.comp _ _⟩
end

lemma is_coseparator_iff_faithful_preadditive_yoneda (G : C) :
  is_coseparator G ↔ faithful (preadditive_yoneda.obj G) :=
begin
  rw [is_coseparator_iff_faithful_yoneda_obj, ← whiskering_preadditive_yoneda, functor.comp_obj,
    whiskering_right_obj_obj],
  exact ⟨λ h, by exactI faithful.of_comp _ (forget AddCommGroup), λ h, by exactI faithful.comp _ _⟩
end

lemma is_coseparator_iff_faithful_preadditive_yoneda_obj (G : C) :
  is_coseparator G ↔ faithful (preadditive_yoneda_obj G) :=
begin
  rw [is_coseparator_iff_faithful_preadditive_yoneda, preadditive_yoneda_obj_2],
  exact ⟨λ h, by exactI faithful.of_comp _ (forget₂ _ AddCommGroup.{v}),
         λ h, by exactI faithful.comp _ _⟩
end

end category_theory


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.ordinal_arithmetic
import Mathlib.tactic.omega.default
import Mathlib.PostPort

universes u_1 u v w u_2

namespace Mathlib

/-!
# Cardinals and ordinals

Relationships between cardinals and ordinals, properties of cardinals that are proved
using ordinals.

## Main definitions and results

* The `aleph'` function gives the cardinals listed by their ordinal
  index, and is the inverse of `aleph_idx`.
  `aleph' n = n`, `aleph' ω = ω`, `aleph' (ω + 1) = ℵ₁`, etc. It is an order isomorphism
  between ordinals and cardinals.
* The `aleph` function gives the infinite cardinals listed by their
  ordinal index. `aleph 0 = ω`, `aleph 1 = succ ω` is the first
  uncountable cardinal, and so on.

* `mul_eq_max` and `add_eq_max` state that the product (resp. sum) of two infinite cardinals
  is just their maximum. Several variations around this fact are also given.
* `mk_list_eq_mk` : when `α` is infinite, `α` and `list α` have the same cardinality.
* simp lemmas for inequalities between `bit0 a` and `bit1 b` are registered, making simp
  able to prove inequalities about numeral cardinals.
-/

namespace cardinal

theorem ord_is_limit {c : cardinal} (co : omega ≤ c) : ordinal.is_limit (ord c) := sorry

/-- The `aleph'` index function, which gives the ordinal index of a cardinal.
  (The `aleph'` part is because unlike `aleph` this counts also the
  finite stages. So `aleph_idx n = n`, `aleph_idx ω = ω`,
  `aleph_idx ℵ₁ = ω + 1` and so on.)
  In this definition, we register additionally that this function is an initial segment,
  i.e., it is order preserving and its range is an initial segment of the ordinals.
  For the basic function version, see `aleph_idx`.
  For an upgraded version stating that the range is everything, see `aleph_idx.rel_iso`. -/
def aleph_idx.initial_seg : initial_seg Less Less :=
  rel_embedding.collapse (order_embedding.lt_embedding ord.order_embedding)

/-- The `aleph'` index function, which gives the ordinal index of a cardinal.
  (The `aleph'` part is because unlike `aleph` this counts also the
  finite stages. So `aleph_idx n = n`, `aleph_idx ω = ω`,
  `aleph_idx ℵ₁ = ω + 1` and so on.)
  For an upgraded version stating that the range is everything, see `aleph_idx.rel_iso`. -/
def aleph_idx : cardinal → ordinal :=
  ⇑sorry

@[simp] theorem aleph_idx.initial_seg_coe : ⇑aleph_idx.initial_seg = aleph_idx :=
  rfl

@[simp] theorem aleph_idx_lt {a : cardinal} {b : cardinal} : aleph_idx a < aleph_idx b ↔ a < b :=
  rel_embedding.map_rel_iff (initial_seg.to_rel_embedding aleph_idx.initial_seg)

@[simp] theorem aleph_idx_le {a : cardinal} {b : cardinal} : aleph_idx a ≤ aleph_idx b ↔ a ≤ b := sorry

theorem aleph_idx.init {a : cardinal} {b : ordinal} : b < aleph_idx a → ∃ (c : cardinal), aleph_idx c = b :=
  initial_seg.init aleph_idx.initial_seg a b

/-- The `aleph'` index function, which gives the ordinal index of a cardinal.
  (The `aleph'` part is because unlike `aleph` this counts also the
  finite stages. So `aleph_idx n = n`, `aleph_idx ω = ω`,
  `aleph_idx ℵ₁ = ω + 1` and so on.)
  In this version, we register additionally that this function is an order isomorphism
  between cardinals and ordinals.
  For the basic function version, see `aleph_idx`. -/
def aleph_idx.rel_iso : Less ≃r Less :=
  rel_iso.of_surjective ↑aleph_idx.initial_seg sorry

@[simp] theorem aleph_idx.rel_iso_coe : ⇑aleph_idx.rel_iso = aleph_idx :=
  rfl

@[simp] theorem type_cardinal : ordinal.type Less = ordinal.univ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (ordinal.type Less = ordinal.univ)) ordinal.univ_id))
    (quotient.sound (Nonempty.intro aleph_idx.rel_iso))

@[simp] theorem mk_cardinal : mk cardinal = univ := sorry

/-- The `aleph'` function gives the cardinals listed by their ordinal
  index, and is the inverse of `aleph_idx`.
  `aleph' n = n`, `aleph' ω = ω`, `aleph' (ω + 1) = ℵ₁`, etc.
  In this version, we register additionally that this function is an order isomorphism
  between ordinals and cardinals.
  For the basic function version, see `aleph'`. -/
def aleph'.rel_iso : Less ≃r Less :=
  rel_iso.symm aleph_idx.rel_iso

/-- The `aleph'` function gives the cardinals listed by their ordinal
  index, and is the inverse of `aleph_idx`.
  `aleph' n = n`, `aleph' ω = ω`, `aleph' (ω + 1) = ℵ₁`, etc. -/
def aleph' : ordinal → cardinal :=
  ⇑sorry

@[simp] theorem aleph'.rel_iso_coe : ⇑aleph'.rel_iso = aleph' :=
  rfl

@[simp] theorem aleph'_lt {o₁ : ordinal} {o₂ : ordinal} : aleph' o₁ < aleph' o₂ ↔ o₁ < o₂ :=
  rel_iso.map_rel_iff aleph'.rel_iso

@[simp] theorem aleph'_le {o₁ : ordinal} {o₂ : ordinal} : aleph' o₁ ≤ aleph' o₂ ↔ o₁ ≤ o₂ :=
  iff.mpr le_iff_le_iff_lt_iff_lt aleph'_lt

@[simp] theorem aleph'_aleph_idx (c : cardinal) : aleph' (aleph_idx c) = c :=
  equiv.symm_apply_apply (rel_iso.to_equiv aleph_idx.rel_iso) c

@[simp] theorem aleph_idx_aleph' (o : ordinal) : aleph_idx (aleph' o) = o :=
  equiv.apply_symm_apply (rel_iso.to_equiv aleph_idx.rel_iso) o

@[simp] theorem aleph'_zero : aleph' 0 = 0 := sorry

@[simp] theorem aleph'_succ {o : ordinal} : aleph' (ordinal.succ o) = succ (aleph' o) := sorry

@[simp] theorem aleph'_nat (n : ℕ) : aleph' ↑n = ↑n := sorry

theorem aleph'_le_of_limit {o : ordinal} (l : ordinal.is_limit o) {c : cardinal} : aleph' o ≤ c ↔ ∀ (o' : ordinal), o' < o → aleph' o' ≤ c := sorry

@[simp] theorem aleph'_omega : aleph' ordinal.omega = omega := sorry

/-- `aleph'` and `aleph_idx` form an equivalence between `ordinal` and `cardinal` -/
@[simp] def aleph'_equiv : ordinal ≃ cardinal :=
  equiv.mk aleph' aleph_idx aleph_idx_aleph' aleph'_aleph_idx

/-- The `aleph` function gives the infinite cardinals listed by their
  ordinal index. `aleph 0 = ω`, `aleph 1 = succ ω` is the first
  uncountable cardinal, and so on. -/
def aleph (o : ordinal) : cardinal :=
  aleph' (ordinal.omega + o)

@[simp] theorem aleph_lt {o₁ : ordinal} {o₂ : ordinal} : aleph o₁ < aleph o₂ ↔ o₁ < o₂ :=
  iff.trans aleph'_lt (ordinal.add_lt_add_iff_left ordinal.omega)

@[simp] theorem aleph_le {o₁ : ordinal} {o₂ : ordinal} : aleph o₁ ≤ aleph o₂ ↔ o₁ ≤ o₂ :=
  iff.mpr le_iff_le_iff_lt_iff_lt aleph_lt

@[simp] theorem aleph_succ {o : ordinal} : aleph (ordinal.succ o) = succ (aleph o) := sorry

@[simp] theorem aleph_zero : aleph 0 = omega := sorry

theorem omega_le_aleph' {o : ordinal} : omega ≤ aleph' o ↔ ordinal.omega ≤ o :=
  eq.mpr (id (Eq._oldrec (Eq.refl (omega ≤ aleph' o ↔ ordinal.omega ≤ o)) (Eq.symm aleph'_omega)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (aleph' ordinal.omega ≤ aleph' o ↔ ordinal.omega ≤ o)) (propext aleph'_le)))
      (iff.refl (ordinal.omega ≤ o)))

theorem omega_le_aleph (o : ordinal) : omega ≤ aleph o :=
  eq.mpr (id (Eq._oldrec (Eq.refl (omega ≤ aleph o)) (aleph.equations._eqn_1 o)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (omega ≤ aleph' (ordinal.omega + o))) (propext omega_le_aleph')))
      (ordinal.le_add_right ordinal.omega o))

theorem ord_aleph_is_limit (o : ordinal) : ordinal.is_limit (ord (aleph o)) :=
  ord_is_limit (omega_le_aleph o)

theorem exists_aleph {c : cardinal} : omega ≤ c ↔ ∃ (o : ordinal), c = aleph o := sorry

theorem aleph'_is_normal : ordinal.is_normal (ord ∘ aleph') := sorry

theorem aleph_is_normal : ordinal.is_normal (ord ∘ aleph) :=
  ordinal.is_normal.trans aleph'_is_normal (ordinal.add_is_normal ordinal.omega)

/-! ### Properties of `mul` -/

/-- If `α` is an infinite type, then `α × α` and `α` have the same cardinality. -/
theorem mul_eq_self {c : cardinal} (h : omega ≤ c) : c * c = c := sorry

/-- If `α` and `β` are infinite types, then the cardinality of `α × β` is the maximum
of the cardinalities of `α` and `β`. -/
theorem mul_eq_max {a : cardinal} {b : cardinal} (ha : omega ≤ a) (hb : omega ≤ b) : a * b = max a b := sorry

theorem mul_lt_of_lt {a : cardinal} {b : cardinal} {c : cardinal} (hc : omega ≤ c) (h1 : a < c) (h2 : b < c) : a * b < c := sorry

theorem mul_le_max_of_omega_le_left {a : cardinal} {b : cardinal} (h : omega ≤ a) : a * b ≤ max a b := sorry

theorem mul_eq_max_of_omega_le_left {a : cardinal} {b : cardinal} (h : omega ≤ a) (h' : b ≠ 0) : a * b = max a b := sorry

theorem mul_eq_left {a : cardinal} {b : cardinal} (ha : omega ≤ a) (hb : b ≤ a) (hb' : b ≠ 0) : a * b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b = a)) (mul_eq_max_of_omega_le_left ha hb')))
    (eq.mpr (id (Eq._oldrec (Eq.refl (max a b = a)) (max_eq_left hb))) (Eq.refl a))

theorem mul_eq_right {a : cardinal} {b : cardinal} (hb : omega ≤ b) (ha : a ≤ b) (ha' : a ≠ 0) : a * b = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b = b)) (mul_comm a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b * a = b)) (mul_eq_left hb ha ha'))) (Eq.refl b))

theorem le_mul_left {a : cardinal} {b : cardinal} (h : b ≠ 0) : a ≤ b * a := sorry

theorem le_mul_right {a : cardinal} {b : cardinal} (h : b ≠ 0) : a ≤ a * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ a * b)) (mul_comm a b))) (le_mul_left h)

theorem mul_eq_left_iff {a : cardinal} {b : cardinal} : a * b = a ↔ max omega b ≤ a ∧ b ≠ 0 ∨ b = 1 ∨ a = 0 := sorry

/-! ### Properties of `add` -/

/-- If `α` is an infinite type, then `α ⊕ α` and `α` have the same cardinality. -/
theorem add_eq_self {c : cardinal} (h : omega ≤ c) : c + c = c := sorry

/-- If `α` is an infinite type, then the cardinality of `α ⊕ β` is the maximum
of the cardinalities of `α` and `β`. -/
theorem add_eq_max {a : cardinal} {b : cardinal} (ha : omega ≤ a) : a + b = max a b :=
  le_antisymm (add_eq_self (le_trans ha (le_max_left a b)) ▸ add_le_add (le_max_left a b) (le_max_right a b))
    (max_le (self_le_add_right a b) (self_le_add_left b a))

theorem add_lt_of_lt {a : cardinal} {b : cardinal} {c : cardinal} (hc : omega ≤ c) (h1 : a < c) (h2 : b < c) : a + b < c := sorry

theorem eq_of_add_eq_of_omega_le {a : cardinal} {b : cardinal} {c : cardinal} (h : a + b = c) (ha : a < c) (hc : omega ≤ c) : b = c := sorry

theorem add_eq_left {a : cardinal} {b : cardinal} (ha : omega ≤ a) (hb : b ≤ a) : a + b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b = a)) (add_eq_max ha)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (max a b = a)) (max_eq_left hb))) (Eq.refl a))

theorem add_eq_right {a : cardinal} {b : cardinal} (hb : omega ≤ b) (ha : a ≤ b) : a + b = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b = b)) (add_comm a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b + a = b)) (add_eq_left hb ha))) (Eq.refl b))

theorem add_eq_left_iff {a : cardinal} {b : cardinal} : a + b = a ↔ max omega b ≤ a ∨ b = 0 := sorry

theorem add_eq_right_iff {a : cardinal} {b : cardinal} : a + b = b ↔ max omega a ≤ b ∨ a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b = b ↔ max omega a ≤ b ∨ a = 0)) (add_comm a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b + a = b ↔ max omega a ≤ b ∨ a = 0)) (propext add_eq_left_iff)))
      (iff.refl (max omega a ≤ b ∨ a = 0)))

theorem add_one_eq {a : cardinal} (ha : omega ≤ a) : a + 1 = a :=
  (fun (this : 1 ≤ a) => add_eq_left ha this) (le_trans (le_of_lt one_lt_omega) ha)

protected theorem eq_of_add_eq_add_left {a : cardinal} {b : cardinal} {c : cardinal} (h : a + b = a + c) (ha : a < omega) : b = c := sorry

protected theorem eq_of_add_eq_add_right {a : cardinal} {b : cardinal} {c : cardinal} (h : a + b = c + b) (hb : b < omega) : a = c := sorry

/-! ### Properties about power -/

theorem pow_le {κ : cardinal} {μ : cardinal} (H1 : omega ≤ κ) (H2 : μ < omega) : κ ^ μ ≤ κ := sorry

theorem power_self_eq {c : cardinal} (h : omega ≤ c) : c ^ c = bit0 1 ^ c := sorry

theorem power_nat_le {c : cardinal} {n : ℕ} (h : omega ≤ c) : c ^ ↑n ≤ c :=
  pow_le h (nat_lt_omega n)

theorem powerlt_omega {c : cardinal} (h : omega ≤ c) : c ^< omega = c := sorry

theorem powerlt_omega_le (c : cardinal) : c ^< omega ≤ max c omega := sorry

/-! ### Computing cardinality of various types -/

theorem mk_list_eq_mk {α : Type u} (H1 : omega ≤ mk α) : mk (List α) = mk α := sorry

theorem mk_finset_eq_mk {α : Type u} (h : omega ≤ mk α) : mk (finset α) = mk α :=
  Eq.symm
    (le_antisymm (mk_le_of_injective fun (x y : α) => iff.mp finset.singleton_inj)
      (trans_rel_left LessEq (mk_le_of_surjective list.to_finset_surjective) (mk_list_eq_mk h)))

theorem mk_bounded_set_le_of_omega_le (α : Type u) (c : cardinal) (hα : omega ≤ mk α) : mk (Subtype fun (t : set α) => mk ↥t ≤ c) ≤ mk α ^ c := sorry

theorem mk_bounded_set_le (α : Type u) (c : cardinal) : mk (Subtype fun (t : set α) => mk ↥t ≤ c) ≤ max (mk α) omega ^ c := sorry

theorem mk_bounded_subset_le {α : Type u} (s : set α) (c : cardinal) : mk (Subtype fun (t : set α) => t ⊆ s ∧ mk ↥t ≤ c) ≤ max (mk ↥s) omega ^ c := sorry

/-! ### Properties of `compl` -/

theorem mk_compl_of_omega_le {α : Type u_1} (s : set α) (h : omega ≤ mk α) (h2 : mk ↥s < mk α) : mk ↥(sᶜ) = mk α :=
  eq_of_add_eq_of_omega_le (mk_sum_compl s) h2 h

theorem mk_compl_finset_of_omega_le {α : Type u_1} (s : finset α) (h : omega ≤ mk α) : mk ↥(↑sᶜ) = mk α :=
  mk_compl_of_omega_le (↑s) h (lt_of_lt_of_le (finset_card_lt_omega s) h)

theorem mk_compl_eq_mk_compl_infinite {α : Type u_1} {s : set α} {t : set α} (h : omega ≤ mk α) (hs : mk ↥s < mk α) (ht : mk ↥t < mk α) : mk ↥(sᶜ) = mk ↥(tᶜ) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (mk ↥(sᶜ) = mk ↥(tᶜ))) (mk_compl_of_omega_le s h hs)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (mk α = mk ↥(tᶜ))) (mk_compl_of_omega_le t h ht))) (Eq.refl (mk α)))

theorem mk_compl_eq_mk_compl_finite_lift {α : Type u} {β : Type v} {s : set α} {t : set β} (hα : mk α < omega) (h1 : lift (mk α) = lift (mk β)) (h2 : lift (mk ↥s) = lift (mk ↥t)) : lift (mk ↥(sᶜ)) = lift (mk ↥(tᶜ)) := sorry

theorem mk_compl_eq_mk_compl_finite {α : Type u} {β : Type u} {s : set α} {t : set β} (hα : mk α < omega) (h1 : mk α = mk β) (h : mk ↥s = mk ↥t) : mk ↥(sᶜ) = mk ↥(tᶜ) := sorry

theorem mk_compl_eq_mk_compl_finite_same {α : Type u_1} {s : set α} {t : set α} (hα : mk α < omega) (h : mk ↥s = mk ↥t) : mk ↥(sᶜ) = mk ↥(tᶜ) :=
  mk_compl_eq_mk_compl_finite hα rfl h

/-! ### Extending an injection to an equiv -/

theorem extend_function {α : Type u_1} {β : Type u_2} {s : set α} (f : ↥s ↪ β) (h : Nonempty (↥(sᶜ) ≃ ↥(set.range ⇑fᶜ))) : ∃ (g : α ≃ β), ∀ (x : ↥s), coe_fn g ↑x = coe_fn f x := sorry

theorem extend_function_finite {α : Type u_1} {β : Type u_2} {s : set α} (f : ↥s ↪ β) (hs : mk α < omega) (h : Nonempty (α ≃ β)) : ∃ (g : α ≃ β), ∀ (x : ↥s), coe_fn g ↑x = coe_fn f x := sorry

theorem extend_function_of_lt {α : Type u_1} {β : Type u_2} {s : set α} (f : ↥s ↪ β) (hs : mk ↥s < mk α) (h : Nonempty (α ≃ β)) : ∃ (g : α ≃ β), ∀ (x : ↥s), coe_fn g ↑x = coe_fn f x := sorry

/-!
This section proves inequalities for `bit0` and `bit1`, enabling `simp` to solve inequalities
for numeral cardinals. The complexity of the resulting algorithm is not good, as in some cases
`simp` reduces an inequality to a disjunction of two situations, depending on whether a cardinal
is finite or infinite. Since the evaluation of the branches is not lazy, this is bad. It is good
enough for practical situations, though.

For specific numbers, these inequalities could also be deduced from the corresponding
inequalities of natural numbers using `norm_cast`:
```
example : (37 : cardinal) < 42 :=
by { norm_cast, norm_num }
```
-/

@[simp] theorem bit0_ne_zero (a : cardinal) : ¬bit0 a = 0 ↔ ¬a = 0 := sorry

@[simp] theorem bit1_ne_zero (a : cardinal) : ¬bit1 a = 0 := sorry

@[simp] theorem zero_lt_bit0 (a : cardinal) : 0 < bit0 a ↔ 0 < a := sorry

@[simp] theorem zero_lt_bit1 (a : cardinal) : 0 < bit1 a :=
  lt_of_lt_of_le zero_lt_one (self_le_add_left 1 (bit0 a))

@[simp] theorem one_le_bit0 (a : cardinal) : 1 ≤ bit0 a ↔ 0 < a :=
  { mp := fun (h : 1 ≤ bit0 a) => iff.mp (zero_lt_bit0 a) (lt_of_lt_of_le zero_lt_one h),
    mpr := fun (h : 0 < a) => le_trans (iff.mpr one_le_iff_pos h) (self_le_add_left a a) }

@[simp] theorem one_le_bit1 (a : cardinal) : 1 ≤ bit1 a :=
  self_le_add_left 1 (bit0 a)

theorem bit0_eq_self {c : cardinal} (h : omega ≤ c) : bit0 c = c :=
  add_eq_self h

@[simp] theorem bit0_lt_omega {c : cardinal} : bit0 c < omega ↔ c < omega := sorry

@[simp] theorem omega_le_bit0 {c : cardinal} : omega ≤ bit0 c ↔ omega ≤ c := sorry

@[simp] theorem bit1_eq_self_iff {c : cardinal} : bit1 c = c ↔ omega ≤ c := sorry

@[simp] theorem bit1_lt_omega {c : cardinal} : bit1 c < omega ↔ c < omega := sorry

@[simp] theorem omega_le_bit1 {c : cardinal} : omega ≤ bit1 c ↔ omega ≤ c := sorry

@[simp] theorem bit0_le_bit0 {a : cardinal} {b : cardinal} : bit0 a ≤ bit0 b ↔ a ≤ b := sorry

@[simp] theorem bit0_le_bit1 {a : cardinal} {b : cardinal} : bit0 a ≤ bit1 b ↔ a ≤ b := sorry

@[simp] theorem bit1_le_bit1 {a : cardinal} {b : cardinal} : bit1 a ≤ bit1 b ↔ a ≤ b :=
  { mp := fun (h : bit1 a ≤ bit1 b) => iff.mp bit0_le_bit1 (le_trans (self_le_add_right (bit0 a) 1) h),
    mpr :=
      fun (h : a ≤ b) => le_trans (add_le_add_right (add_le_add_left h a) 1) (add_le_add_right (add_le_add_right h b) 1) }

@[simp] theorem bit1_le_bit0 {a : cardinal} {b : cardinal} : bit1 a ≤ bit0 b ↔ a < b ∨ a ≤ b ∧ omega ≤ a := sorry

@[simp] theorem bit0_lt_bit0 {a : cardinal} {b : cardinal} : bit0 a < bit0 b ↔ a < b := sorry

@[simp] theorem bit1_lt_bit0 {a : cardinal} {b : cardinal} : bit1 a < bit0 b ↔ a < b := sorry

@[simp] theorem bit1_lt_bit1 {a : cardinal} {b : cardinal} : bit1 a < bit1 b ↔ a < b := sorry

@[simp] theorem bit0_lt_bit1 {a : cardinal} {b : cardinal} : bit0 a < bit1 b ↔ a < b ∨ a ≤ b ∧ a < omega := sorry

-- This strategy works generally to prove inequalities between numerals in `cardinality`.

theorem one_lt_two : 1 < bit0 1 := sorry

@[simp] theorem one_lt_bit0 {a : cardinal} : 1 < bit0 a ↔ 0 < a := sorry

@[simp] theorem one_lt_bit1 (a : cardinal) : 1 < bit1 a ↔ 0 < a := sorry

@[simp] theorem one_le_one : 1 ≤ 1 :=
  le_refl 1