/- Copyright (c) 2015 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Jeremy Avigad Two sets are equinumerous, or equipollent, if there is a bijection between them. It is sometimes said that two such sets "have the same cardinality." -/ import .classical_inverse data.nat open eq.ops classical nat /- two versions of Cantor's theorem -/ namespace set variables {X : Type} {A : set X} theorem not_surj_on_pow (f : X β set X) : Β¬ surj_on f A (π« A) := let diag := {x β A | x β f x} in have diag β A, from sep_subset _ _, assume H : surj_on f A (π« A), obtain x [(xA : x β A) (Hx : f x = diag)], from H `diag β A`, have x β f x, from suppose x β f x, have x β diag, from Hx βΈ this, have x β f x, from and.right this, show false, from this `x β f x`, have x β diag, from and.intro xA this, have x β f x, from Hxβ»ΒΉ βΈ this, show false, from `x β f x` this theorem not_inj_on_pow {f : set X β X} (H : maps_to f (π« A) A) : Β¬ inj_on f (π« A) := let diag := f '[{x β π« A | f x β x}] in have diag β A, from image_subset_of_maps_to H (sep_subset _ _), assume Hβ : inj_on f (π« A), have f diag β diag, from by_contradiction (suppose f diag β diag, have diag β {x β π« A | f x β x}, from and.intro `diag β A` this, have f diag β diag, from mem_image_of_mem f this, show false, from `f diag β diag` this), obtain x [(Hx : x β π« A β§ f x β x) (fxeq : f x = f diag)], from this, have x = diag, from Hβ (and.left Hx) `diag β A` fxeq, have f diag β diag, from this βΈ and.right Hx, show false, from this `f diag β diag` end set /- The SchrΓΆder-Bernstein theorem. The proof below is nonconstructive, in three ways: (1) We need a left inverse to g (we could get around this by supplying one). (2) The definition of h below assumes that membership in Union U is decidable. (3) We ultimately case split on whether B is empty, and choose an element if it isn't. Rather than mark every auxiliary construction as "private", we put them all in a separate namespace. -/ namespace schroeder_bernstein section open set parameters {X Y : Type} parameter {A : set X} parameter {B : set Y} parameter {f : X β Y} parameter (f_maps_to : maps_to f A B) parameter (finj : inj_on f A) parameter {g : Y β X} parameter (g_maps_to : maps_to g B A) parameter (ginj : inj_on g B) parameter {dflt : Y} -- for now, assume B is nonempty parameter (dfltB : dflt β B) /- gβ»ΒΉ : A β B -/ noncomputable definition ginv : X β Y := inv_fun g B dflt lemma ginv_maps_to : maps_to ginv A B := maps_to_inv_fun dfltB lemma ginv_g_eq {b : Y} (bB : b β B) : ginv (g b) = b := left_inv_on_inv_fun_of_inj_on dflt ginj bB /- define a sequence of sets U -/ definition U : β β set X | U 0 := A \ g '[B] | U (n + 1) := g '[f '[U n]] lemma U_subset_A : β n, U n β A | 0 := show U 0 β A, from diff_subset _ _ | (n + 1) := have f '[U n] β B, from image_subset_of_maps_to f_maps_to (U_subset_A n), show U (n + 1) β A, from image_subset_of_maps_to g_maps_to this lemma g_ginv_eq {a : X} (aA : a β A) (anU : a β Union U) : g (ginv a) = a := have a β g '[B], from by_contradiction (suppose a β g '[B], have a β U 0, from and.intro aA this, have a β Union U, from exists.intro 0 this, show false, from anU this), obtain b [(bB : b β B) (gbeq : g b = a)], from this, calc g (ginv a) = g (ginv (g b)) : gbeq ... = g b : ginv_g_eq bB ... = a : gbeq /- h : A β B -/ noncomputable definition h x := if x β Union U then f x else ginv x lemma h_maps_to : maps_to h A B := take a, suppose a β A, show h a β B, from by_cases (suppose a β Union U, by+ rewrite [βh, if_pos this]; exact f_maps_to `a β A`) (suppose a β Union U, by+ rewrite [βh, if_neg this]; exact ginv_maps_to `a β A`) /- h is injective -/ lemma aux {aβ aβ : X} (Hβ : aβ β Union U) (aβA : aβ β A) (heq : h aβ = h aβ) : aβ β Union U := obtain n (aβUn : aβ β U n), from Hβ, have haβeq : h aβ = f aβ, from dif_pos Hβ, show aβ β Union U, from by_contradiction (suppose aβ β Union U, have haβeq : h aβ = ginv aβ, from dif_neg this, have g (f aβ) = aβ, from calc g (f aβ) = g (h aβ) : haβeq ... = g (h aβ) : heq ... = g (ginv aβ) : haβeq ... = aβ : g_ginv_eq aβA `aβ β Union U`, have g (f aβ) β g '[f '[U n]], from mem_image_of_mem g (mem_image_of_mem f aβUn), have aβ β U (n + 1), from `g (f aβ) = aβ` βΈ this, have aβ β Union U, from exists.intro _ this, show false, from `aβ β Union U` `aβ β Union U`) lemma h_inj : inj_on h A := take aβ aβ, suppose aβ β A, suppose aβ β A, assume heq : h aβ = h aβ, show aβ = aβ, from by_cases (assume aβUU : aβ β Union U, have aβUU : aβ β Union U, from aux aβUU `aβ β A` heq, have f aβ = f aβ, from calc f aβ = h aβ : dif_pos aβUU ... = h aβ : heq ... = f aβ : dif_pos aβUU, show aβ = aβ, from finj `aβ β A` `aβ β A` this) (assume aβnUU : aβ β Union U, have aβnUU : aβ β Union U, from assume H, aβnUU (aux H `aβ β A` heqβ»ΒΉ), have eqβ : g (ginv aβ) = aβ, from g_ginv_eq `aβ β A` aβnUU, have eqβ : g (ginv aβ) = aβ, from g_ginv_eq `aβ β A` aβnUU, have ginv aβ = ginv aβ, from calc ginv aβ = h aβ : dif_neg aβnUU ... = h aβ : heq ... = ginv aβ : dif_neg aβnUU, show aβ = aβ, from calc aβ = g (ginv aβ) : eqβ -- g_ginv_eq `aβ β A` aβnUU ... = g (ginv aβ) : this ... = aβ : eqβ) -- g_ginv_eq `aβ β A` aβnUU) /- h is surjective -/ lemma h_surj : surj_on h A B := take b, suppose b β B, have g b β A, from g_maps_to this, by_cases (suppose g b β Union U, obtain n (gbUn : g b β U n), from this, using ginj f_maps_to, begin cases n with n, {have g b β U 0, from gbUn, have g b β g '[B], from and.right this, have g b β g '[B], from mem_image_of_mem g `b β B`, show b β h '[A], from absurd `g b β g '[B]` `g b β g '[B]`}, {have g b β U (succ n), from gbUn, have g b β g '[f '[U n]], from this, obtain b' [(b'fUn : b' β f '[U n]) (geq : g b' = g b)], from this, obtain a [(aUn : a β U n) (faeq : f a = b')], from b'fUn, have g (f a) = g b, by rewrite [faeq, geq], have a β A, from U_subset_A n aUn, have f a β B, from f_maps_to this, have f a = b, from ginj `f a β B` `b β B` `g (f a) = g b`, have a β Union U, from exists.intro n aUn, have h a = f a, from dif_pos this, show b β h '[A], from mem_image `a β A` (`h a = f a` β¬ `f a = b`)} end) (suppose g b β Union U, have eqβ : h (g b) = ginv (g b), from dif_neg this, have eqβ : ginv (g b) = b, from ginv_g_eq `b β B`, show b β h '[A], from mem_image `g b β A` (eqβ β¬ eqβ)) end end schroeder_bernstein namespace set section parameters {X Y : Type} parameter {A : set X} parameter {B : set Y} parameter {f : X β Y} parameter (f_maps_to : maps_to f A B) parameter (finj : inj_on f A) parameter {g : Y β X} parameter (g_maps_to : maps_to g B A) parameter (ginj : inj_on g B) theorem schroeder_bernstein : β h, bij_on h A B := by_cases (assume H : β b, b β B, have fsurj : surj_on f A B, from take b, suppose b β B, absurd this !H, exists.intro f (and.intro f_maps_to (and.intro finj fsurj))) (assume H : Β¬ β b, b β B, have β b, b β B, from exists_of_not_forall_not H, obtain b bB, from this, let h := @schroeder_bernstein.h X Y A B f g b in have h_maps_to : maps_to h A B, from schroeder_bernstein.h_maps_to f_maps_to bB, have hinj : inj_on h A, from schroeder_bernstein.h_inj finj ginj, -- ginj, have hsurj : surj_on h A B, from schroeder_bernstein.h_surj f_maps_to g_maps_to ginj, exists.intro h (and.intro h_maps_to (and.intro hinj hsurj))) end end set