import ch3

universe u

namespace Set

def succ (a : Set) : Set := {a} ∪ a

@[simp]
lemma mem_succ {a b : Set} : b ∈ a.succ ↔ b = a ∨ b ∈ a :=
by rw [succ, mem_union, mem_singleton]

@[simp]
lemma insert_eq {x y : Set} : insert x y = {x} ∪ y :=
by simp only [←ext_iff, mem_insert, mem_union, mem_singleton, forall_const, iff_self]

@[simp]
lemma succ_eq_insert {a : Set} : a.succ = insert a a := by simp only [succ, insert_eq]

structure induct (A : Set) : Prop :=
(zero : ∅ ∈ A)
(succ_closed : ∀ ⦃a : Set⦄, a ∈ A → a.succ ∈ A)

-- Set.omega is the inductive set defined in mathlib
-- Set.omega_zero and Set.omega_succ says that it's inductive

theorem induct_omega : omega.induct :=
begin
  refine ⟨omega_zero, (λ a ha, _)⟩, simp only [succ_eq_insert, omega_succ ha],
end

-- The infinity axiom
theorem exists_inductive : ∃ A : Set, A.induct := ⟨_, induct_omega⟩

def is_nat (n : Set) : Prop := ∀ ⦃A : Set⦄, A.induct → n ∈ A

def nat : Set := {n ∈ omega | n.is_nat}

notation `ω` := nat

@[simp]
theorem mem_nat {n : Set} : n ∈ ω ↔ n.is_nat :=
begin
  simp only [nat, mem_sep, and_iff_right_iff_imp],
  intro hn, exact hn induct_omega,
end

-- theorem 4B part 1
theorem nat_induct : nat.induct :=
begin
  refine ⟨_, _⟩,
  { rw mem_nat, exact (λ A hA, hA.zero), },
  { intros a ha, rw mem_nat at ha, rw mem_nat,
    intros A hA, exact hA.succ_closed (ha hA), },
end

lemma succ_nat_is_nat {n : Set} (nω : n ∈ ω) : n.succ ∈ ω :=
nat_induct.succ_closed nω

def one : Set := (∅ : Set).succ
def two : Set := one.succ
def three : Set := two.succ
def four : Set := three.succ

lemma zero_nat : ∅ ∈ ω := nat_induct.zero
lemma one_nat : one ∈ ω := nat_induct.succ_closed zero_nat
lemma two_nat : two ∈ ω := nat_induct.succ_closed one_nat
lemma three_nat : three ∈ ω := nat_induct.succ_closed two_nat
lemma four_nat : four ∈ ω := nat_induct.succ_closed three_nat

-- theorem 4B part 2
theorem nat_subset_induct {A : Set} (hA : A.induct) : ω ⊆ A := (λ a ha, mem_nat.mp ha hA)

-- induction principle
theorem eq_nat_of_induct_sub {A : Set} (ha : A.induct) (hs : A ⊆ ω) : A = ω :=
eq_iff_subset_and_subset.mpr ⟨hs, nat_subset_induct ha⟩

lemma induction {p : Set → Prop} (hz : p ∅) (hi : ∀ {a : Set}, a ∈ ω → p a → p a.succ) : ∀ {n : Set}, n ∈ ω → p n :=
begin
  let T : Set := {n ∈ ω | p n},
  have he : T = ω, refine eq_nat_of_induct_sub ⟨_, _⟩ sep_subset,
    { simp only [hz, mem_sep, and_true, nat_induct.zero], },
    { simp only [mem_sep], rintros a ⟨ha, hp⟩, exact ⟨nat_induct.succ_closed ha, hi ha hp⟩, },
  intros n hn, rw [←he, mem_sep] at hn, finish,
end

-- Theorem 4C
theorem exists_pred {n : Set} (h : n ∈ ω) : n = ∅ ∨ ∃ p : Set, p ∈ ω ∧ n = p.succ :=
begin
  refine induction _ _ h,
  { exact or.inl rfl, },
  { intros a ha hp, exact or.inr ⟨_, ha, rfl⟩, },
end

theorem exists_pred_of_ne_zero {n : Set} (hn : n ∈ ω) (hnz : n ≠ ∅) : ∃ p : Set, p ∈ ω ∧ n = p.succ :=
begin
  cases exists_pred hn,
  { contradiction, },
  { assumption, },
end

theorem succ_neq_empty {n : Set} : n.succ ≠ ∅ :=
begin
  intro he, apply mem_empty n,
  simp only [←he, mem_union, succ_eq_insert, insert_eq, true_or, eq_self_iff_true, mem_singleton],
end

def transitive_set (A : Set) : Prop := A.Union ⊆ A

lemma transitive_set_iff {A : Set} : A.transitive_set ↔ ∀ {x : Set}, x ∈ A → ∀ {y : Set}, y ∈ x → y ∈ A :=
begin
  simp only [transitive_set, subset_def, mem_Union, exists_prop], split,
    intros h x xA y yx, exact h ⟨_, xA, yx⟩,
  rintros h y ⟨x, xA, yx⟩, exact h xA yx,
end

lemma transitive_set_iff' {A : Set} : A.transitive_set ↔ ∀ {x : Set}, x ∈ A → x ⊆ A :=
begin
  simp only [subset_def, transitive_set_iff],
end

theorem T4E {A : Set} (ht : transitive_set A) : A.succ.Union = A :=
begin
  rw [succ, p21, Union_singleton], apply ext, intro z,
  replace ht : z ∈ A.Union → z ∈ A := (λ h, ht h),
  simp only [mem_union, or_iff_left_iff_imp], assumption,
end

-- exercise 3
lemma powerset_transitive {A : Set} (Atrans : A.transitive_set) : A.powerset.transitive_set :=
begin
  rw transitive_set_iff' at *, intros X XA z zX, rw mem_powerset at *, apply Atrans,
  apply XA, exact zX,
end

-- T4F
theorem nat_transitive {n : Set} (hn : n ∈ ω) : n.transitive_set :=
begin
  refine induction _ _ hn,
  { intro x, simp only [mem_Union, mem_empty, forall_prop_of_false, exists_false, not_false_iff, exists_prop_of_false], },
  { intros a ha hp, rw [transitive_set, T4E hp, succ], intros x hx, rw [mem_union, mem_singleton], finish, },
end

theorem succ_inj {n m : Set} (hn : n ∈ ω) (hm : m ∈ ω) (he : n.succ = m.succ) : n = m :=
begin
  rw [←T4E (nat_transitive hn), ←T4E (nat_transitive hm), he],
end

structure Peano_sys :=
(N S e : Set)
(hf : S.into_fun N N)
(he : e ∈ N)
(hi : e ∉ S.ran)
(hii : S.one_to_one)
(hiii : ∀ A : Set, A ⊆ N → e ∈ A → S.img A ⊆ A → A = N)

def succ_fun : Set := pair_sep (λ x y, y = x.succ) ω ω

lemma succ_fun_into_fun : succ_fun.into_fun ω ω :=
begin
  have hd : succ_fun.dom = ω, apply ext, intro x,
    simp only [ext_iff, mem_dom, succ_fun, mem_pair_sep, exists_prop], split,
    { rintro ⟨y, a, ha, b, -, he, -⟩, rw (pair_inj he).left, assumption, },
    { intro hx, exact ⟨_, _, hx, _, nat_induct.succ_closed hx, rfl, rfl⟩, },
  refine ⟨⟨pair_sep_is_rel, _⟩, hd, _⟩,
  { rw hd, intros x hx, refine ⟨x.succ, _, _⟩,
    { simp only [succ_fun, mem_pair_sep, exists_prop], exact ⟨_, hx, _, nat_induct.succ_closed hx, rfl, rfl⟩, },
    { intros y hy, simp only [succ_fun, mem_pair_sep, exists_prop] at hy,
      rcases hy with ⟨a, ha, b, hb, hp, he⟩, rw [(pair_inj hp).left, (pair_inj hp).right], assumption, }, },
  { intros y hy, simp only [mem_ran, succ_fun, mem_pair_sep, exists_prop] at hy,
    rcases hy with ⟨x, a, ha, b, hb, hp, he⟩, rw (pair_inj hp).right, assumption, },
end

lemma succ_fun_value {n : Set} (hn : n ∈ ω) : n.succ = succ_fun.fun_value n :=
begin
  apply fun_value_def (is_function_of_into succ_fun_into_fun),
  simp only [succ_fun, mem_pair_sep, exists_prop],
  exact ⟨_, hn, _, nat_induct.succ_closed hn, rfl, rfl⟩,
end

lemma succ_not_onto : ∅ ∉ succ_fun.ran :=
begin
  intro hm, rw [mem_ran] at hm, rcases hm with ⟨x, hx⟩,
  have h : ∅ = succ_fun.fun_value x := fun_value_def (is_function_of_into succ_fun_into_fun) hx,
  rw ←succ_fun_value at h, exact succ_neq_empty h.symm,
  rw ←(dom_eq_of_into succ_fun_into_fun), rw mem_dom, exact ⟨_, hx⟩,
end

lemma succ_one_to_one : succ_fun.one_to_one :=
begin
  have hf : succ_fun.is_function := is_function_of_into succ_fun_into_fun,
  have hd : succ_fun.dom = ω := dom_eq_of_into succ_fun_into_fun,
  intros y hx, simp only [mem_ran] at hx, rcases hx with ⟨x, hx⟩, refine ⟨_, hx, _⟩,
  intros x' hx',
  have hhx : y = succ_fun.fun_value x := fun_value_def hf hx,
  have hhx' : y = succ_fun.fun_value x' := fun_value_def hf hx',
  rw hhx' at hhx, apply succ_inj,
  rw ←hd, rw mem_dom, exact ⟨_, hx'⟩,
  rw ←hd, rw mem_dom, exact ⟨_, hx⟩,
  rw succ_fun_value, rw succ_fun_value, assumption,
  rw ←hd, rw mem_dom, exact ⟨_, hx⟩,
  rw ←hd, rw mem_dom, exact ⟨_, hx'⟩,
end

lemma succ_fun_ran : succ_fun.ran = ω \ {∅} :=
begin
  apply ext, simp only [mem_ran_iff succ_fun_into_fun.left, succ_fun_into_fun.right.left, mem_diff, mem_singleton], intros y, split,
    rintro ⟨n, hn, hy⟩, rw ←succ_fun_value hn at hy, subst hy, exact ⟨nat_induct.succ_closed hn, succ_neq_empty⟩,
  rintro ⟨hy, hyne⟩,
  obtain ⟨x, hx, hxy⟩ := exists_pred_of_ne_zero hy hyne,
  refine ⟨_, hx, _⟩, subst hxy, rw succ_fun_value hx,
end

-- Theorem 4D
theorem exists_Peano_sys : Peano_sys :=
begin
  have hf : succ_fun.is_function := is_function_of_into succ_fun_into_fun,
  have hd : succ_fun.dom = ω := dom_eq_of_into succ_fun_into_fun,
  refine ⟨ω, succ_fun, ∅, succ_fun_into_fun, nat_induct.zero, succ_not_onto, succ_one_to_one, _⟩,
  { intros A hA hem hcl, refine eq_nat_of_induct_sub ⟨hem, _⟩ hA,
    intros a ha, apply hcl, rw mem_img, refine ⟨_, ha, _⟩, apply fun_value_def''' hf,
      rw dom_eq_of_into succ_fun_into_fun, apply hA, exact ha,
    exact succ_fun_value (hA ha), },
end

theorem nat_transitive_set : (ω : Set).transitive_set :=
begin
  suffices h : ∀ n ∈ ω, n ⊆ ω,
    intro X, simp only [mem_Union, exists_prop], rintros ⟨x, hx, hX⟩,
    apply h _ hx hX,
  intros n hn, refine @induction (λ x, x ⊆ ω) (λ x hx, _) _ _ hn,
  { exfalso, exact mem_empty _ hx, },
  { intros a ha hp, intro z, simp only [succ, mem_union, mem_singleton],
    rintro (h|h),
    { rw h, finish, },
    { exact hp h, }, },
end

structure acceptable (A a F v : Set) : Prop :=
(hf : v.is_function)
(hd : v.dom ⊆ ω)
(hr : v.ran ⊆ A)
(hi : ∅ ∈ v.dom → v.fun_value ∅ = a)
(hii : ∀ {n : Set}, n ∈ ω → n.succ ∈ v.dom → n ∈ v.dom ∧ v.fun_value n.succ = F.fun_value (v.fun_value n))

-- The domain is nat.
-- The range is a subset of A.
-- rec_fun (0) = a.
-- rec_fun (succ(n)) = F(rec_fun(n)).
-- so F : A → A
def rec_fun (A a F : Set) : Set :=
{v ∈ ((ω : Set).prod A).powerset | A.acceptable a F v}.Union

@[simp]
lemma mem_rec_fun {A a F p : Set} : p ∈ A.rec_fun a F ↔ ∃ v : Set, A.acceptable a F v ∧ p ∈ v :=
begin
  simp only [rec_fun, mem_Union, exists_prop, mem_sep, mem_powerset, and_assoc], split,
  { rintro ⟨v, hs, ha⟩, exact ⟨_, ha⟩, },
  { rintro ⟨v, ha, hm⟩, refine ⟨_, _, ha, hm⟩, intros q hq, simp only [mem_prod, exists_prop],
    have h : ∃ x y : Set, q = x.pair y := ha.hf.left _ hq,
    rcases h with ⟨x, y, hq⟩, refine ⟨_, _, _, _, hq⟩,
    { apply ha.hd, rw mem_dom, existsi y, rw ←hq, assumption, },
    { apply ha.hr, rw mem_ran, existsi x, rw ←hq, assumption, }, },
end

lemma rec_fun_rel {A a F : Set} (ha : a ∈ A) : (A.rec_fun a F).is_rel :=
begin
  intros p hp, rw mem_rec_fun at hp, rcases hp with ⟨v, ha, hp⟩, exact ha.hf.left _ hp,
end

lemma rec_fun_dom {A a F : Set} : (A.rec_fun a F).dom ⊆ ω :=
begin
  intros x hx, simp only [mem_dom, mem_rec_fun] at hx,
  rcases hx with ⟨y, v, ha, hx⟩, apply ha.hd, rw mem_dom, exact ⟨_, hx⟩,
end

@[simp]
lemma pair_mem_rec_fun {A a F x y : Set} : x.pair y ∈ A.rec_fun a F ↔ ∃ v : Set, A.acceptable a F v ∧ x.pair y ∈ v :=
begin
  simp only [mem_rec_fun],
end

lemma rec_fun_is_fun {A a F : Set} (ha : a ∈ A) : (A.rec_fun a F).is_function :=
begin
  refine ⟨_, _⟩,
  { exact rec_fun_rel ha, },
  { have hi : ∀ x : Set, x.mem (ω : Set) → ∀ y y' : Set, x.pair y ∈ (A.rec_fun a F) → x.pair y' ∈ (A.rec_fun a F) → y = y',
      intro x, refine @induction _ _ _ x, intros y y' hy hy',
      { simp only [pair_mem_rec_fun] at hy hy',
        rcases hy with ⟨v, hv, hy⟩,
        rcases hy' with ⟨v', hv', hy'⟩,
        have hd : ∅ ∈ v.dom, rw mem_dom, exact ⟨_, hy⟩,
        have hd' : ∅ ∈ v'.dom, rw mem_dom, exact ⟨_, hy'⟩,
        rw [fun_value_def hv.hf hy, fun_value_def hv'.hf hy', hv.hi hd, hv'.hi hd'], },
      { intros x hx hi y y' hy hy', simp only [pair_mem_rec_fun] at hy hy',
        rcases hy with ⟨v, hv, hy⟩,
        rcases hy' with ⟨v', hv', hy'⟩,
        have hd : x.succ ∈ v.dom, rw mem_dom, exact ⟨_, hy⟩,
        have hd' : x.succ ∈ v'.dom, rw mem_dom, exact ⟨_, hy'⟩,
        rw [fun_value_def hv.hf hy, fun_value_def hv'.hf hy', (hv.hii hx hd).right, (hv'.hii hx hd').right],
        have h : v.fun_value x = v'.fun_value x, apply hi,
          rw pair_mem_rec_fun, refine ⟨_, hv, fun_value_def' hv.hf (hv.hii hx hd).left⟩,
          rw pair_mem_rec_fun, refine ⟨_, hv', fun_value_def' hv'.hf (hv'.hii hx hd').left⟩,
        rw h, },
    intros x hx, refine exists_unique_of_exists_of_unique _ (hi x (rec_fun_dom hx)),
    rw mem_dom at hx, exact hx,
  },
end

lemma rec_fun_ran {A a F : Set} : (A.rec_fun a F).ran ⊆ A :=
begin
  intros y hy, simp only [mem_ran, pair_mem_rec_fun] at hy, rcases hy with ⟨x, v, hv, hy⟩,
  apply hv.hr, rw mem_ran, exact ⟨_, hy⟩,
end

lemma rec_fun_acceptable {A a F : Set} (ha : a ∈ A) : A.acceptable a F (A.rec_fun a F) :=
begin
  refine ⟨rec_fun_is_fun ha, rec_fun_dom, rec_fun_ran, _, _⟩,
  { intro h, simp only [mem_dom, pair_mem_rec_fun] at h, rcases h with ⟨y, v, hv, hy⟩,
    suffices h : (A.rec_fun a F).fun_value ∅ = v.fun_value ∅,
      rw h, refine hv.hi _, rw mem_dom, exact ⟨_, hy⟩,
    symmetry, refine fun_value_def (rec_fun_is_fun ha) _,
    rw pair_mem_rec_fun, refine ⟨_, hv, _⟩, refine fun_value_def' hv.hf _,
    rw mem_dom, exact ⟨_, hy⟩, },
  { intros x hx hd, simp only [mem_dom, pair_mem_rec_fun] at hd, rcases hd with ⟨y, v, hv, hy⟩,
    suffices h : (A.rec_fun a F).fun_value x.succ = v.fun_value x.succ,
      have hd : x ∈ v.dom, refine (hv.hii hx _).left, rw mem_dom, exact ⟨_, hy⟩,
      have hy' : x.succ ∈ v.dom, rw mem_dom, exact ⟨_, hy⟩,
      rw [h, (hv.hii hx hy').right],
      suffices h' : v.fun_value x = (A.rec_fun a F).fun_value x,
        rw h', refine ⟨_, rfl⟩, simp only [mem_dom, pair_mem_rec_fun], rw mem_dom at hd, rcases hd with ⟨y', hy''⟩,
        exact ⟨_, _, hv, hy''⟩,
      refine fun_value_def (rec_fun_is_fun ha) _, rw pair_mem_rec_fun,
      refine ⟨_, hv, _⟩, refine fun_value_def' hv.hf _, assumption,
    symmetry, refine fun_value_def (rec_fun_is_fun ha) _, rw pair_mem_rec_fun,
    refine ⟨_, hv, _⟩, refine fun_value_def' hv.hf _, rw mem_dom, exact ⟨_, hy⟩, },
end

lemma rec_fun_dom_eq_nat {A a F : Set} (ha : a ∈ A) (hF : F.into_fun A A) : (A.rec_fun a F).dom = ω :=
begin
  have hb : ∃ v : Set, A.acceptable a F v ∧ (∅ : Set).pair a ∈ v,
    refine ⟨{(∅ : Set).pair a}, _, mem_singleton.mpr rfl⟩,
    have hf : Set.is_function {(∅ : Set).pair a},
      simp only [is_function_iff, is_rel, mem_singleton], refine ⟨(λ p hp, ⟨_, _, by rw hp⟩), _⟩,
      intros x y y' he he', rw ←he' at he, exact (pair_inj he).right,
    split,
    { exact hf, },
    { intros x hx, simp only [mem_dom, mem_singleton] at hx, rcases hx with ⟨y, he⟩,
      rw (pair_inj he).left, exact nat_induct.zero, },
    { intros y hy, simp only [mem_ran, mem_singleton] at hy, rcases hy with ⟨x, he⟩,
      rw (pair_inj he).right, assumption, },
    { intro h, symmetry, refine fun_value_def hf _, rw mem_singleton, },
    { intros n hn hd, simp only [mem_dom, mem_singleton] at hd, rcases hd with ⟨y, hy⟩,
      exfalso, exact succ_neq_empty (pair_inj hy).left, },
  refine eq_nat_of_induct_sub _ rec_fun_dom, refine ⟨_, _⟩,
  { simp only [mem_dom, pair_mem_rec_fun], exact ⟨a, hb⟩, },
  { intros k hk,
    let h := A.rec_fun a F,
    let v := h ∪ {k.succ.pair (F.fun_value (h.fun_value k))},
    by_cases hc : k.succ ∈ h.dom,
      assumption,
    have hf : v.is_function, rw is_function_iff, split,
      { intros p hp, simp only [mem_union, mem_singleton] at hp, cases hp,
        { exact rec_fun_rel ha _ hp, },
        { exact ⟨_, _, hp⟩, }, },
      { simp only [mem_union, mem_singleton],
        rintros x y y' (hh|he) (hh'|he'),
        { rw [fun_value_def (rec_fun_is_fun ha) hh, fun_value_def (rec_fun_is_fun ha) hh'], },
        { rw [(pair_inj he').right, fun_value_def (rec_fun_is_fun ha) hh, (pair_inj he').left],
          have h : h.fun_value k.succ = F.fun_value (h.fun_value k),
            refine ((rec_fun_acceptable ha).hii _ _).right,
            { exact (rec_fun_acceptable ha).hd hk, },
            { simp only [←(pair_inj he').left, mem_dom], exact ⟨_, hh⟩, },
          rw h, },
        { rw [(pair_inj he).right, fun_value_def (rec_fun_is_fun ha) hh', (pair_inj he).left],
          have h : h.fun_value k.succ = F.fun_value (h.fun_value k),
            refine ((rec_fun_acceptable ha).hii _ _).right,
            { exact (rec_fun_acceptable ha).hd hk, },
            { simp only [←(pair_inj he).left, mem_dom], exact ⟨_, hh'⟩, },
          rw h, },
        { rw [(pair_inj he).right, (pair_inj he').right], }, },
    have hd : v.dom ⊆ ω, intros x hx,
      simp only [mem_dom, mem_union, mem_singleton] at hx,
      rcases hx with ⟨y, hx|hx⟩,
      { apply (rec_fun_acceptable ha).hd, rw mem_dom, exact ⟨_, hx⟩, },
      { rw (pair_inj hx).left, exact nat_induct.succ_closed ((rec_fun_acceptable ha).hd hk), },
    have hr : v.ran ⊆ A, refine (λ y hy, _),
      simp only [mem_ran, mem_union, mem_singleton] at hy, rcases hy with ⟨x, hy|hy⟩,
      { apply (rec_fun_acceptable ha).hr, rw mem_ran, exact ⟨_, hy⟩, },
      { rw (pair_inj hy).right, apply ran_sub_of_into hF,
        refine fun_value_def'' (is_function_of_into hF) _,
        rw dom_eq_of_into hF, apply (rec_fun_acceptable ha).hr,
        refine fun_value_def'' (rec_fun_acceptable ha).hf _, assumption, },
    have hva : A.acceptable a F v, refine ⟨hf, hd, hr, _, _⟩,
      { intro hz, symmetry, apply fun_value_def hf, rw [mem_union, mem_singleton, pair_mem_rec_fun],
        exact or.inl hb, },
      { intros n hn hdn, by_cases he : n.succ = k.succ,
        { have he' : n = k, exact succ_inj hn ((rec_fun_acceptable ha).hd hk) he,
          simp only [mem_dom, mem_union], refine ⟨⟨h.fun_value n, or.inl _⟩, _⟩,
          { apply fun_value_def' (rec_fun_acceptable ha).hf, rw he', assumption, },
          { rw he', symmetry, apply fun_value_def hf, rw mem_union, right,
            rw mem_singleton,
            suffices he'' : v.fun_value k = h.fun_value k, rw he'',
            symmetry, apply fun_value_def hf, rw mem_union, left,
            apply fun_value_def' (rec_fun_acceptable ha).hf, assumption, }, },
        { have hsn : n.succ ∈ h.dom, simp only [mem_dom, mem_union, mem_singleton] at hdn, rw mem_dom,
            rcases hdn with ⟨y, hy|hy⟩,
            { exact ⟨_, hy⟩, },
            { exfalso, exact he (pair_inj hy).left, },
          have hsn' : n ∈ v.dom, simp only [mem_dom, mem_union],
            suffices h : n ∈ h.dom, rw mem_dom at h, rcases h with ⟨y, hy⟩,
              exact ⟨_, or.inl hy⟩,
            exact ((rec_fun_acceptable ha).hii hn hsn).left,
          refine ⟨hsn', _⟩,
          have he' : v.fun_value n.succ = h.fun_value n.succ,
            symmetry, apply fun_value_def hf, rw mem_union, left,
            apply fun_value_def' (rec_fun_acceptable ha).hf, exact hsn,
          rw he', rw ((rec_fun_acceptable ha).hii hn hsn).right,
          have he'' : v.fun_value n = h.fun_value n,
            symmetry, apply fun_value_def hf, rw mem_union, left,
            apply fun_value_def' (rec_fun_acceptable ha).hf,
            exact ((rec_fun_acceptable ha).hii hn hsn).left,
          rw he'', }, },
    simp only [mem_dom, pair_mem_rec_fun], refine ⟨F.fun_value (h.fun_value k), _, hva, _⟩,
    simp only [mem_union, mem_singleton], right, refl, },
end

lemma rec_fun_into_fun {A a F : Set} (ha : a ∈ A) (hF : F.into_fun A A) : (A.rec_fun a F).into_fun ω A :=
⟨rec_fun_is_fun ha, rec_fun_dom_eq_nat ha hF, rec_fun_ran⟩

-- lemma rec_fun_unique {A a F : Set} : ∃! h : Set, h.fun_value ∅ = a
-- ∧ ∀ n : Set, n ∈ ω → h.fun_value n.succ = F.fun_value (h.fun_value n) :=
-- begin
-- end

theorem recursion_thm {A a F : Set} (ha : a ∈ A) (hF : F.into_fun A A) :
(A.rec_fun a F).fun_value ∅ = a
∧ ∀ n : Set, n ∈ ω → (A.rec_fun a F).fun_value n.succ = F.fun_value ((A.rec_fun a F).fun_value n) :=
begin
  split,
  { apply (rec_fun_acceptable ha).hi, rw rec_fun_dom_eq_nat ha hF, exact nat_induct.zero, },
  { intros n hn, apply ((rec_fun_acceptable ha).hii hn _).right,
    rw rec_fun_dom_eq_nat ha hF, exact nat_induct.succ_closed hn, },
end

def Piso (P : Peano_sys) : Set := P.N.rec_fun P.e P.S

-- Theorem 4H
theorem peano_isomorphic {P : Peano_sys} :
(Piso P).onto_fun ω P.N
∧ (Piso P).one_to_one
∧ (Piso P).fun_value ∅ = P.e
∧ ∀ n : Set, n ∈ ω → (Piso P).fun_value (succ_fun.fun_value n) = P.S.fun_value ((Piso P).fun_value n) :=
begin
  refine ⟨_, _, _, _⟩,
  { apply onto_of_into,
    { exact rec_fun_into_fun P.he P.hf, },
    { apply P.hiii _ rec_fun_ran,
      { change P.e ∈ (Piso P).ran, rw ←(recursion_thm P.he P.hf).left,
        change (Piso P).fun_value ∅ ∈ (Piso P).ran, apply fun_value_def'' (rec_fun_is_fun P.he),
        rw rec_fun_dom_eq_nat P.he P.hf, exact nat_induct.zero, },
      { intros y hy, simp only [mem_img, mem_ran] at hy, rcases hy with ⟨m, ⟨n, hh⟩, hS⟩,
        rw fun_value_def (is_function_of_into P.hf) hS,
        rw fun_value_def (rec_fun_is_fun P.he) hh,
        have hn : n.mem ω, rw ←rec_fun_dom_eq_nat P.he P.hf, change n ∈ (Piso P).dom, rw mem_dom, exact ⟨_, hh⟩,
        rw ←(recursion_thm P.he P.hf).right _ hn, apply fun_value_def'' (rec_fun_is_fun P.he),
        rw rec_fun_dom_eq_nat P.he P.hf, apply nat_induct.succ_closed hn, }, }, },
  { apply one_to_one_of (rec_fun_is_fun P.he), rw rec_fun_dom_eq_nat P.he P.hf,
    intros m hm, refine induction _ _ hm,
    { intros n hn hne,
      rcases exists_pred_of_ne_zero hn hne.symm with ⟨p, hp, he⟩,
      rw [(recursion_thm P.he P.hf).left, he, (recursion_thm P.he P.hf).right _ hp],
      intro he', apply P.hi, rw he', apply fun_value_def'' (is_function_of_into P.hf),
      rw dom_eq_of_into P.hf, apply @rec_fun_ran _ P.e P.S, apply fun_value_def'' (rec_fun_is_fun P.he),
      rw rec_fun_dom_eq_nat P.he P.hf, assumption, },
    { intros k hk hi n hn hne he,
      have h : n ≠ ∅, intro he', rw [he', (recursion_thm P.he P.hf).left, (recursion_thm P.he P.hf).right] at he,
        apply P.hi, rw ←he, apply fun_value_def'' (is_function_of_into P.hf),
        rw dom_eq_of_into P.hf, apply @rec_fun_ran _ P.e P.S, apply fun_value_def'' (rec_fun_is_fun P.he),
        rw rec_fun_dom_eq_nat P.he P.hf, assumption, assumption,
      rcases exists_pred_of_ne_zero hn h with ⟨p, hp, he'⟩, subst he', apply hne,
      rw [(recursion_thm P.he P.hf).right _ hk, (recursion_thm P.he P.hf).right _ hp] at he,
      have he' : k = p, apply classical.by_contradiction, intro hne', apply hi hp, assumption,
        apply from_one_to_one (is_function_of_into P.hf) P.hii,
        { rw dom_eq_of_into P.hf, apply rec_fun_ran, apply fun_value_def'' (rec_fun_is_fun P.he),
          rw rec_fun_dom_eq_nat P.he P.hf, assumption, },
        { rw dom_eq_of_into P.hf, apply rec_fun_ran, apply fun_value_def'' (rec_fun_is_fun P.he),
          rw rec_fun_dom_eq_nat P.he P.hf, assumption, },
        { assumption, },
      rw he', }, },
  { exact (recursion_thm P.he P.hf).left, },
  { intros n hn, rw ←succ_fun_value hn, exact (recursion_thm P.he P.hf).right _ hn, },
end

def pre_add (m : Set) : Set := (ω : Set).rec_fun m succ_fun
def add : Set := pair_sep_eq ((ω : Set).prod ω) ω (λ a, (pre_add a.fst).fun_value a.snd)
instance : has_add Set := ⟨λ m n, add.fun_value (m.pair n)⟩

lemma add_eq {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m + n = (pre_add m).fun_value n :=
begin
  let f : Set → Set := λ p, (pre_add p.fst).fun_value p.snd,
  have hf : f (m.pair n) = (pre_add m).fun_value n, simp only [f], rw [fst_congr, snd_congr],
  change add.fun_value (m.pair n) = (pre_add m).fun_value n, rw ←hf, apply pair_sep_eq_fun_value,
  have hd : add.dom = ((ω : Set).prod ω), apply pair_sep_eq_dom_eq, intros a ha, apply rec_fun_ran,
    apply fun_value_def'',
    { apply rec_fun_is_fun, exact (fst_snd_mem_dom_ran ha).left, },
    { rw [pre_add, rec_fun_dom_eq_nat],
      { exact (fst_snd_mem_dom_ran ha).right, },
      { exact (fst_snd_mem_dom_ran ha).left, },
      { exact succ_fun_into_fun, }, },
  rw [←add, hd, pair_mem_prod], exact ⟨hm, hn⟩,
end

-- Theorem 4I part A1
theorem add_base {m : Set} (hm : m ∈ ω) : m + ∅ = m :=
begin
  rw add_eq hm nat_induct.zero, exact (recursion_thm hm succ_fun_into_fun).left,
end
-- Theorem 4I part A2
theorem add_ind {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m + n.succ = (m + n).succ :=
begin
  rw [add_eq hm (nat_induct.succ_closed hn), add_eq hm hn], rw [pre_add, (recursion_thm hm succ_fun_into_fun).right _ hn],
  symmetry, refine succ_fun_value _, apply rec_fun_ran, apply fun_value_def'' (rec_fun_is_fun hm),
  rw rec_fun_dom_eq_nat hm succ_fun_into_fun, exact hn,
end

theorem add_into_nat {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m + n ∈ ω :=
begin
  revert n, apply induction,
  { rw add_base hm, exact hm, },
  { intros n hn hi, rw [add_ind hm hn], exact nat_induct.succ_closed hi, },
end

-- Theorem 4K
theorem add_assoc {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) {p : Set} (hp : p ∈ ω) : m + (n + p) = (m + n) + p :=
begin
  revert p, apply induction,
  { rw [add_base hn, add_base], exact add_into_nat hm hn, },
  { intros p hp hi, rw [add_ind hn hp, add_ind hm (add_into_nat hn hp), hi, add_ind (add_into_nat hm hn) hp], },
end

theorem zero_add {n : Set} (hn : n ∈ ω) : ∅ + n = n :=
begin
  revert n, apply induction,
  { rw add_base nat_induct.zero, },
  { intros n hn hi, rw [add_ind nat_induct.zero hn, hi], },
end

theorem succ_add {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m.succ + n = (m + n).succ :=
begin
  revert n, apply induction,
  { rw [add_base hm, add_base (nat_induct.succ_closed hm)], },
  { intros n hn hi, rw [add_ind (nat_induct.succ_closed hm) hn, hi, add_ind hm hn], },
end

theorem add_comm {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m + n = n + m :=
begin
  revert m, apply induction,
  { rw [add_base hn, zero_add hn], },
  { intros m hm hi, rw [succ_add hm hn, hi, add_ind hn hm], },
end

theorem succ_eq_add_one {n : Set} (hn : n ∈ ω) : n.succ = n + one :=
by rw [one, add_ind hn zero_nat, add_base hn]

def pre_mul (m : Set) : Set := (ω : Set).rec_fun ∅ (pre_add m)
def mul : Set := pair_sep_eq ((ω : Set).prod ω) ω (λ a, (pre_mul a.fst).fun_value a.snd)
instance : has_mul Set := ⟨λ m n, mul.fun_value (m.pair n)⟩

lemma pre_add_into_fun {m : Set} (hm : m ∈ ω) : m.pre_add.into_fun ω ω := rec_fun_into_fun hm succ_fun_into_fun

lemma mul_eq {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m * n = (pre_mul m).fun_value n :=
begin
  let f : Set → Set := λ p, (pre_mul p.fst).fun_value p.snd,
  have hf : f (m.pair n) = (pre_mul m).fun_value n, simp only [f], rw [fst_congr, snd_congr],
  change mul.fun_value (m.pair n) = (pre_mul m).fun_value n, rw ←hf, apply pair_sep_eq_fun_value,
  have hd : mul.dom = ((ω : Set).prod ω), apply pair_sep_eq_dom_eq, intros a ha, apply rec_fun_ran,
    apply fun_value_def'',
    { apply rec_fun_is_fun, exact nat_induct.zero, },
    { rw [pre_mul, rec_fun_dom_eq_nat],
      { exact (fst_snd_mem_dom_ran ha).right, },
      { exact nat_induct.zero, },
      { apply pre_add_into_fun (fst_snd_mem_dom_ran ha).left, }, },
  rw [←mul, hd, pair_mem_prod], exact ⟨hm, hn⟩,
end

-- Theorem 4J part M1
theorem mul_base {m : Set} (hm : m ∈ ω) : m * ∅ = ∅ :=
begin
  rw [mul_eq hm nat_induct.zero, pre_mul], refine (recursion_thm nat_induct.zero  (pre_add_into_fun hm)).left,
end
-- Theorem 4J part M2
theorem mul_ind {m : Set} (hm : m ∈ (ω : Set.{u})) {n : Set} (hn : n ∈ ω) : m * n.succ = m * n + m :=
begin
  rw [mul_eq hm (nat_induct.succ_closed hn), mul_eq hm hn],
  rw [pre_mul, (recursion_thm nat_induct.zero (pre_add_into_fun hm)).right _ hn],
  have h : ((ω : Set).rec_fun ∅ m.pre_add).fun_value n ∈ (ω : Set.{u}),
    apply rec_fun_ran, apply fun_value_def'' (rec_fun_is_fun nat_induct.zero),
    rw rec_fun_dom_eq_nat nat_induct.zero (pre_add_into_fun hm), exact hn,
  rw add_comm h hm,
  rw add_eq hm h,
end

theorem mul_into_nat {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m * n ∈ ω :=
begin
  revert n, apply induction,
  { rw [mul_base hm], exact nat_induct.zero, },
  { intros n hn hi, rw [mul_ind hm hn], exact add_into_nat hi hm, },
end

-- Theorem 4K
theorem mul_add {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) {p : Set} (hp : p ∈ ω) : m * (n + p) = m * n + m * p :=
begin
  revert p, apply induction,
  { rw [add_base hn, mul_base hm, add_base (mul_into_nat hm hn)], },
  { intros p hp hi, rw [add_ind hn hp, mul_ind hm (add_into_nat hn hp), hi, ←add_assoc (mul_into_nat hm hn) (mul_into_nat hm hp) hm, mul_ind hm hp], },
end

theorem mul_assoc {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) {p : Set} (hp : p ∈ ω) : m * (n * p) = (m * n) * p :=
begin
  revert p, apply induction,
  { rw [mul_base hn, mul_base hm, mul_base (mul_into_nat hm hn)], },
  { intros p hp hi, rw [mul_ind hn hp, mul_add hm (mul_into_nat hn hp) hn, hi, mul_ind (mul_into_nat hm hn) hp], },
end

theorem zero_mul {n : Set} (hn : n ∈ ω) : ∅ * n = ∅ :=
begin
  revert n, apply induction,
  { rw [mul_base nat_induct.zero], },
  { intros n hn hi, rw [mul_ind nat_induct.zero hn, hi, add_base nat_induct.zero], },
end

theorem succ_mul {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m.succ * n = m * n + n :=
begin
  revert n, apply induction,
  { rw [mul_base (nat_induct.succ_closed hm), mul_base hm, add_base nat_induct.zero], },
  { intros n hn hi, rw [mul_ind (nat_induct.succ_closed hm) hn, add_ind (mul_into_nat (nat_induct.succ_closed hm) hn) hm, hi],
    rw [←add_assoc (mul_into_nat hm hn) hn hm, add_comm hn hm, add_assoc (mul_into_nat hm hn) hm hn],
    rw [add_ind (mul_into_nat hm (nat_induct.succ_closed hn)) hn, mul_ind hm hn], },
end

theorem mul_comm {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m * n = n * m :=
begin
  revert m, apply induction,
  { rw [mul_base hn, zero_mul hn], },
  { intros m hm hi, rw [succ_mul hm hn, hi, mul_ind hn hm], },
end

theorem mul_one {m : Set} (hm : m ∈ ω) : m * one = m :=
begin
  revert m, apply induction,
  { rw zero_mul one_nat, },
  { intros m hm hi, rw [succ_mul hm one_nat, hi, succ_eq_add_one hm], },
end

theorem one_mul {m : Set} (hm : m ∈ ω) : one * m = m :=
begin
  rw mul_comm one_nat hm, exact mul_one hm,
end

def pre_exp (m : Set) : Set := (ω : Set).rec_fun one (pre_mul m)
def exp : Set := pair_sep_eq ((ω : Set).prod ω) ω (λ a, (pre_exp a.fst).fun_value a.snd)
instance : has_pow Set Set := ⟨λ m n, exp.fun_value (m.pair n)⟩

lemma pre_mul_into_fun {m : Set} (hm : m ∈ ω) : m.pre_mul.into_fun ω ω := rec_fun_into_fun zero_nat (pre_add_into_fun hm)

lemma exp_eq {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m ^ n = (pre_exp m).fun_value n :=
begin
  let f : Set → Set := λ p, (pre_exp p.fst).fun_value p.snd,
  have hf : f (m.pair n) = (pre_exp m).fun_value n, simp only [f], rw [fst_congr, snd_congr],
  change exp.fun_value (m.pair n) = (pre_exp m).fun_value n, rw ←hf, apply pair_sep_eq_fun_value,
  have hd : exp.dom = ((ω : Set).prod ω), apply pair_sep_eq_dom_eq, intros a ha, apply rec_fun_ran,
    apply fun_value_def'',
    { exact rec_fun_is_fun one_nat, },
    { rw [pre_exp, rec_fun_dom_eq_nat],
      { exact (fst_snd_mem_dom_ran ha).right, },
      { exact one_nat, },
      { apply pre_mul_into_fun (fst_snd_mem_dom_ran ha).left, }, },
  rw [←exp, hd, pair_mem_prod], exact ⟨hm, hn⟩,
end

theorem exp_base {m : Set} (hm : m ∈ (ω : Set.{u})) : m ^ (∅ : Set.{u}) = one :=
begin
  rw [exp_eq hm zero_nat, pre_exp], refine (recursion_thm one_nat (pre_mul_into_fun hm)).left,
end

theorem exp_ind {m : Set.{u}} (hm : m ∈ (ω : Set.{u})) {n : Set.{u}} (hn : n ∈ (ω : Set.{u})) : m ^ n.succ = m ^ n * m :=
begin
  rw [exp_eq hm (nat_induct.succ_closed hn), exp_eq hm hn],
  rw [pre_exp, (recursion_thm one_nat (pre_mul_into_fun hm)).right _ hn],
  have h : ((ω : Set).rec_fun one m.pre_mul).fun_value n ∈ (ω : Set.{u}),
    apply rec_fun_ran, apply fun_value_def'' (rec_fun_is_fun one_nat),
    rw rec_fun_dom_eq_nat one_nat (pre_mul_into_fun hm), exact hn,
  rw mul_comm h hm,
  rw mul_eq hm h,
end

theorem exp_into_nat {m : Set.{u}} (hm : m ∈ (ω : Set.{u})) {n : Set.{u}} (hn : n ∈ (ω : Set.{u})) : m ^ n ∈ (ω : Set.{u}) :=
begin
  revert n, apply induction,
  { rw [exp_base hm], exact one_nat, },
  { intros n hn hi, rw [exp_ind hm hn], exact mul_into_nat hi hm, },
end

theorem exp_add {m : Set.{u}} (hm : m ∈ (ω : Set.{u})) {n : Set.{u}} (hn : n ∈ (ω : Set.{u})) {p : Set} (hp : p ∈ ω) : m ^ (n + p) = m ^ n * m ^ p :=
begin
  revert p, apply induction,
  { rw [add_base hn, exp_base hm, mul_one (exp_into_nat hm hn)], },
  { intros p hp hi, rw [add_ind hn hp, exp_ind hm (add_into_nat hn hp), hi, exp_ind hm hp],
    rw mul_assoc (exp_into_nat hm hn) (exp_into_nat hm hp) hm, },
end

theorem one_exp {m : Set.{u}} (hm : m ∈ (ω : Set.{u})) : one.{u} ^ m = one :=
begin
  revert m, apply induction,
  { rw [exp_base one_nat], },
  { intros m hm hi, rw [exp_ind one_nat hm, hi, mul_one one_nat], },
end

theorem exp_exp {m : Set.{u}} (hm : m ∈ (ω : Set.{u})) {n : Set.{u}} (hn : n ∈ (ω : Set.{u})) {p : Set} (hp : p ∈ ω) : (m ^ n) ^ p = m ^ (n * p) :=
begin
  revert p, apply induction,
  { rw [mul_base hn, exp_base hm, exp_base (exp_into_nat hm hn)], },
  { intros p hp hi, rw [exp_ind (exp_into_nat hm hn) hp, hi, mul_ind hn hp, exp_add hm (mul_into_nat hn hp) hn], },
end

theorem exp_mul {m : Set.{u}} (hm : m ∈ (ω : Set.{u})) {n : Set.{u}} (hn : n ∈ (ω : Set.{u})) {p : Set.{u}} (hp : p ∈ (ω : Set.{u})) : (m * n) ^ p = m ^ p * n ^ p :=
begin
  revert p, apply induction,
  { rw [exp_base (mul_into_nat hm hn), exp_base hm, exp_base hn, mul_one one_nat], },
  { intros p hp hi, rw [exp_ind (mul_into_nat hm hn) hp, hi, mul_assoc (mul_into_nat (exp_into_nat hm hp) (exp_into_nat hn hp)) hm hn],
    rw [←mul_assoc (exp_into_nat hm hp) (exp_into_nat hn hp) hm, mul_comm (exp_into_nat hn hp) hm],
    rw [mul_assoc (exp_into_nat hm hp) hm (exp_into_nat hn hp), exp_ind hn hp],
    rw [mul_assoc (exp_into_nat hm (nat_induct.succ_closed hp)) (exp_into_nat hn hp) hn, exp_ind hm hp], },
end

theorem exp_one {m : Set} (mω : m ∈ nat.{u}) : m ^ one.{u} = m :=
by rw [one, exp_ind mω zero_nat, exp_base mω, one_mul mω]

instance : has_lt Set := ⟨Set.has_mem.mem⟩
instance : has_le Set := ⟨(λ m n, m ∈ n ∨ m = n)⟩

lemma le_self {x : Set} : x ≤ x := or.inr rfl

@[simp]
lemma lt_def {n m : Set} : n < m ↔ n ∈ m := by refl

@[simp]
lemma le_iff {n m : Set} : m ≤ n ↔ m ∈ n ∨ m = n := by simp only [has_le.le]

lemma mem_succ_iff_le {p k : Set} : p ∈ k.succ ↔ p ≤ k :=
by simp only [succ, mem_union, mem_singleton, le_iff, or_comm]

lemma mem_nat_iff {n : Set} (hn : n ∈ ω) {x : Set} : x ∈ n ↔ x ∈ ω ∧ x ∈ n :=
begin
  symmetry, simp only [and_iff_right_iff_imp],
  intro hx, apply nat_transitive_set, simp only [mem_Union, exists_prop], exact ⟨_, hn, hx⟩,
end

lemma mem_nat_of_mem_nat_of_mem {n : Set} (hn : n ∈ ω) {m : Set} (hm : m ∈ n) : m ∈ ω := ((mem_nat_iff hn).mp hm).left

lemma subset_nat_of_mem_nat {n : Set} (hn : n ∈ ω) : n ⊆ ω := (λ m hm, mem_nat_of_mem_nat_of_mem hn hm)

lemma self_mem_succ {n : Set} : n ∈ n.succ := by { rw [mem_succ_iff_le, le_iff], finish, }
lemma self_sub_succ {n : Set} : n ⊆ n.succ :=
(λ m hmn, by { rw [mem_succ_iff_le, le_iff], finish, })

-- Lemma 4L part a
lemma mem_iff_succ_mem_succ {m n : Set} (hm : m ∈ ω) (hn : n ∈ ω) : m ∈ n ↔ m.succ ∈ n.succ :=
begin
  split,
  { revert hm m, refine induction _ _ hn,
    { intros m hm hc, exfalso, exact mem_empty _ hc, },
    { intros k hk hi m hm hmk, rw [mem_succ_iff_le, le_iff] at hmk, cases hmk,
      { apply self_sub_succ, exact hi hm hmk, },
      { subst hmk, exact self_mem_succ, }, }, },
  { intro he, rw [mem_succ_iff_le, le_iff] at he, cases he,
    { apply nat_transitive hn, simp only [mem_Union, exists_prop],
      refine ⟨_, he, _⟩, exact self_mem_succ, },
    { subst he, exact self_mem_succ }, },
end

lemma mem_iff_succ_le {n : Set} (hn : n ∈ ω) {m : Set} (hm : m ∈ ω) : n ∈ m ↔ n.succ ≤ m :=
begin
  rw [mem_iff_succ_mem_succ hn hm, mem_succ_iff_le],
end

-- Lemma 4L part b
lemma nat_not_mem_self : ∀ {n : Set}, n ∈ ω → n ∉ n :=
@induction (λ n, n ∉ n) (mem_empty _) (λ n hn hnn hsn, hnn ((mem_iff_succ_mem_succ hn hn).mpr hsn))

lemma lt_iff' {n m : Set} (mω : m ∈ ω) : n ∈ m ↔ n ≤ m ∧ n ≠ m :=
begin
  split,
    intro nm, refine ⟨or.inl nm, λ h, _⟩, subst h, exact nat_not_mem_self mω nm,
  rintro ⟨(nm|nm), h⟩,
    exact nm,
  exfalso, exact h nm,
end

def nat_order : Set := Set.pair_sep Set.has_mem.mem ω ω

-- The Trichotomy Law for ω can be deduced from here
theorem nat_order_lin : (ω : Set).lin_order nat_order :=
begin
  split,
  { exact pair_sep_sub_prod, },
  { intros m n p hmn hnp, rw [nat_order, pair_mem_pair_sep] at *,
    rcases hmn with ⟨hm, hn, hmn⟩, rcases hnp with ⟨-, hp, hnp⟩, refine ⟨hm, hp, _⟩,
    apply nat_transitive hp, simp only [mem_Union, exists_prop], exact ⟨_, hnp, hmn⟩, },
  { intro m, rw [nat_order, pair_mem_pair_sep], rintro ⟨hm, -, h⟩,
    exact nat_not_mem_self hm h, },
  { suffices h : ∀ {n : Set}, n ∈ ω → ∀ {m : Set}, m ∈ ω → n = m ∨ m ∈ n ∨ n ∈ m,
      intros n m hn hm hne, specialize h hn hm, rcases h with (h|h|h),
      { contradiction, },
      { right, rw [nat_order, pair_mem_pair_sep], finish, },
      { left, rw [nat_order, pair_mem_pair_sep], finish, },
    refine @induction (λ n, ∀ {m : Set}, m ∈ ω → n = m ∨ m ∈ n ∨ n ∈ m) _ _,
    { suffices h : ∀ {m : Set}, m ∈ ω → ∅ ≤ m, simp only [le_iff] at h,
        intros m hm, cases h hm,
        { finish, },
        { finish, },
      apply induction,
      { rw [le_iff], finish, },
      { simp only [le_iff, mem_succ_iff_le], intros m hm h, left, assumption, }, },
    { intros k hk hi m hm, specialize hi hm, rcases hi with (hi|hi|hi),
      { subst hi, right, left, exact self_mem_succ, },
      { rw [mem_succ_iff_le, le_iff], finish, },
      { have h : k.succ ∈ m.succ, from (mem_iff_succ_mem_succ hk hm).mp hi,
        rw [mem_succ_iff_le, le_iff] at h, finish, }, }, },
end

lemma lt_trans {k m n : Set} (hk : k ∈ ω) (hm : m ∈ ω) (hn : n ∈ ω) (hkm : k ∈ m) (hmn : m ∈ n) : k ∈ n :=
begin
  have ht : nat_order.transitive, from nat_order_lin.trans,
  specialize @ht k m n,
  simp only [nat_order, pair_mem_pair_sep] at ht,
  exact (ht ⟨hk, hm, hkm⟩ ⟨hm, hn, hmn⟩).right.right,
end

lemma lt_trans' {k m n : Set} (nω : n ∈ ω) (km : k ∈ m) (mn : m ∈ n) : k ∈ n :=
let mω := mem_nat_of_mem_nat_of_mem nω mn in
lt_trans (mem_nat_of_mem_nat_of_mem mω km) mω nω km mn

lemma le_trans {m n : Set} (mn : m ≤ n) {k : Set} (nk : n ≤ k) (kω : k ∈ ω) : m ≤ k :=
begin
  cases mn,
    cases nk,
      left, exact lt_trans' kω mn nk,
    subst nk, left, exact mn,
  subst mn, cases nk,
    left, exact nk,
  subst nk, right, refl,
end

lemma nat_lt_of_le_of_lt {n m : Set} (nm : n ≤ m) {k : Set} (mk : m ∈ k) (kω : k ∈ ω) : n ∈ k :=
begin
  cases nm,
    exact lt_trans' kω nm mk,
  subst nm, exact mk,
end

lemma not_lt_and_gt {m n : Set} (hm : m ∈ ω) (hn : n ∈ ω) : ¬ (m ∈ n ∧ n ∈ m) :=
begin
  intro h, apply nat_not_mem_self hm, exact lt_trans hm hn hm h.left h.right,
end

lemma nat_order_conn {m n : Set} (hm : m ∈ ω) (hn : n ∈ ω) (hne : m ≠ n) : m ∈ n ∨ n ∈ m :=
begin
  have h := nat_order_lin.conn hm hn hne,
  simp only [nat_order, pair_mem_pair_sep] at h, cases h,
    exact or.inl h.right.right,
  exact or.inr h.right.right,
end

lemma nat_le_or_le {m n : Set} (hm : m ∈ ω) (hn : n ∈ ω) : m ≤ n ∨ n ≤ m :=
begin
  by_cases mn : m = n,
    left, right, exact mn,
  cases nat_order_conn hm hn mn,
    left, left, exact h,
  right, left, exact h,
end

instance : has_ssubset Set := ⟨(λ m n, m ⊆ n ∧ m ≠ n)⟩

lemma ssub_of_sub_of_ssub {x y z : Set} (hxy : x ⊆ y) (hyz : y ⊂ z) : x ⊂ z :=
begin
  split,
    exact subset_trans hxy hyz.left,
  intro hxz, rw ←hxz at hyz, apply hyz.right, rw eq_iff_subset_and_subset, exact ⟨hyz.left, hxy⟩,
end

@[simp]
lemma ssubset_iff {A B : Set} : A ⊂ B ↔ A ⊆ B ∧ A ≠ B := iff.rfl

-- Corollary 4M part 1
theorem nat_ssub_iff_mem {m n : Set} (hm : m ∈ ω) (hn : n ∈ ω) : m ⊂ n ↔ m ∈ n :=
begin
  split,
  { rintro ⟨hs, hne⟩, cases nat_order_lin.conn hm hn hne,
    { rw [nat_order, pair_mem_pair_sep] at h, finish, },
    { rw [nat_order, pair_mem_pair_sep] at h, rcases h with ⟨-, -, h⟩, exfalso,
      apply nat_not_mem_self hn, exact hs h, }, },
  { intro h, refine ⟨_, _⟩,
    { intros k hk, apply nat_transitive hn, simp only [mem_Union, exists_prop], exact ⟨_, h, hk⟩, },
    { intro he, subst he, exact nat_not_mem_self hm h, }, },
end

-- Corollary 4M part 2
theorem nat_sub_iff_le {m n : Set} (hm : m ∈ ω) (hn : n ∈ ω) : m ⊆ n ↔ m ≤ n :=
begin
  rw [le_iff], split,
  { intro hmn, by_cases m = n,
    { finish, },
    { left, rw ←nat_ssub_iff_mem hm hn, exact ⟨hmn, h⟩, }, },
  { rintro (h|h),
    { exact ((nat_ssub_iff_mem hm hn).mpr h).left, },
    { subst h, exact subset_self, }, },
end

lemma zero_mem_succ {n : Set} (nω : n ∈ ω) : ∅ ∈ n.succ :=
begin
  revert n, refine @induction _ _ _,
    exact self_mem_succ,
  intros n nω ind,
  have nω' := nat_induct.succ_closed nω,
  exact lt_trans zero_nat nω' (nat_induct.succ_closed nω') ind self_mem_succ,
end

lemma zero_ne_one : ∅ ≠ one :=
begin
  intro he, apply nat_not_mem_self zero_nat, nth_rewrite 1 he, exact self_mem_succ,
end

lemma one_ne_two : one ≠ two :=
begin
  intro he, apply nat_not_mem_self one_nat, nth_rewrite 1 he, exact self_mem_succ,
end

lemma zero_ne_two : ∅ ≠ two :=
begin
  intro he, apply nat_not_mem_self zero_nat, nth_rewrite 1 he, exact self_sub_succ self_mem_succ,
end

lemma zero_lt_one : ∅ ∈ one :=
by rw [one, succ, union_empty, mem_singleton]

lemma one_lt_two : one ∈ two :=
by rw [two, succ, mem_union, mem_singleton]; exact or.inl rfl

lemma zero_lt_two : ∅ ∈ two :=
lt_trans' two_nat zero_lt_one one_lt_two

theorem unbounded_Union_eq_nat {A : Set} (hA : A ⊆ ω) (base : one ∈ A)
  (unb : ∀ {n : Set}, n ∈ A → ∃ m : Set, m ∈ A ∧ n ∈ m) : A.Union = ω :=
begin
  apply eq_nat_of_induct_sub,
    split,
      rw mem_Union, exact ⟨_, base, zero_lt_one⟩,
    intros n hn, simp only [mem_Union] at hn ⊢, rcases hn with ⟨m, mA, nm⟩,
    obtain ⟨k, kA, mk⟩ := unb mA, refine ⟨_, kA, _⟩,
    refine nat_lt_of_le_of_lt _ mk (hA kA),
    rwa ←mem_iff_succ_le (mem_nat_of_mem_nat_of_mem (hA mA) nm) (hA mA),
  apply Union_sub,
  suffices h : ∀ {x : Set}, x ∈ ω → x ⊆ ω,
    intros x xA, exact h (hA xA),
  rw ←transitive_set_iff', exact nat_transitive_set,
end

-- Theorem 4N part a
theorem add_lt_add_of_lt {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) {p : Set} (hp : p ∈ ω) :
m ∈ n ↔ m + p ∈ n + p :=
begin
  revert m hm n hn p hp,
  have hleft : ∀ {m : Set}, m ∈ ω → ∀ {n : Set}, n ∈ ω → m ∈ n → ∀ {p : Set}, p ∈ ω → m + p ∈ n + p,
    intros m hm n hn hmn, apply induction,
      rw [add_base hm, add_base hn], exact hmn,
    intros k hk hi, rw [add_ind hm hk, add_ind hn hk, ←mem_iff_succ_mem_succ (add_into_nat hm hk) (add_into_nat hn hk)],
    exact hi,
  intros m hm n hn p hp,
  refine ⟨λ hmn, hleft hm hn hmn hp, _⟩,
  intro h, by_cases he : m = n,
    subst he, exfalso, exact nat_not_mem_self (add_into_nat hm hp) h,
  cases nat_order_conn hm hn he with hmn hnm,
    exact hmn,
  have h : n + p ∈ n + p,
    exact lt_trans (add_into_nat hn hp) (add_into_nat hm hp) (add_into_nat hn hp) (hleft hn hm hnm hp) h,
  exfalso, apply nat_not_mem_self (add_into_nat hn hp) h,
end

-- Theorem 4N part b
theorem mul_lt_mul_of_lt {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) {p : Set} (hp : p ∈ ω) (hpnz : p ≠ ∅) :
m ∈ n ↔ m * p ∈ n * p :=
begin
  revert m hm n hn p hp,
  have hleft : ∀ {m : Set}, m ∈ ω → ∀ {n : Set}, n ∈ ω → m ∈ n → ∀ {p : Set}, p ∈ ω → m * p.succ ∈ n * p.succ,
    intros m hm n hn hmn, apply induction,
      rw [←one, mul_one hm, mul_one hn], exact hmn,
    intros k hk hi, rw [mul_ind hm (nat_induct.succ_closed hk), mul_ind hn (nat_induct.succ_closed hk)],
    apply lt_trans (add_into_nat (mul_into_nat hm (nat_induct.succ_closed hk)) hm) (add_into_nat (mul_into_nat hn (nat_induct.succ_closed hk)) hm) (add_into_nat (mul_into_nat hn (nat_induct.succ_closed hk)) hn),
      rw ←add_lt_add_of_lt (mul_into_nat hm (nat_induct.succ_closed hk)) (mul_into_nat hn (nat_induct.succ_closed hk)) hm,
      exact hi,
    rw [add_comm (mul_into_nat hn (nat_induct.succ_closed hk)) hm, add_comm (mul_into_nat hn (nat_induct.succ_closed hk)) hn],
    rw ←add_lt_add_of_lt hm hn (mul_into_nat hn (nat_induct.succ_closed hk)),
    exact hmn,
  intros m hm n hn p hp hpnz,
  obtain ⟨q, hq, he⟩ := exists_pred_of_ne_zero hp hpnz,
  subst he, refine ⟨λ hmn, hleft hm hn hmn hq, _⟩,
  intro h, by_cases he : m = n,
    subst he, exfalso, exact nat_not_mem_self (mul_into_nat hm hp) h,
  cases nat_order_conn hm hn he with hmn hnm,
    exact hmn,
  have h : n * q.succ ∈ n * q.succ,
    exact lt_trans (mul_into_nat hn hp) (mul_into_nat hm hp) (mul_into_nat hn hp) (hleft hn hm hnm hq) h,
  exfalso, apply nat_not_mem_self (mul_into_nat hn hp) h,
end

theorem mul_lt_mul_of_lt_left {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) {p : Set} (hp : p ∈ ω) (hpnz : p ≠ ∅) :
m ∈ n ↔ p * m ∈ p * n :=
begin
  rw [mul_comm hp hm, mul_comm hp hn], exact mul_lt_mul_of_lt hm hn hp hpnz,
end

lemma mul_lt_mul_of_lt' {m n : Set.{u}} (nω : n ∈ nat.{u}) (mn : m ∈ n) : m * m ∈ n * n :=
begin
  have nz : n ≠ ∅, intro nz, subst nz, exact mem_empty _ mn,
  by_cases mz : m = ∅,
    subst mz, rw mul_base zero_nat, rwa [←mul_base nω, ←mul_lt_mul_of_lt_left zero_nat nω nω nz],
  have mω : m ∈ nat.{u} := mem_nat_of_mem_nat_of_mem nω mn,
  apply lt_trans' (mul_into_nat nω nω) ((mul_lt_mul_of_lt mω nω mω mz).mp mn),
  exact (mul_lt_mul_of_lt_left mω nω nω nz).mp mn,
end

-- Corollary 4P part a
theorem cancel_add_right {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) {p : Set} (hp : p ∈ ω) (h : m + p = n + p) : m = n :=
begin
  apply classical.by_contradiction, intro hmne, cases nat_order_conn hm hn hmne with hmn hnm,
    rw [add_lt_add_of_lt hm hn hp, h] at hmn, exact nat_not_mem_self (add_into_nat hn hp) hmn,
  rw [add_lt_add_of_lt hn hm hp, h] at hnm, exact nat_not_mem_self (add_into_nat hn hp) hnm,
end

theorem cancel_add_left {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) {p : Set} (hp : p ∈ ω) (h : p + m = p + n) : m = n :=
begin
  rw [add_comm hp hm, add_comm hp hn] at h, exact cancel_add_right hm hn hp h,
end

-- Corollary 4P part b
theorem cancel_mul_right {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) {p : Set} (hp : p ∈ ω) (hpnz : p ≠ ∅) (h : m * p = n * p) : m = n :=
begin
  apply classical.by_contradiction, intro hmne, cases nat_order_conn hm hn hmne with hmn hnm,
    rw [mul_lt_mul_of_lt hm hn hp hpnz, h] at hmn, exact nat_not_mem_self (mul_into_nat hn hp) hmn,
  rw [mul_lt_mul_of_lt hn hm hp hpnz, h] at hnm, exact nat_not_mem_self (mul_into_nat hn hp) hnm,
end

theorem cancel_mul_left {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) {p : Set} (hp : p ∈ ω) (hpnz : p ≠ ∅) (h : p * m = p * n) : m = n :=
begin
  rw [mul_comm hp hm, mul_comm hp hn] at h, exact cancel_mul_right hm hn hp hpnz h,
end

lemma nonzero_exp_positive {b : Set.{u}} (hb : b ∈ nat.{u}) (hbnz : b ≠ ∅) {n : Set.{u}} (hn : n ∈ nat.{u}) : ∅ ∈ b ^ n :=
begin
  revert n, apply induction,
    rw [exp_base hb, one], exact self_mem_succ,
  intros n hn hi, rw [exp_ind hb hn, ←zero_mul hb, ←mul_lt_mul_of_lt zero_nat (exp_into_nat hb hn) hb hbnz],
  exact hi,
end

lemma not_zero_of_ge_not_zero {n : Set} (nω : n ∈ ω) (nz : n ≠ ∅) {m : Set} (m ∈ ω) (nm : n ≤ m) : m ≠ ∅ :=
begin
  intro mz, subst mz, cases nm,
    exact mem_empty _ nm,
  subst nm, exact nz rfl,
end

lemma exp_gt_one {n : Set} (nω : n ∈ nat.{u}) (hn : one ∈ n) : ∀ {m : Set.{u}}, m ∈ nat.{u} → one ∈ n ^ m.succ :=
begin
  apply induction,
    rwa [←one, exp_one nω],
  intros m mω ind,
  have mω' := succ_nat_is_nat mω,
  apply lt_trans' (exp_into_nat nω (succ_nat_is_nat mω')) ind,
  have nmω := exp_into_nat nω mω',
  have nmnz : n ^ m.succ ≠ ∅, apply @not_zero_of_ge_not_zero one one_nat zero_ne_one.symm (n ^ m.succ),
      exact nmω,
    exact or.inl ind,
  rwa [←mul_one nmω, exp_ind nω mω', ←mul_lt_mul_of_lt_left one_nat nω nmω nmnz],
end

theorem nat_well_order {A : Set} (hA : A ⊆ ω) (hne : A ≠ ∅) : ∃ m : Set, m ∈ A ∧ ∀ {n : Set}, n ∈ A → m ≤ n :=
begin
  apply classical.by_contradiction, intro hc,
  have h : ∀ {m : Set}, m.mem ω → ∀ {n : Set}, n.mem m → n ∉ A,
    refine @induction (λ m, ∀ {n : Set}, n.mem m → n ∉ A) _ _,
    { intros n hn, exfalso, exact mem_empty _ hn, },
    { intros k hk hi n hnk, change n ∈ k.succ at hnk, rw [mem_succ_iff_le, le_iff] at hnk, cases hnk,
      { exact hi hnk, },
      { subst hnk, intro hnA, refine hc ⟨_, hnA, _⟩, intros m hmA, rw le_iff, by_cases n = m,
        { exact or.inr h, },
        { cases nat_order_lin.conn hk (hA hmA) h with h' h',
          { rw [nat_order, pair_mem_pair_sep] at h', finish, },
          { rw [nat_order, pair_mem_pair_sep] at h', exfalso, exact hi h'.right.right hmA, }, }, }, },
  apply hne, rw eq_empty, intros n hnA, exact h (nat_induct.succ_closed (hA hnA)) self_mem_succ hnA,
end

lemma le_of_not_lt {n : Set} (hn : n ∈ ω) {m : Set} (hm : m ∈ ω) (h : ¬ (n ∈ m)) : m ≤ n :=
begin
  by_cases hc : m = n,
    exact or.inr hc,
  cases nat_order_conn hm hn hc with hmn hmn,
    exact or.inl hmn,
  contradiction,
end

lemma not_lt_of_le {n : Set} (hn : n ∈ ω) {m : Set} (hm : m ∈ ω) (h : n ≤ m) : ¬ (m ∈ n) :=
begin
  intro mn, cases h,
    apply nat_not_mem_self hm,
    apply lt_trans hm hn hm mn h,
  subst h, exact nat_not_mem_self hn mn,
end

-- Corollary 4Q
theorem not_exists_mon_dec_fun : ¬ ∃ f : Set, f.into_fun ω ω
∧ ∀ {n : Set}, n ∈ ω → f.fun_value n.succ ∈ f.fun_value n :=
begin
  rintro ⟨f, hf, ha⟩,
  have hne : f.ran ≠ ∅, intro fr, rw eq_empty at fr, apply fr (f.fun_value ∅),
    apply fun_value_def'' (is_function_of_into hf), rw dom_eq_of_into hf, exact nat_induct.zero,
  rcases nat_well_order (ran_sub_of_into hf) hne with ⟨m, hmA, ha'⟩,
  rw mem_ran at hmA, rcases hmA with ⟨k, hkm⟩,
  have hd : k ∈ f.dom, rw mem_dom, exact ⟨_, hkm⟩,
  replace hkm : m = f.fun_value k, from fun_value_def (is_function_of_into hf) hkm, subst hkm,
  simp only [le_iff] at ha',
  have hd' : k.succ ∈ f.dom, rw dom_eq_of_into hf at *, exact nat_induct.succ_closed hd,
  cases ha' (fun_value_def'' (is_function_of_into hf) hd'),
  { apply nat_not_mem_self,
    { apply ran_sub_of_into hf, exact fun_value_def'' (is_function_of_into hf) hd, },
    { have ht : nat_order.transitive, from nat_order_lin.trans,
      specialize @ht (f.fun_value k) (f.fun_value k.succ) (f.fun_value k),
      simp only [nat_order, pair_mem_pair_sep] at ht,
      have hko : (f.fun_value k).mem ω,
        apply ran_sub_of_into hf, exact fun_value_def'' (is_function_of_into hf) hd,
      have hkso : (f.fun_value k.succ).mem ω,
        apply ran_sub_of_into hf, exact fun_value_def'' (is_function_of_into hf) hd',
      refine (ht ⟨hko, hkso, h⟩ ⟨hkso, hko, ha _⟩).right.right,
      rw ←dom_eq_of_into hf, assumption, }, },
  { apply nat_not_mem_self, apply ran_sub_of_into hf, apply fun_value_def'' (is_function_of_into hf), exact hd,
    have ho : k.mem ω, rw ←dom_eq_of_into hf, assumption,
    specialize ha ho, rw ←h at ha, assumption, },
end

theorem strong_induction {A : Set} (hA : A ⊆ ω)
(h : ∀ {n : Set}, n ∈ ω → (∀ {m : Set}, m ∈ n → m ∈ A) → n ∈ A) : A = ω :=
begin
  apply classical.by_contradiction, intro hne,
  have hcne : ω \ A ≠ ∅, intro hce, apply hne, refine eq_iff_subset_and_subset.mpr ⟨hA, _⟩,
    intros n hn, apply classical.by_contradiction, intro hnA, apply mem_empty n, rw ←hce,
    rw mem_diff, exact ⟨hn, hnA⟩,
  have hs : ω \ A ⊆ ω, intros n hn, rw mem_diff at hn, exact hn.left,
  rcases nat_well_order hs hcne with ⟨m, hm, ha⟩, simp only [mem_diff] at hm ha, apply hm.right,
  apply h hm.left, intros n hnm, apply classical.by_contradiction, intro hnA,
  have hno : n.mem ω, apply nat_transitive_set, simp only [mem_Union, exists_prop],
    exact ⟨_, hm.left, hnm⟩,
  specialize ha ⟨hno, hnA⟩, rw le_iff at ha, cases ha,
  { exact not_lt_and_gt hno hm.left ⟨hnm, ha⟩, },
  { apply nat_not_mem_self hno, subst ha, exact hnm, },
end

-- chapter 4 problem 22
lemma mem_self_add_succ {m : Set} (hm : m ∈ ω) {p : Set} (hp : p ∈ ω) : m ∈ m + p.succ :=
begin
  revert p, apply induction,
    rw [add_ind hm zero_nat, add_base hm], exact self_mem_succ,
  intros p hp hi, rw [add_ind hm hp] at hi, rw [add_ind hm (nat_induct.succ_closed hp), add_ind hm hp],
  have h : (m + p).succ ∈ (m + p).succ.succ := self_mem_succ,
  exact lt_trans hm (nat_induct.succ_closed (add_into_nat hm hp)) (nat_induct.succ_closed (nat_induct.succ_closed (add_into_nat hm hp))) hi h,
end

-- chapter 4 problem 23
lemma exists_addend_of_lt {m : Set.{u}} (hm : m ∈ (ω : Set.{u})) : ∀ {n : Set.{u}}, n ∈ (ω : Set.{u}) → m ∈ n → ∃ p : Set.{u}, p ∈ (ω : Set.{u}) ∧ m + p.succ = n :=
begin
  apply @induction (λ n : Set.{u}, m ∈ n → ∃ p : Set.{u}, p ∈ (ω : Set.{u}) ∧ m + p.succ = n),
    intro hme, exfalso, exact mem_empty _ hme,
  intros n hn hi hmn, rw [mem_succ_iff_le, le_iff] at hmn, cases hmn,
    obtain ⟨p, hp, he⟩ := hi hmn,
    refine ⟨p.succ, nat_induct.succ_closed hp, _⟩,
    rw [add_ind hm (nat_induct.succ_closed hp), he],
  refine ⟨∅, zero_nat, _⟩, rw [add_ind hm zero_nat, add_base hm, hmn],
end

lemma exp_lt_of_lt {b : Set} (bω : b ∈ nat.{u}) (hb : one ∈ b)
  {n m : Set} (nm : n ∈ m) (mω : m ∈ nat.{u}) : b ^ n ∈ b ^ m :=
begin
  have nω := mem_nat_of_mem_nat_of_mem mω nm,
  obtain ⟨k, kω, nkm⟩ := exists_addend_of_lt nω mω nm,
  subst nkm, rw [exp_add bω nω (succ_nat_is_nat kω)],
  have bnω := exp_into_nat bω nω,
  nth_rewrite 0 ←mul_one bnω,
  have bnz : b ^ n ≠ ∅, apply @not_zero_of_ge_not_zero one one_nat zero_ne_one.symm (b ^ n),
      exact bnω,
    rw [one, ←mem_iff_succ_le zero_nat bnω],
    apply nonzero_exp_positive bω,
      apply @not_zero_of_ge_not_zero one one_nat zero_ne_one.symm b,
        exact bω,
      left, exact hb,
    exact nω,
  rw ←mul_lt_mul_of_lt_left one_nat (exp_into_nat bω (succ_nat_is_nat kω)) bnω bnz,
  exact exp_gt_one bω hb kω,
end

lemma lt_iff {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m ∈ n ↔ ∃ p : Set, p ∈ ω ∧ m + p.succ = n :=
begin
  split,
    intro hmn, exact exists_addend_of_lt hm hn hmn,
  rintro ⟨p, hp, he⟩, rw ←he, exact mem_self_add_succ hm hp,
end

lemma le_iff_exists {m : Set} (hm : m ∈ ω) {n : Set} (hn : n ∈ ω) : m ≤ n ↔ ∃ p : Set, p ∈ ω ∧ m + p = n :=
begin
  split,
    intro hmn, rw le_iff at hmn, cases hmn with hmn,
      rw lt_iff hm hn at hmn,
      rcases hmn with ⟨p, hp, he⟩, exact ⟨p.succ, (nat_induct.succ_closed hp), he⟩,
    refine ⟨∅, zero_nat, _⟩, rw [hmn, add_base hn],
  rintro ⟨p, hp, he⟩, rw le_iff, by_cases h : p = ∅,
    right, rw [h, add_base hm] at he, exact he,
  left, rw lt_iff hm hn,
  obtain ⟨k, hk, he'⟩ := exists_pred_of_ne_zero hp h,
  refine ⟨k, hk, _⟩, rw [←he', he],
end

def bool : Set := {∅, one}
def neg : Set := {pair ∅ one, pair one ∅}
def mod2 : Set := bool.rec_fun ∅ neg

lemma zero_mem_bool : ∅ ∈ bool :=
by simp [bool]

lemma one_mem_bool : one ∈ bool :=
by simp [bool]

lemma neg_into_fun : neg.into_fun bool bool :=
begin
  rw fun_def_equiv, dsimp [is_func], split,
    intros z hz, rw [neg, mem_insert, mem_singleton] at hz, cases hz,
      subst hz, rw [pair_mem_prod], exact ⟨zero_mem_bool, one_mem_bool⟩,
    subst hz, rw [pair_mem_prod], exact ⟨one_mem_bool, zero_mem_bool⟩,
  intros z hz, rw [bool, mem_insert, mem_singleton] at hz, cases hz,
    subst hz, use one, simp only [neg, mem_insert, mem_singleton], refine ⟨or.inl rfl, _⟩,
    rintros b (hb|hb),
      exact (pair_inj hb).right,
    exfalso, apply zero_ne_one, exact (pair_inj hb).left,
  subst hz, use ∅, simp only [neg, mem_insert, mem_singleton], refine ⟨or.inr rfl, _⟩,
  rintros b (hb|hb),
    exfalso, apply zero_ne_one, symmetry, exact (pair_inj hb).left,
  exact (pair_inj hb).right,
end

lemma neg_fun_value_zero : neg.fun_value ∅ = one :=
begin
  symmetry, apply fun_value_def neg_into_fun.left, simp [neg],
end

lemma neg_fun_value_one : neg.fun_value one = ∅ :=
begin
  symmetry, apply fun_value_def neg_into_fun.left, simp [neg],
end

lemma self_eq_one_of_neq_eq_zero {n : Set} (hn : n ∈ bool) (h : neg.fun_value n = ∅) : n = one  :=
begin
  simp [bool] at hn, cases hn,
    subst hn, exfalso, rw neg_fun_value_zero at h, exact zero_ne_one h.symm,
  exact hn,
end

lemma self_eq_zero_of_neq_eq_one {n : Set} (hn : n ∈ bool) (h : neg.fun_value n = one) : n = ∅  :=
begin
  simp [bool] at hn, cases hn,
    exact hn,
  subst hn, exfalso, rw neg_fun_value_one at h, exact zero_ne_one h,
end

lemma mod2_zero : mod2.fun_value ∅ = ∅ :=
(recursion_thm zero_mem_bool neg_into_fun).left

lemma mod2_succ {n : Set} (hn : n ∈ ω) : mod2.fun_value n.succ = neg.fun_value (mod2.fun_value n) :=
(recursion_thm zero_mem_bool neg_into_fun).right _ hn

lemma mod2_fun_value_mem {n : Set} (hn : n ∈ ω) : mod2.fun_value n ∈ bool :=
begin
  apply rec_fun_ran, apply fun_value_def'' (rec_fun_is_fun zero_mem_bool),
  rw rec_fun_dom_eq_nat zero_mem_bool neg_into_fun, exact hn,
end

lemma mod2_fun_value_eq_zero_or_one {n : Set} (hn : n ∈ ω) : mod2.fun_value n = ∅ ∨ mod2.fun_value n = one :=
begin
  have h := mod2_fun_value_mem hn,
  rw [bool, mem_insert, mem_singleton] at h, exact h,
end

def pred : Set := succ_fun.inv ∪ {pair ∅ ∅}

lemma pred_onto_fun : pred.onto_fun (ω : Set.{u}) ω :=
begin
  have hd : succ_fun.inv.dom ∪ dom {(∅ : Set.{u}).pair ∅} = ω,
    rw [dom_singleton, T3E_a, succ_fun_ran, union_comm], apply union_diff_eq_self_of_subset,
    intros x hx, rw mem_singleton at hx, subst hx, exact zero_nat,
  have hr : succ_fun.inv.ran ∪ ran {(∅ : Set.{u}).pair ∅} = ω,
    rw [ran_single_pair, T3E_b, succ_fun_into_fun.right.left],
    apply union_eq_left_of_subset, intros x hx, rw mem_singleton at hx, subst hx, exact zero_nat,
  nth_rewrite 0 ←hd, rw ←hr, refine union_fun _ singleton_is_fun _,
    rw T3F_a, exact succ_one_to_one,
  rw [dom_singleton, T3E_a, succ_fun_ran, inter_comm], exact self_inter_diff_empty,
end

lemma pred_succ_eq_self {n : Set} (hn : n ∈ ω) : pred.fun_value n.succ = n :=
begin
  symmetry, apply fun_value_def pred_onto_fun.left,
  rw [pred, mem_union, pair_mem_inv], left, apply fun_value_def''' succ_fun_into_fun.left,
    rw succ_fun_into_fun.right.left, exact hn,
  exact succ_fun_value hn,
end

lemma pred_oto {n : Set} (hn : n ∈ ω) (hnz : n ≠ ∅) {m : Set} (hm : m ∈ ω) (hmz : m ≠ ∅)
(h : pred.fun_value n = pred.fun_value m) : n = m :=
begin
  obtain ⟨p, hp, hpe⟩ := exists_pred_of_ne_zero hn hnz,
  obtain ⟨q, hq, hqe⟩ := exists_pred_of_ne_zero hm hmz,
  subst hpe, subst hqe, rw [pred_succ_eq_self hp, pred_succ_eq_self hq] at h, rw h,
end

lemma mod2_spec : ∀ {n : Set.{u}}, n ∈ (ω : Set.{u}) → (mod2.fun_value n = ∅ → ∃ k, k ∈ (ω : Set.{u}) ∧ n = two * k) ∧ (mod2.fun_value n = one → ∃ k, k ∈ (ω : Set.{u}) ∧ n = (two * k).succ) :=
begin
  apply induction,
    split,
      intro h, refine ⟨_, zero_nat, _⟩, rw mul_base two_nat,
    intro h, exfalso, rw mod2_zero at h, exact zero_ne_one h,
  intros n hn hi,
  split,
    intro h, rw mod2_succ hn at h, rw self_eq_one_of_neq_eq_zero (mod2_fun_value_mem hn) h at hi,
    obtain ⟨k, hk, he⟩ := hi.right rfl,
    refine ⟨_, nat_induct.succ_closed hk, _⟩,
    rw [he, mul_ind two_nat hk],
    change (two * k).succ.succ = two * k + one.succ,
    rw [add_ind (mul_into_nat two_nat hk) one_nat],
    rw [one, add_ind (mul_into_nat two_nat hk) zero_nat, add_base (mul_into_nat two_nat hk)],
  intro h, rw mod2_succ hn at h, rw self_eq_zero_of_neq_eq_one (mod2_fun_value_mem hn) h at hi,
  obtain ⟨k, hk, he⟩ := hi.left rfl,
  rw he, exact ⟨_, hk, rfl⟩,
end

lemma mod2_spec_zero {n : Set} (hn : n ∈ ω) (h : mod2.fun_value n = ∅) : ∃ k, k ∈ ω ∧ n = two * k :=
(mod2_spec hn).left h

lemma mod2_spec_one {n : Set} (hn : n ∈ ω) (h : mod2.fun_value n = one) : ∃ k, k ∈ ω ∧ n = (two * k).succ :=
(mod2_spec hn).right h

-- set_option pp.universes true

lemma mod2_spec_one' {n : Set} (hn : n ∈ ω) (h : mod2.fun_value n = one) : ∃ k, k ∈ (ω : Set.{u}) ∧ n = pred.fun_value (two.{u} * succ k) :=
begin
  obtain ⟨k, hk, he⟩ := mod2_spec_one hn h,
  refine ⟨_, hk, _⟩, rw [mul_ind two_nat hk],
  have two_mul_k := mul_into_nat two_nat hk,
  change n = pred.fun_value (two * k + one.succ), rw add_ind two_mul_k one_nat,
  change n = pred.fun_value (two * k + succ ∅).succ, rw add_ind two_mul_k zero_nat,
  rw add_base two_mul_k, rw ←he, symmetry, exact pred_succ_eq_self hn,
end

def divides (n m : Set) : Prop := ∃ k : Set, k ∈ ω ∧ m = k * n
def composite (n : Set) : Prop := ∃ a : Set, a < n ∧ ∃ b : Set, b < n ∧ n = a * b
def prime (n : Set) : Prop := ¬ n.composite

lemma two_pow_lemma {n : Set.{u}} (hn : n ∈ nat.{u}) {m : Set} (hm : m ∈ ω) : two * (two.{u} ^ n * m) = two ^ n.succ * m :=
begin
  have two_exp_n := exp_into_nat two_nat hn,
  rw [exp_ind two_nat hn, mul_assoc two_nat two_exp_n hm, mul_comm two_nat two_exp_n],
end

lemma pre_nonzero_nat_factor_two : ∀ {n : Set.{u}}, n ∈ (ω : Set.{u}) → ∀ {m : Set}, m < n → m ≠ ∅ → ∃ l : Set.{u}, l ∈ (ω : Set.{u}) ∧ ∃ k : Set, k ∈ (ω : Set.{u}) ∧ mod2.fun_value k = one ∧ m = two.{u} ^ l * k :=
begin
  refine @induction _ _ _,
    intros m hm, exfalso, exact mem_empty _ hm,
  intros n hn hi m hmn hmnz,
  have hm : m ∈ (ω : Set.{u}) := mem_nat_of_mem_nat_of_mem (nat_induct.succ_closed hn) hmn,
  have hfe := mod2_fun_value_eq_zero_or_one hm,
  cases hfe,
    obtain ⟨k, hk, he⟩ := mod2_spec_zero hm hfe,
    have hknz : k ≠ ∅, intro hkz, subst hkz, subst he, apply hmnz, rw mul_base two_nat,
    have hsk : k < two * k, nth_rewrite 0 ←one_mul hk,
      rw [lt_def, ←mul_lt_mul_of_lt one_nat two_nat hk hknz], dsimp [two],
      exact self_mem_succ,
    have hkn : k < n, simp only [lt_def] at *, subst he, rw [mem_succ_iff_le, le_iff] at hmn, cases hmn,
        exact lt_trans hk (mul_into_nat two_nat hk) hn hsk hmn,
      rw ←hmn, exact hsk,
    obtain ⟨p, hp, q, hq, hqo, he'⟩ := hi hkn hknz,
    refine ⟨p.succ, nat_induct.succ_closed hp, _, hq, hqo, _⟩,
    rw [he', two_pow_lemma hp hq] at he, exact he,
  refine ⟨_, zero_nat, _, hm, hfe, _⟩,
  rw [exp_base two_nat, one_mul hm],
end

lemma nonzero_nat_factor_two {n : Set} (hn : n ∈ ω) (hnz : n ≠ ∅) :
∃ l : Set.{u}, l ∈ (ω : Set.{u}) ∧ ∃ k : Set, k ∈ (ω : Set.{u}) ∧ mod2.fun_value k = one ∧ n = two.{u} ^ l * k :=
begin
  refine pre_nonzero_nat_factor_two (nat_induct.succ_closed hn) _ hnz,
  rw [lt_def], exact self_mem_succ,
end

lemma mod2_of_sum_mod2_of_mod2 {a : Set.{u}} (ha : a ∈ nat.{u}) {b : Set.{u}} (hb : b ∈ nat.{u})
(habe : two.divides (a + b)) (hae : two.divides a) : two.divides b :=
begin
  obtain ⟨n, hn, hne⟩ := habe,
  obtain ⟨m, hm, hme⟩ := hae,
  have haab : a ≤ a + b, rw [add_comm ha hb], nth_rewrite 0 ←zero_add ha, rw le_iff, by_cases hbe : b = ∅,
      right, rw hbe,
    left, cases nat_order_conn hb zero_nat hbe,
      rw ←add_lt_add_of_lt zero_nat hb ha, exfalso, exact mem_empty _ h,
    rw ←add_lt_add_of_lt zero_nat hb ha, exact h,
  rw [hne, hme] at haab, rw le_iff at haab, cases haab,
    rw [←mul_lt_mul_of_lt hm hn two_nat zero_ne_two.symm, lt_iff hm hn] at haab,
    rcases haab with ⟨q, hq, hqe⟩, rw [hme, ←hqe, mul_comm (add_into_nat hm (nat_induct.succ_closed hq)) two_nat, mul_add two_nat hm (nat_induct.succ_closed hq), mul_comm hm two_nat] at hne,
    have two_mul_m := mul_into_nat two_nat hm,
    have two_mul_q := mul_into_nat two_nat (nat_induct.succ_closed hq),
    refine ⟨_, nat_induct.succ_closed hq, _⟩,
    rw [mul_comm (nat_induct.succ_closed hq) two_nat, cancel_add_left hb two_mul_q two_mul_m], rw hne,
  have n_mul_two := mul_into_nat hn two_nat,
  rw [hme, haab] at hne, nth_rewrite 1 ←add_base n_mul_two at hne,
  refine ⟨∅, zero_nat, _⟩, rw zero_mul two_nat,
  apply cancel_add_left hb zero_nat n_mul_two hne,
end

lemma not_two_divides_one : ¬ two.divides one :=
begin
  rintro ⟨k, hk, he⟩, by_cases h : k = ∅,
    rw [h, zero_mul two_nat] at he, exact zero_ne_one.symm he,
  obtain ⟨m, hm, hme⟩ := exists_pred_of_ne_zero hk h, subst hme,
  have hom : one ≤ m.succ,
    rw le_iff, by_cases hmz : m = ∅,
      right, rw [hmz, one],
    left, rw [one, ←mem_iff_succ_mem_succ zero_nat hm],
    rcases nat_order_conn hm zero_nat hmz with (hmp|hmn),
      exfalso, exact mem_empty _ hmp,
    exact hmn,
  rw le_iff at hom, cases hom,
    rw [he] at hom, nth_rewrite 1 ←mul_one hk at hom,
    rw ←mul_lt_mul_of_lt_left two_nat one_nat hk h at hom,
    apply nat_not_mem_self two_nat, apply lt_trans two_nat one_nat two_nat hom,
    rw two, exact self_mem_succ,
  rw [hom] at he, nth_rewrite 0 ←mul_one hk at he, apply one_ne_two,
  apply cancel_mul_left one_nat two_nat hk h he,
end

lemma mem_two {x : Set} : x ∈ two ↔ x = ∅ ∨ x = one :=
begin
  rw [two, succ, union_comm, mem_union, one, succ, union_empty, mem_singleton, mem_singleton],
end

end Set


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.group.fundamental_domain
import measure_theory.integral.interval_integral
import topology.algebra.floor_ring

/-!
# Integrals of periodic functions

In this file we prove that `∫ x in t..t + T, f x = ∫ x in s..s + T, f x` for any (not necessarily
measurable) function periodic function with period `T`.
-/

open set function measure_theory measure_theory.measure topological_space
open_locale measure_theory

lemma is_add_fundamental_domain_Ioc {T : ℝ} (hT : 0 < T) (t : ℝ) (μ : measure ℝ . volume_tac) :
  is_add_fundamental_domain (add_subgroup.zmultiples T) (Ioc t (t + T)) μ :=
begin
  refine is_add_fundamental_domain.mk' measurable_set_Ioc.null_measurable_set (λ x, _),
  have : bijective (cod_restrict (λ n : ℤ, n • T) (add_subgroup.zmultiples T) _),
    from (equiv.of_injective (λ n : ℤ, n • T) (zsmul_strict_mono_left hT).injective).bijective,
  refine this.exists_unique_iff.2 _,
  simpa only [add_comm x] using exists_unique_add_zsmul_mem_Ioc hT x t
end

variables {E : Type*} [normed_group E] [normed_space ℝ E] [complete_space E]

namespace function

namespace periodic

open interval_integral

variables {f : ℝ → E} {T : ℝ}

/-- An auxiliary lemma for a more general `function.periodic.interval_integral_add_eq`. -/
lemma interval_integral_add_eq_of_pos (hf : periodic f T)
  (hT : 0 < T) (t s : ℝ) : ∫ x in t..t + T, f x = ∫ x in s..s + T, f x :=
begin
  haveI : encodable (add_subgroup.zmultiples T) := (countable_range _).to_encodable,
  simp only [integral_of_le, hT.le, le_add_iff_nonneg_right],
  haveI : vadd_invariant_measure (add_subgroup.zmultiples T) ℝ volume :=
    ⟨λ c s hs, measure_preimage_add _ _ _⟩,
  exact (is_add_fundamental_domain_Ioc hT t).set_integral_eq
    (is_add_fundamental_domain_Ioc hT s) hf.map_vadd_zmultiples
end

/-- If `f` is a periodic function with period `T`, then its integral over `[t, t + T]` does not
depend on `t`. -/
lemma interval_integral_add_eq (hf : periodic f T)
  (t s : ℝ) : ∫ x in t..t + T, f x = ∫ x in s..s + T, f x :=
begin
  rcases lt_trichotomy 0 T with (hT|rfl|hT),
  { exact hf.interval_integral_add_eq_of_pos hT t s },
  { simp },
  { rw [← neg_inj, ← integral_symm, ← integral_symm],
    simpa only [← sub_eq_add_neg, add_sub_cancel]
      using (hf.neg.interval_integral_add_eq_of_pos (neg_pos.2 hT) (t + T) (s + T)) }
end

/-- If `f` is an integrable periodic function with period `T`, then its integral over `[t, s + T]`
is the sum of its integrals over the intervals `[t, s]` and `[t, t + T]`. -/
lemma interval_integral_add_eq_add (hf : periodic f T) (t s : ℝ)
  (h_int : ∀ t₁ t₂, interval_integrable f measure_space.volume t₁ t₂) :
  ∫ x in t..s+T, f x = (∫ x in t..s, f x) + ∫ x in t..t + T, f x :=
by rw [hf.interval_integral_add_eq t s, integral_add_adjacent_intervals (h_int t s) (h_int s _)]

/-- If `f` is an integrable periodic function with period `T`, and `n` is an integer, then its
integral over `[t, t + n • T]` is `n` times its integral over `[t, t + T]`. -/
lemma interval_integral_add_zsmul_eq (hf : periodic f T) (n : ℤ) (t : ℝ)
  (h_int : ∀ t₁ t₂, interval_integrable f measure_space.volume t₁ t₂) :
  ∫ x in t..t + n • T, f x = n • ∫ x in t..t + T, f x :=
begin
  -- Reduce to the case `b = 0`
  suffices : ∫ x in 0..n • T, f x = n • ∫ x in 0..T, f x,
  { simp only [hf.interval_integral_add_eq t 0, (hf.zsmul n).interval_integral_add_eq t 0, zero_add,
      this], },
  -- First prove it for natural numbers
  have : ∀ (m : ℕ), ∫ x in 0..m • T, f x = m • ∫ x in 0..T, f x,
  { intros,
    induction m with m ih,
    { simp, },
    { simp only [succ_nsmul', hf.interval_integral_add_eq_add 0 (m • T) h_int, ih, zero_add], }, },
  -- Then prove it for all integers
  cases n with n n,
  { simp [← this n], },
  { conv_rhs { rw zsmul_neg_succ_of_nat, },
    have h₀ : (int.neg_succ_of_nat n) • T + (n + 1) • T = 0, { simp, linarith, },
    rw [integral_symm, ← (hf.nsmul (n+1)).funext, neg_inj],
    simp_rw [integral_comp_add_right, h₀, zero_add, this (n+1),
      add_comm T, hf.interval_integral_add_eq ((n+1) • T) 0, zero_add], },
end

section real_valued

open filter

variables {g : ℝ → ℝ}
variables (hg : periodic g T) (h_int : ∀ t₁ t₂, interval_integrable g measure_space.volume t₁ t₂)
include hg h_int

/-- If `g : ℝ → ℝ` is periodic with period `T > 0`, then for any `t : ℝ`, the function
`t ↦ ∫ x in 0..t, g x` is bounded below by `t ↦ X + ⌊t/T⌋ • Y` for appropriate constants `X` and
`Y`. -/
lemma Inf_add_zsmul_le_integral_of_pos (hT : 0 < T) (t : ℝ) :
  Inf ((λ t, ∫ x in 0..t, g x) '' (Icc 0 T)) + ⌊t/T⌋ • (∫ x in 0..T, g x) ≤ ∫ x in 0..t, g x :=
begin
  let ε := int.fract (t/T) * T,
  conv_rhs { rw [← int.fract_div_mul_self_add_zsmul_eq T t (by linarith),
    ← integral_add_adjacent_intervals (h_int 0 ε) (h_int _ _)] },
  rw [hg.interval_integral_add_zsmul_eq ⌊t/T⌋ ε h_int, hg.interval_integral_add_eq ε 0, zero_add,
    add_le_add_iff_right],
  exact (continuous_primitive h_int 0).continuous_on.Inf_image_Icc_le
    (mem_Icc_of_Ico (int.fract_div_mul_self_mem_Ico T t hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0`, then for any `t : ℝ`, the function
`t ↦ ∫ x in 0..t, g x` is bounded above by `t ↦ X + ⌊t/T⌋ • Y` for appropriate constants `X` and
`Y`. -/
lemma integral_le_Sup_add_zsmul_of_pos (hT : 0 < T) (t : ℝ) :
  ∫ x in 0..t, g x ≤ Sup ((λ t, ∫ x in 0..t, g x) '' (Icc 0 T)) + ⌊t/T⌋ • (∫ x in 0..T, g x) :=
begin
  let ε := int.fract (t/T) * T,
  conv_lhs { rw [← int.fract_div_mul_self_add_zsmul_eq T t (by linarith),
    ← integral_add_adjacent_intervals (h_int 0 ε) (h_int _ _)] },
  rw [hg.interval_integral_add_zsmul_eq ⌊t/T⌋ ε h_int, hg.interval_integral_add_eq ε 0, zero_add,
    add_le_add_iff_right],
  exact (continuous_primitive h_int 0).continuous_on.le_Sup_image_Icc
    (mem_Icc_of_Ico (int.fract_div_mul_self_mem_Ico T t hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `0 < ∫ x in 0..T, g x`, then
`t ↦ ∫ x in 0..t, g x` tends to `∞` as `t` tends to `∞`. -/
lemma tendsto_at_top_interval_integral_of_pos (h₀ : 0 < ∫ x in 0..T, g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_top at_top :=
begin
  apply tendsto_at_top_mono (hg.Inf_add_zsmul_le_integral_of_pos h_int hT),
  apply at_top.tendsto_at_top_add_const_left (Inf $ (λ t, ∫ x in 0..t, g x) '' (Icc 0 T)),
  apply tendsto.at_top_zsmul_const h₀,
  exact tendsto_floor_at_top.comp (tendsto_id.at_top_mul_const (inv_pos.mpr hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `0 < ∫ x in 0..T, g x`, then
`t ↦ ∫ x in 0..t, g x` tends to `-∞` as `t` tends to `-∞`. -/
lemma tendsto_at_bot_interval_integral_of_pos (h₀ : 0 < ∫ x in 0..T, g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_bot at_bot :=
begin
  apply tendsto_at_bot_mono (hg.integral_le_Sup_add_zsmul_of_pos h_int hT),
  apply at_bot.tendsto_at_bot_add_const_left (Sup $ (λ t, ∫ x in 0..t, g x) '' (Icc 0 T)),
  apply tendsto.at_bot_zsmul_const h₀,
  exact tendsto_floor_at_bot.comp (tendsto_id.at_bot_mul_const (inv_pos.mpr hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `∀ x, 0 < g x`, then `t ↦ ∫ x in 0..t, g x`
tends to `∞` as `t` tends to `∞`. -/
lemma tendsto_at_top_interval_integral_of_pos' (h₀ : ∀ x, 0 < g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_top at_top :=
hg.tendsto_at_top_interval_integral_of_pos h_int (interval_integral_pos_of_pos (h_int 0 T) h₀ hT) hT

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `∀ x, 0 < g x`, then `t ↦ ∫ x in 0..t, g x`
tends to `-∞` as `t` tends to `-∞`. -/
lemma tendsto_at_bot_interval_integral_of_pos' (h₀ : ∀ x, 0 < g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_bot at_bot :=
hg.tendsto_at_bot_interval_integral_of_pos h_int (interval_integral_pos_of_pos (h_int 0 T) h₀ hT) hT

end real_valued

end periodic

end function


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

! This file was ported from Lean 3 source module data.list.range
! leanprover-community/mathlib commit be24ec5de6701447e5df5ca75400ffee19d65659
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Chain
import Mathbin.Data.List.Zip

/-!
# Ranges of naturals as lists

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

This file shows basic results about `list.iota`, `list.range`, `list.range'` (all defined in
`data.list.defs`) and defines `list.fin_range`.
`fin_range n` is the list of elements of `fin n`.
`iota n = [n, n - 1, ..., 1]` and `range n = [0, ..., n - 1]` are basic list constructions used for
tactics. `range' a b = [a, ..., a + b - 1]` is there to help prove properties about them.
Actual maths should use `list.Ico` instead.
-/

universe u

open Nat

namespace List

variable {α : Type u}

#print List.length_range' /-
@[simp]
theorem length_range' : ∀ s n : ℕ, length (range' s n) = n
  | s, 0 => rfl
  | s, n + 1 => congr_arg succ (length_range' _ _)
#align list.length_range' List.length_range'
-/

#print List.range'_eq_nil /-
@[simp]
theorem range'_eq_nil {s n : ℕ} : range' s n = [] ↔ n = 0 := by rw [← length_eq_zero, length_range']
#align list.range'_eq_nil List.range'_eq_nil
-/

#print List.mem_range' /-
@[simp]
theorem mem_range' {m : ℕ} : ∀ {s n : ℕ}, m ∈ range' s n ↔ s ≤ m ∧ m < s + n
  | s, 0 => (false_iff_iff _).2 fun ⟨H1, H2⟩ => not_le_of_lt H2 H1
  | s, succ n =>
    have : m = s → m < s + n + 1 := fun e => e ▸ lt_succ_of_le (Nat.le_add_right _ _)
    have l : m = s ∨ s + 1 ≤ m ↔ s ≤ m := by
      simpa only [eq_comm] using (@Decidable.le_iff_eq_or_lt _ _ _ s m).symm
    (mem_cons _ _ _).trans <| by
      simp only [mem_range', or_and_left, or_iff_right_of_imp this, l, add_right_comm] <;> rfl
#align list.mem_range' List.mem_range'
-/

#print List.map_add_range' /-
theorem map_add_range' (a) : ∀ s n : ℕ, map ((· + ·) a) (range' s n) = range' (a + s) n
  | s, 0 => rfl
  | s, n + 1 => congr_arg (cons _) (map_add_range' (s + 1) n)
#align list.map_add_range' List.map_add_range'
-/

#print List.map_sub_range' /-
theorem map_sub_range' (a) :
    ∀ (s n : ℕ) (h : a ≤ s), map (fun x => x - a) (range' s n) = range' (s - a) n
  | s, 0, _ => rfl
  | s, n + 1, h =>
    by
    convert congr_arg (cons (s - a)) (map_sub_range' (s + 1) n (Nat.le_succ_of_le h))
    rw [Nat.succ_sub h]
    rfl
#align list.map_sub_range' List.map_sub_range'
-/

#print List.chain_succ_range' /-
theorem chain_succ_range' : ∀ s n : ℕ, Chain (fun a b => b = succ a) s (range' (s + 1) n)
  | s, 0 => Chain.nil
  | s, n + 1 => (chain_succ_range' (s + 1) n).cons rfl
#align list.chain_succ_range' List.chain_succ_range'
-/

#print List.chain_lt_range' /-
theorem chain_lt_range' (s n : ℕ) : Chain (· < ·) s (range' (s + 1) n) :=
  (chain_succ_range' s n).imp fun a b e => e.symm ▸ lt_succ_self _
#align list.chain_lt_range' List.chain_lt_range'
-/

#print List.pairwise_lt_range' /-
theorem pairwise_lt_range' : ∀ s n : ℕ, Pairwise (· < ·) (range' s n)
  | s, 0 => Pairwise.nil
  | s, n + 1 => chain_iff_pairwise.1 (chain_lt_range' s n)
#align list.pairwise_lt_range' List.pairwise_lt_range'
-/

#print List.nodup_range' /-
theorem nodup_range' (s n : ℕ) : Nodup (range' s n) :=
  (pairwise_lt_range' s n).imp fun a b => ne_of_lt
#align list.nodup_range' List.nodup_range'
-/

#print List.range'_append /-
@[simp]
theorem range'_append : ∀ s m n : ℕ, range' s m ++ range' (s + m) n = range' s (n + m)
  | s, 0, n => rfl
  | s, m + 1, n =>
    show s :: (range' (s + 1) m ++ range' (s + m + 1) n) = s :: range' (s + 1) (n + m) by
      rw [add_right_comm, range'_append]
#align list.range'_append List.range'_append
-/

#print List.range'_sublist_right /-
theorem range'_sublist_right {s m n : ℕ} : range' s m <+ range' s n ↔ m ≤ n :=
  ⟨fun h => by simpa only [length_range'] using h.length_le, fun h => by
    rw [← tsub_add_cancel_of_le h, ← range'_append] <;> apply sublist_append_left⟩
#align list.range'_sublist_right List.range'_sublist_right
-/

#print List.range'_subset_right /-
theorem range'_subset_right {s m n : ℕ} : range' s m ⊆ range' s n ↔ m ≤ n :=
  ⟨fun h =>
    le_of_not_lt fun hn =>
      lt_irrefl (s + n) <|
        (mem_range'.1 <| h <| mem_range'.2 ⟨Nat.le_add_right _ _, Nat.add_lt_add_left hn s⟩).2,
    fun h => (range'_sublist_right.2 h).Subset⟩
#align list.range'_subset_right List.range'_subset_right
-/

#print List.get?_range' /-
theorem get?_range' : ∀ (s) {m n : ℕ}, m < n → get? (range' s n) m = some (s + m)
  | s, 0, n + 1, _ => rfl
  | s, m + 1, n + 1, h =>
    (nth_range' (s + 1) (lt_of_add_lt_add_right h)).trans <| by rw [add_right_comm] <;> rfl
#align list.nth_range' List.get?_range'
-/

#print List.nthLe_range' /-
@[simp]
theorem nthLe_range' {n m} (i) (H : i < (range' n m).length) : nthLe (range' n m) i H = n + i :=
  Option.some.inj <| by rw [← nth_le_nth _, nth_range' _ (by simpa using H)]
#align list.nth_le_range' List.nthLe_range'
-/

#print List.range'_concat /-
theorem range'_concat (s n : ℕ) : range' s (n + 1) = range' s n ++ [s + n] := by
  rw [add_comm n 1] <;> exact (range'_append s n 1).symm
#align list.range'_concat List.range'_concat
-/

#print List.range_loop_range' /-
theorem range_loop_range' : ∀ s n : ℕ, List.range.loop s (range' s n) = range' 0 (n + s)
  | 0, n => rfl
  | s + 1, n => by
    rw [show n + (s + 1) = n + 1 + s from add_right_comm n s 1] <;>
      exact range_core_range' s (n + 1)
#align list.range_core_range' List.range_loop_range'
-/

#print List.range_eq_range' /-
theorem range_eq_range' (n : ℕ) : range n = range' 0 n :=
  (range_loop_range' n 0).trans <| by rw [zero_add]
#align list.range_eq_range' List.range_eq_range'
-/

#print List.range_succ_eq_map /-
theorem range_succ_eq_map (n : ℕ) : range (n + 1) = 0 :: map succ (range n) := by
  rw [range_eq_range', range_eq_range', range', add_comm, ← map_add_range'] <;> congr <;>
    exact funext one_add
#align list.range_succ_eq_map List.range_succ_eq_map
-/

#print List.range'_eq_map_range /-
theorem range'_eq_map_range (s n : ℕ) : range' s n = map ((· + ·) s) (range n) := by
  rw [range_eq_range', map_add_range'] <;> rfl
#align list.range'_eq_map_range List.range'_eq_map_range
-/

#print List.length_range /-
@[simp]
theorem length_range (n : ℕ) : length (range n) = n := by simp only [range_eq_range', length_range']
#align list.length_range List.length_range
-/

#print List.range_eq_nil /-
@[simp]
theorem range_eq_nil {n : ℕ} : range n = [] ↔ n = 0 := by rw [← length_eq_zero, length_range]
#align list.range_eq_nil List.range_eq_nil
-/

#print List.pairwise_lt_range /-
theorem pairwise_lt_range (n : ℕ) : Pairwise (· < ·) (range n) := by
  simp only [range_eq_range', pairwise_lt_range']
#align list.pairwise_lt_range List.pairwise_lt_range
-/

#print List.pairwise_le_range /-
theorem pairwise_le_range (n : ℕ) : Pairwise (· ≤ ·) (range n) :=
  Pairwise.imp (@le_of_lt ℕ _) (pairwise_lt_range _)
#align list.pairwise_le_range List.pairwise_le_range
-/

#print List.nodup_range /-
theorem nodup_range (n : ℕ) : Nodup (range n) := by simp only [range_eq_range', nodup_range']
#align list.nodup_range List.nodup_range
-/

#print List.range_sublist /-
theorem range_sublist {m n : ℕ} : range m <+ range n ↔ m ≤ n := by
  simp only [range_eq_range', range'_sublist_right]
#align list.range_sublist List.range_sublist
-/

#print List.range_subset /-
theorem range_subset {m n : ℕ} : range m ⊆ range n ↔ m ≤ n := by
  simp only [range_eq_range', range'_subset_right]
#align list.range_subset List.range_subset
-/

#print List.mem_range /-
@[simp]
theorem mem_range {m n : ℕ} : m ∈ range n ↔ m < n := by
  simp only [range_eq_range', mem_range', Nat.zero_le, true_and_iff, zero_add]
#align list.mem_range List.mem_range
-/

#print List.not_mem_range_self /-
@[simp]
theorem not_mem_range_self {n : ℕ} : n ∉ range n :=
  mt mem_range.1 <| lt_irrefl _
#align list.not_mem_range_self List.not_mem_range_self
-/

#print List.self_mem_range_succ /-
@[simp]
theorem self_mem_range_succ (n : ℕ) : n ∈ range (n + 1) := by
  simp only [succ_pos', lt_add_iff_pos_right, mem_range]
#align list.self_mem_range_succ List.self_mem_range_succ
-/

#print List.get?_range /-
theorem get?_range {m n : ℕ} (h : m < n) : get? (range n) m = some m := by
  simp only [range_eq_range', nth_range' _ h, zero_add]
#align list.nth_range List.get?_range
-/

#print List.range_succ /-
theorem range_succ (n : ℕ) : range (succ n) = range n ++ [n] := by
  simp only [range_eq_range', range'_concat, zero_add]
#align list.range_succ List.range_succ
-/

#print List.range_zero /-
@[simp]
theorem range_zero : range 0 = [] :=
  rfl
#align list.range_zero List.range_zero
-/

#print List.chain'_range_succ /-
theorem chain'_range_succ (r : ℕ → ℕ → Prop) (n : ℕ) :
    Chain' r (range n.succ) ↔ ∀ m < n, r m m.succ :=
  by
  rw [range_succ]
  induction' n with n hn
  · simp
  · rw [range_succ]
    simp only [append_assoc, singleton_append, chain'_append_cons_cons, chain'_singleton,
      and_true_iff]
    rw [hn, forall_lt_succ]
#align list.chain'_range_succ List.chain'_range_succ
-/

#print List.chain_range_succ /-
theorem chain_range_succ (r : ℕ → ℕ → Prop) (n a : ℕ) :
    Chain r a (range n.succ) ↔ r a 0 ∧ ∀ m < n, r m m.succ :=
  by
  rw [range_succ_eq_map, chain_cons, and_congr_right_iff, ← chain'_range_succ, range_succ_eq_map]
  exact fun _ => Iff.rfl
#align list.chain_range_succ List.chain_range_succ
-/

#print List.range_add /-
theorem range_add (a : ℕ) : ∀ b, range (a + b) = range a ++ (range b).map fun x => a + x
  | 0 => by rw [add_zero, range_zero, map_nil, append_nil]
  | b + 1 => by
    rw [Nat.add_succ, range_succ, range_add b, range_succ, map_append, map_singleton, append_assoc]
#align list.range_add List.range_add
-/

#print List.iota_eq_reverse_range' /-
theorem iota_eq_reverse_range' : ∀ n : ℕ, iota n = reverse (range' 1 n)
  | 0 => rfl
  | n + 1 => by
    simp only [iota, range'_concat, iota_eq_reverse_range' n, reverse_append, add_comm] <;> rfl
#align list.iota_eq_reverse_range' List.iota_eq_reverse_range'
-/

#print List.length_iota /-
@[simp]
theorem length_iota (n : ℕ) : length (iota n) = n := by
  simp only [iota_eq_reverse_range', length_reverse, length_range']
#align list.length_iota List.length_iota
-/

#print List.pairwise_gt_iota /-
theorem pairwise_gt_iota (n : ℕ) : Pairwise (· > ·) (iota n) := by
  simp only [iota_eq_reverse_range', pairwise_reverse, pairwise_lt_range']
#align list.pairwise_gt_iota List.pairwise_gt_iota
-/

#print List.nodup_iota /-
theorem nodup_iota (n : ℕ) : Nodup (iota n) :=
  (pairwise_gt_iota n).imp fun a b => ne_of_gt
#align list.nodup_iota List.nodup_iota
-/

#print List.mem_iota /-
theorem mem_iota {m n : ℕ} : m ∈ iota n ↔ 1 ≤ m ∧ m ≤ n := by
  simp only [iota_eq_reverse_range', mem_reverse, mem_range', add_comm, lt_succ_iff]
#align list.mem_iota List.mem_iota
-/

#print List.reverse_range' /-
theorem reverse_range' : ∀ s n : ℕ, reverse (range' s n) = map (fun i => s + n - 1 - i) (range n)
  | s, 0 => rfl
  | s, n + 1 => by
    rw [range'_concat, reverse_append, range_succ_eq_map] <;>
      simpa only [show s + (n + 1) - 1 = s + n from rfl, (· ∘ ·), fun a i =>
        show a - 1 - i = a - succ i from pred_sub _ _, reverse_singleton, map_cons, tsub_zero,
        cons_append, nil_append, eq_self_iff_true, true_and_iff, map_map] using reverse_range' s n
#align list.reverse_range' List.reverse_range'
-/

#print List.finRange /-
/-- All elements of `fin n`, from `0` to `n-1`. The corresponding finset is `finset.univ`. -/
def finRange (n : ℕ) : List (Fin n) :=
  (range n).pmap Fin.mk fun _ => List.mem_range.1
#align list.fin_range List.finRange
-/

#print List.finRange_zero /-
@[simp]
theorem finRange_zero : finRange 0 = [] :=
  rfl
#align list.fin_range_zero List.finRange_zero
-/

#print List.mem_finRange /-
@[simp]
theorem mem_finRange {n : ℕ} (a : Fin n) : a ∈ finRange n :=
  mem_pmap.2
    ⟨a.1, mem_range.2 a.2, by
      cases a
      rfl⟩
#align list.mem_fin_range List.mem_finRange
-/

#print List.nodup_finRange /-
theorem nodup_finRange (n : ℕ) : (finRange n).Nodup :=
  Pairwise.pmap (nodup_range n) _ fun _ _ _ _ => @Fin.ne_of_vne _ ⟨_, _⟩ ⟨_, _⟩
#align list.nodup_fin_range List.nodup_finRange
-/

#print List.length_finRange /-
@[simp]
theorem length_finRange (n : ℕ) : (finRange n).length = n := by
  rw [fin_range, length_pmap, length_range]
#align list.length_fin_range List.length_finRange
-/

#print List.finRange_eq_nil /-
@[simp]
theorem finRange_eq_nil {n : ℕ} : finRange n = [] ↔ n = 0 := by
  rw [← length_eq_zero, length_fin_range]
#align list.fin_range_eq_nil List.finRange_eq_nil
-/

/- warning: list.prod_range_succ -> List.prod_range_succ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Monoid.{u1} α] (f : Nat -> α) (n : Nat), Eq.{succ u1} α (List.prod.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (List.map.{0, u1} Nat α f (List.range (Nat.succ n)))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1))) (List.prod.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (List.map.{0, u1} Nat α f (List.range n))) (f n))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Monoid.{u1} α] (f : Nat -> α) (n : Nat), Eq.{succ u1} α (List.prod.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (Monoid.toOne.{u1} α _inst_1) (List.map.{0, u1} Nat α f (List.range (Nat.succ n)))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1))) (List.prod.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (Monoid.toOne.{u1} α _inst_1) (List.map.{0, u1} Nat α f (List.range n))) (f n))
Case conversion may be inaccurate. Consider using '#align list.prod_range_succ List.prod_range_succₓ'. -/
@[to_additive]
theorem prod_range_succ {α : Type u} [Monoid α] (f : ℕ → α) (n : ℕ) :
    ((range n.succ).map f).Prod = ((range n).map f).Prod * f n := by
  rw [range_succ, map_append, map_singleton, prod_append, prod_cons, prod_nil, mul_one]
#align list.prod_range_succ List.prod_range_succ
#align list.sum_range_succ List.sum_range_succ

/- warning: list.prod_range_succ' -> List.prod_range_succ' is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Monoid.{u1} α] (f : Nat -> α) (n : Nat), Eq.{succ u1} α (List.prod.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (List.map.{0, u1} Nat α f (List.range (Nat.succ n)))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1))) (f (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) (List.prod.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (List.map.{0, u1} Nat α (fun (i : Nat) => f (Nat.succ i)) (List.range n))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Monoid.{u1} α] (f : Nat -> α) (n : Nat), Eq.{succ u1} α (List.prod.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (Monoid.toOne.{u1} α _inst_1) (List.map.{0, u1} Nat α f (List.range (Nat.succ n)))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1))) (f (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) (List.prod.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) (Monoid.toOne.{u1} α _inst_1) (List.map.{0, u1} Nat α (fun (i : Nat) => f (Nat.succ i)) (List.range n))))
Case conversion may be inaccurate. Consider using '#align list.prod_range_succ' List.prod_range_succ'ₓ'. -/
/-- A variant of `prod_range_succ` which pulls off the first
  term in the product rather than the last.-/
@[to_additive
      "A variant of `sum_range_succ` which pulls off the first term in the sum\n  rather than the last."]
theorem prod_range_succ' {α : Type u} [Monoid α] (f : ℕ → α) (n : ℕ) :
    ((range n.succ).map f).Prod = f 0 * ((range n).map fun i => f (succ i)).Prod :=
  Nat.recOn n (show 1 * f 0 = f 0 * 1 by rw [one_mul, mul_one]) fun _ hd => by
    rw [List.prod_range_succ, hd, mul_assoc, ← List.prod_range_succ]
#align list.prod_range_succ' List.prod_range_succ'
#align list.sum_range_succ' List.sum_range_succ'

#print List.enum_from_map_fst /-
@[simp]
theorem enum_from_map_fst : ∀ (n) (l : List α), map Prod.fst (enumFrom n l) = range' n l.length
  | n, [] => rfl
  | n, a :: l => congr_arg (cons _) (enum_from_map_fst _ _)
#align list.enum_from_map_fst List.enum_from_map_fst
-/

#print List.enum_map_fst /-
@[simp]
theorem enum_map_fst (l : List α) : map Prod.fst (enum l) = range l.length := by
  simp only [enum, enum_from_map_fst, range_eq_range']
#align list.enum_map_fst List.enum_map_fst
-/

#print List.enum_eq_zip_range /-
theorem enum_eq_zip_range (l : List α) : l.enum = (range l.length).zip l :=
  zip_of_prod (enum_map_fst _) (enum_map_snd _)
#align list.enum_eq_zip_range List.enum_eq_zip_range
-/

#print List.unzip_enum_eq_prod /-
@[simp]
theorem unzip_enum_eq_prod (l : List α) : l.enum.unzip = (range l.length, l) := by
  simp only [enum_eq_zip_range, unzip_zip, length_range]
#align list.unzip_enum_eq_prod List.unzip_enum_eq_prod
-/

#print List.enum_from_eq_zip_range' /-
theorem enum_from_eq_zip_range' (l : List α) {n : ℕ} : l.enumFrom n = (range' n l.length).zip l :=
  zip_of_prod (enum_from_map_fst _ _) (enumFrom_map_snd _ _)
#align list.enum_from_eq_zip_range' List.enum_from_eq_zip_range'
-/

#print List.unzip_enum_from_eq_prod /-
@[simp]
theorem unzip_enum_from_eq_prod (l : List α) {n : ℕ} :
    (l.enumFrom n).unzip = (range' n l.length, l) := by
  simp only [enum_from_eq_zip_range', unzip_zip, length_range']
#align list.unzip_enum_from_eq_prod List.unzip_enum_from_eq_prod
-/

#print List.nthLe_range /-
@[simp]
theorem nthLe_range {n} (i) (H : i < (range n).length) : nthLe (range n) i H = i :=
  Option.some.inj <| by rw [← nth_le_nth _, nth_range (by simpa using H)]
#align list.nth_le_range List.nthLe_range
-/

#print List.nthLe_finRange /-
@[simp]
theorem nthLe_finRange {n : ℕ} {i : ℕ} (h) : (finRange n).nthLe i h = ⟨i, length_finRange n ▸ h⟩ :=
  by simp only [fin_range, nth_le_range, nth_le_pmap]
#align list.nth_le_fin_range List.nthLe_finRange
-/

end List