(* 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                                                     *)
(*************)
(** * Zero   *)
(*************)
(** In set theory, zero is implemented as the empty set.  As a pointed graph, we can take any (non-empty) carrier and any root, with an empty edge relation: *)
Definition unit : Typ1 := forall X : Typ0, X -> X.
Definition id : unit := fun X x => x.
Definition ZERO : Rel unit := fun _ _ => bot.
(*******************************)
(** * The successor function   *)
(*******************************)
(** In set theory, the successor of von Neumann numeral n is encoded as the set  n U {n}, whose existence follows from the pairing axiom (used twice) and the union axiom, that have been already derived in the files "IZF_pair.v"  and "IZF_union.v".  However, it is simpler to give here a direct implementation of the successor as follows.  Formally, the successor of a given pointed graph (X, A, a) is represented as the pointed graph  ((opt X), (SUCC X A a), (none X))  whose edge relation is defined by the following three clauses:  1. Delocate A in the new graph via (some X):  if (A x' x), then (SUCC X A a (some X x') (some X x))  2. Connect the image of any direct element of the old root a:X to the new root:  if (A x a), then (SUCC X A a (some X x) (none X))  3. Connect the old root to the new root:  (SUCC X A a (some X a) (none X)).  As usual, we use a second-order encoding to define this relation. *)
Definition SUCC (X : Typ1) (A : Rel X) (a : X) : Rel (opt X) :=
fun z' z =>
forall E : Prop,
(forall x x' : X,
eq (opt X) z (some X x) -> eq (opt X) z' (some X x') -> A x' x -> E) ->
(forall x' : X,
eq (opt X) z (none X) -> eq (opt X) z' (some X x') -> A x' a -> E) ->
(eq (opt X) z (none X) -> eq (opt X) z' (some X a) -> E) -> E.
Proof
fun X A a x x' H E H1 _ _ =>
H1 x x' (eq_refl (opt X) (some X x)) (eq_refl (opt X) (some X x')) H.
Proof
fun X A a x' H E _ H2 _ =>
H2 x' (eq_refl (opt X) (none X)) (eq_refl (opt X) (some X x')) H.
Proof
fun X A a E _ _ H3 =>
H3 (eq_refl (opt X) (none X)) (eq_refl (opt X) (some X a)).
(**************************************)
(** * The set of von Neuman numerals  *)
(**************************************)
(** The set omega of von Neumann numerals is represented as the pointed graph ((opt nat), OMEGA, (none nat)) whose edge relation OMEGA : (Rel (opt nat)) is defined by the following two clauses:  1. Delocation of the strict ordering "lt"  if (wf_nat n), (wf_nat m) and (lt n m), then (OMEGA (some nat n) (some nat m))  2. Connecting wf_nat's to the new root:  if (wf_nat n), then (OMEGA (some nat n) (none nat)).  As usual, we define it via a second-order encoding: *)
Definition OMEGA : Rel (opt nat) :=
fun z' z =>
forall E : Prop,
(forall n n' : nat,
eq (opt nat) z (some nat n) ->
eq (opt nat) z' (some nat n') -> wf_nat n -> wf_nat n' -> lt n' n -> E) ->
(forall n' : nat,
eq (opt nat) z (none nat) ->
eq (opt nat) z' (some nat n') -> wf_nat n' -> E) -> E.
(** The corresponding constructors are the following: *)
Proof
fun n Hn m Hm H E H1 _ =>
H1 m n (eq_refl (opt nat) (some nat m)) (eq_refl (opt nat) (some nat n)) Hm
Hn H.
Proof
fun n Hn E _ H2 =>
H2 n (eq_refl (opt nat) (none nat)) (eq_refl (opt nat) (some nat n)) Hn.
(** The pointed graph ((opt nat), OMEGA, (some nat O)) is bisimilar to the pointed graph (unit ZERO id) that represents the empty set. This is done by extensionality. *)
(** Inductive case: for any n:nat such that (wf_nat n), the pointed graph ((opt nat), OMEGA, (some nat (S n))) is bisimilar to the successor of the pointed graph ((opt nat), OMEGA, (some nat n)). Again, this is done by extensionality. *)
(** ** The axiom of infinity **)
(** The set denoted by the pointed graph ((opt nat), OMEGA, (none nat)) contains zero (i.e. the empty set)... *)
(** ... and is closed under successor: *)
(** And we now check the induction principle on omega: *)

Theorem omega_ind
:
forall P : PRED,
Compat P ->
P unit ZERO id ->
(forall (X : Typ1) (A : Rel X) (a : X),
ELT X A a (opt nat) OMEGA (none nat) ->
P X A a -> P (opt X) (SUCC X A a) (none X)) ->
forall (X : Typ1) (A : Rel X) (a : X),
ELT X A a (opt nat) OMEGA (none nat) -> P X A a.