(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
Set Implicit Arguments.
Unset Strict Implicit.
Require Export Parts2.
(** Title "Cantor Bernstein theorem" *)
Comments
"We prove that if there is an injection from A to B, and an injection from B to A".
Comments "then there is a bijection between A and B.".
Section Cantor_Bernstein.
Variable E F : Setoid.
Variable f : MAP E F.
Variable g : MAP F E.
Hypothesis finj : injective f.
Hypothesis ginj : injective g.
Let h (X : part_set E) := compl (image g (compl (image f X))).
Let h_incr : forall A B : part_set E, included A B -> included (h A) (h B).
unfold h in |- *.
auto with algebra.
Qed.
Hint Resolve h_incr: algebra.
Let PX : part_set (part_set E).
apply (Build_Predicate (Pred_fun:=fun A : part_set E => included A (h A))).
red in |- *.
intros x y H' H'0; try assumption.
apply included_comp with x (h x); auto with algebra.
unfold h in |- *.
auto with algebra.
Defined.
Let X := union_part PX.
Let XhX : included X (h X).
unfold X in |- *.
apply union_part_upper_bound.
intros A H'; try assumption.
apply included_trans with (h A); auto with algebra.
Qed.
Let hXX : included (h X) X.
unfold X in |- *.
apply union_part_included.
simpl in |- *.
apply h_incr.
exact XhX.
Qed.
Let PXeq : Equal (h X) X.
apply included_antisym.
exact hXX.
exact XhX.
Qed.
Hint Resolve PXeq hXX XhX: algebra.
Let img : Equal (image g (compl (image f X))) (compl X).
apply Trans with (compl (h X)); auto with algebra.
unfold h in |- *; auto with algebra.
Qed.
Hint Resolve img: algebra.
Hypothesis
partial_section :
forall (E F : Setoid) (f : MAP E F),
injective f -> exists g : MAP F E, Equal (comp_map_map g f) (Id E).
Hypothesis
map_extend :
forall (E F : Setoid) (f g : MAP E F) (A : part_set E),
exists b : MAP E F,
(forall x : E, in_part x A -> Equal (b x) (f x)) /\
(forall x : E, ~ in_part x A -> Equal (b x) (g x)).

(* Specifications: *)
Theorem Cantor_Berstein : exists b : MAP E F, bijective b.
case (partial_section ginj).