feat(library/standard): add decidability of le for int

This commit is contained in:
Jeremy Avigad 2014-08-21 17:54:50 -07:00 committed by Leonardo de Moura
parent 937c465685
commit 3afad10a72
11 changed files with 180 additions and 168 deletions

View file

@ -12,7 +12,7 @@ inductive bool : Type :=
namespace bool
theorem induction_on {p : bool → Prop} (b : bool) (H0 : p ff) (H1 : p tt) : p b :=
theorem cases_on {p : bool → Prop} (b : bool) (H0 : p ff) (H1 : p tt) : p b :=
bool_rec H0 H1 b
theorem bool_inhabited [instance] : inhabited bool :=
@ -22,7 +22,7 @@ definition cond {A : Type} (b : bool) (t e : A) :=
bool_rec e t b
theorem dichotomy (b : bool) : b = ff b = tt :=
induction_on b (or_inl (refl ff)) (or_inr (refl tt))
cases_on b (or_inl (refl ff)) (or_inr (refl tt))
theorem cond_ff {A : Type} (t e : A) : cond ff t e = e :=
refl (cond ff t e)
@ -52,24 +52,24 @@ refl (bor tt a)
infixl `||`:65 := bor
theorem bor_tt_right (a : bool) : a || tt = tt :=
induction_on a (refl (ff || tt)) (refl (tt || tt))
cases_on a (refl (ff || tt)) (refl (tt || tt))
theorem bor_ff_left (a : bool) : ff || a = a :=
induction_on a (refl (ff || ff)) (refl (ff || tt))
cases_on a (refl (ff || ff)) (refl (ff || tt))
theorem bor_ff_right (a : bool) : a || ff = a :=
induction_on a (refl (ff || ff)) (refl (tt || ff))
cases_on a (refl (ff || ff)) (refl (tt || ff))
theorem bor_id (a : bool) : a || a = a :=
induction_on a (refl (ff || ff)) (refl (tt || tt))
cases_on a (refl (ff || ff)) (refl (tt || tt))
theorem bor_comm (a b : bool) : a || b = b || a :=
induction_on a
(induction_on b (refl (ff || ff)) (refl (ff || tt)))
(induction_on b (refl (tt || ff)) (refl (tt || tt)))
cases_on a
(cases_on b (refl (ff || ff)) (refl (ff || tt)))
(cases_on b (refl (tt || ff)) (refl (tt || tt)))
theorem bor_assoc (a b c : bool) : (a || b) || c = a || (b || c) :=
induction_on a
cases_on a
(calc (ff || b) || c = b || c : {bor_ff_left b}
... = ff || (b || c) : bor_ff_left (b || c)⁻¹)
(calc (tt || b) || c = tt || c : {bor_tt_left b}
@ -93,24 +93,24 @@ theorem band_ff_left (a : bool) : ff && a = ff :=
refl (ff && a)
theorem band_tt_left (a : bool) : tt && a = a :=
induction_on a (refl (tt && ff)) (refl (tt && tt))
cases_on a (refl (tt && ff)) (refl (tt && tt))
theorem band_ff_right (a : bool) : a && ff = ff :=
induction_on a (refl (ff && ff)) (refl (tt && ff))
cases_on a (refl (ff && ff)) (refl (tt && ff))
theorem band_tt_right (a : bool) : a && tt = a :=
induction_on a (refl (ff && tt)) (refl (tt && tt))
cases_on a (refl (ff && tt)) (refl (tt && tt))
theorem band_id (a : bool) : a && a = a :=
induction_on a (refl (ff && ff)) (refl (tt && tt))
cases_on a (refl (ff && ff)) (refl (tt && tt))
theorem band_comm (a b : bool) : a && b = b && a :=
induction_on a
(induction_on b (refl (ff && ff)) (refl (ff && tt)))
(induction_on b (refl (tt && ff)) (refl (tt && tt)))
cases_on a
(cases_on b (refl (ff && ff)) (refl (ff && tt)))
(cases_on b (refl (tt && ff)) (refl (tt && tt)))
theorem band_assoc (a b c : bool) : (a && b) && c = a && (b && c) :=
induction_on a
cases_on a
(calc (ff && b) && c = ff && c : {band_ff_left b}
... = ff : band_ff_left c
... = ff && (b && c) : band_ff_left (b && c)⁻¹)
@ -135,7 +135,7 @@ definition bnot (a : bool) := bool_rec tt ff a
prefix `!`:85 := bnot
theorem bnot_bnot (a : bool) : !!a = a :=
induction_on a (refl (!!ff)) (refl (!!tt))
cases_on a (refl (!!ff)) (refl (!!tt))
theorem bnot_false : !ff = tt := refl _

View file

@ -8,11 +8,6 @@
import ..nat.basic ..nat.order ..nat.sub ..prod ..quotient ..quotient tools.tactic struc.relation
import struc.binary
-- TODO: show decidability of le and remove this
import logic.classes.decidable
import logic.axioms.classical
import logic.axioms.prop_decidable
import tools.fake_simplifier
namespace int
@ -214,43 +209,30 @@ exists_intro (pr1 (rep a))
definition of_nat (n : ) : := psub (pair n 0)
theorem int_eq_decidable [instance] (a b : ) : decidable (a = b) := _
-- subtype_eq_decidable _ _ (prod_eq_decidable _ _ _ _)
opaque_hint (hiding int)
coercion of_nat
-- TODO: why doesn't the coercion work?
theorem eq_zero_intro (n : ) : psub (pair n n) = 0 :=
have H : rel (pair n n) (pair 0 0), by simp,
eq_abs quotient H
-- TODO: this is not a good name -- we want to use abs for the function from int to int.
-- Rename to int.to_nat?
-- ## absolute value
definition to_nat : := rec_constant quotient (fun v, dist (pr1 v) (pr2 v))
-- TODO: set binding strength: is this right?
notation `|`:40 x:40 `|` := to_nat x
-- TODO: delete -- prod.destruct should be enough
---move to other library or remove
-- add_rewrite pair_tproj_eq
-- theorem pair_translate {A B : Type} (P : A → B → A × B → Prop)
-- : (∀v, P (pr1 v) (pr2 v) v) ↔ (∀a b, P a b (pair a b)) :=
-- iff_intro
-- (assume H, take a b, subst (by simp) (H (pair a b)))
-- (assume H, take v, subst (by simp) (H (pr1 v) (pr2 v)))
theorem abs_comp (n m : ) : (to_nat (psub (pair n m))) = dist n m :=
theorem to_nat_comp (n m : ) : (to_nat (psub (pair n m))) = dist n m :=
have H : ∀v w : × , rel v w → dist (pr1 v) (pr2 v) = dist (pr1 w) (pr2 w),
from take v w H, dist_eq_intro H,
have H2 : ∀v : × , (to_nat (psub v)) = dist (pr1 v) (pr2 v),
from take v, (comp_constant quotient H (rel_refl v)),
(by simp) ◂ H2 (pair n m)
-- add_rewrite abs_comp --local
-- add_rewrite to_nat_comp --local
--the following theorem includes abs_zero
theorem to_nat_of_nat (n : ) : to_nat (of_nat n) = n :=
calc
(to_nat (psub (pair n 0))) = dist n 0 : by simp
@ -262,7 +244,7 @@ calc
... = to_nat (of_nat m) : {H}
... = m : to_nat_of_nat m
theorem abs_eq_zero {a : } (H : (to_nat a) = 0) : a = 0 :=
theorem to_nat_eq_zero {a : } (H : to_nat a = 0) : a = 0 :=
obtain (xa ya : ) (Ha : a = psub (pair xa ya)), from destruct a,
have H2 : dist xa ya = 0, from
calc
@ -275,11 +257,10 @@ calc
... = psub (pair ya ya) : {H3}
... = 0 : eq_zero_intro ya
-- add_rewrite abs_of_nat
-- add_rewrite to_nat_of_nat
-- ## neg
definition neg : := quotient_map quotient flip
-- TODO: is this good?
@ -309,7 +290,7 @@ theorem neg_inj {a b : } (H : -a = -b) : a = b :=
theorem neg_move {a b : } (H : -a = b) : -b = a :=
subst H (neg_neg a)
theorem abs_neg (a : ) : (to_nat (-a)) = (to_nat a) :=
theorem to_nat_neg (a : ) : (to_nat (-a)) = (to_nat a) :=
obtain (xa ya : ) (Ha : a = psub (pair xa ya)), from destruct a,
by simp
@ -324,7 +305,7 @@ have H5 : n + m = 0, from
... = 0 : by simp,
add_eq_zero H5
-- add_rewrite abs_neg
-- add_rewrite to_nat_neg
---reverse equalities
@ -354,7 +335,8 @@ or_imp_or (or_swap (proj_zero_or (rep a)))
opaque_hint (hiding int)
---rename to by_cases in Lean 0.2 (for now using this to avoid name clash)
theorem int_by_cases {P : → Prop} (a : ) (H1 : ∀n : , P (of_nat n)) (H2 : ∀n : , P (-n)) : P a :=
theorem int_by_cases {P : → Prop} (a : ) (H1 : ∀n : , P (of_nat n)) (H2 : ∀n : , P (-n)) :
P a :=
or_elim (cases a)
(assume H, obtain (n : ) (H3 : a = n), from H, subst (symm H3) (H1 n))
(assume H, obtain (n : ) (H3 : a = -n), from H, subst (symm H3) (H2 n))
@ -378,7 +360,8 @@ or_elim (cases a)
have H4 : a = - of_nat (succ k), from subst H3 H2,
or_intro_right _ (exists_intro k H4)))
theorem int_by_cases_succ {P : → Prop} (a : ) (H1 : ∀n : , P (of_nat n)) (H2 : ∀n : , P (-of_nat (succ n))) : P a :=
theorem int_by_cases_succ {P : → Prop} (a : )
(H1 : ∀n : , P (of_nat n)) (H2 : ∀n : , P (-of_nat (succ n))) : P a :=
or_elim (cases_succ a)
(assume H, obtain (n : ) (H3 : a = of_nat n), from H, subst (symm H3) (H1 n))
(assume H, obtain (n : ) (H3 : a = -of_nat (succ n)), from H, subst (symm H3) (H2 n))
@ -460,7 +443,8 @@ obtain (xa ya : ) (Ha : a = psub (pair xa ya)), from destruct a,
obtain (xb yb : ) (Hb : b = psub (pair xb yb)), from destruct b,
by simp
theorem triangle_inequality (a b : ) : (to_nat (a + b)) ≤ (to_nat a) + (to_nat b) := --note: ≤ is nat::≤
theorem to_nat_add_le (a b : ) : to_nat (a + b) ≤ to_nat a + to_nat b :=
--note: ≤ is nat::≤
obtain (xa ya : ) (Ha : a = psub (pair xa ya)), from destruct a,
obtain (xb yb : ) (Hb : b = psub (pair xb yb)), from destruct b,
have H : dist (xa + xb) (ya + yb) ≤ dist xa ya + dist xb yb,
@ -619,24 +603,25 @@ calc
... = (to_nat (of_nat n - m)) : sorry -- {symm H}
-- ## mul
-- TODO: remove this when order changes
theorem rel_mul_prep {xa ya xb yb xn yn xm ym : }
(H1 : xa + yb = ya + xb) (H2 : xn + ym = yn + xm)
: xa * xn + ya * yn + (xb * ym + yb * xm) = xa * yn + ya * xn + (xb * xm + yb * ym) :=
have H3 : xa * xn + ya * yn + (xb * ym + yb * xm) + (yb * xn + xb * yn + (xb * xn + yb * yn))
= xa * yn + ya * xn + (xb * xm + yb * ym) + (yb * xn + xb * yn + (xb * xn + yb * yn)), from
= xa * yn + ya * xn + (xb * xm + yb * ym) + (yb * xn + xb * yn + (xb * xn + yb * yn)), from
calc
xa * xn + ya * yn + (xb * ym + yb * xm) + (yb * xn + xb * yn + (xb * xn + yb * yn))
= xa * xn + yb * xn + (ya * yn + xb * yn) + (xb * xn + xb * ym + (yb * yn + yb * xm)) : by simp
... = (xa + yb) * xn + (ya + xb) * yn + (xb * (xn + ym) + yb * (yn + xm)) : by simp
... = (ya + xb) * xn + (xa + yb) * yn + (xb * (yn + xm) + yb * (xn + ym)) : by simp
... = ya * xn + xb * xn + (xa * yn + yb * yn) + (xb * yn + xb * xm + (yb*xn + yb*ym))
: by simp
... = xa * yn + ya * xn + (xb * xm + yb * ym) + (yb * xn + xb * yn + (xb * xn + yb * yn)) : by simp,
= xa * xn + yb * xn + (ya * yn + xb * yn) + (xb * xn + xb * ym + (yb * yn + yb * xm))
: by simp
... = (xa + yb) * xn + (ya + xb) * yn + (xb * (xn + ym) + yb * (yn + xm)) : by simp
... = (ya + xb) * xn + (xa + yb) * yn + (xb * (yn + xm) + yb * (xn + ym)) : by simp
... = ya * xn + xb * xn + (xa * yn + yb * yn) + (xb * yn + xb * xm + (yb*xn + yb*ym))
: by simp
... = xa * yn + ya * xn + (xb * xm + yb * ym) + (yb * xn + xb * yn + (xb * xn + yb * yn))
: by simp,
nat.add_cancel_right H3
theorem rel_mul {u u' v v' : × } (H1 : rel u u') (H2 : rel v v')
: rel (pair (pr1 u * pr1 v + pr2 u * pr2 v) (pr1 u * pr2 v + pr2 u * pr1 v))
theorem rel_mul {u u' v v' : × } (H1 : rel u u') (H2 : rel v v') :
rel (pair (pr1 u * pr1 v + pr2 u * pr2 v) (pr1 u * pr2 v + pr2 u * pr1 v))
(pair (pr1 u' * pr1 v' + pr2 u' * pr2 v') (pr1 u' * pr2 v' + pr2 u' * pr1 v')) :=
calc
pr1 (pair (pr1 u * pr1 v + pr2 u * pr2 v) (pr1 u * pr2 v + pr2 u * pr1 v))
@ -651,8 +636,8 @@ definition mul : := quotient_map_binary quotient
infixl `*` := int.mul
theorem mul_comp (n m k l : )
: psub (pair n m) * psub (pair k l) = psub (pair (n * k + m * l) (n * l + m * k)) :=
theorem mul_comp (n m k l : ) :
psub (pair n m) * psub (pair k l) = psub (pair (n * k + m * l) (n * l + m * k)) :=
have H : ∀u v,
psub u * psub v = psub (pair (pr1 u * pr1 v + pr2 u * pr2 v) (pr1 u * pr2 v + pr2 u * pr1 v)),
from comp_quotient_map_binary_refl rel_refl quotient @rel_mul,
@ -671,7 +656,6 @@ obtain (xb yb : ) (Hb : b = psub (pair xb yb)), from destruct b,
obtain (xc yc : ) (Hc : c = psub (pair xc yc)), from destruct c,
by simp
theorem mul_left_comm : ∀a b c : , a * (b * c) = b * (a * c) :=
left_comm mul_comm mul_assoc
@ -709,27 +693,27 @@ subst (mul_comm b a) (subst (mul_comm b (-a)) (mul_neg_right b a))
theorem mul_neg_neg (a b : ) : -a * -b = a * b :=
by simp
theorem mul_distr_right (a b c : ) : (a + b) * c = a * c + b * c :=
theorem mul_right_distr (a b c : ) : (a + b) * c = a * c + b * c :=
obtain (xa ya : ) (Ha : a = psub (pair xa ya)), from destruct a,
obtain (xb yb : ) (Hb : b = psub (pair xb yb)), from destruct b,
obtain (xc yc : ) (Hc : c = psub (pair xc yc)), from destruct c,
by simp
theorem mul_distr_left (a b c : ) : a * (b + c) = a * b + a * c :=
theorem mul_left_distr (a b c : ) : a * (b + c) = a * b + a * c :=
calc
a * (b + c) = (b + c) * a : mul_comm a (b + c)
... = b * a + c * a : mul_distr_right b c a
... = b * a + c * a : mul_right_distr b c a
... = a * b + c * a : {mul_comm b a}
... = a * b + a * c : {mul_comm c a}
theorem mul_sub_distr_right (a b c : ) : (a - b) * c = a * c - b * c :=
theorem mul_sub_right_distr (a b c : ) : (a - b) * c = a * c - b * c :=
calc
(a + -b) * c = a * c + -b * c : mul_distr_right a (-b) c
(a + -b) * c = a * c + -b * c : mul_right_distr a (-b) c
... = a * c + - (b * c) : {mul_neg_left b c}
theorem mul_sub_distr_left (a b c : ) : a * (b - c) = a * b - a * c :=
theorem mul_sub_left_distr (a b c : ) : a * (b - c) = a * b - a * c :=
calc
a * (b + -c) = a * b + a * -c : mul_distr_left a b (-c)
a * (b + -c) = a * b + a * -c : mul_left_distr a b (-c)
... = a * b + - (a * c) : {mul_neg_right a c}
theorem mul_of_nat (n m : ) : of_nat n * of_nat m = n * m :=
@ -745,8 +729,7 @@ by simp
-- add_rewrite mul_zero_left mul_zero_right mul_one_right mul_one_left
-- add_rewrite mul_comm mul_assoc mul_left_comm
-- add_rewrite mul_distr_right mul_distr_left mul_of_nat
--mul_sub_distr_left mul_sub_distr_right
-- add_rewrite mul_distr_right mul_distr_left mul_of_nat mul_sub_distr_left mul_sub_distr_right
-- ---------- inversion
@ -759,8 +742,8 @@ have H2 : (to_nat a) * (to_nat b) = 0, from
... = 0 : to_nat_of_nat 0,
have H3 : (to_nat a) = 0 (to_nat b) = 0, from mul_eq_zero H2,
or_imp_or H3
(assume H : (to_nat a) = 0, abs_eq_zero H)
(assume H : (to_nat b) = 0, abs_eq_zero H)
(assume H : (to_nat a) = 0, to_nat_eq_zero H)
(assume H : (to_nat b) = 0, to_nat_eq_zero H)
theorem mul_cancel_left_or {a b c : } (H : a * b = a * c) : a = 0 b = c :=
have H2 : a * (b - c) = 0, by simp,
@ -797,29 +780,6 @@ definition le (a b : ) : Prop := ∃n : , a + n = b
infix `<=` := int.le
infix `≤` := int.le
-- definition le : → Prop := rec_binary quotient (fun a b, pr1 a + pr2 b ≤ pr2 a + pr1 b)
-- theorem le_comp_alt (u v : × ) : (psub u ≤ psub v) ↔ (pr1 u + pr2 v ≤ pr2 u + pr1 v)
-- :=
-- comp_binary_refl quotient rel_refl
-- (take u u' v v' : × ,
-- assume Hu : rel u u',
-- assume Hv : rel v v',)
-- u v
-- theorem le_intro {a b : } {n : } (H : a + of_nat n = b) : a ≤ b
-- :=
-- have lemma : ∀u v, rel (map_pair2 nat::add u (pair n 0)) v → pr1 u + pr2 v + n = pr2 u + pr1 v, from
-- take u v,
-- assume H : rel (map_pair2 nat::add u (pair n 0)) v,
-- calc
-- pr1 u + pr2 v + n = pr1 u + n + pr2 v : nat::add_right_comm (pr1 u) (pr2 v) n
-- ... = pr1 (map_pair2 nat::add u (pair n 0)) + pr2 v : by simp
-- ... = pr2 (map_pair2 nat::add u (pair n 0)) + pr1 v : H
-- ... = pr2 u + 0 + pr1 v : by simp
-- ... = pr2 u + pr1 v : {nat::add_zero_right (pr2 u)},
-- have H2 :
theorem le_intro {a b : } {n : } (H : a + n = b) : a ≤ b :=
exists_intro n H
@ -968,6 +928,12 @@ add_le_cancel_right H
theorem sub_le_left_inv {a b c : } (H : c - a ≤ c - b) : b ≤ a :=
le_neg_inv (add_le_cancel_left H)
theorem le_iff_sub_nonneg (a b : ) : a ≤ b ↔ 0 ≤ b - a :=
iff_intro
(assume H, subst (sub_self _) (sub_le_right H a))
(assume H, subst (sub_add_inverse _ _) (subst (add_zero_left _) (add_le_right H a)))
-- Less than, Greater than, Greater than or equal
-- ----------------------------------------------
@ -1208,23 +1174,40 @@ obtain (n : ) (Hn : -a = n), from pos_imp_exists_nat H2,
have H3 : a = -n, from symm (neg_move Hn),
exists_intro n H3
theorem abs_pos {a : } (H : a ≥ 0) : (to_nat a) = a :=
theorem to_nat_nonneg_eq {a : } (H : a ≥ 0) : (to_nat a) = a :=
obtain (n : ) (Hn : a = n), from pos_imp_exists_nat H,
subst (symm Hn) (congr_arg of_nat (to_nat_of_nat n))
--abs_neg is already taken... rename?
theorem abs_negative {a : } (H : a ≤ 0) : (to_nat a) = -a :=
theorem of_nat_nonneg (n : ) : of_nat n ≥ 0 :=
iff_mp (iff_symm (le_of_nat _ _)) (zero_le _)
theorem le_decidable [instance] {a b : } : decidable (a ≤ b) :=
have aux : ∀x, decidable (0 ≤ x), from
take x,
have H : 0 ≤ x ↔ of_nat (to_nat x) = x, from
iff_intro
(assume H1, to_nat_nonneg_eq H1)
(assume H1, subst H1 (of_nat_nonneg (to_nat x))),
decidable_iff_equiv _ (iff_symm H),
decidable_iff_equiv (aux _) (iff_symm (le_iff_sub_nonneg a b))
theorem ge_decidable [instance] {a b : } : decidable (a ≥ b)
theorem lt_decidable [instance] {a b : } : decidable (a < b)
theorem gt_decidable [instance] {a b : } : decidable (a > b)
--to_nat_neg is already taken... rename?
theorem to_nat_negative {a : } (H : a ≤ 0) : (to_nat a) = -a :=
obtain (n : ) (Hn : a = -n), from neg_imp_exists_nat H,
calc
(to_nat a) = (to_nat ( -n)) : {Hn}
... = (to_nat n) : {abs_neg n}
... = (to_nat n) : {to_nat_neg n}
... = n : {to_nat_of_nat n}
... = -a : symm (neg_move (symm Hn))
theorem abs_cases (a : ) : a = (to_nat a) a = - (to_nat a) :=
theorem to_nat_cases (a : ) : a = (to_nat a) a = - (to_nat a) :=
or_imp_or (le_total 0 a)
(assume H : a ≥ 0, symm (abs_pos H))
(assume H : a ≤ 0, symm (neg_move (symm (abs_negative H))))
(assume H : a ≥ 0, symm (to_nat_nonneg_eq H))
(assume H : a ≤ 0, symm (neg_move (symm (to_nat_negative H))))
-- ### interaction of mul with le and lt
@ -1233,7 +1216,7 @@ obtain (n : ) (Hn : b + n = c), from le_elim H,
have H2 : a * b + of_nat ((to_nat a) * n) = a * c, from
calc
a * b + of_nat ((to_nat a) * n) = a * b + (to_nat a) * of_nat n : by simp
... = a * b + a * n : {abs_pos Ha}
... = a * b + a * n : {to_nat_nonneg_eq Ha}
... = a * (b + n) : by simp
... = a * c : by simp,
le_intro H2
@ -1339,7 +1322,7 @@ have H2 : (to_nat a) * (to_nat b) = 1, from
... = (to_nat 1) : {H}
... = 1 : to_nat_of_nat 1,
have H3 : (to_nat a) = 1, from mul_eq_one_left H2,
or_imp_or (abs_cases a)
or_imp_or (to_nat_cases a)
(assume H4 : a = (to_nat a), subst H3 H4)
(assume H4 : a = - (to_nat a), subst H3 H4)
@ -1365,7 +1348,7 @@ trans (if_neg (lt_antisym H) _ _) (if_pos H _ _)
theorem sign_zero : sign 0 = 0 :=
trans (if_neg (lt_irrefl 0) _ _) (if_neg (lt_irrefl 0) _ _)
-- add_rewrite sign_negative sign_pos abs_negative abs_pos sign_zero mul_abs
-- add_rewrite sign_negative sign_pos to_nat_negative to_nat_nonneg_eq sign_zero mul_to_nat
theorem mul_sign_to_nat (a : ) : sign a * (to_nat a) = a :=
have temp1 : ∀a : , a < 0 → a ≤ 0, from take a, lt_imp_le,
@ -1390,7 +1373,7 @@ or_elim (em (a = 0))
... = sign a * (to_nat a) * (sign b * (to_nat b)) : {symm (mul_sign_to_nat b)}
... = sign a * sign b * (to_nat (a * b)) : by simp,
have H2 : (to_nat (a * b)) ≠ 0, from
take H2', mul_ne_zero Ha Hb (abs_eq_zero H2'),
take H2', mul_ne_zero Ha Hb (to_nat_eq_zero H2'),
have H3 : (to_nat (a * b)) ≠ of_nat 0, from contrapos of_nat_inj H2,
mul_cancel_right H3 H))
@ -1418,7 +1401,7 @@ or_elim3 (trichotomy a 0) sorry sorry sorry
-- add_rewrite sign_neg
theorem abs_sign_ne_zero {a : } (H : a ≠ 0) : (to_nat (sign a)) = 1 :=
theorem to_nat_sign_ne_zero {a : } (H : a ≠ 0) : (to_nat (sign a)) = 1 :=
or_elim3 (trichotomy a 0) sorry
-- (by simp)
(assume H2 : a = 0, absurd_elim _ H2 H)

View file

@ -2,4 +2,4 @@
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Author: Jeremy Avigad
import data.nat.basic
import data.int.basic

View file

@ -24,16 +24,6 @@ using fake_simplifier decidable
namespace nat
-- TODO: settle on a name, and move this
theorem by_cases (a : Prop) {b : Prop} {C : decidable a} (Hab : a → b) (Hnab : ¬a → b) : b :=
or_elim (em a) (assume Ha, Hab Ha) (assume Hna, Hnab Hna)
-- move to nat
theorem pos_imp_ne_zero {n : } (H : n > 0) : n ≠ 0 :=
ne_symm (lt_imp_ne H)
-- A general recursion principle
-- =============================
--
@ -102,7 +92,7 @@ case_strong_induction_on m
funext
(take x : dom,
show f' (succ m) x = restrict default measure f (succ m) x, from
by_cases (measure x < succ m)
by_cases -- (measure x < succ m)
(assume H1 : measure x < succ m,
have H2 [fact] : f' (succ m) x = rec_val x f, from
calc
@ -165,14 +155,14 @@ theorem div_aux_decreasing (y : ) (g : ) (m : ) (x : ) (H :
let lhs := div_aux_rec y x g in
let rhs := div_aux_rec y x (restrict 0 (fun x, x) g m) in
show lhs = rhs, from
by_cases (y = 0 x < y)
by_cases -- (y = 0 x < y)
(assume H1 : y = 0 x < y,
calc
lhs = 0 : if_pos H1 _ _
... = rhs : symm (if_pos H1 _ _))
(assume H1 : ¬ (y = 0 x < y),
have H2 : y ≠ 0 ∧ ¬ x < y, from not_or _ _ ◂ H1,
have ypos : y > 0, from ne_zero_pos (and_elim_left H2),
have ypos : y > 0, from ne_zero_imp_pos (and_elim_left H2),
have xgey : x ≥ y, from not_lt_imp_ge (and_elim_right H2),
have H4 : x - y < x, from sub_lt (lt_le_trans ypos xgey) ypos,
have H5 : x - y < m, from lt_le_trans H4 H,
@ -241,14 +231,14 @@ theorem mod_aux_decreasing (y : ) (g : ) (m : ) (x : ) (H :
let lhs := mod_aux_rec y x g in
let rhs := mod_aux_rec y x (restrict 0 (fun x, x) g m) in
show lhs = rhs, from
by_cases (y = 0 x < y)
by_cases -- (y = 0 x < y)
(assume H1 : y = 0 x < y,
calc
lhs = x : if_pos H1 _ _
... = rhs : symm (if_pos H1 _ _))
(assume H1 : ¬ (y = 0 x < y),
have H2 : y ≠ 0 ∧ ¬ x < y, from not_or _ _ ◂ H1,
have ypos : y > 0, from ne_zero_pos (and_elim_left H2),
have ypos : y > 0, from ne_zero_imp_pos (and_elim_left H2),
have xgey : x ≥ y, from not_lt_imp_ge (and_elim_right H2),
have H4 : x - y < x, from sub_lt (lt_le_trans ypos xgey) ypos,
have H5 : x - y < m, from lt_le_trans H4 H,
@ -325,7 +315,7 @@ case_strong_induction_on x
(take x,
assume IH : ∀x', x' ≤ x → x' mod y < y,
show succ x mod y < y, from
by_cases (succ x < y)
by_cases -- (succ x < y)
(assume H1 : succ x < y,
have H2 : succ x mod y = succ x, from mod_lt_eq H1,
show succ x mod y < y, from subst (symm H2) H1)
@ -351,7 +341,7 @@ case_zero_pos y
(take x,
assume IH : ∀x', x' ≤ x → x' = x' div y * y + x' mod y,
show succ x = succ x div y * y + succ x mod y, from
by_cases (succ x < y)
by_cases -- (succ x < y)
(assume H1 : succ x < y,
have H2 : succ x div y = 0, from div_less H1,
have H3 : succ x mod y = succ x, from mod_lt_eq H1,
@ -393,10 +383,10 @@ have H6 : y > 0, from le_lt_trans (zero_le _) H1,
show q1 = q2, from mul_cancel_right H6 H5
theorem div_mul_mul {z : } (x y : ) (zpos : z > 0) : (z * x) div (z * y) = x div y :=
by_cases (y = 0)
by_cases -- (y = 0)
(assume H : y = 0, by simp)
(assume H : y ≠ 0,
have ypos : y > 0, from ne_zero_pos H,
have ypos : y > 0, from ne_zero_imp_pos H,
have zypos : z * y > 0, from mul_pos zpos ypos,
have H1 : (z * x) mod (z * y) < z * y, from mod_lt _ zypos,
have H2 : z * (x mod y) < z * y, from mul_lt_left zpos (mod_lt _ ypos),
@ -410,10 +400,10 @@ by_cases (y = 0)
--- ... = (x div y) * (z * y) + z * (x mod y) : by simp))
theorem mod_mul_mul {z : } (x y : ) (zpos : z > 0) : (z * x) mod (z * y) = z * (x mod y) :=
by_cases (y = 0)
by_cases -- (y = 0)
(assume H : y = 0, by simp)
(assume H : y ≠ 0,
have ypos : y > 0, from ne_zero_pos H,
have ypos : y > 0, from ne_zero_imp_pos H,
have zypos : z * y > 0, from mul_pos zpos ypos,
have H1 : (z * x) mod (z * y) < z * y, from mod_lt _ zypos,
have H2 : z * (x mod y) < z * y, from mul_lt_left zpos (mod_lt _ ypos),
@ -477,7 +467,7 @@ have H2 : (z - x div y) * y = x mod y, from
... = x mod y + x div y * y - x div y * y : {H1}
... = x mod y : sub_add_left _ _,
show x mod y = 0, from
by_cases (y = 0)
by_cases -- (y = 0)
(assume yz : y = 0,
have xz : x = 0, from
calc
@ -489,7 +479,7 @@ show x mod y = 0, from
... = x : mod_zero _
... = 0 : xz)
(assume ynz : y ≠ 0,
have ypos : y > 0, from ne_zero_pos ynz,
have ypos : y > 0, from ne_zero_imp_pos ynz,
have H3 : (z - x div y) * y < y, from subst (symm H2) (mod_lt x ypos),
have H4 : (z - x div y) * y < 1 * y, from subst (symm (mul_one_left y)) H3,
have H5 : z - x div y < 1, from mul_lt_cancel_right H4,
@ -578,7 +568,7 @@ theorem dvd_add_cancel_right {m n1 n2 : } (H : m | (n1 + n2)) : m | n2 → m
dvd_add_cancel_left (subst (add_comm _ _) H)
theorem dvd_sub {m n1 n2 : } (H1 : m | n1) (H2 : m | n2) : m | (n1 - n2) :=
by_cases _
by_cases
(assume H3 : n1 ≥ n2,
have H4 : n1 = n1 - n2 + n2, from symm (add_sub_ge_left H3),
show m | n1 - n2, from dvd_add_cancel_right (subst H4 H1) H2)
@ -608,13 +598,13 @@ let p' := pair y (x mod y) in
let lhs := gcd_aux_rec p g in
let rhs := gcd_aux_rec p (restrict 0 gcd_aux_measure g m) in
show lhs = rhs, from
by_cases (y = 0)
by_cases -- (y = 0)
(assume H1 : y = 0,
calc
lhs = x : if_pos H1 _ _
... = rhs : symm (if_pos H1 _ _))
(assume H1 : y ≠ 0,
have ypos : y > 0, from ne_zero_pos H1,
have ypos : y > 0, from ne_zero_imp_pos H1,
have H2 : gcd_aux_measure p' = x mod y, from pr2_pair _ _,
have H3 : gcd_aux_measure p' < gcd_aux_measure p, from subst (symm H2) (mod_lt _ ypos),
have H4: gcd_aux_measure p' < m, from lt_le_trans H3 H,

View file

@ -276,12 +276,6 @@ infix `>` : 50 := gt
theorem lt_def (n m : ) : (n < m) = (succ n ≤ m) := refl (n < m)
-- theorem gt_def (n m : ) : n > m ↔ m < n
-- := refl (n > m)
-- theorem ge_def (n m : ) : n ≥ m ↔ m ≤ n
-- := refl (n ≥ m)
-- add_rewrite gt_def ge_def --it might be possible to remove this in Lean 0.2
theorem lt_intro {n m k : } (H : succ n + k = m) : n < m :=
@ -491,9 +485,12 @@ or_imp_or_left (or_swap (le_imp_lt_or_eq (zero_le n))) (take H : 0 = n, symm H)
theorem succ_imp_pos {n m : } (H : n = succ m) : n > 0 :=
H⁻¹ ▸ (succ_pos m)
theorem ne_zero_pos {n : } (H : n ≠ 0) : n > 0 :=
theorem ne_zero_imp_pos {n : } (H : n ≠ 0) : n > 0 :=
or_elim (zero_or_pos n) (take H2 : n = 0, absurd_elim _ H2 H) (take H2 : n > 0, H2)
theorem pos_imp_ne_zero {n : } (H : n > 0) : n ≠ 0 :=
ne_symm (lt_imp_ne H)
theorem pos_imp_eq_succ {n : } (H : n > 0) : exists l, n = succ l :=
lt_imp_eq_succ H
@ -606,4 +603,5 @@ mul_eq_one_left ((mul_comm n m) ▸ H)
--- theorem mul_eq_one {n m : } (H : n * m = 1) : n = 1 ∧ m = 1
--- := and_intro (mul_eq_one_left H) (mul_eq_one_right H)
end nat

View file

@ -2,9 +2,9 @@
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Author: Leonardo de Moura, Jeremy Avigad
import logic.classes.inhabited logic.connectives.eq
import logic.classes.inhabited logic.connectives.eq logic.classes.decidable
using inhabited
using inhabited decidable
inductive prod (A B : Type) : Type :=
| pair : A → B → prod A B
@ -43,8 +43,17 @@ section
theorem prod_inhabited (H1 : inhabited A) (H2 : inhabited B) : inhabited (prod A B) :=
inhabited_destruct H1 (λa, inhabited_destruct H2 (λb, inhabited_mk (pair a b)))
theorem prod_eq_decidable (u v : A × B) (H1 : decidable (pr1 u = pr1 v))
(H2 : decidable (pr2 u = pr2 v)) : decidable (u = v) :=
have H3 : u = v ↔ (pr1 u = pr1 v) ∧ (pr2 u = pr2 v), from
iff_intro
(assume H, subst H (and_intro (refl _) (refl _)))
(assume H, and_elim H (assume H4 H5, prod_eq H4 H5)),
decidable_iff_equiv _ (iff_symm H3)
end
instance prod_inhabited
instance prod_eq_decidable
end prod

View file

@ -126,8 +126,8 @@ have H2 [fact] : R a (rep (abs a)), from R_rep_abs Q Ha,
calc
rec Q f (abs a) = eq_rec_on _ (f (rep (abs a))) : rfl
... = eq_rec_on _ (eq_rec_on _ (f a)) : {symm (H _ _ H2)}
... = eq_rec_on _ (f a) : eq_rec_on_compose _ _ _
... = f a : eq_rec_on_id _ _
... = eq_rec_on _ (f a) : eq_rec_on_compose (eq_abs Q H2) _ _
... = f a : eq_rec_on_id (trans (eq_abs Q H2) (abs_rep Q (abs a))) _
definition rec_constant {A B : Type} {R : A → A → Prop} {abs : A → B} {rep : B → A}
(Q : is_quotient R abs rep) {C : Type} (f : A → C) (b : B) : C :=

View file

@ -48,7 +48,7 @@ section
∀(H1 : dpr1 p1 = dpr1 p2) (H2 : eq_rec_on H1 (dpr2 p1) = (dpr2 p2)), p1 = p2 :=
sigma_destruct p1 (take a1 b1, sigma_destruct p2 (take a2 b2 H1 H2, dpair_eq H1 H2))
theorem sigma_inhabited (H1 : inhabited A) (H2 : inhabited (B (default A))) :
theorem sigma_inhabited [instance] (H1 : inhabited A) (H2 : inhabited (B (default A))) :
inhabited (sigma B) :=
inhabited_destruct H1 (λa, inhabited_destruct H2 (λb, inhabited_mk (dpair (default A) b)))

View file

@ -2,7 +2,9 @@
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Author: Leonardo de Moura, Jeremy Avigad
import logic.classes.inhabited logic.connectives.eq
import logic.classes.inhabited logic.connectives.eq logic.classes.decidable
using decidable
inductive subtype {A : Type} (P : A → Prop) : Type :=
| tag : Πx : A, P x → subtype P
@ -36,10 +38,18 @@ section
theorem subtype_eq {a1 a2 : {x | P x}} : ∀(H : elt_of a1 = elt_of a2), a1 = a2 :=
subtype_destruct a1 (take x1 H1, subtype_destruct a2 (take x2 H2 H, tag_eq H))
-- TODO: need inhabited
theorem subtype_inhabited {a : A} (H : P a) : inhabited {x | P x} :=
inhabited_mk (tag a H)
theorem subtype_eq_decidable (a1 a2 : {x | P x})
(H : decidable (elt_of a1 = elt_of a2)) : decidable (a1 = a2) :=
have H1 : (a1 = a2) ↔ (elt_of a1 = elt_of a2), from
iff_intro (assume H, subst H rfl) (assume H, subtype_eq H),
decidable_iff_equiv _ (iff_symm H1)
end
end subtype
instance subtype_inhabited
instance subtype_eq_decidable
-- instance subtype_inhabited
end subtype

View file

@ -1,18 +1,33 @@
----------------------------------------------------------------------------------------------------
-- Copyright (c) 2014 Microsoft Corporation. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Author: Leonardo de Moura
----------------------------------------------------------------------------------------------------
-- Author: Leonardo de Moura, Jeremy Avigad
import logic.connectives.prop
import logic.connectives.prop logic.classes.inhabited logic.classes.decidable
using inhabited decidable
namespace sum
-- TODO: take this outside the namespace when the inductive package handles it better
inductive sum (A B : Type) : Type :=
| inl : A → sum A B
| inr : B → sum A B
infixr `+`:25 := sum
theorem induction_on {A B : Type} {C : Prop} (s : A + B) (H1 : A → C) (H2 : B → C) : C :=
theorem cases_on {A B : Type} {C : Prop} (s : A + B) (H1 : A → C) (H2 : B → C) : C :=
sum_rec H1 H2 s
-- TODO: need equality lemmas
-- theorem inl_eq {A : Type} (B : Type) {a1 a2 : A} (H : inl B a1 = inl B a2) : a1 = a2 := sorry
theorem sum_inhabited_left [instance] {A B : Type} (H : inhabited A) : inhabited (A + B) :=
inhabited_mk (inl B (default A))
theorem sum_inhabited_right [instance] {A B : Type} (H : inhabited B) : inhabited (A + B) :=
inhabited_mk (inr A (default B))
--theorem sum_eq_decidable [instance] {A B : Type} (s1 s2 : A + B) : decidable (s1 = s2) :=
--cases_
end sum

View file

@ -1,8 +1,6 @@
----------------------------------------------------------------------------------------------------
-- Copyright (c) 2014 Microsoft Corporation. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Author: Leonardo de Moura
----------------------------------------------------------------------------------------------------
import logic.connectives.basic logic.connectives.eq
@ -12,16 +10,17 @@ inductive decidable (p : Prop) : Type :=
| inl : p → decidable p
| inr : ¬p → decidable p
theorem decidable_true [instance] : decidable true :=
theorem true_decidable [instance] : decidable true :=
inl trivial
theorem decidable_false [instance] : decidable false :=
theorem false_decidable [instance] : decidable false :=
inr not_false_trivial
theorem induction_on {p : Prop} {C : Prop} (H : decidable p) (H1 : p → C) (H2 : ¬p → C) : C :=
decidable_rec H1 H2 H
definition rec_on [inline] {p : Prop} {C : Type} (H : decidable p) (H1 : p → C) (H2 : ¬p → C) : C :=
definition rec_on [inline] {p : Prop} {C : Type} (H : decidable p) (H1 : p → C) (H2 : ¬p → C) :
C :=
decidable_rec H1 H2 H
theorem irrelevant {p : Prop} (d1 d2 : decidable p) : d1 = d2 :=
@ -39,40 +38,48 @@ decidable_rec
theorem em (p : Prop) {H : decidable p} : p ¬p :=
induction_on H (λ Hp, or_inl Hp) (λ Hnp, or_inr Hnp)
theorem by_cases {a b : Prop} {C : decidable a} (Hab : a → b) (Hnab : ¬a → b) : b :=
or_elim (em a) (assume Ha, Hab Ha) (assume Hna, Hnab Hna)
theorem by_contradiction {p : Prop} {Hp : decidable p} (H : ¬p → false) : p :=
or_elim (em p)
(assume H1 : p, H1)
(assume H1 : ¬p, false_elim p (H H1))
theorem decidable_and [instance] {a b : Prop} (Ha : decidable a) (Hb : decidable b) : decidable (a ∧ b) :=
theorem and_decidable [instance] {a b : Prop} (Ha : decidable a) (Hb : decidable b) :
decidable (a ∧ b) :=
rec_on Ha
(assume Ha : a, rec_on Hb
(assume Hb : b, inl (and_intro Ha Hb))
(assume Hnb : ¬b, inr (and_not_right a Hnb)))
(assume Hna : ¬a, inr (and_not_left b Hna))
theorem decidable_or [instance] {a b : Prop} (Ha : decidable a) (Hb : decidable b) : decidable (a b) :=
theorem or_decidable [instance] {a b : Prop} (Ha : decidable a) (Hb : decidable b) :
decidable (a b) :=
rec_on Ha
(assume Ha : a, inl (or_inl Ha))
(assume Hna : ¬a, rec_on Hb
(assume Hb : b, inl (or_inr Hb))
(assume Hnb : ¬b, inr (or_not_intro Hna Hnb)))
theorem decidable_not [instance] {a : Prop} (Ha : decidable a) : decidable (¬a) :=
theorem not_decidable [instance] {a : Prop} (Ha : decidable a) : decidable (¬a) :=
rec_on Ha
(assume Ha, inr (not_not_intro Ha))
(assume Hna, inl Hna)
theorem decidable_iff [instance] {a b : Prop} (Ha : decidable a) (Hb : decidable b) : decidable (a ↔ b) :=
theorem iff_decidable [instance] {a b : Prop} (Ha : decidable a) (Hb : decidable b) :
decidable (a ↔ b) :=
rec_on Ha
(assume Ha, rec_on Hb
(assume Hb : b, inl (iff_intro (assume H, Hb) (assume H, Ha)))
(assume Hnb : ¬b, inr (assume H : a ↔ b, absurd (iff_elim_left H Ha) Hnb)))
(assume Hna, rec_on Hb
(assume Hb : b, inr (assume H : a ↔ b, absurd (iff_elim_right H Hb) Hna))
(assume Hnb : ¬b, inl (iff_intro (assume Ha, absurd_elim b Ha Hna) (assume Hb, absurd_elim a Hb Hnb))))
(assume Hnb : ¬b, inl
(iff_intro (assume Ha, absurd_elim b Ha Hna) (assume Hb, absurd_elim a Hb Hnb))))
theorem decidable_implies [instance] {a b : Prop} (Ha : decidable a) (Hb : decidable b) : decidable (a → b) :=
theorem implies_decidable [instance] {a b : Prop} (Ha : decidable a) (Hb : decidable b) :
decidable (a → b) :=
rec_on Ha
(assume Ha : a, rec_on Hb
(assume Hb : b, inl (assume H, Hb))