import analysis.normed.group.SemiNormedGroup.kernels
/-!

# Seminormed groups with an extra automorphism

This file contains definition 8.13 of `analytic.pdf`, a category-theoretic
definition of a seminormed group eqipped with an automorphism which scales
norms by a fixed factor `r`.

-/

open_locale nnreal

/-- A `normed_with_aut r V` structure on a seminormed group `V`
consists of an automorphism `T` satisfying `∥T v∥ = r * ∥v∥`.

In other words, it is a normed `ℤ[T^{±1}]`-module satisfying `∥T v∥ = r * ∥v∥`.

Definition 8.13 of [Analytic] -/
class normed_with_aut (r : out_param ℝ≥0) (V : SemiNormedGroup) :=
(T : V ≅ V)
(norm_T : ∀ v : V, ∥(T.hom : V → V) v∥ = r * ∥v∥)

variables {r : ℝ≥0} (V : SemiNormedGroup) [normed_with_aut r V] [fact (0 < r)]

namespace normed_with_aut

lemma norm_T_inv (v : V) : ∥T.inv v∥ = r⁻¹ * ∥v∥ :=
begin
  calc ∥(T.inv : V → V) v∥
      = r⁻¹ * ∥T.hom (T.inv v)∥ : _
  ... = r⁻¹ * ∥v∥ : _,
  { rw [normed_with_aut.norm_T, inv_mul_cancel_left₀],
    apply ne_of_gt,
    rw nnreal.coe_pos,
    exact ‹fact (0 < r)›.out },
  { rw [← category_theory.comp_apply, T.inv_hom_id], refl }
end

end normed_with_aut

#lint- only unused_arguments def_lemma doc_blame


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Floris van Doorn
-/
import data.set.countable
import set_theory.schroeder_bernstein
import data.fintype.card
import data.nat.enat

/-!
# Cardinal Numbers

We define cardinal numbers as a quotient of types under the equivalence relation of equinumerity.

## Main definitions

* `cardinal` the type of cardinal numbers (in a given universe).
* `cardinal.mk α` or `#α` is the cardinality of `α`. The notation `#` lives in the locale
  `cardinal`.
* There is an instance that `cardinal` forms a `canonically_ordered_comm_semiring`.
* Addition `c₁ + c₂` is defined by `cardinal.add_def α β : #α + #β = #(α ⊕ β)`.
* Multiplication `c₁ * c₂` is defined by `cardinal.mul_def : #α * #β = #(α * β)`.
* The order `c₁ ≤ c₂` is defined by `cardinal.le_def α β : #α ≤ #β ↔ nonempty (α ↪ β)`.
* Exponentiation `c₁ ^ c₂` is defined by `cardinal.power_def α β : #α ^ #β = #(β → α)`.
* `cardinal.omega` the cardinality of `ℕ`. This definition is universe polymorphic:
  `cardinal.omega.{u} : cardinal.{u}`
  (contrast with `ℕ : Type`, which lives in a specific universe).
  In some cases the universe level has to be given explicitly.
* `cardinal.min (I : nonempty ι) (c : ι → cardinal)` is the minimal cardinal in the range of `c`.
* `cardinal.succ c` is the successor cardinal, the smallest cardinal larger than `c`.
* `cardinal.sum` is the sum of a collection of cardinals.
* `cardinal.sup` is the supremum of a collection of cardinals.
* `cardinal.powerlt c₁ c₂` or `c₁ ^< c₂` is defined as `sup_{γ < β} α^γ`.

## Main Statements

* Cantor's theorem: `cardinal.cantor c : c < 2 ^ c`.
* König's theorem: `cardinal.sum_lt_prod`

## Implementation notes

* There is a type of cardinal numbers in every universe level:
  `cardinal.{u} : Type (u + 1)` is the quotient of types in `Type u`.
  The operation `cardinal.lift` lifts cardinal numbers to a higher level.
* Cardinal arithmetic specifically for infinite cardinals (like `κ * κ = κ`) is in the file
  `set_theory/cardinal_ordinal.lean`.
* There is an instance `has_pow cardinal`, but this will only fire if Lean already knows that both
  the base and the exponent live in the same universe. As a workaround, you can add
  ```
    local infixr ^ := @has_pow.pow cardinal cardinal cardinal.has_pow
  ```
  to a file. This notation will work even if Lean doesn't know yet that the base and the exponent
  live in the same universe (but no exponents in other types can be used).

## References

* <https://en.wikipedia.org/wiki/Cardinal_number>

## Tags

cardinal number, cardinal arithmetic, cardinal exponentiation, omega,
Cantor's theorem, König's theorem
-/

open function set
open_locale classical

universes u v w x
variables {α β : Type u}

/-- The equivalence relation on types given by equivalence (bijective correspondence) of types.
  Quotienting by this equivalence relation gives the cardinal numbers.
-/
instance cardinal.is_equivalent : setoid (Type u) :=
{ r := λα β, nonempty (α ≃ β),
  iseqv := ⟨λα,
    ⟨equiv.refl α⟩,
    λα β ⟨e⟩, ⟨e.symm⟩,
    λα β γ ⟨e₁⟩ ⟨e₂⟩, ⟨e₁.trans e₂⟩⟩ }

/-- `cardinal.{u}` is the type of cardinal numbers in `Type u`,
  defined as the quotient of `Type u` by existence of an equivalence
  (a bijection with explicit inverse). -/
def cardinal : Type (u + 1) := quotient cardinal.is_equivalent

namespace cardinal

/-- The cardinal number of a type -/
def mk : Type u → cardinal := quotient.mk

localized "notation `#` := cardinal.mk" in cardinal

protected lemma eq : mk α = mk β ↔ nonempty (α ≃ β) := quotient.eq

@[simp] theorem mk_def (α : Type u) : @eq cardinal ⟦α⟧ (mk α) := rfl

@[simp] theorem mk_out (c : cardinal) : mk (c.out) = c := quotient.out_eq _

/-- We define the order on cardinal numbers by `mk α ≤ mk β` if and only if
  there exists an embedding (injective function) from α to β. -/
instance : has_le cardinal.{u} :=
⟨λq₁ q₂, quotient.lift_on₂ q₁ q₂ (λα β, nonempty $ α ↪ β) $
  assume α β γ δ ⟨e₁⟩ ⟨e₂⟩,
    propext ⟨assume ⟨e⟩, ⟨e.congr e₁ e₂⟩, assume ⟨e⟩, ⟨e.congr e₁.symm e₂.symm⟩⟩⟩

theorem le_def (α β : Type u) : mk α ≤ mk β ↔ nonempty (α ↪ β) :=
iff.rfl

theorem mk_le_of_injective {α β : Type u} {f : α → β} (hf : injective f) : mk α ≤ mk β :=
⟨⟨f, hf⟩⟩

theorem mk_le_of_surjective {α β : Type u} {f : α → β} (hf : surjective f) : mk β ≤ mk α :=
⟨embedding.of_surjective f hf⟩

theorem le_mk_iff_exists_set {c : cardinal} {α : Type u} :
  c ≤ mk α ↔ ∃ p : set α, mk p = c :=
⟨quotient.induction_on c $ λ β ⟨⟨f, hf⟩⟩,
  ⟨set.range f, eq.symm $ quot.sound ⟨equiv.of_injective f hf⟩⟩,
λ ⟨p, e⟩, e ▸ ⟨⟨subtype.val, λ a b, subtype.eq⟩⟩⟩

theorem out_embedding {c c' : cardinal} : c ≤ c' ↔ nonempty (c.out ↪ c'.out) :=
by { transitivity _, rw [←quotient.out_eq c, ←quotient.out_eq c'], refl }

protected lemma eq_congr : α ≃ β → # α = # β :=
λ h, quot.sound ⟨h⟩

noncomputable instance : linear_order cardinal.{u} :=
{ le          := (≤),
  le_refl     := by rintros ⟨α⟩; exact ⟨embedding.refl _⟩,
  le_trans    := by rintros ⟨α⟩ ⟨β⟩ ⟨γ⟩ ⟨e₁⟩ ⟨e₂⟩; exact ⟨e₁.trans e₂⟩,
  le_antisymm := by rintros ⟨α⟩ ⟨β⟩ ⟨e₁⟩ ⟨e₂⟩; exact quotient.sound (e₁.antisymm e₂),
  le_total    := by rintros ⟨α⟩ ⟨β⟩; exact embedding.total,
  decidable_le := classical.dec_rel _ }

-- short-circuit type class inference
noncomputable instance : distrib_lattice cardinal.{u} := by apply_instance

instance : has_zero cardinal.{u} := ⟨⟦pempty⟧⟩

instance : inhabited cardinal.{u} := ⟨0⟩

theorem ne_zero_iff_nonempty {α : Type u} : mk α ≠ 0 ↔ nonempty α :=
not_iff_comm.1
  ⟨λ h, quotient.sound ⟨(equiv.empty_of_not_nonempty h).trans equiv.empty_equiv_pempty⟩,
   λ e, let ⟨h⟩ := quotient.exact e in λ ⟨a⟩, (h a).elim⟩

instance : has_one cardinal.{u} := ⟨⟦punit⟧⟩

instance : nontrivial cardinal.{u} :=
⟨⟨1, 0, ne_zero_iff_nonempty.2 ⟨punit.star⟩⟩⟩

theorem le_one_iff_subsingleton {α : Type u} : mk α ≤ 1 ↔ subsingleton α :=
⟨λ ⟨f⟩, ⟨λ a b, f.injective (subsingleton.elim _ _)⟩,
 λ ⟨h⟩, ⟨⟨λ a, punit.star, λ a b _, h _ _⟩⟩⟩

theorem one_lt_iff_nontrivial {α : Type u} : 1 < mk α ↔ nontrivial α :=
by { rw [← not_iff_not, not_nontrivial_iff_subsingleton, ← le_one_iff_subsingleton], simp }

instance : has_add cardinal.{u} :=
⟨λq₁ q₂, quotient.lift_on₂ q₁ q₂ (λα β, mk (α ⊕ β)) $ assume α β γ δ ⟨e₁⟩ ⟨e₂⟩,
  quotient.sound ⟨equiv.sum_congr e₁ e₂⟩⟩

@[simp] theorem add_def (α β) : mk α + mk β = mk (α ⊕ β) := rfl

instance : has_mul cardinal.{u} :=
⟨λq₁ q₂, quotient.lift_on₂ q₁ q₂ (λα β, mk (α × β)) $ assume α β γ δ ⟨e₁⟩ ⟨e₂⟩,
  quotient.sound ⟨equiv.prod_congr e₁ e₂⟩⟩

@[simp] theorem mul_def (α β : Type u) : mk α * mk β = mk (α × β) := rfl

private theorem add_comm (a b : cardinal.{u}) : a + b = b + a :=
quotient.induction_on₂ a b $ assume α β, quotient.sound ⟨equiv.sum_comm α β⟩

private theorem mul_comm (a b : cardinal.{u}) : a * b = b * a :=
quotient.induction_on₂ a b $ assume α β, quotient.sound ⟨equiv.prod_comm α β⟩

private theorem zero_add (a : cardinal.{u}) : 0 + a = a :=
quotient.induction_on a $ assume α, quotient.sound ⟨equiv.pempty_sum α⟩

private theorem zero_mul (a : cardinal.{u}) : 0 * a = 0 :=
quotient.induction_on a $ assume α, quotient.sound ⟨equiv.pempty_prod α⟩

private theorem one_mul (a : cardinal.{u}) : 1 * a = a :=
quotient.induction_on a $ assume α, quotient.sound ⟨equiv.punit_prod α⟩

private theorem left_distrib (a b c : cardinal.{u}) : a * (b + c) = a * b + a * c :=
quotient.induction_on₃ a b c $ assume α β γ, quotient.sound ⟨equiv.prod_sum_distrib α β γ⟩

protected theorem eq_zero_or_eq_zero_of_mul_eq_zero  {a b : cardinal.{u}} :
  a * b = 0 → a = 0 ∨ b = 0 :=
begin
  refine quotient.induction_on b _,
  refine quotient.induction_on a _,
  intros a b h,
  contrapose h,
  simp_rw [not_or_distrib, ← ne.def] at h,
  have := @prod.nonempty a b (ne_zero_iff_nonempty.mp h.1) (ne_zero_iff_nonempty.mp h.2),
  exact ne_zero_iff_nonempty.mpr this
end

instance : comm_semiring cardinal.{u} :=
{ zero          := 0,
  one           := 1,
  add           := (+),
  mul           := (*),
  zero_add      := zero_add,
  add_zero      := assume a, by rw [add_comm a 0, zero_add a],
  add_assoc     := λa b c, quotient.induction_on₃ a b c $ assume α β γ,
    quotient.sound ⟨equiv.sum_assoc α β γ⟩,
  add_comm      := add_comm,
  zero_mul      := zero_mul,
  mul_zero      := assume a, by rw [mul_comm a 0, zero_mul a],
  one_mul       := one_mul,
  mul_one       := assume a, by rw [mul_comm a 1, one_mul a],
  mul_assoc     := λa b c, quotient.induction_on₃ a b c $ assume α β γ,
    quotient.sound ⟨equiv.prod_assoc α β γ⟩,
  mul_comm      := mul_comm,
  left_distrib  := left_distrib,
  right_distrib := assume a b c,
    by rw [mul_comm (a + b) c, left_distrib c a b, mul_comm c a, mul_comm c b] }

/-- The cardinal exponential. `mk α ^ mk β` is the cardinal of `β → α`. -/
protected def power (a b : cardinal.{u}) : cardinal.{u} :=
quotient.lift_on₂ a b (λα β, mk (β → α)) $ assume α₁ α₂ β₁ β₂ ⟨e₁⟩ ⟨e₂⟩,
  quotient.sound ⟨equiv.arrow_congr e₂ e₁⟩

instance : has_pow cardinal cardinal := ⟨cardinal.power⟩
local infixr ^ := @has_pow.pow cardinal cardinal cardinal.has_pow

@[simp] theorem power_def (α β) : mk α ^ mk β = mk (β → α) := rfl

@[simp] theorem power_zero {a : cardinal} : a ^ 0 = 1 :=
quotient.induction_on a $ assume α, quotient.sound
⟨equiv.pempty_arrow_equiv_punit α⟩

@[simp] theorem power_one {a : cardinal} : a ^ 1 = a :=
quotient.induction_on a $ assume α, quotient.sound
⟨equiv.punit_arrow_equiv α⟩

@[simp] theorem one_power {a : cardinal} : 1 ^ a = 1 :=
quotient.induction_on a $ assume α, quotient.sound
⟨equiv.arrow_punit_equiv_punit α⟩

@[simp] theorem prop_eq_two : mk (ulift Prop) = 2 :=
quot.sound ⟨equiv.ulift.trans $ equiv.Prop_equiv_bool.trans equiv.bool_equiv_punit_sum_punit⟩

@[simp] theorem zero_power {a : cardinal} : a ≠ 0 → 0 ^ a = 0 :=
quotient.induction_on a $ assume α heq,
nonempty.rec_on (ne_zero_iff_nonempty.1 heq) $ assume a,
quotient.sound ⟨equiv.equiv_pempty $ assume f, pempty.rec (λ _, false) (f a)⟩

theorem power_ne_zero {a : cardinal} (b) : a ≠ 0 → a ^ b ≠ 0 :=
quotient.induction_on₂ a b $ λ α β h,
let ⟨a⟩ := ne_zero_iff_nonempty.1 h in
ne_zero_iff_nonempty.2 ⟨λ _, a⟩

theorem mul_power {a b c : cardinal} : (a * b) ^ c = a ^ c * b ^ c :=
quotient.induction_on₃ a b c $ assume α β γ,
  quotient.sound ⟨equiv.arrow_prod_equiv_prod_arrow α β γ⟩

theorem power_add {a b c : cardinal} : a ^ (b + c) = a ^ b * a ^ c :=
quotient.induction_on₃ a b c $ assume α β γ,
  quotient.sound ⟨equiv.sum_arrow_equiv_prod_arrow β γ α⟩

theorem power_mul {a b c : cardinal} : (a ^ b) ^ c = a ^ (b * c) :=
by rw [_root_.mul_comm b c];
from (quotient.induction_on₃ a b c $ assume α β γ,
  quotient.sound ⟨equiv.arrow_arrow_equiv_prod_arrow γ β α⟩)

@[simp] lemma pow_cast_right (κ : cardinal.{u}) :
  ∀ n : ℕ, (κ ^ (↑n : cardinal.{u})) = @has_pow.pow _ _ monoid.has_pow κ n
| 0 := by simp
| (_+1) := by rw [nat.cast_succ, power_add, power_one, _root_.mul_comm, pow_succ, pow_cast_right]

section order_properties
open sum

protected theorem zero_le : ∀(a : cardinal), 0 ≤ a :=
by rintro ⟨α⟩; exact ⟨embedding.of_not_nonempty $ λ ⟨a⟩, a.elim⟩

protected theorem add_le_add : ∀{a b c d : cardinal}, a ≤ b → c ≤ d → a + c ≤ b + d :=
by rintros ⟨α⟩ ⟨β⟩ ⟨γ⟩ ⟨δ⟩ ⟨e₁⟩ ⟨e₂⟩; exact ⟨e₁.sum_map e₂⟩

protected theorem add_le_add_left (a) {b c : cardinal} : b ≤ c → a + b ≤ a + c :=
cardinal.add_le_add (le_refl _)

protected theorem le_iff_exists_add {a b : cardinal} : a ≤ b ↔ ∃ c, b = a + c :=
⟨quotient.induction_on₂ a b $ λ α β ⟨⟨f, hf⟩⟩,
  have (α ⊕ ((range f)ᶜ : set β)) ≃ β, from
    (equiv.sum_congr (equiv.of_injective f hf) (equiv.refl _)).trans $
    (equiv.set.sum_compl (range f)),
  ⟨⟦↥(range f)ᶜ⟧, quotient.sound ⟨this.symm⟩⟩,
 λ ⟨c, e⟩, add_zero a ▸ e.symm ▸ cardinal.add_le_add_left _ (cardinal.zero_le _)⟩

instance : order_bot cardinal.{u} :=
{ bot := 0, bot_le := cardinal.zero_le, ..cardinal.linear_order }

instance : canonically_ordered_comm_semiring cardinal.{u} :=
{ add_le_add_left       := λ a b h c, cardinal.add_le_add_left _ h,
  lt_of_add_lt_add_left := λ a b c, lt_imp_lt_of_le_imp_le (cardinal.add_le_add_left _),
  le_iff_exists_add     := @cardinal.le_iff_exists_add,
  eq_zero_or_eq_zero_of_mul_eq_zero := @cardinal.eq_zero_or_eq_zero_of_mul_eq_zero,
  ..cardinal.order_bot,
  ..cardinal.comm_semiring, ..cardinal.linear_order }

noncomputable instance : canonically_linear_ordered_add_monoid cardinal.{u} :=
{ .. (infer_instance : canonically_ordered_add_monoid cardinal.{u}),
  .. cardinal.linear_order }

@[simp] theorem zero_lt_one : (0 : cardinal) < 1 :=
lt_of_le_of_ne (zero_le _) zero_ne_one

lemma zero_power_le (c : cardinal.{u}) : (0 : cardinal.{u}) ^ c ≤ 1 :=
by { by_cases h : c = 0, rw [h, power_zero], rw [zero_power h], apply zero_le }

theorem power_le_power_left : ∀{a b c : cardinal}, a ≠ 0 → b ≤ c → a ^ b ≤ a ^ c :=
by rintros ⟨α⟩ ⟨β⟩ ⟨γ⟩ hα ⟨e⟩; exact
  let ⟨a⟩ := ne_zero_iff_nonempty.1 hα in
  ⟨@embedding.arrow_congr_right _ _ _ ⟨a⟩ e⟩

theorem power_le_max_power_one {a b c : cardinal} (h : b ≤ c) : a ^ b ≤ max (a ^ c) 1 :=
begin
  by_cases ha : a = 0,
  simp [ha, zero_power_le],
  exact le_trans (power_le_power_left ha h) (le_max_left _ _)
end

theorem power_le_power_right {a b c : cardinal} : a ≤ b → a ^ c ≤ b ^ c :=
quotient.induction_on₃ a b c $ assume α β γ ⟨e⟩, ⟨embedding.arrow_congr_left e⟩

end order_properties

theorem cantor : ∀(a : cardinal.{u}), a < 2 ^ a :=
by rw ← prop_eq_two; rintros ⟨a⟩; exact ⟨
  ⟨⟨λ a b, ⟨a = b⟩, λ a b h, cast (ulift.up.inj (@congr_fun _ _ _ _ h b)).symm rfl⟩⟩,
  λ ⟨⟨f, hf⟩⟩, cantor_injective (λ s, f (λ a, ⟨s a⟩)) $
    λ s t h, by funext a; injection congr_fun (hf h) a⟩

instance : no_top_order cardinal.{u} :=
{ no_top := λ a, ⟨_, cantor a⟩, ..cardinal.linear_order }

/-- The minimum cardinal in a family of cardinals (the existence
  of which is provided by `injective_min`). -/
noncomputable def min {ι} (I : nonempty ι) (f : ι → cardinal) : cardinal :=
f $ classical.some $
@embedding.min_injective _ (λ i, (f i).out) I

theorem min_eq {ι} (I) (f : ι → cardinal) : ∃ i, min I f = f i :=
⟨_, rfl⟩

theorem min_le {ι I} (f : ι → cardinal) (i) : min I f ≤ f i :=
by rw [← mk_out (min I f), ← mk_out (f i)]; exact
let ⟨g⟩ := classical.some_spec
  (@embedding.min_injective _ (λ i, (f i).out) I) in
⟨g i⟩

theorem le_min {ι I} {f : ι → cardinal} {a} : a ≤ min I f ↔ ∀ i, a ≤ f i :=
⟨λ h i, le_trans h (min_le _ _),
 λ h, let ⟨i, e⟩ := min_eq I f in e.symm ▸ h i⟩

protected theorem wf : @well_founded cardinal.{u} (<) :=
⟨λ a, classical.by_contradiction $ λ h,
  let ι := {c :cardinal // ¬ acc (<) c},
      f : ι → cardinal := subtype.val,
      ⟨⟨c, hc⟩, hi⟩ := @min_eq ι ⟨⟨_, h⟩⟩ f in
    hc (acc.intro _ (λ j ⟨_, h'⟩,
      classical.by_contradiction $ λ hj, h' $
      by have := min_le f ⟨j, hj⟩; rwa hi at this))⟩

instance has_wf : @has_well_founded cardinal.{u} := ⟨(<), cardinal.wf⟩

instance wo : @is_well_order cardinal.{u} (<) := ⟨cardinal.wf⟩

/-- The successor cardinal - the smallest cardinal greater than
  `c`. This is not the same as `c + 1` except in the case of finite `c`. -/
noncomputable def succ (c : cardinal) : cardinal :=
@min {c' // c < c'} ⟨⟨_, cantor _⟩⟩ subtype.val

theorem lt_succ_self (c : cardinal) : c < succ c :=
by cases min_eq _ _ with s e; rw [succ, e]; exact s.2

theorem succ_le {a b : cardinal} : succ a ≤ b ↔ a < b :=
⟨lt_of_lt_of_le (lt_succ_self _), λ h,
  by exact min_le _ (subtype.mk b h)⟩

theorem lt_succ {a b : cardinal} : a < succ b ↔ a ≤ b :=
by rw [← not_le, succ_le, not_lt]

theorem add_one_le_succ (c : cardinal) : c + 1 ≤ succ c :=
begin
  refine quot.induction_on c (λ α, _) (lt_succ_self c),
  refine quot.induction_on (succ (quot.mk setoid.r α)) (λ β h, _),
  cases h.left with f,
  have : ¬ surjective f := λ hn,
    ne_of_lt h (quotient.sound ⟨equiv.of_bijective f ⟨f.injective, hn⟩⟩),
  cases not_forall.1 this with b nex,
  refine ⟨⟨sum.rec (by exact f) _, _⟩⟩,
  { exact λ _, b },
  { intros a b h, rcases a with a|⟨⟨⟨⟩⟩⟩; rcases b with b|⟨⟨⟨⟩⟩⟩,
    { rw f.injective h },
    { exact nex.elim ⟨_, h⟩ },
    { exact nex.elim ⟨_, h.symm⟩ },
    { refl } }
end

lemma succ_ne_zero (c : cardinal) : succ c ≠ 0 :=
by { rw [←pos_iff_ne_zero, lt_succ], apply zero_le }

/-- The indexed sum of cardinals is the cardinality of the
  indexed disjoint union, i.e. sigma type. -/
def sum {ι} (f : ι → cardinal) : cardinal := mk Σ i, (f i).out

theorem le_sum {ι} (f : ι → cardinal) (i) : f i ≤ sum f :=
by rw ← quotient.out_eq (f i); exact
⟨⟨λ a, ⟨i, a⟩, λ a b h, eq_of_heq $ by injection h⟩⟩

@[simp] theorem sum_mk {ι} (f : ι → Type*) : sum (λ i, mk (f i)) = mk (Σ i, f i) :=
quot.sound ⟨equiv.sigma_congr_right $ λ i,
  classical.choice $ quotient.exact $ quot.out_eq $ mk (f i)⟩

theorem sum_const (ι : Type u) (a : cardinal.{u}) : sum (λ _:ι, a) = mk ι * a :=
quotient.induction_on a $ λ α, by simp; exact
  quotient.sound ⟨equiv.sigma_equiv_prod _ _⟩

theorem sum_le_sum {ι} (f g : ι → cardinal) (H : ∀ i, f i ≤ g i) : sum f ≤ sum g :=
⟨(embedding.refl _).sigma_map $ λ i, classical.choice $
  by have := H i; rwa [← quot.out_eq (f i), ← quot.out_eq (g i)] at this⟩

/-- The indexed supremum of cardinals is the smallest cardinal above
  everything in the family. -/
noncomputable def sup {ι} (f : ι → cardinal) : cardinal :=
@min {c // ∀ i, f i ≤ c} ⟨⟨sum f, le_sum f⟩⟩ (λ a, a.1)

theorem le_sup {ι} (f : ι → cardinal) (i) : f i ≤ sup f :=
by dsimp [sup]; cases min_eq _ _ with c hc; rw hc; exact c.2 i

theorem sup_le {ι} {f : ι → cardinal} {a} : sup f ≤ a ↔ ∀ i, f i ≤ a :=
⟨λ h i, le_trans (le_sup _ _) h,
 λ h, by dsimp [sup]; change a with (⟨a, h⟩:subtype _).1; apply min_le⟩

theorem sup_le_sup {ι} (f g : ι → cardinal) (H : ∀ i, f i ≤ g i) : sup f ≤ sup g :=
sup_le.2 $ λ i, le_trans (H i) (le_sup _ _)

theorem sup_le_sum {ι} (f : ι → cardinal) : sup f ≤ sum f :=
sup_le.2 $ le_sum _

theorem sum_le_sup {ι : Type u} (f : ι → cardinal.{u}) : sum f ≤ mk ι * sup.{u u} f :=
by rw ← sum_const; exact sum_le_sum _ _ (le_sup _)

theorem sup_eq_zero {ι} {f : ι → cardinal} (h : ι → false) : sup f = 0 :=
by { rw [← nonpos_iff_eq_zero, sup_le], intro x, exfalso, exact h x }

/-- The indexed product of cardinals is the cardinality of the Pi type
  (dependent product). -/
def prod {ι : Type u} (f : ι → cardinal) : cardinal := mk (Π i, (f i).out)

@[simp] theorem prod_mk {ι} (f : ι → Type*) : prod (λ i, mk (f i)) = mk (Π i, f i) :=
quot.sound ⟨equiv.Pi_congr_right $ λ i,
  classical.choice $ quotient.exact $ mk_out $ mk (f i)⟩

theorem prod_const (ι : Type u) (a : cardinal.{u}) : prod (λ _:ι, a) = a ^ mk ι :=
quotient.induction_on a $ by simp

theorem prod_le_prod {ι} (f g : ι → cardinal) (H : ∀ i, f i ≤ g i) : prod f ≤ prod g :=
⟨embedding.Pi_congr_right $ λ i, classical.choice $
  by have := H i; rwa [← mk_out (f i), ← mk_out (g i)] at this⟩

theorem prod_ne_zero {ι} (f : ι → cardinal) : prod f ≠ 0 ↔ ∀ i, f i ≠ 0 :=
begin
  suffices : nonempty (Π i, (f i).out) ↔ ∀ i, nonempty (f i).out,
  { simpa [← ne_zero_iff_nonempty, prod] },
  exact classical.nonempty_pi
end

theorem prod_eq_zero {ι} (f : ι → cardinal) : prod f = 0 ↔ ∃ i, f i = 0 :=
not_iff_not.1 $ by simpa using prod_ne_zero f

/-- The universe lift operation on cardinals. You can specify the universes explicitly with
  `lift.{u v} : cardinal.{u} → cardinal.{max u v}` -/
def lift (c : cardinal.{u}) : cardinal.{max u v} :=
quotient.lift_on c (λ α, ⟦ulift α⟧) $ λ α β ⟨e⟩,
quotient.sound ⟨equiv.ulift.trans $ e.trans equiv.ulift.symm⟩

theorem lift_mk (α) : lift.{u v} (mk α) = mk (ulift.{v u} α) := rfl

theorem lift_umax : lift.{u (max u v)} = lift.{u v} :=
funext $ λ a, quot.induction_on a $ λ α,
quotient.sound ⟨equiv.ulift.trans equiv.ulift.symm⟩

theorem lift_id' (a : cardinal) : lift a = a :=
quot.induction_on a $ λ α, quot.sound ⟨equiv.ulift⟩

@[simp] theorem lift_id : ∀ a, lift.{u u} a = a := lift_id'.{u u}

@[simp] theorem lift_lift (a : cardinal) :
  lift.{(max u v) w} (lift.{u v} a) = lift.{u (max v w)} a :=
quot.induction_on a $ λ α,
quotient.sound ⟨equiv.ulift.trans $ equiv.ulift.trans equiv.ulift.symm⟩

theorem lift_mk_le {α : Type u} {β : Type v} :
  lift.{u (max v w)} (mk α) ≤ lift.{v (max u w)} (mk β) ↔ nonempty (α ↪ β) :=
⟨λ ⟨f⟩, ⟨embedding.congr equiv.ulift equiv.ulift f⟩,
 λ ⟨f⟩, ⟨embedding.congr equiv.ulift.symm equiv.ulift.symm f⟩⟩

theorem lift_mk_eq {α : Type u} {β : Type v} :
  lift.{u (max v w)} (mk α) = lift.{v (max u w)} (mk β) ↔ nonempty (α ≃ β) :=
quotient.eq.trans
⟨λ ⟨f⟩, ⟨equiv.ulift.symm.trans $ f.trans equiv.ulift⟩,
 λ ⟨f⟩, ⟨equiv.ulift.trans $ f.trans equiv.ulift.symm⟩⟩

@[simp] theorem lift_le {a b : cardinal} : lift a ≤ lift b ↔ a ≤ b :=
quotient.induction_on₂ a b $ λ α β,
by rw ← lift_umax; exact lift_mk_le

@[simp] theorem lift_inj {a b : cardinal} : lift a = lift b ↔ a = b :=
by simp [le_antisymm_iff]

@[simp] theorem lift_lt {a b : cardinal} : lift a < lift b ↔ a < b :=
by simp [lt_iff_le_not_le, -not_le]

@[simp] theorem lift_zero : lift 0 = 0 :=
quotient.sound ⟨equiv.ulift.trans equiv.pempty_equiv_pempty⟩

@[simp] theorem lift_one : lift 1 = 1 :=
quotient.sound ⟨equiv.ulift.trans equiv.punit_equiv_punit⟩

@[simp] theorem lift_add (a b) : lift (a + b) = lift a + lift b :=
quotient.induction_on₂ a b $ λ α β,
quotient.sound ⟨equiv.ulift.trans (equiv.sum_congr equiv.ulift equiv.ulift).symm⟩

@[simp] theorem lift_mul (a b) : lift (a * b) = lift a * lift b :=
quotient.induction_on₂ a b $ λ α β,
quotient.sound ⟨equiv.ulift.trans (equiv.prod_congr equiv.ulift equiv.ulift).symm⟩

@[simp] theorem lift_power (a b) : lift (a ^ b) = lift a ^ lift b :=
quotient.induction_on₂ a b $ λ α β,
quotient.sound ⟨equiv.ulift.trans (equiv.arrow_congr equiv.ulift equiv.ulift).symm⟩

@[simp] theorem lift_two_power (a) : lift (2 ^ a) = 2 ^ lift a :=
by simp [bit0]

@[simp] theorem lift_min {ι I} (f : ι → cardinal) : lift (min I f) = min I (lift ∘ f) :=
le_antisymm (le_min.2 $ λ a, lift_le.2 $ min_le _ a) $
let ⟨i, e⟩ := min_eq I (lift ∘ f) in
by rw e; exact lift_le.2 (le_min.2 $ λ j, lift_le.1 $
by have := min_le (lift ∘ f) j; rwa e at this)

theorem lift_down {a : cardinal.{u}} {b : cardinal.{max u v}} :
  b ≤ lift a → ∃ a', lift a' = b :=
quotient.induction_on₂ a b $ λ α β,
by dsimp; rw [← lift_id (mk β), ← lift_umax, ← lift_umax.{u v}, lift_mk_le]; exact
λ ⟨f⟩, ⟨mk (set.range f), eq.symm $ lift_mk_eq.2
  ⟨embedding.equiv_of_surjective
    (embedding.cod_restrict _ f set.mem_range_self)
    $ λ ⟨a, ⟨b, e⟩⟩, ⟨b, subtype.eq e⟩⟩⟩

theorem le_lift_iff {a : cardinal.{u}} {b : cardinal.{max u v}} :
  b ≤ lift a ↔ ∃ a', lift a' = b ∧ a' ≤ a :=
⟨λ h, let ⟨a', e⟩ := lift_down h in ⟨a', e, lift_le.1 $ e.symm ▸ h⟩,
 λ ⟨a', e, h⟩, e ▸ lift_le.2 h⟩

theorem lt_lift_iff {a : cardinal.{u}} {b : cardinal.{max u v}} :
  b < lift a ↔ ∃ a', lift a' = b ∧ a' < a :=
⟨λ h, let ⟨a', e⟩ := lift_down (le_of_lt h) in
      ⟨a', e, lift_lt.1 $ e.symm ▸ h⟩,
 λ ⟨a', e, h⟩, e ▸ lift_lt.2 h⟩

@[simp] theorem lift_succ (a) : lift (succ a) = succ (lift a) :=
le_antisymm
  (le_of_not_gt $ λ h, begin
    rcases lt_lift_iff.1 h with ⟨b, e, h⟩,
    rw [lt_succ, ← lift_le, e] at h,
    exact not_lt_of_le h (lt_succ_self _)
  end)
  (succ_le.2 $ lift_lt.2 $ lt_succ_self _)

@[simp] theorem lift_max {a : cardinal.{u}} {b : cardinal.{v}} :
  lift.{u (max v w)} a = lift.{v (max u w)} b ↔ lift.{u v} a = lift.{v u} b :=
calc lift.{u (max v w)} a = lift.{v (max u w)} b
  ↔ lift.{(max u v) w} (lift.{u v} a)
    = lift.{(max u v) w} (lift.{v u} b) : by simp
  ... ↔ lift.{u v} a = lift.{v u} b : lift_inj

theorem mk_prod {α : Type u} {β : Type v} :
  mk (α × β) = lift.{u v} (mk α) * lift.{v u} (mk β) :=
quotient.sound ⟨equiv.prod_congr (equiv.ulift).symm (equiv.ulift).symm⟩

theorem sum_const_eq_lift_mul (ι : Type u) (a : cardinal.{v}) :
  sum (λ _:ι, a) = lift.{u v} (mk ι) * lift.{v u} a :=
begin
  apply quotient.induction_on a,
  intro α,
  simp only [cardinal.mk_def, cardinal.sum_mk, cardinal.lift_id],
  convert mk_prod using 1,
  exact quotient.sound ⟨equiv.sigma_equiv_prod ι α⟩,
end

/-- `ω` is the smallest infinite cardinal, also known as ℵ₀. -/
def omega : cardinal.{u} := lift (mk ℕ)

lemma mk_nat : mk nat = omega := (lift_id _).symm

theorem omega_ne_zero : omega ≠ 0 :=
ne_zero_iff_nonempty.2 ⟨⟨0⟩⟩

theorem omega_pos : 0 < omega :=
pos_iff_ne_zero.2 omega_ne_zero

@[simp] theorem lift_omega : lift omega = omega := lift_lift _

/- properties about the cast from nat -/

@[simp] theorem mk_fin : ∀ (n : ℕ), mk (fin n) = n
| 0     := quotient.sound ⟨(equiv.pempty_of_not_nonempty $ λ ⟨h⟩, h.elim0)⟩
| (n+1) := by rw [nat.cast_succ, ← mk_fin]; exact
  quotient.sound (fintype.card_eq.1 $ by simp)

@[simp] theorem lift_nat_cast (n : ℕ) : lift n = n :=
by induction n; simp *

lemma lift_eq_nat_iff {a : cardinal.{u}} {n : ℕ} : lift.{u v} a = n ↔ a = n :=
by rw [← lift_nat_cast.{u v} n, lift_inj]

lemma nat_eq_lift_eq_iff {n : ℕ} {a : cardinal.{u}} :
  (n : cardinal) = lift.{u v} a ↔ (n : cardinal) = a :=
by rw [← lift_nat_cast.{u v} n, lift_inj]

theorem lift_mk_fin (n : ℕ) : lift (mk (fin n)) = n := by simp

theorem fintype_card (α : Type u) [fintype α] : mk α = fintype.card α :=
by rw [← lift_mk_fin.{u}, ← lift_id (mk α), lift_mk_eq.{u 0 u}];
   exact fintype.card_eq.1 (by simp)

theorem card_le_of_finset {α} (s : finset α) :
  (s.card : cardinal) ≤ cardinal.mk α :=
begin
  rw (_ : (s.card : cardinal) = cardinal.mk (↑s : set α)),
  { exact ⟨function.embedding.subtype _⟩ },
  rw [cardinal.fintype_card, fintype.card_coe]
end

@[simp, norm_cast] theorem nat_cast_pow {m n : ℕ} : (↑(pow m n) : cardinal) = m ^ n :=
by induction n; simp [pow_succ', -_root_.add_comm, power_add, *]

@[simp, norm_cast] theorem nat_cast_le {m n : ℕ} : (m : cardinal) ≤ n ↔ m ≤ n :=
by rw [← lift_mk_fin, ← lift_mk_fin, lift_le]; exact
⟨λ ⟨⟨f, hf⟩⟩, by simpa only [fintype.card_fin] using fintype.card_le_of_injective f hf,
  λ h, ⟨(fin.cast_le h).to_embedding⟩⟩

@[simp, norm_cast] theorem nat_cast_lt {m n : ℕ} : (m : cardinal) < n ↔ m < n :=
by simp [lt_iff_le_not_le, -not_le]

@[simp, norm_cast] theorem nat_cast_inj {m n : ℕ} : (m : cardinal) = n ↔ m = n :=
by simp [le_antisymm_iff]

@[simp, norm_cast, priority 900] theorem nat_succ (n : ℕ) : (n.succ : cardinal) = succ n :=
le_antisymm (add_one_le_succ _) (succ_le.2 $ nat_cast_lt.2 $ nat.lt_succ_self _)

@[simp] theorem succ_zero : succ 0 = 1 :=
by norm_cast

theorem card_le_of {α : Type u} {n : ℕ} (H : ∀ s : finset α, s.card ≤ n) :
  # α ≤ n :=
begin
  refine lt_succ.1 (lt_of_not_ge $ λ hn, _),
  rw [← cardinal.nat_succ, ← cardinal.lift_mk_fin n.succ] at hn,
  cases hn with f,
  refine not_lt_of_le (H $ finset.univ.map f) _,
  rw [finset.card_map, ← fintype.card, fintype.card_ulift, fintype.card_fin],
  exact n.lt_succ_self
end

theorem cantor' (a) {b : cardinal} (hb : 1 < b) : a < b ^ a :=
by rw [← succ_le, (by norm_cast : succ 1 = 2)] at hb;
   exact lt_of_lt_of_le (cantor _) (power_le_power_right hb)

theorem one_le_iff_pos {c : cardinal} : 1 ≤ c ↔ 0 < c :=
by rw [← succ_zero, succ_le]

theorem one_le_iff_ne_zero {c : cardinal} : 1 ≤ c ↔ c ≠ 0 :=
by rw [one_le_iff_pos, pos_iff_ne_zero]

theorem nat_lt_omega (n : ℕ) : (n : cardinal.{u}) < omega :=
succ_le.1 $ by rw [← nat_succ, ← lift_mk_fin, omega, lift_mk_le.{0 0 u}]; exact
⟨⟨coe, λ a b, fin.ext⟩⟩

@[simp] theorem one_lt_omega : 1 < omega :=
by simpa using nat_lt_omega 1

theorem lt_omega {c : cardinal.{u}} : c < omega ↔ ∃ n : ℕ, c = n :=
⟨λ h, begin
  rcases lt_lift_iff.1 h with ⟨c, rfl, h'⟩,
  rcases le_mk_iff_exists_set.1 h'.1 with ⟨S, rfl⟩,
  suffices : finite S,
  { cases this, resetI,
    existsi fintype.card S,
    rw [← lift_nat_cast.{0 u}, lift_inj, fintype_card S] },
  by_contra nf,
  have P : ∀ (n : ℕ) (IH : ∀ i<n, S), ∃ a : S, ¬ ∃ y h, IH y h = a :=
    λ n IH,
    let g : {i | i < n} → S := λ ⟨i, h⟩, IH i h in
    not_forall.1 (λ h, nf
      ⟨fintype.of_surjective g (λ a, subtype.exists.2 (h a))⟩),
  let F : ℕ → S := nat.lt_wf.fix (λ n IH, classical.some (P n IH)),
  refine not_le_of_lt h' ⟨⟨F, _⟩⟩,
  suffices : ∀ (n : ℕ) (m < n), F m ≠ F n,
  { refine λ m n, not_imp_not.1 (λ ne, _),
    rcases lt_trichotomy m n with h|h|h,
    { exact this n m h },
    { contradiction },
    { exact (this m n h).symm } },
  intros n m h,
  have := classical.some_spec (P n (λ y _, F y)),
  rw [← show F n = classical.some (P n (λ y _, F y)),
      from nat.lt_wf.fix_eq (λ n IH, classical.some (P n IH)) n] at this,
  exact λ e, this ⟨m, h, e⟩,
end, λ ⟨n, e⟩, e.symm ▸ nat_lt_omega _⟩

theorem omega_le {c : cardinal.{u}} : omega ≤ c ↔ ∀ n : ℕ, (n:cardinal) ≤ c :=
⟨λ h n, le_trans (le_of_lt (nat_lt_omega _)) h,
 λ h, le_of_not_lt $ λ hn, begin
  rcases lt_omega.1 hn with ⟨n, rfl⟩,
  exact not_le_of_lt (nat.lt_succ_self _) (nat_cast_le.1 (h (n+1)))
end⟩

theorem lt_omega_iff_fintype {α : Type u} : mk α < omega ↔ nonempty (fintype α) :=
lt_omega.trans ⟨λ ⟨n, e⟩, begin
  rw [← lift_mk_fin n] at e,
  cases quotient.exact e with f,
  exact ⟨fintype.of_equiv _ f.symm⟩
end, λ ⟨_⟩, by exactI ⟨_, fintype_card _⟩⟩

theorem lt_omega_iff_finite {α} {S : set α} : mk S < omega ↔ finite S :=
lt_omega_iff_fintype

instance can_lift_cardinal_nat : can_lift cardinal ℕ :=
⟨ coe, λ x, x < omega, λ x hx, let ⟨n, hn⟩ := lt_omega.mp hx in ⟨n, hn.symm⟩⟩

theorem add_lt_omega {a b : cardinal} (ha : a < omega) (hb : b < omega) : a + b < omega :=
match a, b, lt_omega.1 ha, lt_omega.1 hb with
| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by rw [← nat.cast_add]; apply nat_lt_omega
end

lemma add_lt_omega_iff {a b : cardinal} : a + b < omega ↔ a < omega ∧ b < omega :=
⟨λ h, ⟨lt_of_le_of_lt (self_le_add_right _ _) h, lt_of_le_of_lt (self_le_add_left _ _) h⟩,
  λ⟨h1, h2⟩, add_lt_omega h1 h2⟩

theorem mul_lt_omega {a b : cardinal} (ha : a < omega) (hb : b < omega) : a * b < omega :=
match a, b, lt_omega.1 ha, lt_omega.1 hb with
| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by rw [← nat.cast_mul]; apply nat_lt_omega
end

lemma mul_lt_omega_iff {a b : cardinal} : a * b < omega ↔ a = 0 ∨ b = 0 ∨ a < omega ∧ b < omega :=
begin
  split,
  { intro h, by_cases ha : a = 0, { left, exact ha },
    right, by_cases hb : b = 0, { left, exact hb },
    right, rw [← ne, ← one_le_iff_ne_zero] at ha hb, split,
    { rw [← mul_one a],
      refine lt_of_le_of_lt (canonically_ordered_semiring.mul_le_mul (le_refl a) hb) h },
    { rw [← _root_.one_mul b],
      refine lt_of_le_of_lt (canonically_ordered_semiring.mul_le_mul ha (le_refl b)) h }},
  rintro (rfl|rfl|⟨ha,hb⟩); simp only [*, mul_lt_omega, omega_pos, _root_.zero_mul, mul_zero]
end

lemma mul_lt_omega_iff_of_ne_zero {a b : cardinal} (ha : a ≠ 0) (hb : b ≠ 0) :
  a * b < omega ↔ a < omega ∧ b < omega :=
by simp [mul_lt_omega_iff, ha, hb]

theorem power_lt_omega {a b : cardinal} (ha : a < omega) (hb : b < omega) : a ^ b < omega :=
match a, b, lt_omega.1 ha, lt_omega.1 hb with
| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by rw [← nat_cast_pow]; apply nat_lt_omega
end

lemma eq_one_iff_subsingleton_and_nonempty {α : Type*} :
  mk α = 1 ↔ (subsingleton α ∧ nonempty α) :=
calc mk α = 1 ↔ mk α ≤ 1 ∧ ¬mk α < 1 : eq_iff_le_not_lt
          ... ↔ subsingleton α ∧ nonempty α :
begin
  apply and_congr le_one_iff_subsingleton,
  push_neg,
  rw [one_le_iff_ne_zero, ne_zero_iff_nonempty]
end

theorem infinite_iff {α : Type u} : infinite α ↔ omega ≤ mk α :=
by rw [←not_lt, lt_omega_iff_fintype, not_nonempty_fintype]

lemma denumerable_iff {α : Type u} : nonempty (denumerable α) ↔ mk α = omega :=
⟨λ⟨h⟩, quotient.sound $ by exactI ⟨ (denumerable.eqv α).trans equiv.ulift.symm ⟩,
 λ h, by { cases quotient.exact h with f, exact ⟨denumerable.mk' $ f.trans equiv.ulift⟩ }⟩

lemma countable_iff (s : set α) : countable s ↔ mk s ≤ omega :=
begin
  rw [countable_iff_exists_injective], split,
  rintro ⟨f, hf⟩, exact ⟨embedding.trans ⟨f, hf⟩ equiv.ulift.symm.to_embedding⟩,
  rintro ⟨f'⟩, cases embedding.trans f' equiv.ulift.to_embedding with f hf, exact ⟨f, hf⟩
end

/-- This function sends finite cardinals to the corresponding natural, and infinite cardinals
  to 0. -/
noncomputable def to_nat : zero_hom cardinal ℕ :=
⟨λ c, if h : c < omega.{v} then classical.some (lt_omega.1 h) else 0,
  begin
    have h : 0 < omega := nat_lt_omega 0,
    rw [dif_pos h, ← cardinal.nat_cast_inj, ← classical.some_spec (lt_omega.1 h), nat.cast_zero],
  end⟩

lemma to_nat_apply_of_lt_omega {c : cardinal} (h : c < omega) :
  c.to_nat = classical.some (lt_omega.1 h) :=
dif_pos h

@[simp]
lemma to_nat_apply_of_omega_le {c : cardinal} (h : omega ≤ c) :
  c.to_nat = 0 :=
dif_neg (not_lt_of_le h)

@[simp]
lemma cast_to_nat_of_lt_omega {c : cardinal} (h : c < omega) :
  ↑c.to_nat = c :=
by rw [to_nat_apply_of_lt_omega h, ← classical.some_spec (lt_omega.1 h)]

@[simp]
lemma to_nat_cast (n : ℕ) : cardinal.to_nat n = n :=
begin
  rw [to_nat_apply_of_lt_omega (nat_lt_omega n), ← nat_cast_inj],
  exact (classical.some_spec (lt_omega.1 (nat_lt_omega n))).symm,
end

/-- `to_nat` has a right-inverse: coercion. -/
lemma to_nat_right_inverse : function.right_inverse (coe : ℕ → cardinal) to_nat := to_nat_cast

lemma to_nat_surjective : surjective to_nat := to_nat_right_inverse.surjective

@[simp]
lemma mk_to_nat_of_infinite [h : infinite α] : (mk α).to_nat = 0 :=
dif_neg (not_lt_of_le (infinite_iff.1 h))

@[simp]
lemma mk_to_nat_eq_card [fintype α] : (mk α).to_nat = fintype.card α :=
by simp [fintype_card]

@[simp]
lemma zero_to_nat : cardinal.to_nat 0 = 0 :=
by rw [← to_nat_cast 0, nat.cast_zero]

@[simp]
lemma one_to_nat : cardinal.to_nat 1 = 1 :=
by rw [← to_nat_cast 1, nat.cast_one]

/-- This function sends finite cardinals to the corresponding natural, and infinite cardinals
  to `⊤`. -/
noncomputable def to_enat : cardinal →+ enat :=
{ to_fun := λ c, if c < omega.{v} then c.to_nat else ⊤,
  map_zero' := by simp [if_pos (lt_trans zero_lt_one one_lt_omega)],
  map_add' := λ x y, begin
    by_cases hx : x < omega,
    { obtain ⟨x0, rfl⟩ := lt_omega.1 hx,
      by_cases hy : y < omega,
      { obtain ⟨y0, rfl⟩ := lt_omega.1 hy,
        simp only [add_lt_omega hx hy, hx, hy, to_nat_cast, if_true],
        rw [← nat.cast_add, to_nat_cast, enat.coe_add] },
      { rw [if_neg hy, if_neg, enat.add_top],
        contrapose! hy,
        apply lt_of_le_of_lt (le_add_left (le_refl y)) hy } },
    { rw [if_neg hx, if_neg, enat.top_add],
      contrapose! hx,
      apply lt_of_le_of_lt (le_add_right (le_refl x)) hx },
  end }

@[simp]
lemma to_enat_apply_of_lt_omega {c : cardinal} (h : c < omega) :
  c.to_enat = c.to_nat :=
if_pos h

@[simp]
lemma to_enat_apply_of_omega_le {c : cardinal} (h : omega ≤ c) :
  c.to_enat = ⊤ :=
if_neg (not_lt_of_le h)

@[simp]
lemma to_enat_cast (n : ℕ) : cardinal.to_enat n = n :=
by rw [to_enat_apply_of_lt_omega (nat_lt_omega n), to_nat_cast]

@[simp]
lemma mk_to_enat_of_infinite [h : infinite α] : (mk α).to_enat = ⊤ :=
to_enat_apply_of_omega_le (infinite_iff.1 h)

lemma to_enat_surjective : surjective to_enat :=
begin
  intro x,
  exact enat.cases_on x ⟨omega, to_enat_apply_of_omega_le (le_refl omega)⟩
    (λ n, ⟨n, to_enat_cast n⟩),
end

@[simp]
lemma mk_to_enat_eq_coe_card [fintype α] : (mk α).to_enat = fintype.card α :=
by simp [fintype_card]

lemma mk_int : mk ℤ = omega :=
denumerable_iff.mp ⟨by apply_instance⟩

lemma mk_pnat : mk ℕ+ = omega :=
denumerable_iff.mp ⟨by apply_instance⟩

lemma two_le_iff : (2 : cardinal) ≤ mk α ↔ ∃x y : α, x ≠ y :=
begin
  split,
  { rintro ⟨f⟩, refine ⟨f $ sum.inl ⟨⟩, f $ sum.inr ⟨⟩, _⟩, intro h, cases f.2 h },
  { rintro ⟨x, y, h⟩, by_contra h',
    rw [not_le, ←nat.cast_two, nat_succ, lt_succ, nat.cast_one, le_one_iff_subsingleton] at h',
    apply h, exactI subsingleton.elim _ _ }
end

lemma two_le_iff' (x : α) : (2 : cardinal) ≤ mk α ↔ ∃y : α, x ≠ y :=
begin
  rw [two_le_iff],
  split,
  { rintro ⟨y, z, h⟩, refine classical.by_cases (λ(h' : x = y), _) (λ h', ⟨y, h'⟩),
    rw [←h'] at h, exact ⟨z, h⟩ },
  { rintro ⟨y, h⟩, exact ⟨x, y, h⟩ }
end

/-- König's theorem -/
theorem sum_lt_prod {ι} (f g : ι → cardinal) (H : ∀ i, f i < g i) : sum f < prod g :=
lt_of_not_ge $ λ ⟨F⟩, begin
  have : inhabited (Π (i : ι), (g i).out),
  { refine ⟨λ i, classical.choice $ ne_zero_iff_nonempty.1 _⟩,
    rw mk_out,
    exact ne_of_gt (lt_of_le_of_lt (zero_le _) (H i)) }, resetI,
  let G := inv_fun F,
  have sG : surjective G := inv_fun_surjective F.2,
  choose C hc using show ∀ i, ∃ b, ∀ a, G ⟨i, a⟩ i ≠ b,
  { assume i,
    simp only [- not_exists, not_exists.symm, not_forall.symm],
    refine λ h, not_le_of_lt (H i) _,
    rw [← mk_out (f i), ← mk_out (g i)],
    exact ⟨embedding.of_surjective _ h⟩ },
  exact (let ⟨⟨i, a⟩, h⟩ := sG C in hc i a (congr_fun h _))
end

@[simp] theorem mk_empty : mk empty = 0 :=
fintype_card empty

@[simp] theorem mk_pempty : mk pempty = 0 :=
fintype_card pempty

@[simp] theorem mk_plift_of_false {p : Prop} (h : ¬ p) : mk (plift p) = 0 :=
quotient.sound ⟨equiv.plift.trans $ equiv.equiv_pempty h⟩

theorem mk_unit : mk unit = 1 :=
(fintype_card unit).trans nat.cast_one

@[simp] theorem mk_punit : mk punit = 1 :=
(fintype_card punit).trans nat.cast_one

@[simp] theorem mk_singleton {α : Type u} (x : α) : mk ({x} : set α) = 1 :=
quotient.sound ⟨equiv.set.singleton x⟩

@[simp] theorem mk_plift_of_true {p : Prop} (h : p) : mk (plift p) = 1 :=
quotient.sound ⟨equiv.plift.trans $ equiv.prop_equiv_punit h⟩

@[simp] theorem mk_bool : mk bool = 2 :=
quotient.sound ⟨equiv.bool_equiv_punit_sum_punit⟩

@[simp] theorem mk_Prop : mk Prop = 2 :=
(quotient.sound ⟨equiv.Prop_equiv_bool⟩ : mk Prop = mk bool).trans mk_bool

@[simp] theorem mk_set {α : Type u} : mk (set α) = 2 ^ mk α :=
begin
  rw [← prop_eq_two, cardinal.power_def (ulift Prop) α, cardinal.eq],
  exact ⟨equiv.arrow_congr (equiv.refl _) equiv.ulift.symm⟩,
end

@[simp] theorem mk_option {α : Type u} : mk (option α) = mk α + 1 :=
quotient.sound ⟨equiv.option_equiv_sum_punit α⟩

theorem mk_list_eq_sum_pow (α : Type u) : mk (list α) = sum (λ n : ℕ, (mk α)^(n:cardinal.{u})) :=
calc  mk (list α)
    = mk (Σ n, vector α n) : quotient.sound ⟨(equiv.sigma_preimage_equiv list.length).symm⟩
... = mk (Σ n, fin n → α) : quotient.sound ⟨equiv.sigma_congr_right $ λ n,
  ⟨vector.nth, vector.of_fn, vector.of_fn_nth, λ f, funext $ vector.nth_of_fn f⟩⟩
... = mk (Σ n : ℕ, ulift.{u} (fin n) → α) : quotient.sound ⟨equiv.sigma_congr_right $ λ n,
  equiv.arrow_congr equiv.ulift.symm (equiv.refl α)⟩
... = sum (λ n : ℕ, (mk α)^(n:cardinal.{u})) :
  by simp only [(lift_mk_fin _).symm, lift_mk, power_def, sum_mk]

theorem mk_quot_le {α : Type u} {r : α → α → Prop} : mk (quot r) ≤ mk α :=
mk_le_of_surjective quot.exists_rep

theorem mk_quotient_le {α : Type u} {s : setoid α} : mk (quotient s) ≤ mk α :=
mk_quot_le

theorem mk_subtype_le {α : Type u} (p : α → Prop) : mk (subtype p) ≤ mk α :=
⟨embedding.subtype p⟩

theorem mk_subtype_le_of_subset {α : Type u} {p q : α → Prop} (h : ∀ ⦃x⦄, p x → q x) :
  mk (subtype p) ≤ mk (subtype q) :=
⟨embedding.subtype_map (embedding.refl α) h⟩

@[simp] theorem mk_emptyc (α : Type u) : mk (∅ : set α) = 0 :=
quotient.sound ⟨equiv.set.pempty α⟩

lemma mk_emptyc_iff {α : Type u} {s : set α} : mk s = 0 ↔ s = ∅ :=
begin
  split,
  { intro h,
    have h2 : cardinal.mk s = cardinal.mk pempty, by simp [h],
    refine set.eq_empty_iff_forall_not_mem.mpr (λ _ hx, _),
    rcases cardinal.eq.mp h2 with ⟨f, _⟩,
    cases f ⟨_, hx⟩ },
  { intro, convert mk_emptyc _ }
end

theorem mk_univ {α : Type u} : mk (@univ α) = mk α :=
quotient.sound ⟨equiv.set.univ α⟩

theorem mk_image_le {α β : Type u} {f : α → β} {s : set α} : mk (f '' s) ≤ mk s :=
mk_le_of_surjective surjective_onto_image

theorem mk_image_le_lift {α : Type u} {β : Type v} {f : α → β} {s : set α} :
  lift.{v u} (mk (f '' s)) ≤ lift.{u v} (mk s) :=
lift_mk_le.{v u 0}.mpr ⟨embedding.of_surjective _ surjective_onto_image⟩

theorem mk_range_le {α β : Type u} {f : α → β} : mk (range f) ≤ mk α :=
mk_le_of_surjective surjective_onto_range

lemma mk_range_eq (f : α → β) (h : injective f) : mk (range f) = mk α :=
quotient.sound ⟨(equiv.of_injective f h).symm⟩

lemma mk_range_eq_of_injective {α : Type u} {β : Type v} {f : α → β} (hf : injective f) :
  lift.{v u} (mk (range f)) = lift.{u v} (mk α) :=
begin
  have := (@lift_mk_eq.{v u max u v} (range f) α).2 ⟨(equiv.of_injective f hf).symm⟩,
  simp only [lift_umax.{u v}, lift_umax.{v u}] at this,
  exact this
end

lemma mk_range_eq_lift {α : Type u} {β : Type v} {f : α → β} (hf : injective f) :
  lift.{v (max u w)} (# (range f)) = lift.{u (max v w)} (# α) :=
lift_mk_eq.mpr ⟨(equiv.of_injective f hf).symm⟩

theorem mk_image_eq {α β : Type u} {f : α → β} {s : set α} (hf : injective f) :
  mk (f '' s) = mk s :=
quotient.sound ⟨(equiv.set.image f s hf).symm⟩

theorem mk_Union_le_sum_mk {α ι : Type u} {f : ι → set α} : mk (⋃ i, f i) ≤ sum (λ i, mk (f i)) :=
calc mk (⋃ i, f i) ≤ mk (Σ i, f i) : mk_le_of_surjective (set.sigma_to_Union_surjective f)
  ... = sum (λ i, mk (f i)) : (sum_mk _).symm

theorem mk_Union_eq_sum_mk {α ι : Type u} {f : ι → set α} (h : ∀i j, i ≠ j → disjoint (f i) (f j)) :
  mk (⋃ i, f i) = sum (λ i, mk (f i)) :=
calc mk (⋃ i, f i) = mk (Σi, f i) : quot.sound ⟨set.Union_eq_sigma_of_disjoint h⟩
  ... = sum (λi, mk (f i)) : (sum_mk _).symm

lemma mk_Union_le {α ι : Type u} (f : ι → set α) :
  mk (⋃ i, f i) ≤ mk ι * cardinal.sup.{u u} (λ i, mk (f i)) :=
le_trans mk_Union_le_sum_mk (sum_le_sup _)

lemma mk_sUnion_le {α : Type u} (A : set (set α)) :
  mk (⋃₀ A) ≤ mk A * cardinal.sup.{u u} (λ s : A, mk s) :=
by { rw [sUnion_eq_Union], apply mk_Union_le }

lemma mk_bUnion_le {ι α : Type u} (A : ι → set α) (s : set ι) :
  mk (⋃(x ∈ s), A x) ≤ mk s * cardinal.sup.{u u} (λ x : s, mk (A x.1)) :=
by { rw [bUnion_eq_Union], apply mk_Union_le }

@[simp] lemma finset_card {α : Type u} {s : finset α} : ↑(finset.card s) = mk (↑s : set α) :=
by rw [fintype_card, nat_cast_inj, fintype.card_coe]

lemma finset_card_lt_omega (s : finset α) : mk (↑s : set α) < omega :=
by { rw [lt_omega_iff_fintype], exact ⟨finset.subtype.fintype s⟩ }

theorem mk_eq_nat_iff_finset {α} {s : set α} {n : ℕ} :
  mk s = n ↔ ∃ t : finset α, (t : set α) = s ∧ t.card = n :=
begin
  split,
  { intro h,
    have : # s < omega, by { rw h, exact nat_lt_omega n },
    refine ⟨(lt_omega_iff_finite.1 this).to_finset, finite.coe_to_finset _, nat_cast_inj.1 _⟩,
    rwa [finset_card, finite.coe_to_finset] },
  { rintro ⟨t, rfl, rfl⟩,
    exact finset_card.symm }
end

theorem mk_union_add_mk_inter {α : Type u} {S T : set α} :
  mk (S ∪ T : set α) + mk (S ∩ T : set α) = mk S + mk T :=
quot.sound ⟨equiv.set.union_sum_inter S T⟩

/-- The cardinality of a union is at most the sum of the cardinalities
of the two sets. -/
lemma mk_union_le {α : Type u} (S T : set α) : mk (S ∪ T : set α) ≤ mk S + mk T :=
@mk_union_add_mk_inter α S T ▸ self_le_add_right (mk (S ∪ T : set α)) (mk (S ∩ T : set α))

theorem mk_union_of_disjoint {α : Type u} {S T : set α} (H : disjoint S T) :
  mk (S ∪ T : set α) = mk S + mk T :=
quot.sound ⟨equiv.set.union H⟩

lemma mk_sum_compl {α} (s : set α) : #s + #(sᶜ : set α) = #α :=
quotient.sound ⟨equiv.set.sum_compl s⟩

lemma mk_le_mk_of_subset {α} {s t : set α} (h : s ⊆ t) : mk s ≤ mk t :=
⟨set.embedding_of_subset s t h⟩

lemma mk_subtype_mono {p q : α → Prop} (h : ∀x, p x → q x) : mk {x // p x} ≤ mk {x // q x} :=
⟨embedding_of_subset _ _ h⟩

lemma mk_set_le (s : set α) : mk s ≤ mk α :=
mk_subtype_le s

lemma mk_image_eq_lift {α : Type u} {β : Type v} (f : α → β) (s : set α) (h : injective f) :
  lift.{v u} (mk (f '' s)) = lift.{u v} (mk s) :=
lift_mk_eq.{v u 0}.mpr ⟨(equiv.set.image f s h).symm⟩

lemma mk_image_eq_of_inj_on_lift {α : Type u} {β : Type v} (f : α → β) (s : set α)
  (h : inj_on f s) : lift.{v u} (mk (f '' s)) = lift.{u v} (mk s) :=
lift_mk_eq.{v u 0}.mpr ⟨(equiv.set.image_of_inj_on f s h).symm⟩

lemma mk_image_eq_of_inj_on {α β : Type u} (f : α → β) (s : set α) (h : inj_on f s) :
  mk (f '' s) = mk s :=
quotient.sound ⟨(equiv.set.image_of_inj_on f s h).symm⟩

lemma mk_subtype_of_equiv {α β : Type u} (p : β → Prop) (e : α ≃ β) :
  mk {a : α // p (e a)} = mk {b : β // p b} :=
quotient.sound ⟨equiv.subtype_equiv_of_subtype e⟩

lemma mk_sep (s : set α) (t : α → Prop) : mk ({ x ∈ s | t x } : set α) = mk { x : s | t x.1 } :=
quotient.sound ⟨equiv.set.sep s t⟩

lemma mk_preimage_of_injective_lift {α : Type u} {β : Type v} (f : α → β) (s : set β)
  (h : injective f) : lift.{u v} (mk (f ⁻¹' s)) ≤ lift.{v u} (mk s) :=
begin
  rw lift_mk_le.{u v 0}, use subtype.coind (λ x, f x.1) (λ x, x.2),
  apply subtype.coind_injective, exact h.comp subtype.val_injective
end

lemma mk_preimage_of_subset_range_lift {α : Type u} {β : Type v} (f : α → β) (s : set β)
  (h : s ⊆ range f) : lift.{v u} (mk s) ≤ lift.{u v} (mk (f ⁻¹' s)) :=
begin
  rw lift_mk_le.{v u 0},
  refine ⟨⟨_, _⟩⟩,
  { rintro ⟨y, hy⟩, rcases classical.subtype_of_exists (h hy) with ⟨x, rfl⟩, exact ⟨x, hy⟩ },
  rintro ⟨y, hy⟩ ⟨y', hy'⟩, dsimp,
  rcases classical.subtype_of_exists (h hy) with ⟨x, rfl⟩,
  rcases classical.subtype_of_exists (h hy') with ⟨x', rfl⟩,
  simp, intro hxx', rw hxx'
end

lemma mk_preimage_of_injective_of_subset_range_lift {β : Type v} (f : α → β) (s : set β)
  (h : injective f) (h2 : s ⊆ range f) : lift.{u v} (mk (f ⁻¹' s)) = lift.{v u} (mk s) :=
le_antisymm (mk_preimage_of_injective_lift f s h) (mk_preimage_of_subset_range_lift f s h2)

lemma mk_preimage_of_injective (f : α → β) (s : set β) (h : injective f) :
  mk (f ⁻¹' s) ≤ mk s :=
by { convert mk_preimage_of_injective_lift.{u u} f s h using 1; rw [lift_id] }

lemma mk_preimage_of_subset_range (f : α → β) (s : set β)
  (h : s ⊆ range f) : mk s ≤ mk (f ⁻¹' s) :=
by { convert mk_preimage_of_subset_range_lift.{u u} f s h using 1; rw [lift_id] }

lemma mk_preimage_of_injective_of_subset_range (f : α → β) (s : set β)
  (h : injective f) (h2 : s ⊆ range f) : mk (f ⁻¹' s) = mk s :=
by { convert mk_preimage_of_injective_of_subset_range_lift.{u u} f s h h2 using 1; rw [lift_id] }

lemma mk_subset_ge_of_subset_image_lift {α : Type u} {β : Type v} (f : α → β) {s : set α}
  {t : set β} (h : t ⊆ f '' s) :
    lift.{v u} (mk t) ≤ lift.{u v} (mk ({ x ∈ s | f x ∈ t } : set α)) :=
by { rw [image_eq_range] at h, convert mk_preimage_of_subset_range_lift _ _ h using 1,
     rw [mk_sep], refl }

lemma mk_subset_ge_of_subset_image (f : α → β) {s : set α} {t : set β} (h : t ⊆ f '' s) :
  mk t ≤ mk ({ x ∈ s | f x ∈ t } : set α) :=
by { rw [image_eq_range] at h, convert mk_preimage_of_subset_range _ _ h using 1,
     rw [mk_sep], refl }

theorem le_mk_iff_exists_subset {c : cardinal} {α : Type u} {s : set α} :
  c ≤ mk s ↔ ∃ p : set α, p ⊆ s ∧ mk p = c :=
begin
  rw [le_mk_iff_exists_set, ←subtype.exists_set_subtype],
  apply exists_congr, intro t, rw [mk_image_eq], apply subtype.val_injective
end

/-- The function α^{<β}, defined to be sup_{γ < β} α^γ.
  We index over {s : set β.out // mk s < β } instead of {γ // γ < β}, because the latter lives in a
  higher universe -/
noncomputable def powerlt (α β : cardinal.{u}) : cardinal.{u} :=
sup.{u u} (λ(s : {s : set β.out // mk s < β}), α ^ mk.{u} s)

infix ` ^< `:80 := powerlt

theorem powerlt_aux {c c' : cardinal} (h : c < c') :
  ∃(s : {s : set c'.out // mk s < c'}), mk s = c :=
begin
  cases out_embedding.mp (le_of_lt h) with f,
  have : mk ↥(range ⇑f) = c, { rwa [mk_range_eq, mk, quotient.out_eq c], exact f.2 },
  exact ⟨⟨range f, by convert h⟩, this⟩
end

lemma le_powerlt {c₁ c₂ c₃ : cardinal} (h : c₂ < c₃) : c₁ ^ c₂ ≤ c₁ ^< c₃ :=
by { rcases powerlt_aux h with ⟨s, rfl⟩, apply le_sup _ s }

lemma powerlt_le {c₁ c₂ c₃ : cardinal} : c₁ ^< c₂ ≤ c₃ ↔ ∀(c₄ < c₂), c₁ ^ c₄ ≤ c₃ :=
begin
  rw [powerlt, sup_le],
  split,
  { intros h c₄ hc₄, rcases powerlt_aux hc₄ with ⟨s, rfl⟩, exact h s },
  intros h s, exact h _ s.2
end

lemma powerlt_le_powerlt_left {a b c : cardinal} (h : b ≤ c) : a ^< b ≤ a ^< c :=
by { rw [powerlt, sup_le], rintro ⟨s, hs⟩, apply le_powerlt, exact lt_of_lt_of_le hs h }

lemma powerlt_succ {c₁ c₂ : cardinal} (h : c₁ ≠ 0) : c₁ ^< c₂.succ = c₁ ^ c₂ :=
begin
  apply le_antisymm,
  { rw powerlt_le, intros c₃ h2, apply power_le_power_left h, rwa [←lt_succ] },
  { apply le_powerlt, apply lt_succ_self }
end

lemma powerlt_max {c₁ c₂ c₃ : cardinal} : c₁ ^< max c₂ c₃ = max (c₁ ^< c₂) (c₁ ^< c₃) :=
by { cases le_total c₂ c₃; simp only [max_eq_left, max_eq_right, h, powerlt_le_powerlt_left] }

lemma zero_powerlt {a : cardinal} (h : a ≠ 0) : 0 ^< a = 1 :=
begin
  apply le_antisymm,
  { rw [powerlt_le], intros c hc, apply zero_power_le },
  convert le_powerlt (pos_iff_ne_zero.2 h), rw [power_zero]
end

lemma powerlt_zero {a : cardinal} : a ^< 0 = 0 :=
by { apply sup_eq_zero, rintro ⟨x, hx⟩, rw [←not_le] at hx, apply hx, apply zero_le }

end cardinal

lemma equiv.cardinal_eq {α β} : α ≃ β → cardinal.mk α = cardinal.mk β :=
cardinal.eq_congr


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.filter.at_top_bot
import Mathlib.algebra.archimedean
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# `at_top` filter and archimedean (semi)rings/fields

In this file we prove that for a linear ordered archimedean semiring `R` and a function `f : α → ℕ`,
the function `coe ∘ f : α → R` tends to `at_top` along a filter `l` if and only if so does `f`.
We also prove that `coe : ℕ → R` tends to `at_top` along `at_top`, as well as version of these
two results for `ℤ` (and a ring `R`) and `ℚ` (and a field `R`).
-/

theorem tendsto_coe_nat_at_top_iff {α : Type u_1} {R : Type u_2} [ordered_semiring R] [nontrivial R] [archimedean R] {f : α → ℕ} {l : filter α} : filter.tendsto (fun (n : α) => ↑(f n)) l filter.at_top ↔ filter.tendsto f l filter.at_top :=
  filter.tendsto_at_top_embedding (fun (a₁ a₂ : ℕ) => nat.cast_le) exists_nat_ge

theorem tendsto_coe_nat_at_top_at_top {R : Type u_2} [ordered_semiring R] [archimedean R] : filter.tendsto coe filter.at_top filter.at_top :=
  monotone.tendsto_at_top_at_top nat.mono_cast exists_nat_ge

theorem tendsto_coe_int_at_top_iff {α : Type u_1} {R : Type u_2} [ordered_ring R] [nontrivial R] [archimedean R] {f : α → ℤ} {l : filter α} : filter.tendsto (fun (n : α) => ↑(f n)) l filter.at_top ↔ filter.tendsto f l filter.at_top := sorry

theorem tendsto_coe_int_at_top_at_top {R : Type u_2} [ordered_ring R] [archimedean R] : filter.tendsto coe filter.at_top filter.at_top := sorry

theorem tendsto_coe_rat_at_top_iff {α : Type u_1} {R : Type u_2} [linear_ordered_field R] [archimedean R] {f : α → ℚ} {l : filter α} : filter.tendsto (fun (n : α) => ↑(f n)) l filter.at_top ↔ filter.tendsto f l filter.at_top := sorry

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the left) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.const_mul_at_top`). -/
theorem filter.tendsto.const_mul_at_top' {α : Type u_1} {R : Type u_2} [linear_ordered_semiring R] [archimedean R] {l : filter α} {f : α → R} {r : R} (hr : 0 < r) (hf : filter.tendsto f l filter.at_top) : filter.tendsto (fun (x : α) => r * f x) l filter.at_top := sorry

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the right) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.at_top_mul_const`). -/
theorem filter.tendsto.at_top_mul_const' {α : Type u_1} {R : Type u_2} [linear_ordered_semiring R] [archimedean R] {l : filter α} {f : α → R} {r : R} (hr : 0 < r) (hf : filter.tendsto f l filter.at_top) : filter.tendsto (fun (x : α) => f x * r) l filter.at_top := sorry


-- ----------------------------------------------------
-- Ejercicio. Demostrar
--    (∃x, ∀y, P x y) → (∀y, ∃x, P x y)
-- ----------------------------------------------------

import tactic

variable {U : Type}
variable {P : U → U → Prop}

-- 1ª demostración
example :
  (∃x, ∀y, P x y) → (∀y, ∃x, P x y) :=
begin
  intros h b,
  cases h with a h1,
  use a,
  exact h1 b,
end

github-repos/lean/jaalonso-Logica_con_Lean/Logica_con_Lean-beb6765c6ff3c05590a03f45722eda0c815a25cd/src/2_LPO/Ejercicios/(∃x, ∀y, P x y) → (∀y, ∃x, P x y).lean


import Mathlib
/-!
# Formal Calculus

We introduce formal structures for integration and differentiation. Properties should be added to make these mathematically sound. But correctness can be ensured temporarily by making sure individual definitions are correct.

## Formal Integrals
-/

/--
Integrability of `f`, i.e., given an interval `[a, b]`, we can compute the integral of `f` over that interval. Additivity over intervals is also required.
-/
class Integrable (f: ℝ → ℝ) where
  integral (a b : ℝ) : ℝ
  interval_union (a b c : ℝ) :
    integral a c = integral a b + integral b c

/-- The integral of a function, with the typeclass derived -/
def integral (f: ℝ → ℝ)[int : Integrable f]
  (a b : ℝ ) :=
  int.integral a b

/-- The integral over a single point is zero, proved as an illustration. -/
theorem integral_point(f: ℝ → ℝ)[int : Integrable f]
  (a : ℝ ) : integral f a a = 0 := by
    unfold integral
    have l := int.interval_union a a a
    simp  at l
    assumption

/-!
As an exercise, prove that flip ends of an interval gives the negative of the integral.
-/

/-!
## Formal Derivatives

We define so called __one-jets__ as a value and a derivative at a point. A differentiable function has values a one-jet at each point.
-/

/--
A _one-jet_ is a value and a derivative at a point.
-/
structure OneJet where
  value : ℝ
  derivative : ℝ

/--
A differentiable function is a function that has a one-jet at each point.
-/
structure SmoothFunction where
  jet: ℝ → OneJet

/--
Derivative of a smooth function, i.e., the derivative of the one-jet at a point.
-/
def SmoothFunction.derivative (f: SmoothFunction) : ℝ → ℝ :=
  fun x ↦ f.jet (x) |>.derivative

/--
The value of a smooth function, i.e., the value of the one-jet at a point.
-/
def SmoothFunction.value (f: SmoothFunction) : ℝ → ℝ :=
  fun x ↦ f.jet (x) |>.value

/--
Integrable functions can be obtained from smooth functions via the fundamental theorem of calculus.
-/
instance fundThm (f: SmoothFunction) :
  Integrable (f.derivative) where
  integral (a b) := f.value b - f.value a
  interval_union (a b c) := by
    simp [integral]

/-!
## Constructions of smooth functions

To use the above we need to construct a few smooth functions
-/

namespace SmoothFunction

/--
Constant functions as smooth functions.
-/
def constant (c : ℝ) : SmoothFunction :=
  ⟨fun _ ↦ ⟨c, 0⟩⟩

/--
Sum of smooth functions.
-/
def sum (f g : SmoothFunction) : SmoothFunction :=
  ⟨fun x ↦ ⟨f.value x + g.value x, f.derivative x + g.derivative x⟩⟩

/--
Product of smooth functions using Liebnitz rule.
-/
def prod (f g : SmoothFunction) : SmoothFunction :=
  ⟨fun x ↦ ⟨f.value x * g.value x, f.derivative x * g.value x + f.value x * g.derivative x⟩⟩

/--
Product of a scalar and a smooth function.
-/
def scalarProd (c : ℝ) (f : SmoothFunction) : SmoothFunction :=
  ⟨fun x ↦ ⟨c * f.value x, c * f.derivative x⟩⟩

/-- Addition operation on smooth functions -/
instance : Add SmoothFunction := ⟨sum⟩
/-- Multiplication operation on smooth functions -/
instance : Mul SmoothFunction := ⟨prod⟩
/-- Scalar multiplication for smooth functions -/
instance : SMul ℝ SmoothFunction := ⟨scalarProd⟩

/-!
This gives polynomial functions as a special case. As an exercise, prove that smooth functions form a Ring (indeed an Algebra over ℝ).

We will define some polynomials as smooth functions as an example.
-/

/-- The coordinate function -/
def x : SmoothFunction := ⟨fun x ↦ ⟨x, 1⟩⟩

/-- The power function for a smooth function (automatic if ring is proved) -/
def pow (f: SmoothFunction): ℕ →  SmoothFunction
| 0 => constant 1
| n + 1 => f * (pow f n)

instance : HPow SmoothFunction ℕ SmoothFunction  := ⟨pow⟩

instance : Coe ℝ SmoothFunction := ⟨constant⟩

/-- A polynomial. We can have cleaner notation but the goal is to illustrate the construction -/
def poly := (2 : ℝ) •  x + (3 : ℝ) • x^3 + (7: ℝ)

end SmoothFunction


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

/-!
# Congruences modulo a natural number

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

This file defines the equivalence relation `a ≡ b [MOD n]` on the natural numbers,
and proves basic properties about it such as the Chinese Remainder Theorem
`modeq_and_modeq_iff_modeq_mul`.

## Notations

`a ≡ b [MOD n]` is notation for `nat.modeq n a b`, which is defined to mean `a % n = b % n`.

## Tags

modeq, congruence, mod, MOD, modulo
-/

namespace nat

/-- Modular equality. `n.modeq a b`, or `a ≡ b [MOD n]`, means that `a - b` is a multiple of `n`. -/
@[derive decidable]
def modeq (n a b : ℕ) := a % n = b % n

notation a ` ≡ `:50 b ` [MOD `:50 n `]`:0 := modeq n a b

variables {m n a b c d : ℕ}

namespace modeq

@[refl] protected theorem refl (a : ℕ) : a ≡ a [MOD n] := @rfl _ _

protected theorem rfl : a ≡ a [MOD n] := modeq.refl _

instance : is_refl _ (modeq n) := ⟨modeq.refl⟩

@[symm] protected theorem symm : a ≡ b [MOD n] → b ≡ a [MOD n] := eq.symm

@[trans] protected theorem trans : a ≡ b [MOD n] → b ≡ c [MOD n] → a ≡ c [MOD n] := eq.trans

protected theorem comm : a ≡ b [MOD n] ↔ b ≡ a [MOD n] := ⟨modeq.symm, modeq.symm⟩

end modeq

theorem modeq_zero_iff_dvd : a ≡ 0 [MOD n] ↔ n ∣ a :=
by rw [modeq, zero_mod, dvd_iff_mod_eq_zero]

lemma _root_.has_dvd.dvd.modeq_zero_nat (h : n ∣ a) : a ≡ 0 [MOD n] := modeq_zero_iff_dvd.2 h
lemma _root_.has_dvd.dvd.zero_modeq_nat (h : n ∣ a) : 0 ≡ a [MOD n] := h.modeq_zero_nat.symm

theorem modeq_iff_dvd : a ≡ b [MOD n] ↔ (n:ℤ) ∣ b - a :=
by rw [modeq, eq_comm, ← int.coe_nat_inj', int.coe_nat_mod, int.coe_nat_mod,
   int.mod_eq_mod_iff_mod_sub_eq_zero, int.dvd_iff_mod_eq_zero]

alias modeq_iff_dvd ↔ modeq.dvd modeq_of_dvd

/-- A variant of `modeq_iff_dvd` with `nat` divisibility -/
theorem modeq_iff_dvd' (h : a ≤ b) : a ≡ b [MOD n] ↔ n ∣ b - a :=
by rw [modeq_iff_dvd, ←int.coe_nat_dvd, int.coe_nat_sub h]

theorem mod_modeq (a n) : a % n ≡ a [MOD n] := mod_mod _ _

namespace modeq

protected theorem of_dvd (d : m ∣ n) (h : a ≡ b [MOD n]) : a ≡ b [MOD m] :=
modeq_of_dvd ((int.coe_nat_dvd.2 d).trans h.dvd)

protected theorem mul_left' (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD (c * n)] :=
by unfold modeq at *; rw [mul_mod_mul_left, mul_mod_mul_left, h]

protected theorem mul_left (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD n] :=
(h.mul_left' _ ).of_dvd (dvd_mul_left _ _)

protected theorem mul_right' (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD (n * c)] :=
by rw [mul_comm a, mul_comm b, mul_comm n]; exact h.mul_left' c

protected theorem mul_right (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD n] :=
by rw [mul_comm a, mul_comm b]; exact h.mul_left c

protected theorem mul (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a * c ≡ b * d [MOD n] :=
(h₂.mul_left _ ).trans (h₁.mul_right _)

protected theorem pow (m : ℕ) (h : a ≡ b [MOD n]) : a ^ m ≡ b ^ m [MOD n] :=
begin
  induction m with d hd, {refl},
  rw [pow_succ, pow_succ],
  exact h.mul hd,
end

protected theorem add (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a + c ≡ b + d [MOD n] :=
begin
  rw [modeq_iff_dvd, int.coe_nat_add, int.coe_nat_add, add_sub_add_comm],
  exact dvd_add h₁.dvd h₂.dvd,
end

protected theorem add_left (c : ℕ) (h : a ≡ b [MOD n]) : c + a ≡ c + b [MOD n] :=
modeq.rfl.add h

protected theorem add_right (c : ℕ) (h : a ≡ b [MOD n]) : a + c ≡ b + c [MOD n] :=
h.add modeq.rfl

protected theorem add_left_cancel (h₁ : a ≡ b [MOD n]) (h₂ : a + c ≡ b + d [MOD n]) :
  c ≡ d [MOD n] :=
begin
  simp only [modeq_iff_dvd, int.coe_nat_add] at *,
  rw add_sub_add_comm at h₂,
  convert _root_.dvd_sub h₂ h₁ using 1,
  rw add_sub_cancel',
end

protected theorem add_left_cancel' (c : ℕ) (h : c + a ≡ c + b [MOD n]) : a ≡ b [MOD n] :=
modeq.rfl.add_left_cancel h

protected theorem add_right_cancel (h₁ : c ≡ d [MOD n]) (h₂ : a + c ≡ b + d [MOD n]) :
  a ≡ b [MOD n] :=
by { rw [add_comm a, add_comm b] at h₂, exact h₁.add_left_cancel h₂ }

protected theorem add_right_cancel' (c : ℕ) (h : a + c ≡ b + c [MOD n]) : a ≡ b [MOD n] :=
modeq.rfl.add_right_cancel h

/-- Cancel left multiplication on both sides of the `≡` and in the modulus.

For cancelling left multiplication in the modulus, see `nat.modeq.of_mul_left`. -/
protected theorem mul_left_cancel' {a b c m : ℕ} (hc : c ≠ 0) :
  c * a ≡ c * b [MOD c * m] → a ≡ b [MOD m] :=
by simp [modeq_iff_dvd, ←mul_sub, mul_dvd_mul_iff_left (by simp [hc] : (c : ℤ) ≠ 0)]

protected theorem mul_left_cancel_iff' {a b c m : ℕ} (hc : c ≠ 0) :
  c * a ≡ c * b [MOD c * m] ↔ a ≡ b [MOD m] :=
⟨modeq.mul_left_cancel' hc, modeq.mul_left' _⟩

/-- Cancel right multiplication on both sides of the `≡` and in the modulus.

For cancelling right multiplication in the modulus, see `nat.modeq.of_mul_right`. -/
protected theorem mul_right_cancel' {a b c m : ℕ} (hc : c ≠ 0) :
  a * c ≡ b * c [MOD m * c] → a ≡ b [MOD m] :=
by simp [modeq_iff_dvd, ←sub_mul, mul_dvd_mul_iff_right (by simp [hc] : (c : ℤ) ≠ 0)]

protected

/-- Cancel left multiplication in the modulus.

For cancelling left multiplication on both sides of the `≡`, see `nat.modeq.mul_left_cancel'`. -/
theorem of_mul_left (m : ℕ) (h : a ≡ b [MOD m * n]) : a ≡ b [MOD n] :=
by { rw [modeq_iff_dvd] at *, exact (dvd_mul_left (n : ℤ) (m : ℤ)).trans h }

/-- Cancel right multiplication in the modulus.

For cancelling right multiplication on both sides of the `≡`, see `nat.modeq.mul_right_cancel'`. -/
theorem of_mul_right (m : ℕ) : a ≡ b [MOD n * m] → a ≡ b [MOD n] := mul_comm m n ▸ of_mul_left _

end modeq

lemma modeq_sub (h : b ≤ a) : a ≡ b [MOD a - b] := (modeq_of_dvd $ by rw [int.coe_nat_sub h]).symm

lemma modeq_one : a ≡ b [MOD 1] := modeq_of_dvd $ one_dvd _

@[simp] lemma modeq_zero_iff : a ≡ b [MOD 0] ↔ a = b := by rw [modeq, mod_zero, mod_zero]

@[simp] lemma add_modeq_left : n + a ≡ a [MOD n] := by rw [modeq, add_mod_left]
@[simp] lemma add_modeq_right : a + n ≡ a [MOD n] := by rw [modeq, add_mod_right]

namespace modeq

lemma le_of_lt_add (h1 : a ≡ b [MOD m]) (h2 : a < b + m) : a ≤ b :=
(le_total a b).elim id (λ h3, nat.le_of_sub_eq_zero
  (eq_zero_of_dvd_of_lt ((modeq_iff_dvd' h3).mp h1.symm) ((tsub_lt_iff_left h3).mpr h2)))

lemma add_le_of_lt (h1 : a ≡ b [MOD m]) (h2 : a < b) : a + m ≤ b :=
le_of_lt_add (add_modeq_right.trans h1) (add_lt_add_right h2 m)

lemma dvd_iff (h : a ≡ b [MOD m]) (hdm : d ∣ m) : d ∣ a ↔ d ∣ b :=
begin
  simp only [←modeq_zero_iff_dvd],
  replace h := h.of_dvd hdm,
  exact ⟨h.symm.trans, h.trans⟩,
end

lemma gcd_eq (h : a ≡ b [MOD m]) : gcd a m = gcd b m :=
begin
  have h1 := gcd_dvd_right a m,
  have h2 := gcd_dvd_right b m,
  exact dvd_antisymm
    (dvd_gcd ((h.dvd_iff h1).mp (gcd_dvd_left a m)) h1)
    (dvd_gcd ((h.dvd_iff h2).mpr (gcd_dvd_left b m)) h2),
end

lemma eq_of_abs_lt (h : a ≡ b [MOD m]) (h2 : |(b - a : ℤ)| < m) : a = b :=
begin
  apply int.coe_nat_inj,
  rw [eq_comm, ←sub_eq_zero],
  exact int.eq_zero_of_abs_lt_dvd (modeq_iff_dvd.mp h) h2,
end

lemma eq_of_lt_of_lt (h : a ≡ b [MOD m]) (ha : a < m) (hb : b < m) : a = b :=
h.eq_of_abs_lt $ abs_sub_lt_iff.2
  ⟨(sub_le_self _ $ int.coe_nat_nonneg _).trans_lt $ cast_lt.2 hb,
   (sub_le_self _ $ int.coe_nat_nonneg _).trans_lt $ cast_lt.2 ha⟩

/-- To cancel a common factor `c` from a `modeq` we must divide the modulus `m` by `gcd m c` -/
lemma cancel_left_div_gcd (hm : 0 < m) (h : c * a ≡ c * b [MOD m]) : a ≡ b [MOD m / gcd m c] :=
begin
  let d := gcd m c,
  have hmd := gcd_dvd_left m c,
  have hcd := gcd_dvd_right m c,
  rw modeq_iff_dvd,
  refine int.dvd_of_dvd_mul_right_of_gcd_one _ _,
  show (m/d : ℤ) ∣ (c/d) * (b - a),
  { rw [mul_comm, ←int.mul_div_assoc (b - a) (int.coe_nat_dvd.mpr hcd), mul_comm],
    apply int.div_dvd_div (int.coe_nat_dvd.mpr hmd),
    rw mul_sub,
    exact modeq_iff_dvd.mp h },
  show int.gcd (m/d) (c/d) = 1,
  { simp only [←int.coe_nat_div, int.coe_nat_gcd (m / d) (c / d), gcd_div hmd hcd,
        nat.div_self (gcd_pos_of_pos_left c hm)] },
end

lemma cancel_right_div_gcd (hm : 0 < m) (h : a * c ≡ b * c [MOD m]) : a ≡ b [MOD m / gcd m c] :=
by { apply cancel_left_div_gcd hm, simpa [mul_comm] using h }

lemma cancel_left_div_gcd' (hm : 0 < m) (hcd : c ≡ d [MOD m]) (h : c * a ≡ d * b [MOD m]) :
  a ≡ b [MOD m / gcd m c] :=
(h.trans (modeq.mul_right b hcd).symm).cancel_left_div_gcd hm

lemma cancel_right_div_gcd' (hm : 0 < m) (hcd : c ≡ d [MOD m]) (h : a * c ≡ b * d [MOD m]) :
  a ≡ b [MOD m / gcd m c] :=
hcd.cancel_left_div_gcd' hm $ by simpa [mul_comm] using h

/-- A common factor that's coprime with the modulus can be cancelled from a `modeq` -/
lemma cancel_left_of_coprime (hmc : gcd m c = 1) (h : c * a ≡ c * b [MOD m]) : a ≡ b [MOD m] :=
begin
  rcases m.eq_zero_or_pos with rfl | hm,
  { simp only [gcd_zero_left] at hmc,
    simp only [gcd_zero_left, hmc, one_mul, modeq_zero_iff] at h,
    subst h },
  simpa [hmc] using h.cancel_left_div_gcd hm
end

/-- A common factor that's coprime with the modulus can be cancelled from a `modeq` -/
lemma cancel_right_of_coprime (hmc : gcd m c = 1) (h : a * c ≡ b * c [MOD m]) : a ≡ b [MOD m] :=
cancel_left_of_coprime hmc $ by simpa [mul_comm] using h

end modeq

/-- The natural number less than `lcm n m` congruent to `a` mod `n` and `b` mod `m` -/
def chinese_remainder' (h : a ≡ b [MOD gcd n m]) : {k // k ≡ a [MOD n] ∧ k ≡ b [MOD m]} :=
if hn : n = 0 then ⟨a, begin rw [hn, gcd_zero_left] at h, split, refl, exact h end⟩ else
if hm : m = 0 then ⟨b, begin rw [hm, gcd_zero_right] at h, split, exact h.symm, refl end⟩ else
⟨let (c, d) := xgcd n m in int.to_nat (((n * c * b + m * d * a) / gcd n m) % lcm n m), begin
  rw xgcd_val,
  dsimp [chinese_remainder'._match_1],
  rw [modeq_iff_dvd, modeq_iff_dvd,
    int.to_nat_of_nonneg (int.mod_nonneg _ (int.coe_nat_ne_zero.2 (lcm_ne_zero hn hm)))],
  have hnonzero : (gcd n m : ℤ) ≠ 0 := begin
    norm_cast,
    rw [nat.gcd_eq_zero_iff, not_and],
    exact λ _, hm,
  end,
  have hcoedvd : ∀ t, (gcd n m : ℤ) ∣ t * (b - a) := λ t, h.dvd.mul_left _,
  have := gcd_eq_gcd_ab n m,
  split; rw [int.mod_def, ← sub_add]; refine dvd_add _ (dvd_mul_of_dvd_left _ _); try {norm_cast},
  { rw ← sub_eq_iff_eq_add' at this,
    rw [← this, sub_mul, ← add_sub_assoc, add_comm, add_sub_assoc, ← mul_sub,
      int.add_div_of_dvd_left, int.mul_div_cancel_left _ hnonzero,
      int.mul_div_assoc _ h.dvd, ← sub_sub, sub_self, zero_sub, dvd_neg, mul_assoc],
    exact dvd_mul_right _ _,
    norm_cast, exact dvd_mul_right _ _, },
  { exact dvd_lcm_left n m, },
  { rw ← sub_eq_iff_eq_add at this,
    rw [← this, sub_mul, sub_add, ← mul_sub, int.sub_div_of_dvd, int.mul_div_cancel_left _ hnonzero,
      int.mul_div_assoc _ h.dvd, ← sub_add, sub_self, zero_add, mul_assoc],
    exact dvd_mul_right _ _,
    exact hcoedvd _ },
  { exact dvd_lcm_right n m, },
end⟩

/-- The natural number less than `n*m` congruent to `a` mod `n` and `b` mod `m` -/
def chinese_remainder (co : coprime n m) (a b : ℕ) : {k // k ≡ a [MOD n] ∧ k ≡ b [MOD m]} :=
chinese_remainder' (by convert modeq_one)

lemma chinese_remainder'_lt_lcm (h : a ≡ b [MOD gcd n m]) (hn : n ≠ 0) (hm : m ≠ 0) :
  ↑(chinese_remainder' h) < lcm n m :=
begin
  dsimp only [chinese_remainder'],
  rw [dif_neg hn, dif_neg hm, subtype.coe_mk, xgcd_val, ←int.to_nat_coe_nat (lcm n m)],
  have lcm_pos := int.coe_nat_pos.mpr (nat.pos_of_ne_zero (lcm_ne_zero hn hm)),
  exact (int.to_nat_lt_to_nat lcm_pos).mpr (int.mod_lt_of_pos _ lcm_pos),
end

lemma chinese_remainder_lt_mul (co : coprime n m) (a b : ℕ) (hn : n ≠ 0) (hm : m ≠ 0) :
  ↑(chinese_remainder co a b) < n * m :=
lt_of_lt_of_le (chinese_remainder'_lt_lcm _ hn hm) (le_of_eq co.lcm_eq_mul)

lemma modeq_and_modeq_iff_modeq_mul {a b m n : ℕ} (hmn : coprime m n) :
  a ≡ b [MOD m] ∧ a ≡ b [MOD n] ↔ (a ≡ b [MOD m * n]) :=
⟨λ h, begin
    rw [nat.modeq_iff_dvd, nat.modeq_iff_dvd, ← int.dvd_nat_abs,
      int.coe_nat_dvd, ← int.dvd_nat_abs, int.coe_nat_dvd] at h,
    rw [nat.modeq_iff_dvd, ← int.dvd_nat_abs, int.coe_nat_dvd],
    exact hmn.mul_dvd_of_dvd_of_dvd h.1 h.2
  end,
λ h, ⟨h.of_mul_right _, h.of_mul_left _⟩⟩

lemma coprime_of_mul_modeq_one (b : ℕ) {a n : ℕ} (h : a * b ≡ 1 [MOD n]) : coprime a n :=
begin
  obtain ⟨g, hh⟩ := nat.gcd_dvd_right a n,
  rw [nat.coprime_iff_gcd_eq_one, ← nat.dvd_one, ← nat.modeq_zero_iff_dvd],
  calc 1 ≡ a * b [MOD a.gcd n] : nat.modeq.of_mul_right g (hh.subst h).symm
  ... ≡ 0 * b [MOD a.gcd n] : (nat.modeq_zero_iff_dvd.mpr (nat.gcd_dvd_left _ _)).mul_right b
  ... = 0 : by rw zero_mul,
end

@[simp] lemma mod_mul_right_mod (a b c : ℕ) : a % (b * c) % b = a % b :=
(mod_modeq _ _).of_mul_right _

@[simp] lemma mod_mul_left_mod (a b c : ℕ) : a % (b * c) % c = a % c :=
(mod_modeq _ _).of_mul_left _

lemma div_mod_eq_mod_mul_div (a b c : ℕ) : a / b % c = a % (b * c) / b :=
if hb0 : b = 0 then by simp [hb0]
else by rw [← @add_right_cancel_iff _ _ _ (c * (a / b / c)), mod_add_div, nat.div_div_eq_div_mul,
  ← mul_right_inj' hb0, ← @add_left_cancel_iff _ _ _ (a % b), mod_add_div,
  mul_add, ← @add_left_cancel_iff _ _ _ (a % (b * c) % b), add_left_comm,
  ← add_assoc (a % (b * c) % b), mod_add_div, ← mul_assoc, mod_add_div, mod_mul_right_mod]

lemma add_mod_add_ite (a b c : ℕ) :
  (a + b) % c + (if c ≤ a % c + b % c then c else 0) = a % c + b % c :=
have (a + b) % c = (a % c + b % c) % c,
  from ((mod_modeq _ _).add $ mod_modeq _ _).symm,
if hc0 : c = 0 then by simp [hc0]
else
  begin
    rw this,
    split_ifs,
    { have h2 : (a % c + b % c) / c < 2,
        from nat.div_lt_of_lt_mul (by rw mul_two;
          exact add_lt_add (nat.mod_lt _ (nat.pos_of_ne_zero hc0))
            (nat.mod_lt _ (nat.pos_of_ne_zero hc0))),
      have h0 : 0 <  (a % c + b % c) / c, from nat.div_pos h (nat.pos_of_ne_zero hc0),
      rw [← @add_right_cancel_iff _ _ _ (c * ((a % c + b % c) / c)), add_comm _ c, add_assoc,
        mod_add_div, le_antisymm (le_of_lt_succ h2) h0, mul_one, add_comm] },
    { rw [nat.mod_eq_of_lt (lt_of_not_ge h), add_zero] }
  end

lemma add_mod_of_add_mod_lt {a b c : ℕ} (hc : a % c + b % c < c) :
  (a + b) % c = a % c + b % c :=
 by rw [← add_mod_add_ite, if_neg (not_le_of_lt hc), add_zero]

lemma add_mod_add_of_le_add_mod {a b c : ℕ} (hc : c ≤ a % c + b % c) :
  (a + b) % c + c = a % c + b % c :=
by rw [← add_mod_add_ite, if_pos hc]

lemma add_div {a b c : ℕ} (hc0 : 0 < c) : (a + b) / c = a / c + b / c +
  if c ≤ a % c + b % c then 1 else 0 :=
begin
  rw [← mul_right_inj' hc0.ne', ← @add_left_cancel_iff _ _ _ ((a + b) % c + a % c + b % c)],
  suffices : (a + b) % c + c * ((a + b) / c) + a % c + b % c =
    a % c + c * (a / c) + (b % c + c * (b / c)) + c * (if c ≤ a % c + b % c then 1 else 0) +
      (a + b) % c,
  { simpa only [mul_add, add_comm, add_left_comm, add_assoc] },
  rw [mod_add_div, mod_add_div, mod_add_div, mul_ite, add_assoc, add_assoc],
  conv_lhs { rw ← add_mod_add_ite },
  simp, ac_refl
end

lemma add_div_eq_of_add_mod_lt {a b c : ℕ} (hc : a % c + b % c < c) :
  (a + b) / c = a / c + b / c :=
if hc0 : c = 0 then by simp [hc0]
else by rw [add_div (nat.pos_of_ne_zero hc0), if_neg (not_le_of_lt hc), add_zero]

protected lemma add_div_of_dvd_right {a b c : ℕ} (hca : c ∣ a) :
  (a + b) / c = a / c + b / c :=
if h : c = 0 then by simp [h] else add_div_eq_of_add_mod_lt begin
  rw [nat.mod_eq_zero_of_dvd hca, zero_add],
  exact nat.mod_lt _ (pos_iff_ne_zero.mpr h),
end

protected lemma add_div_of_dvd_left {a b c : ℕ} (hca : c ∣ b) :
  (a + b) / c = a / c + b / c :=
by rwa [add_comm, nat.add_div_of_dvd_right, add_comm]

lemma add_div_eq_of_le_mod_add_mod {a b c : ℕ} (hc : c ≤ a % c + b % c) (hc0 : 0 < c) :
  (a + b) / c = a / c + b / c + 1 :=
by rw [add_div hc0, if_pos hc]

lemma add_div_le_add_div (a b c : ℕ) : a / c + b / c ≤ (a + b) / c :=
if hc0 : c = 0 then by simp [hc0]
else by rw [nat.add_div (nat.pos_of_ne_zero hc0)]; exact nat.le_add_right _ _

lemma le_mod_add_mod_of_dvd_add_of_not_dvd {a b c : ℕ} (h : c ∣ a + b) (ha : ¬ c ∣ a) :
  c ≤ a % c + b % c :=
by_contradiction $ λ hc,
  have (a + b) % c = a % c + b % c, from add_mod_of_add_mod_lt (lt_of_not_ge hc),
  by simp [dvd_iff_mod_eq_zero, *] at *

lemma odd_mul_odd {n m : ℕ} : n % 2 = 1 → m % 2 = 1 → (n * m) % 2 = 1 :=
by simpa [nat.modeq] using @modeq.mul 2 n 1 m 1

lemma odd_mul_odd_div_two {m n : ℕ} (hm1 : m % 2 = 1) (hn1 : n % 2 = 1) :
  (m * n) / 2 = m * (n / 2) + m / 2 :=
have hm0 : 0 < m := nat.pos_of_ne_zero (λ h, by simp * at *),
have hn0 : 0 < n := nat.pos_of_ne_zero (λ h, by simp * at *),
mul_right_injective₀ two_ne_zero $
by rw [mul_add, two_mul_odd_div_two hm1, mul_left_comm, two_mul_odd_div_two hn1,
  two_mul_odd_div_two (nat.odd_mul_odd hm1 hn1), mul_tsub, mul_one,
  ← add_tsub_assoc_of_le (succ_le_of_lt hm0),
  tsub_add_cancel_of_le (le_mul_of_one_le_right (nat.zero_le _) hn0)]

lemma odd_of_mod_four_eq_one {n : ℕ} : n % 4 = 1 → n % 2 = 1 :=
by simpa [modeq, show 2 * 2 = 4, by norm_num] using @modeq.of_mul_left 2 n 1 2

lemma odd_of_mod_four_eq_three {n : ℕ} : n % 4 = 3 → n % 2 = 1 :=
by simpa [modeq, show 2 * 2 = 4, by norm_num, show 3 % 4 = 3, by norm_num]
  using @modeq.of_mul_left 2 n 3 2

/-- A natural number is odd iff it has residue `1` or `3` mod `4`-/
lemma odd_mod_four_iff {n : ℕ} : n % 2 = 1 ↔ n % 4 = 1 ∨ n % 4 = 3 :=
have help : ∀ (m : ℕ), m < 4 → m % 2 = 1 → m = 1 ∨ m = 3 := dec_trivial,
⟨λ hn, help (n % 4) (mod_lt n (by norm_num)) $ (mod_mod_of_dvd n (by norm_num : 2 ∣ 4)).trans hn,
 λ h, or.dcases_on h odd_of_mod_four_eq_one odd_of_mod_four_eq_three⟩

end nat


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.homology.homological_complex
import algebraic_topology.simplicial_object
import category_theory.abelian.basic

/-!
## Moore complex

We construct the normalized Moore complex, as a functor
`simplicial_object C ⥤ chain_complex C ℕ`,
for any abelian category `C`.

The `n`-th object is intersection of
the kernels of `X.δ i : X.obj n ⟶ X.obj (n-1)`, for `i = 1, ..., n`.

The differentials are induced from `X.δ 0`,
which maps each of these intersections of kernels to the next.

This functor is one direction of the Dold-Kan equivalence, which we're still working towards.

### References

* https://stacks.math.columbia.edu/tag/0194
* https://ncatlab.org/nlab/show/Moore+complex
-/

universes v u

noncomputable theory

open category_theory category_theory.limits
open opposite

namespace algebraic_topology

variables {C : Type*} [category C] [abelian C]
local attribute [instance] abelian.has_pullbacks

/-! The definitions in this namespace are all auxiliary definitions for `normalized_Moore_complex`
and should usually only be accessed via that. -/
namespace normalized_Moore_complex

open category_theory.subobject
variables (X : simplicial_object C)

/--
The normalized Moore complex in degree `n`, as a subobject of `X n`.
-/
@[simp]
def obj_X : Π n : ℕ, subobject (X.obj (op (simplex_category.mk n)))
| 0 := ⊤
| (n+1) := finset.univ.inf (λ k : fin (n+1), kernel_subobject (X.δ k.succ))

/--
The differentials in the normalized Moore complex.
-/
@[simp]
def obj_d : Π n : ℕ, (obj_X X (n+1) : C) ⟶ (obj_X X n : C)
| 0 := subobject.arrow _ ≫ X.δ (0 : fin 2) ≫ inv ((⊤ : subobject _).arrow)
| (n+1) :=
begin
  -- The differential is `subobject.arrow _ ≫ X.δ (0 : fin (n+3))`,
  -- factored through the intersection of the kernels.
  refine factor_thru _ (arrow _ ≫ X.δ (0 : fin (n+3))) _,
  -- We now need to show that it factors!
  -- A morphism factors through an intersection of subobjects if it factors through each.
  refine ((finset_inf_factors _).mpr (λ i m, _)),
  -- A morphism `f` factors through the kernel of `g` exactly if `f ≫ g = 0`.
  apply kernel_subobject_factors,
  -- Use a simplicial identity
  dsimp [obj_X],
  erw [category.assoc, ←X.δ_comp_δ (fin.zero_le i.succ), ←category.assoc],
  -- It's the first two factors which are zero.
  convert zero_comp,
  -- We can rewrite the arrow out of the intersection of all the kernels as a composition
  -- of a morphism we don't care about with the arrow out of the kernel of `X.δ i.succ.succ`.
  rw ←factor_thru_arrow _ _ (finset_inf_arrow_factors finset.univ _ i.succ (by simp)),
  -- It's the second two factors which are zero.
  rw [category.assoc],
  convert comp_zero,
  exact kernel_subobject_arrow_comp _,
end

lemma d_squared (n : ℕ) : obj_d X (n+1) ≫ obj_d X n = 0 :=
begin
  -- It's a pity we need to do a case split here;
  -- after the first simp the proofs are almost identical
  cases n; dsimp,
  { simp only [subobject.factor_thru_arrow_assoc],
    slice_lhs 2 3 { erw ←X.δ_comp_δ (fin.zero_le (0 : fin (0 + 2))), },
    rw ←factor_thru_arrow _ _ (finset_inf_arrow_factors finset.univ _ (0 : fin 2) (by simp)),
    slice_lhs 2 3 { rw [kernel_subobject_arrow_comp], },
    simp, },
  { simp [factor_thru_right],
    slice_lhs 2 3 { erw ←X.δ_comp_δ (fin.zero_le (0 : fin (n.succ + 2))) },
    rw ←factor_thru_arrow _ _ (finset_inf_arrow_factors finset.univ _ (0 : fin (n+3)) (by simp)),
    slice_lhs 2 3 { rw [kernel_subobject_arrow_comp], },
    simp, },
end

/--
The normalized Moore complex functor, on objects.
-/
@[simps]
def obj (X : simplicial_object C) : chain_complex C ℕ :=
chain_complex.of (λ n, (obj_X X n : C)) -- the coercion here picks a representative of the subobject
  (obj_d X) (d_squared X)

variables {X} {Y : simplicial_object C} (f : X ⟶ Y)

/--
The normalized Moore complex functor, on morphisms.
-/
@[simps]
def map (f : X ⟶ Y) : obj X ⟶ obj Y :=
chain_complex.of_hom _ _ _ _ _ _
  (λ n, begin
    refine factor_thru _ (arrow _ ≫ f.app (op (simplex_category.mk n))) _,
    cases n; dsimp,
    { apply top_factors, },
    { refine (finset_inf_factors _).mpr (λ i m, _),
      apply kernel_subobject_factors,
      slice_lhs 2 3 { erw ←f.naturality, },
      rw ←factor_thru_arrow _ _ (finset_inf_arrow_factors finset.univ _ i (by simp)),
      slice_lhs 2 3 { erw [kernel_subobject_arrow_comp], },
      simp, }
  end)
  (λ n, begin
    cases n; dsimp,
    { ext, simp, },
    { ext, simp, },
  end)

end normalized_Moore_complex

open normalized_Moore_complex

variables (C)

/--
The (normalized) Moore complex of a simplicial object `X` in an abelian category `C`.

The `n`-th object is intersection of
the kernels of `X.δ i : X.obj n ⟶ X.obj (n-1)`, for `i = 1, ..., n`.

The differentials are induced from `X.δ 0`,
which maps each of these intersections of kernels to the next.
-/
@[simps]
def normalized_Moore_complex : simplicial_object C ⥤ chain_complex C ℕ :=
{ obj := obj,
  map := λ X Y f, map f,
  map_id' := λ X, by { ext n, cases n; { dsimp, simp, }, },
  map_comp' := λ X Y Z f g, by { ext n, cases n; simp, }, }

variable {C}

@[simp]
lemma normalized_Moore_complex_obj_d (X : simplicial_object C) (n : ℕ) :
  ((normalized_Moore_complex C).obj X).d (n+1) n = normalized_Moore_complex.obj_d X n :=
by apply chain_complex.of_d

end algebraic_topology


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.nat.succ_pred
import algebra.char_zero.lemmas
import algebra.order.sub.with_top
import algebra.order.ring.with_top

/-!
# Definition and basic properties of extended natural numbers

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

In this file we define `enat` (notation: `ℕ∞`) to be `with_top ℕ` and prove some basic lemmas
about this type.
-/

/-- Extended natural numbers `ℕ∞ = with_top ℕ`. -/
@[derive [has_zero, add_comm_monoid_with_one, canonically_ordered_comm_semiring, nontrivial,
  linear_order, order_bot, order_top, has_bot, has_top, canonically_linear_ordered_add_monoid,
  has_sub, has_ordered_sub, linear_ordered_add_comm_monoid_with_top, succ_order, well_founded_lt,
  has_well_founded, char_zero, has_coe_t ℕ]]
def enat : Type := with_top ℕ

notation `ℕ∞` := enat

namespace enat

instance : inhabited ℕ∞ := ⟨0⟩
instance : is_well_order ℕ∞ (<) := { }

variables {m n : ℕ∞}

-- eligible for `dsimp`
@[simp, nolint simp_nf, norm_cast] lemma coe_zero : ((0 : ℕ) : ℕ∞) = 0 := rfl
@[simp, norm_cast] lemma coe_one : ((1 : ℕ) : ℕ∞) = 1 := rfl
@[simp, norm_cast] lemma coe_add (m n : ℕ) : ↑(m + n) = (m + n : ℕ∞) := rfl
@[simp, norm_cast] lemma coe_sub (m n : ℕ) : ↑(m - n) = (m - n : ℕ∞) := rfl
@[simp, norm_cast] lemma coe_mul (m n : ℕ) : ↑(m * n) = (m * n : ℕ∞) := with_top.coe_mul

instance can_lift : can_lift ℕ∞ ℕ coe (λ n, n ≠ ⊤) := with_top.can_lift

/-- Conversion of `ℕ∞` to `ℕ` sending `∞` to `0`. -/
def to_nat : monoid_with_zero_hom ℕ∞ ℕ :=
{ to_fun := with_top.untop' 0,
  map_one' := rfl,
  map_zero' := rfl,
  map_mul' := with_top.untop'_zero_mul }

@[simp] lemma to_nat_coe (n : ℕ) : to_nat n = n := rfl
@[simp] lemma to_nat_top : to_nat ⊤ = 0 := rfl

@[simp] lemma coe_to_nat_eq_self : ↑n.to_nat = n ↔ n ≠ ⊤ :=
with_top.rec_top_coe (by simp) (by simp) n

alias coe_to_nat_eq_self ↔ _ coe_to_nat

lemma coe_to_nat_le_self (n : ℕ∞) : ↑(to_nat n) ≤ n := with_top.rec_top_coe le_top (λ k, le_rfl) n

lemma to_nat_add {m n : ℕ∞} (hm : m ≠ ⊤) (hn : n ≠ ⊤) : to_nat (m + n) = to_nat m + to_nat n :=
by { lift m to ℕ using hm, lift n to ℕ using hn, refl }

lemma to_nat_sub {n : ℕ∞} (hn : n ≠ ⊤) (m : ℕ∞) : to_nat (m - n) = to_nat m - to_nat n :=
begin
  lift n to ℕ using hn,
  induction m using with_top.rec_top_coe,
  { rw [with_top.top_sub_coe, to_nat_top, zero_tsub] },
  { rw [← coe_sub, to_nat_coe, to_nat_coe, to_nat_coe] }
end

lemma to_nat_eq_iff {m : ℕ∞} {n : ℕ} (hn : n ≠ 0) : m.to_nat = n ↔ m = n :=
by induction m using with_top.rec_top_coe; simp [hn.symm]

@[simp] lemma succ_def (m : ℕ∞) : order.succ m = m + 1 := by cases m; refl

lemma add_one_le_of_lt (h : m < n) : m + 1 ≤ n :=
m.succ_def ▸ order.succ_le_of_lt h

lemma add_one_le_iff (hm : m ≠ ⊤) : m + 1 ≤ n ↔ m < n :=
m.succ_def ▸ (order.succ_le_iff_of_not_is_max $ by rwa [is_max_iff_eq_top])

lemma one_le_iff_pos : 1 ≤ n ↔ 0 < n := add_one_le_iff with_top.zero_ne_top

lemma one_le_iff_ne_zero : 1 ≤ n ↔ n ≠ 0 := one_le_iff_pos.trans pos_iff_ne_zero

lemma le_of_lt_add_one (h : m < n + 1) : m ≤ n := order.le_of_lt_succ $ n.succ_def.symm ▸ h

@[elab_as_eliminator]
lemma nat_induction {P : ℕ∞ → Prop} (a : ℕ∞) (h0 : P 0) (hsuc : ∀ n : ℕ, P n → P n.succ)
  (htop : (∀ n : ℕ, P n) → P ⊤) : P a :=
begin
  have A : ∀ n : ℕ, P n := λ n, nat.rec_on n h0 hsuc,
  cases a,
  exacts [htop A, A a]
end

end enat


import Lean
open Lean

namespace Ex
inductive LE : Nat → Nat → Prop
  | refl : LE n n
  | succ : LE n m → LE n m.succ

def typeOf {α : Sort u} (a : α) := α

theorem LE.trans' : LE m n → LE n o → LE m o
  | h1, refl    => h1
  | h1, succ h2 => succ (trans' h1 h2) -- the structural recursion in being performed on the implicit `Nat` parameter

inductive Even : Nat → Prop
  | zero : Even 0
  | ss   : Even n → Even n.succ.succ

theorem Even_brecOn : typeOf @Even.brecOn = ∀ {motive : (a : Nat) → Even a → Prop} {a : Nat} (x : Even a),
  (∀ (a : Nat) (x : Even a), @Even.below motive a x → motive a x) → motive a x := rfl

theorem Even.add : Even n → Even m → Even (n+m) := by
  intro h1 h2
  induction h2 with
  | zero => exact h1
  | ss h2 ih => exact ss ih

theorem Even.add' : Even n → Even m → Even (n+m)
  | h1, zero  => h1
  | h1, ss h2 => ss (add' h1 h2)  -- the structural recursion in being performed on the implicit `Nat` parameter

theorem mul_left_comm (n m o : Nat) : n * (m * o) = m * (n * o) := by
  rw [← Nat.mul_assoc, Nat.mul_comm n m, Nat.mul_assoc]

inductive Power2 : Nat → Prop
  | base : Power2 1
  | ind  : Power2 n → Power2 (2*n) -- Note that index here is not a constructor

theorem Power2_brecOn : typeOf @Power2.brecOn = ∀ {motive : (a : Nat) → Power2 a → Prop} {a : Nat} (x : Power2 a),
  (∀ (a : Nat) (x : Power2 a), @Power2.below motive a x → motive a x) → motive a x := rfl

theorem Power2.mul : Power2 n → Power2 m → Power2 (n*m) := by
  intro h1 h2
  induction h2 with
  | base      => simp_all
  | ind h2 ih => exact mul_left_comm .. ▸ ind ih

/- The following example fails because the structural recursion cannot be performed on the `Nat`s and
   the `brecOn` construction doesn't work for inductive predicates -/
set_option trace.Elab.definition.structural true in
set_option trace.Meta.IndPredBelow.match true in
set_option pp.explicit true in
theorem Power2.mul' : Power2 n → Power2 m → Power2 (n*m)
 | h1, base => by simp_all
 | h1, ind h2 => mul_left_comm .. ▸ ind (mul' h1 h2)

inductive tm : Type :=
  | C : Nat → tm
  | P : tm → tm → tm

open tm

set_option hygiene false in
infixl:40 " ==> " => step
inductive step : tm → tm → Prop :=
  | ST_PlusConstConst : ∀ n1 n2,
      P (C n1) (C n2) ==> C (n1 + n2)
  | ST_Plus1 : ∀ t1 t1' t2,
      t1 ==> t1' →
      P t1 t2 ==> P t1' t2
  | ST_Plus2 : ∀ n1 t2 t2',
      t2 ==> t2' →
      P (C n1) t2 ==> P (C n1) t2'

def deterministic {X : Type} (R : X → X → Prop) :=
  ∀ x y1 y2 : X, R x y1 → R x y2 → y1 = y2

theorem step_deterministic' : deterministic step := λ x y₁ y₂ hy₁ hy₂ =>
  @step.brecOn (λ s t st => ∀ y₂, s ==> y₂ → t = y₂) _ _ hy₁ (λ s t st hy₁ y₂ hy₂ =>
    match hy₁, hy₂ with
    | step.below.ST_PlusConstConst _ _, step.ST_PlusConstConst _ _ => rfl
    | step.below.ST_Plus1 _ _ _ hy₁ ih, step.ST_Plus1 _ t₁' _ _ => by rw [←ih t₁']; assumption
    | step.below.ST_Plus1 _ _ _ hy₁ ih, step.ST_Plus2 _ _ _ _ => by cases hy₁
    | step.below.ST_Plus2 _ _ _ _ ih, step.ST_Plus2 _ _ t₂ _ => by rw [←ih t₂]; assumption
    | step.below.ST_Plus2 _ _ _ hy₁ _, step.ST_PlusConstConst _ _ => by cases hy₁
    ) y₂ hy₂

section NestedRecursion

axiom f : Nat → Nat

inductive is_nat : Nat -> Prop
| Z : is_nat 0
| S {n} : is_nat n → is_nat (f n)

axiom P : Nat → Prop
axiom F0 : P 0
axiom F1 : P (f 0)
axiom FS {n : Nat} : P n → P (f (f n))

-- we would like to write this
theorem foo : ∀ {n}, is_nat n → P n
| _, is_nat.Z => F0
| _, is_nat.S is_nat.Z => F1
| _, is_nat.S (is_nat.S h) => FS (foo h)

theorem foo' : ∀ {n}, is_nat n → P n := fun h =>
  @is_nat.brecOn (fun n hn => P n) _ h fun n h ih =>
  match ih with
  | is_nat.below.Z => F0
  | is_nat.below.S is_nat.below.Z _ => F1
  | is_nat.below.S (is_nat.below.S b hx) h₂ => FS hx

end NestedRecursion

end Ex


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Div
import Init.Data.Nat.Bitwise
import Init.Coe

open Nat

namespace Fin

instance coeToNat {n} : Coe (Fin n) Nat :=
  ⟨fun v => v.val⟩

def elim0.{u} {α : Sort u} : Fin 0 → α
  | ⟨_, h⟩ => absurd h (not_lt_zero _)

variable {n : Nat}

protected def ofNat {n : Nat} (a : Nat) : Fin (succ n) :=
  ⟨a % succ n, Nat.mod_lt _ (Nat.zero_lt_succ _)⟩

protected def ofNat' {n : Nat} (a : Nat) (h : n > 0) : Fin n :=
  ⟨a % n, Nat.mod_lt _ h⟩

private theorem mlt {b : Nat} : {a : Nat} → a < n → b % n < n
  | 0,   h => Nat.mod_lt _ h
  | a+1, h =>
    have : n > 0 := Nat.lt_trans (Nat.zero_lt_succ _) h;
    Nat.mod_lt _ this

protected def add : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a + b) % n, mlt h⟩

protected def mul : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a * b) % n, mlt h⟩

protected def sub : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a + (n - b)) % n, mlt h⟩

/-
Remark: mod/div/modn/land/lor can be defined without using (% n), but
we are trying to minimize the number of Nat theorems
needed to boostrap Lean.
-/

protected def mod : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a % b) % n, mlt h⟩

protected def div : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a / b) % n, mlt h⟩

protected def modn : Fin n → Nat → Fin n
  | ⟨a, h⟩, m => ⟨(a % m) % n, mlt h⟩

def land : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(Nat.land a b) % n, mlt h⟩

def lor : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(Nat.lor a b) % n, mlt h⟩

def xor : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(Nat.xor a b) % n, mlt h⟩

def shiftLeft : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a <<< b) % n, mlt h⟩

def shiftRight : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a >>> b) % n, mlt h⟩

instance : Add (Fin n) where
  add := Fin.add

instance : Sub (Fin n) where
  sub := Fin.sub

instance : Mul (Fin n) where
  mul := Fin.mul

instance : Mod (Fin n) where
  mod := Fin.mod

instance : Div (Fin n) where
  div := Fin.div

instance : AndOp (Fin n) where
  and := Fin.land
instance : OrOp (Fin n) where
  or := Fin.lor
instance : Xor (Fin n) where
  xor := Fin.xor
instance : ShiftLeft (Fin n) where
  shiftLeft := Fin.shiftLeft
instance : ShiftRight (Fin n) where
  shiftRight := Fin.shiftRight

instance : HMod (Fin n) Nat (Fin n) where
  hMod := Fin.modn

instance : OfNat (Fin (no_index (n+1))) i where
  ofNat := Fin.ofNat i

instance : Inhabited (Fin (no_index (n+1))) where
  default := 0

theorem val_ne_of_ne {i j : Fin n} (h : i ≠ j) : val i ≠ val j :=
  fun h' => absurd (eq_of_val_eq h') h

theorem modn_lt : ∀ {m : Nat} (i : Fin n), m > 0 → (i % m).val < m
  | m, ⟨a, h⟩, hp =>  Nat.lt_of_le_of_lt (mod_le _ _) (mod_lt _ hp)

end Fin

open Fin


import Std.Data.List.Lemmas
import Mathlib.Init.Algebra.Order

section
  namespace List
  variable {type} [LinearOrder type]

  def IsSorted : List type → Prop
  | [] => True
  | a :: [] => True
  | a :: b :: l => a ≤ b ∧ (b :: l).IsSorted

  theorem snoc_snoc_IsSorted_iff {l : List type} {y z : type}
  : (l ++ [y] ++ [z]).IsSorted ↔ (l ++ [y]).IsSorted ∧ y ≤ z
  := match l with
  | [] => by simp [IsSorted]
  | a :: [] => by simp [IsSorted]
  | a :: b :: l => by
    show _ ∧ (b :: l ++ [y] ++ [z]).IsSorted ↔ (_ ∧ (b :: l ++ [y]).IsSorted) ∧ _
    rw [and_assoc, snoc_snoc_IsSorted_iff]

  theorem append_cons_IsSorted_iff {l r : List type} {v : type}
  : (l ++ v :: r).IsSorted ↔ (l ++ [v]).IsSorted ∧ (v :: r).IsSorted
  := match r with
  | [] => ⟨λ h => ⟨h, ⟨⟩⟩, λ h => h.1⟩
  | b :: r => by
    rw [append_cons, append_cons_IsSorted_iff]
    show _ ↔ _ ∧ (_ ∧ _)
    rw [snoc_snoc_IsSorted_iff, and_assoc]

  theorem snoc_IsSorted_iff_IsSorted_and_forall_le {l : List type} {z : type}
  : (l ++ [z]).IsSorted ↔ l.IsSorted ∧ ∀ x ∈ l, x ≤ z
  := match l with
  | [] => by simp [IsSorted]
  | a :: [] =>
    ⟨λ h => ⟨trivial, λ x hx => mem_singleton.mp hx ▸ h.1⟩, λ h => ⟨h.2 a (mem_singleton.mpr rfl), trivial⟩⟩
  | a :: b :: l => by
    show _ ∧ (b :: l ++ [z]).IsSorted ↔ (_ ∧ (b :: l).IsSorted) ∧ _
    rw [and_assoc, snoc_IsSorted_iff_IsSorted_and_forall_le]
    exact ⟨λ ⟨h₁, h₂, h₃⟩ => ⟨h₁, h₂, λ x hx => match hx with
      | Mem.head _ => le_trans h₁ (h₃ b (Mem.head ..))
      | Mem.tail _ hx => h₃ x hx⟩
      , λ ⟨h₁, h₂, h₃⟩ => ⟨h₁, h₂, λ x hx => h₃ x (Mem.tail _ hx)⟩⟩

  theorem cons_IsSorted_iff_IsSorted_and_forall_le {l : List type} {a : type}
  : (a :: l).IsSorted ↔ l.IsSorted ∧ ∀ x ∈ l, a ≤ x
  := match l with
  | [] => by simp [IsSorted]
  | b :: l => by
    show _ ∧ _ ↔ _
    rw [cons_IsSorted_iff_IsSorted_and_forall_le]
    exact ⟨λ ⟨h₁, h₂, h₃⟩ => ⟨⟨h₂, h₃⟩, λ x hx => le_trans h₁ $ match hx with
      | Mem.head _ => le_refl x
      | Mem.tail _ hx => h₃ x hx⟩
    , λ ⟨⟨h₁, h₂⟩, h₃⟩ => ⟨h₃ b (Mem.head ..), h₁, h₂⟩⟩

  theorem append_cons_IsSorted_iff_left_IsSorted_and_forall_le_and_right_IsSorted_and_forall_ge
  {l r : List type} {v : type}
  : (l ++ v :: r).IsSorted ↔ (l.IsSorted ∧ ∀ x ∈ l, x ≤ v) ∧ (r.IsSorted ∧ ∀ x ∈ r, v ≤ x)
  := by
    rw [←snoc_IsSorted_iff_IsSorted_and_forall_le]
    rw [←cons_IsSorted_iff_IsSorted_and_forall_le]
    rw [append_cons_IsSorted_iff]

  end List
end


import Mathlib.Data.Finset.Basic
import Mathlib.Init.Set

lemma finiteExhaustion [instDec: DecidableEq α] [LinearOrder β] [Inhabited β] {fam : β → Set α} {fin : Finset α} :
  Monotone fam → ↑fin ⊆ {x : α | ∃n : β, x ∈ fam n } → ∃n : β, ↑fin ⊆ fam n := by
    intros h₁
    apply @Finset.induction_on α (λfs => ↑fs ⊆ {x : α | ∃n : β, x ∈ fam n } → ∃n : β, ↑fs ⊆ fam n) instDec fin
    case empty =>
      intros _
      refine ⟨default,?_⟩
      intros h₂ h₃
      contradiction
    case insert =>
      intros x fs _ h₃ h₄
      have l₁ : x ∈ {x : α | ∃n : β, x ∈ fam n } := h₄ $ Finset.mem_insert_self x fs
      have ⟨n, l₂⟩ := l₁
      have l₃ : ↑fs ⊆ {x : α | ∃n : β, x ∈ fam n } := by
        intros y h₅
        exact h₄ $ Finset.mem_insert_of_mem (Finset.mem_coe.mp h₅)
      have ⟨m, l₄⟩ := h₃ l₃
      cases le_total n m
      case inl leqthan =>
        have l₅ := (h₁ leqthan) l₂
        refine ⟨m,?_⟩
        intros y h₄
        cases Finset.mem_insert.mp h₄
        case inl h₅ => rw [h₅]; assumption
        case inr h₅ => exact l₄ h₅
      case inr geqthan =>
        have l₅ := le_trans l₄ (h₁ geqthan)
        refine ⟨n,?_⟩
        intros y h₄
        cases Finset.mem_insert.mp h₄
        case inl h₅ => rw [h₅]; assumption
        case inr h₅ => exact l₅ h₅