cleaned up peano.pg a bit

This commit is contained in:
William Ball 2024-12-10 20:46:29 -08:00
parent f9e0ec40bd
commit 534809bef9
2 changed files with 31 additions and 28 deletions

View file

@ -25,7 +25,6 @@ section BasicDefinitions
-- fix some binary operation `op` -- fix some binary operation `op`
variable (* : binop); variable (* : binop);
infixl 20 *; infixl 20 *;
-- it is associative if ... -- it is associative if ...

View file

@ -79,11 +79,15 @@ def three : nat := suc two;
def four : nat := suc three; def four : nat := suc three;
def five : nat := suc four; def five : nat := suc four;
-- A nice infix abbreviation for equality on natural numbers
def = (n m : nat) := eq nat n m;
infixl 11 =;
-- First, the predecessor of n is m if n = suc m. -- First, the predecessor of n is m if n = suc m.
def pred (n m : nat) : ★ := eq nat n (suc m); def pred (n m : nat) : ★ := n = suc m;
-- Our claim is a disjunction, whose first option is that n = 0. -- Our claim is a disjunction, whose first option is that n = 0.
def szc_l (n : nat) := eq nat n zero; def szc_l (n : nat) := n = zero;
-- The second option is that n has a predecessor. -- The second option is that n has a predecessor.
def szc_r (n : nat) := exists nat (pred n); def szc_r (n : nat) := exists nat (pred n);
@ -194,7 +198,7 @@ def rec_rel_total : total nat A rec_rel :=
-- {{{ Defining R2 -- {{{ Defining R2
def alt_cond1 (x : nat) (y : A) := def alt_cond1 (x : nat) (y : A) :=
eq nat x zero ∧ eq A y z; x = zero ∧ eq A y z;
def cond_y2 (x : nat) (y : A) def cond_y2 (x : nat) (y : A)
(x2 : nat) (y2 : A) := (x2 : nat) (y2 : A) :=
@ -213,8 +217,8 @@ def rec_rel_alt (x : nat) (y : A) := alt_cond1 x y alt_cond2 x y;
-- {{{ R2 ⊆ R -- {{{ R2 ⊆ R
def R2_sub_R_case1 (x : nat) (y : A) : alt_cond1 x y -> rec_rel x y := def R2_sub_R_case1 (x : nat) (y : A) : alt_cond1 x y -> rec_rel x y :=
fun (case1 : alt_cond1 x y) => fun (case1 : alt_cond1 x y) =>
let (x0 := and_elim_l (eq nat x zero) (eq A y z) case1) let (x0 := and_elim_l (x = zero) (eq A y z) case1)
(yz := and_elim_r (eq nat x zero) (eq A y z) case1) (yz := and_elim_r (x = zero) (eq A y z) case1)
(a1 := (eq_sym A y z yz) (rec_rel zero) rec_rel_cond1) (a1 := (eq_sym A y z yz) (rec_rel zero) rec_rel_cond1)
in in
(eq_sym nat x zero x0) (fun (n : nat) => rec_rel n y) a1 (eq_sym nat x zero x0) (fun (n : nat) => rec_rel n y) a1
@ -252,7 +256,7 @@ def R2_sub_R (x : nat) (y : A) : rec_rel_alt x y -> rec_rel x y :=
-- {{{ R ⊆ R2 -- {{{ R ⊆ R2
def R2_cond1 : cond1 rec_rel_alt := def R2_cond1 : cond1 rec_rel_alt :=
or_intro_l (alt_cond1 zero z) (alt_cond2 zero z) or_intro_l (alt_cond1 zero z) (alt_cond2 zero z)
(and_intro (eq nat zero zero) (eq A z z) (and_intro (zero = zero) (eq A z z)
(eq_refl nat zero) (eq_refl nat zero)
(eq_refl A z)); (eq_refl A z));
@ -292,7 +296,7 @@ def R2_zero (y : A) : rec_rel_alt zero y -> eq A y z :=
(cy2 := cond_y2 zero y) (cy2 := cond_y2 zero y)
in fun (h : rec_rel_alt zero y) => in fun (h : rec_rel_alt zero y) =>
or_elim (alt_cond1 zero y) (alt_cond2 zero y) (eq A y z) h or_elim (alt_cond1 zero y) (alt_cond2 zero y) (eq A y z) h
(fun (case1 : alt_cond1 zero y) => and_elim_r (eq nat zero zero) (eq A y z) case1) (fun (case1 : alt_cond1 zero y) => and_elim_r (zero = zero) (eq A y z) case1)
(fun (case2 : alt_cond2 zero y) => (fun (case2 : alt_cond2 zero y) =>
exists_elim nat (eq A y z) cx2 case2 exists_elim nat (eq A y z) cx2 case2
(fun (x2 : nat) (h2 : cx2 x2) => (fun (x2 : nat) (h2 : cx2 x2) =>
@ -309,7 +313,7 @@ def R2_suc (x2 : nat) (y : A) : rec_rel_alt (suc x2) y -> exists A (cond_y2 (suc
in in
fun (h : rec_rel_alt x y) => fun (h : rec_rel_alt x y) =>
or_elim (alt_cond1 x y) (alt_cond2 x y) goal h or_elim (alt_cond1 x y) (alt_cond2 x y) goal h
(fun (case1 : alt_cond1 x y) => suc_nonzero x2 (and_elim_l (eq nat x zero) (eq A y z) case1) goal) (fun (case1 : alt_cond1 x y) => suc_nonzero x2 (and_elim_l (x = zero) (eq A y z) case1) goal)
(fun (case2 : alt_cond2 x y) => (fun (case2 : alt_cond2 x y) =>
exists_elim nat goal cx2 case2 exists_elim nat goal cx2 case2
(fun (x22 : nat) (hx22 : cx2 x22) => (fun (x22 : nat) (hx22 : cx2 x22) =>
@ -446,17 +450,17 @@ infixl 20 +;
-- The first equation manifests itself as the familiar -- The first equation manifests itself as the familiar
-- n + 0 = 0. -- n + 0 = 0.
def plus_0_r (n : nat) : eq nat (n + zero) n := def plus_0_r (n : nat) : n + zero = n :=
rec_def_sat_zero nat n psuc; rec_def_sat_zero nat n psuc;
-- The second equation, after a bit of massaging, manifests itself as the -- The second equation, after a bit of massaging, manifests itself as the
-- likewise familiar -- likewise familiar
-- n + suc m = suc (n + m). -- n + suc m = suc (n + m).
def plus_s_r (n m : nat) : eq nat (n + suc m) (suc (n + m)) := def plus_s_r (n m : nat) : n + suc m = suc (n + m) :=
rec_def_sat_suc nat n psuc m; rec_def_sat_suc nat n psuc m;
-- -- We can now prove 1 + 1 = 2! -- -- We can now prove 1 + 1 = 2!
def one_plus_one_two : eq nat (one + one) two := def one_plus_one_two : one + one = two :=
-- 1 + (suc zero) = suc (1 + zero) = suc one -- 1 + (suc zero) = suc (1 + zero) = suc one
eq_trans nat (one + one) (suc (one + zero)) two eq_trans nat (one + one) (suc (one + zero)) two
@ -473,11 +477,11 @@ def one_plus_one_two : eq nat (one + one) two :=
-- We will now prove a couple standard properties of addition. -- We will now prove a couple standard properties of addition.
-- First, associativity, namely that n + (m + p) = (n + m) + p. -- First, associativity, namely that n + (m + p) = (n + m) + p.
def plus_assoc : forall (n m p : nat), eq nat (n + (m + p)) (n + m + p) def plus_assoc : forall (n m p : nat), n + (m + p) = n + m + p
:= fun (n m : nat) => := fun (n m : nat) =>
-- We prove this via induction on p for any fixed n and m. -- We prove this via induction on p for any fixed n and m.
nat_ind nat_ind
(fun (p : nat) => eq nat (n + (m + p)) (n + m + p)) (fun (p : nat) => n + (m + p) = n + m + p)
-- Base case: p = 0 -- Base case: p = 0
-- WTS n + (m + 0) = (n + m) + 0 -- WTS n + (m + 0) = (n + m) + 0
@ -490,7 +494,7 @@ def plus_assoc : forall (n m p : nat), eq nat (n + (m + p)) (n + m + p)
(eq_sym nat (n + m + zero) (n + m) (plus_0_r (n + m)))) (eq_sym nat (n + m + zero) (n + m) (plus_0_r (n + m))))
-- Inductive step: IH = n + (m + p) = (n + m) + p -- Inductive step: IH = n + (m + p) = (n + m) + p
(fun (p : nat) (IH : eq nat (n + (m + p)) (n + m + p)) => (fun (p : nat) (IH : n + (m + p) = n + m + p) =>
-- WTS n + (m + suc p) = (n + m) + suc p -- WTS n + (m + suc p) = (n + m) + suc p
-- n + (m + suc p) = n + suc (m + p) -- n + (m + suc p) = n + suc (m + p)
-- = suc (n + (m + p)) -- = suc (n + (m + p))
@ -518,32 +522,32 @@ def plus_assoc : forall (n m p : nat), eq nat (n + (m + p)) (n + m + p)
-- Up next is commutativity, but we will need a couple lemmas first. -- Up next is commutativity, but we will need a couple lemmas first.
-- First, we will show that 0 + n = n. -- First, we will show that 0 + n = n.
def plus_0_l : forall (n : nat), eq nat (zero + n) n := def plus_0_l : forall (n : nat), zero + n = n :=
-- We prove this by induction on n. -- We prove this by induction on n.
nat_ind (fun (n : nat) => eq nat (zero + n) n) nat_ind (fun (n : nat) => zero + n = n)
-- base case: WTS 0 + 0 = 0 -- base case: WTS 0 + 0 = 0
-- This is just plus_0_r 0 -- This is just plus_0_r 0
(plus_0_r zero) (plus_0_r zero)
-- inductive case -- inductive case
(fun (n : nat) (IH : eq nat (zero + n) n) => (fun (n : nat) (IH : zero + n = n) =>
-- WTS 0 + (suc n) = suc n -- WTS 0 + (suc n) = suc n
-- 0 + (suc n) = suc (0 + n) = suc n -- 0 + suc n = suc (0 + n) = suc n
eq_trans nat (zero + suc n) (suc (zero + n)) (suc n) eq_trans nat (zero + suc n) (suc (zero + n)) (suc n)
-- 0 + (suc n) = suc (0 + n) -- 0 + suc n = suc (0 + n)
(plus_s_r zero n) (plus_s_r zero n)
-- suc (0 + n) = suc n -- suc (0 + n) = suc n
(eq_cong nat nat (zero + n) n suc IH)); (eq_cong nat nat (zero + n) n suc IH));
-- Next, we will show that (suc n) + m = suc (n + m). -- Next, we will show that (suc n) + m = suc (n + m).
def plus_s_l (n : nat) : forall (m : nat), eq nat (suc n + m) (suc (n + m)) := def plus_s_l (n : nat) : forall (m : nat), suc n + m = suc (n + m) :=
-- We proceed by induction on m. -- We proceed by induction on m.
nat_ind (fun (m : nat) => eq nat (suc n + m) (suc (n + m))) nat_ind (fun (m : nat) => suc n + m = suc (n + m))
-- base case: (suc n) + 0 = suc (n + 0) -- base case: (suc n) + 0 = suc (n + 0)
-- (suc n) + 0 = suc n = suc (n + 0) -- suc n + 0 = suc n = suc (n + 0)
(eq_trans nat (suc n + zero) (suc n) (suc (n + zero)) (eq_trans nat (suc n + zero) (suc n) (suc (n + zero))
-- (suc n) + 0 = suc n -- suc n + 0 = suc n
(plus_0_r (suc n)) (plus_0_r (suc n))
-- suc n = suc (n + 0) -- suc n = suc (n + 0)
@ -553,7 +557,7 @@ def plus_s_l (n : nat) : forall (m : nat), eq nat (suc n + m) (suc (n + m)) :=
-- inductive case -- inductive case
-- IH = suc n + m = suc (n + m) -- IH = suc n + m = suc (n + m)
(fun (m : nat) (IH : eq nat (suc n + m) (suc (n + m))) => (fun (m : nat) (IH : suc n + m = suc (n + m)) =>
-- WTS suc n + suc m = suc (n + suc m) -- WTS suc n + suc m = suc (n + suc m)
-- suc n + suc m = suc (suc n + m) -- suc n + suc m = suc (suc n + m)
-- = suc (suc (n + m)) -- = suc (suc (n + m))
@ -573,9 +577,9 @@ def plus_s_l (n : nat) : forall (m : nat), eq nat (suc n + m) (suc (n + m)) :=
(eq_sym nat (n + suc m) (suc (n + m)) (plus_s_r n m)))))); (eq_sym nat (n + suc m) (suc (n + m)) (plus_s_r n m))))));
-- Finally, we can prove commutativity. -- Finally, we can prove commutativity.
def plus_comm (n : nat) : forall (m : nat), eq nat (n + m) (m + n) := def plus_comm (n : nat) : forall (m : nat), n + m = m + n :=
-- As usual, we proceed by induction. -- As usual, we proceed by induction.
nat_ind (fun (m : nat) => eq nat (n + m) (m + n)) nat_ind (fun (m : nat) => n + m = m + n)
-- Base case: WTS n + 0 = 0 + n -- Base case: WTS n + 0 = 0 + n
-- n + 0 = n = 0 + n -- n + 0 = n = 0 + n
@ -587,7 +591,7 @@ def plus_comm (n : nat) : forall (m : nat), eq nat (n + m) (m + n) :=
(eq_sym nat (zero + n) n (plus_0_l n))) (eq_sym nat (zero + n) n (plus_0_l n)))
-- Inductive step: -- Inductive step:
(fun (m : nat) (IH : eq nat (n + m) (m + n)) => (fun (m : nat) (IH : n + m = m + n) =>
-- WTS n + suc m = suc m + n -- WTS n + suc m = suc m + n
-- n + suc m = suc (n + m) -- n + suc m = suc (n + m)
-- = suc (m + n) -- = suc (m + n)