2014-12-01 05:16:01 +00:00
|
|
|
|
prelude
|
2014-08-25 02:58:48 +00:00
|
|
|
|
import logic
|
2014-11-23 01:34:05 +00:00
|
|
|
|
namespace experiment
|
2014-07-06 00:41:08 +00:00
|
|
|
|
inductive nat : Type :=
|
2014-08-22 22:46:10 +00:00
|
|
|
|
zero : nat,
|
|
|
|
|
succ : nat → nat
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
2014-09-05 01:41:06 +00:00
|
|
|
|
open eq
|
2014-09-04 23:36:06 +00:00
|
|
|
|
|
|
|
|
|
namespace nat
|
2014-07-06 00:41:08 +00:00
|
|
|
|
definition add (x y : nat)
|
2014-09-04 22:03:59 +00:00
|
|
|
|
:= nat.rec x (λ n r, succ r) y
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
2014-10-21 22:27:45 +00:00
|
|
|
|
infixl `+` := add
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
|
|
|
|
theorem add_zero_left (x : nat) : x + zero = x
|
|
|
|
|
:= refl _
|
|
|
|
|
|
|
|
|
|
theorem add_succ_left (x y : nat) : x + (succ y) = succ (x + y)
|
|
|
|
|
:= refl _
|
|
|
|
|
|
|
|
|
|
definition is_zero (x : nat)
|
2014-09-04 22:03:59 +00:00
|
|
|
|
:= nat.rec true (λ n r, false) x
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
|
|
|
|
theorem is_zero_zero : is_zero zero
|
2014-12-01 05:16:01 +00:00
|
|
|
|
:= eq.true_elim (refl _)
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
|
|
|
|
theorem not_is_zero_succ (x : nat) : ¬ is_zero (succ x)
|
2014-12-01 05:16:01 +00:00
|
|
|
|
:= eq.false_elim (refl _)
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
|
|
|
|
theorem dichotomy (m : nat) : m = zero ∨ (∃ n, m = succ n)
|
2014-09-04 22:03:59 +00:00
|
|
|
|
:= nat.rec
|
2014-09-04 23:36:06 +00:00
|
|
|
|
(or.intro_left _ (refl zero))
|
|
|
|
|
(λ m H, or.intro_right _ (exists_intro m (refl (succ m))))
|
2014-07-06 00:41:08 +00:00
|
|
|
|
m
|
|
|
|
|
|
|
|
|
|
theorem is_zero_to_eq (x : nat) (H : is_zero x) : x = zero
|
2014-09-05 04:25:21 +00:00
|
|
|
|
:= or.elim (dichotomy x)
|
2014-07-06 00:41:08 +00:00
|
|
|
|
(assume Hz : x = zero, Hz)
|
|
|
|
|
(assume Hs : (∃ n, x = succ n),
|
|
|
|
|
exists_elim Hs (λ (w : nat) (Hw : x = succ w),
|
2014-09-05 01:41:06 +00:00
|
|
|
|
absurd H (eq.subst (symm Hw) (not_is_zero_succ w))))
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
|
|
|
|
theorem is_not_zero_to_eq {x : nat} (H : ¬ is_zero x) : ∃ n, x = succ n
|
2014-09-05 04:25:21 +00:00
|
|
|
|
:= or.elim (dichotomy x)
|
2014-07-06 00:41:08 +00:00
|
|
|
|
(assume Hz : x = zero,
|
2014-09-05 01:41:06 +00:00
|
|
|
|
absurd (eq.subst (symm Hz) is_zero_zero) H)
|
2014-07-06 00:41:08 +00:00
|
|
|
|
(assume Hs, Hs)
|
|
|
|
|
|
|
|
|
|
theorem not_zero_add (x y : nat) (H : ¬ is_zero y) : ¬ is_zero (x + y)
|
|
|
|
|
:= exists_elim (is_not_zero_to_eq H)
|
|
|
|
|
(λ (w : nat) (Hw : y = succ w),
|
|
|
|
|
have H1 : x + y = succ (x + w), from
|
|
|
|
|
calc x + y = x + succ w : {Hw}
|
|
|
|
|
... = succ (x + w) : refl _,
|
|
|
|
|
have H2 : ¬ is_zero (succ (x + w)), from
|
|
|
|
|
not_is_zero_succ (x+w),
|
|
|
|
|
subst (symm H1) H2)
|
|
|
|
|
|
2014-10-08 01:02:15 +00:00
|
|
|
|
inductive not_zero [class] (x : nat) : Prop :=
|
2014-09-04 23:36:06 +00:00
|
|
|
|
intro : ¬ is_zero x → not_zero x
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
|
|
|
|
theorem not_zero_not_is_zero {x : nat} (H : not_zero x) : ¬ is_zero x
|
2014-09-04 22:03:59 +00:00
|
|
|
|
:= not_zero.rec (λ H1, H1) H
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
|
|
|
|
theorem not_zero_add_right [instance] (x y : nat) (H : not_zero y) : not_zero (x + y)
|
2014-09-04 23:36:06 +00:00
|
|
|
|
:= not_zero.intro (not_zero_add x y (not_zero_not_is_zero H))
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
|
|
|
|
theorem not_zero_succ [instance] (x : nat) : not_zero (succ x)
|
2014-09-04 23:36:06 +00:00
|
|
|
|
:= not_zero.intro (not_is_zero_succ x)
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
2014-10-02 23:20:52 +00:00
|
|
|
|
constant dvd : Π (x y : nat) {H : not_zero y}, nat
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
2014-10-02 23:20:52 +00:00
|
|
|
|
constants a b : nat
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
2014-07-27 19:01:06 +00:00
|
|
|
|
set_option pp.implicit true
|
2014-09-19 20:30:08 +00:00
|
|
|
|
reducible add
|
2014-08-22 23:36:47 +00:00
|
|
|
|
check dvd a (succ b)
|
|
|
|
|
check (λ H : not_zero b, dvd a b)
|
2014-07-06 00:41:08 +00:00
|
|
|
|
check (succ zero)
|
|
|
|
|
check a + (succ zero)
|
2014-08-22 23:36:47 +00:00
|
|
|
|
check dvd a (a + (succ b))
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
2014-09-19 20:30:08 +00:00
|
|
|
|
reducible [off] add
|
2014-08-22 23:36:47 +00:00
|
|
|
|
check dvd a (a + (succ b))
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
2014-09-19 20:30:08 +00:00
|
|
|
|
reducible add
|
2014-08-22 23:36:47 +00:00
|
|
|
|
check dvd a (a + (succ b))
|
2014-07-06 00:41:08 +00:00
|
|
|
|
|
2014-09-19 20:30:08 +00:00
|
|
|
|
reducible [off] add
|
2014-08-22 23:36:47 +00:00
|
|
|
|
check dvd a (a + (succ b))
|
2014-09-04 23:36:06 +00:00
|
|
|
|
|
|
|
|
|
end nat
|
2014-11-23 01:34:05 +00:00
|
|
|
|
end experiment
|