/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.list.prime
import data.polynomial.field_division
import data.polynomial.lifts

/-!
# Split polynomials

A polynomial `f : K[X]` splits over a field extension `L` of `K` if it is zero or all of its
irreducible factors over `L` have degree `1`.

## Main definitions

* `polynomial.splits i f`: A predicate on a homomorphism `i : K →+* L` from a commutative ring to a
  field and a polynomial `f` saying that `f.map i` is zero or all of its irreducible factors over
  `L` have degree `1`.

## Main statements

* `lift_of_splits`: If `K` and `L` are field extensions of a field `F` and for some finite subset
  `S` of `K`, the minimal polynomial of every `x ∈ K` splits as a polynomial with coefficients in
  `L`, then `algebra.adjoin F S` embeds into `L`.

-/

noncomputable theory
open_locale classical big_operators polynomial

universes u v w

variables {F : Type u} {K : Type v} {L : Type w}

namespace polynomial

open polynomial

section splits

section comm_ring
variables [comm_ring K] [field L] [field F]
variables (i : K →+* L)

/-- A polynomial `splits` iff it is zero or all of its irreducible factors have `degree` 1. -/
def splits (f : K[X]) : Prop :=
f.map i = 0 ∨ ∀ {g : L[X]}, irreducible g → g ∣ f.map i → degree g = 1

@[simp]

lemma splits_of_map_eq_C {f : K[X]} {a : L} (h : f.map i = C a) : splits i f :=
if ha : a = 0 then or.inl (h.trans (ha.symm ▸ C_0))
else or.inr $ λ g hg ⟨p, hp⟩, absurd hg.1 $ not_not.2 $ is_unit_iff_degree_eq_zero.2 $
begin
  have := congr_arg degree hp,
  rw [h, degree_C ha, degree_mul, @eq_comm (with_bot ℕ) 0, nat.with_bot.add_eq_zero_iff] at this,
  exact this.1,
end

@[simp] lemma splits_C (a : K) : splits i (C a) := splits_of_map_eq_C i (map_C i)

lemma splits_of_map_degree_eq_one {f : K[X]} (hf : degree (f.map i) = 1) : splits i f :=
or.inr $ λ g hg ⟨p, hp⟩,
  by have := congr_arg degree hp;
  simp [nat.with_bot.add_eq_one_iff, hf, @eq_comm (with_bot ℕ) 1,
    mt is_unit_iff_degree_eq_zero.2 hg.1] at this;
  clear _fun_match; tauto

lemma splits_of_degree_le_one {f : K[X]} (hf : degree f ≤ 1) : splits i f :=
if hif : degree (f.map i) ≤ 0 then splits_of_map_eq_C i (degree_le_zero_iff.mp hif)
else begin
  push_neg at hif,
  rw [← order.succ_le_iff, ← with_bot.coe_zero, with_bot.succ_coe, nat.succ_eq_succ] at hif,
  exact splits_of_map_degree_eq_one i (le_antisymm ((degree_map_le i _).trans hf) hif),
end

lemma splits_of_degree_eq_one {f : K[X]} (hf : degree f = 1) : splits i f :=
splits_of_degree_le_one i hf.le

lemma splits_of_nat_degree_le_one {f : K[X]} (hf : nat_degree f ≤ 1) : splits i f :=
splits_of_degree_le_one i (degree_le_of_nat_degree_le hf)

lemma splits_of_nat_degree_eq_one {f : K[X]} (hf : nat_degree f = 1) : splits i f :=
splits_of_nat_degree_le_one i (le_of_eq hf)

lemma splits_mul {f g : K[X]} (hf : splits i f) (hg : splits i g) : splits i (f * g) :=
if h : (f * g).map i = 0 then or.inl h
else or.inr $ λ p hp hpf, ((principal_ideal_ring.irreducible_iff_prime.1 hp).2.2 _ _
    (show p ∣ map i f * map i g, by convert hpf; rw polynomial.map_mul)).elim
  (hf.resolve_left (λ hf, by simpa [hf] using h) hp)
  (hg.resolve_left (λ hg, by simpa [hg] using h) hp)

lemma splits_of_splits_mul' {f g : K[X]} (hfg : (f * g).map i ≠ 0) (h : splits i (f * g)) :
  splits i f ∧ splits i g :=
⟨or.inr $ λ g hgi hg, or.resolve_left h hfg hgi
   (by rw polynomial.map_mul; exact hg.trans (dvd_mul_right _ _)),
 or.inr $ λ g hgi hg, or.resolve_left h hfg hgi
   (by rw polynomial.map_mul; exact hg.trans (dvd_mul_left _ _))⟩

lemma splits_map_iff (j : L →+* F) {f : K[X]} :
  splits j (f.map i) ↔ splits (j.comp i) f :=
by simp [splits, polynomial.map_map]

theorem splits_one : splits i 1 :=
splits_C i 1

theorem splits_of_is_unit [is_domain K] {u : K[X]} (hu : is_unit u) : u.splits i :=
(is_unit_iff.mp hu).some_spec.2 ▸ splits_C _ _

theorem splits_X_sub_C {x : K} : (X - C x).splits i :=
splits_of_degree_le_one _ $ degree_X_sub_C_le _

theorem splits_X : X.splits i :=
splits_of_degree_le_one _ degree_X_le

theorem splits_prod {ι : Type u} {s : ι → K[X]} {t : finset ι} :
  (∀ j ∈ t, (s j).splits i) → (∏ x in t, s x).splits i :=
begin
  refine finset.induction_on t (λ _, splits_one i) (λ a t hat ih ht, _),
  rw finset.forall_mem_insert at ht, rw finset.prod_insert hat,
  exact splits_mul i ht.1 (ih ht.2)
end

lemma splits_pow {f : K[X]} (hf : f.splits i) (n : ℕ) : (f ^ n).splits i :=
begin
  rw [←finset.card_range n, ←finset.prod_const],
  exact splits_prod i (λ j hj, hf),
end

lemma splits_X_pow (n : ℕ) : (X ^ n).splits i := splits_pow i (splits_X i) n

theorem splits_id_iff_splits {f : K[X]} :
  (f.map i).splits (ring_hom.id L) ↔ f.splits i :=
by rw [splits_map_iff, ring_hom.id_comp]

lemma exists_root_of_splits' {f : K[X]} (hs : splits i f) (hf0 : degree (f.map i) ≠ 0) :
  ∃ x, eval₂ i x f = 0 :=
if hf0' : f.map i = 0 then by simp [eval₂_eq_eval_map, hf0']
else
  let ⟨g, hg⟩ := wf_dvd_monoid.exists_irreducible_factor
    (show ¬ is_unit (f.map i), from mt is_unit_iff_degree_eq_zero.1 hf0) hf0' in
  let ⟨x, hx⟩ := exists_root_of_degree_eq_one (hs.resolve_left hf0' hg.1 hg.2) in
  let ⟨i, hi⟩ := hg.2 in
  ⟨x, by rw [← eval_map, hi, eval_mul, show _ = _, from hx, zero_mul]⟩

lemma roots_ne_zero_of_splits' {f : K[X]} (hs : splits i f) (hf0 : nat_degree (f.map i) ≠ 0) :
  (f.map i).roots ≠ 0 :=
let ⟨x, hx⟩ := exists_root_of_splits' i hs (λ h, hf0 $ nat_degree_eq_of_degree_eq_some h) in
λ h, by { rw ← eval_map at hx,
  cases h.subst ((mem_roots _).2 hx), exact ne_zero_of_nat_degree_gt (nat.pos_of_ne_zero hf0) }

/-- Pick a root of a polynomial that splits. See `root_of_splits` for polynomials over a field
which has simpler assumptions. -/
def root_of_splits' {f : K[X]} (hf : f.splits i) (hfd : (f.map i).degree ≠ 0) : L :=
classical.some $ exists_root_of_splits' i hf hfd

theorem map_root_of_splits' {f : K[X]} (hf : f.splits i) (hfd) :
  f.eval₂ i (root_of_splits' i hf hfd) = 0 :=
classical.some_spec $ exists_root_of_splits' i hf hfd

lemma nat_degree_eq_card_roots' {p : K[X]} {i : K →+* L}
  (hsplit : splits i p) : (p.map i).nat_degree = (p.map i).roots.card :=
begin
  by_cases hp : p.map i = 0,
  { rw [hp, nat_degree_zero, roots_zero, multiset.card_zero] },
  obtain ⟨q, he, hd, hr⟩ := exists_prod_multiset_X_sub_C_mul (p.map i),
  rw [← splits_id_iff_splits, ← he] at hsplit,
  rw ← he at hp,
  have hq : q ≠ 0 := λ h, hp (by rw [h, mul_zero]),
  rw [← hd, add_right_eq_self],
  by_contra,
  have h' : (map (ring_hom.id L) q).nat_degree ≠ 0, { simp [h], },
  have := roots_ne_zero_of_splits' (ring_hom.id L) (splits_of_splits_mul' _ _ hsplit).2 h',
  { rw map_id at this, exact this hr },
  { rw [map_id], exact mul_ne_zero monic_prod_multiset_X_sub_C.ne_zero hq },
end

lemma degree_eq_card_roots' {p : K[X]} {i : K →+* L} (p_ne_zero : p.map i ≠ 0)
  (hsplit : splits i p) : (p.map i).degree = (p.map i).roots.card :=
by rw [degree_eq_nat_degree p_ne_zero, nat_degree_eq_card_roots' hsplit]

end comm_ring

variables [field K] [field L] [field F]
variables (i : K →+* L)

/-- This lemma is for polynomials over a field. -/
lemma splits_iff (f : K[X]) :
  splits i f ↔ f = 0 ∨ ∀ {g : L[X]}, irreducible g → g ∣ f.map i → degree g = 1 :=
by rw [splits, map_eq_zero]

/-- This lemma is for polynomials over a field. -/
lemma splits.def {i : K →+* L} {f : K[X]} (h : splits i f) :
  f = 0 ∨ ∀ {g : L[X]}, irreducible g → g ∣ f.map i → degree g = 1 :=
(splits_iff i f).mp h

lemma splits_of_splits_mul {f g : K[X]} (hfg : f * g ≠ 0) (h : splits i (f * g)) :
  splits i f ∧ splits i g :=
splits_of_splits_mul' i (map_ne_zero hfg) h

lemma splits_of_splits_of_dvd {f g : K[X]} (hf0 : f ≠ 0) (hf : splits i f) (hgf : g ∣ f) :
  splits i g :=
by { obtain ⟨f, rfl⟩ := hgf, exact (splits_of_splits_mul i hf0 hf).1 }

lemma splits_of_splits_gcd_left {f g : K[X]} (hf0 : f ≠ 0) (hf : splits i f) :
  splits i (euclidean_domain.gcd f g) :=
polynomial.splits_of_splits_of_dvd i hf0 hf (euclidean_domain.gcd_dvd_left f g)

lemma splits_of_splits_gcd_right {f g : K[X]} (hg0 : g ≠ 0) (hg : splits i g) :
  splits i (euclidean_domain.gcd f g) :=
polynomial.splits_of_splits_of_dvd i hg0 hg (euclidean_domain.gcd_dvd_right f g)

theorem splits_mul_iff {f g : K[X]} (hf : f ≠ 0) (hg : g ≠ 0) :
  (f * g).splits i ↔ f.splits i ∧ g.splits i :=
⟨splits_of_splits_mul i (mul_ne_zero hf hg), λ ⟨hfs, hgs⟩, splits_mul i hfs hgs⟩

theorem splits_prod_iff {ι : Type u} {s : ι → K[X]} {t : finset ι} :
  (∀ j ∈ t, s j ≠ 0) → ((∏ x in t, s x).splits i ↔ ∀ j ∈ t, (s j).splits i) :=
begin
  refine finset.induction_on t (λ _, ⟨λ _ _ h, h.elim, λ _, splits_one i⟩) (λ a t hat ih ht, _),
  rw finset.forall_mem_insert at ht ⊢,
  rw [finset.prod_insert hat, splits_mul_iff i ht.1 (finset.prod_ne_zero_iff.2 ht.2), ih ht.2]
end

lemma degree_eq_one_of_irreducible_of_splits {p : K[X]}
  (hp : irreducible p) (hp_splits : splits (ring_hom.id K) p) :
  p.degree = 1 :=
begin
  rcases hp_splits,
  { exfalso, simp * at *, },
  { apply hp_splits hp, simp }
end

lemma exists_root_of_splits {f : K[X]} (hs : splits i f) (hf0 : degree f ≠ 0) :
  ∃ x, eval₂ i x f = 0 :=
exists_root_of_splits' i hs ((f.degree_map i).symm ▸ hf0)

lemma roots_ne_zero_of_splits {f : K[X]} (hs : splits i f) (hf0 : nat_degree f ≠ 0) :
  (f.map i).roots ≠ 0 :=
roots_ne_zero_of_splits' i hs (ne_of_eq_of_ne (nat_degree_map i) hf0)

/-- Pick a root of a polynomial that splits. This version is for polynomials over a field and has
simpler assumptions. -/
def root_of_splits {f : K[X]} (hf : f.splits i) (hfd : f.degree ≠ 0) : L :=
root_of_splits' i hf ((f.degree_map i).symm ▸ hfd)

/-- `root_of_splits'` is definitionally equal to `root_of_splits`. -/
lemma root_of_splits'_eq_root_of_splits {f : K[X]} (hf : f.splits i) (hfd) :
  root_of_splits' i hf hfd = root_of_splits i hf (f.degree_map i ▸ hfd) := rfl

theorem map_root_of_splits {f : K[X]} (hf : f.splits i) (hfd) :
  f.eval₂ i (root_of_splits i hf hfd) = 0 :=
map_root_of_splits' i hf (ne_of_eq_of_ne (degree_map f i) hfd)

lemma nat_degree_eq_card_roots {p : K[X]} {i : K →+* L}
  (hsplit : splits i p) : p.nat_degree = (p.map i).roots.card :=
(nat_degree_map i).symm.trans $ nat_degree_eq_card_roots' hsplit

lemma degree_eq_card_roots {p : K[X]} {i : K →+* L} (p_ne_zero : p ≠ 0)
  (hsplit : splits i p) : p.degree = (p.map i).roots.card :=
by rw [degree_eq_nat_degree p_ne_zero, nat_degree_eq_card_roots hsplit]

theorem roots_map {f : K[X]} (hf : f.splits $ ring_hom.id K) :
  (f.map i).roots = f.roots.map i :=
(roots_map_of_injective_of_card_eq_nat_degree i.injective $
  by { convert (nat_degree_eq_card_roots hf).symm, rw map_id }).symm

lemma image_root_set [algebra F K] [algebra F L] {p : F[X]} (h : p.splits (algebra_map F K))
  (f : K →ₐ[F] L) : f '' p.root_set K = p.root_set L :=
begin
  classical,
  rw [root_set, ←finset.coe_image, ←multiset.to_finset_map, ←f.coe_to_ring_hom, ←roots_map ↑f
      ((splits_id_iff_splits (algebra_map F K)).mpr h), map_map, f.comp_algebra_map, ←root_set],
end

lemma adjoin_root_set_eq_range [algebra F K] [algebra F L] {p : F[X]}
  (h : p.splits (algebra_map F K)) (f : K →ₐ[F] L) :
  algebra.adjoin F (p.root_set L) = f.range ↔ algebra.adjoin F (p.root_set K) = ⊤ :=
begin
  rw [←image_root_set h f, algebra.adjoin_image, ←algebra.map_top],
  exact (subalgebra.map_injective f.to_ring_hom.injective).eq_iff,
end

lemma eq_prod_roots_of_splits {p : K[X]} {i : K →+* L} (hsplit : splits i p) :
  p.map i = C (i p.leading_coeff) * ((p.map i).roots.map (λ a, X - C a)).prod :=
begin
  rw ← leading_coeff_map, symmetry,
  apply C_leading_coeff_mul_prod_multiset_X_sub_C,
  rw nat_degree_map, exact (nat_degree_eq_card_roots hsplit).symm,
end

lemma eq_prod_roots_of_splits_id {p : K[X]}
  (hsplit : splits (ring_hom.id K) p) :
  p = C p.leading_coeff * (p.roots.map (λ a, X - C a)).prod :=
by simpa using eq_prod_roots_of_splits hsplit

lemma eq_prod_roots_of_monic_of_splits_id {p : K[X]}
  (m : monic p) (hsplit : splits (ring_hom.id K) p) :
  p = (p.roots.map (λ a, X - C a)).prod :=
begin
  convert eq_prod_roots_of_splits_id hsplit,
  simp [m],
end

lemma eq_X_sub_C_of_splits_of_single_root {x : K} {h : K[X]} (h_splits : splits i h)
  (h_roots : (h.map i).roots = {i x}) : h = C h.leading_coeff * (X - C x) :=
begin
  apply polynomial.map_injective _ i.injective,
  rw [eq_prod_roots_of_splits h_splits, h_roots],
  simp,
end

theorem mem_lift_of_splits_of_roots_mem_range (R : Type*) [comm_ring R] [algebra R K] {f : K[X]}
  (hs : f.splits (ring_hom.id K)) (hm : f.monic)
  (hr : ∀ a ∈ f.roots, a ∈ (algebra_map R K).range) : f ∈ polynomial.lifts (algebra_map R K) :=
begin
  rw [eq_prod_roots_of_monic_of_splits_id hm hs, lifts_iff_lifts_ring],
  refine subring.multiset_prod_mem _ _ (λ P hP, _),
  obtain ⟨b, hb, rfl⟩ := multiset.mem_map.1 hP,
  exact subring.sub_mem _ (X_mem_lifts _) (C'_mem_lifts (hr _ hb))
end

section UFD

local attribute [instance, priority 10] principal_ideal_ring.to_unique_factorization_monoid
local infix ` ~ᵤ ` : 50 := associated

open unique_factorization_monoid associates

lemma splits_of_exists_multiset {f : K[X]} {s : multiset L}
  (hs : f.map i = C (i f.leading_coeff) * (s.map (λ a : L, X - C a)).prod) :
  splits i f :=
if hf0 : f = 0 then hf0.symm ▸ splits_zero i
else or.inr $ λ p hp hdp, begin
  rw irreducible_iff_prime at hp,
  rw [hs, ← multiset.prod_to_list] at hdp,
  obtain (hd|hd) := hp.2.2 _ _ hdp,
  { refine (hp.2.1 $ is_unit_of_dvd_unit hd _).elim,
    exact is_unit_C.2 ((leading_coeff_ne_zero.2 hf0).is_unit.map i) },
  { obtain ⟨q, hq, hd⟩ := hp.dvd_prod_iff.1 hd,
    obtain ⟨a, ha, rfl⟩ := multiset.mem_map.1 (multiset.mem_to_list.1 hq),
    rw degree_eq_degree_of_associated ((hp.dvd_prime_iff_associated $ prime_X_sub_C a).1 hd),
    exact degree_X_sub_C a },
end

lemma splits_of_splits_id {f : K[X]} : splits (ring_hom.id K) f → splits i f :=
unique_factorization_monoid.induction_on_prime f (λ _, splits_zero _)
  (λ _ hu _, splits_of_degree_le_one _
    ((is_unit_iff_degree_eq_zero.1 hu).symm ▸ dec_trivial))
  (λ a p ha0 hp ih hfi, splits_mul _
    (splits_of_degree_eq_one _
      ((splits_of_splits_mul _ (mul_ne_zero hp.1 ha0) hfi).1.def.resolve_left
        hp.1 hp.irreducible (by rw map_id)))
    (ih (splits_of_splits_mul _ (mul_ne_zero hp.1 ha0) hfi).2))

end UFD

lemma splits_iff_exists_multiset {f : K[X]} : splits i f ↔
  ∃ (s : multiset L), f.map i = C (i f.leading_coeff) * (s.map (λ a : L, X - C a)).prod :=
⟨λ hf, ⟨(f.map i).roots, eq_prod_roots_of_splits hf⟩, λ ⟨s, hs⟩, splits_of_exists_multiset i hs⟩

lemma splits_comp_of_splits (j : L →+* F) {f : K[X]}
  (h : splits i f) : splits (j.comp i) f :=
begin
  change i with ((ring_hom.id _).comp i) at h,
  rw [← splits_map_iff],
  rw [← splits_map_iff i] at h,
  exact splits_of_splits_id _ h
end

/-- A polynomial splits if and only if it has as many roots as its degree. -/
lemma splits_iff_card_roots {p : K[X]} :
  splits (ring_hom.id K) p ↔ p.roots.card = p.nat_degree :=
begin
  split,
  { intro H, rw [nat_degree_eq_card_roots H, map_id] },
  { intro hroots,
    rw splits_iff_exists_multiset (ring_hom.id K),
    use p.roots,
    simp only [ring_hom.id_apply, map_id],
    exact (C_leading_coeff_mul_prod_multiset_X_sub_C hroots).symm },
end

lemma aeval_root_derivative_of_splits [algebra K L] {P : K[X]} (hmo : P.monic)
  (hP : P.splits (algebra_map K L)) {r : L} (hr : r ∈ (P.map (algebra_map K L)).roots) :
  aeval r P.derivative = (((P.map $ algebra_map K L).roots.erase r).map (λ a, r - a)).prod :=
begin
  replace hmo := hmo.map (algebra_map K L),
  replace hP := (splits_id_iff_splits (algebra_map K L)).2 hP,
  rw [aeval_def, ← eval_map, ← derivative_map],
  nth_rewrite 0 [eq_prod_roots_of_monic_of_splits_id hmo hP],
  rw [eval_multiset_prod_X_sub_C_derivative hr]
end

/-- If `P` is a monic polynomial that splits, then `coeff P 0` equals the product of the roots. -/
lemma prod_roots_eq_coeff_zero_of_monic_of_split {P : K[X]} (hmo : P.monic)
  (hP : P.splits (ring_hom.id K)) : coeff P 0 = (-1) ^ P.nat_degree * P.roots.prod :=
begin
  nth_rewrite 0 [eq_prod_roots_of_monic_of_splits_id hmo hP],
  rw [coeff_zero_eq_eval_zero, eval_multiset_prod, multiset.map_map],
  simp_rw [function.comp_app, eval_sub, eval_X, zero_sub, eval_C],
  conv_lhs { congr, congr, funext,
    rw [neg_eq_neg_one_mul] },
  rw [multiset.prod_map_mul, multiset.map_const, multiset.prod_replicate, multiset.map_id',
    splits_iff_card_roots.1 hP]
end

/-- If `P` is a monic polynomial that splits, then `P.next_coeff` equals the sum of the roots. -/
lemma sum_roots_eq_next_coeff_of_monic_of_split {P : K[X]} (hmo : P.monic)
  (hP : P.splits (ring_hom.id K)) : P.next_coeff = - P.roots.sum :=
begin
  nth_rewrite 0 [eq_prod_roots_of_monic_of_splits_id hmo hP],
  rw [monic.next_coeff_multiset_prod _ _ (λ a ha, _)],
  { simp_rw [next_coeff_X_sub_C, multiset.sum_map_neg'] },
  { exact monic_X_sub_C a }
end

end splits

end polynomial


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import algebra.group_ring_action.invariant
import algebra.polynomial.group_ring_action
import field_theory.normal
import field_theory.separable
import field_theory.tower

/-!
# Fixed field under a group action.

This is the basis of the Fundamental Theorem of Galois Theory.
Given a (finite) group `G` that acts on a field `F`, we define `fixed_points G F`,
the subfield consisting of elements of `F` fixed_points by every element of `G`.

This subfield is then normal and separable, and in addition (TODO) if `G` acts faithfully on `F`
then `finrank (fixed_points G F) F = fintype.card G`.

## Main Definitions

- `fixed_points G F`, the subfield consisting of elements of `F` fixed_points by every element of
`G`, where `G` is a group that acts on `F`.

-/

noncomputable theory
open_locale classical big_operators
open mul_action finset finite_dimensional

universes u v w

variables {M : Type u} [monoid M]
variables (G : Type u) [group G]
variables (F : Type v) [field F] [mul_semiring_action M F] [mul_semiring_action G F] (m : M)

/-- The subfield of F fixed by the field endomorphism `m`. -/
def fixed_by.subfield : subfield F :=
{ carrier := fixed_by M F m,
  zero_mem' := smul_zero m,
  add_mem' := λ x y hx hy, (smul_add m x y).trans $ congr_arg2 _ hx hy,
  neg_mem' := λ x hx, (smul_neg m x).trans $ congr_arg _ hx,
  one_mem' := smul_one m,
  mul_mem' := λ x y hx hy, (smul_mul' m x y).trans $ congr_arg2 _ hx hy,
  inv_mem' := λ x hx, (smul_inv'' m x).trans $ congr_arg _ hx }

section invariant_subfields

variables (M) {F}
/-- A typeclass for subrings invariant under a `mul_semiring_action`. -/
class is_invariant_subfield (S : subfield F) : Prop :=
(smul_mem : ∀ (m : M) {x : F}, x ∈ S → m • x ∈ S)

variable (S : subfield F)

instance is_invariant_subfield.to_mul_semiring_action [is_invariant_subfield M S] :
  mul_semiring_action M S :=
{ smul := λ m x, ⟨m • x, is_invariant_subfield.smul_mem m x.2⟩,
  one_smul := λ s, subtype.eq $ one_smul M s,
  mul_smul := λ m₁ m₂ s, subtype.eq $ mul_smul m₁ m₂ s,
  smul_add := λ m s₁ s₂, subtype.eq $ smul_add m s₁ s₂,
  smul_zero := λ m, subtype.eq $ smul_zero m,
  smul_one := λ m, subtype.eq $ smul_one m,
  smul_mul := λ m s₁ s₂, subtype.eq $ smul_mul' m s₁ s₂ }

instance [is_invariant_subfield M S] : is_invariant_subring M (S.to_subring) :=
{ smul_mem := is_invariant_subfield.smul_mem }

end invariant_subfields

namespace fixed_points

variable (M)

-- we use `subfield.copy` so that the underlying set is `fixed_points M F`
/-- The subfield of fixed points by a monoid action. -/
def subfield : subfield F :=
subfield.copy (⨅ (m : M), fixed_by.subfield F m) (fixed_points M F)
(by { ext z, simp [fixed_points, fixed_by.subfield, infi, subfield.mem_Inf] })

instance : is_invariant_subfield M (fixed_points.subfield M F) :=
{ smul_mem := λ g x hx g', by rw [hx, hx] }

instance : smul_comm_class M (fixed_points.subfield M F) F :=
{ smul_comm := λ m f f', show m • (↑f * f') = f * (m • f'), by rw [smul_mul', f.prop m] }

instance smul_comm_class' : smul_comm_class (fixed_points.subfield M F) M F :=
smul_comm_class.symm _ _ _

@[simp] theorem smul (m : M) (x : fixed_points.subfield M F) : m • x = x :=
subtype.eq $ x.2 m

-- Why is this so slow?
@[simp] theorem smul_polynomial (m : M) (p : polynomial (fixed_points.subfield M F)) : m • p = p :=
polynomial.induction_on p
  (λ x, by rw [polynomial.smul_C, smul])
  (λ p q ihp ihq, by rw [smul_add, ihp, ihq])
  (λ n x ih, by rw [smul_mul', polynomial.smul_C, smul, smul_pow', polynomial.smul_X])

instance : algebra (fixed_points.subfield M F) F :=
by apply_instance

theorem coe_algebra_map :
  algebra_map (fixed_points.subfield M F) F = subfield.subtype (fixed_points.subfield M F) :=
rfl

lemma linear_independent_smul_of_linear_independent {s : finset F} :
  linear_independent (fixed_points.subfield G F) (λ i : (s : set F), (i : F)) →
  linear_independent F (λ i : (s : set F), mul_action.to_fun G F i) :=
begin
  haveI : is_empty ((∅ : finset F) : set F) := ⟨subtype.prop⟩,
  refine finset.induction_on s (λ _, linear_independent_empty_type)
    (λ a s has ih hs, _),
  rw coe_insert at hs ⊢,
  rw linear_independent_insert (mt mem_coe.1 has) at hs,
  rw linear_independent_insert' (mt mem_coe.1 has), refine ⟨ih hs.1, λ ha, _⟩,
  rw finsupp.mem_span_image_iff_total at ha, rcases ha with ⟨l, hl, hla⟩,
  rw [finsupp.total_apply_of_mem_supported F hl] at hla,
  suffices : ∀ i ∈ s, l i ∈ fixed_points.subfield G F,
  { replace hla := (sum_apply _ _ (λ i, l i • to_fun G F i)).symm.trans (congr_fun hla 1),
    simp_rw [pi.smul_apply, to_fun_apply, one_smul] at hla,
    refine hs.2 (hla ▸ submodule.sum_mem _ (λ c hcs, _)),
    change (⟨l c, this c hcs⟩ : fixed_points.subfield G F) • c ∈ _,
    exact submodule.smul_mem _ _ (submodule.subset_span $ mem_coe.2 hcs) },
  intros i his g,
  refine eq_of_sub_eq_zero (linear_independent_iff'.1 (ih hs.1) s.attach (λ i, g • l i - l i) _
    ⟨i, his⟩ (mem_attach _ _) : _),
  refine (@sum_attach _ _ s _ (λ i, (g • l i - l i) • mul_action.to_fun G F i)).trans _,
  ext g', dsimp only,
  conv_lhs { rw sum_apply, congr, skip, funext, rw [pi.smul_apply, sub_smul, smul_eq_mul] },
  rw [sum_sub_distrib, pi.zero_apply, sub_eq_zero],
  conv_lhs { congr, skip, funext,
    rw [to_fun_apply, ← mul_inv_cancel_left g g', mul_smul, ← smul_mul', ← to_fun_apply _ x] },
  show ∑ x in s, g • (λ y, l y • mul_action.to_fun G F y) x (g⁻¹ * g') =
    ∑ x in s, (λ y, l y • mul_action.to_fun G F y) x g',
  rw [← smul_sum, ← sum_apply _ _ (λ y, l y • to_fun G F y),
      ← sum_apply _ _ (λ y, l y • to_fun G F y)], dsimp only,
  rw [hla, to_fun_apply, to_fun_apply, smul_smul, mul_inv_cancel_left]
end

section fintype
variables [fintype G] (x : F)

/-- `minpoly G F x` is the minimal polynomial of `(x : F)` over `fixed_points G F`. -/
def minpoly : polynomial (fixed_points.subfield G F) :=
(prod_X_sub_smul G F x).to_subring (fixed_points.subfield G F).to_subring $ λ c hc g,
let ⟨n, hc0, hn⟩ := polynomial.mem_frange_iff.1 hc in hn.symm ▸ prod_X_sub_smul.coeff G F x g n

namespace minpoly

theorem eval₂ : polynomial.eval₂ (subring.subtype $ (fixed_points.subfield G F).to_subring) x
  (minpoly G F x) = 0 :=
begin
  rw [← prod_X_sub_smul.eval G F x, polynomial.eval₂_eq_eval_map],
  simp only [minpoly, polynomial.map_to_subring],
end

theorem eval₂' :
  polynomial.eval₂ (subfield.subtype $ (fixed_points.subfield G F)) x (minpoly G F x) = 0 :=
eval₂ G F x

theorem ne_one :
  minpoly G F x ≠ (1 : polynomial (fixed_points.subfield G F)) :=
λ H, have _ := eval₂ G F x,
(one_ne_zero : (1 : F) ≠ 0) $ by rwa [H, polynomial.eval₂_one] at this

theorem of_eval₂ (f : polynomial (fixed_points.subfield G F))
  (hf : polynomial.eval₂ (subfield.subtype $ fixed_points.subfield G F) x f = 0) :
  minpoly G F x ∣ f :=
begin
  erw [← polynomial.map_dvd_map' (subfield.subtype $ fixed_points.subfield G F),
      minpoly, polynomial.map_to_subring _ (subfield G F).to_subring, prod_X_sub_smul],
  refine fintype.prod_dvd_of_coprime
    (polynomial.pairwise_coprime_X_sub_C $ mul_action.injective_of_quotient_stabilizer G x)
    (λ y, quotient_group.induction_on y $ λ g, _),
  rw [polynomial.dvd_iff_is_root, polynomial.is_root.def, mul_action.of_quotient_stabilizer_mk,
      polynomial.eval_smul',
      ← subfield.to_subring.subtype_eq_subtype,
      ← is_invariant_subring.coe_subtype_hom' G (fixed_points.subfield G F).to_subring,
      ← mul_semiring_action_hom.coe_polynomial, ← mul_semiring_action_hom.map_smul,
      smul_polynomial, mul_semiring_action_hom.coe_polynomial,
      is_invariant_subring.coe_subtype_hom', polynomial.eval_map,
      subfield.to_subring.subtype_eq_subtype, hf, smul_zero]
end

/- Why is this so slow? -/
theorem irreducible_aux (f g : polynomial (fixed_points.subfield G F))
  (hf : f.monic) (hg : g.monic) (hfg : f * g = minpoly G F x) :
  f = 1 ∨ g = 1 :=
begin
  have hf2 : f ∣ minpoly G F x,
  { rw ← hfg, exact dvd_mul_right _ _ },
  have hg2 : g ∣ minpoly G F x,
  { rw ← hfg, exact dvd_mul_left _ _ },
  have := eval₂ G F x,
  rw [← hfg, polynomial.eval₂_mul, mul_eq_zero] at this,
  cases this,
  { right,
    have hf3 : f = minpoly G F x,
    { exact polynomial.eq_of_monic_of_associated hf (monic G F x)
        (associated_of_dvd_dvd hf2 $ @of_eval₂ G _ F _ _ _  x f this) },
    rwa [← mul_one (minpoly G F x), hf3,
        mul_right_inj' (monic G F x).ne_zero] at hfg },
  { left,
    have hg3 : g = minpoly G F x,
    { exact polynomial.eq_of_monic_of_associated hg (monic G F x)
        (associated_of_dvd_dvd hg2 $ @of_eval₂ G _ F _ _ _  x g this) },
    rwa [← one_mul (minpoly G F x), hg3,
        mul_left_inj' (monic G F x).ne_zero] at hfg }
end

theorem irreducible : irreducible (minpoly G F x) :=
(polynomial.irreducible_of_monic (monic G F x) (ne_one G F x)).2 (irreducible_aux G F x)

end minpoly
end fintype

theorem is_integral [finite G] (x : F) : is_integral (fixed_points.subfield G F) x :=
by { casesI nonempty_fintype G, exact ⟨minpoly G F x, minpoly.monic G F x, minpoly.eval₂ G F x⟩ }

section fintype
variables [fintype G] (x : F)

theorem minpoly_eq_minpoly :
  minpoly G F x = _root_.minpoly (fixed_points.subfield G F) x :=
minpoly.eq_of_irreducible_of_monic (minpoly.irreducible G F x)
  (minpoly.eval₂ G F x) (minpoly.monic G F x)

lemma dim_le_card : module.rank (fixed_points.subfield G F) F ≤ fintype.card G :=
dim_le $ λ s hs, by simpa only [dim_fun', cardinal.mk_coe_finset, finset.coe_sort_coe,
  cardinal.lift_nat_cast, cardinal.nat_cast_le]
  using cardinal_lift_le_dim_of_linear_independent'
    (linear_independent_smul_of_linear_independent G F hs)

end fintype

section finite
variables [finite G]

instance normal : normal (fixed_points.subfield G F) F :=
⟨λ x, (is_integral G F x).is_algebraic _, λ x, (polynomial.splits_id_iff_splits _).1 $
begin
  casesI nonempty_fintype G,
  rw [←minpoly_eq_minpoly, minpoly, coe_algebra_map, ←subfield.to_subring.subtype_eq_subtype,
    polynomial.map_to_subring _ (subfield G F).to_subring, prod_X_sub_smul],
  exact polynomial.splits_prod _ (λ _ _, polynomial.splits_X_sub_C _),
end⟩

instance separable : is_separable (fixed_points.subfield G F) F :=
⟨is_integral G F, λ x, by
{ casesI nonempty_fintype G,
  -- this was a plain rw when we were using unbundled subrings
  erw [← minpoly_eq_minpoly,
    ← polynomial.separable_map (fixed_points.subfield G F).subtype,
    minpoly, polynomial.map_to_subring _ ((subfield G F).to_subring) ],
  exact polynomial.separable_prod_X_sub_C_iff.2 (injective_of_quotient_stabilizer G x) }⟩

instance : finite_dimensional (subfield G F) F :=
by { casesI nonempty_fintype G, exact is_noetherian.iff_fg.1 (is_noetherian.iff_dim_lt_aleph_0.2 $
  (dim_le_card G F).trans_lt $ cardinal.nat_lt_aleph_0 _) }

end finite

lemma finrank_le_card [fintype G] : finrank (subfield G F) F ≤ fintype.card G :=
begin
  rw [← cardinal.nat_cast_le, finrank_eq_dim],
  apply dim_le_card,
end

end fixed_points

lemma linear_independent_to_linear_map (R : Type u) (A : Type v) (B : Type w)
  [comm_semiring R] [ring A] [algebra R A]
  [comm_ring B] [is_domain B] [algebra R B] :
  linear_independent B (alg_hom.to_linear_map : (A →ₐ[R] B) → (A →ₗ[R] B)) :=
have linear_independent B (linear_map.lto_fun R A B ∘ alg_hom.to_linear_map),
from ((linear_independent_monoid_hom A B).comp
  (coe : (A →ₐ[R] B) → (A →* B))
  (λ f g hfg, alg_hom.ext $ monoid_hom.ext_iff.1 hfg) : _),
this.of_comp _

lemma cardinal_mk_alg_hom (K : Type u) (V : Type v) (W : Type w)
  [field K] [field V] [algebra K V] [finite_dimensional K V]
            [field W] [algebra K W] [finite_dimensional K W] :
  cardinal.mk (V →ₐ[K] W) ≤ finrank W (V →ₗ[K] W) :=
cardinal_mk_le_finrank_of_linear_independent $ linear_independent_to_linear_map K V W

noncomputable instance alg_equiv.fintype (K : Type u) (V : Type v)
  [field K] [field V] [algebra K V] [finite_dimensional K V] :
  fintype (V ≃ₐ[K] V) :=
fintype.of_equiv (V →ₐ[K] V) (alg_equiv_equiv_alg_hom K V).symm

lemma finrank_alg_hom (K : Type u) (V : Type v)
  [field K] [field V] [algebra K V] [finite_dimensional K V] :
  fintype.card (V →ₐ[K] V) ≤ finrank V (V →ₗ[K] V) :=
fintype_card_le_finrank_of_linear_independent $ linear_independent_to_linear_map K V V

namespace fixed_points

theorem finrank_eq_card (G : Type u) (F : Type v) [group G] [field F]
  [fintype G] [mul_semiring_action G F] [has_faithful_smul G F] :
  finrank (fixed_points.subfield G F) F = fintype.card G :=
le_antisymm (fixed_points.finrank_le_card G F) $
calc  fintype.card G
    ≤ fintype.card (F →ₐ[fixed_points.subfield G F] F) :
        fintype.card_le_of_injective _ (mul_semiring_action.to_alg_hom_injective _ F)
... ≤ finrank F (F →ₗ[fixed_points.subfield G F] F) : finrank_alg_hom (fixed_points G F) F
... = finrank (fixed_points.subfield G F) F : finrank_linear_map' _ _ _

/-- `mul_semiring_action.to_alg_hom` is bijective. -/
theorem to_alg_hom_bijective (G : Type u) (F : Type v) [group G] [field F]
  [finite G] [mul_semiring_action G F] [has_faithful_smul G F] :
  function.bijective (mul_semiring_action.to_alg_hom _ _ : G → F →ₐ[subfield G F] F) :=
begin
  casesI nonempty_fintype G,
  rw fintype.bijective_iff_injective_and_card,
  split,
  { exact mul_semiring_action.to_alg_hom_injective _ F },
  { apply le_antisymm,
    { exact fintype.card_le_of_injective _ (mul_semiring_action.to_alg_hom_injective _ F) },
    { rw ← finrank_eq_card G F,
      exact has_le.le.trans_eq (finrank_alg_hom _ F) (finrank_linear_map' _ _ _) } },
end

/-- Bijection between G and algebra homomorphisms that fix the fixed points -/
def to_alg_hom_equiv (G : Type u) (F : Type v) [group G] [field F]
  [fintype G] [mul_semiring_action G F] [has_faithful_smul G F] :
    G ≃ (F →ₐ[fixed_points.subfield G F] F) :=
equiv.of_bijective _ (to_alg_hom_bijective G F)

end fixed_points


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

! This file was ported from Lean 3 source module data.nat.log
! leanprover-community/mathlib commit 55d224c38461be1e8e4363247dd110137c24a4ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Pow
import Mathbin.Tactic.ByContra

/-!
# Natural number logarithms

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

This file defines two `ℕ`-valued analogs of the logarithm of `n` with base `b`:
* `log b n`: Lower logarithm, or floor **log**. Greatest `k` such that `b^k ≤ n`.
* `clog b n`: Upper logarithm, or **c**eil **log**. Least `k` such that `n ≤ b^k`.

These are interesting because, for `1 < b`, `nat.log b` and `nat.clog b` are respectively right and
left adjoints of `nat.pow b`. See `pow_le_iff_le_log` and `le_pow_iff_clog_le`.
-/

namespace Nat

/-! ### Floor logarithm -/

#print Nat.log /-
/-- `log b n`, is the logarithm of natural number `n` in base `b`. It returns the largest `k : ℕ`
such that `b^k ≤ n`, so if `b^k = n`, it returns exactly `k`. -/
@[pp_nodot]
def log (b : ℕ) : ℕ → ℕ
  | n =>
    if h : b ≤ n ∧ 1 < b then
      have : n / b < n := div_lt_self ((zero_lt_one.trans h.2).trans_le h.1) h.2
      log (n / b) + 1
    else 0
#align nat.log Nat.log
-/

#print Nat.log_eq_zero_iff /-
@[simp]
theorem log_eq_zero_iff {b n : ℕ} : log b n = 0 ↔ n < b ∨ b ≤ 1 :=
  by
  rw [log, ite_eq_right_iff]
  simp only [Nat.succ_ne_zero, imp_false, Decidable.not_and, not_le, not_lt]
#align nat.log_eq_zero_iff Nat.log_eq_zero_iff
-/

#print Nat.log_of_lt /-
theorem log_of_lt {b n : ℕ} (hb : n < b) : log b n = 0 :=
  log_eq_zero_iff.2 (Or.inl hb)
#align nat.log_of_lt Nat.log_of_lt
-/

#print Nat.log_of_left_le_one /-
theorem log_of_left_le_one {b : ℕ} (hb : b ≤ 1) (n) : log b n = 0 :=
  log_eq_zero_iff.2 (Or.inr hb)
#align nat.log_of_left_le_one Nat.log_of_left_le_one
-/

#print Nat.log_pos_iff /-
@[simp]
theorem log_pos_iff {b n : ℕ} : 0 < log b n ↔ b ≤ n ∧ 1 < b := by
  rw [pos_iff_ne_zero, Ne.def, log_eq_zero_iff, not_or, not_lt, not_le]
#align nat.log_pos_iff Nat.log_pos_iff
-/

#print Nat.log_pos /-
theorem log_pos {b n : ℕ} (hb : 1 < b) (hbn : b ≤ n) : 0 < log b n :=
  log_pos_iff.2 ⟨hbn, hb⟩
#align nat.log_pos Nat.log_pos
-/

#print Nat.log_of_one_lt_of_le /-
theorem log_of_one_lt_of_le {b n : ℕ} (h : 1 < b) (hn : b ≤ n) : log b n = log b (n / b) + 1 :=
  by
  rw [log]
  exact if_pos ⟨hn, h⟩
#align nat.log_of_one_lt_of_le Nat.log_of_one_lt_of_le
-/

#print Nat.log_zero_left /-
@[simp]
theorem log_zero_left : ∀ n, log 0 n = 0 :=
  log_of_left_le_one zero_le_one
#align nat.log_zero_left Nat.log_zero_left
-/

#print Nat.log_zero_right /-
@[simp]
theorem log_zero_right (b : ℕ) : log b 0 = 0 :=
  log_eq_zero_iff.2 (le_total 1 b)
#align nat.log_zero_right Nat.log_zero_right
-/

#print Nat.log_one_left /-
@[simp]
theorem log_one_left : ∀ n, log 1 n = 0 :=
  log_of_left_le_one le_rfl
#align nat.log_one_left Nat.log_one_left
-/

#print Nat.log_one_right /-
@[simp]
theorem log_one_right (b : ℕ) : log b 1 = 0 :=
  log_eq_zero_iff.2 (lt_or_le _ _)
#align nat.log_one_right Nat.log_one_right
-/

#print Nat.pow_le_iff_le_log /-
/-- `pow b` and `log b` (almost) form a Galois connection. See also `nat.pow_le_of_le_log` and
`nat.le_log_of_pow_le` for individual implications under weaker assumptions. -/
theorem pow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : y ≠ 0) : b ^ x ≤ y ↔ x ≤ log b y :=
  by
  induction' y using Nat.strong_induction_on with y ih generalizing x
  cases x
  · exact iff_of_true hy.bot_lt (zero_le _)
  rw [log]; split_ifs
  · have b_pos : 0 < b := zero_le_one.trans_lt hb
    rw [succ_eq_add_one, add_le_add_iff_right, ←
      ih (y / b) (div_lt_self hy.bot_lt hb) (Nat.div_pos h.1 b_pos).ne', le_div_iff_mul_le b_pos,
      pow_succ']
  ·
    exact
      iff_of_false (fun hby => h ⟨(le_self_pow x.succ_ne_zero _).trans hby, hb⟩)
        (not_succ_le_zero _)
#align nat.pow_le_iff_le_log Nat.pow_le_iff_le_log
-/

#print Nat.lt_pow_iff_log_lt /-
theorem lt_pow_iff_log_lt {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : y ≠ 0) : y < b ^ x ↔ log b y < x :=
  lt_iff_lt_of_le_iff_le (pow_le_iff_le_log hb hy)
#align nat.lt_pow_iff_log_lt Nat.lt_pow_iff_log_lt
-/

#print Nat.pow_le_of_le_log /-
theorem pow_le_of_le_log {b x y : ℕ} (hy : y ≠ 0) (h : x ≤ log b y) : b ^ x ≤ y :=
  by
  refine' (le_or_lt b 1).elim (fun hb => _) fun hb => (pow_le_iff_le_log hb hy).2 h
  rw [log_of_left_le_one hb, nonpos_iff_eq_zero] at h
  rwa [h, pow_zero, one_le_iff_ne_zero]
#align nat.pow_le_of_le_log Nat.pow_le_of_le_log
-/

#print Nat.le_log_of_pow_le /-
theorem le_log_of_pow_le {b x y : ℕ} (hb : 1 < b) (h : b ^ x ≤ y) : x ≤ log b y :=
  by
  rcases ne_or_eq y 0 with (hy | rfl)
  exacts[(pow_le_iff_le_log hb hy).1 h, (h.not_lt (pow_pos (zero_lt_one.trans hb) _)).elim]
#align nat.le_log_of_pow_le Nat.le_log_of_pow_le
-/

#print Nat.pow_log_le_self /-
theorem pow_log_le_self (b : ℕ) {x : ℕ} (hx : x ≠ 0) : b ^ log b x ≤ x :=
  pow_le_of_le_log hx le_rfl
#align nat.pow_log_le_self Nat.pow_log_le_self
-/

#print Nat.log_lt_of_lt_pow /-
theorem log_lt_of_lt_pow {b x y : ℕ} (hy : y ≠ 0) : y < b ^ x → log b y < x :=
  lt_imp_lt_of_le_imp_le (pow_le_of_le_log hy)
#align nat.log_lt_of_lt_pow Nat.log_lt_of_lt_pow
-/

#print Nat.lt_pow_of_log_lt /-
theorem lt_pow_of_log_lt {b x y : ℕ} (hb : 1 < b) : log b y < x → y < b ^ x :=
  lt_imp_lt_of_le_imp_le (le_log_of_pow_le hb)
#align nat.lt_pow_of_log_lt Nat.lt_pow_of_log_lt
-/

#print Nat.lt_pow_succ_log_self /-
theorem lt_pow_succ_log_self {b : ℕ} (hb : 1 < b) (x : ℕ) : x < b ^ (log b x).succ :=
  lt_pow_of_log_lt hb (lt_succ_self _)
#align nat.lt_pow_succ_log_self Nat.lt_pow_succ_log_self
-/

#print Nat.log_eq_iff /-
theorem log_eq_iff {b m n : ℕ} (h : m ≠ 0 ∨ 1 < b ∧ n ≠ 0) :
    log b n = m ↔ b ^ m ≤ n ∧ n < b ^ (m + 1) :=
  by
  rcases em (1 < b ∧ n ≠ 0) with (⟨hb, hn⟩ | hbn)
  ·
    rw [le_antisymm_iff, ← lt_succ_iff, ← pow_le_iff_le_log, ← lt_pow_iff_log_lt, and_comm] <;>
      assumption
  · have hm : m ≠ 0 := h.resolve_right hbn
    rw [not_and_or, not_lt, Ne.def, Classical.not_not] at hbn
    rcases hbn with (hb | rfl)
    ·
      simpa only [log_of_left_le_one hb, hm.symm, false_iff_iff, not_and, not_lt] using
        le_trans (pow_le_pow_of_le_one' hb m.le_succ)
    ·
      simpa only [log_zero_right, hm.symm, false_iff_iff, not_and, not_lt, le_zero_iff,
        pow_succ] using mul_eq_zero_of_right _
#align nat.log_eq_iff Nat.log_eq_iff
-/

#print Nat.log_eq_of_pow_le_of_lt_pow /-
theorem log_eq_of_pow_le_of_lt_pow {b m n : ℕ} (h₁ : b ^ m ≤ n) (h₂ : n < b ^ (m + 1)) :
    log b n = m := by
  rcases eq_or_ne m 0 with (rfl | hm)
  · rw [pow_one] at h₂
    exact log_of_lt h₂
  · exact (log_eq_iff (Or.inl hm)).2 ⟨h₁, h₂⟩
#align nat.log_eq_of_pow_le_of_lt_pow Nat.log_eq_of_pow_le_of_lt_pow
-/

#print Nat.log_pow /-
theorem log_pow {b : ℕ} (hb : 1 < b) (x : ℕ) : log b (b ^ x) = x :=
  log_eq_of_pow_le_of_lt_pow le_rfl (pow_lt_pow hb x.lt_succ_self)
#align nat.log_pow Nat.log_pow
-/

#print Nat.log_eq_one_iff' /-
theorem log_eq_one_iff' {b n : ℕ} : log b n = 1 ↔ b ≤ n ∧ n < b * b := by
  rw [log_eq_iff (Or.inl one_ne_zero), pow_add, pow_one]
#align nat.log_eq_one_iff' Nat.log_eq_one_iff'
-/

#print Nat.log_eq_one_iff /-
theorem log_eq_one_iff {b n : ℕ} : log b n = 1 ↔ n < b * b ∧ 1 < b ∧ b ≤ n :=
  log_eq_one_iff'.trans
    ⟨fun h => ⟨h.2, lt_mul_self_iff.1 (h.1.trans_lt h.2), h.1⟩, fun h => ⟨h.2.2, h.1⟩⟩
#align nat.log_eq_one_iff Nat.log_eq_one_iff
-/

#print Nat.log_mul_base /-
theorem log_mul_base {b n : ℕ} (hb : 1 < b) (hn : n ≠ 0) : log b (n * b) = log b n + 1 :=
  by
  apply log_eq_of_pow_le_of_lt_pow <;> rw [pow_succ']
  exacts[mul_le_mul_right' (pow_log_le_self _ hn) _,
    (mul_lt_mul_right (zero_lt_one.trans hb)).2 (lt_pow_succ_log_self hb _)]
#align nat.log_mul_base Nat.log_mul_base
-/

#print Nat.pow_log_le_add_one /-
theorem pow_log_le_add_one (b : ℕ) : ∀ x, b ^ log b x ≤ x + 1
  | 0 => by rw [log_zero_right, pow_zero]
  | x + 1 => (pow_log_le_self b x.succ_ne_zero).trans (x + 1).le_succ
#align nat.pow_log_le_add_one Nat.pow_log_le_add_one
-/

#print Nat.log_monotone /-
theorem log_monotone {b : ℕ} : Monotone (log b) :=
  by
  refine' monotone_nat_of_le_succ fun n => _
  cases' le_or_lt b 1 with hb hb
  · rw [log_of_left_le_one hb]
    exact zero_le _
  · exact le_log_of_pow_le hb (pow_log_le_add_one _ _)
#align nat.log_monotone Nat.log_monotone
-/

#print Nat.log_mono_right /-
@[mono]
theorem log_mono_right {b n m : ℕ} (h : n ≤ m) : log b n ≤ log b m :=
  log_monotone h
#align nat.log_mono_right Nat.log_mono_right
-/

#print Nat.log_anti_left /-
@[mono]
theorem log_anti_left {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : log b n ≤ log c n :=
  by
  rcases eq_or_ne n 0 with (rfl | hn); · rw [log_zero_right, log_zero_right]
  apply le_log_of_pow_le hc
  calc
    c ^ log b n ≤ b ^ log b n := pow_le_pow_of_le_left' hb _
    _ ≤ n := pow_log_le_self _ hn

#align nat.log_anti_left Nat.log_anti_left
-/

#print Nat.log_antitone_left /-
theorem log_antitone_left {n : ℕ} : AntitoneOn (fun b => log b n) (Set.Ioi 1) := fun _ hc _ _ hb =>
  log_anti_left (Set.mem_Iio.1 hc) hb
#align nat.log_antitone_left Nat.log_antitone_left
-/

#print Nat.log_div_base /-
@[simp]
theorem log_div_base (b n : ℕ) : log b (n / b) = log b n - 1 :=
  by
  cases' le_or_lt b 1 with hb hb
  · rw [log_of_left_le_one hb, log_of_left_le_one hb, Nat.zero_sub]
  cases' lt_or_le n b with h h
  · rw [div_eq_of_lt h, log_of_lt h, log_zero_right]
  rw [log_of_one_lt_of_le hb h, add_tsub_cancel_right]
#align nat.log_div_base Nat.log_div_base
-/

#print Nat.log_div_mul_self /-
@[simp]
theorem log_div_mul_self (b n : ℕ) : log b (n / b * b) = log b n :=
  by
  cases' le_or_lt b 1 with hb hb
  · rw [log_of_left_le_one hb, log_of_left_le_one hb]
  cases' lt_or_le n b with h h
  · rw [div_eq_of_lt h, MulZeroClass.zero_mul, log_zero_right, log_of_lt h]
  rw [log_mul_base hb (Nat.div_pos h (zero_le_one.trans_lt hb)).ne', log_div_base,
    tsub_add_cancel_of_le (succ_le_iff.2 <| log_pos hb h)]
#align nat.log_div_mul_self Nat.log_div_mul_self
-/

private theorem add_pred_div_lt {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : (n + b - 1) / b < n :=
  by
  rw [div_lt_iff_lt_mul (zero_lt_one.trans hb), ← succ_le_iff, ← pred_eq_sub_one,
    succ_pred_eq_of_pos (add_pos (zero_lt_one.trans hn) (zero_lt_one.trans hb))]
  exact add_le_mul hn hb
#align nat.add_pred_div_lt nat.add_pred_div_lt

/-! ### Ceil logarithm -/

#print Nat.clog /-
/-- `clog b n`, is the upper logarithm of natural number `n` in base `b`. It returns the smallest
`k : ℕ` such that `n ≤ b^k`, so if `b^k = n`, it returns exactly `k`. -/
@[pp_nodot]
def clog (b : ℕ) : ℕ → ℕ
  | n =>
    if h : 1 < b ∧ 1 < n then
      have : (n + b - 1) / b < n := add_pred_div_lt h.1 h.2
      clog ((n + b - 1) / b) + 1
    else 0
#align nat.clog Nat.clog
-/

#print Nat.clog_of_left_le_one /-
theorem clog_of_left_le_one {b : ℕ} (hb : b ≤ 1) (n : ℕ) : clog b n = 0 := by
  rw [clog, if_neg fun h : 1 < b ∧ 1 < n => h.1.not_le hb]
#align nat.clog_of_left_le_one Nat.clog_of_left_le_one
-/

#print Nat.clog_of_right_le_one /-
theorem clog_of_right_le_one {n : ℕ} (hn : n ≤ 1) (b : ℕ) : clog b n = 0 := by
  rw [clog, if_neg fun h : 1 < b ∧ 1 < n => h.2.not_le hn]
#align nat.clog_of_right_le_one Nat.clog_of_right_le_one
-/

#print Nat.clog_zero_left /-
@[simp]
theorem clog_zero_left (n : ℕ) : clog 0 n = 0 :=
  clog_of_left_le_one zero_le_one _
#align nat.clog_zero_left Nat.clog_zero_left
-/

#print Nat.clog_zero_right /-
@[simp]
theorem clog_zero_right (b : ℕ) : clog b 0 = 0 :=
  clog_of_right_le_one zero_le_one _
#align nat.clog_zero_right Nat.clog_zero_right
-/

#print Nat.clog_one_left /-
@[simp]
theorem clog_one_left (n : ℕ) : clog 1 n = 0 :=
  clog_of_left_le_one le_rfl _
#align nat.clog_one_left Nat.clog_one_left
-/

#print Nat.clog_one_right /-
@[simp]
theorem clog_one_right (b : ℕ) : clog b 1 = 0 :=
  clog_of_right_le_one le_rfl _
#align nat.clog_one_right Nat.clog_one_right
-/

#print Nat.clog_of_two_le /-
theorem clog_of_two_le {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) :
    clog b n = clog b ((n + b - 1) / b) + 1 := by rw [clog, if_pos (⟨hb, hn⟩ : 1 < b ∧ 1 < n)]
#align nat.clog_of_two_le Nat.clog_of_two_le
-/

#print Nat.clog_pos /-
theorem clog_pos {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : 0 < clog b n :=
  by
  rw [clog_of_two_le hb hn]
  exact zero_lt_succ _
#align nat.clog_pos Nat.clog_pos
-/

#print Nat.clog_eq_one /-
theorem clog_eq_one {b n : ℕ} (hn : 2 ≤ n) (h : n ≤ b) : clog b n = 1 :=
  by
  rw [clog_of_two_le (hn.trans h) hn, clog_of_right_le_one]
  have n_pos : 0 < n := zero_lt_two.trans_le hn
  rw [← lt_succ_iff, Nat.div_lt_iff_lt_mul (n_pos.trans_le h), ← succ_le_iff, ← pred_eq_sub_one,
    succ_pred_eq_of_pos (add_pos n_pos (n_pos.trans_le h)), succ_mul, one_mul]
  exact add_le_add_right h _
#align nat.clog_eq_one Nat.clog_eq_one
-/

#print Nat.le_pow_iff_clog_le /-
/-- `clog b` and `pow b` form a Galois connection. -/
theorem le_pow_iff_clog_le {b : ℕ} (hb : 1 < b) {x y : ℕ} : x ≤ b ^ y ↔ clog b x ≤ y :=
  by
  induction' x using Nat.strong_induction_on with x ih generalizing y
  cases y
  · rw [pow_zero]
    refine' ⟨fun h => (clog_of_right_le_one h b).le, _⟩
    simp_rw [← not_lt]
    contrapose!
    exact clog_pos hb
  have b_pos : 0 < b := zero_lt_two.trans_le hb
  rw [clog]; split_ifs
  ·
    rw [succ_eq_add_one, add_le_add_iff_right, ← ih ((x + b - 1) / b) (add_pred_div_lt hb h.2),
      Nat.div_le_iff_le_mul_add_pred b_pos, ← pow_succ,
      add_tsub_assoc_of_le (Nat.succ_le_of_lt b_pos), add_le_add_iff_right]
  ·
    exact
      iff_of_true ((not_lt.1 (not_and.1 h hb)).trans <| succ_le_of_lt <| pow_pos b_pos _)
        (zero_le _)
#align nat.le_pow_iff_clog_le Nat.le_pow_iff_clog_le
-/

#print Nat.pow_lt_iff_lt_clog /-
theorem pow_lt_iff_lt_clog {b : ℕ} (hb : 1 < b) {x y : ℕ} : b ^ y < x ↔ y < clog b x :=
  lt_iff_lt_of_le_iff_le (le_pow_iff_clog_le hb)
#align nat.pow_lt_iff_lt_clog Nat.pow_lt_iff_lt_clog
-/

#print Nat.clog_pow /-
theorem clog_pow (b x : ℕ) (hb : 1 < b) : clog b (b ^ x) = x :=
  eq_of_forall_ge_iff fun z => by
    rw [← le_pow_iff_clog_le hb]
    exact (pow_right_strict_mono hb).le_iff_le
#align nat.clog_pow Nat.clog_pow
-/

#print Nat.pow_pred_clog_lt_self /-
theorem pow_pred_clog_lt_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 1 < x) : b ^ (clog b x).pred < x :=
  by
  rw [← not_le, le_pow_iff_clog_le hb, not_le]
  exact pred_lt (clog_pos hb hx).ne'
#align nat.pow_pred_clog_lt_self Nat.pow_pred_clog_lt_self
-/

#print Nat.le_pow_clog /-
theorem le_pow_clog {b : ℕ} (hb : 1 < b) (x : ℕ) : x ≤ b ^ clog b x :=
  (le_pow_iff_clog_le hb).2 le_rfl
#align nat.le_pow_clog Nat.le_pow_clog
-/

#print Nat.clog_mono_right /-
@[mono]
theorem clog_mono_right (b : ℕ) {n m : ℕ} (h : n ≤ m) : clog b n ≤ clog b m :=
  by
  cases' le_or_lt b 1 with hb hb
  · rw [clog_of_left_le_one hb]
    exact zero_le _
  · rw [← le_pow_iff_clog_le hb]
    exact h.trans (le_pow_clog hb _)
#align nat.clog_mono_right Nat.clog_mono_right
-/

#print Nat.clog_anti_left /-
@[mono]
theorem clog_anti_left {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : clog b n ≤ clog c n :=
  by
  rw [← le_pow_iff_clog_le (lt_of_lt_of_le hc hb)]
  calc
    n ≤ c ^ clog c n := le_pow_clog hc _
    _ ≤ b ^ clog c n := pow_le_pow_of_le_left (zero_lt_one.trans hc).le hb _

#align nat.clog_anti_left Nat.clog_anti_left
-/

#print Nat.clog_monotone /-
theorem clog_monotone (b : ℕ) : Monotone (clog b) := fun x y => clog_mono_right _
#align nat.clog_monotone Nat.clog_monotone
-/

#print Nat.clog_antitone_left /-
theorem clog_antitone_left {n : ℕ} : AntitoneOn (fun b : ℕ => clog b n) (Set.Ioi 1) :=
  fun _ hc _ _ hb => clog_anti_left (Set.mem_Iio.1 hc) hb
#align nat.clog_antitone_left Nat.clog_antitone_left
-/

#print Nat.log_le_clog /-
theorem log_le_clog (b n : ℕ) : log b n ≤ clog b n :=
  by
  obtain hb | hb := le_or_lt b 1
  · rw [log_of_left_le_one hb]
    exact zero_le _
  cases n
  · rw [log_zero_right]
    exact zero_le _
  exact
    (pow_right_strict_mono hb).le_iff_le.1
      ((pow_log_le_self b n.succ_ne_zero).trans <| le_pow_clog hb _)
#align nat.log_le_clog Nat.log_le_clog
-/

end Nat


-- Propiedad_semidistributiva_de_la_interseccion_sobre_la_union_2.lean
-- 2ª propiedad semidistributiva de la intersección sobre la unión
-- José A. Alonso Jiménez
-- Sevilla, 20 de mayo de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    (s ∩ t) ∪ (s ∩ u) ⊆ s ∩ (t ∪ u)
-- ----------------------------------------------------------------------

import data.set.basic
open set

variable {α : Type}
variables s t u : set α

-- 1ª demostración
-- ===============

example : (s ∩ t) ∪ (s ∩ u) ⊆ s ∩ (t ∪ u):=
begin
  intros x hx,
  cases hx with xst xsu,
  { split,
    { exact xst.1 },
    { left,
      exact xst.2 }},
  { split,
    { exact xsu.1 },
    { right,
      exact xsu.2 }},
end

-- 2ª demostración
-- ===============

example : (s ∩ t) ∪ (s ∩ u) ⊆ s ∩ (t ∪ u):=
begin
  rintros x (⟨xs, xt⟩ | ⟨xs, xu⟩),
  { use xs,
    left,
    exact xt },
  { use xs,
    right,
    exact xu },
end

-- 3ª demostración
-- ===============

example : (s ∩ t) ∪ (s ∩ u) ⊆ s ∩ (t ∪ u):=
by rw inter_distrib_left s t u

-- 4ª demostración
-- ===============

example : (s ∩ t) ∪ (s ∩ u) ⊆ s ∩ (t ∪ u):=
begin
  intros x hx,
  finish
end


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

! This file was ported from Lean 3 source module analysis.special_functions.log.basic
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Exp
import Mathbin.Data.Nat.Factorization.Basic

/-!
# Real logarithm

In this file we define `real.log` to be the logarithm of a real number. As usual, we extend it from
its domain `(0, +∞)` to a globally defined function. We choose to do it so that `log 0 = 0` and
`log (-x) = log x`.

We prove some basic properties of this function and show that it is continuous.

## Tags

logarithm, continuity
-/

open Set Filter Function

open Topology

noncomputable section

namespace Real

variable {x y : ℝ}

/-- The real logarithm function, equal to the inverse of the exponential for `x > 0`,
to `log |x|` for `x < 0`, and to `0` for `0`. We use this unconventional extension to
`(-∞, 0]` as it gives the formula `log (x * y) = log x + log y` for all nonzero `x` and `y`, and
the derivative of `log` is `1/x` away from `0`. -/
@[pp_nodot]
noncomputable def log (x : ℝ) : ℝ :=
  if hx : x = 0 then 0 else expOrderIso.symm ⟨|x|, abs_pos.2 hx⟩
#align real.log Real.log

theorem log_of_ne_zero (hx : x ≠ 0) : log x = expOrderIso.symm ⟨|x|, abs_pos.2 hx⟩ :=
  dif_neg hx
#align real.log_of_ne_zero Real.log_of_ne_zero

theorem log_of_pos (hx : 0 < x) : log x = expOrderIso.symm ⟨x, hx⟩ :=
  by
  rw [log_of_ne_zero hx.ne']
  congr
  exact abs_of_pos hx
#align real.log_of_pos Real.log_of_pos

theorem exp_log_eq_abs (hx : x ≠ 0) : exp (log x) = |x| := by
  rw [log_of_ne_zero hx, ← coe_exp_order_iso_apply, OrderIso.apply_symm_apply, Subtype.coe_mk]
#align real.exp_log_eq_abs Real.exp_log_eq_abs

theorem exp_log (hx : 0 < x) : exp (log x) = x :=
  by
  rw [exp_log_eq_abs hx.ne']
  exact abs_of_pos hx
#align real.exp_log Real.exp_log

theorem exp_log_of_neg (hx : x < 0) : exp (log x) = -x :=
  by
  rw [exp_log_eq_abs (ne_of_lt hx)]
  exact abs_of_neg hx
#align real.exp_log_of_neg Real.exp_log_of_neg

theorem le_exp_log (x : ℝ) : x ≤ exp (log x) :=
  by
  by_cases h_zero : x = 0
  · rw [h_zero, log, dif_pos rfl, exp_zero]
    exact zero_le_one
  · rw [exp_log_eq_abs h_zero]
    exact le_abs_self _
#align real.le_exp_log Real.le_exp_log

@[simp]
theorem log_exp (x : ℝ) : log (exp x) = x :=
  exp_injective <| exp_log (exp_pos x)
#align real.log_exp Real.log_exp

theorem surjOn_log : SurjOn log (Ioi 0) univ := fun x _ => ⟨exp x, exp_pos x, log_exp x⟩
#align real.surj_on_log Real.surjOn_log

theorem log_surjective : Surjective log := fun x => ⟨exp x, log_exp x⟩
#align real.log_surjective Real.log_surjective

@[simp]
theorem range_log : range log = univ :=
  log_surjective.range_eq
#align real.range_log Real.range_log

@[simp]
theorem log_zero : log 0 = 0 :=
  dif_pos rfl
#align real.log_zero Real.log_zero

@[simp]
theorem log_one : log 1 = 0 :=
  exp_injective <| by rw [exp_log zero_lt_one, exp_zero]
#align real.log_one Real.log_one

@[simp]
theorem log_abs (x : ℝ) : log (|x|) = log x :=
  by
  by_cases h : x = 0
  · simp [h]
  · rw [← exp_eq_exp, exp_log_eq_abs h, exp_log_eq_abs (abs_pos.2 h).ne', abs_abs]
#align real.log_abs Real.log_abs

@[simp]
theorem log_neg_eq_log (x : ℝ) : log (-x) = log x := by rw [← log_abs x, ← log_abs (-x), abs_neg]
#align real.log_neg_eq_log Real.log_neg_eq_log

theorem sinh_log {x : ℝ} (hx : 0 < x) : sinh (log x) = (x - x⁻¹) / 2 := by
  rw [sinh_eq, exp_neg, exp_log hx]
#align real.sinh_log Real.sinh_log

theorem cosh_log {x : ℝ} (hx : 0 < x) : cosh (log x) = (x + x⁻¹) / 2 := by
  rw [cosh_eq, exp_neg, exp_log hx]
#align real.cosh_log Real.cosh_log

theorem surjOn_log' : SurjOn log (Iio 0) univ := fun x _ =>
  ⟨-exp x, neg_lt_zero.2 <| exp_pos x, by rw [log_neg_eq_log, log_exp]⟩
#align real.surj_on_log' Real.surjOn_log'

theorem log_mul (hx : x ≠ 0) (hy : y ≠ 0) : log (x * y) = log x + log y :=
  exp_injective <| by
    rw [exp_log_eq_abs (mul_ne_zero hx hy), exp_add, exp_log_eq_abs hx, exp_log_eq_abs hy, abs_mul]
#align real.log_mul Real.log_mul

theorem log_div (hx : x ≠ 0) (hy : y ≠ 0) : log (x / y) = log x - log y :=
  exp_injective <| by
    rw [exp_log_eq_abs (div_ne_zero hx hy), exp_sub, exp_log_eq_abs hx, exp_log_eq_abs hy, abs_div]
#align real.log_div Real.log_div

@[simp]
theorem log_inv (x : ℝ) : log x⁻¹ = -log x :=
  by
  by_cases hx : x = 0; · simp [hx]
  rw [← exp_eq_exp, exp_log_eq_abs (inv_ne_zero hx), exp_neg, exp_log_eq_abs hx, abs_inv]
#align real.log_inv Real.log_inv

theorem log_le_log (h : 0 < x) (h₁ : 0 < y) : log x ≤ log y ↔ x ≤ y := by
  rw [← exp_le_exp, exp_log h, exp_log h₁]
#align real.log_le_log Real.log_le_log

theorem log_lt_log (hx : 0 < x) : x < y → log x < log y :=
  by
  intro h
  rwa [← exp_lt_exp, exp_log hx, exp_log (lt_trans hx h)]
#align real.log_lt_log Real.log_lt_log

theorem log_lt_log_iff (hx : 0 < x) (hy : 0 < y) : log x < log y ↔ x < y := by
  rw [← exp_lt_exp, exp_log hx, exp_log hy]
#align real.log_lt_log_iff Real.log_lt_log_iff

theorem log_le_iff_le_exp (hx : 0 < x) : log x ≤ y ↔ x ≤ exp y := by rw [← exp_le_exp, exp_log hx]
#align real.log_le_iff_le_exp Real.log_le_iff_le_exp

theorem log_lt_iff_lt_exp (hx : 0 < x) : log x < y ↔ x < exp y := by rw [← exp_lt_exp, exp_log hx]
#align real.log_lt_iff_lt_exp Real.log_lt_iff_lt_exp

theorem le_log_iff_exp_le (hy : 0 < y) : x ≤ log y ↔ exp x ≤ y := by rw [← exp_le_exp, exp_log hy]
#align real.le_log_iff_exp_le Real.le_log_iff_exp_le

theorem lt_log_iff_exp_lt (hy : 0 < y) : x < log y ↔ exp x < y := by rw [← exp_lt_exp, exp_log hy]
#align real.lt_log_iff_exp_lt Real.lt_log_iff_exp_lt

theorem log_pos_iff (hx : 0 < x) : 0 < log x ↔ 1 < x :=
  by
  rw [← log_one]
  exact log_lt_log_iff zero_lt_one hx
#align real.log_pos_iff Real.log_pos_iff

theorem log_pos (hx : 1 < x) : 0 < log x :=
  (log_pos_iff (lt_trans zero_lt_one hx)).2 hx
#align real.log_pos Real.log_pos

theorem log_neg_iff (h : 0 < x) : log x < 0 ↔ x < 1 :=
  by
  rw [← log_one]
  exact log_lt_log_iff h zero_lt_one
#align real.log_neg_iff Real.log_neg_iff

theorem log_neg (h0 : 0 < x) (h1 : x < 1) : log x < 0 :=
  (log_neg_iff h0).2 h1
#align real.log_neg Real.log_neg

theorem log_nonneg_iff (hx : 0 < x) : 0 ≤ log x ↔ 1 ≤ x := by rw [← not_lt, log_neg_iff hx, not_lt]
#align real.log_nonneg_iff Real.log_nonneg_iff

theorem log_nonneg (hx : 1 ≤ x) : 0 ≤ log x :=
  (log_nonneg_iff (zero_lt_one.trans_le hx)).2 hx
#align real.log_nonneg Real.log_nonneg

theorem log_nonpos_iff (hx : 0 < x) : log x ≤ 0 ↔ x ≤ 1 := by rw [← not_lt, log_pos_iff hx, not_lt]
#align real.log_nonpos_iff Real.log_nonpos_iff

theorem log_nonpos_iff' (hx : 0 ≤ x) : log x ≤ 0 ↔ x ≤ 1 :=
  by
  rcases hx.eq_or_lt with (rfl | hx)
  · simp [le_refl, zero_le_one]
  exact log_nonpos_iff hx
#align real.log_nonpos_iff' Real.log_nonpos_iff'

theorem log_nonpos (hx : 0 ≤ x) (h'x : x ≤ 1) : log x ≤ 0 :=
  (log_nonpos_iff' hx).2 h'x
#align real.log_nonpos Real.log_nonpos

theorem strictMonoOn_log : StrictMonoOn log (Set.Ioi 0) := fun x hx y hy hxy => log_lt_log hx hxy
#align real.strict_mono_on_log Real.strictMonoOn_log

theorem strictAntiOn_log : StrictAntiOn log (Set.Iio 0) :=
  by
  rintro x (hx : x < 0) y (hy : y < 0) hxy
  rw [← log_abs y, ← log_abs x]
  refine' log_lt_log (abs_pos.2 hy.ne) _
  rwa [abs_of_neg hy, abs_of_neg hx, neg_lt_neg_iff]
#align real.strict_anti_on_log Real.strictAntiOn_log

theorem log_injOn_pos : Set.InjOn log (Set.Ioi 0) :=
  strictMonoOn_log.InjOn
#align real.log_inj_on_pos Real.log_injOn_pos

theorem eq_one_of_pos_of_log_eq_zero {x : ℝ} (h₁ : 0 < x) (h₂ : log x = 0) : x = 1 :=
  log_injOn_pos (Set.mem_Ioi.2 h₁) (Set.mem_Ioi.2 zero_lt_one) (h₂.trans Real.log_one.symm)
#align real.eq_one_of_pos_of_log_eq_zero Real.eq_one_of_pos_of_log_eq_zero

theorem log_ne_zero_of_pos_of_ne_one {x : ℝ} (hx_pos : 0 < x) (hx : x ≠ 1) : log x ≠ 0 :=
  mt (eq_one_of_pos_of_log_eq_zero hx_pos) hx
#align real.log_ne_zero_of_pos_of_ne_one Real.log_ne_zero_of_pos_of_ne_one

@[simp]
theorem log_eq_zero {x : ℝ} : log x = 0 ↔ x = 0 ∨ x = 1 ∨ x = -1 :=
  by
  constructor
  · intro h
    rcases lt_trichotomy x 0 with (x_lt_zero | rfl | x_gt_zero)
    · refine' Or.inr (Or.inr (neg_eq_iff_eq_neg.mp _))
      rw [← log_neg_eq_log x] at h
      exact eq_one_of_pos_of_log_eq_zero (neg_pos.mpr x_lt_zero) h
    · exact Or.inl rfl
    · exact Or.inr (Or.inl (eq_one_of_pos_of_log_eq_zero x_gt_zero h))
  · rintro (rfl | rfl | rfl) <;> simp only [log_one, log_zero, log_neg_eq_log]
#align real.log_eq_zero Real.log_eq_zero

@[simp]
theorem log_pow (x : ℝ) (n : ℕ) : log (x ^ n) = n * log x :=
  by
  induction' n with n ih
  · simp
  rcases eq_or_ne x 0 with (rfl | hx)
  · simp
  rw [pow_succ', log_mul (pow_ne_zero _ hx) hx, ih, Nat.cast_succ, add_mul, one_mul]
#align real.log_pow Real.log_pow

@[simp]
theorem log_zpow (x : ℝ) (n : ℤ) : log (x ^ n) = n * log x :=
  by
  induction n
  · rw [Int.ofNat_eq_coe, zpow_ofNat, log_pow, Int.cast_ofNat]
  rw [zpow_negSucc, log_inv, log_pow, Int.cast_negSucc, Nat.cast_add_one, neg_mul_eq_neg_mul]
#align real.log_zpow Real.log_zpow

theorem log_sqrt {x : ℝ} (hx : 0 ≤ x) : log (sqrt x) = log x / 2 :=
  by
  rw [eq_div_iff, mul_comm, ← Nat.cast_two, ← log_pow, sq_sqrt hx]
  exact two_ne_zero
#align real.log_sqrt Real.log_sqrt

theorem log_le_sub_one_of_pos {x : ℝ} (hx : 0 < x) : log x ≤ x - 1 :=
  by
  rw [le_sub_iff_add_le]
  convert add_one_le_exp (log x)
  rw [exp_log hx]
#align real.log_le_sub_one_of_pos Real.log_le_sub_one_of_pos

/-- Bound for `|log x * x|` in the interval `(0, 1]`. -/
theorem abs_log_mul_self_lt (x : ℝ) (h1 : 0 < x) (h2 : x ≤ 1) : |log x * x| < 1 :=
  by
  have : 0 < 1 / x := by simpa only [one_div, inv_pos] using h1
  replace := log_le_sub_one_of_pos this
  replace : log (1 / x) < 1 / x := by linarith
  rw [log_div one_ne_zero h1.ne', log_one, zero_sub, lt_div_iff h1] at this
  have aux : 0 ≤ -log x * x := by
    refine' mul_nonneg _ h1.le
    rw [← log_inv]
    apply log_nonneg
    rw [← le_inv h1 zero_lt_one, inv_one]
    exact h2
  rw [← abs_of_nonneg aux, neg_mul, abs_neg] at this
  exact this
#align real.abs_log_mul_self_lt Real.abs_log_mul_self_lt

/-- The real logarithm function tends to `+∞` at `+∞`. -/
theorem tendsto_log_atTop : Tendsto log atTop atTop :=
  tendsto_comp_exp_atTop.1 <| by simpa only [log_exp] using tendsto_id
#align real.tendsto_log_at_top Real.tendsto_log_atTop

theorem tendsto_log_nhdsWithin_zero : Tendsto log (𝓝[≠] 0) atBot :=
  by
  rw [← show _ = log from funext log_abs]
  refine' tendsto.comp _ tendsto_abs_nhdsWithin_zero
  simpa [← tendsto_comp_exp_at_bot] using tendsto_id
#align real.tendsto_log_nhds_within_zero Real.tendsto_log_nhdsWithin_zero

theorem continuousOn_log : ContinuousOn log ({0}ᶜ) :=
  by
  rw [continuousOn_iff_continuous_restrict, restrict]
  conv in log _ => rw [log_of_ne_zero (show (x : ℝ) ≠ 0 from x.2)]
  exact exp_order_iso.symm.continuous.comp (continuous_subtype_coe.norm.subtype_mk _)
#align real.continuous_on_log Real.continuousOn_log

@[continuity]
theorem continuous_log : Continuous fun x : { x : ℝ // x ≠ 0 } => log x :=
  continuousOn_iff_continuous_restrict.1 <| continuousOn_log.mono fun x hx => hx
#align real.continuous_log Real.continuous_log

@[continuity]
theorem continuous_log' : Continuous fun x : { x : ℝ // 0 < x } => log x :=
  continuousOn_iff_continuous_restrict.1 <| continuousOn_log.mono fun x hx => ne_of_gt hx
#align real.continuous_log' Real.continuous_log'

theorem continuousAt_log (hx : x ≠ 0) : ContinuousAt log x :=
  (continuousOn_log x hx).ContinuousAt <| IsOpen.mem_nhds isOpen_compl_singleton hx
#align real.continuous_at_log Real.continuousAt_log

@[simp]
theorem continuousAt_log_iff : ContinuousAt log x ↔ x ≠ 0 :=
  by
  refine' ⟨_, continuous_at_log⟩
  rintro h rfl
  exact
    not_tendsto_nhds_of_tendsto_atBot tendsto_log_nhds_within_zero _
      (h.tendsto.mono_left inf_le_left)
#align real.continuous_at_log_iff Real.continuousAt_log_iff

open BigOperators

theorem log_prod {α : Type _} (s : Finset α) (f : α → ℝ) (hf : ∀ x ∈ s, f x ≠ 0) :
    log (∏ i in s, f i) = ∑ i in s, log (f i) :=
  by
  induction' s using Finset.cons_induction_on with a s ha ih
  · simp
  · rw [Finset.forall_mem_cons] at hf
    simp [ih hf.2, log_mul hf.1 (Finset.prod_ne_zero_iff.2 hf.2)]
#align real.log_prod Real.log_prod

theorem log_nat_eq_sum_factorization (n : ℕ) : log n = n.factorization.Sum fun p t => t * log p :=
  by
  rcases eq_or_ne n 0 with (rfl | hn)
  · simp
  nth_rw 1 [← Nat.factorization_prod_pow_eq_self hn]
  rw [Finsupp.prod, Nat.cast_prod, log_prod _ _ fun p hp => _, Finsupp.sum]
  · simp_rw [Nat.cast_pow, log_pow]
  · norm_cast
    exact pow_ne_zero _ (Nat.prime_of_mem_factorization hp).NeZero
#align real.log_nat_eq_sum_factorization Real.log_nat_eq_sum_factorization

theorem tendsto_pow_log_div_mul_add_atTop (a b : ℝ) (n : ℕ) (ha : a ≠ 0) :
    Tendsto (fun x => log x ^ n / (a * x + b)) atTop (𝓝 0) :=
  ((tendsto_div_pow_mul_exp_add_atTop a b n ha.symm).comp tendsto_log_atTop).congr'
    (by filter_upwards [eventually_gt_at_top (0 : ℝ)]with x hx using by simp [exp_log hx])
#align real.tendsto_pow_log_div_mul_add_at_top Real.tendsto_pow_log_div_mul_add_atTop

theorem isOCat_pow_log_id_atTop {n : ℕ} : (fun x => log x ^ n) =o[atTop] id :=
  by
  rw [Asymptotics.isOCat_iff_tendsto']
  · simpa using tendsto_pow_log_div_mul_add_at_top 1 0 n one_ne_zero
  filter_upwards [eventually_ne_at_top (0 : ℝ)]with x h₁ h₂ using(h₁ h₂).elim
#align real.is_o_pow_log_id_at_top Real.isOCat_pow_log_id_atTop

theorem isOCat_log_id_atTop : log =o[atTop] id :=
  isOCat_pow_log_id_atTop.congr_left fun x => pow_one _
#align real.is_o_log_id_at_top Real.isOCat_log_id_atTop

end Real

section Continuity

open Real

variable {α : Type _}

theorem Filter.Tendsto.log {f : α → ℝ} {l : Filter α} {x : ℝ} (h : Tendsto f l (𝓝 x)) (hx : x ≠ 0) :
    Tendsto (fun x => log (f x)) l (𝓝 (log x)) :=
  (continuousAt_log hx).Tendsto.comp h
#align filter.tendsto.log Filter.Tendsto.log

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

theorem Continuous.log (hf : Continuous f) (h₀ : ∀ x, f x ≠ 0) : Continuous fun x => log (f x) :=
  continuousOn_log.comp_continuous hf h₀
#align continuous.log Continuous.log

theorem ContinuousAt.log (hf : ContinuousAt f a) (h₀ : f a ≠ 0) :
    ContinuousAt (fun x => log (f x)) a :=
  hf.log h₀
#align continuous_at.log ContinuousAt.log

theorem ContinuousWithinAt.log (hf : ContinuousWithinAt f s a) (h₀ : f a ≠ 0) :
    ContinuousWithinAt (fun x => log (f x)) s a :=
  hf.log h₀
#align continuous_within_at.log ContinuousWithinAt.log

theorem ContinuousOn.log (hf : ContinuousOn f s) (h₀ : ∀ x ∈ s, f x ≠ 0) :
    ContinuousOn (fun x => log (f x)) s := fun x hx => (hf x hx).log (h₀ x hx)
#align continuous_on.log ContinuousOn.log

end Continuity

section TendstoCompAddSub

open Filter

namespace Real

theorem tendsto_log_comp_add_sub_log (y : ℝ) :
    Tendsto (fun x : ℝ => log (x + y) - log x) atTop (𝓝 0) :=
  by
  refine' tendsto.congr' (_ : ∀ᶠ x : ℝ in at_top, log (1 + y / x) = _) _
  · refine'
      eventually.mp ((eventually_ne_at_top 0).And (eventually_gt_at_top (-y)))
        (eventually_of_forall fun x hx => _)
    rw [← log_div _ hx.1]
    · congr 1
      field_simp [hx.1]
    · linarith [hx.2]
  · suffices tendsto (fun x : ℝ => log (1 + y / x)) at_top (𝓝 (log (1 + 0))) by simpa
    refine' tendsto.log _ (by simp)
    exact tendsto_const_nhds.add (tendsto_const_nhds.div_at_top tendsto_id)
#align real.tendsto_log_comp_add_sub_log Real.tendsto_log_comp_add_sub_log

theorem tendsto_log_nat_add_one_sub_log : Tendsto (fun k : ℕ => log (k + 1) - log k) atTop (𝓝 0) :=
  (tendsto_log_comp_add_sub_log 1).comp tendsto_nat_cast_atTop_atTop
#align real.tendsto_log_nat_add_one_sub_log Real.tendsto_log_nat_add_one_sub_log

end Real

end TendstoCompAddSub


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl, Mario Carneiro

Cardinal arithmetic.

Cardinals are represented as quotient over equinumerous types.
-/

import data.set.finite data.quot logic.schroeder_bernstein logic.function

open function lattice set
local attribute [instance] classical.prop_decidable

universes u v w x

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 of a type -/
def mk : Type u → cardinal := quotient.mk

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

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

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_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.set.range f hf⟩⟩,
λ ⟨p, e⟩, e ▸ ⟨⟨subtype.val, λ a b, subtype.eq⟩⟩⟩

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 }

noncomputable instance : decidable_linear_order cardinal.{u} := classical.DLO _

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 : zero_ne_one_class cardinal.{u} :=
{ zero := 0, one := 1, zero_ne_one :=
  ne.symm $ ne_zero_iff_nonempty.2 ⟨punit.star⟩ }

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

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 (α β) : 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 α β γ⟩

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 γ β α⟩)

section order_properties
open sum

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

theorem le_zero (a : cardinal) : a ≤ 0 ↔ a = 0 :=
by simp [le_antisymm_iff, zero_le]

theorem pos_iff_ne_zero {o : cardinal} : 0 < o ↔ o ≠ 0 :=
by simp [lt_iff_le_and_ne, eq_comm, zero_le]

theorem zero_lt_one : (0 : cardinal) < 1 :=
lt_of_le_of_ne (zero_le _) zero_ne_one

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

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

theorem add_le_add_right {a b : cardinal} (c) (h : a ≤ b) : a + c ≤ b + c :=
add_le_add h (le_refl _)

theorem le_add_right (a b : cardinal) : a ≤ a + b :=
by simpa using add_le_add_left a (zero_le b)

theorem le_add_left (a b : cardinal) : a ≤ b + a :=
by simpa using add_le_add_right a (zero_le b)

theorem mul_le_mul : ∀{a b c d : cardinal}, a ≤ b → c ≤ d → a * c ≤ b * d :=
by rintros ⟨α⟩ ⟨β⟩ ⟨γ⟩ ⟨δ⟩ ⟨e₁⟩ ⟨e₂⟩; exact ⟨embedding.prod_congr e₁ e₂⟩

theorem mul_le_mul_left (a) {b c : cardinal} : b ≤ c → a * b ≤ a * c :=
mul_le_mul (le_refl _)

theorem mul_le_mul_right {a b : cardinal} (c) (h : a ≤ b) : a * c ≤ b * c :=
mul_le_mul h (le_refl _)

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_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⟩

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

end order_properties

instance : canonically_ordered_monoid cardinal.{u} :=
{ add_le_add_left       := λ a b h c, add_le_add_left _ h,
  lt_of_add_lt_add_left := λ a b c, le_imp_le_iff_lt_imp_lt.1 (add_le_add_left _),
  le_iff_exists_add     := @le_iff_exists_add,
  ..cardinal.comm_semiring, ..cardinal.linear_order }

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

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.injective_min _ (λ 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.injective_min _ (λ 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.inj, hn⟩⟩),
  cases classical.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.inj h },
    { exact nex.elim ⟨_, h⟩ },
    { exact nex.elim ⟨_, h.symm⟩ },
    { refl } }
end

/-- 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.sigma_congr_right $ λ 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 _)

/-- 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
  conv in (f _) {rw ← mk_out (f i)},
  simp [prod, ne_zero_iff_nonempty, -mk_out, -ne.def],
  exact ⟨λ ⟨F⟩ i, ⟨F i⟩, λ h, ⟨λ i, classical.choice (h i)⟩⟩,
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 -/
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 _)

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

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 _

@[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 *

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] theorem nat_cast_pow {m n : ℕ} : (↑(pow m n) : cardinal) = m ^ n :=
by induction n; simp [nat.pow_succ, -_root_.add_comm, power_add, *]

@[simp] theorem nat_cast_le {m n : ℕ} : (m : cardinal) ≤ n ↔ m ≤ n :=
by rw [← lift_mk_fin, ← lift_mk_fin, lift_le]; exact
⟨λ ⟨⟨f, hf⟩⟩, begin
  have : _ = fintype.card _ := finset.card_image_of_injective finset.univ hf,
  simp at this,
  rw [← fintype.card_fin n, ← this],
  exact finset.card_le_of_subset (finset.subset_univ _)
end,
λ h, ⟨⟨λ i, ⟨i.1, lt_of_lt_of_le i.2 h⟩, λ a b h,
  have _, from fin.veq_of_eq h, fin.eq_of_veq this⟩⟩⟩

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

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

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

@[simp] theorem succ_zero : succ 0 = 1 :=
by simpa using nat_succ 0

theorem cantor' (a) {b : cardinal} (hb : 1 < b) : a < b ^ a :=
by rw [← succ_le, (by simpa using nat_succ 1 : 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
⟨⟨fin.val, λ a b, fin.eq_of_veq⟩⟩

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
    classical.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

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

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

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

/-- 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,
  have : ∀ i, ¬ ∀ b, ∃ a, G ⟨i, a⟩ i = b,
  { refine λ i h, not_le_of_lt (H i) _,
    rw [← mk_out (f i), ← mk_out (g i)],
    exact ⟨embedding.of_surjective h⟩ },
  simp [classical.not_forall] at this,
  exact let ⟨C, hc⟩ := classical.axiom_of_choice this, ⟨⟨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_empty' (α : Type u) : mk (∅ : set α) = 0 :=
quotient.sound ⟨equiv.set.pempty α⟩

@[simp] theorem mk_plift_false : mk (plift false) = 0 :=
quotient.sound ⟨equiv.plift.trans $ equiv.false_equiv_pempty⟩

@[simp] 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_true : mk (plift true) = 1 :=
quotient.sound ⟨equiv.plift.trans equiv.true_equiv_punit⟩

@[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_option {α : Type u} : mk (option α) = mk α + 1 :=
quotient.sound ⟨equiv.option_equiv_sum_punit α⟩

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

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.equiv_sigma_subtype list.length⟩
... = 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_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) : show nonempty ((⋃ i, f i) ↪ (Σ i, f i)),
  from ⟨⟨λ x, ⟨classical.some (mem_Union.1 x.2), x.1, classical.some_spec (mem_Union.1 x.2)⟩,
  λ x y H, subtype.eq $ begin
    cases sigma.mk.inj H with H1 H2, clear H,
    generalize_hyp : classical.some_spec _ = H4 at H1 H2,
    generalize_hyp : classical.some _ = i₀ at H1 H2 H4,
    subst H1,
    exact subtype.mk.inj (eq_of_heq H2)
  end⟩⟩
... = sum (λ i, mk (f i)) : (sum_mk _).symm

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

theorem mk_union_add_mk_inter {α : Type u} {S T : set α} : mk (S ∪ T : set α) + mk (S ∩ T : set α) = mk S + mk T :=
quotient.sound $ nonempty.intro $
{ to_fun := λ x, sum.rec_on x
    (λ x, if h : x.1 ∈ S then sum.inl ⟨x.1, h⟩ else sum.inr ⟨x.1, x.2.resolve_left h⟩)
    (λ x, sum.inr ⟨x.1, x.2.2⟩),
  inv_fun := λ x, sum.rec_on x
    (λ x, sum.inl ⟨x.1, or.inl x.2⟩)
    (λ x, if h : x.1 ∈ S then sum.inr ⟨x.1, h, x.2⟩ else sum.inl ⟨x.1, or.inr x.2⟩),
  left_inv := λ x, sum.rec_on x
    (λ ⟨x, hx⟩, if h : x ∈ S
      then by dsimp only; rw [dif_pos h]; refl
      else by dsimp only; rw [dif_neg h]; dsimp only; rw [dif_neg h]; refl)
    (λ ⟨x, hx1, hx2⟩, by dsimp only; rw [dif_pos hx1]),
  right_inv := λ x, sum.rec_on x
    (λ ⟨x, hx⟩, by dsimp only; rw [dif_pos hx])
    (λ ⟨x, hx⟩, if h : x ∈ S
      then by dsimp only; rw [dif_pos h]
      else by dsimp only; rw [dif_neg h]; dsimp only; rw [dif_neg h]) }

theorem mk_union_of_disjiont {α : Type u} {S T : set α} (H : disjoint S T) : mk (S ∪ T : set α) = mk S + mk T :=
eq.trans (by simp only [(eq_empty_of_subset_empty H : S ∩ T = ∅), mk_empty', add_zero]) mk_union_add_mk_inter

end cardinal