diff --git a/hott/algebra/binary.hlean b/hott/algebra/binary.hlean index 7f11d3c6ea..dab145c8d5 100644 --- a/hott/algebra/binary.hlean +++ b/hott/algebra/binary.hlean @@ -84,3 +84,34 @@ namespace binary {A B : Type} (f : A → A → A) (g : B → A) (lcomm : left_commutative f) : left_commutative (compose_left f g) := λ a b₁ b₂, !lcomm end binary + +open eq +namespace is_equiv + definition inv_preserve_binary {A B : Type} (f : A → B) [H : is_equiv f] + (mA : A → A → A) (mB : B → B → B) (H : Π(a a' : A), mB (f a) (f a') = f (mA a a')) + (b b' : B) : f⁻¹ (mB b b') = mA (f⁻¹ b) (f⁻¹ b') := + begin + have H2 : f⁻¹ (mB (f (f⁻¹ b)) (f (f⁻¹ b'))) = f⁻¹ (f (mA (f⁻¹ b) (f⁻¹ b'))), from ap f⁻¹ !H, + rewrite [+right_inv f at H2,left_inv f at H2,▸* at H2,H2] + end + + definition preserve_binary_of_inv_preserve {A B : Type} (f : A → B) [H : is_equiv f] + (mA : A → A → A) (mB : B → B → B) (H : Π(b b' : B), mA (f⁻¹ b) (f⁻¹ b') = f⁻¹ (mB b b')) + (a a' : A) : f (mA a a') = mB (f a) (f a') := + begin + have H2 : f (mA (f⁻¹ (f a)) (f⁻¹ (f a'))) = f (f⁻¹ (mB (f a) (f a'))), from ap f !H, + rewrite [right_inv f at H2,+left_inv f at H2,▸* at H2,H2] + end +end is_equiv +namespace equiv + open is_equiv equiv.ops + definition inv_preserve_binary {A B : Type} (f : A ≃ B) + (mA : A → A → A) (mB : B → B → B) (H : Π(a a' : A), mB (f a) (f a') = f (mA a a')) + (b b' : B) : f⁻¹ (mB b b') = mA (f⁻¹ b) (f⁻¹ b') := + inv_preserve_binary f mA mB H b b' + + definition preserve_binary_of_inv_preserve {A B : Type} (f : A ≃ B) + (mA : A → A → A) (mB : B → B → B) (H : Π(b b' : B), mA (f⁻¹ b) (f⁻¹ b') = f⁻¹ (mB b b')) + (a a' : A) : f (mA a a') = mB (f a) (f a') := + preserve_binary_of_inv_preserve f mA mB H a a' +end equiv diff --git a/hott/algebra/category/functor/examples.hlean b/hott/algebra/category/functor/examples.hlean index 8824e06116..28e698c7ed 100644 --- a/hott/algebra/category/functor/examples.hlean +++ b/hott/algebra/category/functor/examples.hlean @@ -35,7 +35,7 @@ namespace functor apply nat_trans_eq, intro d, calc natural_map (Fhom F (f' ∘ f)) d = F (f' ∘ f, id) : by esimp - ... = F (f' ∘ f, id ∘ id) : by rewrite id_id + ... = F (f' ∘ f, category.id ∘ category.id) : by rewrite id_id ... = F ((f',id) ∘ (f, id)) : by esimp ... = F (f',id) ∘ F (f, id) : by rewrite [respect_comp F] ... = natural_map ((Fhom F f') ∘ (Fhom F f)) d : by esimp @@ -119,10 +119,11 @@ namespace functor apply id_leftright, show (functor_uncurry (functor_curry F)) (f, g) = F (f,g), from calc - (functor_uncurry (functor_curry F)) (f, g) = to_fun_hom F (id, g) ∘ to_fun_hom F (f, id) : by esimp - ... = F (id ∘ f, g ∘ id) : by krewrite [-respect_comp F (id,g) (f,id)] - ... = F (f, g ∘ id) : by rewrite id_left - ... = F (f,g) : by rewrite id_right, + (functor_uncurry (functor_curry F)) (f, g) + = to_fun_hom F (id, g) ∘ to_fun_hom F (f, id) : by esimp + ... = F (category.id ∘ f, g ∘ category.id) : (respect_comp F (id,g) (f,id))⁻¹ + ... = F (f, g ∘ category.id) : by rewrite id_left + ... = F (f,g) : by rewrite id_right, end definition functor_curry_functor_uncurry_ob (c : C) diff --git a/hott/algebra/field.hlean b/hott/algebra/field.hlean index c8940b4bb6..a74dceddfc 100644 --- a/hott/algebra/field.hlean +++ b/hott/algebra/field.hlean @@ -3,7 +3,7 @@ Copyright (c) 2014 Robert Lewis. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Robert Lewis -Structures with multiplicative and additive components, including division rings and fields. +Structures with multiplicative prod additive components, including division rings prod fields. The development is modeled after Isabelle's library. -/ import algebra.binary algebra.group algebra.ring @@ -73,7 +73,7 @@ section division_ring absurd C1 Ha theorem mul_ne_zero_comm (H : a * b ≠ 0) : b * a ≠ 0 := - have H2 : a ≠ 0 × b ≠ 0, from ne_zero_and_ne_zero_of_mul_ne_zero H, + have H2 : a ≠ 0 × b ≠ 0, from ne_zero_prod_ne_zero_of_mul_ne_zero H, division_ring.mul_ne_zero (prod.pr2 H2) (prod.pr1 H2) theorem eq_one_div_of_mul_eq_one (H : a * b = 1) : b = 1 / a := @@ -222,7 +222,7 @@ section field by rewrite [(division_ring.one_div_mul_one_div Ha Hb), mul.comm b] theorem field.div_mul_right (Hb : b ≠ 0) (H : a * b ≠ 0) : a / (a * b) = 1 / b := - have a ≠ 0, from prod.pr1 (ne_zero_and_ne_zero_of_mul_ne_zero H), + have a ≠ 0, from prod.pr1 (ne_zero_prod_ne_zero_of_mul_ne_zero H), symm (calc 1 / b = 1 * (1 / b) : one_mul ... = (a * a⁻¹) * (1 / b) : mul_inv_cancel this @@ -324,10 +324,10 @@ section discrete_field include s variables {a b c d : A} - -- many of the theorems in discrete_field are the same as theorems in field or division ring, - -- but with fewer hypotheses since 0⁻¹ = 0 and equality is decidable. + -- many of the theorems in discrete_field are the same as theorems in field sum division ring, + -- but with fewer hypotheses since 0⁻¹ = 0 prod equality is decidable. - theorem discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero + theorem discrete_field.eq_zero_sum_eq_zero_of_mul_eq_zero (x y : A) (H : x * y = 0) : x = 0 ⊎ y = 0 := decidable.by_cases (suppose x = 0, sum.inl this) @@ -337,7 +337,7 @@ section discrete_field definition discrete_field.to_integral_domain [trans_instance] [reducible] : integral_domain A := ⦃ integral_domain, s, - eq_zero_or_eq_zero_of_mul_eq_zero := discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero⦄ + eq_zero_sum_eq_zero_of_mul_eq_zero := discrete_field.eq_zero_sum_eq_zero_of_mul_eq_zero⦄ theorem inv_zero : 0⁻¹ = (0:A) := !discrete_field.inv_zero @@ -524,5 +524,4 @@ theorem subst_into_div [s : has_div A] (a₁ b₁ a₂ b₂ v : A) (H : a₁ / b by rewrite [H1, H2, H] end norm_num - end algebra diff --git a/hott/algebra/group.hlean b/hott/algebra/group.hlean index 11bd614b08..18fc19a770 100644 --- a/hott/algebra/group.hlean +++ b/hott/algebra/group.hlean @@ -9,7 +9,7 @@ Various multiplicative and additive structures. Partially modeled on Isabelle's import algebra.binary algebra.priority open eq eq.ops -- note: ⁻¹ will be overloaded -open binary algebra +open binary algebra is_trunc set_option class.force_new true variable {A : Type} @@ -19,8 +19,11 @@ variable {A : Type} namespace algebra structure semigroup [class] (A : Type) extends has_mul A := +(is_hset_carrier : is_hset A) (mul_assoc : Πa b c, mul (mul a b) c = mul a (mul b c)) +attribute semigroup.is_hset_carrier [instance] + theorem mul.assoc [s : semigroup A] (a b c : A) : a * b * c = a * (b * c) := !semigroup.mul_assoc @@ -57,8 +60,11 @@ abbreviation eq_of_mul_eq_mul_right' := @mul.right_cancel /- additive semigroup -/ structure add_semigroup [class] (A : Type) extends has_add A := +(is_hset_carrier : is_hset A) (add_assoc : Πa b c, add (add a b) c = add a (add b c)) +attribute add_semigroup.is_hset_carrier [instance] + theorem add.assoc [s : add_semigroup A] (a b c : A) : a + b + c = a + (b + c) := !add_semigroup.add_assoc @@ -121,7 +127,8 @@ definition add_monoid.to_monoid {A : Type} [s : add_monoid A] : monoid A := mul_assoc := add_monoid.add_assoc, one := add_monoid.zero A, mul_one := add_monoid.add_zero, - one_mul := add_monoid.zero_add + one_mul := add_monoid.zero_add, + is_hset_carrier := _ ⦄ definition add_comm_monoid.to_comm_monoid {A : Type} [s : add_comm_monoid A] : comm_monoid A := @@ -577,7 +584,8 @@ definition group_of_add_group (A : Type) [G : add_group A] : group A := one_mul := zero_add, mul_one := add_zero, inv := has_neg.neg, - mul_left_inv := add.left_inv⦄ + mul_left_inv := add.left_inv, + is_hset_carrier := _⦄ namespace norm_num reveal add.assoc diff --git a/hott/algebra/homotopy_group.hlean b/hott/algebra/homotopy_group.hlean index 9c0a38d33d..c66587949b 100644 --- a/hott/algebra/homotopy_group.hlean +++ b/hott/algebra/homotopy_group.hlean @@ -65,8 +65,7 @@ namespace eq fapply Group_eq, { apply equiv_of_eq, exact ap (λ(X : Type*), trunc 0 X) (loop_space_succ_eq_in A (succ n))}, { exact abstract [irreducible] begin refine trunc.rec _, intro p, refine trunc.rec _, intro q, - rewrite [▸*,-+tr_eq_cast_ap, +trunc_transport, ↑[group_homotopy_group, group.to_monoid, - monoid.to_semigroup, semigroup.to_has_mul, trunc_mul], trunc_transport], apply ap tr, + rewrite [▸*,-+tr_eq_cast_ap, +trunc_transport], refine !trunc_transport ⬝ _, apply ap tr, apply loop_space_succ_eq_in_concat end end}, end diff --git a/hott/algebra/hott.hlean b/hott/algebra/hott.hlean index 370c21f728..b59b577e79 100644 --- a/hott/algebra/hott.hlean +++ b/hott/algebra/hott.hlean @@ -6,11 +6,20 @@ Author: Floris van Doorn Theorems about algebra specific to HoTT -/ -import .group arity types.pi hprop_trunc types.unit +import .group arity types.pi hprop_trunc types.unit .bundled -open equiv eq equiv.ops is_trunc +open equiv eq equiv.ops is_trunc unit namespace algebra + + definition trivial_group [constructor] : group unit := + group.mk (λx y, star) _ (λx y z, idp) star (unit.rec idp) (unit.rec idp) (λx, star) (λx, idp) + + definition Trivial_group [constructor] : Group := + Group.mk _ trivial_group + + notation `G0` := Trivial_group + open Group has_mul has_inv -- we prove under which conditions two groups are equal diff --git a/hott/algebra/order.hlean b/hott/algebra/order.hlean index ed8aa57520..21f2e39ecb 100644 --- a/hott/algebra/order.hlean +++ b/hott/algebra/order.hlean @@ -3,11 +3,11 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Jeremy Avigad -Weak orders "≤", strict orders "<", and structures that include both. +Weak orders "≤", strict orders "<", prod structures that include both. -/ import algebra.binary algebra.priority open eq eq.ops algebra ---set_option class.force_new true +-- set_option class.force_new true variable {A : Type} @@ -25,6 +25,8 @@ section theorem le.refl (a : A) : a ≤ a := !weak_order.le_refl + theorem le_of_eq {a b : A} (H : a = b) : a ≤ b := H ▸ le.refl a + theorem le.trans [trans] {a b c : A} : a ≤ b → b ≤ c → a ≤ c := !weak_order.le_trans theorem ge.trans [trans] {a b c : A} (H1 : a ≥ b) (H2: b ≥ c) : a ≥ c := le.trans H2 H1 @@ -83,9 +85,7 @@ definition wf.rec_on {A : Type} [s : wf_strict_order A] {P : A → Type} (x : A) (H : Πx, (Πy, wf_strict_order.lt y x → P y) → P x) : P x := wf_strict_order.wf_rec P H x -definition wf.ind_on := @wf.rec_on - -/- structures with a weak and a strict order -/ +/- structures with a weak prod a strict order -/ structure order_pair [class] (A : Type) extends weak_order A, has_lt A := (le_of_lt : Π a b, lt a b → le a b) @@ -126,36 +126,36 @@ section end structure strong_order_pair [class] (A : Type) extends weak_order A, has_lt A := -(le_iff_lt_or_eq : Πa b, le a b ↔ lt a b ⊎ a = b) +(le_iff_lt_sum_eq : Πa b, le a b ↔ lt a b ⊎ a = b) (lt_irrefl : Π a, ¬ lt a a) -theorem le_iff_lt_or_eq [s : strong_order_pair A] {a b : A} : a ≤ b ↔ a < b ⊎ a = b := -!strong_order_pair.le_iff_lt_or_eq +theorem le_iff_lt_sum_eq [s : strong_order_pair A] {a b : A} : a ≤ b ↔ a < b ⊎ a = b := +!strong_order_pair.le_iff_lt_sum_eq -theorem lt_or_eq_of_le [s : strong_order_pair A] {a b : A} (le_ab : a ≤ b) : a < b ⊎ a = b := -iff.mp le_iff_lt_or_eq le_ab +theorem lt_sum_eq_of_le [s : strong_order_pair A] {a b : A} (le_ab : a ≤ b) : a < b ⊎ a = b := +iff.mp le_iff_lt_sum_eq le_ab -theorem le_of_lt_or_eq [s : strong_order_pair A] {a b : A} (lt_or_eq : a < b ⊎ a = b) : a ≤ b := -iff.mpr le_iff_lt_or_eq lt_or_eq +theorem le_of_lt_sum_eq [s : strong_order_pair A] {a b : A} (lt_sum_eq : a < b ⊎ a = b) : a ≤ b := +iff.mpr le_iff_lt_sum_eq lt_sum_eq private theorem lt_irrefl' [s : strong_order_pair A] (a : A) : ¬ a < a := !strong_order_pair.lt_irrefl private theorem le_of_lt' [s : strong_order_pair A] (a b : A) : a < b → a ≤ b := -take Hlt, le_of_lt_or_eq (sum.inl Hlt) +take Hlt, le_of_lt_sum_eq (sum.inl Hlt) -private theorem lt_iff_le_and_ne [s : strong_order_pair A] {a b : A} : a < b ↔ (a ≤ b × a ≠ b) := +private theorem lt_iff_le_prod_ne [s : strong_order_pair A] {a b : A} : a < b ↔ (a ≤ b × a ≠ b) := iff.intro - (take Hlt, pair (le_of_lt_or_eq (sum.inl Hlt)) (take Hab, absurd (Hab ▸ Hlt) !lt_irrefl')) + (take Hlt, pair (le_of_lt_sum_eq (sum.inl Hlt)) (take Hab, absurd (Hab ▸ Hlt) !lt_irrefl')) (take Hand, - have Hor : a < b ⊎ a = b, from lt_or_eq_of_le (prod.pr1 Hand), + have Hor : a < b ⊎ a = b, from lt_sum_eq_of_le (prod.pr1 Hand), sum_resolve_left Hor (prod.pr2 Hand)) theorem lt_of_le_of_ne [s : strong_order_pair A] {a b : A} : a ≤ b → a ≠ b → a < b := -take H1 H2, iff.mpr lt_iff_le_and_ne (pair H1 H2) +take H1 H2, iff.mpr lt_iff_le_prod_ne (pair H1 H2) private theorem ne_of_lt' [s : strong_order_pair A] {a b : A} (H : a < b) : a ≠ b := -prod.pr2 (iff.mp (@lt_iff_le_and_ne _ _ _ _) H) +prod.pr2 ((iff.mp (@lt_iff_le_prod_ne _ _ _ _)) H) private theorem lt_of_lt_of_le' [s : strong_order_pair A] (a b c : A) : a < b → b ≤ c → a < c := assume lt_ab : a < b, @@ -166,7 +166,7 @@ have ne_ac : a ≠ c, from have le_ba : b ≤ a, from eq_ac⁻¹ ▸ le_bc, have eq_ab : a = b, from le.antisymm (le_of_lt' _ _ lt_ab) le_ba, show empty, from ne_of_lt' lt_ab eq_ab, -show a < c, from iff.mpr (lt_iff_le_and_ne) (pair le_ac ne_ac) +show a < c, from iff.mpr (lt_iff_le_prod_ne) (pair le_ac ne_ac) theorem lt_of_le_of_lt' [s : strong_order_pair A] (a b c : A) : a ≤ b → b < c → a < c := assume le_ab : a ≤ b, @@ -177,7 +177,7 @@ have ne_ac : a ≠ c, from have le_cb : c ≤ b, from eq_ac ▸ le_ab, have eq_bc : b = c, from le.antisymm (le_of_lt' _ _ lt_bc) le_cb, show empty, from ne_of_lt' lt_bc eq_bc, -show a < c, from iff.mpr (lt_iff_le_and_ne) (pair le_ac ne_ac) +show a < c, from iff.mpr (lt_iff_le_prod_ne) (pair le_ac ne_ac) definition strong_order_pair.to_order_pair [trans_instance] [reducible] [s : strong_order_pair A] : order_pair A := @@ -206,18 +206,21 @@ section theorem lt.trichotomy : a < b ⊎ a = b ⊎ b < a := sum.elim (le.total a b) (assume H : a ≤ b, - sum.elim (iff.mp (@le_iff_lt_or_eq _ _ _ _) H) (assume H1, sum.inl H1) (assume H1, sum.inr (sum.inl H1))) + sum.elim (iff.mp !le_iff_lt_sum_eq H) (assume H1, sum.inl H1) (assume H1, sum.inr (sum.inl H1))) (assume H : b ≤ a, - sum.elim (iff.mp (@le_iff_lt_or_eq _ _ _ _) H) + sum.elim (iff.mp !le_iff_lt_sum_eq H) (assume H1, sum.inr (sum.inr H1)) (assume H1, sum.inr (sum.inl (H1⁻¹)))) - theorem lt.by_cases {a b : A} {P : Type} + definition lt.by_cases {a b : A} {P : Type} (H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P := sum.elim !lt.trichotomy (assume H, H1 H) (assume H, sum.elim H (assume H', H2 H') (assume H', H3 H')) + definition lt_ge_by_cases {a b : A} {P : Type} (H1 : a < b → P) (H2 : a ≥ b → P) : P := + lt.by_cases H1 (λH, H2 (H ▸ le.refl a)) (λH, H2 (le_of_lt H)) + theorem le_of_not_gt {a b : A} (H : ¬ a > b) : a ≤ b := lt.by_cases (assume H', absurd H' H) (assume H', H' ▸ !le.refl) (assume H', le_of_lt H') @@ -227,16 +230,16 @@ section (assume H', absurd (H' ▸ !le.refl) H) (assume H', H') - theorem lt_or_ge : a < b ⊎ a ≥ b := + theorem lt_sum_ge : a < b ⊎ a ≥ b := lt.by_cases (assume H1 : a < b, sum.inl H1) (assume H1 : a = b, sum.inr (H1 ▸ le.refl a)) (assume H1 : a > b, sum.inr (le_of_lt H1)) - theorem le_or_gt : a ≤ b ⊎ a > b := - !sum.swap (lt_or_ge b a) + theorem le_sum_gt : a ≤ b ⊎ a > b := + !sum.swap (lt_sum_ge b a) - theorem lt_or_gt_of_ne {a b : A} (H : a ≠ b) : a < b ⊎ a > b := + theorem lt_sum_gt_of_ne {a b : A} (H : a ≠ b) : a < b ⊎ a > b := lt.by_cases (assume H1, sum.inl H1) (assume H1, absurd H1 H) (assume H1, sum.inr H1) end @@ -272,12 +275,12 @@ section (assume H : ¬ a ≤ b, (inr (assume H1 : a = b, H (H1 ▸ !le.refl)))) - theorem eq_or_lt_of_not_lt {a b : A} (H : ¬ a < b) : a = b ⊎ b < a := + theorem eq_sum_lt_of_not_lt {a b : A} (H : ¬ a < b) : a = b ⊎ b < a := if Heq : a = b then sum.inl Heq else sum.inr (lt_of_not_ge (λ Hge, H (lt_of_le_of_ne Hge Heq))) - theorem eq_or_lt_of_le {a b : A} (H : a ≤ b) : a = b ⊎ a < b := + theorem eq_sum_lt_of_le {a b : A} (H : a ≤ b) : a = b ⊎ a < b := begin - cases eq_or_lt_of_not_lt (not_lt_of_ge H), + cases eq_sum_lt_of_not_lt (not_lt_of_ge H), exact sum.inl a_1⁻¹, exact sum.inr a_1 end @@ -301,7 +304,7 @@ section definition min (a b : A) : A := if a ≤ b then a else b definition max (a b : A) : A := if a ≤ b then b else a - /- these show min and max form a lattice -/ + /- these show min prod max form a lattice -/ theorem min_le_left (a b : A) : min a b ≤ a := by_cases @@ -339,7 +342,7 @@ section theorem le_max_right_iff_unit (a b : A) : b ≤ max a b ↔ unit := iff_unit_intro (le_max_right a b) - /- these are also proved for lattices, but with inf and sup in place of min and max -/ + /- these are also proved for lattices, but with inf prod sup in place of min prod max -/ theorem eq_min {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) (H₃ : Π{d}, d ≤ a → d ≤ b → d ≤ c) : c = min a b := @@ -420,12 +423,12 @@ section /- these use the fact that it is a linear ordering -/ theorem lt_min {a b c : A} (H₁ : a < b) (H₂ : a < c) : a < min b c := - sum.elim !le_or_gt + sum.elim !le_sum_gt (assume H : b ≤ c, by rewrite (min_eq_left H); apply H₁) (assume H : b > c, by rewrite (min_eq_right_of_lt H); apply H₂) theorem max_lt {a b c : A} (H₁ : a < c) (H₂ : b < c) : max a b < c := - sum.elim !le_or_gt + sum.elim !le_sum_gt (assume H : a ≤ b, by rewrite (max_eq_right H); apply H₂) (assume H : a > b, by rewrite (max_eq_left_of_lt H); apply H₁) end diff --git a/hott/algebra/ordered_field.hlean b/hott/algebra/ordered_field.hlean index 01a6cd9135..c07086aaf0 100644 --- a/hott/algebra/ordered_field.hlean +++ b/hott/algebra/ordered_field.hlean @@ -5,6 +5,7 @@ Authors: Robert Lewis -/ import algebra.ordered_ring algebra.field open eq eq.ops algebra +set_option class.force_new true namespace algebra structure linear_ordered_field [class] (A : Type) extends linear_ordered_ring A, field A @@ -339,7 +340,7 @@ section linear_ordered_field apply one_div_pos_of_pos He end - theorem exists_add_lt_and_pos_of_lt (H : b < a) : Σ c : A, b + c < a × c > 0 := + theorem exists_add_lt_prod_pos_of_lt (H : b < a) : Σ c : A, b + c < a × c > 0 := sigma.mk ((a - b) / (1 + 1)) (pair (assert H2 : a + a > (b + b) + (a - b), from calc a + a > b + a : add_lt_add_right H @@ -356,7 +357,7 @@ section linear_ordered_field begin apply le_of_not_gt, intro Hb, - cases exists_add_lt_and_pos_of_lt Hb with [c, Hc], + cases exists_add_lt_prod_pos_of_lt Hb with [c, Hc], let Hc' := H c (prod.pr2 Hc), apply (not_le_of_gt (prod.pr1 Hc)) (iff.mpr !le_add_iff_sub_right_le Hc') end diff --git a/hott/algebra/ordered_group.hlean b/hott/algebra/ordered_group.hlean index c743004386..11a9eaeeb3 100644 --- a/hott/algebra/ordered_group.hlean +++ b/hott/algebra/ordered_group.hlean @@ -13,6 +13,7 @@ set_option class.force_new true variable {A : Type} /- partially ordered monoids, such as the natural numbers -/ + namespace algebra structure ordered_cancel_comm_monoid [class] (A : Type) extends add_comm_monoid A, add_left_cancel_semigroup A, add_right_cancel_semigroup A, order_pair A := @@ -122,7 +123,7 @@ section !zero_add ▸ (add_lt_add_of_le_of_lt Ha Hb) -- TODO: add nonpos version (will be easier with simplifier) - theorem add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg + theorem add_eq_zero_iff_eq_zero_prod_eq_zero_of_nonneg_of_nonneg (Ha : 0 ≤ a) (Hb : 0 ≤ b) : a + b = 0 ↔ a = 0 × b = 0 := iff.intro (assume Hab : a + b = 0, @@ -336,7 +337,7 @@ section iff.mp !add_le_iff_le_sub_left theorem add_le_iff_le_sub_right : a + b ≤ c ↔ a ≤ c - b := - have H: a + b ≤ c ↔ a + b - b ≤ c - b, from proof iff.symm (!add_le_add_right_iff) qed, + have H: a + b ≤ c ↔ a + b - b ≤ c - b, from iff.symm (!add_le_add_right_iff), !add_neg_cancel_right ▸ H theorem add_le_of_le_sub_right {a b c : A} : a ≤ c - b → a + b ≤ c := @@ -718,7 +719,7 @@ section show a = b, from eq_of_sub_eq_zero this theorem abs_pos_of_ne_zero (H : a ≠ 0) : abs a > 0 := - sum.elim (lt_or_gt_of_ne H) abs_pos_of_neg abs_pos_of_pos + sum.elim (lt_sum_gt_of_ne H) abs_pos_of_neg abs_pos_of_pos theorem abs.by_cases {P : A → Type} {a : A} (H1 : P a) (H2 : P (-a)) : P (abs a) := sum.elim (le.total 0 a) @@ -820,5 +821,4 @@ section end end - end algebra diff --git a/hott/algebra/ordered_ring.hlean b/hott/algebra/ordered_ring.hlean index 966723d454..f3e77e0e8f 100644 --- a/hott/algebra/ordered_ring.hlean +++ b/hott/algebra/ordered_ring.hlean @@ -4,16 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad Here an "ordered_ring" is partially ordered ring, which is ordered with respect to both a weak -order and an associated strict order. Our numeric structures (int, rat, and real) will be instances +order prod an associated strict order. Our numeric structures (int, rat, prod real) will be instances of "linear_ordered_comm_ring". This development is modeled after Isabelle's library. -/ import algebra.ordered_group algebra.ring -open eq eq.ops +open eq eq.ops algebra set_option class.force_new true variable {A : Type} - namespace algebra private definition absurd_a_lt_a {B : Type} {a : A} [s : strict_order A] (H : a < a) : B := absurd H (lt.irrefl a) @@ -335,7 +334,7 @@ definition linear_ordered_ring.to_linear_ordered_semiring [trans_instance] [redu structure linear_ordered_comm_ring [class] (A : Type) extends linear_ordered_ring A, comm_monoid A -theorem linear_ordered_comm_ring.eq_zero_or_eq_zero_of_mul_eq_zero [s : linear_ordered_comm_ring A] +theorem linear_ordered_comm_ring.eq_zero_sum_eq_zero_of_mul_eq_zero [s : linear_ordered_comm_ring A] {a b : A} (H : a * b = 0) : a = 0 ⊎ b = 0 := lt.by_cases (assume Ha : 0 < a, @@ -374,8 +373,8 @@ lt.by_cases definition linear_ordered_comm_ring.to_integral_domain [trans_instance] [reducible] [s: linear_ordered_comm_ring A] : integral_domain A := ⦃ integral_domain, s, - eq_zero_or_eq_zero_of_mul_eq_zero := - @linear_ordered_comm_ring.eq_zero_or_eq_zero_of_mul_eq_zero A s ⦄ + eq_zero_sum_eq_zero_of_mul_eq_zero := + @linear_ordered_comm_ring.eq_zero_sum_eq_zero_of_mul_eq_zero A s ⦄ section variable [s : linear_ordered_ring A] @@ -389,7 +388,7 @@ section theorem zero_le_one : 0 ≤ (1:A) := one_mul 1 ▸ mul_self_nonneg 1 - theorem pos_and_pos_or_neg_and_neg_of_mul_pos {a b : A} (Hab : a * b > 0) : + theorem pos_prod_pos_sum_neg_prod_neg_of_mul_pos {a b : A} (Hab : a * b > 0) : (a > 0 × b > 0) ⊎ (a < 0 × b < 0) := lt.by_cases (assume Ha : 0 < a, @@ -712,7 +711,7 @@ section end -/- TODO: Multiplication and one, starting with mult_right_le_one_le. -/ +/- TODO: Multiplication prod one, starting with mult_right_le_one_le. -/ namespace norm_num @@ -740,5 +739,4 @@ theorem nonzero_of_neg_helper [s : linear_ordered_ring A] (a : A) (H : a ≠ 0) begin intro Ha, apply H, apply eq_of_neg_eq_neg, rewrite neg_zero, exact Ha end end norm_num - end algebra diff --git a/hott/algebra/port.md b/hott/algebra/port.md index eaea71beac..3a132cd260 100644 --- a/hott/algebra/port.md +++ b/hott/algebra/port.md @@ -1,9 +1,9 @@ -We have ported a lot of algebra files from the standard library to the HoTT library. +We port a lot of algebra files from the standard library to the HoTT library. -Port instructions for the abstract structures: -- use the script port.pl in scripts/ to port the file. e.g. execute in the scripts file: - `./port.pl ../library/algebra/lattice.lean ../hott/algebra/lattice.hlean` -- remove imports starting with `data.` or `logic.` -- open namespace algebra, and put every identifier in namespace algebra -- add option `set_option class.force_new true` -- fix all remaining errors (open namespace `eq` if needed) +Port instructions: +- use the script port.pl in scripts/ to port the file. e.g. execute the following in the `scripts` folder: `./port.pl ../library/algebra/lattice.lean ../hott/algebra/lattice.hlean` +- remove imports starting with `data.` or `logic.` (sometimes you need to replace a `data.` import by the corresponding `types.` import) +- All of the algebraic hierarchy is in the algebra namespace in the HoTT library. +- Open namespaces `eq` and `algebra` if needed +- (optional) add option `set_option class.force_new true` +- fix all remaining errors diff --git a/hott/algebra/ring.hlean b/hott/algebra/ring.hlean index 086a7d6eb8..924c3d4509 100644 --- a/hott/algebra/ring.hlean +++ b/hott/algebra/ring.hlean @@ -3,19 +3,18 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura -Structures with multiplicative and additive components, including semirings, rings, and fields. +Structures with multiplicative prod additive components, including semirings, rings, prod fields. The development is modeled after Isabelle's library. -/ -import algebra.group -open algebra eq - -variable {A : Type} +import algebra.binary algebra.group +open eq eq.ops algebra set_option class.force_new true +variable {A : Type} +namespace algebra /- auxiliary classes -/ -namespace algebra structure distrib [class] (A : Type) extends has_mul A, has_add A := (left_distrib : Πa b c, mul a (add b c) = add (mul a b) (mul a c)) (right_distrib : Πa b c, mul (add a b) c = add (mul a c) (mul b c)) @@ -247,7 +246,7 @@ section ... = 0 : mul_zero, symm (neg_eq_of_add_eq_zero this) - theorem ne_zero_and_ne_zero_of_mul_ne_zero {a b : A} (H : a * b ≠ 0) : a ≠ 0 × b ≠ 0 := + theorem ne_zero_prod_ne_zero_of_mul_ne_zero {a b : A} (H : a * b ≠ 0) : a ≠ 0 × b ≠ 0 := have a ≠ 0, from (suppose a = 0, have a * b = 0, by rewrite [this, zero_mul], @@ -256,7 +255,7 @@ section (suppose b = 0, have a * b = 0, by rewrite [this, mul_zero], absurd this H), - pair `a ≠ 0` `b ≠ 0` + prod.mk `a ≠ 0` `b ≠ 0` end structure comm_ring [class] (A : Type) extends ring A, comm_semigroup A @@ -327,11 +326,11 @@ end /- integral domains -/ structure no_zero_divisors [class] (A : Type) extends has_mul A, has_zero A := -(eq_zero_or_eq_zero_of_mul_eq_zero : Πa b, mul a b = zero → a = zero ⊎ b = zero) +(eq_zero_sum_eq_zero_of_mul_eq_zero : Πa b, mul a b = zero → a = zero ⊎ b = zero) -theorem eq_zero_or_eq_zero_of_mul_eq_zero {A : Type} [s : no_zero_divisors A] {a b : A} +theorem eq_zero_sum_eq_zero_of_mul_eq_zero {A : Type} [s : no_zero_divisors A] {a b : A} (H : a * b = 0) : - a = 0 ⊎ b = 0 := !no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero H + a = 0 ⊎ b = 0 := !no_zero_divisors.eq_zero_sum_eq_zero_of_mul_eq_zero H structure integral_domain [class] (A : Type) extends comm_ring A, no_zero_divisors A, zero_ne_one_class A @@ -342,18 +341,18 @@ section theorem mul_ne_zero {a b : A} (H1 : a ≠ 0) (H2 : b ≠ 0) : a * b ≠ 0 := suppose a * b = 0, - sum.elim (eq_zero_or_eq_zero_of_mul_eq_zero this) (assume H3, H1 H3) (assume H4, H2 H4) + sum.elim (eq_zero_sum_eq_zero_of_mul_eq_zero this) (assume H3, H1 H3) (assume H4, H2 H4) theorem eq_of_mul_eq_mul_right {a b c : A} (Ha : a ≠ 0) (H : b * a = c * a) : b = c := have b * a - c * a = 0, from iff.mp !eq_iff_sub_eq_zero H, have (b - c) * a = 0, using this, by rewrite [mul_sub_right_distrib, this], - have b - c = 0, from sum_resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero this) Ha, + have b - c = 0, from sum_resolve_left (eq_zero_sum_eq_zero_of_mul_eq_zero this) Ha, iff.elim_right !eq_iff_sub_eq_zero this theorem eq_of_mul_eq_mul_left {a b c : A} (Ha : a ≠ 0) (H : a * b = a * c) : b = c := have a * b - a * c = 0, from iff.mp !eq_iff_sub_eq_zero H, have a * (b - c) = 0, using this, by rewrite [mul_sub_left_distrib, this], - have b - c = 0, from sum_resolve_right (eq_zero_or_eq_zero_of_mul_eq_zero this) Ha, + have b - c = 0, from sum_resolve_right (eq_zero_sum_eq_zero_of_mul_eq_zero this) Ha, iff.elim_right !eq_iff_sub_eq_zero this -- TODO: do we want the iff versions? @@ -363,7 +362,7 @@ section suppose b - 1 = 0, H₁ (!zero_add ▸ eq_add_of_sub_eq this), have a * b - a = 0, by rewrite H₂; apply sub_self, have a * (b - 1) = 0, by+ rewrite [mul_sub_left_distrib, mul_one]; apply this, - show a = 0, from sum_resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero this) `b - 1 ≠ 0` + show a = 0, from sum_resolve_left (eq_zero_sum_eq_zero_of_mul_eq_zero this) `b - 1 ≠ 0` theorem eq_zero_of_mul_eq_self_left {a b : A} (H₁ : b ≠ 1) (H₂ : b * a = a) : a = 0 := eq_zero_of_mul_eq_self_right H₁ (!mul.comm ▸ H₂) @@ -373,7 +372,7 @@ section (suppose a * a = b * b, have (a - b) * (a + b) = 0, by rewrite [mul.comm, -mul_self_sub_mul_self_eq, this, sub_self], - assert a - b = 0 ⊎ a + b = 0, from !eq_zero_or_eq_zero_of_mul_eq_zero this, + assert a - b = 0 ⊎ a + b = 0, from !eq_zero_sum_eq_zero_of_mul_eq_zero this, sum.elim this (suppose a - b = 0, sum.inl (eq_of_sub_eq_zero this)) (suppose a + b = 0, sum.inr (eq_neg_of_add_eq_zero this))) @@ -385,7 +384,7 @@ section assert a * a = 1 * 1 ↔ a = 1 ⊎ a = -1, from mul_self_eq_mul_self_iff a 1, by rewrite mul_one at this; exact this - -- TODO: c - b * c → c = 0 ⊎ b = 1 and variants + -- TODO: c - b * c → c = 0 ⊎ b = 1 prod variants theorem dvd_of_mul_dvd_mul_left {a b c : A} (Ha : a ≠ 0) (Hdvd : (a * b ∣ a * c)) : (b ∣ c) := dvd.elim Hdvd diff --git a/hott/homotopy/circle.hlean b/hott/homotopy/circle.hlean index 03fc4df632..9e6653cace 100644 --- a/hott/homotopy/circle.hlean +++ b/hott/homotopy/circle.hlean @@ -10,7 +10,7 @@ import .sphere import types.bool types.int.hott types.equiv import algebra.homotopy_group algebra.hott -open eq susp bool sphere_index is_equiv equiv equiv.ops is_trunc pi +open eq susp bool sphere_index is_equiv equiv equiv.ops is_trunc pi algebra definition circle : Type₀ := sphere 1 @@ -227,16 +227,18 @@ namespace circle definition base_eq_base_equiv [constructor] : base = base ≃ ℤ := circle_eq_equiv base - definition decode_add (a b : ℤ) : circle.decode a ⬝ circle.decode b = circle.decode (a + b) := + definition decode_add (a b : ℤ) : circle.decode a ⬝ circle.decode b = circle.decode (a +[ℤ] b) := !power_con_power - definition encode_con (p q : base = base) : circle.encode (p ⬝ q) = circle.encode p + circle.encode q := - preserve_binary_of_inv_preserve base_eq_base_equiv concat add decode_add p q + definition encode_con (p q : base = base) + : circle.encode (p ⬝ q) = circle.encode p +[ℤ] circle.encode q := + preserve_binary_of_inv_preserve base_eq_base_equiv concat (@add ℤ _) decode_add p q --the carrier of π₁(S¹) is the set-truncation of base = base. open algebra trunc equiv.ops + definition fg_carrier_equiv_int : π[1](S¹.) ≃ ℤ := - trunc_equiv_trunc 0 base_eq_base_equiv ⬝e !trunc_equiv + trunc_equiv_trunc 0 base_eq_base_equiv ⬝e @(trunc_equiv ℤ _) proof _ qed definition con_comm_base (p q : base = base) : p ⬝ q = q ⬝ p := eq_of_fn_eq_fn base_eq_base_equiv (by esimp;rewrite [+encode_con,add.comm]) diff --git a/hott/homotopy/sphere.hlean b/hott/homotopy/sphere.hlean index 9fad2bb997..d6c1655df6 100644 --- a/hott/homotopy/sphere.hlean +++ b/hott/homotopy/sphere.hlean @@ -36,10 +36,16 @@ namespace sphere_index notation for sphere_index is -1, 0, 1, ... from 0 and up this comes from a coercion from num to sphere_index (via nat) -/ + + definition has_zero_sphere_index [instance] [reducible] : has_zero sphere_index := + has_zero.mk (succ minus_one) + + definition has_one_sphere_index [instance] [reducible] : has_one sphere_index := + has_one.mk (succ (succ minus_one)) + postfix `.+1`:(max+1) := sphere_index.succ postfix `.+2`:(max+1) := λ(n : sphere_index), (n .+1 .+1) notation `-1` := minus_one - export [coercions] nat notation `ℕ₋₁` := sphere_index definition add (n m : sphere_index) : sphere_index := @@ -50,11 +56,11 @@ namespace sphere_index infix `+1+`:65 := sphere_index.add - notation x <= y := sphere_index.leq x y - notation x ≤ y := sphere_index.leq x y + definition has_le_sphere_index [instance] [reducible] : has_le sphere_index := + has_le.mk leq - definition succ_le_succ {n m : sphere_index} (H : n ≤ m) : n.+1 ≤ m.+1 := H - definition le_of_succ_le_succ {n m : sphere_index} (H : n.+1 ≤ m.+1) : n ≤ m := H + definition succ_le_succ {n m : sphere_index} (H : n ≤ m) : n.+1 ≤ m.+1 := proof H qed + definition le_of_succ_le_succ {n m : sphere_index} (H : n.+1 ≤ m.+1) : n ≤ m := proof H qed definition minus_two_le (n : sphere_index) : -1 ≤ n := star definition empty_of_succ_le_minus_two {n : sphere_index} (H : n .+1 ≤ -1) : empty := H @@ -104,17 +110,17 @@ namespace sphere definition bool_of_sphere : S 0 → bool := - susp.rec ff tt (λx, empty.elim x) + proof susp.rec ff tt (λx, empty.elim x) qed definition sphere_of_bool : bool → S 0 - | ff := north - | tt := south + | ff := proof north qed + | tt := proof south qed definition sphere_equiv_bool : S 0 ≃ bool := equiv.MK bool_of_sphere sphere_of_bool (λb, match b with | tt := idp | ff := idp end) - (λx, susp.rec_on x idp idp (empty.rec _)) + (λx, proof susp.rec_on x idp idp (empty.rec _) qed) definition sphere_eq_bool : S 0 = bool := ua sphere_equiv_bool diff --git a/hott/homotopy/susp.hlean b/hott/homotopy/susp.hlean index ba3d0dc22e..6d27a32f3e 100644 --- a/hott/homotopy/susp.hlean +++ b/hott/homotopy/susp.hlean @@ -169,7 +169,7 @@ namespace susp (!ap_con ⬝ whisker_left _ !ap_inv) ⬝ (!elim_merid ◾ inverse2 !elim_merid)}, - { rewrite [▸*,inverse2_right_inv (elim_merid function.id idp)], + { rewrite [▸*,inverse2_right_inv (elim_merid id idp)], refine !con.assoc ⬝ _, xrewrite [ap_con_right_inv (susp.elim x x (λa, a)) (merid idp),idp_con_idp,-ap_compose]} end diff --git a/hott/init/connectives.hlean b/hott/init/connectives.hlean new file mode 100644 index 0000000000..8321d5ca19 --- /dev/null +++ b/hott/init/connectives.hlean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2014 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Haitao Zhang + +The propositional connectives. +-/ +prelude + +import .types +open unit + +variables {a b c d : Type} + +/- implies -/ + +definition imp (a b : Type) : Type := a → b + +definition imp.id (H : a) : a := H + +definition imp.intro (H : a) (H₂ : b) : a := H + +definition imp.mp (H : a) (H₂ : a → b) : b := +H₂ H + +definition imp.syl (H : a → b) (H₂ : c → a) (Hc : c) : b := +H (H₂ Hc) + +definition imp.left (H : a → b) (H₂ : b → c) (Ha : a) : c := +H₂ (H Ha) + +definition imp_unit (a : Type) : (a → unit) ↔ unit := +iff_unit_intro (imp.intro star) + +definition unit_imp (a : Type) : (unit → a) ↔ a := +iff.intro (assume H, H star) imp.intro + +definition imp_empty (a : Type) : (a → empty) ↔ ¬ a := iff.rfl + +definition empty_imp (a : Type) : (empty → a) ↔ unit := +iff_unit_intro empty.elim + +/- not -/ + +definition not.elim {A : Type} (H1 : ¬a) (H2 : a) : A := absurd H2 H1 + +definition not.mto {a b : Type} : (a → b) → ¬b → ¬a := imp.left + +definition not_imp_not_of_imp {a b : Type} : (a → b) → ¬b → ¬a := not.mto + +definition not_not_of_not_implies : ¬(a → b) → ¬¬a := +not.mto not.elim + +definition not_of_not_implies : ¬(a → b) → ¬b := +not.mto imp.intro + +definition not_not_em : ¬¬(a ⊎ ¬a) := +assume not_em : ¬(a ⊎ ¬a), +not_em (sum.inr (not.mto sum.inl not_em)) + +definition not_iff_not (H : a ↔ b) : ¬a ↔ ¬b := +iff.intro (not.mto (iff.mpr H)) (not.mto (iff.mp H)) + +/- prod -/ + +definition not_prod_of_not_left (b : Type) : ¬a → ¬(a × b) := +not.mto prod.pr1 + +definition not_prod_of_not_right (a : Type) {b : Type} : ¬b → ¬(a × b) := +not.mto prod.pr2 + +definition prod.imp_left (H : a → b) : a × c → b × c := +prod.imp H imp.id + +definition prod.imp_right (H : a → b) : c × a → c × b := +prod.imp imp.id H + +definition prod_of_prod_of_imp_of_imp (H₁ : a × b) (H₂ : a → c) (H₃ : b → d) : c × d := +prod.imp H₂ H₃ H₁ + +definition prod_of_prod_of_imp_left (H₁ : a × c) (H : a → b) : b × c := +prod.imp_left H H₁ + +definition prod_of_prod_of_imp_right (H₁ : c × a) (H : a → b) : c × b := +prod.imp_right H H₁ + +definition prod_imp_iff (a b c : Type) : (a × b → c) ↔ (a → b → c) := +iff.intro (λH a b, H (pair a b)) prod.rec + +/- sum -/ + +definition not_sum : ¬a → ¬b → ¬(a ⊎ b) := sum.rec + +definition sum_of_sum_of_imp_of_imp (H₁ : a ⊎ b) (H₂ : a → c) (H₃ : b → d) : c ⊎ d := +sum.imp H₂ H₃ H₁ + +definition sum_of_sum_of_imp_left (H₁ : a ⊎ c) (H : a → b) : b ⊎ c := +sum.imp_left H H₁ + +definition sum_of_sum_of_imp_right (H₁ : c ⊎ a) (H : a → b) : c ⊎ b := +sum.imp_right H H₁ + +definition sum.elim3 (H : a ⊎ b ⊎ c) (Ha : a → d) (Hb : b → d) (Hc : c → d) : d := +sum.elim H Ha (assume H₂, sum.elim H₂ Hb Hc) + +definition sum_resolve_right (H₁ : a ⊎ b) (H₂ : ¬a) : b := +sum.elim H₁ (not.elim H₂) imp.id + +definition sum_resolve_left (H₁ : a ⊎ b) : ¬b → a := +sum_resolve_right (sum.swap H₁) + +definition sum.imp_distrib : ((a ⊎ b) → c) ↔ ((a → c) × (b → c)) := +iff.intro + (λH, pair (imp.syl H sum.inl) (imp.syl H sum.inr)) + (prod.rec sum.rec) + +definition sum_iff_right_of_imp {a b : Type} (Ha : a → b) : (a ⊎ b) ↔ b := +iff.intro (sum.rec Ha imp.id) sum.inr + +definition sum_iff_left_of_imp {a b : Type} (Hb : b → a) : (a ⊎ b) ↔ a := +iff.intro (sum.rec imp.id Hb) sum.inl + +definition sum_iff_sum (H1 : a ↔ c) (H2 : b ↔ d) : (a ⊎ b) ↔ (c ⊎ d) := +iff.intro (sum.imp (iff.mp H1) (iff.mp H2)) (sum.imp (iff.mpr H1) (iff.mpr H2)) + +/- distributivity -/ + +definition prod.pr1_distrib (a b c : Type) : a × (b ⊎ c) ↔ (a × b) ⊎ (a × c) := +iff.intro + (prod.rec (λH, sum.imp (pair H) (pair H))) + (sum.rec (prod.imp_right sum.inl) (prod.imp_right sum.inr)) + +definition prod.pr2_distrib (a b c : Type) : (a ⊎ b) × c ↔ (a × c) ⊎ (b × c) := +iff.trans (iff.trans !prod.comm !prod.pr1_distrib) (sum_iff_sum !prod.comm !prod.comm) + +definition sum.left_distrib (a b c : Type) : a ⊎ (b × c) ↔ (a ⊎ b) × (a ⊎ c) := +iff.intro + (sum.rec (λH, pair (sum.inl H) (sum.inl H)) (prod.imp sum.inr sum.inr)) + (prod.rec (sum.rec (imp.syl imp.intro sum.inl) (imp.syl sum.imp_right pair))) + +definition sum.right_distrib (a b c : Type) : (a × b) ⊎ c ↔ (a ⊎ c) × (b ⊎ c) := +iff.trans (iff.trans !sum.comm !sum.left_distrib) (prod_congr !sum.comm !sum.comm) + +/- iff -/ + +definition iff.def : (a ↔ b) = ((a → b) × (b → a)) := rfl + +definition pi_imp_pi {A : Type} {P Q : A → Type} (H : Πa, (P a → Q a)) (p : Πa, P a) (a : A) : Q a := +(H a) (p a) + +definition pi_iff_pi {A : Type} {P Q : A → Type} (H : Πa, (P a ↔ Q a)) : (Πa, P a) ↔ (Πa, Q a) := +iff.intro (λp a, iff.elim_left (H a) (p a)) (λq a, iff.elim_right (H a) (q a)) + +definition imp_iff {P : Type} (Q : Type) (p : P) : (P → Q) ↔ Q := +iff.intro (λf, f p) imp.intro diff --git a/hott/init/default.hlean b/hott/init/default.hlean index 044ed82da0..a3f0c0f40b 100644 --- a/hott/init/default.hlean +++ b/hott/init/default.hlean @@ -7,13 +7,15 @@ Authors: Leonardo de Moura, Jakob von Raumer, Floris van Doorn prelude import init.datatypes init.reserved_notation init.tactic init.logic import init.bool init.num init.relation init.wf -import init.types +import init.types init.connectives import init.trunc init.path init.equiv init.util import init.ua init.funext import init.hedberg init.nat init.hit init.pathover namespace core - export bool empty unit sum + export bool unit + export empty (hiding elim) + export sum (hiding elim) export sigma (hiding pr1 pr2) export [notations] prod export [notations] nat diff --git a/hott/init/function.hlean b/hott/init/function.hlean index ae4fa49a56..a6ff7dfdaa 100644 --- a/hott/init/function.hlean +++ b/hott/init/function.hlean @@ -24,9 +24,6 @@ definition compose_right [reducible] [unfold_full] (f : B → B → B) (g : A definition compose_left [reducible] [unfold_full] (f : B → B → B) (g : A → B) : A → B → B := λ a b, f (g a) b -definition id [reducible] [unfold_full] (a : A) : A := -a - definition on_fun [reducible] [unfold_full] (f : B → B → C) (g : A → B) : A → A → C := λx y, f (g x) (g y) diff --git a/hott/init/logic.hlean b/hott/init/logic.hlean index deb59755f3..3998ccdf82 100644 --- a/hott/init/logic.hlean +++ b/hott/init/logic.hlean @@ -8,6 +8,9 @@ prelude import init.reserved_notation open unit +definition id [reducible] [unfold_full] {A : Type} (a : A) : A := +a + /- not -/ definition not [reducible] (a : Type) := a → empty @@ -19,24 +22,20 @@ empty.rec (λ e, b) (H₂ H₁) definition mt {a b : Type} (H₁ : a → b) (H₂ : ¬b) : ¬a := assume Ha : a, absurd (H₁ Ha) H₂ -protected definition not_empty : ¬ empty := +definition not_empty : ¬empty := assume H : empty, H -definition not_not_intro {a : Type} (Ha : a) : ¬¬a := +definition non_contradictory (a : Type) : Type := ¬¬a + +definition non_contradictory_intro {a : Type} (Ha : a) : ¬¬a := assume Hna : ¬a, absurd Ha Hna -theorem not_of_not_not_not {a : Type} (H : ¬¬¬a) : ¬a := -λ Ha, absurd (not_not_intro Ha) H - -definition not.elim {a : Type} (H₁ : ¬a) (H₂ : a) : empty := H₁ H₂ - definition not.intro {a : Type} (H : a → empty) : ¬a := H -definition not_not_of_not_implies {a b : Type} (H : ¬(a → b)) : ¬¬a := -assume Hna : ¬a, absurd (assume Ha : a, absurd Ha Hna) H +/- empty -/ -definition not_of_not_implies {a b : Type} (H : ¬(a → b)) : ¬b := -assume Hb : b, absurd (assume Ha : a, Hb) H +definition empty.elim {c : Type} (H : empty) : c := +empty.rec _ H /- eq -/ @@ -55,10 +54,10 @@ namespace eq definition symm [unfold 4] (H : a = b) : b = a := subst H (refl a) - theorem mp {a b : Type} : (a = b) → a → b := + definition mp {a b : Type} : (a = b) → a → b := eq.rec_on - theorem mpr {a b : Type} : (a = b) → b → a := + definition mpr {a b : Type} : (a = b) → b → a := assume H₁ H₂, eq.rec_on (eq.symm H₁) H₂ namespace ops end ops -- this is just to ensure that this namespace exists. There is nothing in it @@ -75,13 +74,13 @@ eq.rec H₁ H₂ definition congr {A B : Type} {f₁ f₂ : A → B} {a₁ a₂ : A} (H₁ : f₁ = f₂) (H₂ : a₁ = a₂) : f₁ a₁ = f₂ a₂ := eq.subst H₁ (eq.subst H₂ rfl) -theorem congr_fun {A : Type} {B : A → Type} {f g : Π x, B x} (H : f = g) (a : A) : f a = g a := +definition congr_fun {A : Type} {B : A → Type} {f g : Π x, B x} (H : f = g) (a : A) : f a = g a := eq.subst H (eq.refl (f a)) -theorem congr_arg {A B : Type} (a a' : A) (f : A → B) (Ha : a = a') : f a = f a' := +definition congr_arg {A B : Type} (a a' : A) (f : A → B) (Ha : a = a') : f a = f a' := eq.subst Ha rfl -theorem congr_arg2 {A B C : Type} (a a' : A) (b b' : B) (f : A → B → C) (Ha : a = a') (Hb : b = b') : f a b = f a' b' := +definition congr_arg2 {A B C : Type} (a a' : A) (b b' : B) (f : A → B → C) (Ha : a = a') (Hb : b = b') : f a b = f a' b' := eq.subst Ha (eq.subst Hb rfl) section @@ -110,318 +109,563 @@ end lift /- ne -/ -definition ne {A : Type} (a b : A) := ¬(a = b) -infix ≠ := ne +definition ne [reducible] {A : Type} (a b : A) := ¬(a = b) +notation a ≠ b := ne a b namespace ne open eq.ops variable {A : Type} variables {a b : A} - definition intro : (a = b → empty) → a ≠ b := - assume H, H + definition intro (H : a = b → empty) : a ≠ b := H - definition elim : a ≠ b → a = b → empty := - assume H₁ H₂, H₁ H₂ + definition elim (H : a ≠ b) : a = b → empty := H - definition irrefl : a ≠ a → empty := - assume H, H rfl + definition irrefl (H : a ≠ a) : empty := H rfl - definition symm : a ≠ b → b ≠ a := - assume (H : a ≠ b) (H₁ : b = a), H H₁⁻¹ + definition symm (H : a ≠ b) : b ≠ a := + assume (H₁ : b = a), H (H₁⁻¹) end ne +definition empty_of_ne {A : Type} {a : A} : a ≠ a → empty := ne.irrefl + section open eq.ops - variables {A : Type} {a b c : A} + variables {p : Type₀} - definition empty.of_ne : a ≠ a → empty := - assume H, H rfl + definition ne_empty_of_self : p → p ≠ empty := + assume (Hp : p) (Heq : p = empty), Heq ▸ Hp - definition ne.of_eq_of_ne : a = b → b ≠ c → a ≠ c := - assume H₁ H₂, H₁⁻¹ ▸ H₂ + definition ne_unit_of_not : ¬p → p ≠ unit := + assume (Hnp : ¬p) (Heq : p = unit), (Heq ▸ Hnp) star - definition ne.of_ne_of_eq : a ≠ b → b = c → a ≠ c := - assume H₁ H₂, H₂ ▸ H₁ + definition unit_ne_empty : ¬unit = empty := + ne_empty_of_self star end +/- prod -/ + +abbreviation pair [constructor] := @prod.mk +infixr × := prod + +variables {a b c d : Type} + +attribute prod.rec [elim] +attribute prod.mk [intro!] + +protected definition prod.elim [unfold 4] (H₁ : a × b) (H₂ : a → b → c) : c := +prod.rec H₂ H₁ + +definition prod.swap [unfold 3] : a × b → b × a := +prod.rec (λHa Hb, prod.mk Hb Ha) + +/- sum -/ + +infixr ⊎ := sum +infixr + := sum + +attribute sum.rec [elim] + +protected definition sum.elim [unfold 4] (H₁ : a ⊎ b) (H₂ : a → c) (H₃ : b → c) : c := +sum.rec H₂ H₃ H₁ + +definition non_contradictory_em (a : Type) : ¬¬(a ⊎ ¬a) := +assume not_em : ¬(a ⊎ ¬a), + have neg_a : ¬a, from + assume pos_a : a, absurd (sum.inl pos_a) not_em, + absurd (sum.inr neg_a) not_em + +definition sum.swap : a ⊎ b → b ⊎ a := sum.rec sum.inr sum.inl + + /- iff -/ -definition iff (a b : Type) := prod (a → b) (b → a) +definition iff (a b : Type) := (a → b) × (b → a) -infix <-> := iff -infix ↔ := iff - variables {a b c : Type} +notation a <-> b := iff a b +notation a ↔ b := iff a b -namespace iff +definition iff.intro : (a → b) → (b → a) → (a ↔ b) := prod.mk - definition def : (a ↔ b) = (prod (a → b) (b → a)) := - rfl +attribute iff.intro [intro!] - definition intro (H₁ : a → b) (H₂ : b → a) : a ↔ b := - prod.mk H₁ H₂ +definition iff.elim : ((a → b) → (b → a) → c) → (a ↔ b) → c := prod.rec - definition elim (H₁ : (a → b) → (b → a) → c) (H₂ : a ↔ b) : c := - prod.rec H₁ H₂ +attribute iff.elim [recursor 5] [elim] - definition elim_left (H : a ↔ b) : a → b := - elim (assume H₁ H₂, H₁) H +definition iff.elim_left : (a ↔ b) → a → b := prod.pr1 - definition mp := @elim_left +definition iff.mp := @iff.elim_left - definition elim_right (H : a ↔ b) : b → a := - elim (assume H₁ H₂, H₂) H +definition iff.elim_right : (a ↔ b) → b → a := prod.pr2 - definition mpr := @elim_right +definition iff.mpr := @iff.elim_right - definition flip_sign (H₁ : a ↔ b) : ¬a ↔ ¬b := - intro - (assume Hna, mt (elim_right H₁) Hna) - (assume Hnb, mt (elim_left H₁) Hnb) +definition iff.refl [refl] (a : Type) : a ↔ a := +iff.intro (assume H, H) (assume H, H) - definition refl (a : Type) : a ↔ a := - intro (assume H, H) (assume H, H) +definition iff.rfl {a : Type} : a ↔ a := +iff.refl a - definition rfl {a : Type} : a ↔ a := - refl a +definition iff.trans [trans] (H₁ : a ↔ b) (H₂ : b ↔ c) : a ↔ c := +iff.intro + (assume Ha, iff.mp H₂ (iff.mp H₁ Ha)) + (assume Hc, iff.mpr H₁ (iff.mpr H₂ Hc)) - definition iff_of_eq (a b : Type) (p : a = b) : a ↔ b := - eq.rec rfl p +definition iff.symm [symm] (H : a ↔ b) : b ↔ a := +iff.intro (iff.elim_right H) (iff.elim_left H) - definition trans (H₁ : a ↔ b) (H₂ : b ↔ c) : a ↔ c := - intro - (assume Ha, elim_left H₂ (elim_left H₁ Ha)) - (assume Hc, elim_right H₁ (elim_right H₂ Hc)) +definition iff.comm : (a ↔ b) ↔ (b ↔ a) := +iff.intro iff.symm iff.symm - definition symm (H : a ↔ b) : b ↔ a := - intro - (assume Hb, elim_right H Hb) - (assume Ha, elim_left H Ha) +definition iff.of_eq {a b : Type} (H : a = b) : a ↔ b := +eq.rec_on H iff.rfl - definition unit_elim (H : a ↔ unit) : a := - mp (symm H) unit.star - - definition empty_elim (H : a ↔ empty) : ¬a := - assume Ha : a, mp H Ha - - open eq.ops - definition of_eq {a b : Type} (H : a = b) : a ↔ b := - iff.intro (λ Ha, H ▸ Ha) (λ Hb, H⁻¹ ▸ Hb) - - definition pi_iff_pi {A : Type} {P Q : A → Type} (H : Πa, (P a ↔ Q a)) : (Πa, P a) ↔ Πa, Q a := - iff.intro (λp a, iff.elim_left (H a) (p a)) (λq a, iff.elim_right (H a) (q a)) - - theorem imp_iff {P : Type} (Q : Type) (p : P) : (P → Q) ↔ Q := - iff.intro (λf, f p) (λq p, q) - -end iff - -theorem not_iff_not_of_iff (H₁ : a ↔ b) : ¬a ↔ ¬b := +definition not_iff_not_of_iff (H₁ : a ↔ b) : ¬a ↔ ¬b := iff.intro (assume (Hna : ¬ a) (Hb : b), Hna (iff.elim_right H₁ Hb)) (assume (Hnb : ¬ b) (Ha : a), Hnb (iff.elim_left H₁ Ha)) -theorem of_iff_unit (H : a ↔ unit) : a := +definition of_iff_unit (H : a ↔ unit) : a := iff.mp (iff.symm H) star -theorem not_of_iff_empty : (a ↔ empty) → ¬a := iff.mp +definition not_of_iff_empty : (a ↔ empty) → ¬a := iff.mp -theorem iff_unit_intro (H : a) : a ↔ unit := +definition iff_unit_intro (H : a) : a ↔ unit := iff.intro (λ Hl, star) (λ Hr, H) -theorem iff_empty_intro (H : ¬a) : a ↔ empty := +definition iff_empty_intro (H : ¬a) : a ↔ empty := iff.intro H (empty.rec _) -theorem not_non_contradictory_iff_absurd (a : Type) : ¬¬¬a ↔ ¬a := +definition not_non_contradictory_iff_absurd (a : Type) : ¬¬¬a ↔ ¬a := iff.intro - (λ (Hl : ¬¬¬a) (Ha : a), Hl (λf, f Ha)) + (λ (Hl : ¬¬¬a) (Ha : a), Hl (non_contradictory_intro Ha)) absurd -attribute iff.refl [refl] -attribute iff.trans [trans] -attribute iff.symm [symm] +definition imp_congr [congr] (H1 : a ↔ c) (H2 : b ↔ d) : (a → b) ↔ (c → d) := +iff.intro + (λHab Hc, iff.mp H2 (Hab (iff.mpr H1 Hc))) + (λHcd Ha, iff.mpr H2 (Hcd (iff.mp H1 Ha))) + +definition not_not_intro (Ha : a) : ¬¬a := +assume Hna : ¬a, Hna Ha + +definition not_of_not_not_not (H : ¬¬¬a) : ¬a := +λ Ha, absurd (not_not_intro Ha) H + +definition not_unit [simp] : (¬ unit) ↔ empty := +iff_empty_intro (not_not_intro star) + +definition not_empty_iff [simp] : (¬ empty) ↔ unit := +iff_unit_intro not_empty + +definition not_congr [congr] (H : a ↔ b) : ¬a ↔ ¬b := +iff.intro (λ H₁ H₂, H₁ (iff.mpr H H₂)) (λ H₁ H₂, H₁ (iff.mp H H₂)) + +definition ne_self_iff_empty [simp] {A : Type} (a : A) : (not (a = a)) ↔ empty := +iff.intro empty_of_ne empty.elim + +definition eq_self_iff_unit [simp] {A : Type} (a : A) : (a = a) ↔ unit := +iff_unit_intro rfl + +definition iff_not_self [simp] (a : Type) : (a ↔ ¬a) ↔ empty := +iff_empty_intro (λ H, + have H' : ¬a, from (λ Ha, (iff.mp H Ha) Ha), + H' (iff.mpr H H')) + +definition not_iff_self [simp] (a : Type) : (¬a ↔ a) ↔ empty := +iff_empty_intro (λ H, + have H' : ¬a, from (λ Ha, (iff.mpr H Ha) Ha), + H' (iff.mp H H')) + +definition unit_iff_empty [simp] : (unit ↔ empty) ↔ empty := +iff_empty_intro (λ H, iff.mp H star) + +definition empty_iff_unit [simp] : (empty ↔ unit) ↔ empty := +iff_empty_intro (λ H, iff.mpr H star) + +definition empty_of_unit_iff_empty : (unit ↔ empty) → empty := +assume H, iff.mp H star + +/- prod simp rules -/ +definition prod.imp (H₂ : a → c) (H₃ : b → d) : a × b → c × d := +prod.rec (λHa Hb, prod.mk (H₂ Ha) (H₃ Hb)) + +definition prod_congr [congr] (H1 : a ↔ c) (H2 : b ↔ d) : (a × b) ↔ (c × d) := +iff.intro (prod.imp (iff.mp H1) (iff.mp H2)) (prod.imp (iff.mpr H1) (iff.mpr H2)) + +definition prod.comm [simp] : a × b ↔ b × a := +iff.intro prod.swap prod.swap + +definition prod.assoc [simp] : (a × b) × c ↔ a × (b × c) := +iff.intro + (prod.rec (λ H' Hc, prod.rec (λ Ha Hb, prod.mk Ha (prod.mk Hb Hc)) H')) + (prod.rec (λ Ha, prod.rec (λ Hb Hc, prod.mk (prod.mk Ha Hb) Hc))) + +definition prod.pr1_comm [simp] : a × (b × c) ↔ b × (a × c) := +iff.trans (iff.symm !prod.assoc) (iff.trans (prod_congr !prod.comm !iff.refl) !prod.assoc) + +definition prod_iff_left {a b : Type} (Hb : b) : (a × b) ↔ a := +iff.intro prod.pr1 (λHa, prod.mk Ha Hb) + +definition prod_iff_right {a b : Type} (Ha : a) : (a × b) ↔ b := +iff.intro prod.pr2 (prod.mk Ha) + +definition prod_unit [simp] (a : Type) : a × unit ↔ a := +prod_iff_left star + +definition unit_prod [simp] (a : Type) : unit × a ↔ a := +prod_iff_right star + +definition prod_empty [simp] (a : Type) : a × empty ↔ empty := +iff_empty_intro prod.pr2 + +definition empty_prod [simp] (a : Type) : empty × a ↔ empty := +iff_empty_intro prod.pr1 + +definition not_prod_self [simp] (a : Type) : (¬a × a) ↔ empty := +iff_empty_intro (λ H, prod.elim H (λ H₁ H₂, absurd H₂ H₁)) + +definition prod_not_self [simp] (a : Type) : (a × ¬a) ↔ empty := +iff_empty_intro (λ H, prod.elim H (λ H₁ H₂, absurd H₁ H₂)) + +definition prod_self [simp] (a : Type) : a × a ↔ a := +iff.intro prod.pr1 (assume H, prod.mk H H) + +/- sum simp rules -/ + +definition sum.imp (H₂ : a → c) (H₃ : b → d) : a ⊎ b → c ⊎ d := +sum.rec (λ H, sum.inl (H₂ H)) (λ H, sum.inr (H₃ H)) + +definition sum.imp_left (H : a → b) : a ⊎ c → b ⊎ c := +sum.imp H id + +definition sum.imp_right (H : a → b) : c ⊎ a → c ⊎ b := +sum.imp id H + +definition sum_congr [congr] (H1 : a ↔ c) (H2 : b ↔ d) : (a ⊎ b) ↔ (c ⊎ d) := +iff.intro (sum.imp (iff.mp H1) (iff.mp H2)) (sum.imp (iff.mpr H1) (iff.mpr H2)) + +definition sum.comm [simp] : a ⊎ b ↔ b ⊎ a := iff.intro sum.swap sum.swap + +definition sum.assoc [simp] : (a ⊎ b) ⊎ c ↔ a ⊎ (b ⊎ c) := +iff.intro + (sum.rec (sum.imp_right sum.inl) (λ H, sum.inr (sum.inr H))) + (sum.rec (λ H, sum.inl (sum.inl H)) (sum.imp_left sum.inr)) + +definition sum.left_comm [simp] : a ⊎ (b ⊎ c) ↔ b ⊎ (a ⊎ c) := +iff.trans (iff.symm !sum.assoc) (iff.trans (sum_congr !sum.comm !iff.refl) !sum.assoc) + +definition sum_unit [simp] (a : Type) : a ⊎ unit ↔ unit := +iff_unit_intro (sum.inr star) + +definition unit_sum [simp] (a : Type) : unit ⊎ a ↔ unit := +iff_unit_intro (sum.inl star) + +definition sum_empty [simp] (a : Type) : a ⊎ empty ↔ a := +iff.intro (sum.rec id empty.elim) sum.inl + +definition empty_sum [simp] (a : Type) : empty ⊎ a ↔ a := +iff.trans sum.comm !sum_empty + +definition sum_self [simp] (a : Type) : a ⊎ a ↔ a := +iff.intro (sum.rec id id) sum.inl + +/- sum resolution rulse -/ + +definition sum.resolve_left {a b : Type} (H : a ⊎ b) (na : ¬ a) : b := + sum.elim H (λ Ha, absurd Ha na) id + +definition sum.neg_resolve_left {a b : Type} (H : ¬ a ⊎ b) (Ha : a) : b := + sum.elim H (λ na, absurd Ha na) id + +definition sum.resolve_right {a b : Type} (H : a ⊎ b) (nb : ¬ b) : a := + sum.elim H id (λ Hb, absurd Hb nb) + +definition sum.neg_resolve_right {a b : Type} (H : a ⊎ ¬ b) (Hb : b) : a := + sum.elim H id (λ nb, absurd Hb nb) + +/- iff simp rules -/ + +definition iff_unit [simp] (a : Type) : (a ↔ unit) ↔ a := +iff.intro (assume H, iff.mpr H star) iff_unit_intro + +definition unit_iff [simp] (a : Type) : (unit ↔ a) ↔ a := +iff.trans iff.comm !iff_unit + +definition iff_empty [simp] (a : Type) : (a ↔ empty) ↔ ¬ a := +iff.intro prod.pr1 iff_empty_intro + +definition empty_iff [simp] (a : Type) : (empty ↔ a) ↔ ¬ a := +iff.trans iff.comm !iff_empty + +definition iff_self [simp] (a : Type) : (a ↔ a) ↔ unit := +iff_unit_intro iff.rfl + +definition iff_congr [congr] (H1 : a ↔ c) (H2 : b ↔ d) : (a ↔ b) ↔ (c ↔ d) := +prod_congr (imp_congr H1 H2) (imp_congr H2 H1) + +/- decidable -/ + +inductive decidable [class] (p : Type) : Type := +| inl : p → decidable p +| inr : ¬p → decidable p + +definition decidable_unit [instance] : decidable unit := +decidable.inl star + +definition decidable_empty [instance] : decidable empty := +decidable.inr not_empty + +-- We use "dependent" if-then-else to be able to communicate the if-then-else condition +-- to the branches +definition dite (c : Type) [H : decidable c] {A : Type} : (c → A) → (¬ c → A) → A := +decidable.rec_on H + +/- if-then-else -/ + +definition ite (c : Type) [H : decidable c] {A : Type} (t e : A) : A := +decidable.rec_on H (λ Hc, t) (λ Hnc, e) + +namespace decidable + variables {p q : Type} + + definition by_cases {q : Type} [C : decidable p] : (p → q) → (¬p → q) → q := !dite + + theorem em (p : Type) [H : decidable p] : p ⊎ ¬p := by_cases sum.inl sum.inr + + theorem by_contradiction [Hp : decidable p] (H : ¬p → empty) : p := + if H1 : p then H1 else empty.rec _ (H H1) +end decidable + +section + variables {p q : Type} + open decidable + definition decidable_of_decidable_of_iff (Hp : decidable p) (H : p ↔ q) : decidable q := + if Hp : p then inl (iff.mp H Hp) + else inr (iff.mp (not_iff_not_of_iff H) Hp) + + definition decidable_of_decidable_of_eq {p q : Type} (Hp : decidable p) (H : p = q) + : decidable q := + decidable_of_decidable_of_iff Hp (iff.of_eq H) + + protected definition sum.by_cases [Hp : decidable p] [Hq : decidable q] {A : Type} + (h : p ⊎ q) (h₁ : p → A) (h₂ : q → A) : A := + if hp : p then h₁ hp else + if hq : q then h₂ hq else + empty.rec _ (sum.elim h hp hq) +end + +section + variables {p q : Type} + open decidable (rec_on inl inr) + + definition decidable_prod [instance] [Hp : decidable p] [Hq : decidable q] : decidable (p × q) := + if hp : p then + if hq : q then inl (prod.mk hp hq) + else inr (assume H : p × q, hq (prod.pr2 H)) + else inr (assume H : p × q, hp (prod.pr1 H)) + + definition decidable_sum [instance] [Hp : decidable p] [Hq : decidable q] : decidable (p ⊎ q) := + if hp : p then inl (sum.inl hp) else + if hq : q then inl (sum.inr hq) else + inr (sum.rec hp hq) + + definition decidable_not [instance] [Hp : decidable p] : decidable (¬p) := + if hp : p then inr (absurd hp) else inl hp + + definition decidable_implies [instance] [Hp : decidable p] [Hq : decidable q] : decidable (p → q) := + if hp : p then + if hq : q then inl (assume H, hq) + else inr (assume H : p → q, absurd (H hp) hq) + else inl (assume Hp, absurd Hp hp) + + definition decidable_iff [instance] [Hp : decidable p] [Hq : decidable q] : decidable (p ↔ q) := + decidable_prod + +end + +definition decidable_pred [reducible] {A : Type} (R : A → Type) := Π (a : A), decidable (R a) +definition decidable_rel [reducible] {A : Type} (R : A → A → Type) := Π (a b : A), decidable (R a b) +definition decidable_eq [reducible] (A : Type) := decidable_rel (@eq A) +definition decidable_ne [instance] {A : Type} [H : decidable_eq A] (a b : A) : decidable (a ≠ b) := +decidable_implies + +namespace bool + theorem ff_ne_tt : ff = tt → empty + | [none] +end bool + +open bool +definition is_dec_eq {A : Type} (p : A → A → bool) : Type := Π ⦃x y : A⦄, p x y = tt → x = y +definition is_dec_refl {A : Type} (p : A → A → bool) : Type := Πx, p x x = tt + +open decidable +protected definition bool.has_decidable_eq [instance] : Πa b : bool, decidable (a = b) +| ff ff := inl rfl +| ff tt := inr ff_ne_tt +| tt ff := inr (ne.symm ff_ne_tt) +| tt tt := inl rfl + +definition decidable_eq_of_bool_pred {A : Type} {p : A → A → bool} (H₁ : is_dec_eq p) (H₂ : is_dec_refl p) : decidable_eq A := +take x y : A, if Hp : p x y = tt then inl (H₁ Hp) + else inr (assume Hxy : x = y, (eq.subst Hxy Hp) (H₂ y)) /- inhabited -/ inductive inhabited [class] (A : Type) : Type := mk : A → inhabited A -namespace inhabited +protected definition inhabited.value {A : Type} : inhabited A → A := +inhabited.rec (λa, a) -protected definition destruct {A : Type} {B : Type} (H1 : inhabited A) (H2 : A → B) : B := +protected definition inhabited.destruct {A : Type} {B : Type} (H1 : inhabited A) (H2 : A → B) : B := inhabited.rec H2 H1 +definition default (A : Type) [H : inhabited A] : A := +inhabited.value H + +definition arbitrary [irreducible] (A : Type) [H : inhabited A] : A := +inhabited.value H + +definition Type.is_inhabited [instance] : inhabited Type := +inhabited.mk (lift unit) + definition inhabited_fun [instance] (A : Type) {B : Type} [H : inhabited B] : inhabited (A → B) := -inhabited.destruct H (λb, mk (λa, b)) +inhabited.rec_on H (λb, inhabited.mk (λa, b)) definition inhabited_Pi [instance] (A : Type) {B : A → Type} [H : Πx, inhabited (B x)] : inhabited (Πx, B x) := -mk (λa, inhabited.destruct (H a) (λb, b)) +inhabited.mk (λa, !default) -definition default (A : Type) [H : inhabited A] : A := inhabited.destruct H (take a, a) +protected definition bool.is_inhabited [instance] : inhabited bool := +inhabited.mk ff -end inhabited +protected definition pos_num.is_inhabited [instance] : inhabited pos_num := +inhabited.mk pos_num.one -/- decidable -/ +protected definition num.is_inhabited [instance] : inhabited num := +inhabited.mk num.zero -inductive decidable.{l} [class] (p : Type.{l}) : Type.{l} := -| inl : p → decidable p -| inr : ¬p → decidable p +inductive nonempty [class] (A : Type) : Type := +intro : A → nonempty A -namespace decidable - variables {p q : Type} +protected definition nonempty.elim {A : Type} {B : Type} (H1 : nonempty A) (H2 : A → B) : B := +nonempty.rec H2 H1 - definition pos_witness [C : decidable p] (H : p) : p := - decidable.rec_on C (λ Hp, Hp) (λ Hnp, absurd H Hnp) +theorem nonempty_of_inhabited [instance] {A : Type} [H : inhabited A] : nonempty A := +nonempty.intro !default - definition neg_witness [C : decidable p] (H : ¬ p) : ¬ p := - decidable.rec_on C (λ Hp, absurd Hp H) (λ Hnp, Hnp) +theorem nonempty_of_exists {A : Type} {P : A → Type} : (sigma P) → nonempty A := +sigma.rec (λw H, nonempty.intro w) - definition by_cases {q : Type} [C : decidable p] (Hpq : p → q) (Hnpq : ¬p → q) : q := - decidable.rec_on C (assume Hp, Hpq Hp) (assume Hnp, Hnpq Hnp) +/- subsingleton -/ - definition em (p : Type) [H : decidable p] : sum p ¬p := - by_cases (λ Hp, sum.inl Hp) (λ Hnp, sum.inr Hnp) +inductive subsingleton [class] (A : Type) : Type := +intro : (Π a b : A, a = b) → subsingleton A - definition by_contradiction [Hp : decidable p] (H : ¬p → empty) : p := - by_cases - (assume H₁ : p, H₁) - (assume H₁ : ¬p, empty.rec (λ e, p) (H H₁)) +protected definition subsingleton.elim {A : Type} [H : subsingleton A] : Π(a b : A), a = b := +subsingleton.rec (λp, p) H - definition decidable_iff_equiv (Hp : decidable p) (H : p ↔ q) : decidable q := - decidable.rec_on Hp - (assume Hp : p, inl (iff.elim_left H Hp)) - (assume Hnp : ¬p, inr (iff.elim_left (iff.flip_sign H) Hnp)) +protected theorem rec_subsingleton {p : Type} [H : decidable p] + {H1 : p → Type} {H2 : ¬p → Type} + [H3 : Π(h : p), subsingleton (H1 h)] [H4 : Π(h : ¬p), subsingleton (H2 h)] + : subsingleton (decidable.rec_on H H1 H2) := +decidable.rec_on H (λh, H3 h) (λh, H4 h) --this can be proven using dependent version of "by_cases" - definition decidable_eq_equiv.{l} {p q : Type.{l}} (Hp : decidable p) (H : p = q) : decidable q := - decidable_iff_equiv Hp (iff.of_eq H) -end decidable - -section - variables {p q : Type} - open decidable (rec_on inl inr) - - definition decidable_unit [instance] : decidable unit := - inl unit.star - - definition decidable_empty [instance] : decidable empty := - inr not_empty - - definition decidable_prod [instance] [Hp : decidable p] [Hq : decidable q] : decidable (prod p q) := - rec_on Hp - (assume Hp : p, rec_on Hq - (assume Hq : q, inl (prod.mk Hp Hq)) - (assume Hnq : ¬q, inr (λ H : prod p q, prod.rec_on H (λ Hp Hq, absurd Hq Hnq)))) - (assume Hnp : ¬p, inr (λ H : prod p q, prod.rec_on H (λ Hp Hq, absurd Hp Hnp))) - - definition decidable_sum [instance] [Hp : decidable p] [Hq : decidable q] : decidable (sum p q) := - rec_on Hp - (assume Hp : p, inl (sum.inl Hp)) - (assume Hnp : ¬p, rec_on Hq - (assume Hq : q, inl (sum.inr Hq)) - (assume Hnq : ¬q, inr (λ H : sum p q, sum.rec_on H (λ Hp, absurd Hp Hnp) (λ Hq, absurd Hq Hnq)))) - - definition decidable_not [instance] [Hp : decidable p] : decidable (¬p) := - rec_on Hp - (assume Hp, inr (not_not_intro Hp)) - (assume Hnp, inl Hnp) - - definition decidable_implies [instance] [Hp : decidable p] [Hq : decidable q] : decidable (p → q) := - rec_on Hp - (assume Hp : p, rec_on Hq - (assume Hq : q, inl (assume H, Hq)) - (assume Hnq : ¬q, inr (assume H : p → q, absurd (H Hp) Hnq))) - (assume Hnp : ¬p, inl (assume Hp, absurd Hp Hnp)) - - definition decidable_if [instance] [Hp : decidable p] [Hq : decidable q] : decidable (p ↔ q) := - show decidable (prod (p → q) (q → p)), from _ -end - -definition decidable_pred [reducible] {A : Type} (R : A → Type) := Π (a : A), decidable (R a) -definition decidable_rel [reducible] {A : Type} (R : A → A → Type) := Π (a b : A), decidable (R a b) -definition decidable_eq [reducible] (A : Type) := decidable_rel (@eq A) -definition decidable_ne [instance] {A : Type} [H : decidable_eq A] : decidable_rel (@ne A) := -show Π x y : A, decidable (x = y → empty), from _ - -definition ite (c : Type) [H : decidable c] {A : Type} (t e : A) : A := -decidable.rec_on H (λ Hc, t) (λ Hnc, e) - -definition if_pos {c : Type} [H : decidable c] (Hc : c) {A : Type} {t e : A} : (if c then t else e) = t := +theorem if_pos {c : Type} [H : decidable c] (Hc : c) {A : Type} {t e : A} : (ite c t e) = t := decidable.rec (λ Hc : c, eq.refl (@ite c (decidable.inl Hc) A t e)) (λ Hnc : ¬c, absurd Hc Hnc) H -definition if_neg {c : Type} [H : decidable c] (Hnc : ¬c) {A : Type} {t e : A} : (if c then t else e) = e := +theorem if_neg {c : Type} [H : decidable c] (Hnc : ¬c) {A : Type} {t e : A} : (ite c t e) = e := decidable.rec (λ Hc : c, absurd Hc Hnc) (λ Hnc : ¬c, eq.refl (@ite c (decidable.inr Hnc) A t e)) H -definition if_t_t (c : Type) [H : decidable c] {A : Type} (t : A) : (if c then t else t) = t := +theorem if_t_t [simp] (c : Type) [H : decidable c] {A : Type} (t : A) : (ite c t t) = t := decidable.rec (λ Hc : c, eq.refl (@ite c (decidable.inl Hc) A t t)) (λ Hnc : ¬c, eq.refl (@ite c (decidable.inr Hnc) A t t)) H -definition if_unit {A : Type} (t e : A) : (if unit then t else e) = t := -if_pos unit.star - -definition if_empty {A : Type} (t e : A) : (if empty then t else e) = e := -if_neg not_empty - -section -open eq.ops -definition if_cond_congr {c₁ c₂ : Type} [H₁ : decidable c₁] [H₂ : decidable c₂] (Heq : c₁ ↔ c₂) {A : Type} (t e : A) - : (if c₁ then t else e) = (if c₂ then t else e) := -decidable.rec_on H₁ - (λ Hc₁ : c₁, decidable.rec_on H₂ - (λ Hc₂ : c₂, if_pos Hc₁ ⬝ (if_pos Hc₂)⁻¹) - (λ Hnc₂ : ¬c₂, absurd (iff.elim_left Heq Hc₁) Hnc₂)) - (λ Hnc₁ : ¬c₁, decidable.rec_on H₂ - (λ Hc₂ : c₂, absurd (iff.elim_right Heq Hc₂) Hnc₁) - (λ Hnc₂ : ¬c₂, if_neg Hnc₁ ⬝ (if_neg Hnc₂)⁻¹)) - -definition if_congr_aux {c₁ c₂ : Type} [H₁ : decidable c₁] [H₂ : decidable c₂] {A : Type} {t₁ t₂ e₁ e₂ : A} - (Hc : c₁ ↔ c₂) (Ht : t₁ = t₂) (He : e₁ = e₂) : - (if c₁ then t₁ else e₁) = (if c₂ then t₂ else e₂) := -Ht ▸ He ▸ (if_cond_congr Hc t₁ e₁) - -definition if_congr {c₁ c₂ : Type} [H₁ : decidable c₁] {A : Type} {t₁ t₂ e₁ e₂ : A} (Hc : c₁ ↔ c₂) (Ht : t₁ = t₂) (He : e₁ = e₂) : - (if c₁ then t₁ else e₁) = (@ite c₂ (decidable.decidable_iff_equiv H₁ Hc) A t₂ e₂) := -have H2 [visible] : decidable c₂, from (decidable.decidable_iff_equiv H₁ Hc), -if_congr_aux Hc Ht He - -theorem implies_of_if_pos {c t e : Type} [H : decidable c] (h : if c then t else e) : c → t := +theorem implies_of_if_pos {c t e : Type} [H : decidable c] (h : ite c t e) : c → t := assume Hc, eq.rec_on (if_pos Hc) h -theorem implies_of_if_neg {c t e : Type} [H : decidable c] (h : if c then t else e) : ¬c → e := +theorem implies_of_if_neg {c t e : Type} [H : decidable c] (h : ite c t e) : ¬c → e := assume Hnc, eq.rec_on (if_neg Hnc) h --- We use "dependent" if-then-else to be able to communicate the if-then-else condition --- to the branches -definition dite (c : Type) [H : decidable c] {A : Type} (t : c → A) (e : ¬ c → A) : A := -decidable.rec_on H (λ Hc, t Hc) (λ Hnc, e Hnc) +theorem if_ctx_congr {A : Type} {b c : Type} [dec_b : decidable b] [dec_c : decidable c] + {x y u v : A} + (h_c : b ↔ c) (h_t : c → x = u) (h_e : ¬c → y = v) : + ite b x y = ite c u v := +decidable.rec_on dec_b + (λ hp : b, calc + ite b x y = x : if_pos hp + ... = u : h_t (iff.mp h_c hp) + ... = ite c u v : if_pos (iff.mp h_c hp)) + (λ hn : ¬b, calc + ite b x y = y : if_neg hn + ... = v : h_e (iff.mp (not_iff_not_of_iff h_c) hn) + ... = ite c u v : if_neg (iff.mp (not_iff_not_of_iff h_c) hn)) -definition dif_pos {c : Type} [H : decidable c] (Hc : c) {A : Type} {t : c → A} {e : ¬ c → A} : (if H : c then t H else e H) = t (decidable.pos_witness Hc) := -decidable.rec - (λ Hc : c, eq.refl (@dite c (decidable.inl Hc) A t e)) - (λ Hnc : ¬c, absurd Hc Hnc) - H +theorem if_congr [congr] {A : Type} {b c : Type} [dec_b : decidable b] [dec_c : decidable c] + {x y u v : A} + (h_c : b ↔ c) (h_t : x = u) (h_e : y = v) : + ite b x y = ite c u v := +@if_ctx_congr A b c dec_b dec_c x y u v h_c (λ h, h_t) (λ h, h_e) -definition dif_neg {c : Type} [H : decidable c] (Hnc : ¬c) {A : Type} {t : c → A} {e : ¬ c → A} : (if H : c then t H else e H) = e (decidable.neg_witness Hnc) := -decidable.rec - (λ Hc : c, absurd Hc Hnc) - (λ Hnc : ¬c, eq.refl (@dite c (decidable.inr Hnc) A t e)) - H +theorem if_ctx_simp_congr {A : Type} {b c : Type} [dec_b : decidable b] {x y u v : A} + (h_c : b ↔ c) (h_t : c → x = u) (h_e : ¬c → y = v) : + ite b x y = (@ite c (decidable_of_decidable_of_iff dec_b h_c) A u v) := +@if_ctx_congr A b c dec_b (decidable_of_decidable_of_iff dec_b h_c) x y u v h_c h_t h_e --- Remark: dite and ite are "definitionally equal" when we ignore the proofs. -definition dite_ite_eq (c : Type) [H : decidable c] {A : Type} (t : A) (e : A) : dite c (λh, t) (λh, e) = ite c t e := +theorem if_simp_congr [congr] {A : Type} {b c : Type} [dec_b : decidable b] {x y u v : A} + (h_c : b ↔ c) (h_t : x = u) (h_e : y = v) : + ite b x y = (@ite c (decidable_of_decidable_of_iff dec_b h_c) A u v) := +@if_ctx_simp_congr A b c dec_b x y u v h_c (λ h, h_t) (λ h, h_e) + +definition if_unit [simp] {A : Type} (t e : A) : (if unit then t else e) = t := +if_pos star + +definition if_empty [simp] {A : Type} (t e : A) : (if empty then t else e) = e := +if_neg not_empty + +theorem if_ctx_congr_prop {b c x y u v : Type} [dec_b : decidable b] [dec_c : decidable c] + (h_c : b ↔ c) (h_t : c → (x ↔ u)) (h_e : ¬c → (y ↔ v)) : + ite b x y ↔ ite c u v := +decidable.rec_on dec_b + (λ hp : b, calc + ite b x y ↔ x : iff.of_eq (if_pos hp) + ... ↔ u : h_t (iff.mp h_c hp) + ... ↔ ite c u v : iff.of_eq (if_pos (iff.mp h_c hp))) + (λ hn : ¬b, calc + ite b x y ↔ y : iff.of_eq (if_neg hn) + ... ↔ v : h_e (iff.mp (not_iff_not_of_iff h_c) hn) + ... ↔ ite c u v : iff.of_eq (if_neg (iff.mp (not_iff_not_of_iff h_c) hn))) + +theorem if_congr_prop [congr] {b c x y u v : Type} [dec_b : decidable b] [dec_c : decidable c] + (h_c : b ↔ c) (h_t : x ↔ u) (h_e : y ↔ v) : + ite b x y ↔ ite c u v := +if_ctx_congr_prop h_c (λ h, h_t) (λ h, h_e) + +theorem if_ctx_simp_congr_prop {b c x y u v : Type} [dec_b : decidable b] + (h_c : b ↔ c) (h_t : c → (x ↔ u)) (h_e : ¬c → (y ↔ v)) : + ite b x y ↔ (@ite c (decidable_of_decidable_of_iff dec_b h_c) Type u v) := +@if_ctx_congr_prop b c x y u v dec_b (decidable_of_decidable_of_iff dec_b h_c) h_c h_t h_e + +theorem if_simp_congr_prop [congr] {b c x y u v : Type} [dec_b : decidable b] + (h_c : b ↔ c) (h_t : x ↔ u) (h_e : y ↔ v) : + ite b x y ↔ (@ite c (decidable_of_decidable_of_iff dec_b h_c) Type u v) := +@if_ctx_simp_congr_prop b c x y u v dec_b h_c (λ h, h_t) (λ h, h_e) + +-- Remark: dite prod ite are "definitionally equal" when we ignore the proofs. +theorem dite_ite_eq (c : Type) [H : decidable c] {A : Type} (t : A) (e : A) : dite c (λh, t) (λh, e) = ite c t e := rfl -end -open eq.ops unit definition is_unit (c : Type) [H : decidable c] : Type₀ := if c then unit else empty @@ -429,16 +673,26 @@ if c then unit else empty definition is_empty (c : Type) [H : decidable c] : Type₀ := if c then empty else unit -theorem of_is_unit {c : Type} [H₁ : decidable c] (H₂ : is_unit c) : c := +definition of_is_unit {c : Type} [H₁ : decidable c] (H₂ : is_unit c) : c := decidable.rec_on H₁ (λ Hc, Hc) (λ Hnc, empty.rec _ (if_neg Hnc ▸ H₂)) -notation `dec_trivial` := of_is_unit star +notation `dec_star` := of_is_unit star theorem not_of_not_is_unit {c : Type} [H₁ : decidable c] (H₂ : ¬ is_unit c) : ¬ c := -decidable.rec_on H₁ (λ Hc, absurd star (if_pos Hc ▸ H₂)) (λ Hnc, Hnc) +if Hc : c then absurd star (if_pos Hc ▸ H₂) else Hc theorem not_of_is_empty {c : Type} [H₁ : decidable c] (H₂ : is_empty c) : ¬ c := -decidable.rec_on H₁ (λ Hc, empty.rec _ (if_pos Hc ▸ H₂)) (λ Hnc, Hnc) +if Hc : c then empty.rec _ (if_pos Hc ▸ H₂) else Hc theorem of_not_is_empty {c : Type} [H₁ : decidable c] (H₂ : ¬ is_empty c) : c := -decidable.rec_on H₁ (λ Hc, Hc) (λ Hnc, absurd star (if_neg Hnc ▸ H₂)) +if Hc : c then Hc else absurd star (if_neg Hc ▸ H₂) + +-- The following symbols should not be considered in the pattern inference procedure used by +-- heuristic instantiation. +attribute prod sum not iff ite dite eq ne [no_pattern] + +-- namespace used to collect congruence rules for "contextual simplification" +namespace contextual + attribute if_ctx_simp_congr [congr] + attribute if_ctx_simp_congr_prop [congr] +end contextual diff --git a/hott/init/nat.hlean b/hott/init/nat.hlean index b47e27f1e9..5172d9e113 100644 --- a/hott/init/nat.hlean +++ b/hott/init/nat.hlean @@ -179,10 +179,10 @@ namespace nat theorem lt_zero_iff_empty [simp] (a : ℕ) : a < 0 ↔ empty := iff_empty_intro (not_lt_zero a) - protected theorem eq_or_lt_of_le {a b : ℕ} (H : a ≤ b) : a = b ⊎ a < b := + protected theorem eq_sum_lt_of_le {a b : ℕ} (H : a ≤ b) : a = b ⊎ a < b := le.cases_on H (inl rfl) (λn h, inr (succ_le_succ h)) - protected theorem le_of_eq_or_lt {a b : ℕ} (H : a = b ⊎ a < b) : a ≤ b := + protected theorem le_of_eq_sum_lt {a b : ℕ} (H : a = b ⊎ a < b) : a ≤ b := sum.rec_on H !nat.le_of_eq !nat.le_of_lt -- less-than is well-founded @@ -222,13 +222,13 @@ namespace nat definition decidable_lt [instance] [priority nat.prio] : Π a b : nat, decidable (a < b) := λ a b, decidable_le (succ a) b - protected theorem lt_or_ge (a b : ℕ) : a < b ⊎ a ≥ b := + protected theorem lt_sum_ge (a b : ℕ) : a < b ⊎ a ≥ b := nat.rec (inr !zero_le) (λn, sum.rec (λh, inl (le_succ_of_le h)) - (λh, sum.rec_on (nat.eq_or_lt_of_le h) (λe, inl (eq.subst e !nat.le_refl)) inr)) b + (λh, sum.rec_on (nat.eq_sum_lt_of_le h) (λe, inl (eq.subst e !nat.le_refl)) inr)) b protected definition lt_ge_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a ≥ b → P) : P := - by_cases H1 (λh, H2 (sum.rec_on !nat.lt_or_ge (λa, absurd a h) (λa, a))) + by_cases H1 (λh, H2 (sum.rec_on !nat.lt_sum_ge (λa, absurd a h) (λa, a))) protected definition lt_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P := @@ -238,7 +238,7 @@ namespace nat protected theorem lt_trichotomy (a b : ℕ) : a < b ⊎ a = b ⊎ b < a := nat.lt_by_cases (λH, inl H) (λH, inr (inl H)) (λH, inr (inr H)) - protected theorem eq_or_lt_of_not_lt {a b : ℕ} (hnlt : ¬ a < b) : a = b ⊎ b < a := + protected theorem eq_sum_lt_of_not_lt {a b : ℕ} (hnlt : ¬ a < b) : a = b ⊎ b < a := sum.rec_on (nat.lt_trichotomy a b) (λ hlt, absurd hlt hnlt) (λ h, h) diff --git a/hott/init/reserved_notation.hlean b/hott/init/reserved_notation.hlean index 18ae9dbf6c..369ebd8a65 100644 --- a/hott/init/reserved_notation.hlean +++ b/hott/init/reserved_notation.hlean @@ -155,8 +155,8 @@ reserve infixr ` ▹ `:75 /- types and type constructors -/ -reserve infixr ` ⊎ `:25 -reserve infixr ` × `:30 +reserve infixr ` ⊎ `:30 +reserve infixr ` × `:35 /- arithmetic operations -/ diff --git a/hott/init/trunc.hlean b/hott/init/trunc.hlean index 43751a4844..7c6c4bcd76 100644 --- a/hott/init/trunc.hlean +++ b/hott/init/trunc.hlean @@ -28,6 +28,9 @@ namespace is_trunc definition has_zero_trunc_index [instance] [reducible] : has_zero trunc_index := has_zero.mk (succ (succ minus_two)) + definition has_one_trunc_index [instance] [reducible] : has_one trunc_index := + has_one.mk (succ (succ (succ minus_two))) + /- notation for trunc_index is -2, -1, 0, 1, ... from 0 and up this comes from a coercion from num to trunc_index (via nat) @@ -44,15 +47,17 @@ namespace is_trunc definition leq (n m : trunc_index) : Type₀ := trunc_index.rec_on n (λm, unit) (λ n p m, trunc_index.rec_on m (λ p, empty) (λ m q p, p m) p) m - infix <= := trunc_index.leq - infix ≤ := trunc_index.leq + + definition has_le_trunc_index [instance] [reducible] : has_le trunc_index := + has_le.mk leq + end trunc_index infix `+2+`:65 := trunc_index.add namespace trunc_index - definition succ_le_succ {n m : trunc_index} (H : n ≤ m) : n.+1 ≤ m.+1 := H - definition le_of_succ_le_succ {n m : trunc_index} (H : n.+1 ≤ m.+1) : n ≤ m := H + definition succ_le_succ {n m : trunc_index} (H : n ≤ m) : n.+1 ≤ m.+1 := proof H qed + definition le_of_succ_le_succ {n m : trunc_index} (H : n.+1 ≤ m.+1) : n ≤ m := proof H qed definition minus_two_le (n : trunc_index) : -2 ≤ n := star definition le.refl (n : trunc_index) : n ≤ n := by induction n with n IH; exact star; exact IH definition empty_of_succ_le_minus_two {n : trunc_index} (H : n .+1 ≤ -2) : empty := H @@ -101,6 +106,10 @@ namespace is_trunc (n : trunc_index) [H : is_trunc (n.+1) A] (x y : A) : is_trunc n (x = y) := is_trunc.mk (is_trunc.to_internal (n.+1) A x y) + definition is_trunc_eq_zero [instance] [priority 1250] [H : is_trunc 1 A] (x y : A) + : is_hset (x = y) := + @is_trunc_eq A 0 H x y + /- contractibility -/ definition is_contr.mk (center : A) (center_eq : Π(a : A), center = a) : is_contr A := @@ -134,6 +143,9 @@ namespace is_trunc A H --in the proof the type of H is given explicitly to make it available for class inference + theorem is_trunc_succ_zero [instance] [priority 950] (A : Type) [H : is_hset A] : is_trunc 1 A := + !is_trunc_succ + theorem is_trunc_of_leq.{l} (A : Type.{l}) {n m : trunc_index} (Hnm : n ≤ m) [Hn : is_trunc n A] : is_trunc m A := have base : ∀k A, k ≤ -2 → is_trunc k A → (is_trunc -2 A), from diff --git a/hott/init/types.hlean b/hott/init/types.hlean index 7e5317119e..5b2473a67b 100644 --- a/hott/init/types.hlean +++ b/hott/init/types.hlean @@ -11,13 +11,6 @@ open iff -- Empty type -- ---------- -namespace empty - - protected theorem elim {A : Type} (H : empty) : A := - empty.rec (λe, A) H - -end empty - protected definition empty.has_decidable_eq [instance] : decidable_eq empty := take (a b : empty), decidable.inl (!empty.elim a) @@ -48,8 +41,6 @@ end sigma -- Sum type -- -------- -infixr ⊎ := sum -infixr + := sum namespace sum infixr [parsing_only] `+t`:25 := sum -- notation which is never overloaded @@ -60,8 +51,6 @@ namespace sum variables {a b c d : Type} - protected definition elim (H : a ⊎ b) (f : a → c) (g : b → c) := sum.rec_on H f g - definition sum_of_sum_of_imp_of_imp (H₁ : a ⊎ b) (H₂ : a → c) (H₃ : b → d) : c ⊎ d := sum.rec_on H₁ (assume Ha : a, sum.inl (H₂ Ha)) @@ -81,8 +70,6 @@ end sum -- Product type -- ------------ -abbreviation pair [constructor] := @prod.mk -infixr × := prod namespace prod @@ -168,168 +155,9 @@ namespace prod end prod -/- logic using prod and sum -/ +/- logic (ported from standard library as second half of logic file) -/ + +/- iff -/ variables {a b c d : Type} open prod sum unit - -/- prod -/ - -definition not_prod_of_not_left (b : Type) (Hna : ¬a) : ¬(a × b) := -assume H : a × b, absurd (pr1 H) Hna - -definition not_prod_of_not_right (a : Type) {b : Type} (Hnb : ¬b) : ¬(a × b) := -assume H : a × b, absurd (pr2 H) Hnb - -definition prod.swap (H : a × b) : b × a := -pair (pr2 H) (pr1 H) - -definition prod_of_prod_of_imp_of_imp (H₁ : a × b) (H₂ : a → c) (H₃ : b → d) : c × d := -by cases H₁ with aa bb; exact (H₂ aa, H₃ bb) - -definition prod_of_prod_of_imp_left (H₁ : a × c) (H : a → b) : b × c := -by cases H₁ with aa cc; exact (H aa, cc) - -definition prod_of_prod_of_imp_right (H₁ : c × a) (H : a → b) : c × b := -by cases H₁ with cc aa; exact (cc, H aa) - -definition prod.comm : a × b ↔ b × a := -iff.intro (λH, prod.swap H) (λH, prod.swap H) - -definition prod.assoc : (a × b) × c ↔ a × (b × c) := -iff.intro - (assume H, pair - (pr1 (pr1 H)) - (pair (pr2 (pr1 H)) (pr2 H))) - (assume H, pair - (pair (pr1 H) (pr1 (pr2 H))) - (pr2 (pr2 H))) - -definition prod_unit (a : Type) : a × unit ↔ a := -iff.intro (assume H, pr1 H) (assume H, pair H star) - -definition unit_prod (a : Type) : unit × a ↔ a := -iff.intro (assume H, pr2 H) (assume H, pair star H) - -definition prod_empty (a : Type) : a × empty ↔ empty := -iff.intro (assume H, pr2 H) (assume H, !empty.elim H) - -definition empty_prod (a : Type) : empty × a ↔ empty := -iff.intro (assume H, pr1 H) (assume H, !empty.elim H) - -definition prod_self (a : Type) : a × a ↔ a := -iff.intro (assume H, pr1 H) (assume H, pair H H) - -/- sum -/ - -definition not_sum (Hna : ¬a) (Hnb : ¬b) : ¬(a ⊎ b) := -assume H : a ⊎ b, sum.rec_on H - (assume Ha, absurd Ha Hna) - (assume Hb, absurd Hb Hnb) - -definition sum_of_sum_of_imp_of_imp (H₁ : a ⊎ b) (H₂ : a → c) (H₃ : b → d) : c ⊎ d := -sum.rec_on H₁ - (assume Ha : a, sum.inl (H₂ Ha)) - (assume Hb : b, sum.inr (H₃ Hb)) - -definition sum_of_sum_of_imp_left (H₁ : a ⊎ c) (H : a → b) : b ⊎ c := -sum.rec_on H₁ - (assume H₂ : a, sum.inl (H H₂)) - (assume H₂ : c, sum.inr H₂) - -definition sum_of_sum_of_imp_right (H₁ : c ⊎ a) (H : a → b) : c ⊎ b := -sum.rec_on H₁ - (assume H₂ : c, sum.inl H₂) - (assume H₂ : a, sum.inr (H H₂)) - -definition sum.elim3 (H : a ⊎ b ⊎ c) (Ha : a → d) (Hb : b → d) (Hc : c → d) : d := -sum.rec_on H Ha (assume H₂, sum.rec_on H₂ Hb Hc) - -definition sum_resolve_right (H₁ : a ⊎ b) (H₂ : ¬a) : b := -sum.rec_on H₁ (assume Ha, absurd Ha H₂) (assume Hb, Hb) - -definition sum_resolve_left (H₁ : a ⊎ b) (H₂ : ¬b) : a := -sum.rec_on H₁ (assume Ha, Ha) (assume Hb, absurd Hb H₂) - -definition sum.swap (H : a ⊎ b) : b ⊎ a := -sum.rec_on H (assume Ha, sum.inr Ha) (assume Hb, sum.inl Hb) - -definition sum.comm : a ⊎ b ↔ b ⊎ a := -iff.intro (λH, sum.swap H) (λH, sum.swap H) - -definition sum.assoc : (a ⊎ b) ⊎ c ↔ a ⊎ (b ⊎ c) := -iff.intro - (assume H, sum.rec_on H - (assume H₁, sum.rec_on H₁ - (assume Ha, sum.inl Ha) - (assume Hb, sum.inr (sum.inl Hb))) - (assume Hc, sum.inr (sum.inr Hc))) - (assume H, sum.rec_on H - (assume Ha, (sum.inl (sum.inl Ha))) - (assume H₁, sum.rec_on H₁ - (assume Hb, sum.inl (sum.inr Hb)) - (assume Hc, sum.inr Hc))) - -definition sum_unit (a : Type) : a ⊎ unit ↔ unit := -iff.intro (assume H, star) (assume H, sum.inr H) - -definition unit_sum (a : Type) : unit ⊎ a ↔ unit := -iff.intro (assume H, star) (assume H, sum.inl H) - -definition sum_empty (a : Type) : a ⊎ empty ↔ a := -iff.intro - (assume H, sum.rec_on H (assume H1 : a, H1) (assume H1 : empty, !empty.elim H1)) - (assume H, sum.inl H) - -definition empty_sum (a : Type) : empty ⊎ a ↔ a := -iff.intro - (assume H, sum.rec_on H (assume H1 : empty, !empty.elim H1) (assume H1 : a, H1)) - (assume H, sum.inr H) - -definition sum_self (a : Type) : a ⊎ a ↔ a := -iff.intro - (assume H, sum.rec_on H (assume H1, H1) (assume H1, H1)) - (assume H, sum.inl H) - -/- TODO -theorem sum.right_comm (a b c : Type) : (a + b) + c ↔ (a + c) + b := -calc - (a + b) + c ↔ a + (b + c) : sum.assoc - ... ↔ a + (c + b) : {sum.comm} - ... ↔ (a + c) + b : iff.symm sum.assoc - -theorem sum.left_comm (a b c : Type) : a + (b + c) ↔ b + (a + c) := -calc - a + (b + c) ↔ (a + b) + c : iff.symm sum.assoc - ... ↔ (b + a) + c : {sum.comm} - ... ↔ b + (a + c) : sum.assoc - -theorem prod.right_comm (a b c : Type) : (a × b) × c ↔ (a × c) × b := -calc - (a × b) × c ↔ a × (b × c) : prod.assoc - ... ↔ a × (c × b) : _ - ... ↔ (a × c) × b : iff.symm prod.assoc - -theorem prod_not_self_iff {a : Type} : a × ¬ a ↔ false := -iff.intro (assume H, (prod.right H) (prod.left H)) (assume H, false.elim H) - -theorem not_prod_self_iff {a : Type} : ¬ a × a ↔ false := -!prod.comm ▸ !prod_not_self_iff - -theorem prod.left_comm [simp] (a b c : Type) : a × (b × c) ↔ b × (a × c) := -calc - a × (b × c) ↔ (a × b) × c : iff.symm prod.assoc - ... ↔ (b × a) × c : {prod.comm} - ... ↔ b × (a × c) : prod.assoc --/ - -theorem imp.syl (H : a → b) (H₂ : c → a) (Hc : c) : b := -H (H₂ Hc) - -theorem sum.imp_distrib : ((a + b) → c) ↔ ((a → c) × (b → c)) := -iff.intro - (λH, prod.mk (imp.syl H sum.inl) (imp.syl H sum.inr)) - (prod.rec sum.rec) - -theorem not_sum_iff_not_prod_not {a b : Type} : ¬(a + b) ↔ ¬a × ¬b := -sum.imp_distrib diff --git a/hott/tools/helper_tactics.hlean b/hott/tools/helper_tactics.hlean new file mode 100644 index 0000000000..91375d8f76 --- /dev/null +++ b/hott/tools/helper_tactics.hlean @@ -0,0 +1,15 @@ +-- Copyright (c) 2014 Microsoft Corporation. All rights reserved. +-- Released under Apache 2.0 license as described in the file LICENSE. +-- Author: Leonardo de Moura, Jeremy Avigad + +-- tools.helper_tactics +-- ==================== + +-- Useful tactics. + +open tactic + +namespace helper_tactics + definition apply_refl := apply eq.refl + tactic_hint apply_refl +end helper_tactics diff --git a/hott/tools/tools.md b/hott/tools/tools.md new file mode 100644 index 0000000000..bc88f47d1a --- /dev/null +++ b/hott/tools/tools.md @@ -0,0 +1,6 @@ +tools +===== + +Various additional tools. + +* [helper_tactics](helper_tactics.lean) : useful tactics \ No newline at end of file diff --git a/hott/types/bool.hlean b/hott/types/bool.hlean index 1532cf2d9e..8b2dcbabc4 100644 --- a/hott/types/bool.hlean +++ b/hott/types/bool.hlean @@ -1,24 +1,146 @@ /- -Copyright (c) 2015 Floris van Doorn. All rights reserved. +Copyright (c) 2014 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Floris van Doorn +Author: Leonardo de Moura, Floris van Doorn -Theorems about the booleans +Partially ported from the standard library -/ -open is_equiv eq equiv function is_trunc option unit decidable +open eq eq.ops decidable namespace bool + local attribute bor [reducible] + local attribute band [reducible] + + theorem dichotomy (b : bool) : b = ff ⊎ b = tt := + bool.cases_on b (sum.inl rfl) (sum.inr rfl) + + theorem cond_ff {A : Type} (t e : A) : cond ff t e = e := + rfl + + theorem cond_tt {A : Type} (t e : A) : cond tt t e = t := + rfl + + theorem eq_tt_of_ne_ff : Π {a : bool}, a ≠ ff → a = tt + | @eq_tt_of_ne_ff tt H := rfl + | @eq_tt_of_ne_ff ff H := absurd rfl H + + theorem eq_ff_of_ne_tt : Π {a : bool}, a ≠ tt → a = ff + | @eq_ff_of_ne_tt tt H := absurd rfl H + | @eq_ff_of_ne_tt ff H := rfl + + theorem absurd_of_eq_ff_of_eq_tt {B : Type} {a : bool} (H₁ : a = ff) (H₂ : a = tt) : B := + absurd (H₁⁻¹ ⬝ H₂) ff_ne_tt + + theorem tt_bor (a : bool) : bor tt a = tt := + rfl + + notation a || b := bor a b + + theorem bor_tt (a : bool) : a || tt = tt := + bool.cases_on a rfl rfl + + theorem ff_bor (a : bool) : ff || a = a := + bool.cases_on a rfl rfl + + theorem bor_ff (a : bool) : a || ff = a := + bool.cases_on a rfl rfl + + theorem bor_self (a : bool) : a || a = a := + bool.cases_on a rfl rfl + + theorem bor.comm (a b : bool) : a || b = b || a := + by cases a; repeat (cases b | reflexivity) + + theorem bor.assoc (a b c : bool) : (a || b) || c = a || (b || c) := + match a with + | ff := by rewrite *ff_bor + | tt := by rewrite *tt_bor + end + + theorem or_of_bor_eq {a b : bool} : a || b = tt → a = tt ⊎ b = tt := + bool.rec_on a + (suppose ff || b = tt, + have b = tt, from !ff_bor ▸ this, + sum.inr this) + (suppose tt || b = tt, + sum.inl rfl) + + theorem bor_inl {a b : bool} (H : a = tt) : a || b = tt := + by rewrite H + + theorem bor_inr {a b : bool} (H : b = tt) : a || b = tt := + bool.rec_on a (by rewrite H) (by rewrite H) + + theorem ff_band (a : bool) : ff && a = ff := + rfl + + theorem tt_band (a : bool) : tt && a = a := + bool.cases_on a rfl rfl + + theorem band_ff (a : bool) : a && ff = ff := + bool.cases_on a rfl rfl + + theorem band_tt (a : bool) : a && tt = a := + bool.cases_on a rfl rfl + + theorem band_self (a : bool) : a && a = a := + bool.cases_on a rfl rfl + + theorem band.comm (a b : bool) : a && b = b && a := + bool.cases_on a + (bool.cases_on b rfl rfl) + (bool.cases_on b rfl rfl) + + theorem band.assoc (a b c : bool) : (a && b) && c = a && (b && c) := + match a with + | ff := by rewrite *ff_band + | tt := by rewrite *tt_band + end + + theorem band_elim_left {a b : bool} (H : a && b = tt) : a = tt := + sum.elim (dichotomy a) + (suppose a = ff, + absurd + (calc ff = ff && b : ff_band + ... = a && b : this + ... = tt : H) + ff_ne_tt) + (suppose a = tt, this) + + theorem band_intro {a b : bool} (H₁ : a = tt) (H₂ : b = tt) : a && b = tt := + by rewrite [H₁, H₂] + + theorem band_elim_right {a b : bool} (H : a && b = tt) : b = tt := + band_elim_left (!band.comm ⬝ H) + + theorem bnot_bnot (a : bool) : bnot (bnot a) = a := + bool.cases_on a rfl rfl + + theorem bnot_empty : bnot ff = tt := + rfl + + theorem bnot_unit : bnot tt = ff := + rfl + + theorem eq_tt_of_bnot_eq_ff {a : bool} : bnot a = ff → a = tt := + bool.cases_on a (by contradiction) (λ h, rfl) + + theorem eq_ff_of_bnot_eq_tt {a : bool} : bnot a = tt → a = ff := + bool.cases_on a (λ h, rfl) (by contradiction) + + definition bxor (x:bool) (y:bool) := cond x (bnot y) y + + /- HoTT-related stuff -/ + open is_equiv equiv function is_trunc option unit decidable - definition ff_ne_tt : ff = tt → empty - | [none] definition is_equiv_bnot [constructor] [instance] [priority 500] : is_equiv bnot := begin fapply is_equiv.mk, exact bnot, all_goals (intro b;cases b), do 6 reflexivity --- all_goals (focus (intro b;cases b;all_goals reflexivity)), + -- all_goals (focus (intro b;cases b;all_goals reflexivity)), end definition bnot_ne : Π(b : bool), bnot b ≠ b @@ -43,10 +165,4 @@ namespace bool { intro b, cases b, reflexivity, reflexivity}, end - protected definition has_decidable_eq [instance] : ∀ x y : bool, decidable (x = y) - | has_decidable_eq ff ff := inl rfl - | has_decidable_eq ff tt := inr (by contradiction) - | has_decidable_eq tt ff := inr (by contradiction) - | has_decidable_eq tt tt := inl rfl - end bool diff --git a/hott/types/int/basic.hlean b/hott/types/int/basic.hlean index 03e87fc1a0..0d1a1b4f99 100644 --- a/hott/types/int/basic.hlean +++ b/hott/types/int/basic.hlean @@ -3,11 +3,11 @@ Copyright (c) 2014 Floris van Doorn. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Jeremy Avigad -The integers, with addition, multiplication, and subtraction. The representation of the integers is +The integers, with addition, multiplication, prod subtraction. The representation of the integers is chosen to compute efficiently. To faciliate proving things about these operations, we show that the integers are a quotient of -ℕ × ℕ with the usual equivalence relation, ≡, and functions +ℕ × ℕ with the usual equivalence relation, ≡, prod functions abstr : ℕ × ℕ → ℤ repr : ℤ → ℕ × ℕ @@ -24,11 +24,11 @@ following: repr_add (a b : ℤ) : repr (a + b) = padd (repr a) (repr b) padd_congr (p p' q q' : ℕ × ℕ) (H1 : p ≡ p') (H2 : q ≡ q') : padd p q ≡ p' q' -Ported from standard library -/ import types.nat.sub algebra.relation types.prod - -open core nat decidable prod relation prod +open prod relation nat +open decidable binary +open algebra eq lift /- the type of integers -/ @@ -37,274 +37,264 @@ inductive int : Type := | neg_succ_of_nat : nat → int notation `ℤ` := int -attribute int.of_nat [coercion] definition int.of_num [coercion] [reducible] [constructor] (n : num) : ℤ := int.of_nat (nat.of_num n) namespace int +attribute int.of_nat [coercion] + +notation `-[1+ ` n `]` := int.neg_succ_of_nat n -- for pretty-printing output + +protected definition prio : num := num.pred nat.prio + +definition int_has_zero [reducible] [instance] [priority int.prio] : has_zero int := +has_zero.mk (of_nat 0) + +definition int_has_one [reducible] [instance] [priority int.prio] : has_one int := +has_one.mk (of_nat 1) + +theorem of_nat_zero : of_nat (0:nat) = (0:int) := +rfl + +theorem of_nat_one : of_nat (1:nat) = (1:int) := +rfl + /- definitions of basic functions -/ -definition neg_of_nat (m : ℕ) : ℤ := -nat.cases_on m 0 (take m', neg_succ_of_nat m') +definition neg_of_nat : ℕ → ℤ +| 0 := 0 +| (succ m) := -[1+ m] definition sub_nat_nat (m n : ℕ) : ℤ := -nat.cases_on (n - m) - (of_nat (m - n)) -- m ≥ n - (take k, neg_succ_of_nat k) -- m < n, and n - m = succ k +match (n - m : nat) with + | 0 := of_nat (m - n) -- m ≥ n + | (succ k) := -[1+ k] -- m < n, prod n - m = succ k +end -definition neg (a : ℤ) : ℤ := - int.cases_on a - (take m, -- a = of_nat m - nat.cases_on m 0 (take m', neg_succ_of_nat m')) - (take m, of_nat (succ m)) -- a = neg_succ_of_nat m +protected definition neg (a : ℤ) : ℤ := +int.cases_on a neg_of_nat succ -definition add (a b : ℤ) : ℤ := - int.cases_on a - (take m, -- a = of_nat m - int.cases_on b - (take n, of_nat (m + n)) -- b = of_nat n - (take n, sub_nat_nat m (succ n))) -- b = neg_succ_of_nat n - (take m, -- a = neg_succ_of_nat m - int.cases_on b - (take n, sub_nat_nat n (succ m)) -- b = of_nat n - (take n, neg_of_nat (succ m + succ n))) -- b = neg_succ_of_nat n +protected definition add : ℤ → ℤ → ℤ +| (of_nat m) (of_nat n) := _root_.add m n +| (of_nat m) -[1+ n] := sub_nat_nat m (succ n) +| -[1+ m] (of_nat n) := sub_nat_nat n (succ m) +| -[1+ m] -[1+ n] := neg_of_nat (succ m + succ n) -definition mul (a b : ℤ) : ℤ := - int.cases_on a - (take m, -- a = of_nat m - int.cases_on b - (take n, of_nat (m * n)) -- b = of_nat n - (take n, neg_of_nat (m * succ n))) -- b = neg_succ_of_nat n - (take m, -- a = neg_succ_of_nat m - int.cases_on b - (take n, neg_of_nat (succ m * n)) -- b = of_nat n - (take n, of_nat (succ m * succ n))) -- b = neg_succ_of_nat n +protected definition mul : ℤ → ℤ → ℤ +| (of_nat m) (of_nat n) := m * n +| (of_nat m) -[1+ n] := neg_of_nat (m * succ n) +| -[1+ m] (of_nat n) := neg_of_nat (succ m * n) +| -[1+ m] -[1+ n] := succ m * succ n /- notation -/ -notation `-[`:95 n:0 `+1]`:0 := int.neg_succ_of_nat n -- for pretty-printing output -prefix - := int.neg -infix + := int.add -infix * := int.mul +definition int_has_add [reducible] [instance] [priority int.prio] : has_add int := has_add.mk int.add +definition int_has_neg [reducible] [instance] [priority int.prio] : has_neg int := has_neg.mk int.neg +definition int_has_mul [reducible] [instance] [priority int.prio] : has_mul int := has_mul.mk int.mul -/- some basic functions and properties -/ +lemma mul_of_nat_of_nat (m n : nat) : of_nat m * of_nat n = of_nat (m * n) := +rfl -definition of_nat.inj {m n : ℕ} (H : of_nat m = of_nat n) : m = n := -by injection H; assumption +lemma mul_of_nat_neg_succ_of_nat (m n : nat) : of_nat m * -[1+ n] = neg_of_nat (m * succ n) := +rfl -definition neg_succ_of_nat.inj {m n : ℕ} (H : neg_succ_of_nat m = neg_succ_of_nat n) : m = n := -by injection H; assumption +lemma mul_neg_succ_of_nat_of_nat (m n : nat) : -[1+ m] * of_nat n = neg_of_nat (succ m * n) := +rfl -definition neg_succ_of_nat_eq (n : ℕ) : -[n +1] = -(n + 1) := rfl +lemma mul_neg_succ_of_nat_neg_succ_of_nat (m n : nat) : -[1+ m] * -[1+ n] = succ m * succ n := +rfl -definition has_decidable_eq [instance] : decidable_eq ℤ := -take a b, -int.cases_on a - (take m, - int.cases_on b - (take n, - if H : m = n then inl (ap of_nat H) else inr (take H1, H (of_nat.inj H1))) - (take n', inr (by contradiction))) - (take m', - int.cases_on b - (take n, inr (by contradiction)) - (take n', - (if H : m' = n' then inl (ap neg_succ_of_nat H) else - inr (take H1, H (neg_succ_of_nat.inj H1))))) +/- some basic functions prod properties -/ -definition of_nat_add_of_nat (n m : nat) : of_nat n + of_nat m = #nat n + m := rfl +theorem of_nat.inj {m n : ℕ} (H : of_nat m = of_nat n) : m = n := +down (int.no_confusion H imp.id) -definition of_nat_succ (n : ℕ) : of_nat (succ n) = of_nat n + 1 := rfl +theorem eq_of_of_nat_eq_of_nat {m n : ℕ} (H : of_nat m = of_nat n) : m = n := +of_nat.inj H -definition of_nat_mul_of_nat (n m : ℕ) : of_nat n * of_nat m = n * m := rfl +theorem of_nat_eq_of_nat_iff (m n : ℕ) : of_nat m = of_nat n ↔ m = n := +iff.intro of_nat.inj !ap -definition sub_nat_nat_of_ge {m n : ℕ} (H : m ≥ n) : sub_nat_nat m n = of_nat (m - n) := -have H1 : n - m = 0, from sub_eq_zero_of_le H, -calc - sub_nat_nat m n = nat.cases_on 0 (of_nat (m - n)) _ : H1 ▸ rfl - ... = of_nat (m - n) : rfl +theorem neg_succ_of_nat.inj {m n : ℕ} (H : neg_succ_of_nat m = neg_succ_of_nat n) : m = n := +down (int.no_confusion H imp.id) + +theorem neg_succ_of_nat_eq (n : ℕ) : -[1+ n] = -(n + 1) := rfl + +private definition has_decidable_eq₂ : Π (a b : ℤ), decidable (a = b) +| (of_nat m) (of_nat n) := decidable_of_decidable_of_iff + (nat.has_decidable_eq m n) (iff.symm (of_nat_eq_of_nat_iff m n)) +| (of_nat m) -[1+ n] := inr (by contradiction) +| -[1+ m] (of_nat n) := inr (by contradiction) +| -[1+ m] -[1+ n] := if H : m = n then + inl (ap neg_succ_of_nat H) else inr (not.mto neg_succ_of_nat.inj H) + +definition has_decidable_eq [instance] [priority int.prio] : decidable_eq ℤ := has_decidable_eq₂ + +theorem of_nat_add (n m : nat) : of_nat (n + m) = of_nat n + of_nat m := rfl + +theorem of_nat_succ (n : ℕ) : of_nat (succ n) = of_nat n + 1 := rfl + +theorem of_nat_mul (n m : ℕ) : of_nat (n * m) = of_nat n * of_nat m := rfl + +theorem sub_nat_nat_of_ge {m n : ℕ} (H : m ≥ n) : sub_nat_nat m n = of_nat (m - n) := +show sub_nat_nat m n = nat.cases_on 0 (m -[nat] n) _, from (sub_eq_zero_of_le H) ▸ rfl section local attribute sub_nat_nat [reducible] -definition sub_nat_nat_of_lt {m n : ℕ} (H : m < n) : - sub_nat_nat m n = neg_succ_of_nat (pred (n - m)) := -have H1 : n - m = succ (pred (n - m)), from (succ_pred_of_pos (sub_pos_of_lt H))⁻¹, -calc - sub_nat_nat m n = nat.cases_on (succ (pred (n - m))) (of_nat (m - n)) - (take k, neg_succ_of_nat k) : H1 ▸ rfl - ... = neg_succ_of_nat (pred (n - m)) : rfl +theorem sub_nat_nat_of_lt {m n : ℕ} (H : m < n) : sub_nat_nat m n = -[1+ pred (n - m)] := +have H1 : n - m = succ (pred (n - m)), from inverse (succ_pred_of_pos (nat.sub_pos_of_lt H)), +show sub_nat_nat m n = nat.cases_on (succ (nat.pred (n - m))) (m -[nat] n) _, from H1 ▸ rfl end -definition nat_abs (a : ℤ) : ℕ := int.cases_on a (take n, n) (take n', succ n') +definition nat_abs (a : ℤ) : ℕ := int.cases_on a id succ -definition nat_abs_of_nat (n : ℕ) : nat_abs (of_nat n) = n := rfl +theorem nat_abs_of_nat (n : ℕ) : nat_abs n = n := rfl -definition nat_abs_eq_zero {a : ℤ} : nat_abs a = 0 → a = 0 := -int.cases_on a - (take m, assume H : nat_abs (of_nat m) = 0, ap of_nat H) - (take m', assume H : nat_abs (neg_succ_of_nat m') = 0, absurd H (succ_ne_zero _)) +theorem eq_zero_of_nat_abs_eq_zero : Π {a : ℤ}, nat_abs a = 0 → a = 0 +| (of_nat m) H := ap of_nat H +| -[1+ m'] H := absurd H !succ_ne_zero + +theorem nat_abs_zero : nat_abs (0:int) = (0:nat) := +rfl + +theorem nat_abs_one : nat_abs (1:int) = (1:nat) := +rfl /- int is a quotient of ordered pairs of natural numbers -/ -definition int_equiv (p q : ℕ × ℕ) : Type₀ := pr1 p + pr2 q = pr2 p + pr1 q +protected definition equiv (p q : ℕ × ℕ) : Type₀ := pr1 p + pr2 q = pr2 p + pr1 q -local infix `≡` := int_equiv +local infix ≡ := int.equiv -protected theorem int_equiv.refl [refl] {p : ℕ × ℕ} : p ≡ p := !add.comm +protected theorem equiv.refl [refl] {p : ℕ × ℕ} : p ≡ p := !add.comm -protected theorem int_equiv.symm [symm] {p q : ℕ × ℕ} (H : p ≡ q) : q ≡ p := +protected theorem equiv.symm [symm] {p q : ℕ × ℕ} (H : p ≡ q) : q ≡ p := calc - pr1 q + pr2 p = pr2 p + pr1 q : !add.comm + pr1 q + pr2 p = pr2 p + pr1 q : by rewrite add.comm ... = pr1 p + pr2 q : H⁻¹ - ... = pr2 q + pr1 p : !add.comm + ... = pr2 q + pr1 p : by rewrite add.comm -protected theorem int_equiv.trans [trans] {p q r : ℕ × ℕ} (H1 : p ≡ q) (H2 : q ≡ r) : p ≡ r := -add.cancel_right (calc - pr1 p + pr2 r + pr2 q = pr1 p + pr2 q + pr2 r : add.right_comm +protected theorem equiv.trans [trans] {p q r : ℕ × ℕ} (H1 : p ≡ q) (H2 : q ≡ r) : p ≡ r := +add.right_cancel (calc + pr1 p + pr2 r + pr2 q = pr1 p + pr2 q + pr2 r : by rewrite add.right_comm ... = pr2 p + pr1 q + pr2 r : {H1} - ... = pr2 p + (pr1 q + pr2 r) : add.assoc + ... = pr2 p + (pr1 q + pr2 r) : by rewrite add.assoc ... = pr2 p + (pr2 q + pr1 r) : {H2} - ... = pr2 p + pr2 q + pr1 r : add.assoc - ... = pr2 p + pr1 r + pr2 q : add.right_comm) + ... = pr2 p + pr2 q + pr1 r : by rewrite add.assoc + ... = pr2 p + pr1 r + pr2 q : by rewrite add.right_comm) -definition int_equiv_int_equiv : is_equivalence int_equiv := -is_equivalence.mk @int_equiv.refl @int_equiv.symm @int_equiv.trans +protected theorem equiv_equiv : is_equivalence int.equiv := +is_equivalence.mk @equiv.refl @equiv.symm @equiv.trans -definition int_equiv_cases {p q : ℕ × ℕ} (H : int_equiv p q) : +protected theorem equiv_cases {p q : ℕ × ℕ} (H : p ≡ q) : (pr1 p ≥ pr2 p × pr1 q ≥ pr2 q) ⊎ (pr1 p < pr2 p × pr1 q < pr2 q) := -sum.rec_on (@le_or_gt (pr2 p) (pr1 p)) - (assume H1: pr1 p ≥ pr2 p, - have H2 : pr2 p + pr1 q ≥ pr2 p + pr2 q, from H ▸ add_le_add_right H1 (pr2 q), - sum.inl (pair H1 (le_of_add_le_add_left H2))) - (assume H1: pr1 p < pr2 p, - have H2 : pr2 p + pr1 q < pr2 p + pr2 q, from H ▸ add_lt_add_right H1 (pr2 q), - sum.inr (pair H1 (lt_of_add_lt_add_left H2))) +sum.elim (@le_sum_gt _ _ (pr2 p) (pr1 p)) + (suppose pr1 p ≥ pr2 p, + have pr2 p + pr1 q ≥ pr2 p + pr2 q, from H ▸ add_le_add_right this (pr2 q), + sum.inl (pair `pr1 p ≥ pr2 p` (le_of_add_le_add_left this))) + (suppose H₁ : pr1 p < pr2 p, + have pr2 p + pr1 q < pr2 p + pr2 q, from H ▸ add_lt_add_right H₁ (pr2 q), + sum.inr (pair H₁ (lt_of_add_lt_add_left this))) -definition int_equiv_of_eq {p q : ℕ × ℕ} (H : p = q) : p ≡ q := H ▸ int_equiv.refl +protected theorem equiv_of_eq {p q : ℕ × ℕ} (H : p = q) : p ≡ q := H ▸ equiv.refl -/- the representation and abstraction functions -/ +/- the representation prod abstraction functions -/ definition abstr (a : ℕ × ℕ) : ℤ := sub_nat_nat (pr1 a) (pr2 a) -definition abstr_of_ge {p : ℕ × ℕ} (H : pr1 p ≥ pr2 p) : abstr p = of_nat (pr1 p - pr2 p) := +theorem abstr_of_ge {p : ℕ × ℕ} (H : pr1 p ≥ pr2 p) : abstr p = of_nat (pr1 p - pr2 p) := sub_nat_nat_of_ge H -definition abstr_of_lt {p : ℕ × ℕ} (H : pr1 p < pr2 p) : - abstr p = neg_succ_of_nat (pred (pr2 p - pr1 p)) := +theorem abstr_of_lt {p : ℕ × ℕ} (H : pr1 p < pr2 p) : + abstr p = -[1+ pred (pr2 p - pr1 p)] := sub_nat_nat_of_lt H -definition repr (a : ℤ) : ℕ × ℕ := int.cases_on a (take m, (m, 0)) (take m, (0, succ m)) +definition repr : ℤ → ℕ × ℕ +| (of_nat m) := (m, 0) +| -[1+ m] := (0, succ m) -definition abstr_repr (a : ℤ) : abstr (repr a) = a := -int.cases_on a (take m, (sub_nat_nat_of_ge (zero_le m))) (take m, rfl) +theorem abstr_repr : Π (a : ℤ), abstr (repr a) = a +| (of_nat m) := (sub_nat_nat_of_ge (zero_le m)) +| -[1+ m] := rfl -definition repr_sub_nat_nat (m n : ℕ) : repr (sub_nat_nat m n) ≡ (m, n) := -sum.rec_on (@le_or_gt n m) +theorem repr_sub_nat_nat (m n : ℕ) : repr (sub_nat_nat m n) ≡ (m, n) := +nat.lt_ge_by_cases + (take H : m < n, + have H1 : repr (sub_nat_nat m n) = (0, n - m), by + rewrite [sub_nat_nat_of_lt H, -(succ_pred_of_pos (nat.sub_pos_of_lt H))], + H1⁻¹ ▸ (!zero_add ⬝ (nat.sub_add_cancel (le_of_lt H))⁻¹)) (take H : m ≥ n, have H1 : repr (sub_nat_nat m n) = (m - n, 0), from sub_nat_nat_of_ge H ▸ rfl, - H1⁻¹ ▸ - (calc - m - n + n = m : sub_add_cancel H - ... = 0 + m : zero_add)) - (take H : m < n, - have H1 : repr (sub_nat_nat m n) = (0, succ (pred (n - m))), from sub_nat_nat_of_lt H ▸ rfl, - H1⁻¹ ▸ - (calc - 0 + n = n : zero_add - ... = n - m + m : sub_add_cancel (le_of_lt H) - ... = succ (pred (n - m)) + m : (succ_pred_of_pos (sub_pos_of_lt H))⁻¹ᵖ)) + H1⁻¹ ▸ ((nat.sub_add_cancel H) ⬝ !zero_add⁻¹)) -definition repr_abstr (p : ℕ × ℕ) : repr (abstr p) ≡ p := +theorem repr_abstr (p : ℕ × ℕ) : repr (abstr p) ≡ p := !prod.eta ▸ !repr_sub_nat_nat -definition abstr_eq {p q : ℕ × ℕ} (Hint_equiv : p ≡ q) : abstr p = abstr q := -sum.rec_on (int_equiv_cases Hint_equiv) - (assume H2, - have H3 : pr1 p ≥ pr2 p, from prod.pr1 H2, - have H4 : pr1 q ≥ pr2 q, from prod.pr2 H2, - have H5 : pr1 p = pr1 q - pr2 q + pr2 p, from - calc - pr1 p = pr1 p + pr2 q - pr2 q : add_sub_cancel - ... = pr2 p + pr1 q - pr2 q : by rewrite [↑int_equiv at Hint_equiv,Hint_equiv] - ... = pr2 p + (pr1 q - pr2 q) : add_sub_assoc H4 - ... = pr1 q - pr2 q + pr2 p : add.comm, - have H6 : pr1 p - pr2 p = pr1 q - pr2 q, from - calc - pr1 p - pr2 p = pr1 q - pr2 q + pr2 p - pr2 p : H5 - ... = pr1 q - pr2 q : add_sub_cancel, - abstr_of_ge H3 ⬝ ap of_nat H6 ⬝ (abstr_of_ge H4)⁻¹) - (assume H2, - have H3 : pr1 p < pr2 p, from prod.pr1 H2, - have H4 : pr1 q < pr2 q, from prod.pr2 H2, - have H5 : pr2 p = pr2 q - pr1 q + pr1 p, from - calc - pr2 p = pr2 p + pr1 q - pr1 q : add_sub_cancel - ... = pr1 p + pr2 q - pr1 q : by rewrite [↑int_equiv at Hint_equiv,Hint_equiv] - ... = pr1 p + (pr2 q - pr1 q) : add_sub_assoc (le_of_lt H4) - ... = pr2 q - pr1 q + pr1 p : add.comm, - have H6 : pr2 p - pr1 p = pr2 q - pr1 q, from - calc - pr2 p - pr1 p = pr2 q - pr1 q + pr1 p - pr1 p : H5 - ... = pr2 q - pr1 q : add_sub_cancel, - abstr_of_lt H3 ⬝ ap neg_succ_of_nat (ap pred H6)⬝ (abstr_of_lt H4)⁻¹) +theorem abstr_eq {p q : ℕ × ℕ} (Hequiv : p ≡ q) : abstr p = abstr q := +sum.elim (int.equiv_cases Hequiv) + (prod.rec (assume (Hp : pr1 p ≥ pr2 p) (Hq : pr1 q ≥ pr2 q), + have H : pr1 p - pr2 p = pr1 q - pr2 q, from + calc pr1 p - pr2 p + = pr1 p + pr2 q - pr2 q - pr2 p : by rewrite nat.add_sub_cancel + ... = pr2 p + pr1 q - pr2 q - pr2 p : Hequiv + ... = pr2 p + (pr1 q - pr2 q) - pr2 p : nat.add_sub_assoc Hq + ... = pr1 q - pr2 q + pr2 p - pr2 p : by rewrite add.comm + ... = pr1 q - pr2 q : by rewrite nat.add_sub_cancel, + abstr_of_ge Hp ⬝ (H ▸ rfl) ⬝ (abstr_of_ge Hq)⁻¹)) + (prod.rec (assume (Hp : pr1 p < pr2 p) (Hq : pr1 q < pr2 q), + have H : pr2 p - pr1 p = pr2 q - pr1 q, from + calc pr2 p - pr1 p + = pr2 p + pr1 q - pr1 q - pr1 p : by rewrite nat.add_sub_cancel + ... = pr1 p + pr2 q - pr1 q - pr1 p : Hequiv + ... = pr1 p + (pr2 q - pr1 q) - pr1 p : nat.add_sub_assoc (le_of_lt Hq) + ... = pr2 q - pr1 q + pr1 p - pr1 p : by rewrite add.comm + ... = pr2 q - pr1 q : by rewrite nat.add_sub_cancel, + abstr_of_lt Hp ⬝ (H ▸ rfl) ⬝ (abstr_of_lt Hq)⁻¹)) -definition int_equiv_iff (p q : ℕ × ℕ) : (p ≡ q) ↔ ((p ≡ p) × (q ≡ q) × (abstr p = abstr q)) := -iff.intro - (assume H : int_equiv p q, - pair !int_equiv.refl (pair !int_equiv.refl (abstr_eq H))) - (assume H : int_equiv p p × int_equiv q q × abstr p = abstr q, - have H1 : abstr p = abstr q, from prod.pr2 (prod.pr2 H), - int_equiv.trans (H1 ▸ int_equiv.symm (repr_abstr p)) (repr_abstr q)) +theorem equiv_iff (p q : ℕ × ℕ) : (p ≡ q) ↔ (abstr p = abstr q) := +iff.intro abstr_eq (assume H, equiv.trans (H ▸ equiv.symm (repr_abstr p)) (repr_abstr q)) -definition eq_abstr_of_int_equiv_repr {a : ℤ} {p : ℕ × ℕ} (Hint_equiv : repr a ≡ p) : a = abstr p := -calc - a = abstr (repr a) : abstr_repr - ... = abstr p : abstr_eq Hint_equiv +theorem equiv_iff3 (p q : ℕ × ℕ) : (p ≡ q) ↔ ((p ≡ p) × (q ≡ q) × (abstr p = abstr q)) := +iff.trans !equiv_iff (iff.symm + (iff.trans (prod_iff_right !equiv.refl) (prod_iff_right !equiv.refl))) -definition eq_of_repr_int_equiv_repr {a b : ℤ} (H : repr a ≡ repr b) : a = b := -calc - a = abstr (repr a) : abstr_repr - ... = abstr (repr b) : abstr_eq H - ... = b : abstr_repr +theorem eq_abstr_of_equiv_repr {a : ℤ} {p : ℕ × ℕ} (Hequiv : repr a ≡ p) : a = abstr p := +!abstr_repr⁻¹ ⬝ abstr_eq Hequiv + +theorem eq_of_repr_equiv_repr {a b : ℤ} (H : repr a ≡ repr b) : a = b := +eq_abstr_of_equiv_repr H ⬝ !abstr_repr section local attribute abstr [reducible] local attribute dist [reducible] -definition nat_abs_abstr (p : ℕ × ℕ) : nat_abs (abstr p) = dist (pr1 p) (pr2 p) := -let m := pr1 p, n := pr2 p in -sum.rec_on (@le_or_gt n m) - (assume H : m ≥ n, - calc - nat_abs (abstr (m, n)) = nat_abs (of_nat (m - n)) : int.abstr_of_ge H - ... = dist m n : dist_eq_sub_of_ge H) +theorem nat_abs_abstr : Π (p : ℕ × ℕ), nat_abs (abstr p) = dist (pr1 p) (pr2 p) +| (m, n) := nat.lt_ge_by_cases (assume H : m < n, calc - nat_abs (abstr (m, n)) = nat_abs (neg_succ_of_nat (pred (n - m))) : int.abstr_of_lt H - ... = succ (pred (n - m)) : rfl - ... = n - m : succ_pred_of_pos (sub_pos_of_lt H) + nat_abs (abstr (m, n)) = nat_abs (-[1+ pred (n - m)]) : int.abstr_of_lt H + ... = n - m : succ_pred_of_pos (nat.sub_pos_of_lt H) ... = dist m n : dist_eq_sub_of_le (le_of_lt H)) + (assume H : m ≥ n, (abstr_of_ge H)⁻¹ ▸ (dist_eq_sub_of_ge H)⁻¹) end -definition cases_of_nat (a : ℤ) : (Σn : ℕ, a = of_nat n) ⊎ (Σn : ℕ, a = - of_nat n) := -int.cases_on a - (take n, sum.inl (sigma.mk n rfl)) - (take n', sum.inr (sigma.mk (succ n') rfl)) - -definition cases_of_nat_succ (a : ℤ) : (Σn : ℕ, a = of_nat n) ⊎ (Σn : ℕ, a = - (of_nat (succ n))) := +theorem cases_of_nat_succ (a : ℤ) : (Σn : ℕ, a = of_nat n) ⊎ (Σn : ℕ, a = - (of_nat (succ n))) := int.cases_on a (take m, sum.inl (sigma.mk _ rfl)) (take m, sum.inr (sigma.mk _ rfl)) -definition by_cases_of_nat {P : ℤ → Type} (a : ℤ) +theorem cases_of_nat (a : ℤ) : (Σn : ℕ, a = of_nat n) ⊎ (Σn : ℕ, a = - of_nat n) := +sum.imp_right (sigma.rec (take n, (sigma.mk _))) !cases_of_nat_succ + +theorem by_cases_of_nat {P : ℤ → Type} (a : ℤ) (H1 : Πn : ℕ, P (of_nat n)) (H2 : Πn : ℕ, P (- of_nat n)) : P a := -sum.rec_on (cases_of_nat a) +sum.elim (cases_of_nat a) (assume H, obtain (n : ℕ) (H3 : a = n), from H, H3⁻¹ ▸ H1 n) (assume H, obtain (n : ℕ) (H3 : a = -n), from H, H3⁻¹ ▸ H2 n) -definition by_cases_of_nat_succ {P : ℤ → Type} (a : ℤ) +theorem by_cases_of_nat_succ {P : ℤ → Type} (a : ℤ) (H1 : Πn : ℕ, P (of_nat n)) (H2 : Πn : ℕ, P (- of_nat (succ n))) : P a := -sum.rec_on (cases_of_nat_succ a) +sum.elim (cases_of_nat_succ a) (assume H, obtain (n : ℕ) (H3 : a = n), from H, H3⁻¹ ▸ H1 n) (assume H, obtain (n : ℕ) (H3 : a = -(succ n)), from H, H3⁻¹ ▸ H2 n) @@ -316,92 +306,71 @@ sum.rec_on (cases_of_nat_succ a) definition padd (p q : ℕ × ℕ) : ℕ × ℕ := (pr1 p + pr1 q, pr2 p + pr2 q) -definition repr_add (a b : ℤ) : repr (add a b) ≡ padd (repr a) (repr b) := -int.cases_on a - (take m, - int.cases_on b - (take n, !int_equiv.refl) - (take n', - have H1 : int_equiv (repr (add (of_nat m) (neg_succ_of_nat n'))) (m, succ n'), - from !repr_sub_nat_nat, - have H2 : padd (repr (of_nat m)) (repr (neg_succ_of_nat n')) = (m, 0 + succ n'), - from rfl, - (!zero_add ▸ H2)⁻¹ ▸ H1)) - (take m', - int.cases_on b - (take n, - have H1 : int_equiv (repr (add (neg_succ_of_nat m') (of_nat n))) (n, succ m'), - from !repr_sub_nat_nat, - have H2 : padd (repr (neg_succ_of_nat m')) (repr (of_nat n)) = (0 + n, succ m'), - from rfl, - (!zero_add ▸ H2)⁻¹ ▸ H1) - (take n',!repr_sub_nat_nat)) +theorem repr_add : Π (a b : ℤ), repr (add a b) ≡ padd (repr a) (repr b) +| (of_nat m) (of_nat n) := !equiv.refl +| (of_nat m) -[1+ n] := + begin + change repr (sub_nat_nat m (succ n)) ≡ (m + 0, 0 + succ n), + rewrite [zero_add, add_zero], + apply repr_sub_nat_nat + end +| -[1+ m] (of_nat n) := + begin + change repr (-[1+ m] + n) ≡ (0 + n, succ m + 0), + rewrite [zero_add, add_zero], + apply repr_sub_nat_nat + end +| -[1+ m] -[1+ n] := !repr_sub_nat_nat -definition padd_congr {p p' q q' : ℕ × ℕ} (Ha : p ≡ p') (Hb : q ≡ q') : padd p q ≡ padd p' q' := +theorem padd_congr {p p' q q' : ℕ × ℕ} (Ha : p ≡ p') (Hb : q ≡ q') : padd p q ≡ padd p' q' := calc pr1 p + pr1 q + (pr2 p' + pr2 q') = pr1 p + pr2 p' + (pr1 q + pr2 q') : add.comm4 ... = pr2 p + pr1 p' + (pr1 q + pr2 q') : {Ha} ... = pr2 p + pr1 p' + (pr2 q + pr1 q') : {Hb} ... = pr2 p + pr2 q + (pr1 p' + pr1 q') : add.comm4 -definition padd_comm (p q : ℕ × ℕ) : padd p q = padd q p := -calc - padd p q = (pr1 p + pr1 q, pr2 p + pr2 q) : rfl - ... = (pr1 q + pr1 p, pr2 p + pr2 q) : add.comm - ... = (pr1 q + pr1 p, pr2 q + pr2 p) : add.comm - ... = padd q p : rfl +theorem padd_comm (p q : ℕ × ℕ) : padd p q = padd q p := +calc (pr1 p + pr1 q, pr2 p + pr2 q) + = (pr1 q + pr1 p, pr2 p + pr2 q) : by rewrite add.comm + ... = (pr1 q + pr1 p, pr2 q + pr2 p) : by rewrite (add.comm (pr2 p) (pr2 q)) -definition padd_assoc (p q r : ℕ × ℕ) : padd (padd p q) r = padd p (padd q r) := -calc - padd (padd p q) r = (pr1 p + pr1 q + pr1 r, pr2 p + pr2 q + pr2 r) : rfl - ... = (pr1 p + (pr1 q + pr1 r), pr2 p + pr2 q + pr2 r) : add.assoc - ... = (pr1 p + (pr1 q + pr1 r), pr2 p + (pr2 q + pr2 r)) : add.assoc - ... = padd p (padd q r) : rfl +theorem padd_assoc (p q r : ℕ × ℕ) : padd (padd p q) r = padd p (padd q r) := +calc (pr1 p + pr1 q + pr1 r, pr2 p + pr2 q + pr2 r) + = (pr1 p + (pr1 q + pr1 r), pr2 p + pr2 q + pr2 r) : by rewrite add.assoc + ... = (pr1 p + (pr1 q + pr1 r), pr2 p + (pr2 q + pr2 r)) : by rewrite add.assoc -definition add.comm (a b : ℤ) : a + b = b + a := -begin - apply eq_of_repr_int_equiv_repr, - apply int_equiv.trans, - apply repr_add, - apply int_equiv.symm, - apply eq.subst (padd_comm (repr b) (repr a)), - apply repr_add -end +protected theorem add_comm (a b : ℤ) : a + b = b + a := +eq_of_repr_equiv_repr (equiv.trans !repr_add + (equiv.symm (!padd_comm ▸ !repr_add))) -definition add.assoc (a b c : ℤ) : a + b + c = a + (b + c) := -assert H1 : repr (a + b + c) ≡ padd (padd (repr a) (repr b)) (repr c), from - int_equiv.trans (repr_add (a + b) c) (padd_congr !repr_add !int_equiv.refl), -assert H2 : repr (a + (b + c)) ≡ padd (repr a) (padd (repr b) (repr c)), from - int_equiv.trans (repr_add a (b + c)) (padd_congr !int_equiv.refl !repr_add), -begin - apply eq_of_repr_int_equiv_repr, - apply int_equiv.trans, - apply H1, - apply eq.subst (padd_assoc _ _ _)⁻¹, - apply int_equiv.symm, - apply H2 -end +protected theorem add_assoc (a b c : ℤ) : a + b + c = a + (b + c) := +eq_of_repr_equiv_repr (calc + repr (a + b + c) + ≡ padd (repr (a + b)) (repr c) : repr_add + ... ≡ padd (padd (repr a) (repr b)) (repr c) : padd_congr !repr_add !equiv.refl + ... = padd (repr a) (padd (repr b) (repr c)) : !padd_assoc + ... ≡ padd (repr a) (repr (b + c)) : padd_congr !equiv.refl !repr_add + ... ≡ repr (a + (b + c)) : repr_add) -definition add_zero (a : ℤ) : a + 0 = a := int.cases_on a (take m, rfl) (take m', rfl) +protected theorem add_zero : Π (a : ℤ), a + 0 = a := int.rec (λm, rfl) (λm, rfl) -definition zero_add (a : ℤ) : 0 + a = a := add.comm a 0 ▸ add_zero a +protected theorem zero_add (a : ℤ) : 0 + a = a := !int.add_comm ▸ !int.add_zero /- negation -/ definition pneg (p : ℕ × ℕ) : ℕ × ℕ := (pr2 p, pr1 p) -- note: this is =, not just ≡ -definition repr_neg (a : ℤ) : repr (- a) = pneg (repr a) := -int.cases_on a - (take m, - nat.cases_on m rfl (take m', rfl)) - (take m', rfl) +theorem repr_neg : Π (a : ℤ), repr (- a) = pneg (repr a) +| 0 := rfl +| (succ m) := rfl +| -[1+ m] := rfl -definition pneg_congr {p p' : ℕ × ℕ} (H : p ≡ p') : pneg p ≡ pneg p' := inverse H +theorem pneg_congr {p p' : ℕ × ℕ} (H : p ≡ p') : pneg p ≡ pneg p' := inverse H -definition pneg_pneg (p : ℕ × ℕ) : pneg (pneg p) = p := !prod.eta +theorem pneg_pneg (p : ℕ × ℕ) : pneg (pneg p) = p := !prod.eta -definition nat_abs_neg (a : ℤ) : nat_abs (-a) = nat_abs a := +theorem nat_abs_neg (a : ℤ) : nat_abs (-a) = nat_abs a := calc nat_abs (-a) = nat_abs (abstr (repr (-a))) : abstr_repr ... = nat_abs (abstr (pneg (repr a))) : repr_neg @@ -410,64 +379,59 @@ calc ... = nat_abs (abstr (repr a)) : nat_abs_abstr ... = nat_abs a : abstr_repr -definition padd_pneg (p : ℕ × ℕ) : padd p (pneg p) ≡ (0, 0) := -show pr1 p + pr2 p + 0 = pr2 p + pr1 p + 0, from !nat.add.comm ▸ rfl +theorem padd_pneg (p : ℕ × ℕ) : padd p (pneg p) ≡ (0, 0) := +show pr1 p + pr2 p + 0 = pr2 p + pr1 p + 0, from !nat.add_comm ▸ rfl -definition padd_padd_pneg (p q : ℕ × ℕ) : padd (padd p q) (pneg q) ≡ p := +theorem padd_padd_pneg (p q : ℕ × ℕ) : padd (padd p q) (pneg q) ≡ p := calc pr1 p + pr1 q + pr2 q + pr2 p - = pr1 p + (pr1 q + pr2 q) + pr2 p : nat.add.assoc - ... = pr1 p + (pr1 q + pr2 q + pr2 p) : nat.add.assoc - ... = pr1 p + (pr2 q + pr1 q + pr2 p) : nat.add.comm + = pr1 p + (pr1 q + pr2 q) + pr2 p : add.assoc + ... = pr1 p + (pr1 q + pr2 q + pr2 p) : add.assoc + ... = pr1 p + (pr2 q + pr1 q + pr2 p) : add.comm ... = pr1 p + (pr2 q + pr2 p + pr1 q) : add.right_comm - ... = pr1 p + (pr2 p + pr2 q + pr1 q) : nat.add.comm - ... = pr2 p + pr2 q + pr1 q + pr1 p : nat.add.comm + ... = pr1 p + (pr2 p + pr2 q + pr1 q) : add.comm + ... = pr2 p + pr2 q + pr1 q + pr1 p : add.comm -definition add.left_inv (a : ℤ) : -a + a = 0 := +protected theorem add_left_inv (a : ℤ) : -a + a = 0 := have H : repr (-a + a) ≡ repr 0, from calc repr (-a + a) ≡ padd (repr (neg a)) (repr a) : repr_add ... = padd (pneg (repr a)) (repr a) : repr_neg ... ≡ repr 0 : padd_pneg, -eq_of_repr_int_equiv_repr H +eq_of_repr_equiv_repr H /- nat abs -/ definition pabs (p : ℕ × ℕ) : ℕ := dist (pr1 p) (pr2 p) -definition pabs_congr {p q : ℕ × ℕ} (H : p ≡ q) : pabs p = pabs q := +theorem pabs_congr {p q : ℕ × ℕ} (H : p ≡ q) : pabs p = pabs q := calc pabs p = nat_abs (abstr p) : nat_abs_abstr ... = nat_abs (abstr q) : abstr_eq H ... = pabs q : nat_abs_abstr -definition nat_abs_eq_pabs_repr (a : ℤ) : nat_abs a = pabs (repr a) := +theorem nat_abs_eq_pabs_repr (a : ℤ) : nat_abs a = pabs (repr a) := calc nat_abs a = nat_abs (abstr (repr a)) : abstr_repr ... = pabs (repr a) : nat_abs_abstr -definition nat_abs_add_le (a b : ℤ) : nat_abs (a + b) ≤ nat_abs a + nat_abs b := -have H : nat_abs (a + b) = pabs (padd (repr a) (repr b)), from - calc - nat_abs (a + b) = pabs (repr (a + b)) : nat_abs_eq_pabs_repr - ... = pabs (padd (repr a) (repr b)) : pabs_congr !repr_add, -have H1 : nat_abs a = pabs (repr a), from !nat_abs_eq_pabs_repr, -have H2 : nat_abs b = pabs (repr b), from !nat_abs_eq_pabs_repr, -have H3 : pabs (padd (repr a) (repr b)) ≤ pabs (repr a) + pabs (repr b), - from !dist_add_add_le_add_dist_dist, -H⁻¹ ▸ H1⁻¹ ▸ H2⁻¹ ▸ H3 +theorem nat_abs_add_le (a b : ℤ) : nat_abs (a + b) ≤ nat_abs a + nat_abs b := +calc + nat_abs (a + b) = pabs (repr (a + b)) : nat_abs_eq_pabs_repr + ... = pabs (padd (repr a) (repr b)) : pabs_congr !repr_add + ... ≤ pabs (repr a) + pabs (repr b) : dist_add_add_le_add_dist_dist + ... = pabs (repr a) + nat_abs b : nat_abs_eq_pabs_repr + ... = nat_abs a + nat_abs b : nat_abs_eq_pabs_repr + +theorem nat_abs_neg_of_nat (n : nat) : nat_abs (neg_of_nat n) = n := +begin cases n, reflexivity, reflexivity end section local attribute nat_abs [reducible] -definition mul_nat_abs (a b : ℤ) : nat_abs (a * b) = #nat (nat_abs a) * (nat_abs b) := -int.cases_on a - (take m, - int.cases_on b - (take n, rfl) - (take n', !nat_abs_neg ▸ rfl)) - (take m', - int.cases_on b - (take n, !nat_abs_neg ▸ rfl) - (take n', rfl)) +theorem nat_abs_mul : Π (a b : ℤ), nat_abs (a * b) = (nat_abs a) * (nat_abs b) +| (of_nat m) (of_nat n) := rfl +| (of_nat m) -[1+ n] := by rewrite [mul_of_nat_neg_succ_of_nat, nat_abs_neg_of_nat] +| -[1+ m] (of_nat n) := by rewrite [mul_neg_succ_of_nat_of_nat, nat_abs_neg_of_nat] +| -[1+ m] -[1+ n] := rfl end /- multiplication -/ @@ -475,365 +439,189 @@ end definition pmul (p q : ℕ × ℕ) : ℕ × ℕ := (pr1 p * pr1 q + pr2 p * pr2 q, pr1 p * pr2 q + pr2 p * pr1 q) -definition repr_neg_of_nat (m : ℕ) : repr (neg_of_nat m) = (0, m) := +theorem repr_neg_of_nat (m : ℕ) : repr (neg_of_nat m) = (0, m) := nat.cases_on m rfl (take m', rfl) -- note: we have =, not just ≡ -definition repr_mul (a b : ℤ) : repr (mul a b) = pmul (repr a) (repr b) := -int.cases_on a - (take m, - int.cases_on b - (take n, - (calc - pmul (repr m) (repr n) = (m * n + 0 * 0, m * 0 + 0 * n) : rfl - ... = (m * n + 0 * 0, m * 0 + 0) : zero_mul)⁻¹) - (take n', - (calc - pmul (repr m) (repr (neg_succ_of_nat n')) = - (m * 0 + 0 * succ n', m * succ n' + 0 * 0) : rfl - ... = (m * 0 + 0, m * succ n' + 0 * 0) : zero_mul - ... = repr (mul m (neg_succ_of_nat n')) : repr_neg_of_nat)⁻¹)) - (take m', - int.cases_on b - (take n, - (calc - pmul (repr (neg_succ_of_nat m')) (repr n) = - (0 * n + succ m' * 0, 0 * 0 + succ m' * n) : rfl - ... = (0 + succ m' * 0, 0 * 0 + succ m' * n) : zero_mul - ... = (0 + succ m' * 0, succ m' * n) : {!nat.zero_add} - ... = repr (mul (neg_succ_of_nat m') n) : repr_neg_of_nat)⁻¹) - (take n', - (calc - pmul (repr (neg_succ_of_nat m')) (repr (neg_succ_of_nat n')) = - (0 + succ m' * succ n', 0 * succ n') : rfl - ... = (succ m' * succ n', 0 * succ n') : nat.zero_add - ... = (succ m' * succ n', 0) : zero_mul - ... = repr (mul (neg_succ_of_nat m') (neg_succ_of_nat n')) : rfl)⁻¹)) +theorem repr_mul : Π (a b : ℤ), repr (a * b) = pmul (repr a) (repr b) +| (of_nat m) (of_nat n) := calc + (m * n + 0 * 0, m * 0 + 0) = (m * n + 0 * 0, m * 0 + 0 * n) : by rewrite *zero_mul +| (of_nat m) -[1+ n] := calc + repr ((m : int) * -[1+ n]) = (m * 0 + 0, m * succ n + 0 * 0) : repr_neg_of_nat + ... = (m * 0 + 0 * succ n, m * succ n + 0 * 0) : by rewrite *zero_mul +| -[1+ m] (of_nat n) := calc + repr (-[1+ m] * (n:int)) = (0 + succ m * 0, succ m * n) : repr_neg_of_nat + ... = (0 + succ m * 0, 0 + succ m * n) : nat.zero_add + ... = (0 * n + succ m * 0, 0 + succ m * n) : by rewrite zero_mul +| -[1+ m] -[1+ n] := calc + (succ m * succ n, 0) = (succ m * succ n, 0 * succ n) : by rewrite zero_mul + ... = (0 + succ m * succ n, 0 * succ n) : nat.zero_add -definition int_equiv_mul_prep {xa ya xb yb xn yn xm ym : ℕ} +theorem equiv_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) := -nat.add.cancel_right (calc +: xa*xn+ya*yn+(xb*ym+yb*xm) = xa*yn+ya*xn+(xb*xm+yb*ym) := +nat.add_right_cancel (calc xa*xn+ya*yn + (xb*ym+yb*xm) + (yb*xn+xb*yn + (xb*xn+yb*yn)) - = xa*xn+ya*yn + (yb*xn+xb*yn) + (xb*ym+yb*xm + (xb*xn+yb*yn)) : add.comm4 - ... = xa*xn+ya*yn + (yb*xn+xb*yn) + (xb*xn+yb*yn + (xb*ym+yb*xm)) : nat.add.comm - ... = xa*xn+yb*xn + (ya*yn+xb*yn) + (xb*xn+xb*ym + (yb*yn+yb*xm)) : !congr_arg2 add.comm4 add.comm4 - ... = ya*xn+xb*xn + (xa*yn+yb*yn) + (xb*yn+xb*xm + (yb*xn+yb*ym)) - : by rewrite[-+mul.left_distrib,-+mul.right_distrib]; exact H1 ▸ H2 ▸ rfl - ... = ya*xn+xa*yn + (xb*xn+yb*yn) + (xb*yn+yb*xn + (xb*xm+yb*ym)) : !congr_arg2 add.comm4 add.comm4 - ... = xa*yn+ya*xn + (xb*xn+yb*yn) + (yb*xn+xb*yn + (xb*xm+yb*ym)) : !nat.add.comm ▸ !nat.add.comm ▸ rfl - ... = xa*yn+ya*xn + (yb*xn+xb*yn) + (xb*xn+yb*yn + (xb*xm+yb*ym)) : add.comm4 - ... = xa*yn+ya*xn + (yb*xn+xb*yn) + (xb*xm+yb*ym + (xb*xn+yb*yn)) : nat.add.comm - ... = xa*yn+ya*xn + (xb*xm+yb*ym) + (yb*xn+xb*yn + (xb*xn+yb*yn)) : add.comm4) + = xa*xn+ya*yn + (yb*xn+xb*yn) + (xb*ym+yb*xm + (xb*xn+yb*yn)) : by rewrite add.comm4 + ... = xa*xn+ya*yn + (yb*xn+xb*yn) + (xb*xn+yb*yn + (xb*ym+yb*xm)) : by rewrite {xb*ym+yb*xm +_}nat.add_comm + ... = xa*xn+yb*xn + (ya*yn+xb*yn) + (xb*xn+xb*ym + (yb*yn+yb*xm)) : by exact !congr_arg2 !add.comm4 !add.comm4 + ... = ya*xn+xb*xn + (xa*yn+yb*yn) + (xb*yn+xb*xm + (yb*xn+yb*ym)) : by rewrite[-+left_distrib,-+right_distrib]; exact H1 ▸ H2 ▸ rfl + ... = ya*xn+xa*yn + (xb*xn+yb*yn) + (xb*yn+yb*xn + (xb*xm+yb*ym)) : by exact !congr_arg2 !add.comm4 !add.comm4 + ... = xa*yn+ya*xn + (xb*xn+yb*yn) + (xb*yn+yb*xn + (xb*xm+yb*ym)) : by rewrite {xa*yn + _}nat.add_comm + ... = xa*yn+ya*xn + (xb*xn+yb*yn) + (yb*xn+xb*yn + (xb*xm+yb*ym)) : by rewrite {xb*yn + _}nat.add_comm + ... = xa*yn+ya*xn + (yb*xn+xb*yn) + (xb*xn+yb*yn + (xb*xm+yb*ym)) : by rewrite (!add.comm4) + ... = xa*yn+ya*xn + (yb*xn+xb*yn) + (xb*xm+yb*ym + (xb*xn+yb*yn)) : by rewrite {xb*xn+yb*yn + _}nat.add_comm + ... = xa*yn+ya*xn + (xb*xm+yb*ym) + (yb*xn+xb*yn + (xb*xn+yb*yn)) : by rewrite add.comm4) -definition pmul_congr {p p' q q' : ℕ × ℕ} (H1 : p ≡ p') (H2 : q ≡ q') : pmul p q ≡ pmul p' q' := -int_equiv_mul_prep H1 H2 +theorem pmul_congr {p p' q q' : ℕ × ℕ} : p ≡ p' → q ≡ q' → pmul p q ≡ pmul p' q' := equiv_mul_prep -definition pmul_comm (p q : ℕ × ℕ) : pmul p q = pmul q p := -calc - (pr1 p * pr1 q + pr2 p * pr2 q, pr1 p * pr2 q + pr2 p * pr1 q) = - (pr1 q * pr1 p + pr2 p * pr2 q, pr1 p * pr2 q + pr2 p * pr1 q) : mul.comm - ... = (pr1 q * pr1 p + pr2 q * pr2 p, pr1 p * pr2 q + pr2 p * pr1 q) : mul.comm - ... = (pr1 q * pr1 p + pr2 q * pr2 p, pr2 q * pr1 p + pr2 p * pr1 q) : mul.comm - ... = (pr1 q * pr1 p + pr2 q * pr2 p, pr2 q * pr1 p + pr1 q * pr2 p) : mul.comm - ... = (pr1 q * pr1 p + pr2 q * pr2 p, pr1 q * pr2 p + pr2 q * pr1 p) : nat.add.comm +theorem pmul_comm (p q : ℕ × ℕ) : pmul p q = pmul q p := +show (_,_) = (_,_), +begin + congruence, + { congruence, repeat rewrite mul.comm }, + { rewrite add.comm, congruence, repeat rewrite mul.comm } +end -definition mul.comm (a b : ℤ) : a * b = b * a := -eq_of_repr_int_equiv_repr +protected theorem mul_comm (a b : ℤ) : a * b = b * a := +eq_of_repr_equiv_repr ((calc repr (a * b) = pmul (repr a) (repr b) : repr_mul ... = pmul (repr b) (repr a) : pmul_comm - ... = repr (b * a) : repr_mul) ▸ !int_equiv.refl) + ... = repr (b * a) : repr_mul) ▸ !equiv.refl) private theorem pmul_assoc_prep {p1 p2 q1 q2 r1 r2 : ℕ} : ((p1*q1+p2*q2)*r1+(p1*q2+p2*q1)*r2, (p1*q1+p2*q2)*r2+(p1*q2+p2*q1)*r1) = (p1*(q1*r1+q2*r2)+p2*(q1*r2+q2*r1), p1*(q1*r2+q2*r1)+p2*(q1*r1+q2*r2)) := begin - rewrite[+mul.left_distrib,+mul.right_distrib,*mul.assoc], - rewrite (@add.comm4 (p1 * (q1 * r1)) (p2 * (q2 * r1)) (p1 * (q2 * r2)) (p2 * (q1 * r2))), - rewrite (nat.add.comm (p2 * (q2 * r1)) (p2 * (q1 * r2))), - rewrite (@add.comm4 (p1 * (q1 * r2)) (p2 * (q2 * r2)) (p1 * (q2 * r1)) (p2 * (q1 * r1))), - rewrite (nat.add.comm (p2 * (q2 * r2)) (p2 * (q1 * r1))) + rewrite [+left_distrib, +right_distrib, *mul.assoc], + rewrite (add.comm4 (p1 * (q1 * r1)) (p2 * (q2 * r1)) (p1 * (q2 * r2)) (p2 * (q1 * r2))), + rewrite (add.comm (p2 * (q2 * r1)) (p2 * (q1 * r2))), + rewrite (add.comm4 (p1 * (q1 * r2)) (p2 * (q2 * r2)) (p1 * (q2 * r1)) (p2 * (q1 * r1))), + rewrite (add.comm (p2 * (q2 * r2)) (p2 * (q1 * r1))) end -definition pmul_assoc (p q r: ℕ × ℕ) : pmul (pmul p q) r = pmul p (pmul q r) := -pmul_assoc_prep +theorem pmul_assoc (p q r: ℕ × ℕ) : pmul (pmul p q) r = pmul p (pmul q r) := pmul_assoc_prep -definition mul.assoc (a b c : ℤ) : (a * b) * c = a * (b * c) := -eq_of_repr_int_equiv_repr +protected theorem mul_assoc (a b c : ℤ) : (a * b) * c = a * (b * c) := +eq_of_repr_equiv_repr ((calc repr (a * b * c) = pmul (repr (a * b)) (repr c) : repr_mul ... = pmul (pmul (repr a) (repr b)) (repr c) : repr_mul ... = pmul (repr a) (pmul (repr b) (repr c)) : pmul_assoc ... = pmul (repr a) (repr (b * c)) : repr_mul - ... = repr (a * (b * c)) : repr_mul) ▸ !int_equiv.refl) + ... = repr (a * (b * c)) : repr_mul) ▸ !equiv.refl) -set_option pp.coercions true +protected theorem mul_one : Π (a : ℤ), a * 1 = a +| (of_nat m) := !int.zero_add -- zero_add happens to be def. = to this thm +| -[1+ m] := !nat.zero_add ▸ rfl -definition mul_one (a : ℤ) : a * 1 = a := -eq_of_repr_int_equiv_repr (int_equiv_of_eq - ((calc - repr (a * 1) = pmul (repr a) (repr 1) : repr_mul - ... = (pr1 (repr a), pr2 (repr a)) : by unfold [pmul, repr]; krewrite [*mul_zero, *mul_one, *nat.add_zero, *nat.zero_add] - ... = repr a : prod.eta))) - -definition one_mul (a : ℤ) : 1 * a = a := -mul.comm a 1 ▸ mul_one a +protected theorem one_mul (a : ℤ) : 1 * a = a := +int.mul_comm a 1 ▸ int.mul_one a private theorem mul_distrib_prep {a1 a2 b1 b2 c1 c2 : ℕ} : - ((a1+b1)*c1+(a2+b2)*c2, (a1+b1)*c2+(a2+b2)*c1) = + ((a1+b1)*c1+(a2+b2)*c2, (a1+b1)*c2+(a2+b2)*c1) = (a1*c1+a2*c2+(b1*c1+b2*c2), a1*c2+a2*c1+(b1*c2+b2*c1)) := -by rewrite[+mul.right_distrib] ⬝ (!congr_arg2 !add.comm4 !add.comm4) - -definition mul.right_distrib (a b c : ℤ) : (a + b) * c = a * c + b * c := -eq_of_repr_int_equiv_repr - (calc - repr ((a + b) * c) = pmul (repr (a + b)) (repr c) : repr_mul - ... ≡ pmul (padd (repr a) (repr b)) (repr c) : pmul_congr !repr_add int_equiv.refl - ... = padd (pmul (repr a) (repr c)) (pmul (repr b) (repr c)) : mul_distrib_prep - ... = padd (repr (a * c)) (pmul (repr b) (repr c)) : {(repr_mul a c)⁻¹} - ... = padd (repr (a * c)) (repr (b * c)) : repr_mul - ... ≡ repr (a * c + b * c) : int_equiv.symm !repr_add) - -definition mul.left_distrib (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.right_distrib b c a - ... = a * b + c * a : {mul.comm b a} - ... = a * b + a * c : {mul.comm c a} - -definition zero_ne_one : (0 : int) ≠ 1 := -assume H : 0 = 1, -show empty, from succ_ne_zero 0 ((of_nat.inj H)⁻¹) - -definition eq_zero_or_eq_zero_of_mul_eq_zero {a b : ℤ} (H : a * b = 0) : a = 0 ⊎ b = 0 := -have H2 : (nat_abs a) * (nat_abs b) = nat.zero, from - calc - (nat_abs a) * (nat_abs b) = (nat_abs (a * b)) : (mul_nat_abs a b)⁻¹ - ... = (nat_abs 0) : {H} - ... = nat.zero : nat_abs_of_nat nat.zero, -have H3 : (nat_abs a) = nat.zero ⊎ (nat_abs b) = nat.zero, - from eq_zero_or_eq_zero_of_mul_eq_zero H2, -sum_of_sum_of_imp_of_imp H3 - (assume H : (nat_abs a) = nat.zero, nat_abs_eq_zero H) - (assume H : (nat_abs b) = nat.zero, nat_abs_eq_zero H) - -section - open [classes] algebra - - protected definition integral_domain [instance] [reducible] : algebra.integral_domain int := - ⦃algebra.integral_domain, - add := add, - add_assoc := add.assoc, - zero := zero, - zero_add := zero_add, - add_zero := add_zero, - neg := neg, - add_left_inv := add.left_inv, - add_comm := add.comm, - mul := mul, - mul_assoc := mul.assoc, - one := (of_num 1), - one_mul := one_mul, - mul_one := mul_one, - left_distrib := mul.left_distrib, - right_distrib := mul.right_distrib, - mul_comm := mul.comm, - eq_zero_or_eq_zero_of_mul_eq_zero := @eq_zero_or_eq_zero_of_mul_eq_zero, - is_hset_carrier := is_hset_of_decidable_eq⦄ +begin + rewrite +right_distrib, congruence, + {rewrite add.comm4}, + {rewrite add.comm4} end -/- instantiate ring theorems to int -/ +protected theorem right_distrib (a b c : ℤ) : (a + b) * c = a * c + b * c := +eq_of_repr_equiv_repr + (calc + repr ((a + b) * c) = pmul (repr (a + b)) (repr c) : repr_mul + ... ≡ pmul (padd (repr a) (repr b)) (repr c) : pmul_congr !repr_add equiv.refl + ... = padd (pmul (repr a) (repr c)) (pmul (repr b) (repr c)) : mul_distrib_prep + ... = padd (repr (a * c)) (pmul (repr b) (repr c)) : repr_mul + ... = padd (repr (a * c)) (repr (b * c)) : repr_mul + ... ≡ repr (a * c + b * c) : repr_add) -section port_algebra - open [classes] algebra - definition mul.left_comm : Πa b c : ℤ, a * (b * c) = b * (a * c) := algebra.mul.left_comm - definition mul.right_comm : Πa b c : ℤ, (a * b) * c = (a * c) * b := algebra.mul.right_comm - definition add.left_comm : Πa b c : ℤ, a + (b + c) = b + (a + c) := algebra.add.left_comm - definition add.right_comm : Πa b c : ℤ, (a + b) + c = (a + c) + b := algebra.add.right_comm - definition add.left_cancel : Π{a b c : ℤ}, a + b = a + c → b = c := @algebra.add.left_cancel _ _ - definition add.right_cancel : Π{a b c : ℤ}, a + b = c + b → a = c := @algebra.add.right_cancel _ _ - definition neg_add_cancel_left : Πa b : ℤ, -a + (a + b) = b := algebra.neg_add_cancel_left - definition neg_add_cancel_right : Πa b : ℤ, a + -b + b = a := algebra.neg_add_cancel_right - definition neg_eq_of_add_eq_zero : Π{a b : ℤ}, a + b = 0 → -a = b := - @algebra.neg_eq_of_add_eq_zero _ _ - definition neg_zero : -0 = 0 := algebra.neg_zero - definition neg_neg : Πa : ℤ, -(-a) = a := algebra.neg_neg - definition neg.inj : Π{a b : ℤ}, -a = -b → a = b := @algebra.neg.inj _ _ - definition neg_eq_neg_iff_eq : Πa b : ℤ, -a = -b ↔ a = b := algebra.neg_eq_neg_iff_eq - definition neg_eq_zero_iff_eq_zero : Πa : ℤ, -a = 0 ↔ a = 0 := algebra.neg_eq_zero_iff_eq_zero - definition eq_neg_of_eq_neg : Π{a b : ℤ}, a = -b → b = -a := @algebra.eq_neg_of_eq_neg _ _ - definition eq_neg_iff_eq_neg : Π{a b : ℤ}, a = -b ↔ b = -a := @algebra.eq_neg_iff_eq_neg _ _ - definition add.right_inv : Πa : ℤ, a + -a = 0 := algebra.add.right_inv - definition add_neg_cancel_left : Πa b : ℤ, a + (-a + b) = b := algebra.add_neg_cancel_left - definition add_neg_cancel_right : Πa b : ℤ, a + b + -b = a := algebra.add_neg_cancel_right - definition neg_add_rev : Πa b : ℤ, -(a + b) = -b + -a := algebra.neg_add_rev - definition eq_add_neg_of_add_eq : Π{a b c : ℤ}, a + c = b → a = b + -c := - @algebra.eq_add_neg_of_add_eq _ _ - definition eq_neg_add_of_add_eq : Π{a b c : ℤ}, b + a = c → a = -b + c := - @algebra.eq_neg_add_of_add_eq _ _ - definition neg_add_eq_of_eq_add : Π{a b c : ℤ}, b = a + c → -a + b = c := - @algebra.neg_add_eq_of_eq_add _ _ - definition add_neg_eq_of_eq_add : Π{a b c : ℤ}, a = c + b → a + -b = c := - @algebra.add_neg_eq_of_eq_add _ _ - definition eq_add_of_add_neg_eq : Π{a b c : ℤ}, a + -c = b → a = b + c := - @algebra.eq_add_of_add_neg_eq _ _ - definition eq_add_of_neg_add_eq : Π{a b c : ℤ}, -b + a = c → a = b + c := - @algebra.eq_add_of_neg_add_eq _ _ - definition add_eq_of_eq_neg_add : Π{a b c : ℤ}, b = -a + c → a + b = c := - @algebra.add_eq_of_eq_neg_add _ _ - definition add_eq_of_eq_add_neg : Π{a b c : ℤ}, a = c + -b → a + b = c := - @algebra.add_eq_of_eq_add_neg _ _ - definition add_eq_iff_eq_neg_add : Πa b c : ℤ, a + b = c ↔ b = -a + c := - @algebra.add_eq_iff_eq_neg_add _ _ - definition add_eq_iff_eq_add_neg : Πa b c : ℤ, a + b = c ↔ a = c + -b := - @algebra.add_eq_iff_eq_add_neg _ _ - definition sub (a b : ℤ) : ℤ := algebra.sub a b - infix - := int.sub - definition sub_eq_add_neg : Πa b : ℤ, a - b = a + -b := algebra.sub_eq_add_neg - definition sub_self : Πa : ℤ, a - a = 0 := algebra.sub_self - definition sub_add_cancel : Πa b : ℤ, a - b + b = a := algebra.sub_add_cancel - definition add_sub_cancel : Πa b : ℤ, a + b - b = a := algebra.add_sub_cancel - definition eq_of_sub_eq_zero : Π{a b : ℤ}, a - b = 0 → a = b := @algebra.eq_of_sub_eq_zero _ _ - definition eq_iff_sub_eq_zero : Πa b : ℤ, a = b ↔ a - b = 0 := algebra.eq_iff_sub_eq_zero - definition zero_sub : Πa : ℤ, 0 - a = -a := algebra.zero_sub - definition sub_zero : Πa : ℤ, a - 0 = a := algebra.sub_zero - definition sub_neg_eq_add : Πa b : ℤ, a - (-b) = a + b := algebra.sub_neg_eq_add - definition neg_sub : Πa b : ℤ, -(a - b) = b - a := algebra.neg_sub - definition add_sub : Πa b c : ℤ, a + (b - c) = a + b - c := algebra.add_sub - definition sub_add_eq_sub_sub_swap : Πa b c : ℤ, a - (b + c) = a - c - b := - algebra.sub_add_eq_sub_sub_swap - definition sub_eq_iff_eq_add : Πa b c : ℤ, a - b = c ↔ a = c + b := algebra.sub_eq_iff_eq_add - definition eq_sub_iff_add_eq : Πa b c : ℤ, a = b - c ↔ a + c = b := algebra.eq_sub_iff_add_eq - definition eq_iff_eq_of_sub_eq_sub : Π{a b c d : ℤ}, a - b = c - d → (a = b ↔ c = d) := - @algebra.eq_iff_eq_of_sub_eq_sub _ _ - definition eq_sub_of_add_eq : Π{a b c : ℤ}, a + c = b → a = b - c := @algebra.eq_sub_of_add_eq _ _ - definition sub_eq_of_eq_add : Π{a b c : ℤ}, a = c + b → a - b = c := @algebra.sub_eq_of_eq_add _ _ - definition eq_add_of_sub_eq : Π{a b c : ℤ}, a - c = b → a = b + c := @algebra.eq_add_of_sub_eq _ _ - definition add_eq_of_eq_sub : Π{a b c : ℤ}, a = c - b → a + b = c := @algebra.add_eq_of_eq_sub _ _ - definition sub_add_eq_sub_sub : Πa b c : ℤ, a - (b + c) = a - b - c := algebra.sub_add_eq_sub_sub - definition neg_add_eq_sub : Πa b : ℤ, -a + b = b - a := algebra.neg_add_eq_sub - definition neg_add : Πa b : ℤ, -(a + b) = -a + -b := algebra.neg_add - definition sub_add_eq_add_sub : Πa b c : ℤ, a - b + c = a + c - b := algebra.sub_add_eq_add_sub - definition sub_sub_ : Πa b c : ℤ, a - b - c = a - (b + c) := algebra.sub_sub - definition add_sub_add_left_eq_sub : Πa b c : ℤ, (c + a) - (c + b) = a - b := - algebra.add_sub_add_left_eq_sub - definition eq_sub_of_add_eq' : Π{a b c : ℤ}, c + a = b → a = b - c := @algebra.eq_sub_of_add_eq' _ _ - definition sub_eq_of_eq_add' : Π{a b c : ℤ}, a = b + c → a - b = c := @algebra.sub_eq_of_eq_add' _ _ - definition eq_add_of_sub_eq' : Π{a b c : ℤ}, a - b = c → a = b + c := @algebra.eq_add_of_sub_eq' _ _ - definition add_eq_of_eq_sub' : Π{a b c : ℤ}, b = c - a → a + b = c := @algebra.add_eq_of_eq_sub' _ _ - definition ne_zero_of_mul_ne_zero_right : Π{a b : ℤ}, a * b ≠ 0 → a ≠ 0 := - @algebra.ne_zero_of_mul_ne_zero_right _ _ - definition ne_zero_of_mul_ne_zero_left : Π{a b : ℤ}, a * b ≠ 0 → b ≠ 0 := - @algebra.ne_zero_of_mul_ne_zero_left _ _ - definition dvd (a b : ℤ) : Type₀ := algebra.dvd a b - notation a ∣ b := dvd a b - definition dvd.intro : Π{a b c : ℤ} (H : a * c = b), a ∣ b := @algebra.dvd.intro _ _ - definition dvd.intro_left : Π{a b c : ℤ} (H : c * a = b), a ∣ b := @algebra.dvd.intro_left _ _ - definition exists_eq_mul_right_of_dvd : Π{a b : ℤ} (H : a ∣ b), Σc, b = a * c := - @algebra.exists_eq_mul_right_of_dvd _ _ - definition dvd.elim : Π{P : Type} {a b : ℤ} (H₁ : a ∣ b) (H₂ : Πc, b = a * c → P), P := - @algebra.dvd.elim _ _ - definition exists_eq_mul_left_of_dvd : Π{a b : ℤ} (H : a ∣ b), Σc, b = c * a := - @algebra.exists_eq_mul_left_of_dvd _ _ - definition dvd.elim_left : Π{P : Type} {a b : ℤ} (H₁ : a ∣ b) (H₂ : Πc, b = c * a → P), P := - @algebra.dvd.elim_left _ _ - definition dvd.refl : Πa : ℤ, (a ∣ a) := algebra.dvd.refl - definition dvd.trans : Π{a b c : ℤ} (H₁ : a ∣ b) (H₂ : b ∣ c), a ∣ c := @algebra.dvd.trans _ _ - definition eq_zero_of_zero_dvd : Π{a : ℤ} (H : 0 ∣ a), a = 0 := @algebra.eq_zero_of_zero_dvd _ _ - definition dvd_zero : Πa : ℤ, a ∣ 0 := algebra.dvd_zero - definition one_dvd : Πa : ℤ, 1 ∣ a := algebra.one_dvd - definition dvd_mul_right : Πa b : ℤ, a ∣ a * b := algebra.dvd_mul_right - definition dvd_mul_left : Πa b : ℤ, a ∣ b * a := algebra.dvd_mul_left - definition dvd_mul_of_dvd_left : Π{a b : ℤ} (H : a ∣ b) (c : ℤ), a ∣ b * c := - @algebra.dvd_mul_of_dvd_left _ _ - definition dvd_mul_of_dvd_right : Π{a b : ℤ} (H : a ∣ b) (c : ℤ), a ∣ c * b := - @algebra.dvd_mul_of_dvd_right _ _ - definition mul_dvd_mul : Π{a b c d : ℤ}, a ∣ b → c ∣ d → a * c ∣ b * d := - @algebra.mul_dvd_mul _ _ - definition dvd_of_mul_right_dvd : Π{a b c : ℤ}, a * b ∣ c → a ∣ c := - @algebra.dvd_of_mul_right_dvd _ _ - definition dvd_of_mul_left_dvd : Π{a b c : ℤ}, a * b ∣ c → b ∣ c := - @algebra.dvd_of_mul_left_dvd _ _ - definition dvd_add : Π{a b c : ℤ}, a ∣ b → a ∣ c → a ∣ b + c := @algebra.dvd_add _ _ - definition zero_mul : Πa : ℤ, 0 * a = 0 := algebra.zero_mul - definition mul_zero : Πa : ℤ, a * 0 = 0 := algebra.mul_zero - definition neg_mul_eq_neg_mul : Πa b : ℤ, -(a * b) = -a * b := algebra.neg_mul_eq_neg_mul - definition neg_mul_eq_mul_neg : Πa b : ℤ, -(a * b) = a * -b := algebra.neg_mul_eq_mul_neg - definition neg_mul_neg : Πa b : ℤ, -a * -b = a * b := algebra.neg_mul_neg - definition neg_mul_comm : Πa b : ℤ, -a * b = a * -b := algebra.neg_mul_comm - definition neg_eq_neg_one_mul : Πa : ℤ, -a = -1 * a := algebra.neg_eq_neg_one_mul - definition mul_sub_left_distrib : Πa b c : ℤ, a * (b - c) = a * b - a * c := - algebra.mul_sub_left_distrib - definition mul_sub_right_distrib : Πa b c : ℤ, (a - b) * c = a * c - b * c := - algebra.mul_sub_right_distrib - definition mul_add_eq_mul_add_iff_sub_mul_add_eq : - Πa b c d e : ℤ, a * e + c = b * e + d ↔ (a - b) * e + c = d := - algebra.mul_add_eq_mul_add_iff_sub_mul_add_eq - definition mul_self_sub_mul_self_eq : Πa b : ℤ, a * a - b * b = (a + b) * (a - b) := - algebra.mul_self_sub_mul_self_eq - definition mul_self_sub_one_eq : Πa : ℤ, a * a - 1 = (a + 1) * (a - 1) := - algebra.mul_self_sub_one_eq - definition dvd_neg_iff_dvd : Πa b : ℤ, a ∣ -b ↔ a ∣ b := algebra.dvd_neg_iff_dvd - definition neg_dvd_iff_dvd : Πa b : ℤ, -a ∣ b ↔ a ∣ b := algebra.neg_dvd_iff_dvd - definition dvd_sub : Πa b c : ℤ, a ∣ b → a ∣ c → a ∣ b - c := algebra.dvd_sub - definition mul_ne_zero : Π{a b : ℤ}, a ≠ 0 → b ≠ 0 → a * b ≠ 0 := @algebra.mul_ne_zero _ _ - definition eq_of_mul_eq_mul_right : Π{a b c : ℤ}, a ≠ 0 → b * a = c * a → b = c := - @algebra.eq_of_mul_eq_mul_right _ _ - definition eq_of_mul_eq_mul_left : Π{a b c : ℤ}, a ≠ 0 → a * b = a * c → b = c := - @algebra.eq_of_mul_eq_mul_left _ _ - definition mul_self_eq_mul_self_iff : Πa b : ℤ, a * a = b * b ↔ a = b ⊎ a = -b := - algebra.mul_self_eq_mul_self_iff - definition mul_self_eq_one_iff : Πa : ℤ, a * a = 1 ↔ a = 1 ⊎ a = -1 := - algebra.mul_self_eq_one_iff - definition dvd_of_mul_dvd_mul_left : Π{a b c : ℤ}, a ≠ 0 → a*b ∣ a*c → b ∣ c := - @algebra.dvd_of_mul_dvd_mul_left _ _ - definition dvd_of_mul_dvd_mul_right : Π{a b c : ℤ}, a ≠ 0 → b*a ∣ c*a → b ∣ c := - @algebra.dvd_of_mul_dvd_mul_right _ _ -end port_algebra +protected theorem left_distrib (a b c : ℤ) : a * (b + c) = a * b + a * c := +calc + a * (b + c) = (b + c) * a : int.mul_comm + ... = b * a + c * a : int.right_distrib + ... = a * b + c * a : int.mul_comm + ... = a * b + a * c : int.mul_comm + +protected theorem zero_ne_one : (0 : int) ≠ 1 := +assume H : 0 = 1, !succ_ne_zero (of_nat.inj H)⁻¹ + +protected theorem eq_zero_sum_eq_zero_of_mul_eq_zero {a b : ℤ} (H : a * b = 0) : a = 0 ⊎ b = 0 := +sum.imp eq_zero_of_nat_abs_eq_zero eq_zero_of_nat_abs_eq_zero + (eq_zero_sum_eq_zero_of_mul_eq_zero (by rewrite [-nat_abs_mul, H])) + +protected definition integral_domain [reducible] [trans_instance] : integral_domain int := +⦃integral_domain, + add := int.add, + add_assoc := int.add_assoc, + zero := 0, + zero_add := int.zero_add, + add_zero := int.add_zero, + neg := int.neg, + add_left_inv := int.add_left_inv, + add_comm := int.add_comm, + mul := int.mul, + mul_assoc := int.mul_assoc, + one := 1, + one_mul := int.one_mul, + mul_one := int.mul_one, + left_distrib := int.left_distrib, + right_distrib := int.right_distrib, + mul_comm := int.mul_comm, + zero_ne_one := int.zero_ne_one, + eq_zero_sum_eq_zero_of_mul_eq_zero := @int.eq_zero_sum_eq_zero_of_mul_eq_zero, + is_hset_carrier := is_hset_of_decidable_eq⦄ + +definition int_has_sub [reducible] [instance] [priority int.prio] : has_sub int := +has_sub.mk has_sub.sub + +definition int_has_dvd [reducible] [instance] [priority int.prio] : has_dvd int := +has_dvd.mk has_dvd.dvd /- additional properties -/ +theorem of_nat_sub {m n : ℕ} (H : m ≥ n) : of_nat (m - n) = of_nat m - of_nat n := +assert m - n + n = m, from nat.sub_add_cancel H, +begin + symmetry, + apply sub_eq_of_eq_add, + rewrite [-of_nat_add, this] +end -definition of_nat_sub_of_nat {m n : ℕ} (H : #nat m ≥ n) : of_nat m - of_nat n = of_nat (#nat m - n) := -have H1 : m = (#nat m - n + n), from (nat.sub_add_cancel H)⁻¹, -have H2 : m = (#nat m - n) + n, from ap of_nat H1, -sub_eq_of_eq_add H2 +theorem neg_succ_of_nat_eq' (m : ℕ) : -[1+ m] = -m - 1 := +by rewrite [neg_succ_of_nat_eq, neg_add] -definition neg_succ_of_nat_eq' (m : ℕ) : -[m +1] = -m - 1 := -by rewrite [neg_succ_of_nat_eq, -of_nat_add_of_nat, neg_add] - -definition succ (a : ℤ) := a + (nat.succ zero) -definition pred (a : ℤ) := a - (nat.succ zero) +definition succ (a : ℤ) := a + (succ zero) +definition pred (a : ℤ) := a - (succ zero) definition nat_succ_eq_int_succ (n : ℕ) : nat.succ n = int.succ n := idp -definition pred_succ (a : ℤ) : pred (succ a) = a := !sub_add_cancel -definition succ_pred (a : ℤ) : succ (pred a) = a := !add_sub_cancel -definition neg_succ (a : ℤ) : -succ a = pred (-a) := +theorem pred_succ (a : ℤ) : pred (succ a) = a := !sub_add_cancel +theorem succ_pred (a : ℤ) : succ (pred a) = a := !add_sub_cancel + +theorem neg_succ (a : ℤ) : -succ a = pred (-a) := by rewrite [↑succ,neg_add] -definition succ_neg_succ (a : ℤ) : succ (-succ a) = -a := + +theorem succ_neg_succ (a : ℤ) : succ (-succ a) = -a := by rewrite [neg_succ,succ_pred] -definition neg_pred (a : ℤ) : -pred a = succ (-a) := + +theorem neg_pred (a : ℤ) : -pred a = succ (-a) := by rewrite [↑pred,neg_sub,sub_eq_add_neg,add.comm] -definition pred_neg_pred (a : ℤ) : pred (-pred a) = -a := + +theorem pred_neg_pred (a : ℤ) : pred (-pred a) = -a := by rewrite [neg_pred,pred_succ] -definition pred_nat_succ (n : ℕ) : pred (nat.succ n) = n := pred_succ n -definition neg_nat_succ (n : ℕ) : -nat.succ n = pred (-n) := !neg_succ -definition succ_neg_nat_succ (n : ℕ) : succ (-nat.succ n) = -n := !succ_neg_succ +theorem pred_nat_succ (n : ℕ) : pred (nat.succ n) = n := pred_succ n +theorem neg_nat_succ (n : ℕ) : -nat.succ n = pred (-n) := !neg_succ +theorem succ_neg_nat_succ (n : ℕ) : succ (-nat.succ n) = -n := !succ_neg_succ definition rec_nat_on [unfold 2] {P : ℤ → Type} (z : ℤ) (H0 : P 0) (Hsucc : Π⦃n : ℕ⦄, P n → P (succ n)) (Hpred : Π⦃n : ℕ⦄, P (-n) → P (-nat.succ n)) : P z := -begin - induction z with n n, - {exact nat.rec_on n H0 Hsucc}, - {induction n with m ih, - exact Hpred H0, - exact Hpred ih} -end +int.rec (nat.rec H0 Hsucc) (λn, nat.rec H0 Hpred (nat.succ n)) z --the only computation rule of rec_nat_on which is not definitional -definition rec_nat_on_neg {P : ℤ → Type} (n : nat) (H0 : P zero) - (Hsucc : Π⦃n : nat⦄, P n → P (succ n)) (Hpred : Π⦃n : nat⦄, P (-n) → P (-nat.succ n)) +theorem rec_nat_on_neg {P : ℤ → Type} (n : ℕ) (H0 : P zero) + (Hsucc : Π⦃n : ℕ⦄, P n → P (succ n)) (Hpred : Π⦃n : ℕ⦄, P (-n) → P (-nat.succ n)) : rec_nat_on (-nat.succ n) H0 Hsucc Hpred = Hpred (rec_nat_on (-n) H0 Hsucc Hpred) := -nat.rec_on n rfl (λn H, rfl) +nat.rec rfl (λn H, rfl) n end int diff --git a/hott/types/int/hott.hlean b/hott/types/int/hott.hlean index c79d5fa961..073439408e 100644 --- a/hott/types/int/hott.hlean +++ b/hott/types/int/hott.hlean @@ -6,11 +6,12 @@ Author: Floris van Doorn Theorems about the integers specific to HoTT -/ -import .basic types.eq arity -open core eq is_equiv equiv equiv.ops +import .basic types.eq arity algebra.bundled +open core eq is_equiv equiv equiv.ops algebra is_trunc open nat (hiding pred) namespace int + section open algebra definition group_integers : Group := @@ -21,7 +22,7 @@ namespace int adjointify succ pred (λa, !add_sub_cancel) (λa, !sub_add_cancel) definition equiv_succ : ℤ ≃ ℤ := equiv.mk succ _ - definition is_equiv_neg [instance] : is_equiv neg := + definition is_equiv_neg [instance] : is_equiv (neg : ℤ → ℤ) := adjointify neg neg (λx, !neg_neg) (λa, !neg_neg) definition equiv_neg : ℤ ≃ ℤ := equiv.mk neg _ @@ -90,8 +91,9 @@ namespace eq idp (λn IH, idp) (λn IH, calc - power p (-succ n) ⬝ p = (power p (-n) ⬝ p⁻¹) ⬝ p : by rewrite [↑power,-rec_nat_on_neg] - ... = power p (-n) : inv_con_cancel_right + power p (-succ n) ⬝ p + = (power p (-int.of_nat n) ⬝ p⁻¹) ⬝ p : by rewrite [↑power,-rec_nat_on_neg] + ... = power p (-int.of_nat n) : inv_con_cancel_right ... = power p (succ (-succ n)) : by rewrite -succ_neg_succ) definition power_con_inv : power p b ⬝ p⁻¹ = power p (pred b) := @@ -101,7 +103,8 @@ namespace eq power p (succ n) ⬝ p⁻¹ = power p n : by apply con_inv_cancel_right ... = power p (pred (succ n)) : by rewrite pred_nat_succ) (λn IH, calc - power p (-succ n) ⬝ p⁻¹ = power p (-succ (succ n)) : by rewrite [↑power,-rec_nat_on_neg] + power p (-int.of_nat (succ n)) ⬝ p⁻¹ + = power p (-int.of_nat (succ (succ n))) : by rewrite [↑power,-rec_nat_on_neg] ... = power p (pred (-succ n)) : by rewrite -neg_succ) definition con_power : p ⬝ power p b = power p (succ b) := @@ -111,12 +114,12 @@ namespace eq p ⬝ power p (succ n) = (p ⬝ power p n) ⬝ p : con.assoc p _ p ... = power p (succ (succ n)) : by rewrite IH qed) ( λn IH, calc - p ⬝ power p (-succ n) - = p ⬝ (power p (-n) ⬝ p⁻¹) : by rewrite [↑power,rec_nat_on_neg] - ... = (p ⬝ power p (-n)) ⬝ p⁻¹ : con.assoc - ... = power p (succ (-n)) ⬝ p⁻¹ : by rewrite IH - ... = power p (pred (succ (-n))) : power_con_inv - ... = power p (succ (-succ n)) : by rewrite [succ_neg_nat_succ,int.pred_succ]) + p ⬝ power p (-int.of_nat (succ n)) + = p ⬝ (power p (-int.of_nat n) ⬝ p⁻¹) : by rewrite [↑power, rec_nat_on_neg] + ... = (p ⬝ power p (-int.of_nat n)) ⬝ p⁻¹ : con.assoc + ... = power p (succ (-int.of_nat n)) ⬝ p⁻¹ : by rewrite IH + ... = power p (pred (succ (-int.of_nat n))) : power_con_inv + ... = power p (succ (-int.of_nat (succ n))) : by rewrite [succ_neg_nat_succ,int.pred_succ]) definition inv_con_power : p⁻¹ ⬝ power p b = power p (pred b) := rec_nat_on b @@ -127,18 +130,20 @@ namespace eq ... = power p (succ (pred n)) : power_con ... = power p (pred (succ n)) : by rewrite [succ_pred,-int.pred_succ n]) ( λn IH, calc - p⁻¹ ⬝ power p (-succ n) = p⁻¹ ⬝ (power p (-n) ⬝ p⁻¹) : by rewrite [↑power,rec_nat_on_neg] - ... = (p⁻¹ ⬝ power p (-n)) ⬝ p⁻¹ : con.assoc - ... = power p (pred (-n)) ⬝ p⁻¹ : by rewrite IH - ... = power p (-succ n) ⬝ p⁻¹ : by rewrite -neg_succ + p⁻¹ ⬝ power p (-int.of_nat (succ n)) + = p⁻¹ ⬝ (power p (-int.of_nat n) ⬝ p⁻¹) : by rewrite [↑power,rec_nat_on_neg] + ... = (p⁻¹ ⬝ power p (-int.of_nat n)) ⬝ p⁻¹ : con.assoc + ... = power p (pred (-int.of_nat n)) ⬝ p⁻¹ : by rewrite IH + ... = power p (-int.of_nat (succ n)) ⬝ p⁻¹ : by rewrite -neg_succ ... = power p (-succ (succ n)) : by rewrite [↑power,-rec_nat_on_neg] ... = power p (pred (-succ n)) : by rewrite -neg_succ) definition power_con_power : Π(b : ℤ), power p b ⬝ power p c = power p (b + c) := rec_nat_on c (λb, by rewrite int.add_zero) - (λn IH b, by rewrite [-con_power,-con.assoc,power_con,IH,↑succ,int.add.assoc,int.add.comm 1 n]) + (λn IH b, by rewrite [-con_power,-con.assoc,power_con,IH,↑succ,add.assoc, + add.comm (int.of_nat n)]) (λn IH b, by rewrite [neg_nat_succ,-inv_con_power,-con.assoc,power_con_inv,IH,↑pred, - +sub_eq_add_neg,int.add.assoc,int.add.comm (-1) (-n)]) + +sub_eq_add_neg,add.assoc,add.comm (-n)]) end eq diff --git a/hott/types/list.hlean b/hott/types/list.hlean index 2ea8b86005..585bb56903 100644 --- a/hott/types/list.hlean +++ b/hott/types/list.hlean @@ -10,7 +10,7 @@ Some lemmas are commented out, their proofs need to be repaired when needed import .pointed .nat .pi -open eq lift nat is_trunc pi pointed sum function prod option sigma +open eq lift nat is_trunc pi pointed sum function prod option sigma algebra inductive list (T : Type) : Type := | nil {} : list T diff --git a/hott/types/nat/basic.hlean b/hott/types/nat/basic.hlean index 8b80bfbd6f..845c304f64 100644 --- a/hott/types/nat/basic.hlean +++ b/hott/types/nat/basic.hlean @@ -1,13 +1,13 @@ /- Copyright (c) 2014 Floris van Doorn. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -(Ported from standard library file data.nat.basic on May 02, 2015) +(Ported from standard library) Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad Basic operations on the natural numbers. -/ -import algebra.ring -open core prod binary +import ..num algebra.ring +open prod binary eq algebra lift is_trunc namespace nat @@ -17,7 +17,7 @@ definition addl (x y : ℕ) : ℕ := nat.rec y (λ n r, succ r) x infix ` ⊕ `:65 := addl -definition addl_succ_right (n m : ℕ) : n ⊕ succ m = succ (n ⊕ m) := +theorem addl_succ_right (n m : ℕ) : n ⊕ succ m = succ (n ⊕ m) := nat.rec_on n rfl (λ n₁ ih, calc @@ -25,115 +25,120 @@ nat.rec_on n ... = succ (succ (n₁ ⊕ m)) : ih ... = succ (succ n₁ ⊕ m) : rfl) -definition add_eq_addl (x : ℕ) : ∀y, x + y = x ⊕ y := +theorem add_eq_addl (x : ℕ) : Πy, x + y = x ⊕ y := nat.rec_on x (λ y, nat.rec_on y rfl (λ y₁ ih, calc - zero + succ y₁ = succ (zero + y₁) : rfl - ... = succ (zero ⊕ y₁) : {ih} - ... = zero ⊕ (succ y₁) : rfl)) + 0 + succ y₁ = succ (0 + y₁) : rfl + ... = succ (0 ⊕ y₁) : {ih} + ... = 0 ⊕ (succ y₁) : rfl)) (λ x₁ ih₁ y, nat.rec_on y (calc - succ x₁ + zero = succ (x₁ + zero) : rfl - ... = succ (x₁ ⊕ zero) : {ih₁ zero} - ... = succ x₁ ⊕ zero : rfl) + succ x₁ + 0 = succ (x₁ + 0) : rfl + ... = succ (x₁ ⊕ 0) : {ih₁ 0} + ... = succ x₁ ⊕ 0 : rfl) (λ y₁ ih₂, calc succ x₁ + succ y₁ = succ (succ x₁ + y₁) : rfl ... = succ (succ x₁ ⊕ y₁) : {ih₂} ... = succ x₁ ⊕ succ y₁ : addl_succ_right)) -/- successor and predecessor -/ +/- successor prod predecessor -/ -definition succ_ne_zero (n : ℕ) : succ n ≠ 0 := +theorem succ_ne_zero (n : ℕ) : succ n ≠ 0 := by contradiction -- add_rewrite succ_ne_zero -definition pred_zero : pred 0 = 0 := +theorem pred_zero [simp] : pred 0 = 0 := rfl -definition pred_succ (n : ℕ) : pred (succ n) = n := +theorem pred_succ [simp] (n : ℕ) : pred (succ n) = n := rfl -definition eq_zero_or_eq_succ_pred (n : ℕ) : n = 0 ⊎ n = succ (pred n) := +theorem eq_zero_sum_eq_succ_pred (n : ℕ) : n = 0 ⊎ n = succ (pred n) := nat.rec_on n (sum.inl rfl) - (take m IH, sum.inr rfl) + (take m IH, sum.inr + (show succ m = succ (pred (succ m)), from ap succ !pred_succ⁻¹)) -definition exists_eq_succ_of_ne_zero {n : ℕ} (H : n ≠ 0) : Σk : ℕ, n = succ k := -sigma.mk _ (sum_resolve_right !eq_zero_or_eq_succ_pred H) +theorem exists_eq_succ_of_ne_zero {n : ℕ} (H : n ≠ 0) : Σk : ℕ, n = succ k := +sigma.mk _ (sum_resolve_right !eq_zero_sum_eq_succ_pred H) -definition succ.inj {n m : ℕ} (H : succ n = succ m) : n = m := -lift.down (nat.no_confusion H (λe, e)) +theorem succ.inj {n m : ℕ} (H : succ n = succ m) : n = m := +down (nat.no_confusion H imp.id) -definition succ_ne_self {n : ℕ} : succ n ≠ n := +abbreviation eq_of_succ_eq_succ := @succ.inj + +theorem succ_ne_self {n : ℕ} : succ n ≠ n := nat.rec_on n (take H : 1 = 0, have ne : 1 ≠ 0, from !succ_ne_zero, absurd H ne) (take k IH H, IH (succ.inj H)) -definition discriminate {B : Type} {n : ℕ} (H1: n = 0 → B) (H2 : ∀m, n = succ m → B) : B := +theorem discriminate {B : Type} {n : ℕ} (H1: n = 0 → B) (H2 : Πm, n = succ m → B) : B := have H : n = n → B, from nat.cases_on n H1 H2, H rfl -definition two_step_induction_on {P : ℕ → Type} (a : ℕ) (H1 : P 0) (H2 : P 1) - (H3 : ∀ (n : ℕ) (IH1 : P n) (IH2 : P (succ n)), P (succ (succ n))) : P a := +theorem two_step_rec_on {P : ℕ → Type} (a : ℕ) (H1 : P 0) (H2 : P 1) + (H3 : Π (n : ℕ) (IH1 : P n) (IH2 : P (succ n)), P (succ (succ n))) : P a := have stronger : P a × P (succ a), from nat.rec_on a (pair H1 H2) (take k IH, - have IH1 : P k, from pr1 IH, - have IH2 : P (succ k), from pr2 IH, + have IH1 : P k, from prod.pr1 IH, + have IH2 : P (succ k), from prod.pr2 IH, pair IH2 (H3 k IH1 IH2)), - pr1 stronger + prod.pr1 stronger -definition sub_induction {P : ℕ → ℕ → Type} (n m : ℕ) (H1 : ∀m, P 0 m) - (H2 : ∀n, P (succ n) 0) (H3 : ∀n m, P n m → P (succ n) (succ m)) : P n m := -have general : ∀m, P n m, from nat.rec_on n - (take m : ℕ, H1 m) +theorem sub_induction {P : ℕ → ℕ → Type} (n m : ℕ) (H1 : Πm, P 0 m) + (H2 : Πn, P (succ n) 0) (H3 : Πn m, P n m → P (succ n) (succ m)) : P n m := +have general : Πm, P n m, from nat.rec_on n H1 (take k : ℕ, - assume IH : ∀m, P k m, + assume IH : Πm, P k m, take m : ℕ, nat.cases_on m (H2 k) (take l, (H3 k l (IH l)))), general m /- addition -/ -definition add_zero (n : ℕ) : n + 0 = n := +protected theorem add_zero [simp] (n : ℕ) : n + 0 = n := rfl -definition add_succ (n m : ℕ) : n + succ m = succ (n + m) := +theorem add_succ [simp] (n m : ℕ) : n + succ m = succ (n + m) := rfl -definition zero_add (n : ℕ) : 0 + n = n := +protected theorem zero_add [simp] (n : ℕ) : 0 + n = n := nat.rec_on n - !add_zero + !nat.add_zero (take m IH, show 0 + succ m = succ m, from calc 0 + succ m = succ (0 + m) : add_succ ... = succ m : IH) -definition succ_add (n m : ℕ) : (succ n) + m = succ (n + m) := +theorem succ_add [simp] (n m : ℕ) : (succ n) + m = succ (n + m) := nat.rec_on m - (rfl) - (take k IH, eq.ap succ IH) + (!nat.add_zero ▸ !nat.add_zero) + (take k IH, calc + succ n + succ k = succ (succ n + k) : add_succ + ... = succ (succ (n + k)) : IH + ... = succ (n + succ k) : add_succ) -definition add.comm (n m : ℕ) : n + m = m + n := +protected theorem add_comm [simp] (n m : ℕ) : n + m = m + n := nat.rec_on m - (!add_zero ⬝ !zero_add⁻¹) + (by rewrite [nat.add_zero, nat.zero_add]) (take k IH, calc n + succ k = succ (n+k) : add_succ ... = succ (k + n) : IH ... = succ k + n : succ_add) -definition succ_add_eq_succ_add (n m : ℕ) : succ n + m = n + succ m := +theorem succ_add_eq_succ_add (n m : ℕ) : succ n + m = n + succ m := !succ_add ⬝ !add_succ⁻¹ -definition add.assoc (n m k : ℕ) : (n + m) + k = n + (m + k) := +protected theorem add_assoc [simp] (n m k : ℕ) : (n + m) + k = n + (m + k) := nat.rec_on k - (!add_zero ▸ !add_zero) + (by rewrite +nat.add_zero) (take l IH, calc (n + m) + succ l = succ ((n + m) + l) : add_succ @@ -141,33 +146,30 @@ nat.rec_on k ... = n + succ (m + l) : add_succ ... = n + (m + succ l) : add_succ) -definition add.left_comm (n m k : ℕ) : n + (m + k) = m + (n + k) := -left_comm add.comm add.assoc n m k +protected theorem add_left_comm : Π (n m k : ℕ), n + (m + k) = m + (n + k) := +left_comm nat.add_comm nat.add_assoc -definition add.right_comm (n m k : ℕ) : n + m + k = n + k + m := -right_comm add.comm add.assoc n m k +protected theorem add_right_comm : Π (n m k : ℕ), n + m + k = n + k + m := +right_comm nat.add_comm nat.add_assoc -theorem add.comm4 : Π {n m k l : ℕ}, n + m + (k + l) = n + k + (m + l) := -comm4 add.comm add.assoc - -definition add.cancel_left {n m k : ℕ} : n + m = n + k → m = k := +protected theorem add_left_cancel {n m k : ℕ} : n + m = n + k → m = k := nat.rec_on n (take H : 0 + m = 0 + k, - !zero_add⁻¹ ⬝ H ⬝ !zero_add) + !nat.zero_add⁻¹ ⬝ H ⬝ !nat.zero_add) (take (n : ℕ) (IH : n + m = n + k → m = k) (H : succ n + m = succ n + k), - have H2 : succ (n + m) = succ (n + k), + have succ (n + m) = succ (n + k), from calc succ (n + m) = succ n + m : succ_add ... = succ n + k : H ... = succ (n + k) : succ_add, - have H3 : n + m = n + k, from succ.inj H2, - IH H3) + have n + m = n + k, from succ.inj this, + IH this) -definition add.cancel_right {n m k : ℕ} (H : n + m = k + m) : n = k := -have H2 : m + n = m + k, from !add.comm ⬝ H ⬝ !add.comm, - add.cancel_left H2 +protected theorem add_right_cancel {n m k : ℕ} (H : n + m = k + m) : n = k := +have H2 : m + n = m + k, from !nat.add_comm ⬝ H ⬝ !nat.add_comm, + nat.add_left_cancel H2 -definition eq_zero_of_add_eq_zero_right {n m : ℕ} : n + m = 0 → n = 0 := +theorem eq_zero_of_add_eq_zero_right {n m : ℕ} : n + m = 0 → n = 0 := nat.rec_on n (take (H : 0 + m = 0), rfl) (take k IH, @@ -178,99 +180,98 @@ nat.rec_on n ... = 0 : H) !succ_ne_zero) -definition eq_zero_of_add_eq_zero_left {n m : ℕ} (H : n + m = 0) : m = 0 := -eq_zero_of_add_eq_zero_right (!add.comm ⬝ H) +theorem eq_zero_of_add_eq_zero_left {n m : ℕ} (H : n + m = 0) : m = 0 := +eq_zero_of_add_eq_zero_right (!nat.add_comm ⬝ H) -definition eq_zero_and_eq_zero_of_add_eq_zero {n m : ℕ} (H : n + m = 0) : n = 0 × m = 0 := +theorem eq_zero_prod_eq_zero_of_add_eq_zero {n m : ℕ} (H : n + m = 0) : n = 0 × m = 0 := pair (eq_zero_of_add_eq_zero_right H) (eq_zero_of_add_eq_zero_left H) -definition add_one (n : ℕ) : n + 1 = succ n := -!add_zero ▸ !add_succ +theorem add_one [simp] (n : ℕ) : n + 1 = succ n := rfl -definition one_add (n : ℕ) : 1 + n = succ n := -!zero_add ▸ !succ_add +theorem one_add (n : ℕ) : 1 + n = succ n := +!nat.zero_add ▸ !succ_add /- multiplication -/ -definition mul_zero (n : ℕ) : n * 0 = 0 := +protected theorem mul_zero [simp] (n : ℕ) : n * 0 = 0 := rfl -definition mul_succ (n m : ℕ) : n * succ m = n * m + n := +theorem mul_succ [simp] (n m : ℕ) : n * succ m = n * m + n := rfl -- commutativity, distributivity, associativity, identity -definition zero_mul (n : ℕ) : 0 * n = 0 := +protected theorem zero_mul [simp] (n : ℕ) : 0 * n = 0 := nat.rec_on n - !mul_zero - (take m IH, !mul_succ ⬝ !add_zero ⬝ IH) + !nat.mul_zero + (take m IH, !mul_succ ⬝ !nat.add_zero ⬝ IH) -definition succ_mul (n m : ℕ) : (succ n) * m = (n * m) + m := +theorem succ_mul [simp] (n m : ℕ) : (succ n) * m = (n * m) + m := nat.rec_on m - (!mul_zero ⬝ !mul_zero⁻¹ ⬝ !add_zero⁻¹) + (by rewrite nat.mul_zero) (take k IH, calc succ n * succ k = succ n * k + succ n : mul_succ ... = n * k + k + succ n : IH - ... = n * k + (k + succ n) : add.assoc - ... = n * k + (succ n + k) : add.comm + ... = n * k + (k + succ n) : nat.add_assoc + ... = n * k + (succ n + k) : nat.add_comm ... = n * k + (n + succ k) : succ_add_eq_succ_add - ... = n * k + n + succ k : add.assoc + ... = n * k + n + succ k : nat.add_assoc ... = n * succ k + succ k : mul_succ) -definition mul.comm (n m : ℕ) : n * m = m * n := +protected theorem mul_comm [simp] (n m : ℕ) : n * m = m * n := nat.rec_on m - (!mul_zero ⬝ !zero_mul⁻¹) + (!nat.mul_zero ⬝ !nat.zero_mul⁻¹) (take k IH, calc n * succ k = n * k + n : mul_succ ... = k * n + n : IH ... = (succ k) * n : succ_mul) -definition mul.right_distrib (n m k : ℕ) : (n + m) * k = n * k + m * k := +protected theorem right_distrib (n m k : ℕ) : (n + m) * k = n * k + m * k := nat.rec_on k (calc - (n + m) * 0 = 0 : mul_zero - ... = 0 + 0 : add_zero - ... = n * 0 + 0 : mul_zero - ... = n * 0 + m * 0 : mul_zero) + (n + m) * 0 = 0 : nat.mul_zero + ... = 0 + 0 : nat.add_zero + ... = n * 0 + 0 : nat.mul_zero + ... = n * 0 + m * 0 : nat.mul_zero) (take l IH, calc (n + m) * succ l = (n + m) * l + (n + m) : mul_succ ... = n * l + m * l + (n + m) : IH - ... = n * l + m * l + n + m : add.assoc - ... = n * l + n + m * l + m : add.right_comm - ... = n * l + n + (m * l + m) : add.assoc + ... = n * l + m * l + n + m : nat.add_assoc + ... = n * l + n + m * l + m : nat.add_right_comm + ... = n * l + n + (m * l + m) : nat.add_assoc ... = n * succ l + (m * l + m) : mul_succ ... = n * succ l + m * succ l : mul_succ) -definition mul.left_distrib (n m k : ℕ) : n * (m + k) = n * m + n * k := +protected theorem left_distrib (n m k : ℕ) : n * (m + k) = n * m + n * k := calc - n * (m + k) = (m + k) * n : mul.comm - ... = m * n + k * n : mul.right_distrib - ... = n * m + k * n : mul.comm - ... = n * m + n * k : mul.comm + n * (m + k) = (m + k) * n : nat.mul_comm + ... = m * n + k * n : nat.right_distrib + ... = n * m + k * n : nat.mul_comm + ... = n * m + n * k : nat.mul_comm -definition mul.assoc (n m k : ℕ) : (n * m) * k = n * (m * k) := +protected theorem mul_assoc [simp] (n m k : ℕ) : (n * m) * k = n * (m * k) := nat.rec_on k (calc - (n * m) * 0 = n * (m * 0) : mul_zero) + (n * m) * 0 = n * (m * 0) : nat.mul_zero) (take l IH, calc (n * m) * succ l = (n * m) * l + n * m : mul_succ ... = n * (m * l) + n * m : IH - ... = n * (m * l + m) : mul.left_distrib + ... = n * (m * l + m) : nat.left_distrib ... = n * (m * succ l) : mul_succ) -definition mul_one (n : ℕ) : n * 1 = n := +protected theorem mul_one [simp] (n : ℕ) : n * 1 = n := calc n * 1 = n * 0 + n : mul_succ - ... = 0 + n : mul_zero - ... = n : zero_add + ... = 0 + n : nat.mul_zero + ... = n : nat.zero_add -definition one_mul (n : ℕ) : 1 * n = n := +protected theorem one_mul [simp] (n : ℕ) : 1 * n = n := calc - 1 * n = n * 1 : mul.comm - ... = n : mul_one + 1 * n = n * 1 : nat.mul_comm + ... = n : nat.mul_one -definition eq_zero_or_eq_zero_of_mul_eq_zero {n m : ℕ} : n * m = 0 → n = 0 ⊎ m = 0 := +theorem eq_zero_sum_eq_zero_of_mul_eq_zero {n m : ℕ} : n * m = 0 → n = 0 ⊎ m = 0 := nat.cases_on n (assume H, sum.inl rfl) (take n', @@ -279,72 +280,38 @@ nat.cases_on n (take m', assume H : succ n' * succ m' = 0, absurd - ((calc + (calc 0 = succ n' * succ m' : H ... = succ n' * m' + succ n' : mul_succ - ... = succ (succ n' * m' + n') : add_succ)⁻¹) + ... = succ (succ n' * m' + n') : add_succ)⁻¹ !succ_ne_zero)) -section - open [classes] algebra - - protected definition comm_semiring [instance] [reducible] : algebra.comm_semiring nat := - ⦃algebra.comm_semiring, - add := add, - add_assoc := add.assoc, - zero := zero, - zero_add := zero_add, - add_zero := add_zero, - add_comm := add.comm, - mul := mul, - mul_assoc := mul.assoc, - one := succ zero, - one_mul := one_mul, - mul_one := mul_one, - left_distrib := mul.left_distrib, - right_distrib := mul.right_distrib, - zero_mul := zero_mul, - mul_zero := mul_zero, - mul_comm := mul.comm, - is_hset_carrier := is_hset_of_decidable_eq⦄ -end - -section port_algebra - open [classes] algebra - definition mul.left_comm : ∀a b c : ℕ, a * (b * c) = b * (a * c) := algebra.mul.left_comm - definition mul.right_comm : ∀a b c : ℕ, (a * b) * c = (a * c) * b := algebra.mul.right_comm - - definition dvd (a b : ℕ) : Type₀ := algebra.dvd a b - notation a ∣ b := dvd a b - - definition dvd.intro : ∀{a b c : ℕ} (H : a * c = b), a ∣ b := @algebra.dvd.intro _ _ - definition dvd.intro_left : ∀{a b c : ℕ} (H : c * a = b), a ∣ b := @algebra.dvd.intro_left _ _ - definition exists_eq_mul_right_of_dvd : ∀{a b : ℕ} (H : a ∣ b), Σc, b = a * c := - @algebra.exists_eq_mul_right_of_dvd _ _ - definition dvd.elim : ∀{P : Type} {a b : ℕ} (H₁ : a ∣ b) (H₂ : ∀c, b = a * c → P), P := - @algebra.dvd.elim _ _ - definition exists_eq_mul_left_of_dvd : ∀{a b : ℕ} (H : a ∣ b), Σc, b = c * a := - @algebra.exists_eq_mul_left_of_dvd _ _ - definition dvd.elim_left : ∀{P : Type} {a b : ℕ} (H₁ : a ∣ b) (H₂ : ∀c, b = c * a → P), P := - @algebra.dvd.elim_left _ _ - definition dvd.refl : ∀a : ℕ, a ∣ a := algebra.dvd.refl - definition dvd.trans : ∀{a b c : ℕ}, a ∣ b → b ∣ c → a ∣ c := @algebra.dvd.trans _ _ - definition eq_zero_of_zero_dvd : ∀{a : ℕ}, 0 ∣ a → a = 0 := @algebra.eq_zero_of_zero_dvd _ _ - definition dvd_zero : ∀a : ℕ, a ∣ 0 := algebra.dvd_zero - definition one_dvd : ∀a : ℕ, 1 ∣ a := algebra.one_dvd - definition dvd_mul_right : ∀a b : ℕ, a ∣ a * b := algebra.dvd_mul_right - definition dvd_mul_left : ∀a b : ℕ, a ∣ b * a := algebra.dvd_mul_left - definition dvd_mul_of_dvd_left : ∀{a b : ℕ} (H : a ∣ b) (c : ℕ), a ∣ b * c := - @algebra.dvd_mul_of_dvd_left _ _ - definition dvd_mul_of_dvd_right : ∀{a b : ℕ} (H : a ∣ b) (c : ℕ), a ∣ c * b := - @algebra.dvd_mul_of_dvd_right _ _ - definition mul_dvd_mul : ∀{a b c d : ℕ}, a ∣ b → c ∣ d → a * c ∣ b * d := - @algebra.mul_dvd_mul _ _ - definition dvd_of_mul_right_dvd : ∀{a b c : ℕ}, a * b ∣ c → a ∣ c := - @algebra.dvd_of_mul_right_dvd _ _ - definition dvd_of_mul_left_dvd : ∀{a b c : ℕ}, a * b ∣ c → b ∣ c := - @algebra.dvd_of_mul_left_dvd _ _ - definition dvd_add : ∀{a b c : ℕ}, a ∣ b → a ∣ c → a ∣ b + c := @algebra.dvd_add _ _ -end port_algebra - +protected definition comm_semiring [reducible] [trans_instance] : comm_semiring nat := +⦃comm_semiring, + add := nat.add, + add_assoc := nat.add_assoc, + zero := nat.zero, + zero_add := nat.zero_add, + add_zero := nat.add_zero, + add_comm := nat.add_comm, + mul := nat.mul, + mul_assoc := nat.mul_assoc, + one := nat.succ nat.zero, + one_mul := nat.one_mul, + mul_one := nat.mul_one, + left_distrib := nat.left_distrib, + right_distrib := nat.right_distrib, + zero_mul := nat.zero_mul, + mul_zero := nat.mul_zero, + mul_comm := nat.mul_comm, + is_hset_carrier:= _⦄ end nat + +section +open nat +definition iterate {A : Type} (op : A → A) : ℕ → A → A + | 0 := λ a, a + | (succ k) := λ a, op (iterate k a) + +notation f`^[`n`]` := iterate f n +end diff --git a/hott/types/nat/hott.hlean b/hott/types/nat/hott.hlean index eb21ad184b..bdeaaaee93 100644 --- a/hott/types/nat/hott.hlean +++ b/hott/types/nat/hott.hlean @@ -6,9 +6,9 @@ Author: Floris van Doorn Theorems about the natural numbers specific to HoTT -/ -import .basic +import .order -open is_trunc unit empty eq equiv +open is_trunc unit empty eq equiv algebra namespace nat definition is_hprop_le [instance] (n m : ℕ) : is_hprop (n ≤ m) := @@ -25,6 +25,8 @@ namespace nat { exact ap le.step !v_0}}, end + definition is_hprop_lt [instance] (n m : ℕ) : is_hprop (n < m) := !is_hprop_le + definition le_equiv_succ_le_succ (n m : ℕ) : (n ≤ m) ≃ (succ n ≤ succ m) := equiv_of_is_hprop succ_le_succ le_of_succ_le_succ definition le_succ_equiv_pred_le (n m : ℕ) : (n ≤ succ m) ≃ (pred n ≤ m) := @@ -73,8 +75,9 @@ namespace nat unfold [lt_ge_by_cases,lt.by_cases], induction (lt.trichotomy n m) with H' H', { esimp, apply ap H1 !is_hprop.elim}, { cases H' with H' H', - esimp, exact !Heq⁻¹ ⬝ ap H1 !is_hprop.elim, - exfalso, apply lt.irrefl, apply lt_of_le_of_lt H H'} + { esimp, induction H', esimp, symmetry, + exact ap H1 !is_hprop.elim ⬝ Heq idp ⬝ ap H2 !is_hprop.elim}, + { exfalso, apply lt.irrefl, apply lt_of_le_of_lt H H'}} end protected definition code [reducible] [unfold 1 2] : ℕ → ℕ → Type₀ diff --git a/hott/types/nat/order.hlean b/hott/types/nat/order.hlean index e9b9f1a6e4..f6c1099f17 100644 --- a/hott/types/nat/order.hlean +++ b/hott/types/nat/order.hlean @@ -4,180 +4,158 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad The order relation on the natural numbers. - -Note: this file has significant differences than the standard library version -/ - import .basic algebra.ordered_ring -open prod decidable sum eq sigma sigma.ops +open eq eq.ops algebra algebra namespace nat -/- lt and le -/ +/- lt prod le -/ -theorem le_of_lt_or_eq {m n : ℕ} (H : m < n ⊎ m = n) : m ≤ n := -sum.rec_on H (take H1, le_of_lt H1) (take H1, H1 ▸ !le.refl) +protected theorem le_of_lt_sum_eq {m n : ℕ} (H : m < n ⊎ m = n) : m ≤ n := +nat.le_of_eq_sum_lt (sum.swap H) -theorem lt_or_eq_of_le {m n : ℕ} (H : m ≤ n) : m < n ⊎ m = n := -lt.by_cases - (assume H1 : m < n, sum.inl H1) - (assume H1 : m = n, sum.inr H1) - (assume H1 : m > n, absurd (lt_of_le_of_lt H H1) !lt.irrefl) +protected theorem lt_sum_eq_of_le {m n : ℕ} (H : m ≤ n) : m < n ⊎ m = n := +sum.swap (nat.eq_sum_lt_of_le H) -theorem le_iff_lt_or_eq (m n : ℕ) : m ≤ n ↔ m < n ⊎ m = n := -iff.intro lt_or_eq_of_le le_of_lt_or_eq +protected theorem le_iff_lt_sum_eq (m n : ℕ) : m ≤ n ↔ m < n ⊎ m = n := +iff.intro nat.lt_sum_eq_of_le nat.le_of_lt_sum_eq -theorem lt_of_le_and_ne {m n : ℕ} (H1 : m ≤ n) (H2 : m ≠ n) : m < n := -sum.rec_on (lt_or_eq_of_le H1) - (take H3 : m < n, H3) - (take H3 : m = n, absurd H3 H2) +protected theorem lt_of_le_prod_ne {m n : ℕ} (H1 : m ≤ n) : m ≠ n → m < n := +sum_resolve_right (nat.eq_sum_lt_of_le H1) -theorem lt_iff_le_and_ne (m n : ℕ) : m < n ↔ m ≤ n × m ≠ n := +protected theorem lt_iff_le_prod_ne (m n : ℕ) : m < n ↔ m ≤ n × m ≠ n := iff.intro - (take H, pair (le_of_lt H) (take H1, lt.irrefl _ (H1 ▸ H))) - (take H, lt_of_le_and_ne (pr1 H) (pr2 H)) + (take H, pair (nat.le_of_lt H) (take H1, !nat.lt_irrefl (H1 ▸ H))) + (prod.rec nat.lt_of_le_prod_ne) theorem le_add_right (n k : ℕ) : n ≤ n + k := -nat.rec_on k - (calc n ≤ n : le.refl n - ... = n + zero : add_zero) - (λ k (ih : n ≤ n + k), calc - n ≤ succ (n + k) : le_succ_of_le ih - ... = n + succ k : add_succ) +nat.rec !nat.le_refl (λ k, le_succ_of_le) k theorem le_add_left (n m : ℕ): n ≤ m + n := !add.comm ▸ !le_add_right theorem le.intro {n m k : ℕ} (h : n + k = m) : n ≤ m := -h ▸ le_add_right n k +h ▸ !le_add_right -theorem le.elim {n m : ℕ} (h : n ≤ m) : Σk, n + k = m := -by induction h with m h ih;exact ⟨0, idp⟩;exact ⟨succ ih.1, ap succ ih.2⟩ +theorem le.elim {n m : ℕ} : n ≤ m → Σ k, n + k = m := +le.rec (sigma.mk 0 rfl) (λm h, sigma.rec + (λ k H, sigma.mk (succ k) (H ▸ rfl))) -theorem le.total {m n : ℕ} : m ≤ n ⊎ n ≤ m := -lt.by_cases - (assume H : m < n, sum.inl (le_of_lt H)) - (assume H : m = n, sum.inl (H ▸ !le.refl)) - (assume H : m > n, sum.inr (le_of_lt H)) +protected theorem le_total {m n : ℕ} : m ≤ n ⊎ n ≤ m := +sum.imp_left nat.le_of_lt !nat.lt_sum_ge /- addition -/ -theorem add_le_add_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k + n ≤ k + m := -sigma.rec_on (le.elim H) (λ(l : ℕ) (Hl : n + l = m), -le.intro - (calc - k + n + l = k + (n + l) : !add.assoc - ... = k + m : {Hl})) +protected theorem add_le_add_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k + n ≤ k + m := +obtain l Hl, from le.elim H, le.intro (Hl ▸ !add.assoc) -theorem add_le_add_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n + k ≤ m + k := -!add.comm ▸ !add.comm ▸ add_le_add_left H k +protected theorem add_le_add_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n + k ≤ m + k := +!add.comm ▸ !add.comm ▸ nat.add_le_add_left H k -theorem le_of_add_le_add_left {k n m : ℕ} (H : k + n ≤ k + m) : n ≤ m := -sigma.rec_on (le.elim H) (λ(l : ℕ) (Hl : k + n + l = k + m), -le.intro (add.cancel_left - (calc - k + (n + l) = k + n + l : (!add.assoc)⁻¹ - ... = k + m : Hl))) +protected theorem le_of_add_le_add_left {k n m : ℕ} (H : k + n ≤ k + m) : n ≤ m := +obtain l Hl, from le.elim H, le.intro (nat.add_left_cancel (!add.assoc⁻¹ ⬝ Hl)) -theorem add_lt_add_left {n m : ℕ} (H : n < m) (k : ℕ) : k + n < k + m := -lt_of_succ_le (!add_succ ▸ add_le_add_left (succ_le_of_lt H) k) +protected theorem lt_of_add_lt_add_left {k n m : ℕ} (H : k + n < k + m) : n < m := +let H' := nat.le_of_lt H in +nat.lt_of_le_prod_ne (nat.le_of_add_le_add_left H') (assume Heq, !nat.lt_irrefl (Heq ▸ H)) -theorem add_lt_add_right {n m : ℕ} (H : n < m) (k : ℕ) : n + k < m + k := -!add.comm ▸ !add.comm ▸ add_lt_add_left H k +protected theorem add_lt_add_left {n m : ℕ} (H : n < m) (k : ℕ) : k + n < k + m := +lt_of_succ_le (!add_succ ▸ nat.add_le_add_left (succ_le_of_lt H) k) -theorem lt_add_of_pos_right {n k : ℕ} (H : k > 0) : n < n + k := -!add_zero ▸ add_lt_add_left H n +protected theorem add_lt_add_right {n m : ℕ} (H : n < m) (k : ℕ) : n + k < m + k := +!add.comm ▸ !add.comm ▸ nat.add_lt_add_left H k + +protected theorem lt_add_of_pos_right {n k : ℕ} (H : k > 0) : n < n + k := +!add_zero ▸ nat.add_lt_add_left H n /- multiplication -/ -theorem mul_le_mul_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k * n ≤ k * m := -sigma.rec_on (le.elim H) (λ(l : ℕ) (Hl : n + l = m), -have H2 : k * n + k * l = k * m, by rewrite [-mul.left_distrib, Hl], -le.intro H2) +theorem mul_le_mul_left {n m : ℕ} (k : ℕ) (H : n ≤ m) : k * n ≤ k * m := +obtain (l : ℕ) (Hl : n + l = m), from le.elim H, +have k * n + k * l = k * m, by rewrite [-left_distrib, Hl], +le.intro this -theorem mul_le_mul_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n * k ≤ m * k := -!mul.comm ▸ !mul.comm ▸ (mul_le_mul_left H k) +theorem mul_le_mul_right {n m : ℕ} (k : ℕ) (H : n ≤ m) : n * k ≤ m * k := +!mul.comm ▸ !mul.comm ▸ !mul_le_mul_left H -theorem mul_le_mul {n m k l : ℕ} (H1 : n ≤ k) (H2 : m ≤ l) : n * m ≤ k * l := -le.trans (mul_le_mul_right H1 m) (mul_le_mul_left H2 k) +protected theorem mul_le_mul {n m k l : ℕ} (H1 : n ≤ k) (H2 : m ≤ l) : n * m ≤ k * l := +nat.le_trans (!nat.mul_le_mul_right H1) (!nat.mul_le_mul_left H2) -theorem mul_lt_mul_of_pos_left {n m k : ℕ} (H : n < m) (Hk : k > 0) : k * n < k * m := -have H2 : k * n < k * n + k, from lt_add_of_pos_right Hk, -have H3 : k * n + k ≤ k * m, from !mul_succ ▸ mul_le_mul_left (succ_le_of_lt H) k, -lt_of_lt_of_le H2 H3 +protected theorem mul_lt_mul_of_pos_left {n m k : ℕ} (H : n < m) (Hk : k > 0) : k * n < k * m := +nat.lt_of_lt_of_le (nat.lt_add_of_pos_right Hk) (!mul_succ ▸ nat.mul_le_mul_left k (succ_le_of_lt H)) -theorem mul_lt_mul_of_pos_right {n m k : ℕ} (H : n < m) (Hk : k > 0) : n * k < m * k := -!mul.comm ▸ !mul.comm ▸ mul_lt_mul_of_pos_left H Hk +protected theorem mul_lt_mul_of_pos_right {n m k : ℕ} (H : n < m) (Hk : k > 0) : n * k < m * k := +!mul.comm ▸ !mul.comm ▸ nat.mul_lt_mul_of_pos_left H Hk -/- nat is an instance of a linearly ordered semiring -/ +/- nat is an instance of a linearly ordered semiring prod a lattice -/ -section - open [classes] algebra +protected definition decidable_linear_ordered_semiring [reducible] [trans_instance] : +decidable_linear_ordered_semiring nat := +⦃ decidable_linear_ordered_semiring, nat.comm_semiring, + add_left_cancel := @nat.add_left_cancel, + add_right_cancel := @nat.add_right_cancel, + lt := nat.lt, + le := nat.le, + le_refl := nat.le_refl, + le_trans := @nat.le_trans, + le_antisymm := @nat.le_antisymm, + le_total := @nat.le_total, + le_iff_lt_sum_eq := @nat.le_iff_lt_sum_eq, + le_of_lt := @nat.le_of_lt, + lt_irrefl := @nat.lt_irrefl, + lt_of_lt_of_le := @nat.lt_of_lt_of_le, + lt_of_le_of_lt := @nat.lt_of_le_of_lt, + lt_of_add_lt_add_left := @nat.lt_of_add_lt_add_left, + add_lt_add_left := @nat.add_lt_add_left, + add_le_add_left := @nat.add_le_add_left, + le_of_add_le_add_left := @nat.le_of_add_le_add_left, + zero_lt_one := zero_lt_succ 0, + mul_le_mul_of_nonneg_left := (take a b c H1 H2, nat.mul_le_mul_left c H1), + mul_le_mul_of_nonneg_right := (take a b c H1 H2, nat.mul_le_mul_right c H1), + mul_lt_mul_of_pos_left := @nat.mul_lt_mul_of_pos_left, + mul_lt_mul_of_pos_right := @nat.mul_lt_mul_of_pos_right, + decidable_lt := nat.decidable_lt ⦄ - protected definition linear_ordered_semiring [instance] [reducible] : - algebra.linear_ordered_semiring nat := - ⦃ algebra.linear_ordered_semiring, nat.comm_semiring, - add_left_cancel := @add.cancel_left, - add_right_cancel := @add.cancel_right, - lt := lt, - le := le, - le_refl := le.refl, - le_trans := @le.trans, - le_antisymm := @le.antisymm, - le_total := @le.total, - le_iff_lt_or_eq := @le_iff_lt_or_eq, - lt_iff_le_and_ne := lt_iff_le_and_ne, - add_le_add_left := @add_le_add_left, - le_of_add_le_add_left := @le_of_add_le_add_left, - zero_ne_one := ne.symm (succ_ne_zero zero), - mul_le_mul_of_nonneg_left := (take a b c H1 H2, mul_le_mul_left H1 c), - mul_le_mul_of_nonneg_right := (take a b c H1 H2, mul_le_mul_right H1 c), - mul_lt_mul_of_pos_left := @mul_lt_mul_of_pos_left, - mul_lt_mul_of_pos_right := @mul_lt_mul_of_pos_right ⦄ +definition nat_has_dvd [reducible] [instance] [priority nat.prio] : has_dvd nat := +has_dvd.mk has_dvd.dvd - variables {a b c d : nat} - theorem ne_of_lt (lt_ab : a < b) : a ≠ b := algebra.ne_of_lt lt_ab - theorem ne_of_gt (gt_ab : a > b) : a ≠ b := algebra.ne_of_gt gt_ab - theorem lt_of_not_le (H : ¬ a ≥ b) : a < b := algebra.lt_of_not_le H - theorem le_or_gt (a b : nat) : sum (a ≤ b) (a > b) := algebra.le_or_gt a b - theorem le_of_mul_le_mul_left (H : c * a ≤ c * b) (Hc : c > 0) : a ≤ b := algebra.le_of_mul_le_mul_left H Hc - theorem not_lt_of_le (H : a ≤ b) : ¬ b < a := algebra.not_lt_of_le H - theorem not_le_of_lt (H : a < b) : ¬ b ≤ a := algebra.not_le_of_lt H - theorem add_le_add (Hab : a ≤ b) (Hcd : c ≤ d) : a + c ≤ b + d := algebra.add_le_add Hab Hcd - theorem lt_of_add_lt_add_right (H : a + b < c + b) : a < c := algebra.lt_of_add_lt_add_right H - theorem lt_of_add_lt_add_left (H : a + b < a + c) : b < c := algebra.lt_of_add_lt_add_left H -end +theorem add_pos_left {a : ℕ} (H : 0 < a) (b : ℕ) : 0 < a + b := +@add_pos_of_pos_of_nonneg _ _ a b H !zero_le -section port_algebra - open [classes] algebra - theorem add_pos_left : Π{a : ℕ}, 0 < a → Πb : ℕ, 0 < a + b := - take a H b, @algebra.add_pos_of_pos_of_nonneg _ _ a b H !zero_le - theorem add_pos_right : Π{a : ℕ}, 0 < a → Πb : ℕ, 0 < b + a := - take a H b, !add.comm ▸ add_pos_left H b - theorem add_eq_zero_iff_eq_zero_and_eq_zero : Π{a b : ℕ}, - a + b = 0 ↔ a = 0 × b = 0 := - take a b : ℕ, - @algebra.add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg _ _ a b !zero_le !zero_le - theorem le_add_of_le_left : Π{a b c : ℕ}, b ≤ c → b ≤ a + c := - take a b c H, @algebra.le_add_of_nonneg_of_le _ _ a b c !zero_le H - theorem le_add_of_le_right : Π{a b c : ℕ}, b ≤ c → b ≤ c + a := - take a b c H, @algebra.le_add_of_le_of_nonneg _ _ a b c H !zero_le - theorem lt_add_of_lt_left : Π{b c : ℕ}, b < c → Πa, b < a + c := - take b c H a, @algebra.lt_add_of_nonneg_of_lt _ _ a b c !zero_le H - theorem lt_add_of_lt_right : Π{b c : ℕ}, b < c → Πa, b < c + a := - take b c H a, @algebra.lt_add_of_lt_of_nonneg _ _ a b c H !zero_le - theorem lt_of_mul_lt_mul_left : Π{a b c : ℕ}, c * a < c * b → a < b := - take a b c H, @algebra.lt_of_mul_lt_mul_left _ _ a b c H !zero_le - theorem lt_of_mul_lt_mul_right : Π{a b c : ℕ}, a * c < b * c → a < b := - take a b c H, @algebra.lt_of_mul_lt_mul_right _ _ a b c H !zero_le - theorem pos_of_mul_pos_left : Π{a b : ℕ}, 0 < a * b → 0 < b := - take a b H, @algebra.pos_of_mul_pos_left _ _ a b H !zero_le - theorem pos_of_mul_pos_right : Π{a b : ℕ}, 0 < a * b → 0 < a := - take a b H, @algebra.pos_of_mul_pos_right _ _ a b H !zero_le -end port_algebra +theorem add_pos_right {a : ℕ} (H : 0 < a) (b : ℕ) : 0 < b + a := +by rewrite add.comm; apply add_pos_left H b -theorem zero_le_one : 0 ≤ 1 := dec_trivial -theorem zero_lt_one : 0 < 1 := dec_trivial +theorem add_eq_zero_iff_eq_zero_prod_eq_zero {a b : ℕ} : +a + b = 0 ↔ a = 0 × b = 0 := +@add_eq_zero_iff_eq_zero_prod_eq_zero_of_nonneg_of_nonneg _ _ a b !zero_le !zero_le + +theorem le_add_of_le_left {a b c : ℕ} (H : b ≤ c) : b ≤ a + c := +@le_add_of_nonneg_of_le _ _ a b c !zero_le H + +theorem le_add_of_le_right {a b c : ℕ} (H : b ≤ c) : b ≤ c + a := +@le_add_of_le_of_nonneg _ _ a b c H !zero_le + +theorem lt_add_of_lt_left {b c : ℕ} (H : b < c) (a : ℕ) : b < a + c := +@lt_add_of_nonneg_of_lt _ _ a b c !zero_le H + +theorem lt_add_of_lt_right {b c : ℕ} (H : b < c) (a : ℕ) : b < c + a := +@lt_add_of_lt_of_nonneg _ _ a b c H !zero_le + +theorem lt_of_mul_lt_mul_left {a b c : ℕ} (H : c * a < c * b) : a < b := +@lt_of_mul_lt_mul_left _ _ a b c H !zero_le + +theorem lt_of_mul_lt_mul_right {a b c : ℕ} (H : a * c < b * c) : a < b := +@lt_of_mul_lt_mul_right _ _ a b c H !zero_le + +theorem pos_of_mul_pos_left {a b : ℕ} (H : 0 < a * b) : 0 < b := +@pos_of_mul_pos_left _ _ a b H !zero_le + +theorem pos_of_mul_pos_right {a b : ℕ} (H : 0 < a * b) : 0 < a := +@pos_of_mul_pos_right _ _ a b H !zero_le + +theorem zero_le_one : (0:nat) ≤ 1 := +dec_star /- properties specific to nat -/ @@ -194,116 +172,95 @@ theorem eq_zero_of_le_zero {n : ℕ} (H : n ≤ 0) : n = 0 := obtain (k : ℕ) (Hk : n + k = 0), from le.elim H, eq_zero_of_add_eq_zero_right Hk -/- succ and pred -/ +/- succ prod pred -/ + +theorem le_of_lt_succ {m n : nat} : m < succ n → m ≤ n := +le_of_succ_le_succ theorem lt_iff_succ_le (m n : nat) : m < n ↔ succ m ≤ n := iff.rfl +theorem lt_succ_iff_le (m n : nat) : m < succ n ↔ m ≤ n := +iff.intro le_of_lt_succ lt_succ_of_le + theorem self_le_succ (n : ℕ) : n ≤ succ n := le.intro !add_one -theorem succ_le_or_eq_of_le {n m : ℕ} (H : n ≤ m) : succ n ≤ m ⊎ n = m := -sum.rec_on (lt_or_eq_of_le H) - (assume H1 : n < m, sum.inl (succ_le_of_lt H1)) - (assume H1 : n = m, sum.inr H1) +theorem succ_le_sum_eq_of_le {n m : ℕ} : n ≤ m → succ n ≤ m ⊎ n = m := +lt_sum_eq_of_le theorem pred_le_of_le_succ {n m : ℕ} : n ≤ succ m → pred n ≤ m := -nat.cases_on n - (assume H, !pred_zero⁻¹ ▸ zero_le m) - (take n', - assume H : succ n' ≤ succ m, - have H1 : n' ≤ m, from le_of_succ_le_succ H, - !pred_succ⁻¹ ▸ H1) +pred_le_pred theorem succ_le_of_le_pred {n m : ℕ} : succ n ≤ m → n ≤ pred m := -nat.cases_on m - (assume H, absurd H !not_succ_le_zero) - (take m', - assume H : succ n ≤ succ m', - have H1 : n ≤ m', from le_of_succ_le_succ H, - !pred_succ⁻¹ ▸ H1) +pred_le_pred theorem pred_le_pred_of_le {n m : ℕ} : n ≤ m → pred n ≤ pred m := -nat.cases_on n - (assume H, pred_zero⁻¹ ▸ zero_le (pred m)) - (take n', - assume H : succ n' ≤ m, - !pred_succ⁻¹ ▸ succ_le_of_le_pred H) +pred_le_pred + +theorem pre_lt_of_lt {n m : ℕ} : n < m → pred n < m := +lt_of_le_of_lt !pred_le theorem lt_of_pred_lt_pred {n m : ℕ} (H : pred n < pred m) : n < m := -lt_of_not_le - (take H1 : m ≤ n, - not_lt_of_le (pred_le_pred_of_le H1) H) +lt_of_not_ge + (suppose m ≤ n, + not_lt_of_ge (pred_le_pred_of_le this) H) -theorem le_or_eq_succ_of_le_succ {n m : ℕ} (H : n ≤ succ m) : n ≤ m ⊎ n = succ m := -sum_of_sum_of_imp_left (succ_le_or_eq_of_le H) - (take H2 : succ n ≤ succ m, show n ≤ m, from le_of_succ_le_succ H2) +theorem le_sum_eq_succ_of_le_succ {n m : ℕ} (H : n ≤ succ m) : n ≤ m ⊎ n = succ m := +sum.imp_left le_of_succ_le_succ (succ_le_sum_eq_of_le H) theorem le_pred_self (n : ℕ) : pred n ≤ n := -nat.cases_on n - (pred_zero⁻¹ ▸ !le.refl) - (take k : ℕ, (!pred_succ)⁻¹ ▸ !self_le_succ) +!pred_le theorem succ_pos (n : ℕ) : 0 < succ n := !zero_lt_succ theorem succ_pred_of_pos {n : ℕ} (H : n > 0) : succ (pred n) = n := -(sum_resolve_right (eq_zero_or_eq_succ_pred n) (ne.symm (ne_of_lt H)))⁻¹ +(sum_resolve_right (eq_zero_sum_eq_succ_pred n) (ne.symm (ne_of_lt H)))⁻¹ -theorem exists_eq_succ_of_lt {n m : ℕ} (H : n < m) : Σk, m = succ k := -discriminate - (take (Hm : m = 0), absurd (Hm ▸ H) !not_lt_zero) - (take (l : ℕ) (Hm : m = succ l), sigma.mk l Hm) +theorem exists_eq_succ_of_lt {n : ℕ} : Π {m : ℕ}, n < m → Σk, m = succ k +| 0 H := absurd H !not_lt_zero +| (succ k) H := sigma.mk k rfl theorem lt_succ_self (n : ℕ) : n < succ n := lt.base n -theorem le_of_lt_succ {n m : ℕ} (H : n < succ m) : n ≤ m := -le_of_succ_le_succ (succ_le_of_lt H) +lemma lt_succ_of_lt {i j : nat} : i < j → i < succ j := +assume Plt, lt.trans Plt (self_lt_succ j) -/- other forms of rec -/ +/- other forms of induction -/ -protected theorem strong_induction_on {P : nat → Type} (n : ℕ) (H : Πn, (Πm, m < n → P m) → P n) : - P n := -have H1 : Π {n m : nat}, m < n → P m, from - take n, - nat.rec_on n - (show Πm, m < 0 → P m, from take m H, absurd H !not_lt_zero) - (take n', - assume IH : Π {m : nat}, m < n' → P m, - have H2: P n', from H n' @IH, - show Πm, m < succ n' → P m, from - take m, - assume H3 : m < succ n', - sum.rec_on (lt_or_eq_of_le (le_of_lt_succ H3)) - (assume H4: m < n', IH H4) - (assume H4: m = n', H4⁻¹ ▸ H2)), -H1 !lt_succ_self +protected definition strong_rec_on {P : nat → Type} (n : ℕ) (H : Πn, (Πm, m < n → P m) → P n) : P n := +nat.rec (λm h, absurd h !not_lt_zero) + (λn' (IH : Π {m : ℕ}, m < n' → P m) m l, + sum.elim (lt_sum_eq_of_le (le_of_lt_succ l)) + IH (λ e, eq.rec (H n' @IH) e⁻¹)) (succ n) n !lt_succ_self -protected theorem case_strong_induction_on {P : nat → Type} (a : nat) (H0 : P 0) +protected theorem case_strong_rec_on {P : nat → Type} (a : nat) (H0 : P 0) (Hind : Π(n : nat), (Πm, m ≤ n → P m) → P (succ n)) : P a := -nat.strong_induction_on a +nat.strong_rec_on a (take n, show (Π m, m < n → P m) → P n, from nat.cases_on n - (assume H : (Πm, m < 0 → P m), show P 0, from H0) + (suppose (Π m, m < 0 → P m), show P 0, from H0) (take n, - assume H : (Πm, m < succ n → P m), + suppose (Π m, m < succ n → P m), show P (succ n), from - Hind n (take m, assume H1 : m ≤ n, H _ (lt_succ_of_le H1)))) + Hind n (take m, assume H1 : m ≤ n, this _ (lt_succ_of_le H1)))) /- pos -/ -theorem by_cases_zero_pos {P : ℕ → Type} (y : ℕ) (H0 : P 0) (H1 : Π {y : nat}, y > 0 → P y) : P y := +theorem by_cases_zero_pos {P : ℕ → Type} (y : ℕ) (H0 : P 0) (H1 : Π {y : nat}, y > 0 → P y) : + P y := nat.cases_on y H0 (take y, H1 !succ_pos) -theorem eq_zero_or_pos (n : ℕ) : n = 0 ⊎ n > 0 := +theorem eq_zero_sum_pos (n : ℕ) : n = 0 ⊎ n > 0 := sum_of_sum_of_imp_left - (sum.swap (lt_or_eq_of_le !zero_le)) - (take H : 0 = n, H⁻¹) + (sum.swap (lt_sum_eq_of_le !zero_le)) + (suppose 0 = n, by subst n) theorem pos_of_ne_zero {n : ℕ} (H : n ≠ 0) : n > 0 := -sum.rec_on !eq_zero_or_pos (take H2 : n = 0, absurd H2 H) (take H2 : n > 0, H2) +sum.elim !eq_zero_sum_pos (take H2 : n = 0, by contradiction) (take H2 : n > 0, H2) theorem ne_zero_of_pos {n : ℕ} (H : n > 0) : n ≠ 0 := ne.symm (ne_of_lt H) @@ -313,53 +270,53 @@ exists_eq_succ_of_lt H theorem pos_of_dvd_of_pos {m n : ℕ} (H1 : m ∣ n) (H2 : n > 0) : m > 0 := pos_of_ne_zero - (assume H3 : m = 0, - have H4 : n = 0, from eq_zero_of_zero_dvd (H3 ▸ H1), - ne_of_lt H2 H4⁻¹) + (suppose m = 0, + assert n = 0, from eq_zero_of_zero_dvd (this ▸ H1), + ne_of_lt H2 (by subst n)) /- multiplication -/ theorem mul_lt_mul_of_le_of_lt {n m k l : ℕ} (Hk : k > 0) (H1 : n ≤ k) (H2 : m < l) : n * m < k * l := -lt_of_le_of_lt (mul_le_mul_right H1 m) (mul_lt_mul_of_pos_left H2 Hk) +lt_of_le_of_lt (mul_le_mul_right m H1) (mul_lt_mul_of_pos_left H2 Hk) theorem mul_lt_mul_of_lt_of_le {n m k l : ℕ} (Hl : l > 0) (H1 : n < k) (H2 : m ≤ l) : n * m < k * l := -lt_of_le_of_lt (mul_le_mul_left H2 n) (mul_lt_mul_of_pos_right H1 Hl) +lt_of_le_of_lt (mul_le_mul_left n H2) (mul_lt_mul_of_pos_right H1 Hl) theorem mul_lt_mul_of_le_of_le {n m k l : ℕ} (H1 : n < k) (H2 : m < l) : n * m < k * l := -have H3 : n * m ≤ k * m, from mul_le_mul_right (le_of_lt H1) m, +have H3 : n * m ≤ k * m, from mul_le_mul_right m (le_of_lt H1), have H4 : k * m < k * l, from mul_lt_mul_of_pos_left H2 (lt_of_le_of_lt !zero_le H1), lt_of_le_of_lt H3 H4 theorem eq_of_mul_eq_mul_left {m k n : ℕ} (Hn : n > 0) (H : n * m = n * k) : m = k := -have H2 : n * m ≤ n * k, from H ▸ !le.refl, -have H3 : n * k ≤ n * m, from H ▸ !le.refl, -have H4 : m ≤ k, from le_of_mul_le_mul_left H2 Hn, -have H5 : k ≤ m, from le_of_mul_le_mul_left H3 Hn, -le.antisymm H4 H5 +have n * m ≤ n * k, by rewrite H, +have m ≤ k, from le_of_mul_le_mul_left this Hn, +have n * k ≤ n * m, by rewrite H, +have k ≤ m, from le_of_mul_le_mul_left this Hn, +le.antisymm `m ≤ k` this theorem eq_of_mul_eq_mul_right {n m k : ℕ} (Hm : m > 0) (H : n * m = k * m) : n = k := eq_of_mul_eq_mul_left Hm (!mul.comm ▸ !mul.comm ▸ H) -theorem eq_zero_or_eq_of_mul_eq_mul_left {n m k : ℕ} (H : n * m = n * k) : n = 0 ⊎ m = k := -sum_of_sum_of_imp_right !eq_zero_or_pos +theorem eq_zero_sum_eq_of_mul_eq_mul_left {n m k : ℕ} (H : n * m = n * k) : n = 0 ⊎ m = k := +sum_of_sum_of_imp_right !eq_zero_sum_pos (assume Hn : n > 0, eq_of_mul_eq_mul_left Hn H) -theorem eq_zero_or_eq_of_mul_eq_mul_right {n m k : ℕ} (H : n * m = k * m) : m = 0 ⊎ n = k := -eq_zero_or_eq_of_mul_eq_mul_left (!mul.comm ▸ !mul.comm ▸ H) +theorem eq_zero_sum_eq_of_mul_eq_mul_right {n m k : ℕ} (H : n * m = k * m) : m = 0 ⊎ n = k := +eq_zero_sum_eq_of_mul_eq_mul_left (!mul.comm ▸ !mul.comm ▸ H) theorem eq_one_of_mul_eq_one_right {n m : ℕ} (H : n * m = 1) : n = 1 := -have H2 : n * m > 0, from H⁻¹ ▸ !succ_pos, -have H3 : n > 0, from pos_of_mul_pos_right H2, -have H4 : m > 0, from pos_of_mul_pos_left H2, -sum.rec_on (le_or_gt n 1) - (assume H5 : n ≤ 1, - show n = 1, from le.antisymm H5 (succ_le_of_lt H3)) - (assume H5 : n > 1, - have H6 : n * m ≥ 2 * 1, from mul_le_mul (succ_le_of_lt H5) (succ_le_of_lt H4), - have H7 : 1 ≥ 2, from !mul_one ▸ H ▸ H6, - absurd !lt_succ_self (not_lt_of_le H7)) +have H2 : n * m > 0, by rewrite H; apply succ_pos, +sum.elim (le_sum_gt n 1) + (suppose n ≤ 1, + have n > 0, from pos_of_mul_pos_right H2, + show n = 1, from le.antisymm `n ≤ 1` (succ_le_of_lt this)) + (suppose n > 1, + have m > 0, from pos_of_mul_pos_left H2, + have n * m ≥ 2 * 1, from nat.mul_le_mul (succ_le_of_lt `n > 1`) (succ_le_of_lt this), + have 1 ≥ 2, from !mul_one ▸ H ▸ this, + absurd !lt_succ_self (not_lt_of_ge this)) theorem eq_one_of_mul_eq_one_left {n m : ℕ} (H : n * m = 1) : m = 1 := eq_one_of_mul_eq_one_right (!mul.comm ▸ H) @@ -372,8 +329,164 @@ eq_one_of_mul_eq_self_left Hpos (!mul.comm ▸ H) theorem eq_one_of_dvd_one {n : ℕ} (H : n ∣ 1) : n = 1 := dvd.elim H - (take m, - assume H1 : 1 = n * m, - eq_one_of_mul_eq_one_right H1⁻¹) + (take m, suppose 1 = n * m, + eq_one_of_mul_eq_one_right this⁻¹) + +/- min prod max -/ +open decidable + +theorem min_zero [simp] (a : ℕ) : min a 0 = 0 := +by rewrite [min_eq_right !zero_le] + +theorem zero_min [simp] (a : ℕ) : min 0 a = 0 := +by rewrite [min_eq_left !zero_le] + +theorem max_zero [simp] (a : ℕ) : max a 0 = a := +by rewrite [max_eq_left !zero_le] + +theorem zero_max [simp] (a : ℕ) : max 0 a = a := +by rewrite [max_eq_right !zero_le] + +theorem min_succ_succ [simp] (a b : ℕ) : min (succ a) (succ b) = succ (min a b) := +sum.elim !lt_sum_ge + (suppose a < b, by rewrite [min_eq_left_of_lt this, min_eq_left_of_lt (succ_lt_succ this)]) + (suppose a ≥ b, by rewrite [min_eq_right this, min_eq_right (succ_le_succ this)]) + +theorem max_succ_succ [simp] (a b : ℕ) : max (succ a) (succ b) = succ (max a b) := +sum.elim !lt_sum_ge + (suppose a < b, by rewrite [max_eq_right_of_lt this, max_eq_right_of_lt (succ_lt_succ this)]) + (suppose a ≥ b, by rewrite [max_eq_left this, max_eq_left (succ_le_succ this)]) + +/- In algebra.ordered_group, these next four are only proved for additive groups, not additive + semigroups. -/ + +protected theorem min_add_add_left (a b c : ℕ) : min (a + b) (a + c) = a + min b c := +decidable.by_cases + (suppose b ≤ c, + assert a + b ≤ a + c, from add_le_add_left this _, + by rewrite [min_eq_left `b ≤ c`, min_eq_left this]) + (suppose ¬ b ≤ c, + assert c ≤ b, from le_of_lt (lt_of_not_ge this), + assert a + c ≤ a + b, from add_le_add_left this _, + by rewrite [min_eq_right `c ≤ b`, min_eq_right this]) + +protected theorem min_add_add_right (a b c : ℕ) : min (a + c) (b + c) = min a b + c := +by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply nat.min_add_add_left + +protected theorem max_add_add_left (a b c : ℕ) : max (a + b) (a + c) = a + max b c := +decidable.by_cases + (suppose b ≤ c, + assert a + b ≤ a + c, from add_le_add_left this _, + by rewrite [max_eq_right `b ≤ c`, max_eq_right this]) + (suppose ¬ b ≤ c, + assert c ≤ b, from le_of_lt (lt_of_not_ge this), + assert a + c ≤ a + b, from add_le_add_left this _, + by rewrite [max_eq_left `c ≤ b`, max_eq_left this]) + +protected theorem max_add_add_right (a b c : ℕ) : max (a + c) (b + c) = max a b + c := +by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply nat.max_add_add_left + +/- least prod greatest -/ + +section least_prod_greatest + variable (P : ℕ → Type) + variable [decP : Π n, decidable (P n)] + include decP + + -- returns the least i < n satisfying P, sum n if there is none + definition least : ℕ → ℕ + | 0 := 0 + | (succ n) := if P (least n) then least n else succ n + + theorem least_of_bound {n : ℕ} (H : P n) : P (least P n) := + begin + induction n with [m, ih], + rewrite ↑least, + apply H, + rewrite ↑least, + cases decidable.em (P (least P m)) with [Hlp, Hlp], + rewrite [if_pos Hlp], + apply Hlp, + rewrite [if_neg Hlp], + apply H + end + + theorem least_le (n : ℕ) : least P n ≤ n:= + begin + induction n with [m, ih], + {rewrite ↑least}, + rewrite ↑least, + cases decidable.em (P (least P m)) with [Psm, Pnsm], + rewrite [if_pos Psm], + apply le.trans ih !le_succ, + rewrite [if_neg Pnsm] + end + + theorem least_of_lt {i n : ℕ} (ltin : i < n) (H : P i) : P (least P n) := + begin + induction n with [m, ih], + exact absurd ltin !not_lt_zero, + rewrite ↑least, + cases decidable.em (P (least P m)) with [Psm, Pnsm], + rewrite [if_pos Psm], + apply Psm, + rewrite [if_neg Pnsm], + cases (lt_sum_eq_of_le (le_of_lt_succ ltin)) with [Hlt, Heq], + exact absurd (ih Hlt) Pnsm, + rewrite Heq at H, + exact absurd (least_of_bound P H) Pnsm + end + + theorem ge_least_of_lt {i n : ℕ} (ltin : i < n) (Hi : P i) : i ≥ least P n := + begin + induction n with [m, ih], + exact absurd ltin !not_lt_zero, + rewrite ↑least, + cases decidable.em (P (least P m)) with [Psm, Pnsm], + rewrite [if_pos Psm], + cases (lt_sum_eq_of_le (le_of_lt_succ ltin)) with [Hlt, Heq], + apply ih Hlt, + rewrite Heq, + apply least_le, + rewrite [if_neg Pnsm], + cases (lt_sum_eq_of_le (le_of_lt_succ ltin)) with [Hlt, Heq], + apply absurd (least_of_lt P Hlt Hi) Pnsm, + rewrite Heq at Hi, + apply absurd (least_of_bound P Hi) Pnsm + end + + theorem least_lt {n i : ℕ} (ltin : i < n) (Hi : P i) : least P n < n := + lt_of_le_of_lt (ge_least_of_lt P ltin Hi) ltin + + -- returns the largest i < n satisfying P, sum n if there is none. + definition greatest : ℕ → ℕ + | 0 := 0 + | (succ n) := if P n then n else greatest n + + theorem greatest_of_lt {i n : ℕ} (ltin : i < n) (Hi : P i) : P (greatest P n) := + begin + induction n with [m, ih], + {exact absurd ltin !not_lt_zero}, + {cases (decidable.em (P m)) with [Psm, Pnsm], + {rewrite [↑greatest, if_pos Psm]; exact Psm}, + {rewrite [↑greatest, if_neg Pnsm], + have neim : i ≠ m, from assume H : i = m, absurd (H ▸ Hi) Pnsm, + have ltim : i < m, from lt_of_le_of_ne (le_of_lt_succ ltin) neim, + apply ih ltim}} + end + + theorem le_greatest_of_lt {i n : ℕ} (ltin : i < n) (Hi : P i) : i ≤ greatest P n := + begin + induction n with [m, ih], + {exact absurd ltin !not_lt_zero}, + {cases (decidable.em (P m)) with [Psm, Pnsm], + {rewrite [↑greatest, if_pos Psm], apply le_of_lt_succ ltin}, + {rewrite [↑greatest, if_neg Pnsm], + have neim : i ≠ m, from assume H : i = m, absurd (H ▸ Hi) Pnsm, + have ltim : i < m, from lt_of_le_of_ne (le_of_lt_succ ltin) neim, + apply ih ltim}} + end + +end least_prod_greatest end nat diff --git a/hott/types/nat/sub.hlean b/hott/types/nat/sub.hlean index 4ffcf9117d..cb341088d7 100644 --- a/hott/types/nat/sub.hlean +++ b/hott/types/nat/sub.hlean @@ -3,27 +3,23 @@ Copyright (c) 2014 Floris van Doorn. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Jeremy Avigad -Subtraction on the natural numbers, as well as min, max, and distance. - -Ported from standard library +Subtraction on the natural numbers, as well as min, max, prod distance. -/ import .order - -open core - +open eq.ops algebra eq namespace nat /- subtraction -/ -definition sub_zero (n : ℕ) : n - 0 = n := +protected theorem sub_zero (n : ℕ) : n - 0 = n := rfl -definition sub_succ (n m : ℕ) : n - succ m = pred (n - m) := +theorem sub_succ (n m : ℕ) : n - succ m = pred (n - m) := rfl -definition zero_sub (n : ℕ) : 0 - n = 0 := -nat.rec_on n !sub_zero +protected theorem zero_sub (n : ℕ) : 0 - n = 0 := +nat.rec_on n !nat.sub_zero (take k : nat, assume IH : 0 - k = 0, calc @@ -31,13 +27,13 @@ nat.rec_on n !sub_zero ... = pred 0 : IH ... = 0 : pred_zero) -definition succ_sub_succ (n m : ℕ) : succ n - succ m = n - m := +theorem succ_sub_succ (n m : ℕ) : succ n - succ m = n - m := succ_sub_succ_eq_sub n m -definition sub_self (n : ℕ) : n - n = 0 := -nat.rec_on n !sub_zero (take k IH, !succ_sub_succ ⬝ IH) +protected theorem sub_self (n : ℕ) : n - n = 0 := +nat.rec_on n !nat.sub_zero (take k IH, !succ_sub_succ ⬝ IH) -definition add_sub_add_right (n k m : ℕ) : (n + k) - (m + k) = n - m := +protected theorem add_sub_add_right (n k m : ℕ) : (n + k) - (m + k) = n - m := nat.rec_on k (calc (n + 0) - (m + 0) = n - (m + 0) : {!add_zero} @@ -49,13 +45,12 @@ nat.rec_on k ... = succ (n + l) - succ (m + l) : {!add_succ} ... = (n + l) - (m + l) : !succ_sub_succ ... = n - m : IH) +protected theorem add_sub_add_left (k n m : ℕ) : (k + n) - (k + m) = n - m := +!add.comm ▸ !add.comm ▸ !nat.add_sub_add_right -definition add_sub_add_left (k n m : ℕ) : (k + n) - (k + m) = n - m := -!add.comm ▸ !add.comm ▸ !add_sub_add_right - -definition add_sub_cancel (n m : ℕ) : n + m - m = n := +protected theorem add_sub_cancel (n m : ℕ) : n + m - m = n := nat.rec_on m - (!add_zero⁻¹ ▸ !sub_zero) + (begin rewrite add_zero end) (take k : ℕ, assume IH : n + k - k = n, calc @@ -63,13 +58,13 @@ nat.rec_on m ... = n + k - k : succ_sub_succ ... = n : IH) -definition add_sub_cancel_left (n m : ℕ) : n + m - n = m := -!add.comm ▸ !add_sub_cancel +protected theorem add_sub_cancel_left (n m : ℕ) : n + m - n = m := +!add.comm ▸ !nat.add_sub_cancel -definition sub_sub (n m k : ℕ) : n - m - k = n - (m + k) := +protected theorem sub_sub (n m k : ℕ) : n - m - k = n - (m + k) := nat.rec_on k (calc - n - m - 0 = n - m : sub_zero + n - m - 0 = n - m : nat.sub_zero ... = n - (m + 0) : add_zero) (take l : nat, assume IH : n - m - l = n - (m + l), @@ -77,60 +72,60 @@ nat.rec_on k n - m - succ l = pred (n - m - l) : !sub_succ ... = pred (n - (m + l)) : IH ... = n - succ (m + l) : sub_succ - ... = n - (m + succ l) : {!add_succ⁻¹}) + ... = n - (m + succ l) : by rewrite add_succ) -definition succ_sub_sub_succ (n m k : ℕ) : succ n - m - succ k = n - m - k := +theorem succ_sub_sub_succ (n m k : ℕ) : succ n - m - succ k = n - m - k := calc - succ n - m - succ k = succ n - (m + succ k) : sub_sub + succ n - m - succ k = succ n - (m + succ k) : nat.sub_sub ... = succ n - succ (m + k) : add_succ ... = n - (m + k) : succ_sub_succ - ... = n - m - k : sub_sub + ... = n - m - k : nat.sub_sub -definition sub_self_add (n m : ℕ) : n - (n + m) = 0 := +theorem sub_self_add (n m : ℕ) : n - (n + m) = 0 := calc - n - (n + m) = n - n - m : sub_sub - ... = 0 - m : sub_self - ... = 0 : zero_sub + n - (n + m) = n - n - m : nat.sub_sub + ... = 0 - m : nat.sub_self + ... = 0 : nat.zero_sub -definition sub.right_comm (m n k : ℕ) : m - n - k = m - k - n := +protected theorem sub.right_comm (m n k : ℕ) : m - n - k = m - k - n := calc - m - n - k = m - (n + k) : !sub_sub + m - n - k = m - (n + k) : !nat.sub_sub ... = m - (k + n) : {!add.comm} - ... = m - k - n : !sub_sub⁻¹ + ... = m - k - n : !nat.sub_sub⁻¹ -definition sub_one (n : ℕ) : n - 1 = pred n := +theorem sub_one (n : ℕ) : n - 1 = pred n := rfl -definition succ_sub_one (n : ℕ) : succ n - 1 = n := +theorem succ_sub_one (n : ℕ) : succ n - 1 = n := rfl /- interaction with multiplication -/ -definition mul_pred_left (n m : ℕ) : pred n * m = n * m - m := +theorem mul_pred_left (n m : ℕ) : pred n * m = n * m - m := nat.rec_on n (calc pred 0 * m = 0 * m : pred_zero ... = 0 : zero_mul - ... = 0 - m : zero_sub + ... = 0 - m : nat.zero_sub ... = 0 * m - m : zero_mul) (take k : nat, assume IH : pred k * m = k * m - m, calc pred (succ k) * m = k * m : pred_succ - ... = k * m + m - m : add_sub_cancel + ... = k * m + m - m : nat.add_sub_cancel ... = succ k * m - m : succ_mul) -definition mul_pred_right (n m : ℕ) : n * pred m = n * m - n := +theorem mul_pred_right (n m : ℕ) : n * pred m = n * m - n := calc n * pred m = pred m * n : mul.comm ... = m * n - n : mul_pred_left ... = n * m - n : mul.comm -definition mul_sub_right_distrib (n m k : ℕ) : (n - m) * k = n * k - m * k := +protected theorem mul_sub_right_distrib (n m k : ℕ) : (n - m) * k = n * k - m * k := nat.rec_on m (calc - (n - 0) * k = n * k : sub_zero - ... = n * k - 0 : sub_zero + (n - 0) * k = n * k : nat.sub_zero + ... = n * k - 0 : nat.sub_zero ... = n * k - 0 * k : zero_mul) (take l : nat, assume IH : (n - l) * k = n * k - l * k, @@ -138,26 +133,27 @@ nat.rec_on m (n - succ l) * k = pred (n - l) * k : sub_succ ... = (n - l) * k - k : mul_pred_left ... = n * k - l * k - k : IH - ... = n * k - (l * k + k) : sub_sub + ... = n * k - (l * k + k) : nat.sub_sub ... = n * k - (succ l * k) : succ_mul) -definition mul_sub_left_distrib (n m k : ℕ) : n * (m - k) = n * m - n * k := +protected theorem mul_sub_left_distrib (n m k : ℕ) : n * (m - k) = n * m - n * k := calc n * (m - k) = (m - k) * n : !mul.comm - ... = m * n - k * n : !mul_sub_right_distrib + ... = m * n - k * n : !nat.mul_sub_right_distrib ... = n * m - k * n : {!mul.comm} ... = n * m - n * k : {!mul.comm} -definition mul_self_sub_mul_self_eq (a b : nat) : a * a - b * b = (a + b) * (a - b) := -by rewrite [mul_sub_left_distrib, *mul.right_distrib, mul.comm b a, add.comm (a*a) (a*b), add_sub_add_left] +protected theorem mul_self_sub_mul_self_eq (a b : nat) : a * a - b * b = (a + b) * (a - b) := +by rewrite [nat.mul_sub_left_distrib, *right_distrib, mul.comm b a, add.comm (a*a) (a*b), + nat.add_sub_add_left] -definition succ_mul_succ_eq (a : nat) : succ a * succ a = a*a + a + a + 1 := +theorem succ_mul_succ_eq (a : nat) : succ a * succ a = a*a + a + a + 1 := calc succ a * succ a = (a+1)*(a+1) : by rewrite [add_one] - ... = a*a + a + a + 1 : by rewrite [mul.right_distrib, mul.left_distrib, one_mul, mul_one] + ... = a*a + a + a + 1 : by rewrite [right_distrib, left_distrib, one_mul, mul_one] /- interaction with inequalities -/ -definition succ_sub {m n : ℕ} : m ≥ n → succ m - n = succ (m - n) := +theorem succ_sub {m n : ℕ} : m ≥ n → succ m - n = succ (m - n) := sub_induction n m (take k, assume H : 0 ≤ k, rfl) (take k, @@ -171,16 +167,16 @@ sub_induction n m ... = succ (l - k) : IH (le_of_succ_le_succ H) ... = succ (succ l - succ k) : succ_sub_succ) -definition sub_eq_zero_of_le {n m : ℕ} (H : n ≤ m) : n - m = 0 := +theorem sub_eq_zero_of_le {n m : ℕ} (H : n ≤ m) : n - m = 0 := obtain (k : ℕ) (Hk : n + k = m), from le.elim H, Hk ▸ !sub_self_add -definition add_sub_of_le {n m : ℕ} : n ≤ m → n + (m - n) = m := +theorem add_sub_of_le {n m : ℕ} : n ≤ m → n + (m - n) = m := sub_induction n m (take k, assume H : 0 ≤ k, calc 0 + (k - 0) = k - 0 : zero_add - ... = k : sub_zero) + ... = k : nat.sub_zero) (take k, assume H : succ k ≤ 0, absurd H !not_succ_le_zero) (take k l, assume IH : k ≤ l → k + (l - k) = l, @@ -190,38 +186,38 @@ sub_induction n m ... = succ (k + (l - k)) : succ_add ... = succ l : IH (le_of_succ_le_succ H)) -definition add_sub_of_ge {n m : ℕ} (H : n ≥ m) : n + (m - n) = n := +theorem add_sub_of_ge {n m : ℕ} (H : n ≥ m) : n + (m - n) = n := calc n + (m - n) = n + 0 : sub_eq_zero_of_le H ... = n : add_zero -definition sub_add_cancel {n m : ℕ} : n ≥ m → n - m + m = n := +protected theorem sub_add_cancel {n m : ℕ} : n ≥ m → n - m + m = n := !add.comm ▸ !add_sub_of_le -definition sub_add_of_le {n m : ℕ} : n ≤ m → n - m + m = m := +theorem sub_add_of_le {n m : ℕ} : n ≤ m → n - m + m = m := !add.comm ▸ add_sub_of_ge -definition sub.cases {P : ℕ → Type} {n m : ℕ} (H1 : n ≤ m → P 0) (H2 : Πk, m + k = n -> P k) +theorem sub.cases {P : ℕ → Type} {n m : ℕ} (H1 : n ≤ m → P 0) (H2 : Πk, m + k = n -> P k) : P (n - m) := -sum.rec_on !le.total +sum.elim !le.total (assume H3 : n ≤ m, (sub_eq_zero_of_le H3)⁻¹ ▸ (H1 H3)) (assume H3 : m ≤ n, H2 (n - m) (add_sub_of_le H3)) -definition exists_sub_eq_of_le {n m : ℕ} (H : n ≤ m) : Σk, m - k = n := +theorem exists_sub_eq_of_le {n m : ℕ} (H : n ≤ m) : Σk, m - k = n := obtain (k : ℕ) (Hk : n + k = m), from le.elim H, sigma.mk k (calc - m - k = n + k - k : Hk - ... = n : add_sub_cancel) + m - k = n + k - k : by rewrite Hk + ... = n : nat.add_sub_cancel) -definition add_sub_assoc {m k : ℕ} (H : k ≤ m) (n : ℕ) : n + m - k = n + (m - k) := +protected theorem add_sub_assoc {m k : ℕ} (H : k ≤ m) (n : ℕ) : n + m - k = n + (m - k) := have l1 : k ≤ m → n + m - k = n + (m - k), from sub_induction k m (take m : ℕ, assume H : 0 ≤ m, calc - n + m - 0 = n + m : sub_zero - ... = n + (m - 0) : sub_zero) + n + m - 0 = n + m : nat.sub_zero + ... = n + (m - 0) : nat.sub_zero) (take k : ℕ, assume H : succ k ≤ 0, absurd H !not_succ_le_zero) (take k m, assume IH : k ≤ m → n + m - k = n + (m - k), @@ -233,7 +229,7 @@ have l1 : k ≤ m → n + m - k = n + (m - k), from ... = n + (succ m - succ k) : succ_sub_succ), l1 H -definition le_of_sub_eq_zero {n m : ℕ} : n - m = 0 → n ≤ m := +theorem le_of_sub_eq_zero {n m : ℕ} : n - m = 0 → n ≤ m := sub.cases (assume H1 : n ≤ m, assume H2 : 0 = 0, H1) (take k : ℕ, @@ -242,36 +238,42 @@ sub.cases have H3 : n = m, from !add_zero ▸ H2 ▸ H1⁻¹, H3 ▸ !le.refl) -definition sub_sub.cases {P : ℕ → ℕ → Type} {n m : ℕ} (H1 : Πk, n = m + k -> P k 0) +theorem sub_sub.cases {P : ℕ → ℕ → Type} {n m : ℕ} (H1 : Πk, n = m + k -> P k 0) (H2 : Πk, m = n + k → P 0 k) : P (n - m) (m - n) := -sum.rec_on !le.total +sum.elim !le.total (assume H3 : n ≤ m, (sub_eq_zero_of_le H3)⁻¹ ▸ (H2 (m - n) (add_sub_of_le H3)⁻¹)) (assume H3 : m ≤ n, (sub_eq_zero_of_le H3)⁻¹ ▸ (H1 (n - m) (add_sub_of_le H3)⁻¹)) -definition sub_eq_of_add_eq {n m k : ℕ} (H : n + m = k) : k - n = m := +protected theorem sub_eq_of_add_eq {n m k : ℕ} (H : n + m = k) : k - n = m := have H2 : k - n + n = m + n, from calc - k - n + n = k : sub_add_cancel (le.intro H) + k - n + n = k : nat.sub_add_cancel (le.intro H) ... = n + m : H⁻¹ ... = m + n : !add.comm, -add.cancel_right H2 +add.right_cancel H2 -definition sub_le_sub_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n - k ≤ m - k := +protected theorem eq_sub_of_add_eq {a b c : ℕ} (H : a + c = b) : a = b - c := +(nat.sub_eq_of_add_eq (!add.comm ▸ H))⁻¹ + +protected theorem sub_eq_of_eq_add {a b c : ℕ} (H : a = c + b) : a - b = c := +nat.sub_eq_of_add_eq (!add.comm ▸ H⁻¹) + +protected theorem sub_le_sub_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n - k ≤ m - k := obtain (l : ℕ) (Hl : n + l = m), from le.elim H, -sum.rec_on !le.total +sum.elim !le.total (assume H2 : n ≤ k, (sub_eq_zero_of_le H2)⁻¹ ▸ !zero_le) (assume H2 : k ≤ n, have H3 : n - k + l = m - k, from calc n - k + l = l + (n - k) : add.comm - ... = l + n - k : add_sub_assoc H2 l + ... = l + n - k : nat.add_sub_assoc H2 l ... = n + l - k : add.comm ... = m - k : Hl, le.intro H3) -definition sub_le_sub_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k - m ≤ k - n := +protected theorem sub_le_sub_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k - m ≤ k - n := obtain (l : ℕ) (Hl : n + l = m), from le.elim H, sub.cases (assume H2 : k ≤ m, !zero_le) @@ -285,42 +287,42 @@ sub.cases ... = n + l + m' : add.assoc ... = m + m' : Hl ... = k : Hm - ... = k - n + n : sub_add_cancel H3, - le.intro (add.cancel_right H4)) + ... = k - n + n : nat.sub_add_cancel H3, + le.intro (add.right_cancel H4)) -definition sub_pos_of_lt {m n : ℕ} (H : m < n) : n - m > 0 := -have H1 : n = n - m + m, from (sub_add_cancel (le_of_lt H))⁻¹, -have H2 : 0 + m < n - m + m, from (zero_add m)⁻¹ ▸ H1 ▸ H, +protected theorem sub_pos_of_lt {m n : ℕ} (H : m < n) : n - m > 0 := +assert H1 : n = n - m + m, from (nat.sub_add_cancel (le_of_lt H))⁻¹, +have H2 : 0 + m < n - m + m, begin rewrite [zero_add, -H1], exact H end, !lt_of_add_lt_add_right H2 -definition lt_of_sub_pos {m n : ℕ} (H : n - m > 0) : m < n := -lt_of_not_le +protected theorem lt_of_sub_pos {m n : ℕ} (H : n - m > 0) : m < n := +lt_of_not_ge (take H1 : m ≥ n, have H2 : n - m = 0, from sub_eq_zero_of_le H1, !lt.irrefl (H2 ▸ H)) -definition lt_of_sub_lt_sub_right {n m k : ℕ} (H : n - k < m - k) : n < m := -lt_of_not_le +protected theorem lt_of_sub_lt_sub_right {n m k : ℕ} (H : n - k < m - k) : n < m := +lt_of_not_ge (assume H1 : m ≤ n, - have H2 : m - k ≤ n - k, from sub_le_sub_right H1 _, - not_le_of_lt H H2) + have H2 : m - k ≤ n - k, from nat.sub_le_sub_right H1 _, + not_le_of_gt H H2) -definition lt_of_sub_lt_sub_left {n m k : ℕ} (H : n - m < n - k) : k < m := -lt_of_not_le +protected theorem lt_of_sub_lt_sub_left {n m k : ℕ} (H : n - m < n - k) : k < m := +lt_of_not_ge (assume H1 : m ≤ k, - have H2 : n - k ≤ n - m, from sub_le_sub_left H1 _, - not_le_of_lt H H2) + have H2 : n - k ≤ n - m, from nat.sub_le_sub_left H1 _, + not_le_of_gt H H2) -definition sub_lt_sub_add_sub (n m k : ℕ) : n - k ≤ (n - m) + (m - k) := +protected theorem sub_lt_sub_add_sub (n m k : ℕ) : n - k ≤ (n - m) + (m - k) := sub.cases - (assume H : n ≤ m, !zero_add⁻¹ ▸ sub_le_sub_right H k) + (assume H : n ≤ m, !zero_add⁻¹ ▸ nat.sub_le_sub_right H k) (take mn : ℕ, assume Hmn : m + mn = n, sub.cases (assume H : m ≤ k, - have H2 : n - k ≤ n - m, from sub_le_sub_left H n, - have H3 : n - k ≤ mn, from sub_eq_of_add_eq Hmn ▸ H2, - show n - k ≤ mn + 0, from !add_zero⁻¹ ▸ H3) + have H2 : n - k ≤ n - m, from nat.sub_le_sub_left H n, + assert H3 : n - k ≤ mn, from nat.sub_eq_of_add_eq Hmn ▸ H2, + show n - k ≤ mn + 0, begin rewrite add_zero, assumption end) (take km : ℕ, assume Hkm : k + km = m, have H : k + (mn + km) = n, from @@ -329,10 +331,10 @@ sub.cases ... = k + km + mn : add.assoc ... = m + mn : Hkm ... = n : Hmn, - have H2 : n - k = mn + km, from sub_eq_of_add_eq H, + have H2 : n - k = mn + km, from nat.sub_eq_of_add_eq H, H2 ▸ !le.refl)) -definition sub_lt_self {m n : ℕ} (H1 : m > 0) (H2 : n > 0) : m - n < m := +protected theorem sub_lt_self {m n : ℕ} (H1 : m > 0) (H2 : n > 0) : m - n < m := calc m - n = succ (pred m) - n : succ_pred_of_pos H1 ... = succ (pred m) - succ (pred n) : succ_pred_of_pos H2 @@ -341,127 +343,160 @@ calc ... < succ (pred m) : lt_succ_self ... = m : succ_pred_of_pos H1 -definition le_sub_of_add_le {m n k : ℕ} (H : m + k ≤ n) : m ≤ n - k := +protected theorem le_sub_of_add_le {m n k : ℕ} (H : m + k ≤ n) : m ≤ n - k := calc - m = m + k - k : add_sub_cancel - ... ≤ n - k : sub_le_sub_right H k + m = m + k - k : nat.add_sub_cancel + ... ≤ n - k : nat.sub_le_sub_right H k -definition lt_sub_of_add_lt {m n k : ℕ} (H : m + k < n) (H2 : k ≤ n) : m < n - k := -lt_of_succ_le (le_sub_of_add_le (calc +protected theorem lt_sub_of_add_lt {m n k : ℕ} (H : m + k < n) (H2 : k ≤ n) : m < n - k := +lt_of_succ_le (nat.le_sub_of_add_le (calc succ m + k = succ (m + k) : succ_add_eq_succ_add ... ≤ n : succ_le_of_lt H)) +protected theorem sub_lt_of_lt_add {v n m : nat} (h₁ : v < n + m) (h₂ : n ≤ v) : v - n < m := +have succ v ≤ n + m, from succ_le_of_lt h₁, +have succ (v - n) ≤ m, from + calc succ (v - n) = succ v - n : succ_sub h₂ + ... ≤ n + m - n : nat.sub_le_sub_right this n + ... = m : nat.add_sub_cancel_left, +lt_of_succ_le this + /- distance -/ definition dist [reducible] (n m : ℕ) := (n - m) + (m - n) -definition dist.comm (n m : ℕ) : dist n m = dist m n := +theorem dist.comm (n m : ℕ) : dist n m = dist m n := !add.comm -definition dist_self (n : ℕ) : dist n n = 0 := +theorem dist_self (n : ℕ) : dist n n = 0 := calc - (n - n) + (n - n) = 0 + (n - n) : sub_self - ... = 0 + 0 : sub_self + (n - n) + (n - n) = 0 + (n - n) : nat.sub_self + ... = 0 + 0 : nat.sub_self ... = 0 : rfl -definition eq_of_dist_eq_zero {n m : ℕ} (H : dist n m = 0) : n = m := +theorem eq_of_dist_eq_zero {n m : ℕ} (H : dist n m = 0) : n = m := have H2 : n - m = 0, from eq_zero_of_add_eq_zero_right H, have H3 : n ≤ m, from le_of_sub_eq_zero H2, have H4 : m - n = 0, from eq_zero_of_add_eq_zero_left H, have H5 : m ≤ n, from le_of_sub_eq_zero H4, le.antisymm H3 H5 -definition dist_eq_sub_of_le {n m : ℕ} (H : n ≤ m) : dist n m = m - n := +theorem dist_eq_zero {n m : ℕ} (H : n = m) : dist n m = 0 := +by substvars; rewrite [↑dist, *nat.sub_self, add_zero] + +theorem dist_eq_sub_of_le {n m : ℕ} (H : n ≤ m) : dist n m = m - n := calc dist n m = 0 + (m - n) : {sub_eq_zero_of_le H} ... = m - n : zero_add -definition dist_eq_sub_of_ge {n m : ℕ} (H : n ≥ m) : dist n m = n - m := +theorem dist_eq_sub_of_lt {n m : ℕ} (H : n < m) : dist n m = m - n := +dist_eq_sub_of_le (le_of_lt H) + +theorem dist_eq_sub_of_ge {n m : ℕ} (H : n ≥ m) : dist n m = n - m := !dist.comm ▸ dist_eq_sub_of_le H -definition dist_zero_right (n : ℕ) : dist n 0 = n := -dist_eq_sub_of_ge !zero_le ⬝ !sub_zero +theorem dist_eq_sub_of_gt {n m : ℕ} (H : n > m) : dist n m = n - m := +dist_eq_sub_of_ge (le_of_lt H) -definition dist_zero_left (n : ℕ) : dist 0 n = n := -dist_eq_sub_of_le !zero_le ⬝ !sub_zero +theorem dist_zero_right (n : ℕ) : dist n 0 = n := +dist_eq_sub_of_ge !zero_le ⬝ !nat.sub_zero -definition dist.intro {n m k : ℕ} (H : n + m = k) : dist k n = m := +theorem dist_zero_left (n : ℕ) : dist 0 n = n := +dist_eq_sub_of_le !zero_le ⬝ !nat.sub_zero + +theorem dist.intro {n m k : ℕ} (H : n + m = k) : dist k n = m := calc dist k n = k - n : dist_eq_sub_of_ge (le.intro H) - ... = m : sub_eq_of_add_eq H + ... = m : nat.sub_eq_of_add_eq H -definition dist_add_add_right (n k m : ℕ) : dist (n + k) (m + k) = dist n m := +theorem dist_add_add_right (n k m : ℕ) : dist (n + k) (m + k) = dist n m := calc dist (n + k) (m + k) = ((n+k) - (m+k)) + ((m+k)-(n+k)) : rfl - ... = (n - m) + ((m + k) - (n + k)) : add_sub_add_right - ... = (n - m) + (m - n) : add_sub_add_right + ... = (n - m) + ((m + k) - (n + k)) : nat.add_sub_add_right + ... = (n - m) + (m - n) : nat.add_sub_add_right -definition dist_add_add_left (k n m : ℕ) : dist (k + n) (k + m) = dist n m := -!add.comm ▸ !add.comm ▸ !dist_add_add_right +theorem dist_add_add_left (k n m : ℕ) : dist (k + n) (k + m) = dist n m := +begin rewrite [add.comm k n, add.comm k m]; apply dist_add_add_right end -definition dist_add_eq_of_ge {n m : ℕ} (H : n ≥ m) : dist n m + m = n := +theorem dist_add_eq_of_ge {n m : ℕ} (H : n ≥ m) : dist n m + m = n := calc dist n m + m = n - m + m : {dist_eq_sub_of_ge H} - ... = n : sub_add_cancel H + ... = n : nat.sub_add_cancel H -definition dist_eq_intro {n m k l : ℕ} (H : n + m = k + l) : dist n k = dist l m := +theorem dist_eq_intro {n m k l : ℕ} (H : n + m = k + l) : dist n k = dist l m := calc dist n k = dist (n + m) (k + m) : dist_add_add_right ... = dist (k + l) (k + m) : H ... = dist l m : dist_add_add_left -definition dist_sub_eq_dist_add_left {n m : ℕ} (H : n ≥ m) (k : ℕ) : +theorem dist_sub_eq_dist_add_left {n m : ℕ} (H : n ≥ m) (k : ℕ) : dist (n - m) k = dist n (k + m) := have H2 : n - m + (k + m) = k + n, from calc n - m + (k + m) = n - m + (m + k) : add.comm ... = n - m + m + k : add.assoc - ... = n + k : sub_add_cancel H + ... = n + k : nat.sub_add_cancel H ... = k + n : add.comm, dist_eq_intro H2 -definition dist_sub_eq_dist_add_right {k m : ℕ} (H : k ≥ m) (n : ℕ) : +theorem dist_sub_eq_dist_add_right {k m : ℕ} (H : k ≥ m) (n : ℕ) : dist n (k - m) = dist (n + m) k := (dist_sub_eq_dist_add_left H n ▸ !dist.comm) ▸ !dist.comm -definition dist.triangle_inequality (n m k : ℕ) : dist n k ≤ dist n m + dist m k := -assert (m - k) + ((k - m) + (m - n)) = (m - n) + ((m - k) + (k - m)), - begin - generalize m - k, generalize k - m, generalize m - n, intro x y z, - rewrite [add.comm y x, add.left_comm] - end, +theorem dist.triangle_inequality (n m k : ℕ) : dist n k ≤ dist n m + dist m k := have (n - m) + (m - k) + ((k - m) + (m - n)) = (n - m) + (m - n) + ((m - k) + (k - m)), - by rewrite [add.assoc, this, -add.assoc], -this ▸ add_le_add !sub_lt_sub_add_sub !sub_lt_sub_add_sub +begin rewrite [add.comm (k - m) (m - n), + {n - m + _ + _}add.assoc, + {m - k + _}add.left_comm, -add.assoc] end, +this ▸ add_le_add !nat.sub_lt_sub_add_sub !nat.sub_lt_sub_add_sub -definition dist_add_add_le_add_dist_dist (n m k l : ℕ) : dist (n + m) (k + l) ≤ dist n k + dist m l := -have H : dist (n + m) (k + m) + dist (k + m) (k + l) = dist n k + dist m l, from - !dist_add_add_left ▸ !dist_add_add_right ▸ rfl, -H ▸ !dist.triangle_inequality +theorem dist_add_add_le_add_dist_dist (n m k l : ℕ) : dist (n + m) (k + l) ≤ dist n k + dist m l := +assert H : dist (n + m) (k + m) + dist (k + m) (k + l) = dist n k + dist m l, + by rewrite [dist_add_add_left, dist_add_add_right], +by rewrite -H; apply dist.triangle_inequality theorem dist_mul_right (n k m : ℕ) : dist (n * k) (m * k) = dist n m * k := -assert ∀ n m, dist n m = n - m + (m - n), from take n m, rfl, -by rewrite [this, this n m, mul.right_distrib, *mul_sub_right_distrib] +assert Π n m, dist n m = n - m + (m - n), from take n m, rfl, +by rewrite [this, this n m, right_distrib, *nat.mul_sub_right_distrib] theorem dist_mul_left (k n m : ℕ) : dist (k * n) (k * m) = k * dist n m := -by rewrite [mul.comm k n, mul.comm k m, dist_mul_right, mul.comm] +begin rewrite [mul.comm k n, mul.comm k m, dist_mul_right, mul.comm] end -definition dist_mul_dist (n m k l : ℕ) : dist n m * dist k l = dist (n * k + m * l) (n * l + m * k) := +theorem dist_mul_dist (n m k l : ℕ) : dist n m * dist k l = dist (n * k + m * l) (n * l + m * k) := have aux : Πk l, k ≥ l → dist n m * dist k l = dist (n * k + m * l) (n * l + m * k), from take k l : ℕ, assume H : k ≥ l, - have H2 : m * k ≥ m * l, from mul_le_mul_left H m, + have H2 : m * k ≥ m * l, from !mul_le_mul_left H, have H3 : n * l + m * k ≥ m * l, from le.trans H2 !le_add_left, calc dist n m * dist k l = dist n m * (k - l) : dist_eq_sub_of_ge H ... = dist (n * (k - l)) (m * (k - l)) : dist_mul_right - ... = dist (n * k - n * l) (m * k - m * l) : by rewrite [*mul_sub_left_distrib] - ... = dist (n * k) (m * k - m * l + n * l) : dist_sub_eq_dist_add_left (mul_le_mul_left H n) + ... = dist (n * k - n * l) (m * k - m * l) : by rewrite [*nat.mul_sub_left_distrib] + ... = dist (n * k) (m * k - m * l + n * l) : dist_sub_eq_dist_add_left (!mul_le_mul_left H) ... = dist (n * k) (n * l + (m * k - m * l)) : add.comm - ... = dist (n * k) (n * l + m * k - m * l) : add_sub_assoc H2 (n * l) + ... = dist (n * k) (n * l + m * k - m * l) : nat.add_sub_assoc H2 (n * l) ... = dist (n * k + m * l) (n * l + m * k) : dist_sub_eq_dist_add_right H3 _, -sum.rec_on !le.total +sum.elim !le.total (assume H : k ≤ l, !dist.comm ▸ !dist.comm ▸ aux l k H) (assume H : l ≤ k, aux k l H) +lemma dist_eq_max_sub_min {i j : nat} : dist i j = (max i j) - min i j := +sum.elim (lt_sum_ge i j) + (suppose i < j, + by rewrite [max_eq_right_of_lt this, min_eq_left_of_lt this, dist_eq_sub_of_lt this]) + (suppose i ≥ j, + by rewrite [max_eq_left this , min_eq_right this, dist_eq_sub_of_ge this]) + +lemma dist_succ {i j : nat} : dist (succ i) (succ j) = dist i j := +by rewrite [↑dist, *succ_sub_succ] + +lemma dist_le_max {i j : nat} : dist i j ≤ max i j := +begin rewrite dist_eq_max_sub_min, apply sub_le end + +lemma dist_pos_of_ne {i j : nat} : i ≠ j → dist i j > 0 := +assume Pne, lt.by_cases + (suppose i < j, begin rewrite [dist_eq_sub_of_lt this], apply nat.sub_pos_of_lt this end) + (suppose i = j, by contradiction) + (suppose i > j, begin rewrite [dist_eq_sub_of_gt this], apply nat.sub_pos_of_lt this end) + end nat diff --git a/hott/types/num.hlean b/hott/types/num.hlean new file mode 100644 index 0000000000..dc7b8b10ac --- /dev/null +++ b/hott/types/num.hlean @@ -0,0 +1,523 @@ +/- +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 types.bool tools.helper_tactics +open bool eq eq.ops decidable helper_tactics + +namespace pos_num + theorem succ_not_is_one (a : pos_num) : is_one (succ a) = ff := + pos_num.rec_on a rfl (take n iH, rfl) (take n iH, rfl) + + theorem succ_one : succ one = bit0 one + theorem succ_bit1 (a : pos_num) : succ (bit1 a) = bit0 (succ a) + theorem succ_bit0 (a : pos_num) : succ (bit0 a) = bit1 a + + theorem ne_of_bit0_ne_bit0 {a b : pos_num} (H₁ : bit0 a ≠ bit0 b) : a ≠ b := + suppose a = b, + absurd rfl (this ▸ H₁) + + theorem ne_of_bit1_ne_bit1 {a b : pos_num} (H₁ : bit1 a ≠ bit1 b) : a ≠ b := + suppose a = b, + absurd rfl (this ▸ H₁) + + theorem pred_succ : Π (a : pos_num), pred (succ a) = a + | one := rfl + | (bit0 a) := by rewrite succ_bit0 + | (bit1 a) := + calc + pred (succ (bit1 a)) = cond (is_one (succ a)) one (bit1 (pred (succ a))) : rfl + ... = cond ff one (bit1 (pred (succ a))) : succ_not_is_one + ... = bit1 (pred (succ a)) : rfl + ... = bit1 a : pred_succ a + + section + variables (a b : pos_num) + + theorem one_add_one : one + one = bit0 one + theorem one_add_bit0 : one + (bit0 a) = bit1 a + theorem one_add_bit1 : one + (bit1 a) = succ (bit1 a) + theorem bit0_add_one : (bit0 a) + one = bit1 a + theorem bit1_add_one : (bit1 a) + one = succ (bit1 a) + theorem bit0_add_bit0 : (bit0 a) + (bit0 b) = bit0 (a + b) + theorem bit0_add_bit1 : (bit0 a) + (bit1 b) = bit1 (a + b) + theorem bit1_add_bit0 : (bit1 a) + (bit0 b) = bit1 (a + b) + theorem bit1_add_bit1 : (bit1 a) + (bit1 b) = succ (bit1 (a + b)) + theorem one_mul : one * a = a + end + + theorem mul_one : Π a, a * one = a + | one := rfl + | (bit1 n) := + calc bit1 n * one = bit0 (n * one) + one : rfl + ... = bit0 n + one : mul_one n + ... = bit1 n : bit0_add_one + | (bit0 n) := + calc bit0 n * one = bit0 (n * one) : rfl + ... = bit0 n : mul_one n + + theorem decidable_eq [instance] : Π (a b : pos_num), decidable (a = b) + | one one := inl rfl + | one (bit0 b) := inr (by contradiction) + | one (bit1 b) := inr (by contradiction) + | (bit0 a) one := inr (by contradiction) + | (bit0 a) (bit0 b) := + match decidable_eq a b with + | inl H₁ := inl (by rewrite H₁) + | inr H₁ := inr (by intro H; injection H; contradiction) + end + | (bit0 a) (bit1 b) := inr (by contradiction) + | (bit1 a) one := inr (by contradiction) + | (bit1 a) (bit0 b) := inr (by contradiction) + | (bit1 a) (bit1 b) := + match decidable_eq a b with + | inl H₁ := inl (by rewrite H₁) + | inr H₁ := inr (by intro H; injection H; contradiction) + end + + local notation a < b := (lt a b = tt) + local notation a ` ≮ `:50 b:50 := (lt a b = ff) + + theorem lt_one_right_eq_ff : Π a : pos_num, a ≮ one + | one := rfl + | (bit0 a) := rfl + | (bit1 a) := rfl + + theorem lt_one_succ_eq_tt : Π a : pos_num, one < succ a + | one := rfl + | (bit0 a) := rfl + | (bit1 a) := rfl + + theorem lt_of_lt_bit0_bit0 {a b : pos_num} (H : bit0 a < bit0 b) : a < b := H + theorem lt_of_lt_bit0_bit1 {a b : pos_num} (H : bit1 a < bit0 b) : a < b := H + theorem lt_of_lt_bit1_bit1 {a b : pos_num} (H : bit1 a < bit1 b) : a < b := H + theorem lt_of_lt_bit1_bit0 {a b : pos_num} (H : bit0 a < bit1 b) : a < succ b := H + + theorem lt_bit0_bit0_eq_lt (a b : pos_num) : lt (bit0 a) (bit0 b) = lt a b := + rfl + + theorem lt_bit1_bit1_eq_lt (a b : pos_num) : lt (bit1 a) (bit1 b) = lt a b := + rfl + + theorem lt_bit1_bit0_eq_lt (a b : pos_num) : lt (bit1 a) (bit0 b) = lt a b := + rfl + + theorem lt_bit0_bit1_eq_lt_succ (a b : pos_num) : lt (bit0 a) (bit1 b) = lt a (succ b) := + rfl + + theorem lt_irrefl : Π (a : pos_num), a ≮ a + | one := rfl + | (bit0 a) := + begin + rewrite lt_bit0_bit0_eq_lt, apply lt_irrefl + end + | (bit1 a) := + begin + rewrite lt_bit1_bit1_eq_lt, apply lt_irrefl + end + + theorem ne_of_lt_eq_tt : Π {a b : pos_num}, a < b → a = b → empty + | one ⌞one⌟ H₁ (eq.refl one) := absurd H₁ ff_ne_tt + | (bit0 a) ⌞(bit0 a)⌟ H₁ (eq.refl (bit0 a)) := + begin + rewrite lt_bit0_bit0_eq_lt at H₁, + apply ne_of_lt_eq_tt H₁ (eq.refl a) + end + | (bit1 a) ⌞(bit1 a)⌟ H₁ (eq.refl (bit1 a)) := + begin + rewrite lt_bit1_bit1_eq_lt at H₁, + apply ne_of_lt_eq_tt H₁ (eq.refl a) + end + + theorem lt_base : Π a : pos_num, a < succ a + | one := rfl + | (bit0 a) := + begin + rewrite [succ_bit0, lt_bit0_bit1_eq_lt_succ], + apply lt_base + end + | (bit1 a) := + begin + rewrite [succ_bit1, lt_bit1_bit0_eq_lt], + apply lt_base + end + + theorem lt_step : Π {a b : pos_num}, a < b → a < succ b + | one one H := rfl + | one (bit0 b) H := rfl + | one (bit1 b) H := rfl + | (bit0 a) one H := absurd H ff_ne_tt + | (bit0 a) (bit0 b) H := + begin + rewrite [succ_bit0, lt_bit0_bit1_eq_lt_succ, lt_bit0_bit0_eq_lt at H], + apply lt_step H + end + | (bit0 a) (bit1 b) H := + begin + rewrite [succ_bit1, lt_bit0_bit0_eq_lt, lt_bit0_bit1_eq_lt_succ at H], + exact H + end + | (bit1 a) one H := absurd H ff_ne_tt + | (bit1 a) (bit0 b) H := + begin + rewrite [succ_bit0, lt_bit1_bit1_eq_lt, lt_bit1_bit0_eq_lt at H], + exact H + end + | (bit1 a) (bit1 b) H := + begin + rewrite [succ_bit1, lt_bit1_bit0_eq_lt, lt_bit1_bit1_eq_lt at H], + apply lt_step H + end + + theorem lt_of_lt_succ_succ : Π {a b : pos_num}, succ a < succ b → a < b + | one one H := absurd H ff_ne_tt + | one (bit0 b) H := rfl + | one (bit1 b) H := rfl + | (bit0 a) one H := + begin + rewrite [succ_bit0 at H, succ_one at H, lt_bit1_bit0_eq_lt at H], + apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff a) H + end + | (bit0 a) (bit0 b) H := by exact H + | (bit0 a) (bit1 b) H := by exact H + | (bit1 a) one H := + begin + rewrite [succ_bit1 at H, succ_one at H, lt_bit0_bit0_eq_lt at H], + apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff (succ a)) H + end + | (bit1 a) (bit0 b) H := + begin + rewrite [succ_bit1 at H, succ_bit0 at H, lt_bit0_bit1_eq_lt_succ at H], + rewrite lt_bit1_bit0_eq_lt, + apply lt_of_lt_succ_succ H + end + | (bit1 a) (bit1 b) H := + begin + rewrite [lt_bit1_bit1_eq_lt, *succ_bit1 at H, lt_bit0_bit0_eq_lt at H], + apply lt_of_lt_succ_succ H + end + + theorem lt_succ_succ : Π {a b : pos_num}, a < b → succ a < succ b + | one one H := absurd H ff_ne_tt + | one (bit0 b) H := + begin + rewrite [succ_bit0, succ_one, lt_bit0_bit1_eq_lt_succ], + apply lt_one_succ_eq_tt + end + | one (bit1 b) H := + begin + rewrite [succ_one, succ_bit1, lt_bit0_bit0_eq_lt], + apply lt_one_succ_eq_tt + end + | (bit0 a) one H := absurd H ff_ne_tt + | (bit0 a) (bit0 b) H := by exact H + | (bit0 a) (bit1 b) H := by exact H + | (bit1 a) one H := absurd H ff_ne_tt + | (bit1 a) (bit0 b) H := + begin + rewrite [succ_bit1, succ_bit0, lt_bit0_bit1_eq_lt_succ, lt_bit1_bit0_eq_lt at H], + apply lt_succ_succ H + end + | (bit1 a) (bit1 b) H := + begin + rewrite [lt_bit1_bit1_eq_lt at H, *succ_bit1, lt_bit0_bit0_eq_lt], + apply lt_succ_succ H + end + + theorem lt_of_lt_succ : Π {a b : pos_num}, succ a < b → a < b + | one one H := absurd_of_eq_ff_of_eq_tt !lt_one_right_eq_ff H + | one (bit0 b) H := rfl + | one (bit1 b) H := rfl + | (bit0 a) one H := absurd_of_eq_ff_of_eq_tt !lt_one_right_eq_ff H + | (bit0 a) (bit0 b) H := by exact H + | (bit0 a) (bit1 b) H := + begin + rewrite [succ_bit0 at H, lt_bit1_bit1_eq_lt at H, lt_bit0_bit1_eq_lt_succ], + apply lt_step H + end + | (bit1 a) one H := absurd_of_eq_ff_of_eq_tt !lt_one_right_eq_ff H + | (bit1 a) (bit0 b) H := + begin + rewrite [lt_bit1_bit0_eq_lt, succ_bit1 at H, lt_bit0_bit0_eq_lt at H], + apply lt_of_lt_succ H + end + | (bit1 a) (bit1 b) H := + begin + rewrite [succ_bit1 at H, lt_bit0_bit1_eq_lt_succ at H, lt_bit1_bit1_eq_lt], + apply lt_of_lt_succ_succ H + end + + theorem lt_of_lt_succ_of_ne : Π {a b : pos_num}, a < succ b → a ≠ b → a < b + | one one H₁ H₂ := absurd rfl H₂ + | one (bit0 b) H₁ H₂ := rfl + | one (bit1 b) H₁ H₂ := rfl + | (bit0 a) one H₁ H₂ := + begin + rewrite [succ_one at H₁, lt_bit0_bit0_eq_lt at H₁], + apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₁ + end + | (bit0 a) (bit0 b) H₁ H₂ := + begin + rewrite [lt_bit0_bit0_eq_lt, succ_bit0 at H₁, lt_bit0_bit1_eq_lt_succ at H₁], + apply lt_of_lt_succ_of_ne H₁ (ne_of_bit0_ne_bit0 H₂) + end + | (bit0 a) (bit1 b) H₁ H₂ := + begin + rewrite [succ_bit1 at H₁, lt_bit0_bit0_eq_lt at H₁, lt_bit0_bit1_eq_lt_succ], + exact H₁ + end + | (bit1 a) one H₁ H₂ := + begin + rewrite [succ_one at H₁, lt_bit1_bit0_eq_lt at H₁], + apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₁ + end + | (bit1 a) (bit0 b) H₁ H₂ := + begin + rewrite [succ_bit0 at H₁, lt_bit1_bit1_eq_lt at H₁, lt_bit1_bit0_eq_lt], + exact H₁ + end + | (bit1 a) (bit1 b) H₁ H₂ := + begin + rewrite [succ_bit1 at H₁, lt_bit1_bit0_eq_lt at H₁, lt_bit1_bit1_eq_lt], + apply lt_of_lt_succ_of_ne H₁ (ne_of_bit1_ne_bit1 H₂) + end + + theorem lt_trans : Π {a b c : pos_num}, a < b → b < c → a < c + | one b (bit0 c) H₁ H₂ := rfl + | one b (bit1 c) H₁ H₂ := rfl + | a (bit0 b) one H₁ H₂ := absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₂ + | a (bit1 b) one H₁ H₂ := absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₂ + | (bit0 a) (bit0 b) (bit0 c) H₁ H₂ := + begin + rewrite lt_bit0_bit0_eq_lt at *, apply lt_trans H₁ H₂ + end + | (bit0 a) (bit0 b) (bit1 c) H₁ H₂ := + begin + rewrite [lt_bit0_bit1_eq_lt_succ at *, lt_bit0_bit0_eq_lt at H₁], + apply lt_trans H₁ H₂ + end + | (bit0 a) (bit1 b) (bit0 c) H₁ H₂ := + begin + rewrite [lt_bit0_bit1_eq_lt_succ at H₁, lt_bit1_bit0_eq_lt at H₂, lt_bit0_bit0_eq_lt], + apply @by_cases (a = b), + begin + intro H, rewrite -H at H₂, exact H₂ + end, + begin + intro H, + apply lt_trans (lt_of_lt_succ_of_ne H₁ H) H₂ + end + end + | (bit0 a) (bit1 b) (bit1 c) H₁ H₂ := + begin + rewrite [lt_bit0_bit1_eq_lt_succ at *, lt_bit1_bit1_eq_lt at H₂], + apply lt_trans H₁ (lt_succ_succ H₂) + end + | (bit1 a) (bit0 b) (bit0 c) H₁ H₂ := + begin + rewrite [lt_bit0_bit0_eq_lt at H₂, lt_bit1_bit0_eq_lt at *], + apply lt_trans H₁ H₂ + end + | (bit1 a) (bit0 b) (bit1 c) H₁ H₂ := + begin + rewrite [lt_bit1_bit0_eq_lt at H₁, lt_bit0_bit1_eq_lt_succ at H₂, lt_bit1_bit1_eq_lt], + apply @by_cases (b = c), + begin + intro H, rewrite H at H₁, exact H₁ + end, + begin + intro H, + apply lt_trans H₁ (lt_of_lt_succ_of_ne H₂ H) + end + end + | (bit1 a) (bit1 b) (bit0 c) H₁ H₂ := + begin + rewrite [lt_bit1_bit1_eq_lt at H₁, lt_bit1_bit0_eq_lt at H₂, lt_bit1_bit0_eq_lt], + apply lt_trans H₁ H₂ + end + | (bit1 a) (bit1 b) (bit1 c) H₁ H₂ := + begin + rewrite lt_bit1_bit1_eq_lt at *, + apply lt_trans H₁ H₂ + end + + theorem lt_antisymm : Π {a b : pos_num}, a < b → b ≮ a + | one one H := rfl + | one (bit0 b) H := rfl + | one (bit1 b) H := rfl + | (bit0 a) one H := absurd H ff_ne_tt + | (bit0 a) (bit0 b) H := + begin + rewrite lt_bit0_bit0_eq_lt at *, + apply lt_antisymm H + end + | (bit0 a) (bit1 b) H := + begin + rewrite lt_bit1_bit0_eq_lt, + rewrite lt_bit0_bit1_eq_lt_succ at H, + have H₁ : succ b ≮ a, from lt_antisymm H, + apply eq_ff_of_ne_tt, + intro H₂, + apply @by_cases (succ b = a), + show succ b = a → empty, + begin + intro Hp, + rewrite -Hp at H, + apply absurd_of_eq_ff_of_eq_tt (lt_irrefl (succ b)) H + end, + show succ b ≠ a → empty, + begin + intro Hn, + have H₃ : succ b < succ a, from lt_succ_succ H₂, + have H₄ : succ b < a, from lt_of_lt_succ_of_ne H₃ Hn, + apply absurd_of_eq_ff_of_eq_tt H₁ H₄ + end, + end + | (bit1 a) one H := absurd H ff_ne_tt + | (bit1 a) (bit0 b) H := + begin + rewrite lt_bit0_bit1_eq_lt_succ, + rewrite lt_bit1_bit0_eq_lt at H, + have H₁ : lt b a = ff, from lt_antisymm H, + apply eq_ff_of_ne_tt, + intro H₂, + apply @by_cases (b = a), + show b = a → empty, + begin + intro Hp, + rewrite -Hp at H, + apply absurd_of_eq_ff_of_eq_tt (lt_irrefl b) H + end, + show b ≠ a → empty, + begin + intro Hn, + have H₃ : b < a, from lt_of_lt_succ_of_ne H₂ Hn, + apply absurd_of_eq_ff_of_eq_tt H₁ H₃ + end, + end + | (bit1 a) (bit1 b) H := + begin + rewrite lt_bit1_bit1_eq_lt at *, + apply lt_antisymm H + end + + local notation a ≤ b := (le a b = tt) + + theorem le_refl : Π a : pos_num, a ≤ a := + lt_base + + theorem le_eq_lt_succ {a b : pos_num} : le a b = lt a (succ b) := + rfl + + theorem not_lt_of_le : Π {a b : pos_num}, a ≤ b → b < a → empty + | one one H₁ H₂ := absurd H₂ ff_ne_tt + | one (bit0 b) H₁ H₂ := absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₂ + | one (bit1 b) H₁ H₂ := absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₂ + | (bit0 a) one H₁ H₂ := + begin + rewrite [le_eq_lt_succ at H₁, succ_one at H₁, lt_bit0_bit0_eq_lt at H₁], + apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₁ + end + | (bit0 a) (bit0 b) H₁ H₂ := + begin + rewrite [le_eq_lt_succ at H₁, succ_bit0 at H₁, lt_bit0_bit1_eq_lt_succ at H₁], + rewrite [lt_bit0_bit0_eq_lt at H₂], + apply not_lt_of_le H₁ H₂ + end + | (bit0 a) (bit1 b) H₁ H₂ := + begin + rewrite [le_eq_lt_succ at H₁, succ_bit1 at H₁, lt_bit0_bit0_eq_lt at H₁], + rewrite [lt_bit1_bit0_eq_lt at H₂], + apply not_lt_of_le H₁ H₂ + end + | (bit1 a) one H₁ H₂ := + begin + rewrite [le_eq_lt_succ at H₁, succ_one at H₁, lt_bit1_bit0_eq_lt at H₁], + apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff _) H₁ + end + | (bit1 a) (bit0 b) H₁ H₂ := + begin + rewrite [le_eq_lt_succ at H₁, succ_bit0 at H₁, lt_bit1_bit1_eq_lt at H₁], + rewrite lt_bit0_bit1_eq_lt_succ at H₂, + have H₃ : a < succ b, from lt_step H₁, + apply @by_cases (b = a), + begin + intro Hba, rewrite -Hba at H₁, + apply absurd_of_eq_ff_of_eq_tt (lt_irrefl b) H₁ + end, + begin + intro Hnba, + have H₄ : b < a, from lt_of_lt_succ_of_ne H₂ Hnba, + apply not_lt_of_le H₃ H₄ + end + end + | (bit1 a) (bit1 b) H₁ H₂ := + begin + rewrite [le_eq_lt_succ at H₁, succ_bit1 at H₁, lt_bit1_bit0_eq_lt at H₁], + rewrite [lt_bit1_bit1_eq_lt at H₂], + apply not_lt_of_le H₁ H₂ + end + + theorem le_antisymm : Π {a b : pos_num}, a ≤ b → b ≤ a → a = b + | one one H₁ H₂ := rfl + | one (bit0 b) H₁ H₂ := + by apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff b) H₂ + | one (bit1 b) H₁ H₂ := + by apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff b) H₂ + | (bit0 a) one H₁ H₂ := + by apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff a) H₁ + | (bit0 a) (bit0 b) H₁ H₂ := + begin + rewrite [le_eq_lt_succ at *, succ_bit0 at *, lt_bit0_bit1_eq_lt_succ at *], + have H : a = b, from le_antisymm H₁ H₂, + rewrite H + end + | (bit0 a) (bit1 b) H₁ H₂ := + begin + rewrite [le_eq_lt_succ at *, succ_bit1 at H₁, succ_bit0 at H₂], + rewrite [lt_bit0_bit0_eq_lt at H₁, lt_bit1_bit1_eq_lt at H₂], + apply empty.rec _ (not_lt_of_le H₁ H₂) + end + | (bit1 a) one H₁ H₂ := + by apply absurd_of_eq_ff_of_eq_tt (lt_one_right_eq_ff a) H₁ + | (bit1 a) (bit0 b) H₁ H₂ := + begin + rewrite [le_eq_lt_succ at *, succ_bit0 at H₁, succ_bit1 at H₂], + rewrite [lt_bit1_bit1_eq_lt at H₁, lt_bit0_bit0_eq_lt at H₂], + apply empty.rec _ (not_lt_of_le H₂ H₁) + end + | (bit1 a) (bit1 b) H₁ H₂ := + begin + rewrite [le_eq_lt_succ at *, succ_bit1 at *, lt_bit1_bit0_eq_lt at *], + have H : a = b, from le_antisymm H₁ H₂, + rewrite H + end + + theorem le_trans {a b c : pos_num} : a ≤ b → b ≤ c → a ≤ c := + begin + intro H₁ H₂, + rewrite [le_eq_lt_succ at *], + apply @by_cases (a = b), + begin + intro Hab, rewrite Hab, exact H₂ + end, + begin + intro Hnab, + have Haltb : a < b, from lt_of_lt_succ_of_ne H₁ Hnab, + apply lt_trans Haltb H₂ + end, + end + +end pos_num + +namespace num + open pos_num + + theorem decidable_eq [instance] : Π (a b : num), decidable (a = b) + | zero zero := inl rfl + | zero (pos b) := inr (by contradiction) + | (pos a) zero := inr (by contradiction) + | (pos a) (pos b) := + if H : a = b then inl (by rewrite H) else inr (suppose pos a = pos b, begin injection this, contradiction end) +end num diff --git a/hott/types/pointed.hlean b/hott/types/pointed.hlean index db4d158676..5a7c3d0e8d 100644 --- a/hott/types/pointed.hlean +++ b/hott/types/pointed.hlean @@ -7,7 +7,7 @@ Ported from Coq HoTT -/ import arity .eq .bool .unit .sigma .nat.basic -open is_trunc eq prod sigma nat equiv option is_equiv bool unit +open is_trunc eq prod sigma nat equiv option is_equiv bool unit algebra structure pointed [class] (A : Type) := (point : A) @@ -134,7 +134,7 @@ namespace pointed end definition pid [constructor] (A : Type*) : A →* A := - pmap.mk function.id idp + pmap.mk id idp definition pcompose [constructor] (g : B →* C) (f : A →* B) : A →* C := pmap.mk (λa, g (f a)) (ap g (respect_pt f) ⬝ respect_pt g) @@ -273,7 +273,7 @@ namespace pointed Ω[succ n](Pointed.mk p) = Ω[n](Ω (Pointed.mk p)) : loop_space_succ_eq_in ... = Ω[n] (Ω[2] A) : loop_space_loop_irrel ... = Ω[2+n] A : loop_space_add - ... = Ω[n+2] A : add.comm + ... = Ω[n+2] A : by rewrite [algebra.add.comm] -- TODO: -- definition apn_compose (n : ℕ) (g : B →* C) (f : A →* B) : apn n (g ∘* f) ~* apn n g ∘* apn n f := diff --git a/hott/types/trunc.hlean b/hott/types/trunc.hlean index f3212cac37..e2113c372c 100644 --- a/hott/types/trunc.hlean +++ b/hott/types/trunc.hlean @@ -152,13 +152,13 @@ namespace is_trunc revert A, induction n with n IH, { intro A, esimp [Iterated_loop_space], transitivity _, { apply is_trunc_succ_iff_is_trunc_loop, apply le.refl}, - { apply iff.pi_iff_pi, intro a, esimp, apply is_hprop_iff_is_contr, reflexivity}}, + { apply pi_iff_pi, intro a, esimp, apply is_hprop_iff_is_contr, reflexivity}}, { intro A, esimp [Iterated_loop_space], transitivity _, apply @is_trunc_succ_iff_is_trunc_loop @n, esimp, constructor, - apply iff.pi_iff_pi, intro a, transitivity _, apply IH, - transitivity _, apply iff.pi_iff_pi, intro p, + apply pi_iff_pi, intro a, transitivity _, apply IH, + transitivity _, apply pi_iff_pi, intro p, rewrite [iterated_loop_space_loop_irrel n p], apply iff.refl, esimp, - apply iff.imp_iff, reflexivity} + apply imp_iff, reflexivity} end theorem is_trunc_iff_is_contr_loop (n : ℕ) (A : Type) diff --git a/hott/types/unit.hlean b/hott/types/unit.hlean index dc121d6850..090f14c734 100644 --- a/hott/types/unit.hlean +++ b/hott/types/unit.hlean @@ -6,8 +6,6 @@ Authors: Floris van Doorn Theorems about the unit type -/ -import algebra.group - open equiv option eq namespace unit @@ -36,15 +34,3 @@ namespace unit end unit open unit is_trunc - -namespace algebra - - definition trivial_group [constructor] : group unit := - group.mk (λx y, star) _ (λx y z, idp) star (unit.rec idp) (unit.rec idp) (λx, star) (λx, idp) - - definition Trivial_group [constructor] : Group := - Group.mk _ trivial_group - - notation `G0` := Trivial_group - -end algebra diff --git a/library/algebra/order.lean b/library/algebra/order.lean index 1e300c813c..33cd557dcf 100644 --- a/library/algebra/order.lean +++ b/library/algebra/order.lean @@ -23,6 +23,8 @@ section theorem le.refl (a : A) : a ≤ a := !weak_order.le_refl + theorem le_of_eq {a b : A} (H : a = b) : a ≤ b := H ▸ le.refl a + theorem le.trans [trans] {a b c : A} : a ≤ b → b ≤ c → a ≤ c := !weak_order.le_trans theorem ge.trans [trans] {a b c : A} (H1 : a ≥ b) (H2: b ≥ c) : a ≥ c := le.trans H2 H1 @@ -218,6 +220,9 @@ section (assume H, H1 H) (assume H, or.elim H (assume H', H2 H') (assume H', H3 H')) + definition lt_ge_by_cases {a b : A} {P : Prop} (H1 : a < b → P) (H2 : a ≥ b → P) : P := + lt.by_cases H1 (λH, H2 (H ▸ le.refl a)) (λH, H2 (le_of_lt H)) + theorem le_of_not_gt {a b : A} (H : ¬ a > b) : a ≤ b := lt.by_cases (assume H', absurd H' H) (assume H', H' ▸ !le.refl) (assume H', le_of_lt H') diff --git a/library/data/int/basic.lean b/library/data/int/basic.lean index edbfc1ef16..f549ef27ea 100644 --- a/library/data/int/basic.lean +++ b/library/data/int/basic.lean @@ -25,8 +25,7 @@ following: padd_congr (p p' q q' : ℕ × ℕ) (H1 : p ≡ p') (H2 : q ≡ q') : padd p q ≡ p' q' -/ -import data.nat.basic data.nat.order data.nat.sub data.prod -import algebra.relation algebra.binary algebra.ordered_ring +import data.nat.sub algebra.relation data.prod open eq.ops open prod relation nat open decidable binary @@ -495,9 +494,11 @@ private theorem pmul_assoc_prep {p1 p2 q1 q2 r1 r2 : ℕ} : ((p1*q1+p2*q2)*r1+(p1*q2+p2*q1)*r2, (p1*q1+p2*q2)*r2+(p1*q2+p2*q1)*r1) = (p1*(q1*r1+q2*r2)+p2*(q1*r2+q2*r1), p1*(q1*r2+q2*r1)+p2*(q1*r1+q2*r2)) := begin - rewrite[+left_distrib,+right_distrib,*mul.assoc], - exact (congr_arg2 pair (!add.comm4 ⬝ (!congr_arg !nat.add_comm)) - (!add.comm4 ⬝ (!congr_arg !nat.add_comm))) + rewrite [+left_distrib, +right_distrib, *mul.assoc], + rewrite (add.comm4 (p1 * (q1 * r1)) (p2 * (q2 * r1)) (p1 * (q2 * r2)) (p2 * (q1 * r2))), + rewrite (add.comm (p2 * (q2 * r1)) (p2 * (q1 * r2))), + rewrite (add.comm4 (p1 * (q1 * r2)) (p2 * (q2 * r2)) (p1 * (q2 * r1)) (p2 * (q1 * r1))), + rewrite (add.comm (p2 * (q2 * r2)) (p2 * (q1 * r1))) end theorem pmul_assoc (p q r: ℕ × ℕ) : pmul (pmul p q) r = pmul p (pmul q r) := pmul_assoc_prep @@ -592,6 +593,7 @@ by rewrite [neg_succ_of_nat_eq, neg_add] definition succ (a : ℤ) := a + (succ zero) definition pred (a : ℤ) := a - (succ zero) +definition nat_succ_eq_int_succ (n : ℕ) : nat.succ n = int.succ n := rfl theorem pred_succ (a : ℤ) : pred (succ a) = a := !sub_add_cancel theorem succ_pred (a : ℤ) : succ (pred a) = a := !add_sub_cancel diff --git a/library/data/nat/basic.lean b/library/data/nat/basic.lean index 48d18fd197..055c4ab763 100644 --- a/library/data/nat/basic.lean +++ b/library/data/nat/basic.lean @@ -5,7 +5,7 @@ Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad Basic operations on the natural numbers. -/ -import logic.connectives data.num algebra.binary algebra.ring +import ..num algebra.ring open binary eq.ops namespace nat diff --git a/library/data/nat/order.lean b/library/data/nat/order.lean index 2fdce70a94..013b979b1b 100644 --- a/library/data/nat/order.lean +++ b/library/data/nat/order.lean @@ -5,7 +5,7 @@ Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad The order relation on the natural numbers. -/ -import data.nat.basic algebra.ordered_ring +import .basic algebra.ordered_ring open eq.ops namespace nat @@ -269,7 +269,7 @@ or.elim !eq_zero_or_pos (take H2 : n = 0, by contradiction) (take H2 : n > 0, H2 theorem ne_zero_of_pos {n : ℕ} (H : n > 0) : n ≠ 0 := ne.symm (ne_of_lt H) -theorem exists_eq_succ_of_pos {n : ℕ} (H : n > 0) : exists l, n = succ l := +theorem exists_eq_succ_of_pos {n : ℕ} (H : n > 0) : ∃l, n = succ l := exists_eq_succ_of_lt H theorem pos_of_dvd_of_pos {m n : ℕ} (H1 : m ∣ n) (H2 : n > 0) : m > 0 := diff --git a/library/logic/connectives.lean b/library/logic/connectives.lean index 73478095e5..820c86030f 100644 --- a/library/logic/connectives.lean +++ b/library/logic/connectives.lean @@ -145,8 +145,13 @@ iff.trans (iff.trans !or.comm !or.left_distrib) (and_congr !or.comm !or.comm) definition iff.def : (a ↔ b) = ((a → b) ∧ (b → a)) := rfl -theorem forall_imp_forall {A : Type} {P Q : A → Prop} (H : ∀a, (P a → Q a)) (p : ∀a, P a) (a : A) : Q a := +theorem forall_imp_forall {A : Type} {P Q : A → Prop} (H : ∀a, (P a → Q a)) (p : ∀a, P a) (a : A) + : Q a := (H a) (p a) +theorem forall_iff_forall {A : Type} {P Q : A → Prop} (H : ∀a, (P a ↔ Q a)) + : (∀a, P a) ↔ (∀a, Q a) := +iff.intro (λp a, iff.elim_left (H a) (p a)) (λq a, iff.elim_right (H a) (q a)) + theorem imp_iff {P : Prop} (Q : Prop) (p : P) : (P → Q) ↔ Q := iff.intro (λf, f p) imp.intro diff --git a/script/port.sh b/script/port.sh deleted file mode 100755 index a50a0b3dec..0000000000 --- a/script/port.sh +++ /dev/null @@ -1,16 +0,0 @@ -# usage: -# Make sure port.sh and port.pl are executable (chmod u+x port.pl port.sh) -# in the scripts directory, type ./port.sh to port the files specified below -# from the standard library to the HoTT library -# This file requires both port.pl and port.txt to be in the scripts folder -# -# WARNING: This will overwrite all destination files without warning! -# -# See port.pl for the syntax, if you want to add new files to port. - -now=$(date +"%B %d, %Y") -./port.pl ../library/data/nat/basic.lean ../hott/types/nat/basic2.hlean "Module: data.nat.basic" "Module: types.nat.basic -(Ported from standard library file data.nat.basic on $now)" "import logic.connectives data.num algebra.binary algebra.ring" "import algebra.ring" "open binary eq.ops" "open core prod binary" "nat.no_confusion H \(λe, e\)" "lift.down (nat.no_confusion H (λe, e))" - -# ./port.pl ../library/logic/connectives.lean ../hott/logic.hlean -/port.pl ../library/algebra/ring.lean ../hott/algebra/ring.hlean "import logic.eq logic.connectives data.unit data.sigma data.prod" "import algebra.group" "import algebra.function algebra.binary algebra.group" "" "open eq eq.ops" "open core" diff --git a/script/port.txt b/script/port.txt index 36ebea1a85..f7a63c18ed 100644 --- a/script/port.txt +++ b/script/port.txt @@ -8,32 +8,35 @@ false:empty induction_on:rec_on ∨;⊎ -or.elim:sum.elim -or.inl:sum.inl -or.inr:sum.inr +or:sum +sum.intro_left _;sum.inl +sum.intro_right _;sum.inr + or.intro_left _;sum.inl or.intro_right _;sum.inr -or_resolve_right:sum_resolve_right -or_resolve_left:sum_resolve_left -or.swap:sum.swap -or.rec_on:sum.rec_on -or_of_or_of_imp_of_imp:sum_of_sum_of_imp_of_imp -or_of_or_of_imp_left:sum_of_sum_of_imp_left -or_of_or_of_imp_right:sum_of_sum_of_imp_right ∧;× +and:prod + and.intro:pair -and.left: and.elim_left:prod.pr1 and.left:prod.pr1 and.elim_right:prod.pr2 and.right:prod.pr2 +prod.intro:pair +prod.elim_left:prod.pr1 +prod.left:prod.pr1 +prod.elim_right:prod.pr2 +prod.right:prod.pr2 + + ∀;Π ∃;Σ exists.intro:sigma.mk exists.elim:sigma.rec_on +Exists.rec:sigma.rec eq.symm:inverse congr_arg:ap