/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov, Sébastien Gouëzel
-/
import measure_theory.constructions.borel_space

/-!
# Stieltjes measures on the real line

Consider a function `f : ℝ → ℝ` which is monotone and right-continuous. Then one can define a
corrresponding measure, giving mass `f b - f a` to the interval `(a, b]`.

## Main definitions

* `stieltjes_function` is a structure containing a function from `ℝ → ℝ`, together with the
assertions that it is monotone and right-continuous. To `f : stieltjes_function`, one associates
a Borel measure `f.measure`.
* `f.left_lim x` is the limit of `f` to the left of `x`.
* `f.measure_Ioc` asserts that `f.measure (Ioc a b) = of_real (f b - f a)`
* `f.measure_Ioo` asserts that `f.measure (Ioo a b) = of_real (f.left_lim b - f a)`.
* `f.measure_Icc` and `f.measure_Ico` are analogous.
-/

noncomputable theory
open classical set filter
open ennreal (of_real)
open_locale big_operators ennreal nnreal topological_space

/-! ### Basic properties of Stieltjes functions -/

/-- Bundled monotone right-continuous real functions, used to construct Stieltjes measures. -/
structure stieltjes_function :=
(to_fun : ℝ → ℝ)
(mono' : monotone to_fun)
(right_continuous' : ∀ x, continuous_within_at to_fun (Ici x) x)

namespace stieltjes_function

instance : has_coe_to_fun stieltjes_function (λ _, ℝ → ℝ) := ⟨to_fun⟩

initialize_simps_projections stieltjes_function (to_fun → apply)

variable (f : stieltjes_function)

lemma mono : monotone f := f.mono'

lemma right_continuous (x : ℝ) : continuous_within_at f (Ici x) x := f.right_continuous' x

/-- The limit of a Stieltjes function to the left of `x` (it exists by monotonicity). The fact that
it is indeed a left limit is asserted in `tendsto_left_lim` -/
@[irreducible] def left_lim (x : ℝ) := Sup (f '' (Iio x))

lemma tendsto_left_lim (x : ℝ) : tendsto f (𝓝[<] x) (𝓝 (f.left_lim x)) :=
by { rw left_lim, exact f.mono.tendsto_nhds_within_Iio x }

lemma left_lim_le {x y : ℝ} (h : x ≤ y) : f.left_lim x ≤ f y :=
begin
  apply le_of_tendsto (f.tendsto_left_lim x),
  filter_upwards [self_mem_nhds_within] with _ hz using (f.mono (le_of_lt hz)).trans (f.mono h),
end

lemma le_left_lim {x y : ℝ} (h : x < y) : f x ≤ f.left_lim y :=
begin
  apply ge_of_tendsto (f.tendsto_left_lim y),
  apply mem_nhds_within_Iio_iff_exists_Ioo_subset.2 ⟨x, h, _⟩,
  assume z hz,
  exact f.mono hz.1.le,
end

lemma left_lim_le_left_lim {x y : ℝ} (h : x ≤ y) : f.left_lim x ≤ f.left_lim y :=
begin
  rcases eq_or_lt_of_le h with rfl|hxy,
  { exact le_rfl },
  { exact (f.left_lim_le le_rfl).trans (f.le_left_lim hxy) }
end

/-- The identity of `ℝ` as a Stieltjes function, used to construct Lebesgue measure. -/
@[simps] protected def id : stieltjes_function :=
{ to_fun := id,
  mono' := λ x y, id,
  right_continuous' := λ x, continuous_within_at_id }

@[simp] lemma id_left_lim (x : ℝ) : stieltjes_function.id.left_lim x = x :=
tendsto_nhds_unique (stieltjes_function.id.tendsto_left_lim x) $
  (continuous_at_id).tendsto.mono_left nhds_within_le_nhds

instance : inhabited stieltjes_function := ⟨stieltjes_function.id⟩

/-! ### The outer measure associated to a Stieltjes function -/

/-- Length of an interval. This is the largest monotone function which correctly measures all
intervals. -/
def length (s : set ℝ) : ℝ≥0∞ := ⨅a b (h : s ⊆ Ioc a b), of_real (f b - f a)

@[simp] lemma length_empty : f.length ∅ = 0 :=
nonpos_iff_eq_zero.1 $ infi_le_of_le 0 $ infi_le_of_le 0 $ by simp

@[simp] lemma length_Ioc (a b : ℝ) :
  f.length (Ioc a b) = of_real (f b - f a) :=
begin
  refine le_antisymm (infi_le_of_le a $ binfi_le b (subset.refl _))
    (le_infi $ λ a', le_infi $ λ b', le_infi $ λ h, ennreal.coe_le_coe.2 _),
  cases le_or_lt b a with ab ab,
  { rw real.to_nnreal_of_nonpos (sub_nonpos.2 (f.mono ab)), apply zero_le, },
  cases (Ioc_subset_Ioc_iff ab).1 h with h₁ h₂,
  exact real.to_nnreal_le_to_nnreal (sub_le_sub (f.mono h₁) (f.mono h₂))
end

lemma length_mono {s₁ s₂ : set ℝ} (h : s₁ ⊆ s₂) :
  f.length s₁ ≤ f.length s₂ :=
infi_le_infi $ λ a, infi_le_infi $ λ b, infi_le_infi2 $ λ h', ⟨subset.trans h h', le_rfl⟩

open measure_theory

/-- The Stieltjes outer measure associated to a Stieltjes function. -/
protected def outer : outer_measure ℝ :=
outer_measure.of_function f.length f.length_empty

lemma outer_le_length (s : set ℝ) : f.outer s ≤ f.length s :=
outer_measure.of_function_le _

/-- If a compact interval `[a, b]` is covered by a union of open interval `(c i, d i)`, then
`f b - f a ≤ ∑ f (d i) - f (c i)`. This is an auxiliary technical statement to prove the same
statement for half-open intervals, the point of the current statement being that one can use
compactness to reduce it to a finite sum, and argue by induction on the size of the covering set. -/
lemma length_subadditive_Icc_Ioo {a b : ℝ} {c d : ℕ → ℝ}
  (ss : Icc a b ⊆ ⋃ i, Ioo (c i) (d i)) :
  of_real (f b - f a) ≤ ∑' i, of_real (f (d i) - f (c i)) :=
begin
  suffices : ∀ (s:finset ℕ) b
    (cv : Icc a b ⊆ ⋃ i ∈ (↑s:set ℕ), Ioo (c i) (d i)),
    (of_real (f b - f a) : ℝ≥0∞) ≤ ∑ i in s, of_real (f (d i) - f (c i)),
  { rcases is_compact_Icc.elim_finite_subcover_image (λ (i : ℕ) (_ : i ∈ univ),
      @is_open_Ioo _ _ _ _ (c i) (d i)) (by simpa using ss) with ⟨s, su, hf, hs⟩,
    have e : (⋃ i ∈ (↑hf.to_finset:set ℕ), Ioo (c i) (d i)) = (⋃ i ∈ s, Ioo (c i) (d i)),
      by simp only [ext_iff, exists_prop, finset.set_bUnion_coe, mem_Union, forall_const, iff_self,
                    finite.mem_to_finset],
    rw ennreal.tsum_eq_supr_sum,
    refine le_trans _ (le_supr _ hf.to_finset),
    exact this hf.to_finset _ (by simpa only [e]) },
  clear ss b,
  refine λ s, finset.strong_induction_on s (λ s IH b cv, _),
  cases le_total b a with ab ab,
  { rw ennreal.of_real_eq_zero.2 (sub_nonpos.2 (f.mono ab)), exact zero_le _, },
  have := cv ⟨ab, le_rfl⟩, simp at this,
  rcases this with ⟨i, is, cb, bd⟩,
  rw [← finset.insert_erase is] at cv ⊢,
  rw [finset.coe_insert, bUnion_insert] at cv,
  rw [finset.sum_insert (finset.not_mem_erase _ _)],
  refine le_trans _ (add_le_add_left (IH _ (finset.erase_ssubset is) (c i) _) _),
  { refine le_trans (ennreal.of_real_le_of_real _) ennreal.of_real_add_le,
    rw sub_add_sub_cancel,
    exact sub_le_sub_right (f.mono bd.le) _ },
  { rintro x ⟨h₁, h₂⟩,
    refine (cv ⟨h₁, le_trans h₂ (le_of_lt cb)⟩).resolve_left
      (mt and.left (not_lt_of_le h₂)) }
end

@[simp] lemma outer_Ioc (a b : ℝ) :
  f.outer (Ioc a b) = of_real (f b - f a) :=
begin
  /- It suffices to show that, if `(a, b]` is covered by sets `s i`, then `f b - f a` is bounded
  by `∑ f.length (s i) + ε`. The difficulty is that `f.length` is expressed in terms of half-open
  intervals, while we would like to have a compact interval covered by open intervals to use
  compactness and finite sums, as provided by `length_subadditive_Icc_Ioo`. The trick is to use the
  right-continuity of `f`. If `a'` is close enough to `a` on its right, then `[a', b]` is still
  covered by the sets `s i` and moreover `f b - f a'` is very close to `f b - f a` (up to `ε/2`).
  Also, by definition one can cover `s i` by a half-closed interval `(p i, q i]` with `f`-length
  very close to  that of `s i` (within a suitably small `ε' i`, say). If one moves `q i` very
  slightly to the right, then the `f`-length will change very little by right continuity, and we
  will get an open interval `(p i, q' i)` covering `s i` with `f (q' i) - f (p i)` within `ε' i`
  of the `f`-length of `s i`. -/
  refine le_antisymm (by { rw ← f.length_Ioc, apply outer_le_length })
    (le_binfi $ λ s hs, ennreal.le_of_forall_pos_le_add $ λ ε εpos h, _),
  let δ := ε / 2,
  have δpos : 0 < (δ : ℝ≥0∞), by simpa using εpos.ne',
  rcases ennreal.exists_pos_sum_of_encodable δpos.ne' ℕ with ⟨ε', ε'0, hε⟩,
  obtain ⟨a', ha', aa'⟩ : ∃ a', f a' - f a < δ ∧ a < a',
  { have A : continuous_within_at (λ r, f r - f a) (Ioi a) a,
    { refine continuous_within_at.sub _ continuous_within_at_const,
      exact (f.right_continuous a).mono Ioi_subset_Ici_self },
    have B : f a - f a < δ, by rwa [sub_self, nnreal.coe_pos, ← ennreal.coe_pos],
    exact (((tendsto_order.1 A).2 _ B).and self_mem_nhds_within).exists },
  have : ∀ i, ∃ p:ℝ×ℝ, s i ⊆ Ioo p.1 p.2 ∧
                        (of_real (f p.2 - f p.1) : ℝ≥0∞) < f.length (s i) + ε' i,
  { intro i,
    have := (ennreal.lt_add_right ((ennreal.le_tsum i).trans_lt h).ne
        (ennreal.coe_ne_zero.2 (ε'0 i).ne')),
    conv at this { to_lhs, rw length },
    simp only [infi_lt_iff, exists_prop] at this,
    rcases this with ⟨p, q', spq, hq'⟩,
    have : continuous_within_at (λ r, of_real (f r - f p)) (Ioi q') q',
    { apply ennreal.continuous_of_real.continuous_at.comp_continuous_within_at,
      refine continuous_within_at.sub _ continuous_within_at_const,
      exact (f.right_continuous q').mono Ioi_subset_Ici_self },
    rcases (((tendsto_order.1 this).2 _ hq').and self_mem_nhds_within).exists with ⟨q, hq, q'q⟩,
    exact ⟨⟨p, q⟩, spq.trans (Ioc_subset_Ioo_right q'q), hq⟩ },
  choose g hg using this,
  have I_subset : Icc a' b ⊆ ⋃ i, Ioo (g i).1 (g i).2 := calc
    Icc a' b ⊆ Ioc a b : λ x hx, ⟨aa'.trans_le hx.1, hx.2⟩
    ... ⊆ ⋃ i, s i : hs
    ... ⊆ ⋃ i, Ioo (g i).1 (g i).2 : Union_mono (λ i, (hg i).1),
  calc of_real (f b - f a)
      = of_real ((f b - f a') + (f a' - f a)) : by rw sub_add_sub_cancel
  ... ≤ of_real (f b - f a') + of_real (f a' - f a) : ennreal.of_real_add_le
  ... ≤ (∑' i, of_real (f (g i).2 - f (g i).1)) + of_real δ :
    add_le_add (f.length_subadditive_Icc_Ioo I_subset) (ennreal.of_real_le_of_real ha'.le)
  ... ≤ (∑' i, (f.length (s i) + ε' i)) + δ :
    add_le_add (ennreal.tsum_le_tsum (λ i, (hg i).2.le))
      (by simp only [ennreal.of_real_coe_nnreal, le_rfl])
  ... = (∑' i, f.length (s i)) + (∑' i, ε' i) + δ : by rw [ennreal.tsum_add]
  ... ≤ (∑' i, f.length (s i)) + δ + δ : add_le_add (add_le_add le_rfl hε.le) le_rfl
  ... = ∑' (i : ℕ), f.length (s i) + ε : by simp [add_assoc, ennreal.add_halves]
end

lemma measurable_set_Ioi {c : ℝ} :
  f.outer.caratheodory.measurable_set' (Ioi c) :=
begin
  apply outer_measure.of_function_caratheodory (λ t, _),
  refine le_infi (λ a, le_infi (λ b, le_infi (λ h, _))),
  refine le_trans (add_le_add
    (f.length_mono $ inter_subset_inter_left _ h)
    (f.length_mono $ diff_subset_diff_left h)) _,
  cases le_total a c with hac hac; cases le_total b c with hbc hbc,
  { simp only [Ioc_inter_Ioi, f.length_Ioc, hac, sup_eq_max, hbc, le_refl, Ioc_eq_empty,
      max_eq_right, min_eq_left, Ioc_diff_Ioi, f.length_empty, zero_add, not_lt] },
  { simp only [hac, hbc, Ioc_inter_Ioi, Ioc_diff_Ioi, f.length_Ioc, min_eq_right,
      sup_eq_max, ←ennreal.of_real_add, f.mono hac, f.mono hbc, sub_nonneg, sub_add_sub_cancel,
      le_refl, max_eq_right] },
  { simp only [hbc, le_refl, Ioc_eq_empty, Ioc_inter_Ioi, min_eq_left, Ioc_diff_Ioi,
      f.length_empty, zero_add, or_true, le_sup_iff, f.length_Ioc, not_lt] },
  { simp only [hac, hbc, Ioc_inter_Ioi, Ioc_diff_Ioi, f.length_Ioc, min_eq_right,
      sup_eq_max, le_refl, Ioc_eq_empty, add_zero, max_eq_left, f.length_empty, not_lt] }
end

theorem outer_trim : f.outer.trim = f.outer :=
begin
  refine le_antisymm (λ s, _) (outer_measure.le_trim _),
  rw outer_measure.trim_eq_infi,
  refine le_infi (λ t, le_infi $ λ ht,
    ennreal.le_of_forall_pos_le_add $ λ ε ε0 h, _),
  rcases ennreal.exists_pos_sum_of_encodable
    (ennreal.coe_pos.2 ε0).ne' ℕ with ⟨ε', ε'0, hε⟩,
  refine le_trans _ (add_le_add_left (le_of_lt hε) _),
  rw ← ennreal.tsum_add,
  choose g hg using show
    ∀ i, ∃ s, t i ⊆ s ∧ measurable_set s ∧
      f.outer s ≤ f.length (t i) + of_real (ε' i),
  { intro i,
    have := (ennreal.lt_add_right ((ennreal.le_tsum i).trans_lt h).ne
        (ennreal.coe_pos.2 (ε'0 i)).ne'),
    conv at this {to_lhs, rw length},
    simp only [infi_lt_iff] at this,
    rcases this with ⟨a, b, h₁, h₂⟩,
    rw ← f.outer_Ioc at h₂,
    exact ⟨_, h₁, measurable_set_Ioc, le_of_lt $ by simpa using h₂⟩ },
  simp at hg,
  apply infi_le_of_le (Union g) _,
  apply infi_le_of_le (ht.trans $ Union_mono (λ i, (hg i).1)) _,
  apply infi_le_of_le (measurable_set.Union (λ i, (hg i).2.1)) _,
  exact le_trans (f.outer.Union _) (ennreal.tsum_le_tsum $ λ i, (hg i).2.2)
end

lemma borel_le_measurable : borel ℝ ≤ f.outer.caratheodory :=
begin
  rw borel_eq_generate_from_Ioi,
  refine measurable_space.generate_from_le _,
  simp [f.measurable_set_Ioi] { contextual := tt }
end

/-! ### The measure associated to a Stieltjes function -/

/-- The measure associated to a Stieltjes function, giving mass `f b - f a` to the
interval `(a, b]`. -/
@[irreducible] protected def measure : measure ℝ :=
{ to_outer_measure := f.outer,
  m_Union := λ s hs, f.outer.Union_eq_of_caratheodory $
    λ i, f.borel_le_measurable _ (hs i),
  trimmed := f.outer_trim }

@[simp] lemma measure_Ioc (a b : ℝ) : f.measure (Ioc a b) = of_real (f b - f a) :=
by { rw stieltjes_function.measure, exact f.outer_Ioc a b }

@[simp] lemma measure_singleton (a : ℝ) : f.measure {a} = of_real (f a - f.left_lim a) :=
begin
  obtain ⟨u, u_mono, u_lt_a, u_lim⟩ : ∃ (u : ℕ → ℝ), strict_mono u ∧ (∀ (n : ℕ), u n < a)
    ∧ tendsto u at_top (𝓝 a) := exists_seq_strict_mono_tendsto a,
  have A : {a} = ⋂ n, Ioc (u n) a,
  { refine subset.antisymm (λ x hx, by simp [mem_singleton_iff.1 hx, u_lt_a]) (λ x hx, _),
    simp at hx,
    have : a ≤ x := le_of_tendsto' u_lim (λ n, (hx n).1.le),
    simp [le_antisymm this (hx 0).2] },
  have L1 : tendsto (λ n, f.measure (Ioc (u n) a)) at_top (𝓝 (f.measure {a})),
  { rw A,
    refine tendsto_measure_Inter (λ n, measurable_set_Ioc) (λ m n hmn, _) _,
    { exact Ioc_subset_Ioc (u_mono.monotone hmn) le_rfl },
    { exact ⟨0, by simpa only [measure_Ioc] using ennreal.of_real_ne_top⟩ } },
  have L2 : tendsto (λ n, f.measure (Ioc (u n) a)) at_top (𝓝 (of_real (f a - f.left_lim a))),
  { simp only [measure_Ioc],
    have : tendsto (λ n, f (u n)) at_top (𝓝 (f.left_lim a)),
    { apply (f.tendsto_left_lim a).comp,
      exact tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ u_lim
        (eventually_of_forall (λ n, u_lt_a n)) },
    exact ennreal.continuous_of_real.continuous_at.tendsto.comp (tendsto_const_nhds.sub this) },
  exact tendsto_nhds_unique L1 L2
end

@[simp] lemma measure_Icc (a b : ℝ) : f.measure (Icc a b) = of_real (f b - f.left_lim a) :=
begin
  rcases le_or_lt a b with hab|hab,
  { have A : disjoint {a} (Ioc a b), by simp,
    simp [← Icc_union_Ioc_eq_Icc le_rfl hab, -singleton_union, ← ennreal.of_real_add, f.left_lim_le,
      measure_union A measurable_set_Ioc, f.mono hab] },
  { simp only [hab, measure_empty, Icc_eq_empty, not_le],
    symmetry,
    simp [ennreal.of_real_eq_zero, f.le_left_lim hab] }
end

@[simp] lemma measure_Ioo {a b : ℝ} : f.measure (Ioo a b) = of_real (f.left_lim b - f a) :=
begin
  rcases le_or_lt b a with hab|hab,
  { simp only [hab, measure_empty, Ioo_eq_empty, not_lt],
    symmetry,
    simp [ennreal.of_real_eq_zero, f.left_lim_le hab] },
  { have A : disjoint (Ioo a b) {b}, by simp,
    have D : f b - f a = (f b - f.left_lim b) + (f.left_lim b - f a), by abel,
    have := f.measure_Ioc a b,
    simp only [←Ioo_union_Icc_eq_Ioc hab le_rfl, measure_singleton,
      measure_union A (measurable_set_singleton b), Icc_self] at this,
    rw [D, ennreal.of_real_add, add_comm] at this,
    { simpa only [ennreal.add_right_inj ennreal.of_real_ne_top] },
    { simp only [f.left_lim_le, sub_nonneg] },
    { simp only [f.le_left_lim hab, sub_nonneg] } },
end

@[simp]

end stieltjes_function


-- Teorema_de_Cantor.lean
-- Teorema de Cantor
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 4-mayo-2022
-- ---------------------------------------------------------------------

import data.set.basic
import set_theory.cardinal.basic

open set

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

theorem cantor_injective
  {α : Type} (f : set α → α) :
  ¬function.injective f :=
begin
  set B := {x : set α | f x ∉ x},
  set B' := {y : α | ∃ x : set α, f x = y ∧ x ∈ B},
  by_contradiction h,
  by_cases hp : f(B') ∈ B',
  { have : ∃ X, f(X) = f(B') ∧ f(X) ∉ X := mem_set_of_eq.mp hp,
    cases this with s hs,
    rw ← (h hs.1) at hp,
    have hp' := hs.2,
    contradiction, },
  { have : f(B') ∈ B',
    { rw mem_set_of_eq,
      use B',
      split,
      { refl, },
      { rw mem_set_of_eq,
        exact hp, }, },
    contradiction, },
end

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

theorem cantor_injective2
  {α : Type}
  (f : set α → α)
  : ¬function.injective f :=
begin
  set B := {x : set α | f x ∉ x},
  set B' := {y : α | ∃ x : set α, f x = y ∧ x ∈ B},
  intro h,
  by_cases hp : f B' ∈ B',
  { obtain ⟨s, hs⟩ : ∃ X, f X = f B' ∧ f X ∉ X := set.mem_set_of_eq.mp hp,
    rw ← (h hs.1) at hp,
    exact hs.2 hp, },
  { exact hp ⟨B', rfl, hp⟩, }
end

-- 2ª teorema
-- ==========

theorem cantor_surjective'
  {α : Type}
  (f : α → set α)
  : ¬function.surjective f :=
begin
  set B := {x : α | x ∉ f x},
  by_contradiction,
  obtain ⟨ξ, fx⟩ : ∃ ξ, f ξ = B := h B,
  have : ξ ∈ B ↔ ξ ∉ f(ξ),
  { exact mem_def, },
  { rw fx at this,
    exact (iff_not_self (ξ ∈ B)).mp this, },
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov
-/
import linear_algebra.span

/-!
# Quotients by submodules

* If `p` is a submodule of `M`, `M ⧸ p` is the quotient of `M` with respect to `p`:
  that is, elements of `M` are identified if their difference is in `p`. This is itself a module.

-/

-- For most of this file we work over a noncommutative ring
section ring

namespace submodule

variables {R M : Type*} {r : R} {x y : M} [ring R] [add_comm_group M] [module R M]
variables (p p' : submodule R M)

open linear_map

/-- The equivalence relation associated to a submodule `p`, defined by `x ≈ y` iff `-x + y ∈ p`.

Note this is equivalent to `y - x ∈ p`, but defined this way to be be defeq to the `add_subgroup`
version, where commutativity can't be assumed. -/
def quotient_rel : setoid M :=
quotient_add_group.left_rel p.to_add_subgroup

lemma quotient_rel_r_def {x y : M} : @setoid.r _ (p.quotient_rel) x y ↔ x - y ∈ p :=
iff.trans (by { rw [sub_eq_add_neg, neg_add, neg_neg], refl }) neg_mem_iff

/-- The quotient of a module `M` by a submodule `p ⊆ M`. -/
instance has_quotient : has_quotient M (submodule R M) := ⟨λ p, quotient (quotient_rel p)⟩

namespace quotient

/-- Map associating to an element of `M` the corresponding element of `M/p`,
when `p` is a submodule of `M`. -/
def mk {p : submodule R M} : M → M ⧸ p := quotient.mk'

@[simp] theorem mk_eq_mk {p : submodule R M} (x : M) :
  (@_root_.quotient.mk _ (quotient_rel p) x) = mk x := rfl
@[simp] theorem mk'_eq_mk {p : submodule R M} (x : M) : (quotient.mk' x : M ⧸ p) = mk x := rfl
@[simp] theorem quot_mk_eq_mk {p : submodule R M} (x : M) : (quot.mk _ x : M ⧸ p) = mk x := rfl

protected theorem eq' {x y : M} : (mk x : M ⧸ p) = mk y ↔ -x + y ∈ p := quotient.eq'

protected theorem eq {x y : M} : (mk x : M ⧸ p) = mk y ↔ x - y ∈ p :=
(p^.quotient.eq').trans p.quotient_rel_r_def

instance : has_zero (M ⧸ p) := ⟨mk 0⟩
instance : inhabited (M ⧸ p) := ⟨0⟩

@[simp] theorem mk_zero : mk 0 = (0 : M ⧸ p) := rfl

@[simp] theorem mk_eq_zero : (mk x : M ⧸ p) = 0 ↔ x ∈ p :=
by simpa using (quotient.eq p : mk x = 0 ↔ _)

instance add_comm_group : add_comm_group (M ⧸ p) :=
quotient_add_group.add_comm_group p.to_add_subgroup

@[simp] theorem mk_add : (mk (x + y) : M ⧸ p) = mk x + mk y := rfl

@[simp] theorem mk_neg : (mk (-x) : M ⧸ p) = -mk x := rfl

@[simp] theorem mk_sub : (mk (x - y) : M ⧸ p) = mk x - mk y := rfl

section has_scalar

variables {S : Type*} [has_scalar S R] [has_scalar S M] [is_scalar_tower S R M] (P : submodule R M)

instance has_scalar' : has_scalar S (M ⧸ P) :=
⟨λ a, quotient.map' ((•) a) $ λ x y h, by simpa [smul_sub] using P.smul_mem (a • 1 : R) h⟩

/-- Shortcut to help the elaborator in the common case. -/
instance has_scalar : has_scalar R (M ⧸ P) :=
quotient.has_scalar' P

@[simp] theorem mk_smul (r : S) (x : M) : (mk (r • x) : M ⧸ p) = r • mk x := rfl

instance smul_comm_class (T : Type*) [has_scalar T R] [has_scalar T M] [is_scalar_tower T R M]
  [smul_comm_class S T M] : smul_comm_class S T (M ⧸ P) :=
{ smul_comm := λ x y, quotient.ind' $ by exact λ z, congr_arg mk (smul_comm _ _ _) }

instance is_scalar_tower (T : Type*) [has_scalar T R] [has_scalar T M] [is_scalar_tower T R M]
  [has_scalar S T] [is_scalar_tower S T M] : is_scalar_tower S T (M ⧸ P) :=
{ smul_assoc := λ x y, quotient.ind' $ by exact λ z, congr_arg mk (smul_assoc _ _ _) }

instance is_central_scalar [has_scalar Sᵐᵒᵖ R] [has_scalar Sᵐᵒᵖ M] [is_scalar_tower Sᵐᵒᵖ R M]
  [is_central_scalar S M] : is_central_scalar S (M ⧸ P) :=
{ op_smul_eq_smul := λ x, quotient.ind' $ by exact λ z, congr_arg mk $ op_smul_eq_smul _ _ }

end has_scalar

section module

variables {S : Type*}

instance mul_action' [monoid S] [has_scalar S R] [mul_action S M] [is_scalar_tower S R M]
  (P : submodule R M) : mul_action S (M ⧸ P) :=
function.surjective.mul_action mk (surjective_quot_mk _) P^.quotient.mk_smul

instance mul_action (P : submodule R M) : mul_action R (M ⧸ P) :=
quotient.mul_action' P

instance distrib_mul_action' [monoid S] [has_scalar S R] [distrib_mul_action S M]
  [is_scalar_tower S R M]
  (P : submodule R M) : distrib_mul_action S (M ⧸ P) :=
function.surjective.distrib_mul_action
  ⟨mk, rfl, λ _ _, rfl⟩ (surjective_quot_mk _) P^.quotient.mk_smul

instance distrib_mul_action (P : submodule R M) : distrib_mul_action R (M ⧸ P) :=
quotient.distrib_mul_action' P

instance module' [semiring S] [has_scalar S R] [module S M] [is_scalar_tower S R M]
  (P : submodule R M) : module S (M ⧸ P) :=
function.surjective.module _
  ⟨mk, rfl, λ _ _, rfl⟩ (surjective_quot_mk _) P^.quotient.mk_smul

instance module (P : submodule R M) : module R (M ⧸ P) :=
quotient.module' P

variables (S)

/-- The quotient of `P` as an `S`-submodule is the same as the quotient of `P` as an `R`-submodule,
where `P : submodule R M`.
-/
def restrict_scalars_equiv [ring S] [has_scalar S R] [module S M] [is_scalar_tower S R M]
  (P : submodule R M) :
  (M ⧸ P.restrict_scalars S) ≃ₗ[S] M ⧸ P :=
{ map_add' := λ x y, quotient.induction_on₂' x y (λ x' y', rfl),
  map_smul' := λ c x, quotient.induction_on' x (λ x', rfl),
  ..quotient.congr_right $ λ _ _, iff.rfl }

@[simp] lemma restrict_scalars_equiv_mk
  [ring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] (P : submodule R M)
  (x : M) : restrict_scalars_equiv S P (mk x) = mk x :=
rfl

@[simp] lemma restrict_scalars_equiv_symm_mk
  [ring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] (P : submodule R M)
  (x : M) : (restrict_scalars_equiv S P).symm (mk x) = mk x :=
rfl

end module

lemma mk_surjective : function.surjective (@mk _ _ _ _ _ p) :=
by { rintros ⟨x⟩, exact ⟨x, rfl⟩ }

lemma nontrivial_of_lt_top (h : p < ⊤) : nontrivial (M ⧸ p) :=
begin
  obtain ⟨x, _, not_mem_s⟩ := set_like.exists_of_lt h,
  refine ⟨⟨mk x, 0, _⟩⟩,
  simpa using not_mem_s
end

end quotient

section

variables {M₂ : Type*} [add_comm_group M₂] [module R M₂]

lemma quot_hom_ext ⦃f g : M ⧸ p →ₗ[R] M₂⦄ (h : ∀ x, f (quotient.mk x) = g (quotient.mk x)) :
  f = g :=
linear_map.ext $ λ x, quotient.induction_on' x h

/-- The map from a module `M` to the quotient of `M` by a submodule `p` as a linear map. -/
def mkq : M →ₗ[R] M ⧸ p :=
{ to_fun := quotient.mk, map_add' := by simp, map_smul' := by simp }

@[simp] theorem mkq_apply (x : M) : p.mkq x = quotient.mk x := rfl

lemma mkq_surjective (A : submodule R M) : function.surjective A.mkq :=
by rintro ⟨x⟩; exact ⟨x, rfl⟩

end

variables {R₂ M₂ : Type*} [ring R₂] [add_comm_group M₂] [module R₂ M₂] {τ₁₂ : R →+* R₂}

/-- Two `linear_map`s from a quotient module are equal if their compositions with
`submodule.mkq` are equal.

See note [partially-applied ext lemmas]. -/
@[ext]
lemma linear_map_qext ⦃f g : M ⧸ p →ₛₗ[τ₁₂] M₂⦄ (h : f.comp p.mkq = g.comp p.mkq) : f = g :=
linear_map.ext $ λ x, quotient.induction_on' x $ (linear_map.congr_fun h : _)

/-- The map from the quotient of `M` by a submodule `p` to `M₂` induced by a linear map `f : M → M₂`
vanishing on `p`, as a linear map. -/
def liftq (f : M →ₛₗ[τ₁₂] M₂) (h : p ≤ f.ker) : M ⧸ p →ₛₗ[τ₁₂] M₂ :=
{ map_smul' := by rintro a ⟨x⟩; exact f.map_smulₛₗ a x,
  ..quotient_add_group.lift p.to_add_subgroup f.to_add_monoid_hom h }

@[simp] theorem liftq_apply (f : M →ₛₗ[τ₁₂] M₂) {h} (x : M) :
  p.liftq f h (quotient.mk x) = f x := rfl

@[simp] theorem liftq_mkq (f : M →ₛₗ[τ₁₂] M₂) (h) : (p.liftq f h).comp p.mkq = f :=
by ext; refl

/--Special case of `liftq` when `p` is the span of `x`. In this case, the condition on `f` simply
becomes vanishing at `x`.-/
def liftq_span_singleton (x : M) (f : M →ₛₗ[τ₁₂] M₂) (h : f x = 0) : (M ⧸ R ∙ x) →ₛₗ[τ₁₂] M₂ :=
(R ∙ x).liftq f $ by rw [span_singleton_le_iff_mem, linear_map.mem_ker, h]

@[simp] lemma liftq_span_singleton_apply (x : M) (f : M →ₛₗ[τ₁₂] M₂) (h : f x = 0) (y : M) :
liftq_span_singleton x f h (quotient.mk y) = f y := rfl

@[simp] theorem range_mkq : p.mkq.range = ⊤ :=
eq_top_iff'.2 $ by rintro ⟨x⟩; exact ⟨x, rfl⟩

@[simp] theorem ker_mkq : p.mkq.ker = p :=
by ext; simp

lemma le_comap_mkq (p' : submodule R (M ⧸ p)) : p ≤ comap p.mkq p' :=
by simpa using (comap_mono bot_le : p.mkq.ker ≤ comap p.mkq p')

@[simp] theorem mkq_map_self : map p.mkq p = ⊥ :=
by rw [eq_bot_iff, map_le_iff_le_comap, comap_bot, ker_mkq]; exact le_rfl

@[simp] theorem comap_map_mkq : comap p.mkq (map p.mkq p') = p ⊔ p' :=
by simp [comap_map_eq, sup_comm]

@[simp] theorem map_mkq_eq_top : map p.mkq p' = ⊤ ↔ p ⊔ p' = ⊤ :=
by simp only [map_eq_top_iff p.range_mkq, sup_comm, ker_mkq]

variables (q : submodule R₂ M₂)

/-- The map from the quotient of `M` by submodule `p` to the quotient of `M₂` by submodule `q` along
`f : M → M₂` is linear. -/
def mapq (f : M →ₛₗ[τ₁₂] M₂) (h : p ≤ comap f q) :
  (M ⧸ p) →ₛₗ[τ₁₂] (M₂ ⧸ q) :=
p.liftq (q.mkq.comp f) $ by simpa [ker_comp] using h

@[simp] theorem mapq_apply (f : M →ₛₗ[τ₁₂] M₂) {h} (x : M) :
  mapq p q f h (quotient.mk x) = quotient.mk (f x) := rfl

theorem mapq_mkq (f : M →ₛₗ[τ₁₂] M₂) {h} : (mapq p q f h).comp p.mkq = q.mkq.comp f :=
by ext x; refl

@[simp] lemma mapq_zero (h : p ≤ q.comap (0 : M →ₛₗ[τ₁₂] M₂) := by simp) :
  p.mapq q (0 : M →ₛₗ[τ₁₂] M₂) h = 0 :=
by { ext, simp, }

/-- Given submodules `p ⊆ M`, `p₂ ⊆ M₂`, `p₃ ⊆ M₃` and maps `f : M → M₂`, `g : M₂ → M₃` inducing
`mapq f : M ⧸ p → M₂ ⧸ p₂` and `mapq g : M₂ ⧸ p₂ → M₃ ⧸ p₃` then
`mapq (g ∘ f) = (mapq g) ∘ (mapq f)`. -/
lemma mapq_comp {R₃ M₃ : Type*} [ring R₃] [add_comm_group M₃] [module R₃ M₃]
  (p₂ : submodule R₂ M₂) (p₃ : submodule R₃ M₃)
  {τ₂₃ : R₂ →+* R₃} {τ₁₃ : R →+* R₃} [ring_hom_comp_triple τ₁₂ τ₂₃ τ₁₃]
  (f : M →ₛₗ[τ₁₂] M₂) (g : M₂ →ₛₗ[τ₂₃] M₃) (hf : p ≤ p₂.comap f) (hg : p₂ ≤ p₃.comap g)
  (h := (hf.trans (comap_mono hg))) :
  p.mapq p₃ (g.comp f) h = (p₂.mapq p₃ g hg).comp (p.mapq p₂ f hf) :=
by { ext, simp, }

@[simp] lemma mapq_id (h : p ≤ p.comap linear_map.id := by simp) :
  p.mapq p linear_map.id h = linear_map.id :=
by { ext, simp, }

lemma mapq_pow {f : M →ₗ[R] M} (h : p ≤ p.comap f) (k : ℕ)
  (h' : p ≤ p.comap (f^k) := p.le_comap_pow_of_le_comap h k) :
  p.mapq p (f^k) h' = (p.mapq p f h)^k :=
begin
  induction k with k ih,
  { simp [linear_map.one_eq_id], },
  { simp only [linear_map.iterate_succ, ← ih],
    apply p.mapq_comp, },
end

theorem comap_liftq (f : M →ₛₗ[τ₁₂] M₂) (h) :
  q.comap (p.liftq f h) = (q.comap f).map (mkq p) :=
le_antisymm
  (by rintro ⟨x⟩ hx; exact ⟨_, hx, rfl⟩)
  (by rw [map_le_iff_le_comap, ← comap_comp, liftq_mkq]; exact le_rfl)

theorem map_liftq [ring_hom_surjective τ₁₂] (f : M →ₛₗ[τ₁₂] M₂) (h) (q : submodule R (M ⧸ p)) :
  q.map (p.liftq f h) = (q.comap p.mkq).map f :=
le_antisymm
  (by rintro _ ⟨⟨x⟩, hxq, rfl⟩; exact ⟨x, hxq, rfl⟩)
  (by rintro _ ⟨x, hxq, rfl⟩; exact ⟨quotient.mk x, hxq, rfl⟩)

theorem ker_liftq (f : M →ₛₗ[τ₁₂] M₂) (h) :
  ker (p.liftq f h) = (ker f).map (mkq p) := comap_liftq _ _ _ _

theorem range_liftq [ring_hom_surjective τ₁₂] (f : M →ₛₗ[τ₁₂] M₂) (h) :
  range (p.liftq f h) = range f :=
by simpa only [range_eq_map] using map_liftq _ _ _ _

theorem ker_liftq_eq_bot (f : M →ₛₗ[τ₁₂] M₂) (h) (h' : ker f ≤ p) : ker (p.liftq f h) = ⊥ :=
by rw [ker_liftq, le_antisymm h h', mkq_map_self]

/-- The correspondence theorem for modules: there is an order isomorphism between submodules of the
quotient of `M` by `p`, and submodules of `M` larger than `p`. -/
def comap_mkq.rel_iso :
  submodule R (M ⧸ p) ≃o {p' : submodule R M // p ≤ p'} :=
{ to_fun    := λ p', ⟨comap p.mkq p', le_comap_mkq p _⟩,
  inv_fun   := λ q, map p.mkq q,
  left_inv  := λ p', map_comap_eq_self $ by simp,
  right_inv := λ ⟨q, hq⟩, subtype.ext_val $ by simpa [comap_map_mkq p],
  map_rel_iff'      := λ p₁ p₂, comap_le_comap_iff $ range_mkq _ }

/-- The ordering on submodules of the quotient of `M` by `p` embeds into the ordering on submodules
of `M`. -/
def comap_mkq.order_embedding :
  submodule R (M ⧸ p) ↪o submodule R M :=
(rel_iso.to_rel_embedding $ comap_mkq.rel_iso p).trans (subtype.rel_embedding _ _)

@[simp] lemma comap_mkq_embedding_eq (p' : submodule R (M ⧸ p)) :
  comap_mkq.order_embedding p p' = comap p.mkq p' := rfl

lemma span_preimage_eq [ring_hom_surjective τ₁₂] {f : M →ₛₗ[τ₁₂] M₂} {s : set M₂} (h₀ : s.nonempty)
  (h₁ : s ⊆ range f) :
  span R (f ⁻¹' s) = (span R₂ s).comap f :=
begin
  suffices : (span R₂ s).comap f ≤ span R (f ⁻¹' s),
  { exact le_antisymm (span_preimage_le f s) this, },
  have hk : ker f ≤ span R (f ⁻¹' s),
  { let y := classical.some h₀, have hy : y ∈ s, { exact classical.some_spec h₀, },
    rw ker_le_iff, use [y, h₁ hy], rw ← set.singleton_subset_iff at hy,
    exact set.subset.trans subset_span (span_mono (set.preimage_mono hy)), },
  rw ← left_eq_sup at hk, rw f.range_coe at h₁,
  rw [hk, ←linear_map.map_le_map_iff, map_span, map_comap_eq, set.image_preimage_eq_of_subset h₁],
  exact inf_le_right,
end

end submodule

open submodule

namespace linear_map

section ring

variables {R M R₂ M₂ R₃ M₃ : Type*}
variables [ring R] [ring R₂] [ring R₃]
variables [add_comm_monoid M] [add_comm_group M₂] [add_comm_monoid M₃]
variables [module R M] [module R₂ M₂] [module R₃ M₃]
variables {τ₁₂ : R →+* R₂} {τ₂₃ : R₂ →+* R₃} {τ₁₃ : R →+* R₃}
variables [ring_hom_comp_triple τ₁₂ τ₂₃ τ₁₃] [ring_hom_surjective τ₁₂]

lemma range_mkq_comp (f : M →ₛₗ[τ₁₂] M₂) : f.range.mkq.comp f = 0 :=
linear_map.ext $ λ x, by simp

lemma ker_le_range_iff {f : M →ₛₗ[τ₁₂] M₂} {g : M₂ →ₛₗ[τ₂₃] M₃} :
  g.ker ≤ f.range ↔ f.range.mkq.comp g.ker.subtype = 0 :=
by rw [←range_le_ker_iff, submodule.ker_mkq, submodule.range_subtype]

/-- An epimorphism is surjective. -/
lemma range_eq_top_of_cancel {f : M →ₛₗ[τ₁₂] M₂}
  (h : ∀ (u v : M₂ →ₗ[R₂] M₂ ⧸ f.range), u.comp f = v.comp f → u = v) : f.range = ⊤ :=
begin
  have h₁ : (0 : M₂ →ₗ[R₂] M₂ ⧸ f.range).comp f = 0 := zero_comp _,
  rw [←submodule.ker_mkq f.range, ←h 0 f.range.mkq (eq.trans h₁ (range_mkq_comp _).symm)],
  exact ker_zero
end

end ring

end linear_map

open linear_map

namespace submodule

variables {R M : Type*} {r : R} {x y : M} [ring R] [add_comm_group M] [module R M]
variables (p p' : submodule R M)

/-- If `p = ⊥`, then `M / p ≃ₗ[R] M`. -/
def quot_equiv_of_eq_bot (hp : p = ⊥) : (M ⧸ p) ≃ₗ[R] M :=
linear_equiv.of_linear (p.liftq id $ hp.symm ▸ bot_le) p.mkq (liftq_mkq _ _ _) $
  p.quot_hom_ext $ λ x, rfl

@[simp] lemma quot_equiv_of_eq_bot_apply_mk (hp : p = ⊥) (x : M) :
  p.quot_equiv_of_eq_bot hp (quotient.mk x) = x := rfl

@[simp] lemma quot_equiv_of_eq_bot_symm_apply (hp : p = ⊥) (x : M) :
  (p.quot_equiv_of_eq_bot hp).symm x = quotient.mk x := rfl

@[simp] lemma coe_quot_equiv_of_eq_bot_symm (hp : p = ⊥) :
  ((p.quot_equiv_of_eq_bot hp).symm : M →ₗ[R] M ⧸ p) = p.mkq := rfl

/-- Quotienting by equal submodules gives linearly equivalent quotients. -/
def quot_equiv_of_eq (h : p = p') : (M ⧸ p) ≃ₗ[R] M ⧸ p' :=
{ map_add' := by { rintros ⟨x⟩ ⟨y⟩, refl }, map_smul' := by { rintros x ⟨y⟩, refl },
  ..@quotient.congr _ _ (quotient_rel p) (quotient_rel p') (equiv.refl _) $
    λ a b, by { subst h, refl } }

@[simp]
lemma quot_equiv_of_eq_mk (h : p = p') (x : M) :
  submodule.quot_equiv_of_eq p p' h (submodule.quotient.mk x) = submodule.quotient.mk x :=
rfl

end submodule

end ring

section comm_ring

variables {R M M₂ : Type*} {r : R} {x y : M} [comm_ring R]
  [add_comm_group M] [module R M] [add_comm_group M₂] [module R M₂]
  (p : submodule R M) (q : submodule R M₂)

namespace submodule

/-- Given modules `M`, `M₂` over a commutative ring, together with submodules `p ⊆ M`, `q ⊆ M₂`,
the natural map $\{f ∈ Hom(M, M₂) | f(p) ⊆ q \} \to Hom(M/p, M₂/q)$ is linear. -/
def mapq_linear : compatible_maps p q →ₗ[R] (M ⧸ p) →ₗ[R] (M₂ ⧸ q) :=
{ to_fun    := λ f, mapq _ _ f.val f.property,
  map_add'  := λ x y, by { ext, refl, },
  map_smul' := λ c f, by { ext, refl, } }

end submodule

end comm_ring


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

/-!
# The antidiagonal on a multiset.

The antidiagonal of a multiset `s` consists of all pairs `(t₁, t₂)`
such that `t₁ + t₂ = s`. These pairs are counted with multiplicities.
-/

namespace multiset
open list

variables {α β : Type*}

/-- The antidiagonal of a multiset `s` consists of all pairs `(t₁, t₂)`
    such that `t₁ + t₂ = s`. These pairs are counted with multiplicities. -/
def antidiagonal (s : multiset α) : multiset (multiset α × multiset α) :=
quot.lift_on s
  (λ l, (revzip (powerset_aux l) : multiset (multiset α × multiset α)))
  (λ l₁ l₂ h, quot.sound (revzip_powerset_aux_perm h))

theorem antidiagonal_coe (l : list α) :
  @antidiagonal α l = revzip (powerset_aux l) := rfl

@[simp] theorem antidiagonal_coe' (l : list α) :
  @antidiagonal α l = revzip (powerset_aux' l) :=
quot.sound revzip_powerset_aux_perm_aux'

/-- A pair `(t₁, t₂)` of multisets is contained in `antidiagonal s`
    if and only if `t₁ + t₂ = s`. -/
@[simp] theorem mem_antidiagonal {s : multiset α} {x : multiset α × multiset α} :
  x ∈ antidiagonal s ↔ x.1 + x.2 = s :=
quotient.induction_on s $ λ l, begin
  simp [antidiagonal_coe], refine ⟨λ h, revzip_powerset_aux h, λ h, _⟩,
  haveI := classical.dec_eq α,
  simp [revzip_powerset_aux_lemma l revzip_powerset_aux, h.symm],
  cases x with x₁ x₂,
  exact ⟨_, le_add_right _ _, by rw add_sub_cancel_left _ _⟩
end

@[simp] theorem antidiagonal_map_fst (s : multiset α) :
  (antidiagonal s).map prod.fst = powerset s :=
quotient.induction_on s $ λ l,
by simp [powerset_aux']

@[simp] theorem antidiagonal_map_snd (s : multiset α) :
  (antidiagonal s).map prod.snd = powerset s :=
quotient.induction_on s $ λ l,
by simp [powerset_aux']

@[simp] theorem antidiagonal_zero : @antidiagonal α 0 = (0, 0) ::ₘ 0 := rfl

@[simp] theorem antidiagonal_cons (a : α) (s) : antidiagonal (a ::ₘ s) =
  map (prod.map id (cons a)) (antidiagonal s) +
  map (prod.map (cons a) id) (antidiagonal s) :=
quotient.induction_on s $ λ l, begin
  simp only [revzip, reverse_append, quot_mk_to_coe, coe_eq_coe, powerset_aux'_cons, cons_coe,
    coe_map, antidiagonal_coe', coe_add],
  rw [← zip_map, ← zip_map, zip_append, (_ : _++_=_)],
  {congr; simp}, {simp}
end

@[simp] theorem card_antidiagonal (s : multiset α) :
  card (antidiagonal s) = 2 ^ card s :=
by have := card_powerset s;
   rwa [← antidiagonal_map_fst, card_map] at this

lemma prod_map_add [comm_semiring β] {s : multiset α} {f g : α → β} :
  prod (s.map (λa, f a + g a)) =
  sum ((antidiagonal s).map (λp, (p.1.map f).prod * (p.2.map g).prod)) :=
begin
  refine s.induction_on _ _,
  { simp },
  { assume a s ih,
    simp [ih, add_mul, mul_comm, mul_left_comm, mul_assoc, sum_map_mul_left.symm],
    cc },
end

end multiset


/-
Copyright (c) 2021 Henry Swanson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henry Swanson
-/
import combinatorics.derangements.basic
import data.fintype.big_operators
import tactic.delta_instance
import tactic.ring

/-!
# Derangements on fintypes

This file contains lemmas that describe the cardinality of `derangements α` when `α` is a fintype.

# Main definitions

* `card_derangements_invariant`: A lemma stating that the number of derangements on a type `α`
    depends only on the cardinality of `α`.
* `num_derangements n`: The number of derangements on an n-element set, defined in a computation-
    friendly way.
* `card_derangements_eq_num_derangements`: Proof that `num_derangements` really does compute the
    number of derangements.
* `num_derangements_sum`: A lemma giving an expression for `num_derangements n` in terms of
    factorials.
-/

open derangements equiv fintype
open_locale big_operators

variables {α : Type*} [decidable_eq α] [fintype α]

instance : decidable_pred (derangements α) := λ _, fintype.decidable_forall_fintype

instance : fintype (derangements α) := by delta_instance derangements

lemma card_derangements_invariant {α β : Type*} [fintype α] [decidable_eq α]
  [fintype β] [decidable_eq β] (h : card α = card β) :
  card (derangements α) = card (derangements β) :=
fintype.card_congr (equiv.derangements_congr $ equiv_of_card_eq h)

lemma card_derangements_fin_add_two (n : ℕ) :
  card (derangements (fin (n+2))) = (n+1) * card (derangements (fin n)) +
  (n+1) * card (derangements (fin (n+1))) :=
begin
  -- get some basic results about the size of fin (n+1) plus or minus an element
  have h1 : ∀ a : fin (n+1), card ({a}ᶜ : set (fin (n+1))) = card (fin n),
  { intro a,
    simp only [fintype.card_fin, finset.card_fin, fintype.card_of_finset, finset.filter_ne' _ a,
      set.mem_compl_singleton_iff, finset.card_erase_of_mem (finset.mem_univ a),
      add_tsub_cancel_right] },
  have h2 : card (fin (n+2)) = card (option (fin (n+1))),
  { simp only [card_fin, card_option] },
  -- rewrite the LHS and substitute in our fintype-level equivalence
  simp only [card_derangements_invariant h2,
    card_congr (@derangements_recursion_equiv (fin (n+1)) _),
  -- push the cardinality through the Σ and ⊕ so that we can use `card_n`
    card_sigma, card_sum, card_derangements_invariant (h1 _), finset.sum_const, nsmul_eq_mul,
    finset.card_fin, mul_add, nat.cast_id],
end

/-- The number of derangements of an `n`-element set. -/
def num_derangements : ℕ → ℕ
| 0 := 1
| 1 := 0
| (n + 2) := (n + 1) * (num_derangements n + num_derangements (n+1))

@[simp] lemma num_derangements_zero : num_derangements 0 = 1 := rfl

@[simp] lemma num_derangements_one : num_derangements 1 = 0 := rfl

lemma num_derangements_add_two (n : ℕ) :
  num_derangements (n+2) = (n+1) * (num_derangements n + num_derangements (n+1)) := rfl

lemma num_derangements_succ (n : ℕ) :
  (num_derangements (n+1) : ℤ) = (n + 1) * (num_derangements n : ℤ) - (-1)^n :=
begin
  induction n with n hn,
  { refl },
  { simp only [num_derangements_add_two, hn, pow_succ,
      int.coe_nat_mul, int.coe_nat_add, int.coe_nat_succ],
    ring }
end

lemma card_derangements_fin_eq_num_derangements {n : ℕ} :
  card (derangements (fin n)) = num_derangements n :=
begin
  induction n using nat.strong_induction_on with n hyp,
  obtain (_|_|n) := n, { refl }, { refl },  -- knock out cases 0 and 1
  -- now we have n ≥ 2. rewrite everything in terms of card_derangements, so that we can use
  -- `card_derangements_fin_add_two`
  rw [num_derangements_add_two, card_derangements_fin_add_two, mul_add,
    hyp _ (nat.lt_add_of_pos_right zero_lt_two), hyp _ (lt_add_one _)],
end

lemma card_derangements_eq_num_derangements (α : Type*) [fintype α] [decidable_eq α] :
  card (derangements α) = num_derangements (card α) :=
begin
  rw ←card_derangements_invariant (card_fin _),
  exact card_derangements_fin_eq_num_derangements,
end

theorem num_derangements_sum (n : ℕ) :
  (num_derangements n : ℤ) = ∑ k in finset.range (n + 1), (-1:ℤ)^k * nat.asc_factorial k (n - k) :=
begin
  induction n with n hn, { refl },
  rw [finset.sum_range_succ, num_derangements_succ, hn, finset.mul_sum, tsub_self,
    nat.asc_factorial_zero, int.coe_nat_one, mul_one, pow_succ, neg_one_mul, sub_eq_add_neg,
    add_left_inj, finset.sum_congr rfl],
  -- show that (n + 1) * (-1)^x * asc_fac x (n - x) = (-1)^x * asc_fac x (n.succ - x)
  intros x hx,
  have h_le : x ≤ n := finset.mem_range_succ_iff.mp hx,
  rw [nat.succ_sub h_le, nat.asc_factorial_succ, add_tsub_cancel_of_le h_le,
    int.coe_nat_mul, int.coe_nat_succ, mul_left_comm],
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Floris van Doorn
-/
import data.sum.order
import order.initial_seg
import set_theory.cardinal.basic

/-!
# Ordinals

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

Ordinals are defined as equivalences of well-ordered sets under order isomorphism. They are endowed
with a total order, where an ordinal is smaller than another one if it embeds into it as an
initial segment (or, equivalently, in any way). This total order is well founded.

## Main definitions

* `ordinal`: the type of ordinals (in a given universe)
* `ordinal.type r`: given a well-founded order `r`, this is the corresponding ordinal
* `ordinal.typein r a`: given a well-founded order `r` on a type `α`, and `a : α`, the ordinal
  corresponding to all elements smaller than `a`.
* `enum r o h`: given a well-order `r` on a type `α`, and an ordinal `o` strictly smaller than
  the ordinal corresponding to `r` (this is the assumption `h`), returns the `o`-th element of `α`.
  In other words, the elements of `α` can be enumerated using ordinals up to `type r`.
* `ordinal.card o`: the cardinality of an ordinal `o`.
* `ordinal.lift` lifts an ordinal in universe `u` to an ordinal in universe `max u v`.
  For a version registering additionally that this is an initial segment embedding, see
  `ordinal.lift.initial_seg`.
  For a version regiserting that it is a principal segment embedding if `u < v`, see
  `ordinal.lift.principal_seg`.
* `ordinal.omega` or `ω` is the order type of `ℕ`. This definition is universe polymorphic:
  `ordinal.omega.{u} : ordinal.{u}` (contrast with `ℕ : Type`, which lives in a specific
  universe). In some cases the universe level has to be given explicitly.

* `o₁ + o₂` is the order on the disjoint union of `o₁` and `o₂` obtained by declaring that
  every element of `o₁` is smaller than every element of `o₂`. The main properties of addition
  (and the other operations on ordinals) are stated and proved in `ordinal_arithmetic.lean`. Here,
  we only introduce it and prove its basic properties to deduce the fact that the order on ordinals
  is total (and well founded).
* `succ o` is the successor of the ordinal `o`.
* `cardinal.ord c`: when `c` is a cardinal, `ord c` is the smallest ordinal with this cardinality.
  It is the canonical way to represent a cardinal with an ordinal.

A conditionally complete linear order with bot structure is registered on ordinals, where `⊥` is
`0`, the ordinal corresponding to the empty type, and `Inf` is the minimum for nonempty sets and `0`
for the empty set by convention.

## Notations

* `ω` is a notation for the first infinite ordinal in the locale `ordinal`.
-/

noncomputable theory

open function cardinal set equiv order
open_locale classical cardinal initial_seg

universes u v w
variables {α : Type*} {β : Type*} {γ : Type*}
  {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}

/-! ### Well order on an arbitrary type -/

section well_ordering_thm
parameter {σ : Type u}
open function

theorem nonempty_embedding_to_cardinal : nonempty (σ ↪ cardinal.{u}) :=
(embedding.total _ _).resolve_left $ λ ⟨⟨f, hf⟩⟩,
  let g : σ → cardinal.{u} := inv_fun f in
  let ⟨x, (hx : g x = 2 ^ sum g)⟩ := inv_fun_surjective hf (2 ^ sum g) in
  have g x ≤ sum g, from le_sum.{u u} g x,
  not_le_of_gt (by rw hx; exact cantor _) this

/-- An embedding of any type to the set of cardinals. -/
def embedding_to_cardinal : σ ↪ cardinal.{u} := classical.choice nonempty_embedding_to_cardinal

/-- Any type can be endowed with a well order, obtained by pulling back the well order over
cardinals by some embedding. -/
def well_ordering_rel : σ → σ → Prop := embedding_to_cardinal ⁻¹'o (<)

instance well_ordering_rel.is_well_order : is_well_order σ well_ordering_rel :=
(rel_embedding.preimage _ _).is_well_order

instance is_well_order.subtype_nonempty : nonempty {r // is_well_order σ r} :=
⟨⟨well_ordering_rel, infer_instance⟩⟩

end well_ordering_thm

/-! ### Definition of ordinals -/

/-- Bundled structure registering a well order on a type. Ordinals will be defined as a quotient
of this type. -/
structure Well_order : Type (u+1) :=
(α : Type u)
(r : α → α → Prop)
(wo : is_well_order α r)

attribute [instance] Well_order.wo

namespace Well_order

instance : inhabited Well_order := ⟨⟨pempty, _, empty_relation.is_well_order⟩⟩

@[simp] lemma eta (o : Well_order) : mk o.α o.r o.wo = o := by { cases o, refl }

end Well_order

/-- Equivalence relation on well orders on arbitrary types in universe `u`, given by order
isomorphism. -/
instance ordinal.is_equivalent : setoid Well_order :=
{ r     := λ ⟨α, r, wo⟩ ⟨β, s, wo'⟩, nonempty (r ≃r s),
  iseqv := ⟨λ ⟨α, r, _⟩, ⟨rel_iso.refl _⟩,
    λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨e⟩, ⟨e.symm⟩,
    λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨γ, t, _⟩ ⟨e₁⟩ ⟨e₂⟩, ⟨e₁.trans e₂⟩⟩ }

/-- `ordinal.{u}` is the type of well orders in `Type u`, up to order isomorphism. -/
def ordinal : Type (u + 1) := quotient ordinal.is_equivalent

instance has_well_founded_out (o : ordinal) : has_well_founded o.out.α := ⟨o.out.r, o.out.wo.wf⟩

instance linear_order_out (o : ordinal) : linear_order o.out.α :=
is_well_order.linear_order o.out.r

instance is_well_order_out_lt (o : ordinal) : is_well_order o.out.α (<) :=
o.out.wo

namespace ordinal

/- ### Basic properties of the order type -/

/-- The order type of a well order is an ordinal. -/
def type (r : α → α → Prop) [wo : is_well_order α r] : ordinal :=
⟦⟨α, r, wo⟩⟧

instance : has_zero ordinal := ⟨type $ @empty_relation pempty⟩
instance : inhabited ordinal := ⟨0⟩
instance : has_one ordinal := ⟨type $ @empty_relation punit⟩

/-- The order type of an element inside a well order. For the embedding as a principal segment, see
`typein.principal_seg`. -/
def typein (r : α → α → Prop) [is_well_order α r] (a : α) : ordinal :=
type (subrel r {b | r b a})

@[simp] theorem type_def' (w : Well_order) : ⟦w⟧ = type w.r :=
by { cases w, refl }

@[simp] theorem type_def (r) [wo : is_well_order α r] : (⟦⟨α, r, wo⟩⟧ : ordinal) = type r :=
rfl

@[simp] lemma type_out (o : ordinal) : ordinal.type o.out.r = o :=
by rw [ordinal.type, Well_order.eta, quotient.out_eq]

theorem type_eq {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] : type r = type s ↔ nonempty (r ≃r s) :=
quotient.eq

theorem _root_.rel_iso.ordinal_type_eq {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] (h : r ≃r s) : type r = type s :=
type_eq.2 ⟨h⟩

@[simp] theorem type_lt (o : ordinal) : type ((<) : o.out.α → o.out.α → Prop) = o :=
(type_def' _).symm.trans $ quotient.out_eq o

theorem type_eq_zero_of_empty (r) [is_well_order α r] [is_empty α] : type r = 0 :=
(rel_iso.rel_iso_of_is_empty r _).ordinal_type_eq

@[simp] theorem type_eq_zero_iff_is_empty [is_well_order α r] : type r = 0 ↔ is_empty α :=
⟨λ h, let ⟨s⟩ := type_eq.1 h in s.to_equiv.is_empty, @type_eq_zero_of_empty α r _⟩

theorem type_ne_zero_iff_nonempty [is_well_order α r] : type r ≠ 0 ↔ nonempty α := by simp

theorem type_ne_zero_of_nonempty (r) [is_well_order α r] [h : nonempty α] : type r ≠ 0 :=
type_ne_zero_iff_nonempty.2 h

theorem type_pempty : type (@empty_relation pempty) = 0 := rfl
theorem type_empty : type (@empty_relation empty) = 0 := type_eq_zero_of_empty _

theorem type_eq_one_of_unique (r) [is_well_order α r] [unique α] : type r = 1 :=
(rel_iso.rel_iso_of_unique_of_irrefl r _).ordinal_type_eq

@[simp] theorem type_eq_one_iff_unique [is_well_order α r] : type r = 1 ↔ nonempty (unique α) :=
⟨λ h, let ⟨s⟩ := type_eq.1 h in ⟨s.to_equiv.unique⟩, λ ⟨h⟩, @type_eq_one_of_unique α r _ h⟩

theorem type_punit : type (@empty_relation punit) = 1 := rfl
theorem type_unit : type (@empty_relation unit) = 1 := rfl

@[simp] theorem out_empty_iff_eq_zero {o : ordinal} : is_empty o.out.α ↔ o = 0 :=
by rw [←@type_eq_zero_iff_is_empty o.out.α (<), type_lt]

lemma eq_zero_of_out_empty (o : ordinal) [h : is_empty o.out.α] : o = 0 :=
out_empty_iff_eq_zero.1 h

instance is_empty_out_zero : is_empty (0 : ordinal).out.α := out_empty_iff_eq_zero.2 rfl

@[simp] theorem out_nonempty_iff_ne_zero {o : ordinal} : nonempty o.out.α ↔ o ≠ 0 :=
by rw [←@type_ne_zero_iff_nonempty o.out.α (<), type_lt]

lemma ne_zero_of_out_nonempty (o : ordinal) [h : nonempty o.out.α] : o ≠ 0 :=
out_nonempty_iff_ne_zero.1 h

protected lemma one_ne_zero : (1 : ordinal) ≠ 0 := type_ne_zero_of_nonempty _

instance : nontrivial ordinal.{u} := ⟨⟨1, 0, ordinal.one_ne_zero⟩⟩

@[simp] theorem type_preimage {α β : Type u} (r : α → α → Prop) [is_well_order α r] (f : β ≃ α) :
  type (f ⁻¹'o r) = type r :=
(rel_iso.preimage f r).ordinal_type_eq

@[elab_as_eliminator] theorem induction_on {C : ordinal → Prop}
  (o : ordinal) (H : ∀ α r [is_well_order α r], by exactI C (type r)) : C o :=
quot.induction_on o $ λ ⟨α, r, wo⟩, @H α r wo

/-! ### The order on ordinals -/

instance : partial_order ordinal :=
{ le := λ a b, quotient.lift_on₂ a b (λ ⟨α, r, wo⟩ ⟨β, s, wo'⟩, nonempty (r ≼i s)) $
    λ ⟨α₁, r₁, o₁⟩ ⟨α₂, r₂, o₂⟩ ⟨β₁, s₁, p₁⟩ ⟨β₂, s₂, p₂⟩ ⟨f⟩ ⟨g⟩,
    propext ⟨
      λ ⟨h⟩, ⟨(initial_seg.of_iso f.symm).trans $
        h.trans (initial_seg.of_iso g)⟩,
      λ ⟨h⟩, ⟨(initial_seg.of_iso f).trans $
        h.trans (initial_seg.of_iso g.symm)⟩⟩,
  lt := λ a b, quotient.lift_on₂ a b (λ ⟨α, r, wo⟩ ⟨β, s, wo'⟩, nonempty (r ≺i s)) $
    λ ⟨α₁, r₁, o₁⟩ ⟨α₂, r₂, o₂⟩ ⟨β₁, s₁, p₁⟩ ⟨β₂, s₂, p₂⟩ ⟨f⟩ ⟨g⟩,
    by exactI propext ⟨
      λ ⟨h⟩, ⟨principal_seg.equiv_lt f.symm $
        h.lt_le (initial_seg.of_iso g)⟩,
      λ ⟨h⟩, ⟨principal_seg.equiv_lt f $
        h.lt_le (initial_seg.of_iso g.symm)⟩⟩,
  le_refl := quot.ind $ by exact λ ⟨α, r, wo⟩, ⟨initial_seg.refl _⟩,
  le_trans := λ a b c, quotient.induction_on₃ a b c $
    λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨γ, t, _⟩ ⟨f⟩ ⟨g⟩, ⟨f.trans g⟩,
  lt_iff_le_not_le := λ a b, quotient.induction_on₂ a b $
    λ ⟨α, r, _⟩ ⟨β, s, _⟩, by exactI
      ⟨λ ⟨f⟩, ⟨⟨f⟩, λ ⟨g⟩, (f.lt_le g).irrefl⟩,
      λ ⟨⟨f⟩, h⟩, sum.rec_on f.lt_or_eq (λ g, ⟨g⟩)
      (λ g, (h ⟨initial_seg.of_iso g.symm⟩).elim)⟩,
  le_antisymm := λ a b,
    quotient.induction_on₂ a b $ λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨h₁⟩ ⟨h₂⟩,
    by exactI quot.sound ⟨initial_seg.antisymm h₁ h₂⟩ }

/-- Ordinal less-equal is defined such that
  well orders `r` and `s` satisfy `type r ≤ type s` if there exists
  a function embedding `r` as an initial segment of `s`. -/
add_decl_doc ordinal.partial_order.le

/-- Ordinal less-than is defined such that
  well orders `r` and `s` satisfy `type r < type s` if there exists
  a function embedding `r` as a principal segment of `s`. -/
add_decl_doc ordinal.partial_order.lt

theorem type_le_iff {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] :
  type r ≤ type s ↔ nonempty (r ≼i s) := iff.rfl

theorem type_le_iff' {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] : type r ≤ type s ↔ nonempty (r ↪r s) :=
⟨λ ⟨f⟩, ⟨f⟩, λ ⟨f⟩, ⟨f.collapse⟩⟩

theorem _root_.initial_seg.ordinal_type_le {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] (h : r ≼i s) : type r ≤ type s := ⟨h⟩

theorem _root_.rel_embedding.ordinal_type_le {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] (h : r ↪r s) : type r ≤ type s := ⟨h.collapse⟩

@[simp] theorem type_lt_iff {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] :
  type r < type s ↔ nonempty (r ≺i s) := iff.rfl

theorem _root_.principal_seg.ordinal_type_lt {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] (h : r ≺i s) : type r < type s := ⟨h⟩

protected theorem zero_le (o : ordinal) : 0 ≤ o :=
induction_on o $ λ α r _, by exactI (initial_seg.of_is_empty _ r).ordinal_type_le

instance : order_bot ordinal := ⟨0, ordinal.zero_le⟩

@[simp] lemma bot_eq_zero : (⊥ : ordinal) = 0 := rfl

@[simp] protected theorem le_zero {o : ordinal} : o ≤ 0 ↔ o = 0 := le_bot_iff
protected theorem pos_iff_ne_zero {o : ordinal} : 0 < o ↔ o ≠ 0 := bot_lt_iff_ne_bot
protected theorem not_lt_zero (o : ordinal) : ¬ o < 0 := not_lt_bot
theorem eq_zero_or_pos : ∀ a : ordinal, a = 0 ∨ 0 < a := eq_bot_or_bot_lt

instance : zero_le_one_class ordinal := ⟨ordinal.zero_le _⟩

instance ne_zero.one : ne_zero (1 : ordinal) := ⟨ordinal.one_ne_zero⟩

/-- Given two ordinals `α ≤ β`, then `initial_seg_out α β` is the initial segment embedding
of `α` to `β`, as map from a model type for `α` to a model type for `β`. -/
def initial_seg_out {α β : ordinal} (h : α ≤ β) :
  initial_seg ((<) : α.out.α → α.out.α → Prop) ((<) : β.out.α → β.out.α → Prop) :=
begin
  change α.out.r ≼i β.out.r,
  rw [←quotient.out_eq α, ←quotient.out_eq β] at h, revert h,
  cases quotient.out α, cases quotient.out β, exact classical.choice
end

/-- Given two ordinals `α < β`, then `principal_seg_out α β` is the principal segment embedding
of `α` to `β`, as map from a model type for `α` to a model type for `β`. -/
def principal_seg_out {α β : ordinal} (h : α < β) :
  principal_seg ((<) : α.out.α → α.out.α → Prop) ((<) : β.out.α → β.out.α → Prop) :=
begin
  change α.out.r ≺i β.out.r,
  rw [←quotient.out_eq α, ←quotient.out_eq β] at h, revert h,
  cases quotient.out α, cases quotient.out β, exact classical.choice
end

theorem typein_lt_type (r : α → α → Prop) [is_well_order α r] (a : α) : typein r a < type r :=
⟨principal_seg.of_element _ _⟩

theorem typein_lt_self {o : ordinal} (i : o.out.α) : typein (<) i < o :=
by { simp_rw ←type_lt o, apply typein_lt_type }

@[simp] theorem typein_top {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] (f : r ≺i s) :
  typein s f.top = type r :=
eq.symm $ quot.sound ⟨rel_iso.of_surjective
  (rel_embedding.cod_restrict _ f f.lt_top)
  (λ ⟨a, h⟩, by rcases f.down.1 h with ⟨b, rfl⟩; exact ⟨b, rfl⟩)⟩

@[simp] theorem typein_apply {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] (f : r ≼i s) (a : α) :
  ordinal.typein s (f a) = ordinal.typein r a :=
eq.symm $ quotient.sound ⟨rel_iso.of_surjective
  (rel_embedding.cod_restrict _
    ((subrel.rel_embedding _ _).trans f)
    (λ ⟨x, h⟩, by rw [rel_embedding.trans_apply]; exact f.to_rel_embedding.map_rel_iff.2 h))
  (λ ⟨y, h⟩, by rcases f.init h with ⟨a, rfl⟩;
    exact ⟨⟨a, f.to_rel_embedding.map_rel_iff.1 h⟩, subtype.eq $ rel_embedding.trans_apply _ _ _⟩)⟩

@[simp] theorem typein_lt_typein (r : α → α → Prop) [is_well_order α r]
  {a b : α} : typein r a < typein r b ↔ r a b :=
⟨λ ⟨f⟩, begin
  have : f.top.1 = a,
  { let f' := principal_seg.of_element r a,
    let g' := f.trans (principal_seg.of_element r b),
    have : g'.top = f'.top, {rw subsingleton.elim f' g'},
    exact this },
  rw ← this, exact f.top.2
end, λ h, ⟨principal_seg.cod_restrict _
  (principal_seg.of_element r a)
  (λ x, @trans _ r _ _ _ _ x.2 h) h⟩⟩

theorem typein_surj (r : α → α → Prop) [is_well_order α r]
  {o} (h : o < type r) : ∃ a, typein r a = o :=
induction_on o (λ β s _ ⟨f⟩, by exactI ⟨f.top, typein_top _⟩) h

lemma typein_injective (r : α → α → Prop) [is_well_order α r] : injective (typein r) :=
injective_of_increasing r (<) (typein r) (λ x y, (typein_lt_typein r).2)

@[simp] theorem typein_inj (r : α → α → Prop) [is_well_order α r]
  {a b} : typein r a = typein r b ↔ a = b :=
(typein_injective r).eq_iff

/-! ### Enumerating elements in a well-order with ordinals. -/

/-- `enum r o h` is the `o`-th element of `α` ordered by `r`.
  That is, `enum` maps an initial segment of the ordinals, those
  less than the order type of `r`, to the elements of `α`. -/
def enum (r : α → α → Prop) [is_well_order α r] (o) : o < type r → α :=
quot.rec_on o (λ ⟨β, s, _⟩ h, (classical.choice h).top) $
λ ⟨β, s, _⟩ ⟨γ, t, _⟩ ⟨h⟩, begin
  resetI, refine funext (λ (H₂ : type t < type r), _),
  have H₁ : type s < type r, {rwa type_eq.2 ⟨h⟩},
  have : ∀ {o e} (H : o < type r), @@eq.rec
   (λ (o : ordinal), o < type r → α)
   (λ (h : type s < type r), (classical.choice h).top)
     e H = (classical.choice H₁).top, {intros, subst e},
  exact (this H₂).trans (principal_seg.top_eq h
    (classical.choice H₁) (classical.choice H₂))
end

theorem enum_type {α β} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s] (f : s ≺i r)
  {h : type s < type r} : enum r (type s) h = f.top :=
principal_seg.top_eq (rel_iso.refl _) _ _

@[simp] theorem enum_typein (r : α → α → Prop) [is_well_order α r] (a : α) :
  enum r (typein r a) (typein_lt_type r a) = a :=
enum_type (principal_seg.of_element r a)

@[simp] theorem typein_enum (r : α → α → Prop) [is_well_order α r]
  {o} (h : o < type r) : typein r (enum r o h) = o :=
let ⟨a, e⟩ := typein_surj r h in
by clear _let_match; subst e; rw enum_typein

theorem enum_lt_enum {r : α → α → Prop} [is_well_order α r]
  {o₁ o₂ : ordinal} (h₁ : o₁ < type r) (h₂ : o₂ < type r) :
  r (enum r o₁ h₁) (enum r o₂ h₂) ↔ o₁ < o₂ :=
by rw [← typein_lt_typein r, typein_enum, typein_enum]

lemma rel_iso_enum' {α β : Type u} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s]
  (f : r ≃r s) (o : ordinal) : ∀(hr : o < type r) (hs : o < type s),
  f (enum r o hr) = enum s o hs :=
begin
  refine induction_on o _, rintros γ t wo ⟨g⟩ ⟨h⟩,
  resetI, rw [enum_type g, enum_type (principal_seg.lt_equiv g f)], refl
end

lemma rel_iso_enum {α β : Type u} {r : α → α → Prop} {s : β → β → Prop}
  [is_well_order α r] [is_well_order β s]
  (f : r ≃r s) (o : ordinal) (hr : o < type r) :
  f (enum r o hr) =
  enum s o (by {convert hr using 1, apply quotient.sound, exact ⟨f.symm⟩ }) :=
rel_iso_enum' _ _ _ _

theorem lt_wf : @well_founded ordinal (<) :=
⟨λ a, induction_on a $ λ α r wo, by exactI
suffices ∀ a, acc (<) (typein r a), from
⟨_, λ o h, let ⟨a, e⟩ := typein_surj r h in e ▸ this a⟩,
λ a, acc.rec_on (wo.wf.apply a) $ λ x H IH, ⟨_, λ o h, begin
  rcases typein_surj r (lt_trans h (typein_lt_type r _)) with ⟨b, rfl⟩,
  exact IH _ ((typein_lt_typein r).1 h)
end⟩⟩

instance : has_well_founded ordinal := ⟨(<), lt_wf⟩

/-- Reformulation of well founded induction on ordinals as a lemma that works with the
`induction` tactic, as in `induction i using ordinal.induction with i IH`. -/
lemma induction {p : ordinal.{u} → Prop} (i : ordinal.{u})
  (h : ∀ j, (∀ k, k < j → p k) → p j) : p i :=
lt_wf.induction i h

/-- Principal segment version of the `typein` function, embedding a well order into
  ordinals as a principal segment. -/
def typein.principal_seg {α : Type u} (r : α → α → Prop) [is_well_order α r] :
  @principal_seg α ordinal.{u} r (<) :=
⟨rel_embedding.of_monotone (typein r)
  (λ a b, (typein_lt_typein r).2), type r, λ b,
    ⟨λ h, ⟨enum r _ h, typein_enum r h⟩,
    λ ⟨a, e⟩, e ▸ typein_lt_type _ _⟩⟩

@[simp] theorem typein.principal_seg_coe (r : α → α → Prop) [is_well_order α r] :
  (typein.principal_seg r : α → ordinal) = typein r := rfl

/-! ### Cardinality of ordinals -/

/-- The cardinal of an ordinal is the cardinality of any type on which a relation with that order
type is defined. -/
def card : ordinal → cardinal := quotient.map Well_order.α $ λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨e⟩, ⟨e.to_equiv⟩

@[simp] theorem card_type (r : α → α → Prop) [is_well_order α r] : card (type r) = #α := rfl

@[simp] lemma card_typein {r : α → α → Prop} [wo : is_well_order α r] (x : α) :
  #{y // r y x} = (typein r x).card :=
rfl

theorem card_le_card {o₁ o₂ : ordinal} : o₁ ≤ o₂ → card o₁ ≤ card o₂ :=
induction_on o₁ $ λ α r _, induction_on o₂ $ λ β s _ ⟨⟨⟨f, _⟩, _⟩⟩, ⟨f⟩

@[simp] theorem card_zero : card 0 = 0 := rfl

@[simp] theorem card_eq_zero {o} : card o = 0 ↔ o = 0 :=
⟨induction_on o $ λ α r _ h, begin
  haveI := cardinal.mk_eq_zero_iff.1 h,
  apply type_eq_zero_of_empty
end, λ e, by simp only [e, card_zero]⟩

@[simp] theorem card_one : card 1 = 1 := rfl

/-! ### Lifting ordinals to a higher universe -/

/-- The universe lift operation for ordinals, which embeds `ordinal.{u}` as
  a proper initial segment of `ordinal.{v}` for `v > u`. For the initial segment version,
  see `lift.initial_seg`. -/
def lift (o : ordinal.{v}) : ordinal.{max v u} :=
quotient.lift_on o (λ w, type $ ulift.down ⁻¹'o w.r) $
  λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨f⟩, quot.sound ⟨(rel_iso.preimage equiv.ulift r).trans $
    f.trans (rel_iso.preimage equiv.ulift s).symm⟩

@[simp] theorem type_ulift (r : α → α → Prop) [is_well_order α r] :
  type (ulift.down ⁻¹'o r) = lift.{v} (type r) :=
rfl

theorem _root_.rel_iso.ordinal_lift_type_eq {α : Type u} {β : Type v}
  {r : α → α → Prop} {s : β → β → Prop} [is_well_order α r] [is_well_order β s] (f : r ≃r s) :
  lift.{v} (type r) = lift.{u} (type s) :=
((rel_iso.preimage equiv.ulift r).trans $
  f.trans (rel_iso.preimage equiv.ulift s).symm).ordinal_type_eq

@[simp] theorem type_lift_preimage {α : Type u} {β : Type v} (r : α → α → Prop) [is_well_order α r]
  (f : β ≃ α) : lift.{u} (type (f ⁻¹'o r)) = lift.{v} (type r) :=
(rel_iso.preimage f r).ordinal_lift_type_eq

/-- `lift.{(max u v) u}` equals `lift.{v u}`. Using `set_option pp.universes true` will make it much
    easier to understand what's happening when using this lemma. -/
@[simp] theorem lift_umax : lift.{(max u v) u} = lift.{v u} :=
funext $ λ a, induction_on a $ λ α r _,
quotient.sound ⟨(rel_iso.preimage equiv.ulift r).trans (rel_iso.preimage equiv.ulift r).symm⟩

/-- `lift.{(max v u) u}` equals `lift.{v u}`. Using `set_option pp.universes true` will make it much
    easier to understand what's happening when using this lemma. -/
@[simp] theorem lift_umax' : lift.{(max v u) u} = lift.{v u} := lift_umax

/-- An ordinal lifted to a lower or equal universe equals itself. -/
@[simp] theorem lift_id' (a : ordinal) : lift a = a :=
induction_on a $ λ α r _, quotient.sound ⟨rel_iso.preimage equiv.ulift r⟩

/-- An ordinal lifted to the same universe equals itself. -/
@[simp] theorem lift_id : ∀ a, lift.{u u} a = a := lift_id'.{u u}

/-- An ordinal lifted to the zero universe equals itself. -/
@[simp] theorem lift_uzero (a : ordinal.{u}) : lift.{0} a = a := lift_id'.{0 u} a

@[simp] theorem lift_lift (a : ordinal) : lift.{w} (lift.{v} a) = lift.{max v w} a :=
induction_on a $ λ α r _,
quotient.sound ⟨(rel_iso.preimage equiv.ulift _).trans $
  (rel_iso.preimage equiv.ulift _).trans (rel_iso.preimage equiv.ulift _).symm⟩

theorem lift_type_le {α : Type u} {β : Type v} {r s} [is_well_order α r] [is_well_order β s] :
  lift.{max v w} (type r) ≤ lift.{max u w} (type s) ↔ nonempty (r ≼i s) :=
⟨λ ⟨f⟩, ⟨(initial_seg.of_iso (rel_iso.preimage equiv.ulift r).symm).trans $
    f.trans (initial_seg.of_iso (rel_iso.preimage equiv.ulift s))⟩,
 λ ⟨f⟩, ⟨(initial_seg.of_iso (rel_iso.preimage equiv.ulift r)).trans $
    f.trans (initial_seg.of_iso (rel_iso.preimage equiv.ulift s).symm)⟩⟩

theorem lift_type_eq {α : Type u} {β : Type v} {r s} [is_well_order α r] [is_well_order β s] :
  lift.{max v w} (type r) = lift.{max u w} (type s) ↔ nonempty (r ≃r s) :=
quotient.eq.trans
⟨λ ⟨f⟩, ⟨(rel_iso.preimage equiv.ulift r).symm.trans $
    f.trans (rel_iso.preimage equiv.ulift s)⟩,
 λ ⟨f⟩, ⟨(rel_iso.preimage equiv.ulift r).trans $
    f.trans (rel_iso.preimage equiv.ulift s).symm⟩⟩

theorem lift_type_lt {α : Type u} {β : Type v} {r s} [is_well_order α r] [is_well_order β s] :
  lift.{max v w} (type r) < lift.{max u w} (type s) ↔ nonempty (r ≺i s) :=
by haveI := @rel_embedding.is_well_order _ _ (@equiv.ulift.{max v w} α ⁻¹'o r)
     r (rel_iso.preimage equiv.ulift.{max v w} r) _;
   haveI := @rel_embedding.is_well_order _ _ (@equiv.ulift.{max u w} β ⁻¹'o s)
     s (rel_iso.preimage equiv.ulift.{max u w} s) _; exact
⟨λ ⟨f⟩, ⟨(f.equiv_lt (rel_iso.preimage equiv.ulift r).symm).lt_le
    (initial_seg.of_iso (rel_iso.preimage equiv.ulift s))⟩,
 λ ⟨f⟩, ⟨(f.equiv_lt (rel_iso.preimage equiv.ulift r)).lt_le
    (initial_seg.of_iso (rel_iso.preimage equiv.ulift s).symm)⟩⟩

@[simp] theorem lift_le {a b : ordinal} : lift.{u v} a ≤ lift b ↔ a ≤ b :=
induction_on a $ λ α r _, induction_on b $ λ β s _, by { rw ← lift_umax, exactI lift_type_le }

@[simp] theorem lift_inj {a b : ordinal} : lift a = lift b ↔ a = b :=
by simp only [le_antisymm_iff, lift_le]

@[simp] theorem lift_lt {a b : ordinal} : lift a < lift b ↔ a < b :=
by simp only [lt_iff_le_not_le, lift_le]

@[simp] theorem lift_zero : lift 0 = 0 := type_eq_zero_of_empty _
@[simp] theorem lift_one : lift 1 = 1 := type_eq_one_of_unique _

@[simp] theorem lift_card (a) : (card a).lift = card (lift a) :=
induction_on a $ λ α r _, rfl

theorem lift_down' {a : cardinal.{u}} {b : ordinal.{max u v}}
  (h : card b ≤ a.lift) : ∃ a', lift a' = b :=
let ⟨c, e⟩ := cardinal.lift_down h in
cardinal.induction_on c (λ α, induction_on b $ λ β s _ e', begin
  resetI,
  rw [card_type, ← cardinal.lift_id'.{(max u v) u} (#β),
      ← cardinal.lift_umax.{u v}, lift_mk_eq.{u (max u v) (max u v)}] at e',
  cases e' with f,
  have g := rel_iso.preimage f s,
  haveI := (g : ⇑f ⁻¹'o s ↪r s).is_well_order,
  have := lift_type_eq.{u (max u v) (max u v)}.2 ⟨g⟩,
  rw [lift_id, lift_umax.{u v}] at this,
  exact ⟨_, this⟩
end) e

theorem lift_down {a : ordinal.{u}} {b : ordinal.{max u v}}
  (h : b ≤ lift a) : ∃ a', lift a' = b :=
@lift_down' (card a) _ (by rw lift_card; exact card_le_card h)

theorem lt_lift_iff {a : ordinal.{u}} {b : ordinal.{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⟩

/-- Initial segment version of the lift operation on ordinals, embedding `ordinal.{u}` in
  `ordinal.{v}` as an initial segment when `u ≤ v`. -/
def lift.initial_seg : @initial_seg ordinal.{u} ordinal.{max u v} (<) (<) :=
⟨⟨⟨lift.{v}, λ a b, lift_inj.1⟩, λ a b, lift_lt⟩,
  λ a b h, lift_down (le_of_lt h)⟩

@[simp] theorem lift.initial_seg_coe : (lift.initial_seg : ordinal → ordinal) = lift := rfl

/-! ### The first infinite ordinal `omega` -/

/-- `ω` is the first infinite ordinal, defined as the order type of `ℕ`. -/
def omega : ordinal.{u} := lift $ @type ℕ (<) _

localized "notation (name := ordinal.omega) `ω` := ordinal.omega" in ordinal

/-- Note that the presence of this lemma makes `simp [omega]` form a loop. -/
@[simp] theorem type_nat_lt : @type ℕ (<) _ = ω := (lift_id _).symm

@[simp] theorem card_omega : card ω = ℵ₀ := rfl

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

/-!
### Definition and first properties of addition on ordinals

In this paragraph, we introduce the addition on ordinals, and prove just enough properties to
deduce that the order on ordinals is total (and therefore well-founded). Further properties of
the addition, together with properties of the other operations, are proved in
`ordinal_arithmetic.lean`.
-/

/-- `o₁ + o₂` is the order on the disjoint union of `o₁` and `o₂` obtained by declaring that
  every element of `o₁` is smaller than every element of `o₂`. -/
instance : has_add ordinal.{u} :=
⟨λ o₁ o₂, quotient.lift_on₂ o₁ o₂
  (λ ⟨α, r, wo⟩ ⟨β, s, wo'⟩, by exactI type (sum.lex r s)) $
  λ ⟨α₁, r₁, o₁⟩ ⟨α₂, r₂, o₂⟩ ⟨β₁, s₁, p₁⟩ ⟨β₂, s₂, p₂⟩ ⟨f⟩ ⟨g⟩,
  quot.sound ⟨rel_iso.sum_lex_congr f g⟩⟩

instance : add_monoid_with_one ordinal.{u} :=
{ add       := (+),
  zero      := 0,
  one       := 1,
  zero_add  := λ o, induction_on o $ λ α r _, eq.symm $ quotient.sound
    ⟨⟨(empty_sum pempty α).symm, λ a b, sum.lex_inr_inr⟩⟩,
  add_zero  := λ o, induction_on o $ λ α r _, eq.symm $ quotient.sound
    ⟨⟨(sum_empty α pempty).symm, λ a b, sum.lex_inl_inl⟩⟩,
  add_assoc := λ o₁ o₂ o₃, quotient.induction_on₃ o₁ o₂ o₃ $
    λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨γ, t, _⟩, quot.sound
    ⟨⟨sum_assoc _ _ _, λ a b,
    begin rcases a with ⟨a|a⟩|a; rcases b with ⟨b|b⟩|b;
      simp only [sum_assoc_apply_inl_inl, sum_assoc_apply_inl_inr, sum_assoc_apply_inr,
        sum.lex_inl_inl, sum.lex_inr_inr, sum.lex.sep, sum.lex_inr_inl] end⟩⟩ }

@[simp] theorem card_add (o₁ o₂ : ordinal) : card (o₁ + o₂) = card o₁ + card o₂ :=
induction_on o₁ $ λ α r _, induction_on o₂ $ λ β s _, rfl

@[simp] theorem type_sum_lex {α β : Type u} (r : α → α → Prop) (s : β → β → Prop)
  [is_well_order α r] [is_well_order β s] : type (sum.lex r s) = type r + type s := rfl

@[simp] theorem card_nat (n : ℕ) : card.{u} n = n :=
by induction n; [refl, simp only [card_add, card_one, nat.cast_succ, *]]

instance add_covariant_class_le : covariant_class ordinal.{u} ordinal.{u} (+) (≤) :=
⟨λ c a b h, begin
  revert h c, exact (
  induction_on a $ λ α₁ r₁ _, induction_on b $ λ α₂ r₂ _ ⟨⟨⟨f, fo⟩, fi⟩⟩ c,
  induction_on c $ λ β s _,
  ⟨⟨⟨(embedding.refl _).sum_map f,
    λ a b, match a, b with
      | sum.inl a, sum.inl b := sum.lex_inl_inl.trans sum.lex_inl_inl.symm
      | sum.inl a, sum.inr b := by apply iff_of_true; apply sum.lex.sep
      | sum.inr a, sum.inl b := by apply iff_of_false; exact sum.lex_inr_inl
      | sum.inr a, sum.inr b := sum.lex_inr_inr.trans $ fo.trans sum.lex_inr_inr.symm
      end⟩,
    λ a b H, match a, b, H with
      | _,         sum.inl b, _ := ⟨sum.inl b, rfl⟩
      | sum.inl a, sum.inr b, H := (sum.lex_inr_inl H).elim
      | sum.inr a, sum.inr b, H := let ⟨w, h⟩ := fi _ _ (sum.lex_inr_inr.1 H) in
          ⟨sum.inr w, congr_arg sum.inr h⟩
    end⟩⟩)
end⟩

instance add_swap_covariant_class_le : covariant_class ordinal.{u} ordinal.{u} (swap (+)) (≤) :=
⟨λ c a b h, begin
  revert h c, exact (
  induction_on a $ λ α₁ r₁ hr₁, induction_on b $ λ α₂ r₂ hr₂ ⟨⟨⟨f, fo⟩, fi⟩⟩ c,
  induction_on c $ λ β s hs, by exactI
  @rel_embedding.ordinal_type_le _ _ (sum.lex r₁ s) (sum.lex r₂ s) _ _
  ⟨f.sum_map (embedding.refl _), λ a b, begin
    split; intro H,
    { cases a with a a; cases b with b b; cases H; constructor; [rwa ← fo, assumption] },
    { cases H; constructor; [rwa fo, assumption] }
  end⟩)
end⟩

theorem le_add_right (a b : ordinal) : a ≤ a + b :=
by simpa only [add_zero] using add_le_add_left (ordinal.zero_le b) a

theorem le_add_left (a b : ordinal) : a ≤ b + a :=
by simpa only [zero_add] using add_le_add_right (ordinal.zero_le b) a

instance : linear_order ordinal :=
{ le_total     := λ a b,
    match lt_or_eq_of_le (le_add_left b a), lt_or_eq_of_le (le_add_right a b) with
    | or.inr h, _ := by rw h; exact or.inl (le_add_right _ _)
    | _, or.inr h := by rw h; exact or.inr (le_add_left _ _)
    | or.inl h₁, or.inl h₂ := induction_on a (λ α₁ r₁ _,
      induction_on b $ λ α₂ r₂ _ ⟨f⟩ ⟨g⟩, begin
        resetI,
        rw [← typein_top f, ← typein_top g, le_iff_lt_or_eq,
            le_iff_lt_or_eq, typein_lt_typein, typein_lt_typein],
        rcases trichotomous_of (sum.lex r₁ r₂) g.top f.top with h|h|h;
        [exact or.inl (or.inl h), {left, right, rw h}, exact or.inr (or.inl h)]
      end) h₁ h₂
    end,
  decidable_le := classical.dec_rel _,
  ..ordinal.partial_order }

instance : well_founded_lt ordinal := ⟨lt_wf⟩
instance : is_well_order ordinal (<) := { }

instance : conditionally_complete_linear_order_bot ordinal :=
is_well_order.conditionally_complete_linear_order_bot _

@[simp] lemma max_zero_left : ∀ a : ordinal, max 0 a = a := max_bot_left
@[simp] lemma max_zero_right : ∀ a : ordinal, max a 0 = a := max_bot_right
@[simp] lemma max_eq_zero {a b : ordinal} : max a b = 0 ↔ a = 0 ∧ b = 0 := max_eq_bot

@[simp] theorem Inf_empty : Inf (∅ : set ordinal) = 0 :=
dif_neg not_nonempty_empty

/- ### Successor order properties -/

private theorem succ_le_iff' {a b : ordinal} : a + 1 ≤ b ↔ a < b :=
⟨lt_of_lt_of_le (induction_on a $ λ α r _, ⟨⟨⟨⟨λ x, sum.inl x, λ _ _, sum.inl.inj⟩,
  λ _ _, sum.lex_inl_inl⟩,
  sum.inr punit.star, λ b, sum.rec_on b
    (λ x, ⟨λ _, ⟨x, rfl⟩, λ _, sum.lex.sep _ _⟩)
    (λ x, sum.lex_inr_inr.trans ⟨false.elim, λ ⟨x, H⟩, sum.inl_ne_inr H⟩)⟩⟩),
induction_on a $ λ α r hr, induction_on b $ λ β s hs ⟨⟨f, t, hf⟩⟩, begin
  haveI := hs,
  refine ⟨⟨@rel_embedding.of_monotone (α ⊕ punit) β _ _ _ _ (sum.rec _ _) (λ a b, _), λ a b, _⟩⟩,
  { exact f }, { exact λ _, t },
  { rcases a with a|_; rcases b with b|_,
    { simpa only [sum.lex_inl_inl] using f.map_rel_iff.2 },
    { intro _, rw hf, exact ⟨_, rfl⟩ },
    { exact false.elim ∘ sum.lex_inr_inl },
    { exact false.elim ∘ sum.lex_inr_inr.1 } },
  { rcases a with a|_,
    { intro h, have := @principal_seg.init _ _ _ _ _ ⟨f, t, hf⟩ _ _ h,
      cases this with w h, exact ⟨sum.inl w, h⟩ },
    { intro h, cases (hf b).1 h with w h, exact ⟨sum.inl w, h⟩ } }
end⟩

instance : no_max_order ordinal := ⟨λ a, ⟨_, succ_le_iff'.1 le_rfl⟩⟩

instance : succ_order ordinal.{u} := succ_order.of_succ_le_iff (λ o, o + 1) (λ a b, succ_le_iff')

@[simp] theorem add_one_eq_succ (o : ordinal) : o + 1 = succ o := rfl

@[simp] theorem succ_zero : succ (0 : ordinal) = 1 := zero_add 1
@[simp] theorem succ_one : succ (1 : ordinal) = 2 := rfl

theorem add_succ (o₁ o₂ : ordinal) : o₁ + succ o₂ = succ (o₁ + o₂) :=
(add_assoc _ _ _).symm

theorem one_le_iff_pos {o : ordinal} : 1 ≤ o ↔ 0 < o :=
by rw [← succ_zero, succ_le_iff]

theorem one_le_iff_ne_zero {o : ordinal} : 1 ≤ o ↔ o ≠ 0 :=
by rw [one_le_iff_pos, ordinal.pos_iff_ne_zero]

theorem succ_pos (o : ordinal) : 0 < succ o := bot_lt_succ o
theorem succ_ne_zero (o : ordinal) : succ o ≠ 0 := ne_of_gt $ succ_pos o
theorem lt_one_iff_zero {a : ordinal} : a < 1 ↔ a = 0 := by simpa using @lt_succ_bot_iff _ _ _ a _ _
theorem le_one_iff {a : ordinal} : a ≤ 1 ↔ a = 0 ∨ a = 1 :=
by simpa using @le_succ_bot_iff _ _ _ a _

@[simp] theorem card_succ (o : ordinal) : card (succ o) = card o + 1 :=
by simp only [←add_one_eq_succ, card_add, card_one]

theorem nat_cast_succ (n : ℕ) : ↑n.succ = succ (n : ordinal) := rfl

instance unique_Iio_one : unique (Iio (1 : ordinal)) :=
{ default := ⟨0, zero_lt_one⟩,
  uniq := λ a, subtype.ext $ lt_one_iff_zero.1 a.prop }

instance unique_out_one : unique (1 : ordinal).out.α :=
{ default := enum (<) 0 (by simp),
  uniq := λ a, begin
    rw ←enum_typein (<) a,
    unfold default,
    congr,
    rw ←lt_one_iff_zero,
    apply typein_lt_self
  end }

theorem one_out_eq (x : (1 : ordinal).out.α) : x = enum (<) 0 (by simp) := unique.eq_default x

/-! ### Extra properties of typein and enum -/

@[simp] theorem typein_one_out (x : (1 : ordinal).out.α) : typein (<) x = 0 :=
by rw [one_out_eq x, typein_enum]

@[simp] lemma typein_le_typein (r : α → α → Prop) [is_well_order α r] {x x' : α} :
  typein r x ≤ typein r x' ↔ ¬r x' x :=
by rw [←not_lt, typein_lt_typein]

@[simp] lemma typein_le_typein' (o : ordinal) {x x' : o.out.α} :
  typein (<) x ≤ typein (<) x' ↔ x ≤ x' :=
by { rw typein_le_typein, exact not_lt }

@[simp] lemma enum_le_enum (r : α → α → Prop) [is_well_order α r] {o o' : ordinal}
  (ho : o < type r) (ho' : o' < type r) : ¬r (enum r o' ho') (enum r o ho) ↔ o ≤ o' :=
by rw [←@not_lt _ _ o' o, enum_lt_enum ho']

@[simp] lemma enum_le_enum' (a : ordinal) {o o' : ordinal}
  (ho : o < type (<)) (ho' : o' < type (<)) : enum (<) o ho ≤ @enum a.out.α (<) _ o' ho' ↔ o ≤ o' :=
by rw [←enum_le_enum (<), ←not_lt]

theorem enum_zero_le {r : α → α → Prop} [is_well_order α r] (h0 : 0 < type r) (a : α) :
  ¬ r a (enum r 0 h0) :=
by { rw [←enum_typein r a, enum_le_enum r], apply ordinal.zero_le }

theorem enum_zero_le' {o : ordinal} (h0 : 0 < o) (a : o.out.α) :
  @enum o.out.α (<) _ 0 (by rwa type_lt) ≤ a :=
by { rw ←not_lt, apply enum_zero_le }

theorem le_enum_succ {o : ordinal} (a : (succ o).out.α) :
  a ≤ @enum (succ o).out.α (<) _ o (by { rw type_lt, exact lt_succ o }) :=
by { rw [←enum_typein (<) a, enum_le_enum', ←lt_succ_iff], apply typein_lt_self }

@[simp] theorem enum_inj {r : α → α → Prop} [is_well_order α r] {o₁ o₂ : ordinal} (h₁ : o₁ < type r)
  (h₂ : o₂ < type r) : enum r o₁ h₁ = enum r o₂ h₂ ↔ o₁ = o₂ :=
⟨λ h, begin
  by_contra hne,
  cases lt_or_gt_of_ne hne with hlt hlt;
    apply (is_well_order.is_irrefl r).1,
    { rwa [←@enum_lt_enum α r _ o₁ o₂ h₁ h₂, h] at hlt },
    { change _ < _ at hlt, rwa [←@enum_lt_enum α r _ o₂ o₁ h₂ h₁, h] at hlt }
end, λ h, by simp_rw h⟩

/-- A well order `r` is order isomorphic to the set of ordinals smaller than `type r`. -/
@[simps] def enum_iso (r : α → α → Prop) [is_well_order α r] : subrel (<) (< type r) ≃r r :=
{ to_fun := λ x, enum r x.1 x.2,
  inv_fun := λ x, ⟨typein r x, typein_lt_type r x⟩,
  left_inv := λ ⟨o, h⟩, subtype.ext_val (typein_enum _ _),
  right_inv := λ h, enum_typein _ _,
  map_rel_iff' := by { rintros ⟨a, _⟩ ⟨b, _⟩, apply enum_lt_enum } }

/-- The order isomorphism between ordinals less than `o` and `o.out.α`. -/
@[simps] noncomputable def enum_iso_out (o : ordinal) : set.Iio o ≃o o.out.α :=
{ to_fun := λ x, enum (<) x.1 $ by { rw type_lt, exact x.2 },
  inv_fun := λ x, ⟨typein (<) x, typein_lt_self x⟩,
  left_inv := λ ⟨o', h⟩, subtype.ext_val (typein_enum _ _),
  right_inv := λ h, enum_typein _ _,
  map_rel_iff' := by { rintros ⟨a, _⟩ ⟨b, _⟩, apply enum_le_enum' } }

/-- `o.out.α` is an `order_bot` whenever `0 < o`. -/
def out_order_bot_of_pos {o : ordinal} (ho : 0 < o) : order_bot o.out.α :=
⟨_, enum_zero_le' ho⟩

theorem enum_zero_eq_bot {o : ordinal} (ho : 0 < o) :
  enum (<) 0 (by rwa type_lt) = by { haveI H := out_order_bot_of_pos ho, exact ⊥ } :=
rfl

/-! ### Universal ordinal -/

/-- `univ.{u v}` is the order type of the ordinals of `Type u` as a member
  of `ordinal.{v}` (when `u < v`). It is an inaccessible cardinal. -/
@[nolint check_univs] -- intended to be used with explicit universe parameters
def univ : ordinal.{max (u + 1) v} := lift.{v (u+1)} (@type ordinal (<) _)

theorem univ_id : univ.{u (u+1)} = @type ordinal (<) _ := lift_id _

@[simp] theorem lift_univ : lift.{w} univ.{u v} = univ.{u (max v w)} := lift_lift _

theorem univ_umax : univ.{u (max (u+1) v)} = univ.{u v} := congr_fun lift_umax _

/-- Principal segment version of the lift operation on ordinals, embedding `ordinal.{u}` in
  `ordinal.{v}` as a principal segment when `u < v`. -/
def lift.principal_seg : @principal_seg ordinal.{u} ordinal.{max (u+1) v} (<) (<) :=
⟨↑lift.initial_seg.{u (max (u+1) v)}, univ.{u v}, begin
  refine λ b, induction_on b _, introsI β s _,
  rw [univ, ← lift_umax], split; intro h,
  { rw ← lift_id (type s) at h ⊢,
    cases lift_type_lt.1 h with f, cases f with f a hf,
    existsi a, revert hf,
    apply induction_on a, introsI α r _ hf,
    refine lift_type_eq.{u (max (u+1) v) (max (u+1) v)}.2
      ⟨(rel_iso.of_surjective (rel_embedding.of_monotone _ _) _).symm⟩,
    { exact λ b, enum r (f b) ((hf _).2 ⟨_, rfl⟩) },
    { refine λ a b h, (typein_lt_typein r).1 _,
      rw [typein_enum, typein_enum],
      exact f.map_rel_iff.2 h },
    { intro a', cases (hf _).1 (typein_lt_type _ a') with b e,
      existsi b, simp, simp [e] } },
  { cases h with a e, rw [← e],
    apply induction_on a, introsI α r _,
    exact lift_type_lt.{u (u+1) (max (u+1) v)}.2
      ⟨typein.principal_seg r⟩ }
end⟩

@[simp] theorem lift.principal_seg_coe :
  (lift.principal_seg.{u v} : ordinal → ordinal) = lift.{max (u+1) v} := rfl

@[simp] theorem lift.principal_seg_top : lift.principal_seg.top = univ := rfl

theorem lift.principal_seg_top' :
  lift.principal_seg.{u (u+1)}.top = @type ordinal (<) _ :=
by simp only [lift.principal_seg_top, univ_id]

end ordinal

/-! ### Representing a cardinal with an ordinal -/

namespace cardinal
open ordinal

@[simp] theorem mk_ordinal_out (o : ordinal) : #(o.out.α) = o.card :=
(ordinal.card_type _).symm.trans $ by rw ordinal.type_lt

/-- The ordinal corresponding to a cardinal `c` is the least ordinal
  whose cardinal is `c`. For the order-embedding version, see `ord.order_embedding`. -/
def ord (c : cardinal) : ordinal :=
let F := λ α : Type u, ⨅ r : {r // is_well_order α r}, @type α r.1 r.2 in
quot.lift_on c F
begin
  suffices : ∀ {α β}, α ≈ β → F α ≤ F β,
  from λ α β h, (this h).antisymm (this (setoid.symm h)),
  rintros α β ⟨f⟩,
  refine le_cinfi_iff'.2 (λ i, _),
  haveI := @rel_embedding.is_well_order _ _ (f ⁻¹'o i.1) _ ↑(rel_iso.preimage f i.1) i.2,
  exact (cinfi_le' _ (subtype.mk (⇑f ⁻¹'o i.val)
    (@rel_embedding.is_well_order _ _  _ _ ↑(rel_iso.preimage f i.1) i.2))).trans_eq
    (quot.sound ⟨rel_iso.preimage f i.1⟩)
end

lemma ord_eq_Inf (α : Type u) : ord (#α) = ⨅ r : {r // is_well_order α r}, @type α r.1 r.2 :=
rfl

theorem ord_eq (α) : ∃ (r : α → α → Prop) [wo : is_well_order α r], ord (#α) = @type α r wo :=
let ⟨r, wo⟩ := infi_mem (λ r : {r // is_well_order α r}, @type α r.1 r.2) in ⟨r.1, r.2, wo.symm⟩

theorem ord_le_type (r : α → α → Prop) [h : is_well_order α r] : ord (#α) ≤ type r :=
cinfi_le' _ (subtype.mk r h)

theorem ord_le {c o} : ord c ≤ o ↔ c ≤ o.card :=
induction_on c $ λ α, ordinal.induction_on o $ λ β s _,
let ⟨r, _, e⟩ := ord_eq α in begin
  resetI, simp only [card_type], split; intro h,
  { rw e at h, exact let ⟨f⟩ := h in ⟨f.to_embedding⟩ },
  { cases h with f,
    have g := rel_embedding.preimage f s,
    haveI := rel_embedding.is_well_order g,
    exact le_trans (ord_le_type _) g.ordinal_type_le }
end

theorem gc_ord_card : galois_connection ord card := λ _ _, ord_le

theorem lt_ord {c o} : o < ord c ↔ o.card < c := gc_ord_card.lt_iff_lt

@[simp] theorem card_ord (c) : (ord c).card = c :=
quotient.induction_on c $ λ α,
let ⟨r, _, e⟩ := ord_eq α in by simp only [mk_def, e, card_type]

/-- Galois coinsertion between `cardinal.ord` and `ordinal.card`. -/
def gci_ord_card : galois_coinsertion ord card :=
gc_ord_card.to_galois_coinsertion $ λ c, c.card_ord.le

theorem ord_card_le (o : ordinal) : o.card.ord ≤ o := gc_ord_card.l_u_le _

lemma lt_ord_succ_card (o : ordinal) : o < (succ o.card).ord := lt_ord.2 $ lt_succ _

@[mono] theorem ord_strict_mono : strict_mono ord := gci_ord_card.strict_mono_l
@[mono] theorem ord_mono : monotone ord := gc_ord_card.monotone_l

@[simp] theorem ord_le_ord {c₁ c₂} : ord c₁ ≤ ord c₂ ↔ c₁ ≤ c₂ := gci_ord_card.l_le_l_iff
@[simp] theorem ord_lt_ord {c₁ c₂} : ord c₁ < ord c₂ ↔ c₁ < c₂ := ord_strict_mono.lt_iff_lt
@[simp] theorem ord_zero : ord 0 = 0 := gc_ord_card.l_bot

@[simp] theorem ord_nat (n : ℕ) : ord n = n :=
(ord_le.2 (card_nat n).ge).antisymm begin
  induction n with n IH,
  { apply ordinal.zero_le },
  { exact succ_le_of_lt (IH.trans_lt $ ord_lt_ord.2 $ nat_cast_lt.2 (nat.lt_succ_self n)) }
end

@[simp] theorem ord_one : ord 1 = 1 :=
by simpa using ord_nat 1

@[simp] theorem lift_ord (c) : (ord c).lift = ord (lift c) :=
begin
  refine le_antisymm (le_of_forall_lt (λ a ha, _)) _,
  { rcases ordinal.lt_lift_iff.1 ha with ⟨a, rfl, h⟩,
    rwa [lt_ord, ← lift_card, lift_lt, ← lt_ord, ← ordinal.lift_lt] },
  { rw [ord_le, ← lift_card, card_ord] }
end

lemma mk_ord_out (c : cardinal) : #c.ord.out.α = c := by simp

lemma card_typein_lt (r : α → α → Prop) [is_well_order α r] (x : α)
  (h : ord (#α) = type r) : card (typein r x) < #α :=
by { rw [←lt_ord, h], apply typein_lt_type }

lemma card_typein_out_lt (c : cardinal) (x : c.ord.out.α) : card (typein (<) x) < c :=
by { rw ←lt_ord, apply typein_lt_self }

lemma ord_injective : injective ord :=
by { intros c c' h, rw [←card_ord c, ←card_ord c', h] }

/-- The ordinal corresponding to a cardinal `c` is the least ordinal
  whose cardinal is `c`. This is the order-embedding version. For the regular function, see `ord`.
-/
def ord.order_embedding : cardinal ↪o ordinal :=
rel_embedding.order_embedding_of_lt_embedding
  (rel_embedding.of_monotone cardinal.ord $ λ a b, cardinal.ord_lt_ord.2)

@[simp] theorem ord.order_embedding_coe :
  (ord.order_embedding : cardinal → ordinal) = ord := rfl

/-- The cardinal `univ` is the cardinality of ordinal `univ`, or
  equivalently the cardinal of `ordinal.{u}`, or `cardinal.{u}`,
  as an element of `cardinal.{v}` (when `u < v`). -/
@[nolint check_univs] -- intended to be used with explicit universe parameters
def univ := lift.{v (u+1)} (#ordinal)

theorem univ_id : univ.{u (u+1)} = #ordinal := lift_id _

@[simp] theorem lift_univ : lift.{w} univ.{u v} = univ.{u (max v w)} := lift_lift _

theorem univ_umax : univ.{u (max (u+1) v)} = univ.{u v} := congr_fun lift_umax _

theorem lift_lt_univ (c : cardinal) : lift.{(u+1) u} c < univ.{u (u+1)} :=
by simpa only [lift.principal_seg_coe, lift_ord, lift_succ, ord_le, succ_le_iff] using le_of_lt
  (lift.principal_seg.{u (u+1)}.lt_top (succ c).ord)

theorem lift_lt_univ' (c : cardinal) : lift.{(max (u+1) v) u} c < univ.{u v} :=
by simpa only [lift_lift, lift_univ, univ_umax] using
  lift_lt.{_ (max (u+1) v)}.2 (lift_lt_univ c)

@[simp] theorem ord_univ : ord univ.{u v} = ordinal.univ.{u v} :=
le_antisymm (ord_card_le _) $ le_of_forall_lt $ λ o h,
lt_ord.2 begin
  rcases lift.principal_seg.{u v}.down.1
    (by simpa only [lift.principal_seg_coe] using h) with ⟨o', rfl⟩,
  simp only [lift.principal_seg_coe], rw [← lift_card],
  apply lift_lt_univ'
end

theorem lt_univ {c} : c < univ.{u (u+1)} ↔ ∃ c', c = lift.{(u+1) u} c' :=
⟨λ h, begin
  have := ord_lt_ord.2 h,
  rw ord_univ at this,
  cases lift.principal_seg.{u (u+1)}.down.1
    (by simpa only [lift.principal_seg_top]) with o e,
  have := card_ord c,
  rw [← e, lift.principal_seg_coe, ← lift_card] at this,
  exact ⟨_, this.symm⟩
end, λ ⟨c', e⟩, e.symm ▸ lift_lt_univ _⟩

theorem lt_univ' {c} : c < univ.{u v} ↔ ∃ c', c = lift.{(max (u+1) v) u} c' :=
⟨λ h, let ⟨a, e, h'⟩ := lt_lift_iff.1 h in begin
  rw [← univ_id] at h',
  rcases lt_univ.{u}.1 h' with ⟨c', rfl⟩,
  exact ⟨c', by simp only [e.symm, lift_lift]⟩
end, λ ⟨c', e⟩, e.symm ▸ lift_lt_univ' _⟩

theorem small_iff_lift_mk_lt_univ {α : Type u} :
  small.{v} α ↔ cardinal.lift (#α) < univ.{v (max u (v + 1))} :=
begin
  rw lt_univ',
  split,
  { rintro ⟨β, e⟩,
    exact ⟨#β, lift_mk_eq.{u _ (v + 1)}.2 e⟩ },
  { rintro ⟨c, hc⟩,
    exact ⟨⟨c.out, lift_mk_eq.{u _ (v + 1)}.1 (hc.trans (congr rfl c.mk_out.symm))⟩⟩ }
end

end cardinal

namespace ordinal

@[simp] theorem card_univ : card univ = cardinal.univ := rfl

@[simp] theorem nat_le_card {o} {n : ℕ} : (n : cardinal) ≤ card o ↔ (n : ordinal) ≤ o :=
by rw [← cardinal.ord_le, cardinal.ord_nat]

@[simp] theorem nat_lt_card {o} {n : ℕ} : (n : cardinal) < card o ↔ (n : ordinal) < o :=
by { rw [←succ_le_iff, ←succ_le_iff, ←nat_succ, nat_le_card], refl }

@[simp] theorem card_lt_nat {o} {n : ℕ} : card o < n ↔ o < n :=
lt_iff_lt_of_le_iff_le nat_le_card

@[simp] theorem card_le_nat {o} {n : ℕ} : card o ≤ n ↔ o ≤ n :=
le_iff_le_iff_lt_iff_lt.2 nat_lt_card

@[simp] theorem card_eq_nat {o} {n : ℕ} : card o = n ↔ o = n :=
by simp only [le_antisymm_iff, card_le_nat, nat_le_card]

@[simp] theorem type_fintype (r : α → α → Prop) [is_well_order α r] [fintype α] :
  type r = fintype.card α :=
by rw [←card_eq_nat, card_type, mk_fintype]

theorem type_fin (n : ℕ) : @type (fin n) (<) _ = n := by simp

end ordinal


import subgroup_world.subgroup_inv -- hide

variables {G : Type} [group G] {H : set G} -- hide

/-
## The inverse of an element is in the group (II)

The following variation is useful because since it is an `↔` statement, it can be `rw`ritten.
-/
/- Symbol:
↔ : \iff
∈ : \in
x⁻¹ : x\-1
-/
/- Lemma:
If $H\leq G$, then $x \in H$ if and only if $x^{-1} \in H$.
-/
lemma subgroup.inv_mem  [h : subgroup H] (x : G) : x ∈ H ↔ x⁻¹ ∈ H :=
begin
  split,
  {
    apply subgroup.inv_mem',
  },
  {
    intro hg,
    rw show x = x⁻¹⁻¹, by group,
    apply subgroup.inv_mem',
    assumption,
  }

end


import Lean

open Lean
open Lean.Meta
open Lean.Elab.Tactic

universe u
axiom elimEx (motive : Nat → Nat → Sort u) (x y : Nat)
  (diag  : (a : Nat) → motive a a)
  (upper : (delta a : Nat) → motive a (a + delta.succ))
  (lower : (delta a : Nat) → motive (a + delta.succ) a)
  : motive y x

theorem ex1 (p q : Nat) : p ≤ q ∨ p > q := by
  cases p, q using elimEx with
  | diag    => apply Or.inl; apply Nat.leRefl
  | lower d => apply Or.inl; show p ≤ p + d.succ; admit
  | upper d => apply Or.inr; show q + d.succ > q; admit

theorem ex2 (p q : Nat) : p ≤ q ∨ p > q := by
  cases p, q using elimEx
  case lower => admit
  case upper => admit
  case diag  => apply Or.inl; apply Nat.leRefl

axiom Nat.parityElim (motive : Nat → Sort u)
  (even : (n : Nat) → motive (2*n))
  (odd  : (n : Nat) → motive (2*n+1))
  (n : Nat)
  : motive n

theorem time2Eq (n : Nat) : 2*n = n + n := by
  rw [Nat.mul_comm]
  show (0 + n) + n = n+n
  simp

theorem ex3 (n : Nat) : Exists (fun m => n = m + m ∨ n = m + m + 1) := by
  cases n using Nat.parityElim with
  | even i =>
    apply Exists.intro i
    apply Or.inl
    rw [time2Eq]
  | odd i =>
    apply Exists.intro i
    apply Or.inr
    rw [time2Eq]

open Nat in
theorem ex3b (n : Nat) : Exists (fun m => n = m + m ∨ n = m + m + 1) := by
  cases n using parityElim with
  | even i =>
    apply Exists.intro i
    apply Or.inl
    rw [time2Eq]
  | odd i =>
    apply Exists.intro i
    apply Or.inr
    rw [time2Eq]

def ex4 {α} (xs : List α) (h : xs = [] → False) : α := by
  cases he:xs with
  | nil      => contradiction
  | cons x _ => exact x

def ex5 {α} (xs : List α) (h : xs = [] → False) : α := by
  cases he:xs using List.casesOn with
  | nil      => contradiction
  | cons x _ => exact x

theorem ex6 {α} (f : List α → Bool) (h₁ : {xs : List α} → f xs = true → xs = []) (xs : List α) (h₂ : xs ≠ []) : f xs = false :=
  match he:f xs with
  | true  => False.elim (h₂ (h₁ he))
  | false => rfl

theorem ex7 {α} (f : List α → Bool) (h₁ : {xs : List α} → f xs = true → xs = []) (xs : List α) (h₂ : xs ≠ []) : f xs = false := by
  cases he:f xs with
  | true  => exact False.elim (h₂ (h₁ he))
  | false => rfl

theorem ex8 {α} (f : List α → Bool) (h₁ : {xs : List α} → f xs = true → xs = []) (xs : List α) (h₂ : xs ≠ []) : f xs = false := by
  cases he:f xs using Bool.casesOn with
  | true  => exact False.elim (h₂ (h₁ he))
  | false => rfl

theorem ex9 (xs : List α) (h : xs = [] → False) : Nonempty α := by
  cases xs using List.rec with
  | nil      => contradiction
  | cons x _ => apply Nonempty.intro; assumption

theorem modLt (x : Nat) {y : Nat} (h : y > 0) : x % y < y := by
  induction x, y using Nat.mod.inductionOn with
  | ind x y h₁ ih =>
    rw [Nat.mod_eq_sub_mod h₁.2]
    exact ih h
  | base x y h₁ =>
    match Iff.mp (Decidable.notAndIffOrNot ..) h₁ with
    | Or.inl h₁ => contradiction
    | Or.inr h₁ =>
      have hgt := Nat.gtOfNotLe h₁
      have heq := Nat.mod_eq_of_lt hgt
      rw [← heq] at hgt
      assumption

theorem ex11 {p q : Prop } (h : p ∨ q) : q ∨ p := by
  induction h using Or.casesOn with
  | inr h  => ?myright
  | inl h  => ?myleft
  case myleft  => exact Or.inr h
  case myright => exact Or.inl h

theorem ex12 {p q : Prop } (h : p ∨ q) : q ∨ p := by
  cases h using Or.casesOn with
  | inr h  => ?myright
  | inl h  => ?myleft
  case myleft  => exact Or.inr h
  case myright => exact Or.inl h

theorem ex13 (p q : Nat) : p ≤ q ∨ p > q := by
  cases p, q using elimEx with
  | diag    => ?hdiag
  | lower d => ?hlower
  | upper d => ?hupper
  case hdiag  => apply Or.inl; apply Nat.leRefl
  case hlower => apply Or.inl; show p ≤ p + d.succ; admit
  case hupper => apply Or.inr; show q + d.succ > q; admit

theorem ex14 (p q : Nat) : p ≤ q ∨ p > q := by
  cases p, q using elimEx with
  | diag    => ?hdiag
  | lower d => _
  | upper d => ?hupper
  case hdiag  => apply Or.inl; apply Nat.leRefl
  case lower => apply Or.inl; show p ≤ p + d.succ; admit
  case hupper => apply Or.inr; show q + d.succ > q; admit

theorem ex15 (p q : Nat) : p ≤ q ∨ p > q := by
  cases p, q using elimEx with
  | diag    => ?hdiag
  | lower d => _
  | upper d => ?hupper
  { apply Or.inl; apply Nat.leRefl }
  { apply Or.inr; show q + d.succ > q; admit }
  { apply Or.inl; show p ≤ p + d.succ; admit }

theorem ex16 {p q : Prop} (h : p ∨ q) : q ∨ p := by
  induction h
  case inl h' => exact Or.inr h'
  case inr h' => exact Or.inl h'

theorem ex17 (n : Nat) : 0 + n = n := by
  induction n
  case zero => rfl
  case succ m ih =>
    show Nat.succ (0 + m) = Nat.succ m
    rw [ih]