diff --git a/hott/algebra/algebra.md b/hott/algebra/algebra.md index d0fc3578a..28741baf9 100644 --- a/hott/algebra/algebra.md +++ b/hott/algebra/algebra.md @@ -1,16 +1,20 @@ algebra ======= -The following files are ported from the standard library. If anything needs to be changed, it is probably a good idea to change it in the standard library and then port the file again (see also [script/port.pl](../../script/port.pl)). +The following files are [ported](port.md) from the standard library. If anything needs to be changed, it is probably a good idea to change it in the standard library and then port the file again (see also [script/port.pl](../../script/port.pl)). -* [binary](binary.hlean) : properties of binary operations -* [relation](relation.hlean) : properties of relations -* [group](group.hlean) -* [ring](ring.hlean) -* [order](order.hlean) -* [ordered_group](ordered_group.hlean) -* [ordered_ring](ordered_ring.hlean) -* [field](field.hlean) +* [priority](priority.lean) : priority for algebraic operations +* [relation](relation.lean) +* [binary](binary.lean) : binary operations +* [order](order.lean) +* [lattice](lattice.lean) +* [group](group.lean) +* [ring](ring.lean) +* [ordered_group](ordered_group.lean) +* [ordered_ring](ordered_ring.lean) +* [field](field.lean) +* [ordered_field](ordered_field.lean) +* [bundled](bundled.lean) : bundled versions of the algebraic structures Files which are not ported: @@ -19,6 +23,6 @@ Files which are not ported: * [homotopy_group](homotopy_group.hlean) : homotopy groups of a pointed type * [e_closure](e_closure.hlean) : the type of words formed by a relation -Subfolders: +Subfolders (not ported): * [category](category/category.md) : Category Theory diff --git a/hott/algebra/binary.hlean b/hott/algebra/binary.hlean index f6b4327b5..7f11d3c6e 100644 --- a/hott/algebra/binary.hlean +++ b/hott/algebra/binary.hlean @@ -1,12 +1,11 @@ /- -Copyright (c) 2014-15 Microsoft Corporation. All rights reserved. +Copyright (c) 2014 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad General properties of binary operations. -/ - -open eq.ops function equiv +open eq.ops function namespace binary section @@ -15,31 +14,30 @@ namespace binary local notation a * b := op₁ a b local notation a ⁻¹ := inv a - local notation 1 := one - definition commutative [reducible] := ∀a b, a * b = b * a - definition associative [reducible] := ∀a b c, (a * b) * c = a * (b * c) - definition left_identity [reducible] := ∀a, 1 * a = a - definition right_identity [reducible] := ∀a, a * 1 = a - definition left_inverse [reducible] := ∀a, a⁻¹ * a = 1 - definition right_inverse [reducible] := ∀a, a * a⁻¹ = 1 - definition left_cancelative [reducible] := ∀a b c, a * b = a * c → b = c - definition right_cancelative [reducible] := ∀a b c, a * b = c * b → a = c + definition commutative [reducible] := Πa b, a * b = b * a + definition associative [reducible] := Πa b c, (a * b) * c = a * (b * c) + definition left_identity [reducible] := Πa, one * a = a + definition right_identity [reducible] := Πa, a * one = a + definition left_inverse [reducible] := Πa, a⁻¹ * a = one + definition right_inverse [reducible] := Πa, a * a⁻¹ = one + definition left_cancelative [reducible] := Πa b c, a * b = a * c → b = c + definition right_cancelative [reducible] := Πa b c, a * b = c * b → a = c - definition inv_op_cancel_left [reducible] := ∀a b, a⁻¹ * (a * b) = b - definition op_inv_cancel_left [reducible] := ∀a b, a * (a⁻¹ * b) = b - definition inv_op_cancel_right [reducible] := ∀a b, a * b⁻¹ * b = a - definition op_inv_cancel_right [reducible] := ∀a b, a * b * b⁻¹ = a + definition inv_op_cancel_left [reducible] := Πa b, a⁻¹ * (a * b) = b + definition op_inv_cancel_left [reducible] := Πa b, a * (a⁻¹ * b) = b + definition inv_op_cancel_right [reducible] := Πa b, a * b⁻¹ * b = a + definition op_inv_cancel_right [reducible] := Πa b, a * b * b⁻¹ = a variable (op₂ : A → A → A) local notation a + b := op₂ a b - definition left_distributive [reducible] := ∀a b c, a * (b + c) = a * b + a * c - definition right_distributive [reducible] := ∀a b c, (a + b) * c = a * c + b * c + definition left_distributive [reducible] := Πa b c, a * (b + c) = a * b + a * c + definition right_distributive [reducible] := Πa b c, (a + b) * c = a * c + b * c - definition right_commutative [reducible] {B : Type} (f : B → A → B) := ∀ b a₁ a₂, f (f b a₁) a₂ = f (f b a₂) a₁ - definition left_commutative [reducible] {B : Type} (f : A → B → B) := ∀ a₁ a₂ b, f a₁ (f a₂ b) = f a₂ (f a₁ b) + definition right_commutative [reducible] {B : Type} (f : B → A → B) := Π b a₁ a₂, f (f b a₁) a₂ = f (f b a₂) a₁ + definition left_commutative [reducible] {B : Type} (f : A → B → B) := Π a₁ a₂ b, f a₁ (f a₂ b) = f a₂ (f a₁ b) end section @@ -47,7 +45,7 @@ namespace binary variable {f : A → A → A} variable H_comm : commutative f variable H_assoc : associative f - local infixl * := f + local infixl `*` := f theorem left_comm : left_commutative f := take a b c, calc a*(b*c) = (a*b)*c : H_assoc @@ -71,7 +69,7 @@ namespace binary variable {A : Type} variable {f : A → A → A} variable H_assoc : associative f - local infixl * := f + local infixl `*` := f theorem assoc4helper (a b c d) : (a*b)*(c*d) = a*((b*c)*d) := calc (a*b)*(c*d) = a*(b*(c*d)) : H_assoc @@ -86,34 +84,3 @@ 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/bundled.hlean b/hott/algebra/bundled.hlean new file mode 100644 index 000000000..120262135 --- /dev/null +++ b/hott/algebra/bundled.hlean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2015 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad + +Bundled structures +-/ +import algebra.group +open algebra + +namespace algebra +structure Semigroup := +(carrier : Type) (struct : semigroup carrier) + +attribute Semigroup.carrier [coercion] +attribute Semigroup.struct [instance] + +structure CommSemigroup := +(carrier : Type) (struct : comm_semigroup carrier) + +attribute CommSemigroup.carrier [coercion] +attribute CommSemigroup.struct [instance] + +structure Monoid := +(carrier : Type) (struct : monoid carrier) + +attribute Monoid.carrier [coercion] +attribute Monoid.struct [instance] + +structure CommMonoid := +(carrier : Type) (struct : comm_monoid carrier) + +attribute CommMonoid.carrier [coercion] +attribute CommMonoid.struct [instance] + +structure Group := +(carrier : Type) (struct : group carrier) + +attribute Group.carrier [coercion] +attribute Group.struct [instance] + +structure CommGroup := +(carrier : Type) (struct : comm_group carrier) + +attribute CommGroup.carrier [coercion] +attribute CommGroup.struct [instance] + +structure AddSemigroup := +(carrier : Type) (struct : add_semigroup carrier) + +attribute AddSemigroup.carrier [coercion] +attribute AddSemigroup.struct [instance] + +structure AddCommSemigroup := +(carrier : Type) (struct : add_comm_semigroup carrier) + +attribute AddCommSemigroup.carrier [coercion] +attribute AddCommSemigroup.struct [instance] + +structure AddMonoid := +(carrier : Type) (struct : add_monoid carrier) + +attribute AddMonoid.carrier [coercion] +attribute AddMonoid.struct [instance] + +structure AddCommMonoid := +(carrier : Type) (struct : add_comm_monoid carrier) + +attribute AddCommMonoid.carrier [coercion] +attribute AddCommMonoid.struct [instance] + +structure AddGroup := +(carrier : Type) (struct : add_group carrier) + +attribute AddGroup.carrier [coercion] +attribute AddGroup.struct [instance] + +structure AddCommGroup := +(carrier : Type) (struct : add_comm_group carrier) + +attribute AddCommGroup.carrier [coercion] +attribute AddCommGroup.struct [instance] +end algebra diff --git a/hott/algebra/field.hlean b/hott/algebra/field.hlean index e0f71e61b..c8940b4bb 100644 --- a/hott/algebra/field.hlean +++ b/hott/algebra/field.hlean @@ -5,211 +5,204 @@ Authors: Robert Lewis Structures with multiplicative and additive components, including division rings and fields. The development is modeled after Isabelle's library. - -Ported from the standard library -/ -import algebra.ring -open core - -namespace algebra +import algebra.binary algebra.group algebra.ring +open eq eq.ops algebra +set_option class.force_new true variable {A : Type} --- in division rings, 1 / 0 = 0 +namespace algebra structure division_ring [class] (A : Type) extends ring A, has_inv A, zero_ne_one_class A := (mul_inv_cancel : Π{a}, a ≠ zero → mul a (inv a) = one) (inv_mul_cancel : Π{a}, a ≠ zero → mul (inv a) a = one) - --(inv_zero : inv zero = zero) section division_ring variables [s : division_ring A] {a b c : A} include s - definition divide (a b : A) : A := a * b⁻¹ - infix / := divide + protected definition algebra.div (a b : A) : A := a * b⁻¹ - -- only in this file - local attribute divide [reducible] + definition division_ring_has_div [reducible] [instance] : has_div A := + has_div.mk algebra.div - definition mul_inv_cancel (H : a ≠ 0) : a * a⁻¹ = 1 := + lemma division.def (a b : A) : a / b = a * b⁻¹ := + rfl + + theorem mul_inv_cancel (H : a ≠ 0) : a * a⁻¹ = 1 := division_ring.mul_inv_cancel H - definition inv_mul_cancel (H : a ≠ 0) : a⁻¹ * a = 1 := + theorem inv_mul_cancel (H : a ≠ 0) : a⁻¹ * a = 1 := division_ring.inv_mul_cancel H - definition inv_eq_one_div : a⁻¹ = 1 / a := !one_mul⁻¹ + theorem inv_eq_one_div (a : A) : a⁻¹ = 1 / a := !one_mul⁻¹ --- the following are only theorems if we assume inv_zero here -/- definition inv_zero : 0⁻¹ = 0 := !division_ring.inv_zero + theorem div_eq_mul_one_div (a b : A) : a / b = a * (1 / b) := + by rewrite [*division.def, one_mul] - definition one_div_zero : 1 / 0 = 0 := - calc - 1 / 0 = 1 * 0⁻¹ : refl - ... = 1 * 0 : division_ring.inv_zero A - ... = 0 : mul_zero --/ - - definition div_eq_mul_one_div : a / b = a * (1 / b) := - by rewrite [↑divide, one_mul] - --- definition div_zero : a / 0 = 0 := by rewrite [div_eq_mul_one_div, one_div_zero, mul_zero] - - definition mul_one_div_cancel (H : a ≠ 0) : a * (1 / a) = 1 := + theorem mul_one_div_cancel (H : a ≠ 0) : a * (1 / a) = 1 := by rewrite [-inv_eq_one_div, (mul_inv_cancel H)] - definition one_div_mul_cancel (H : a ≠ 0) : (1 / a) * a = 1 := + theorem one_div_mul_cancel (H : a ≠ 0) : (1 / a) * a = 1 := by rewrite [-inv_eq_one_div, (inv_mul_cancel H)] - definition div_self (H : a ≠ 0) : a / a = 1 := mul_inv_cancel H + theorem div_self (H : a ≠ 0) : a / a = 1 := mul_inv_cancel H - definition one_div_one : 1 / 1 = (1:A) := - div_self (ne.symm zero_ne_one) + theorem one_div_one : 1 / 1 = (1:A) := div_self (ne.symm zero_ne_one) - definition mul_div_assoc : (a * b) / c = a * (b / c) := !mul.assoc + theorem mul_div_assoc (a b : A) : (a * b) / c = a * (b / c) := !mul.assoc - definition one_div_ne_zero (H : a ≠ 0) : 1 / a ≠ 0 := + theorem one_div_ne_zero (H : a ≠ 0) : 1 / a ≠ 0 := assume H2 : 1 / a = 0, - have C1 : 0 = (1:A), from inverse (by rewrite [-(mul_one_div_cancel H), H2, mul_zero]), + have C1 : 0 = (1:A), from symm (by rewrite [-(mul_one_div_cancel H), H2, mul_zero]), absurd C1 zero_ne_one --- definition ne_zero_of_one_div_ne_zero (H : 1 / a ≠ 0) : a ≠ 0 := --- assume Ha : a = 0, absurd (Ha⁻¹ ▸ one_div_zero) H + theorem one_inv_eq : 1⁻¹ = (1:A) := + by rewrite [-mul_one, inv_mul_cancel (ne.symm (@zero_ne_one A _))] - definition inv_one_eq : 1⁻¹ = (1:A) := - by rewrite [-mul_one, (inv_mul_cancel (ne.symm (@zero_ne_one A _)))] + theorem div_one (a : A) : a / 1 = a := + by rewrite [*division.def, one_inv_eq, mul_one] - definition div_one : a / 1 = a := - by rewrite [↑divide, inv_one_eq, mul_one] + theorem zero_div (a : A) : 0 / a = 0 := !zero_mul - definition zero_div : 0 / a = 0 := !zero_mul - - -- note: integral domain has a "mul_ne_zero". Discrete fields are int domains. - definition mul_ne_zero' (Ha : a ≠ 0) (Hb : b ≠ 0) : a * b ≠ 0 := + -- note: integral domain has a "mul_ne_zero". A commutative division ring is an integral + -- domain, but let's not define that class for now. + theorem division_ring.mul_ne_zero (Ha : a ≠ 0) (Hb : b ≠ 0) : a * b ≠ 0 := assume H : a * b = 0, have C1 : a = 0, by rewrite [-mul_one, -(mul_one_div_cancel Hb), -mul.assoc, H, zero_mul], absurd C1 Ha - definition mul_ne_zero_comm (H : a * b ≠ 0) : b * a ≠ 0 := + 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, - mul_ne_zero' (prod.pr2 H2) (prod.pr1 H2) + division_ring.mul_ne_zero (prod.pr2 H2) (prod.pr1 H2) - -- make "left" and "right" versions? - definition eq_one_div_of_mul_eq_one (H : a * b = 1) : b = 1 / a := - have H2 : a ≠ 0, from - (assume aeq0 : a = 0, - have B : 0 = (1:A), by rewrite [-(zero_mul b), -aeq0, H], - absurd B zero_ne_one), - show b = 1 / a, from inverse (calc + theorem eq_one_div_of_mul_eq_one (H : a * b = 1) : b = 1 / a := + have a ≠ 0, from + (suppose a = 0, + have 0 = (1:A), by rewrite [-(zero_mul b), -this, H], + absurd this zero_ne_one), + show b = 1 / a, from symm (calc 1 / a = (1 / a) * 1 : mul_one ... = (1 / a) * (a * b) : H ... = (1 / a) * a * b : mul.assoc - ... = 1 * b : one_div_mul_cancel H2 + ... = 1 * b : one_div_mul_cancel this ... = b : one_mul) - -- which one is left and which is right? - definition eq_one_div_of_mul_eq_one_left (H : b * a = 1) : b = 1 / a := - have H2 : a ≠ 0, from - (assume A : a = 0, - have B : 0 = 1, from inverse (calc - 1 = b * a : inverse H - ... = b * 0 : A - ... = 0 : mul_zero), - absurd B zero_ne_one), - show b = 1 / a, from inverse (calc + theorem eq_one_div_of_mul_eq_one_left (H : b * a = 1) : b = 1 / a := + have a ≠ 0, from + (suppose a = 0, + have 0 = 1, from symm (calc + 1 = b * a : symm H + ... = b * 0 : this + ... = 0 : mul_zero), + absurd this zero_ne_one), + show b = 1 / a, from symm (calc 1 / a = 1 * (1 / a) : one_mul ... = b * a * (1 / a) : H ... = b * (a * (1 / a)) : mul.assoc - ... = b * 1 : mul_one_div_cancel H2 + ... = b * 1 : mul_one_div_cancel this ... = b : mul_one) - definition one_div_mul_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : (1 / a) * (1 / b) = 1 / (b * a) := - have H : (b * a) * ((1 / a) * (1 / b)) = 1, by - rewrite [mul.assoc, -(mul.assoc a), (mul_one_div_cancel Ha), one_mul, (mul_one_div_cancel Hb)], - eq_one_div_of_mul_eq_one H + theorem division_ring.one_div_mul_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : + (1 / a) * (1 / b) = 1 / (b * a) := + have (b * a) * ((1 / a) * (1 / b)) = 1, by + rewrite [mul.assoc, -(mul.assoc a), (mul_one_div_cancel Ha), one_mul, + (mul_one_div_cancel Hb)], + eq_one_div_of_mul_eq_one this - definition one_div_neg_one_eq_neg_one : (1:A) / (-1) = -1 := - have H : (-1) * (-1) = 1, by rewrite [-neg_eq_neg_one_mul, neg_neg], - inverse (eq_one_div_of_mul_eq_one H) + theorem one_div_neg_one_eq_neg_one : (1:A) / (-1) = -1 := + have (-1) * (-1) = (1:A), by rewrite [-neg_eq_neg_one_mul, neg_neg], + symm (eq_one_div_of_mul_eq_one this) - definition one_div_neg_eq_neg_one_div (H : a ≠ 0) : 1 / (- a) = - (1 / a) := - have H1 : -1 ≠ 0, from - (assume H2 : -1 = 0, absurd (inverse (calc + theorem division_ring.one_div_neg_eq_neg_one_div (H : a ≠ 0) : 1 / (- a) = - (1 / a) := + have -1 ≠ 0, from + (suppose -1 = 0, absurd (symm (calc 1 = -(-1) : neg_neg - ... = -0 : H2 + ... = -0 : this ... = (0:A) : neg_zero)) zero_ne_one), calc 1 / (- a) = 1 / ((-1) * a) : neg_eq_neg_one_mul - ... = (1 / a) * (1 / (- 1)) : one_div_mul_one_div H H1 + ... = (1 / a) * (1 / (- 1)) : division_ring.one_div_mul_one_div H this ... = (1 / a) * (-1) : one_div_neg_one_eq_neg_one ... = - (1 / a) : mul_neg_one_eq_neg - definition div_neg_eq_neg_div (Ha : a ≠ 0) : b / (- a) = - (b / a) := + theorem div_neg_eq_neg_div (b : A) (Ha : a ≠ 0) : b / (- a) = - (b / a) := calc - b / (- a) = b * (1 / (- a)) : inv_eq_one_div - ... = b * -(1 / a) : one_div_neg_eq_neg_one_div Ha + b / (- a) = b * (1 / (- a)) : by rewrite -inv_eq_one_div + ... = b * -(1 / a) : division_ring.one_div_neg_eq_neg_one_div Ha ... = -(b * (1 / a)) : neg_mul_eq_mul_neg ... = - (b * a⁻¹) : inv_eq_one_div - definition neg_div (Ha : a ≠ 0) : (-b) / a = - (b / a) := + theorem neg_div (a b : A) : (-b) / a = - (b / a) := by rewrite [neg_eq_neg_one_mul, mul_div_assoc, -neg_eq_neg_one_mul] - definition neg_div_neg_eq_div (Hb : b ≠ 0) : (-a) / (-b) = a / b := - by rewrite [(div_neg_eq_neg_div Hb), (neg_div Hb), neg_neg] + theorem division_ring.neg_div_neg_eq (a : A) {b : A} (Hb : b ≠ 0) : (-a) / (-b) = a / b := + by rewrite [(div_neg_eq_neg_div _ Hb), neg_div, neg_neg] - definition div_div (H : a ≠ 0) : 1 / (1 / a) = a := - inverse (eq_one_div_of_mul_eq_one_left (mul_one_div_cancel H)) + theorem division_ring.one_div_one_div (H : a ≠ 0) : 1 / (1 / a) = a := + symm (eq_one_div_of_mul_eq_one_left (mul_one_div_cancel H)) - definition eq_of_invs_eq (Ha : a ≠ 0) (Hb : b ≠ 0) (H : 1 / a = 1 / b) : a = b := - by rewrite [-(div_div Ha), H, (div_div Hb)] + theorem division_ring.eq_of_one_div_eq_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) (H : 1 / a = 1 / b) : + a = b := + by rewrite [-(division_ring.one_div_one_div Ha), H, (division_ring.one_div_one_div Hb)] - -- oops, the analogous definition in group is called inv_mul, but it *should* be called - -- mul_inv, in which case, we will have to rename this one - definition mul_inv_eq (Ha : a ≠ 0) (Hb : b ≠ 0) : (b * a)⁻¹ = a⁻¹ * b⁻¹ := - have H1 : b * a ≠ 0, from mul_ne_zero' Hb Ha, + theorem mul_inv_eq (Ha : a ≠ 0) (Hb : b ≠ 0) : (b * a)⁻¹ = a⁻¹ * b⁻¹ := inverse (calc a⁻¹ * b⁻¹ = (1 / a) * b⁻¹ : inv_eq_one_div - ... = (1 / a) * (1 / b) : inv_eq_one_div - ... = (1 / (b * a)) : one_div_mul_one_div Ha Hb - ... = (b * a)⁻¹ : inv_eq_one_div) + ... = (1 / a) * (1 / b) : inv_eq_one_div + ... = (1 / (b * a)) : division_ring.one_div_mul_one_div Ha Hb + ... = (b * a)⁻¹ : inv_eq_one_div) - definition mul_div_cancel (Hb : b ≠ 0) : a * b / b = a := - by rewrite [↑divide, mul.assoc, (mul_inv_cancel Hb), mul_one] + theorem mul_div_cancel (a : A) {b : A} (Hb : b ≠ 0) : a * b / b = a := + by rewrite [*division.def, mul.assoc, (mul_inv_cancel Hb), mul_one] - definition div_mul_cancel (Hb : b ≠ 0) : a / b * b = a := - by rewrite [↑divide, mul.assoc, (inv_mul_cancel Hb), mul_one] + theorem div_mul_cancel (a : A) {b : A} (Hb : b ≠ 0) : a / b * b = a := + by rewrite [*division.def, mul.assoc, (inv_mul_cancel Hb), mul_one] - definition div_add_div_same : a / c + b / c = (a + b) / c := !right_distrib⁻¹ + theorem div_add_div_same (a b c : A) : a / c + b / c = (a + b) / c := !right_distrib⁻¹ - definition inv_mul_add_mul_inv_eq_inv_add_inv (Ha : a ≠ 0) (Hb : b ≠ 0) : + theorem div_sub_div_same (a b c : A) : (a / c) - (b / c) = (a - b) / c := + by rewrite [sub_eq_add_neg, -neg_div, div_add_div_same] + + theorem one_div_mul_add_mul_one_div_eq_one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : (1 / a) * (a + b) * (1 / b) = 1 / a + 1 / b := by rewrite [(left_distrib (1 / a)), (one_div_mul_cancel Ha), right_distrib, one_mul, mul.assoc, (mul_one_div_cancel Hb), mul_one, add.comm] - definition inv_mul_sub_mul_inv_eq_inv_add_inv (Ha : a ≠ 0) (Hb : b ≠ 0) : + theorem one_div_mul_sub_mul_one_div_eq_one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : (1 / a) * (b - a) * (1 / b) = 1 / a - 1 / b := by rewrite [(mul_sub_left_distrib (1 / a)), (one_div_mul_cancel Ha), mul_sub_right_distrib, - one_mul, mul.assoc, (mul_one_div_cancel Hb), mul_one, one_mul] + one_mul, mul.assoc, (mul_one_div_cancel Hb), mul_one] - definition div_eq_one_iff_eq (Hb : b ≠ 0) : a / b = 1 ↔ a = b := + theorem div_eq_one_iff_eq (a : A) {b : A} (Hb : b ≠ 0) : a / b = 1 ↔ a = b := iff.intro - (assume H1 : a / b = 1, inverse (calc + (suppose a / b = 1, symm (calc b = 1 * b : one_mul - ... = a / b * b : H1 - ... = a : div_mul_cancel Hb)) - (assume H2 : a = b, calc - a / b = b / b : H2 + ... = a / b * b : this + ... = a : div_mul_cancel _ Hb)) + (suppose a = b, calc + a / b = b / b : this ... = 1 : div_self Hb) - definition eq_div_iff_mul_eq (Hc : c ≠ 0) : a = b / c ↔ a * c = b := + theorem eq_of_div_eq_one (a : A) {b : A} (Hb : b ≠ 0) : a / b = 1 → a = b := + iff.mp (!div_eq_one_iff_eq Hb) + + theorem eq_div_iff_mul_eq (a : A) {b : A} (Hc : c ≠ 0) : a = b / c ↔ a * c = b := iff.intro - (assume H : a = b / c, by rewrite [H, (div_mul_cancel Hc)]) - (assume H : a * c = b, by rewrite [-(mul_div_cancel Hc), H]) + (suppose a = b / c, by rewrite [this, (!div_mul_cancel Hc)]) + (suppose a * c = b, by rewrite [-(!mul_div_cancel Hc), this]) - definition add_div_eq_mul_add_div (Hc : c ≠ 0) : a + b / c = (a * c + b) / c := - have H : (a + b / c) * c = a * c + b, by rewrite [right_distrib, (div_mul_cancel Hc)], - (iff.elim_right (eq_div_iff_mul_eq Hc)) H + theorem eq_div_of_mul_eq (a b : A) {c : A} (Hc : c ≠ 0) : a * c = b → a = b / c := + iff.mpr (!eq_div_iff_mul_eq Hc) - definition mul_mul_div (Hc : c ≠ 0) : a = a * c * (1 / c) := + theorem mul_eq_of_eq_div (a b: A) {c : A} (Hc : c ≠ 0) : a = b / c → a * c = b := + iff.mp (!eq_div_iff_mul_eq Hc) + + theorem add_div_eq_mul_add_div (a b : A) {c : A} (Hc : c ≠ 0) : a + b / c = (a * c + b) / c := + have (a + b / c) * c = a * c + b, by rewrite [right_distrib, (!div_mul_cancel Hc)], + (iff.elim_right (!eq_div_iff_mul_eq Hc)) this + + theorem mul_mul_div (a : A) {c : A} (Hc : c ≠ 0) : a = a * c * (1 / c) := calc a = a * 1 : mul_one ... = a * (c * (1 / c)) : mul_one_div_cancel Hc @@ -217,7 +210,6 @@ section division_ring -- There are many similar rules to these last two in the Isabelle library -- that haven't been ported yet. Do as necessary. - end division_ring structure field [class] (A : Type) extends division_ring A, comm_ring A @@ -225,84 +217,99 @@ structure field [class] (A : Type) extends division_ring A, comm_ring A section field variables [s : field A] {a b c d: A} include s - local attribute divide [reducible] - definition one_div_mul_one_div' (Ha : a ≠ 0) (Hb : b ≠ 0) : (1 / a) * (1 / b) = 1 / (a * b) := - by rewrite [(one_div_mul_one_div Ha Hb), mul.comm b] + theorem field.one_div_mul_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : (1 / a) * (1 / b) = 1 / (a * b) := + by rewrite [(division_ring.one_div_mul_one_div Ha Hb), mul.comm b] - definition div_mul_right (Hb : b ≠ 0) (H : a * b ≠ 0) : a / (a * b) = 1 / b := - let Ha : a ≠ 0 := prod.pr1 (ne_zero_and_ne_zero_of_mul_ne_zero H) in - inverse (calc + 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), + symm (calc 1 / b = 1 * (1 / b) : one_mul - ... = (a * a⁻¹) * (1 / b) : mul_inv_cancel Ha + ... = (a * a⁻¹) * (1 / b) : mul_inv_cancel this ... = a * (a⁻¹ * (1 / b)) : mul.assoc - ... = a * ((1 / a) * (1 / b)) :inv_eq_one_div - ... = a * (1 / (b * a)) : one_div_mul_one_div Ha Hb + ... = a * ((1 / a) * (1 / b)) : inv_eq_one_div + ... = a * (1 / (b * a)) : division_ring.one_div_mul_one_div this Hb ... = a * (1 / (a * b)) : mul.comm ... = a * (a * b)⁻¹ : inv_eq_one_div) - definition div_mul_left (Ha : a ≠ 0) (H : a * b ≠ 0) : b / (a * b) = 1 / a := + theorem field.div_mul_left (Ha : a ≠ 0) (H : a * b ≠ 0) : b / (a * b) = 1 / a := let H1 : b * a ≠ 0 := mul_ne_zero_comm H in - by rewrite [mul.comm a, (div_mul_right Ha H1)] + by rewrite [mul.comm a, (field.div_mul_right Ha H1)] - definition mul_div_cancel_left (Ha : a ≠ 0) : a * b / a = b := - by rewrite [mul.comm a, (mul_div_cancel Ha)] + theorem mul_div_cancel_left (Ha : a ≠ 0) : a * b / a = b := + by rewrite [mul.comm a, (!mul_div_cancel Ha)] - definition mul_div_cancel' (Hb : b ≠ 0) : b * (a / b) = a := - by rewrite [mul.comm, (div_mul_cancel Hb)] + theorem mul_div_cancel' (Hb : b ≠ 0) : b * (a / b) = a := + by rewrite [mul.comm, (!div_mul_cancel Hb)] - definition one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) := - have H [visible] : a * b ≠ 0, from (mul_ne_zero' Ha Hb), - by rewrite [add.comm, -(div_mul_left Ha H), -(div_mul_right Hb H), ↑divide, -right_distrib] + theorem one_div_add_one_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) := + assert a * b ≠ 0, from (division_ring.mul_ne_zero Ha Hb), + by rewrite [add.comm, -(field.div_mul_left Ha this), -(field.div_mul_right Hb this), *division.def, + -right_distrib] - definition div_mul_div (Hb : b ≠ 0) (Hd : d ≠ 0) : (a / b) * (c / d) = (a * c) / (b * d) := - by rewrite [↑divide, 2 mul.assoc, (mul.comm b⁻¹), mul.assoc, (mul_inv_eq Hd Hb)] + theorem field.div_mul_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) : + (a / b) * (c / d) = (a * c) / (b * d) := + by rewrite [*division.def, 2 mul.assoc, (mul.comm b⁻¹), mul.assoc, (mul_inv_eq Hd Hb)] - definition mul_div_mul_left (Hb : b ≠ 0) (Hc : c ≠ 0) : (c * a) / (c * b) = a / b := - have H [visible] : c * b ≠ 0, from mul_ne_zero' Hc Hb, - by rewrite [-(div_mul_div Hc Hb), (div_self Hc), one_mul] + theorem mul_div_mul_left (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) : + (c * a) / (c * b) = a / b := + by rewrite [-(!field.div_mul_div Hc Hb), (div_self Hc), one_mul] - definition mul_div_mul_right (Hb : b ≠ 0) (Hc : c ≠ 0) : (a * c) / (b * c) = a / b := - by rewrite [(mul.comm a), (mul.comm b), (mul_div_mul_left Hb Hc)] + theorem mul_div_mul_right (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) : + (a * c) / (b * c) = a / b := + by rewrite [(mul.comm a), (mul.comm b), (!mul_div_mul_left Hb Hc)] - definition div_mul_eq_mul_div : (b / c) * a = (b * a) / c := - by rewrite [↑divide, mul.assoc, (mul.comm c⁻¹), -mul.assoc] + theorem div_mul_eq_mul_div (a b c : A) : (b / c) * a = (b * a) / c := + by rewrite [*division.def, mul.assoc, (mul.comm c⁻¹), -mul.assoc] - -- this one is odd -- I am not sure what to call it, but again, the prefix is right - definition div_mul_eq_mul_div_comm (Hc : c ≠ 0) : (b / c) * a = b * (a / c) := - by rewrite [(div_mul_eq_mul_div), -(one_mul c), -(div_mul_div (ne.symm zero_ne_one) Hc), div_one, one_mul] + theorem field.div_mul_eq_mul_div_comm (a b : A) {c : A} (Hc : c ≠ 0) : + (b / c) * a = b * (a / c) := + by rewrite [(div_mul_eq_mul_div), -(one_mul c), -(!field.div_mul_div (ne.symm zero_ne_one) Hc), + div_one, one_mul] - definition div_add_div (Hb : b ≠ 0) (Hd : d ≠ 0) : + theorem div_add_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) : (a / b) + (c / d) = ((a * d) + (b * c)) / (b * d) := - have H [visible] : b * d ≠ 0, from mul_ne_zero' Hb Hd, - by rewrite [-(mul_div_mul_right Hb Hd), -(mul_div_mul_left Hd Hb), div_add_div_same] + by rewrite [-(!mul_div_mul_right Hb Hd), -(!mul_div_mul_left Hd Hb), div_add_div_same] - definition div_sub_div (Hb : b ≠ 0) (Hd : d ≠ 0) : + theorem div_sub_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) (Hd : d ≠ 0) : (a / b) - (c / d) = ((a * d) - (b * c)) / (b * d) := - by rewrite [↑sub, neg_eq_neg_one_mul, -mul_div_assoc, (div_add_div Hb Hd), + by rewrite [*sub_eq_add_neg, neg_eq_neg_one_mul, -mul_div_assoc, (!div_add_div Hb Hd), -mul.assoc, (mul.comm b), mul.assoc, -neg_eq_neg_one_mul] - definition mul_eq_mul_of_div_eq_div (Hb : b ≠ 0) (Hd : d ≠ 0) (H : a / b = c / d) : a * d = c * b := + theorem mul_eq_mul_of_div_eq_div (a : A) {b : A} (c : A) {d : A} (Hb : b ≠ 0) + (Hd : d ≠ 0) (H : a / b = c / d) : a * d = c * b := by rewrite [-mul_one, mul.assoc, (mul.comm d), -mul.assoc, -(div_self Hb), - -(div_mul_eq_mul_div_comm Hb), H, (div_mul_eq_mul_div), (div_mul_cancel Hd)] + -(!field.div_mul_eq_mul_div_comm Hb), H, (div_mul_eq_mul_div), (!div_mul_cancel Hd)] - definition one_div_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / (a / b) = b / a := - have H : (a / b) * (b / a) = 1, from calc - (a / b) * (b / a) = (a * b) / (b * a) : div_mul_div Hb Ha + theorem field.one_div_div (Ha : a ≠ 0) (Hb : b ≠ 0) : 1 / (a / b) = b / a := + have (a / b) * (b / a) = 1, from calc + (a / b) * (b / a) = (a * b) / (b * a) : !field.div_mul_div Hb Ha ... = (a * b) / (a * b) : mul.comm - ... = 1 : div_self (mul_ne_zero' Ha Hb), - inverse (eq_one_div_of_mul_eq_one H) + ... = 1 : div_self (division_ring.mul_ne_zero Ha Hb), + symm (eq_one_div_of_mul_eq_one this) - definition div_div_eq_mul_div (Hb : b ≠ 0) (Hc : c ≠ 0) : a / (b / c) = (a * c) / b := - by rewrite [div_eq_mul_one_div, (one_div_div Hb Hc), -mul_div_assoc] + theorem field.div_div_eq_mul_div (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) : + a / (b / c) = (a * c) / b := + by rewrite [div_eq_mul_one_div, (field.one_div_div Hb Hc), -mul_div_assoc] - definition div_div_eq_div_mul (Hb : b ≠ 0) (Hc : c ≠ 0) : (a / b) / c = a / (b * c) := - by rewrite [div_eq_mul_one_div, (div_mul_div Hb Hc), mul_one] + theorem field.div_div_eq_div_mul (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) : + (a / b) / c = a / (b * c) := + by rewrite [div_eq_mul_one_div, (!field.div_mul_div Hb Hc), mul_one] - definition div_div_div_div (Hb : b ≠ 0) (Hc : c ≠ 0) (Hd : d ≠ 0) : (a / b) / (c / d) = (a * d) / (b * c) := - by rewrite [(div_div_eq_mul_div Hc Hd), (div_mul_eq_mul_div), (div_div_eq_div_mul Hb Hc)] + theorem field.div_div_div_div_eq (a : A) {b c d : A} (Hb : b ≠ 0) (Hc : c ≠ 0) (Hd : d ≠ 0) : + (a / b) / (c / d) = (a * d) / (b * c) := + by rewrite [(!field.div_div_eq_mul_div Hc Hd), (div_mul_eq_mul_div), + (!field.div_div_eq_div_mul Hb Hc)] - -- remaining to transfer from Isabelle fields: ordered fields + theorem field.div_mul_eq_div_mul_one_div (a : A) {b c : A} (Hb : b ≠ 0) (Hc : c ≠ 0) : + a / (b * c) = (a / b) * (1 / c) := + by rewrite [-!field.div_div_eq_div_mul Hb Hc, -div_eq_mul_one_div] + + theorem eq_of_mul_eq_mul_of_nonzero_left {a b c : A} (H : a ≠ 0) (H2 : a * b = a * c) : b = c := + by rewrite [-one_mul b, -div_self H, div_mul_eq_mul_div, H2, mul_div_cancel_left H] + + theorem eq_of_mul_eq_mul_of_nonzero_right {a b c : A} (H : c ≠ 0) (H2 : a * c = b * c) : a = b := + by rewrite [-mul_one a, -div_self H, -mul_div_assoc, H2, mul_div_cancel _ H] end field @@ -319,79 +326,75 @@ section discrete_field -- 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. - -- they are named with '. Is there a better convention? - definition discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero + theorem discrete_field.eq_zero_or_eq_zero_of_mul_eq_zero (x y : A) (H : x * y = 0) : x = 0 ⊎ y = 0 := decidable.by_cases - (assume H : x = 0, sum.inl H) - (assume H1 : x ≠ 0, - sum.inr (by rewrite [-one_mul, -(inv_mul_cancel H1), mul.assoc, H, mul_zero])) + (suppose x = 0, sum.inl this) + (suppose x ≠ 0, + sum.inr (by rewrite [-one_mul, -(inv_mul_cancel this), mul.assoc, H, mul_zero])) - definition discrete_field.to_integral_domain [instance] [reducible] : + 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⦄ - definition inv_zero : 0⁻¹ = (0 : A) := !discrete_field.inv_zero + theorem inv_zero : 0⁻¹ = (0:A) := !discrete_field.inv_zero - definition one_div_zero : 1 / 0 = (0:A) := + theorem one_div_zero : 1 / 0 = (0:A) := calc 1 / 0 = 1 * 0⁻¹ : refl - ... = 1 * 0 : discrete_field.inv_zero A + ... = 1 * 0 : inv_zero ... = 0 : mul_zero - definition div_zero : a / 0 = 0 := by rewrite [div_eq_mul_one_div, one_div_zero, mul_zero] + theorem div_zero (a : A) : a / 0 = 0 := by rewrite [div_eq_mul_one_div, one_div_zero, mul_zero] - definition ne_zero_of_one_div_ne_zero (H : 1 / a ≠ 0) : a ≠ 0 := + theorem ne_zero_of_one_div_ne_zero (H : 1 / a ≠ 0) : a ≠ 0 := assume Ha : a = 0, absurd (Ha⁻¹ ▸ one_div_zero) H - definition inv_zero_imp_zero (H : 1 / a = 0) : a = 0 := + theorem eq_zero_of_one_div_eq_zero (H : 1 / a = 0) : a = 0 := decidable.by_cases (assume Ha, Ha) (assume Ha, empty.elim ((one_div_ne_zero Ha) H)) --- the following could all go in "discrete_division_ring" - definition one_div_mul_one_div'' : (1 / a) * (1 / b) = 1 / (b * a) := + variables (a b) + theorem one_div_mul_one_div' : (1 / a) * (1 / b) = 1 / (b * a) := decidable.by_cases - (assume Ha : a = 0, - by rewrite [Ha, div_zero, zero_mul, -(@div_zero A s 1), mul_zero b]) + (suppose a = 0, + by rewrite [this, div_zero, zero_mul, -(@div_zero A s 1), mul_zero b]) (assume Ha : a ≠ 0, decidable.by_cases - (assume Hb : b = 0, - by rewrite [Hb, div_zero, mul_zero, -(@div_zero A s 1), zero_mul a]) - (assume Hb : b ≠ 0, one_div_mul_one_div Ha Hb)) + (suppose b = 0, + by rewrite [this, div_zero, mul_zero, -(@div_zero A s 1), zero_mul a]) + (suppose b ≠ 0, division_ring.one_div_mul_one_div Ha this)) - definition one_div_neg_eq_neg_one_div' : 1 / (- a) = - (1 / a) := + theorem one_div_neg_eq_neg_one_div : 1 / (- a) = - (1 / a) := decidable.by_cases - (assume Ha : a = 0, by rewrite [Ha, neg_zero, 2 div_zero, neg_zero]) - (assume Ha : a ≠ 0, one_div_neg_eq_neg_one_div Ha) + (suppose a = 0, by rewrite [this, neg_zero, 2 div_zero, neg_zero]) + (suppose a ≠ 0, division_ring.one_div_neg_eq_neg_one_div this) - definition neg_div' : (-b) / a = - (b / a) := - decidable.by_cases - (assume Ha : a = 0, by rewrite [Ha, 2 div_zero, neg_zero]) - (assume Ha : a ≠ 0, neg_div Ha) - - definition neg_div_neg_eq_div' : (-a) / (-b) = a / b := + theorem neg_div_neg_eq : (-a) / (-b) = a / b := decidable.by_cases (assume Hb : b = 0, by rewrite [Hb, neg_zero, 2 div_zero]) - (assume Hb : b ≠ 0, neg_div_neg_eq_div Hb) + (assume Hb : b ≠ 0, !division_ring.neg_div_neg_eq Hb) - definition div_div' : 1 / (1 / a) = a := + theorem one_div_one_div : 1 / (1 / a) = a := decidable.by_cases (assume Ha : a = 0, by rewrite [Ha, 2 div_zero]) - (assume Ha : a ≠ 0, div_div Ha) + (assume Ha : a ≠ 0, division_ring.one_div_one_div Ha) - definition eq_of_invs_eq' (H : 1 / a = 1 / b) : a = b := + variables {a b} + theorem eq_of_one_div_eq_one_div (H : 1 / a = 1 / b) : a = b := decidable.by_cases (assume Ha : a = 0, - have Hb : b = 0, from inv_zero_imp_zero (by rewrite [-H, Ha, div_zero]), + have Hb : b = 0, from eq_zero_of_one_div_eq_zero (by rewrite [-H, Ha, div_zero]), Hb⁻¹ ▸ Ha) (assume Ha : a ≠ 0, have Hb : b ≠ 0, from ne_zero_of_one_div_ne_zero (H ▸ (one_div_ne_zero Ha)), - eq_of_invs_eq Ha Hb H) + division_ring.eq_of_one_div_eq_one_div Ha Hb H) - definition mul_inv' : (b * a)⁻¹ = a⁻¹ * b⁻¹ := + variables (a b) + theorem mul_inv' : (b * a)⁻¹ = a⁻¹ * b⁻¹ := decidable.by_cases (assume Ha : a = 0, by rewrite [Ha, mul_zero, 2 inv_zero, zero_mul]) (assume Ha : a ≠ 0, @@ -400,63 +403,126 @@ section discrete_field (assume Hb : b ≠ 0, mul_inv_eq Ha Hb)) -- the following are specifically for fields - definition one_div_mul_one_div''' : (1 / a) * (1 / b) = 1 / (a * b) := - by rewrite [(one_div_mul_one_div''), mul.comm b] + theorem one_div_mul_one_div : (1 / a) * (1 / b) = 1 / (a * b) := + by rewrite [one_div_mul_one_div', mul.comm b] - definition div_mul_right' (Ha : a ≠ 0) : a / (a * b) = 1 / b := + variable {a} + theorem div_mul_right (Ha : a ≠ 0) : a / (a * b) = 1 / b := decidable.by_cases (assume Hb : b = 0, by rewrite [Hb, mul_zero, 2 div_zero]) - (assume Hb : b ≠ 0, div_mul_right Hb (mul_ne_zero Ha Hb)) + (assume Hb : b ≠ 0, field.div_mul_right Hb (mul_ne_zero Ha Hb)) - definition div_mul_left' (Hb : b ≠ 0) : b / (a * b) = 1 / a := - by rewrite [mul.comm a, div_mul_right' Hb] + variables (a) {b} + theorem div_mul_left (Hb : b ≠ 0) : b / (a * b) = 1 / a := + by rewrite [mul.comm a, div_mul_right _ Hb] - definition div_mul_div' : (a / b) * (c / d) = (a * c) / (b * d) := + variables (a b c) + theorem div_mul_div : (a / b) * (c / d) = (a * c) / (b * d) := decidable.by_cases (assume Hb : b = 0, by rewrite [Hb, div_zero, zero_mul, -(@div_zero A s (a * c)), zero_mul]) (assume Hb : b ≠ 0, decidable.by_cases - (assume Hd : d = 0, by rewrite [Hd, div_zero, mul_zero, -(@div_zero A s (a * c)), mul_zero]) - (assume Hd : d ≠ 0, div_mul_div Hb Hd)) + (assume Hd : d = 0, by rewrite [Hd, div_zero, mul_zero, -(@div_zero A s (a * c)), + mul_zero]) + (assume Hd : d ≠ 0, !field.div_mul_div Hb Hd)) - definition mul_div_mul_left' (Hc : c ≠ 0) : (c * a) / (c * b) = a / b := + variable {c} + theorem mul_div_mul_left' (Hc : c ≠ 0) : (c * a) / (c * b) = a / b := decidable.by_cases (assume Hb : b = 0, by rewrite [Hb, mul_zero, 2 div_zero]) - (assume Hb : b ≠ 0, mul_div_mul_left Hb Hc) + (assume Hb : b ≠ 0, !mul_div_mul_left Hb Hc) - definition mul_div_mul_right' (Hc : c ≠ 0) : (a * c) / (b * c) = a / b := - by rewrite [(mul.comm a), (mul.comm b), (mul_div_mul_left' Hc)] + theorem mul_div_mul_right' (Hc : c ≠ 0) : (a * c) / (b * c) = a / b := + by rewrite [(mul.comm a), (mul.comm b), (!mul_div_mul_left' Hc)] - -- this one is odd -- I am not sure what to call it, but again, the prefix is right - definition div_mul_eq_mul_div_comm' : (b / c) * a = b * (a / c) := + variables (a b c d) + theorem div_mul_eq_mul_div_comm : (b / c) * a = b * (a / c) := decidable.by_cases (assume Hc : c = 0, by rewrite [Hc, div_zero, zero_mul, -(mul_zero b), -(@div_zero A s a)]) - (assume Hc : c ≠ 0, div_mul_eq_mul_div_comm Hc) + (assume Hc : c ≠ 0, !field.div_mul_eq_mul_div_comm Hc) - definition one_div_div' : 1 / (a / b) = b / a := + theorem one_div_div : 1 / (a / b) = b / a := decidable.by_cases (assume Ha : a = 0, by rewrite [Ha, zero_div, 2 div_zero]) (assume Ha : a ≠ 0, decidable.by_cases (assume Hb : b = 0, by rewrite [Hb, 2 div_zero, zero_div]) - (assume Hb : b ≠ 0, one_div_div Ha Hb)) + (assume Hb : b ≠ 0, field.one_div_div Ha Hb)) - definition div_div_eq_mul_div' : a / (b / c) = (a * c) / b := - by rewrite [div_eq_mul_one_div, one_div_div', -mul_div_assoc] + theorem div_div_eq_mul_div : a / (b / c) = (a * c) / b := + by rewrite [div_eq_mul_one_div, one_div_div, -mul_div_assoc] - definition div_div_eq_div_mul' : (a / b) / c = a / (b * c) := - by rewrite [div_eq_mul_one_div, div_mul_div', mul_one] + theorem div_div_eq_div_mul : (a / b) / c = a / (b * c) := + by rewrite [div_eq_mul_one_div, div_mul_div, mul_one] - definition div_div_div_div' : (a / b) / (c / d) = (a * d) / (b * c) := - by rewrite [div_div_eq_mul_div', div_mul_eq_mul_div, div_div_eq_div_mul'] + theorem div_div_div_div_eq : (a / b) / (c / d) = (a * d) / (b * c) := + by rewrite [div_div_eq_mul_div, div_mul_eq_mul_div, div_div_eq_div_mul] + + variable {a} + theorem div_helper (H : a ≠ 0) : (1 / (a * b)) * a = 1 / b := + by rewrite [div_mul_eq_mul_div, one_mul, !div_mul_right H] + + variable (a) + theorem div_mul_eq_div_mul_one_div : a / (b * c) = (a / b) * (1 / c) := + by rewrite [-div_div_eq_div_mul, -div_eq_mul_one_div] end discrete_field +namespace norm_num + +theorem div_add_helper [s : field A] (n d b c val : A) (Hd : d ≠ 0) (H : n + b * d = val) + (H2 : c * d = val) : n / d + b = c := + begin + apply eq_of_mul_eq_mul_of_nonzero_right Hd, + rewrite [H2, -H, right_distrib, div_mul_cancel _ Hd] + end + +theorem add_div_helper [s : field A] (n d b c val : A) (Hd : d ≠ 0) (H : d * b + n = val) + (H2 : d * c = val) : b + n / d = c := + begin + apply eq_of_mul_eq_mul_of_nonzero_left Hd, + rewrite [H2, -H, left_distrib, mul_div_cancel' Hd] + end + +theorem div_mul_helper [s : field A] (n d c v : A) (Hd : d ≠ 0) (H : (n * c) / d = v) : + (n / d) * c = v := + by rewrite [-H, field.div_mul_eq_mul_div_comm _ _ Hd, mul_div_assoc] + +theorem mul_div_helper [s : field A] (a n d v : A) (Hd : d ≠ 0) (H : (a * n) / d = v) : + a * (n / d) = v := + by rewrite [-H, mul_div_assoc] + +theorem nonzero_of_div_helper [s : field A] (a b : A) (Ha : a ≠ 0) (Hb : b ≠ 0) : a / b ≠ 0 := + begin + intro Hab, + have Habb : (a / b) * b = 0, by rewrite [Hab, zero_mul], + rewrite [div_mul_cancel _ Hb at Habb], + exact Ha Habb + end + +theorem div_helper [s : field A] (n d v : A) (Hd : d ≠ 0) (H : v * d = n) : n / d = v := + begin + apply eq_of_mul_eq_mul_of_nonzero_right Hd, + rewrite (div_mul_cancel _ Hd), + exact inverse H + end + +theorem div_eq_div_helper [s : field A] (a b c d v : A) (H1 : a * d = v) (H2 : c * b = v) + (Hb : b ≠ 0) (Hd : d ≠ 0) : a / b = c / d := + begin + apply eq_div_of_mul_eq, + exact Hd, + rewrite div_mul_eq_mul_div, + apply inverse, + apply eq_div_of_mul_eq, + exact Hb, + rewrite [H1, H2] + end + +theorem subst_into_div [s : has_div A] (a₁ b₁ a₂ b₂ v : A) (H : a₁ / b₁ = v) (H1 : a₂ = a₁) + (H2 : b₂ = b₁) : a₂ / b₂ = v := + by rewrite [H1, H2, H] + +end norm_num + end algebra - - -/- - decidable.by_cases - (assume Ha : a = 0, sorry) - (assume Ha : a ≠ 0, sorry) --/ diff --git a/hott/algebra/group.hlean b/hott/algebra/group.hlean index 852e7c497..11bd614b0 100644 --- a/hott/algebra/group.hlean +++ b/hott/algebra/group.hlean @@ -3,51 +3,29 @@ 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 -Various multiplicative and additive structures. -Ported from the standard library +Various multiplicative and additive structures. Partially modeled on Isabelle's library. -/ -import algebra.binary +import algebra.binary algebra.priority -open eq is_trunc binary -- note: ⁻¹ will be overloaded - -namespace algebra +open eq eq.ops -- note: ⁻¹ will be overloaded +open binary algebra +set_option class.force_new true variable {A : Type} -/- overloaded symbols -/ -structure has_mul [class] (A : Type) := -(mul : A → A → A) - -structure has_inv [class] (A : Type) := -(inv : A → A) - -structure has_neg [class] (A : Type) := -(neg : A → A) - -infixl * := has_mul.mul -infixl + := has_add.add -postfix ⁻¹ := has_inv.inv -prefix - := has_neg.neg -notation 1 := !has_one.one -notation 0 := !has_zero.zero - ---a second notation for the inverse, which is not overloaded -postfix [parsing_only] `⁻¹ᵍ`:std.prec.max_plus := has_inv.inv - /- semigroup -/ -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)) +namespace algebra -attribute semigroup.is_hset_carrier [instance] +structure semigroup [class] (A : Type) extends has_mul A := +(mul_assoc : Πa b c, mul (mul a b) c = mul a (mul b c)) theorem mul.assoc [s : semigroup A] (a b c : A) : a * b * c = a * (b * c) := !semigroup.mul_assoc structure comm_semigroup [class] (A : Type) extends semigroup A := -(mul_comm : ∀a b, mul a b = mul b a) +(mul_comm : Πa b, mul a b = mul b a) theorem mul.comm [s : comm_semigroup A] (a b : A) : a * b = b * a := !comm_semigroup.mul_comm @@ -59,7 +37,7 @@ theorem mul.right_comm [s : comm_semigroup A] (a b c : A) : (a * b) * c = (a * c binary.right_comm (@mul.comm A _) (@mul.assoc A _) a b c structure left_cancel_semigroup [class] (A : Type) extends semigroup A := -(mul_left_cancel : ∀a b c, mul a b = mul a c → b = c) +(mul_left_cancel : Πa b c, mul a b = mul a c → b = c) theorem mul.left_cancel [s : left_cancel_semigroup A] {a b c : A} : a * b = a * c → b = c := @@ -68,7 +46,7 @@ theorem mul.left_cancel [s : left_cancel_semigroup A] {a b c : A} : abbreviation eq_of_mul_eq_mul_left' := @mul.left_cancel structure right_cancel_semigroup [class] (A : Type) extends semigroup A := -(mul_right_cancel : ∀a b c, mul a b = mul c b → a = c) +(mul_right_cancel : Πa b c, mul a b = mul c b → a = c) theorem mul.right_cancel [s : right_cancel_semigroup A] {a b c : A} : a * b = c * b → a = c := @@ -79,16 +57,13 @@ 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] +(add_assoc : Πa b c, add (add a b) c = add a (add b c)) theorem add.assoc [s : add_semigroup A] (a b c : A) : a + b + c = a + (b + c) := !add_semigroup.add_assoc structure add_comm_semigroup [class] (A : Type) extends add_semigroup A := -(add_comm : ∀a b, add a b = add b a) +(add_comm : Πa b, add a b = add b a) theorem add.comm [s : add_comm_semigroup A] (a b : A) : a + b = b + a := !add_comm_semigroup.add_comm @@ -101,7 +76,7 @@ theorem add.right_comm [s : add_comm_semigroup A] (a b c : A) : (a + b) + c = (a binary.right_comm (@add.comm A _) (@add.assoc A _) a b c structure add_left_cancel_semigroup [class] (A : Type) extends add_semigroup A := -(add_left_cancel : ∀a b c, add a b = add a c → b = c) +(add_left_cancel : Πa b c, add a b = add a c → b = c) theorem add.left_cancel [s : add_left_cancel_semigroup A] {a b c : A} : a + b = a + c → b = c := @@ -110,7 +85,7 @@ theorem add.left_cancel [s : add_left_cancel_semigroup A] {a b c : A} : abbreviation eq_of_add_eq_add_left := @add.left_cancel structure add_right_cancel_semigroup [class] (A : Type) extends add_semigroup A := -(add_right_cancel : ∀a b c, add a b = add c b → a = c) +(add_right_cancel : Πa b c, add a b = add c b → a = c) theorem add.right_cancel [s : add_right_cancel_semigroup A] {a b c : A} : a + b = c + b → a = c := @@ -121,7 +96,7 @@ abbreviation eq_of_add_eq_add_right := @add.right_cancel /- monoid -/ structure monoid [class] (A : Type) extends semigroup A, has_one A := -(one_mul : ∀a, mul one a = a) (mul_one : ∀a, mul a one = a) +(one_mul : Πa, mul one a = a) (mul_one : Πa, mul a one = a) theorem one_mul [s : monoid A] (a : A) : 1 * a = a := !monoid.one_mul @@ -132,7 +107,7 @@ structure comm_monoid [class] (A : Type) extends monoid A, comm_semigroup A /- additive monoid -/ structure add_monoid [class] (A : Type) extends add_semigroup A, has_zero A := -(zero_add : ∀a, add zero a = a) (add_zero : ∀a, add a zero = a) +(zero_add : Πa, add zero a = a) (add_zero : Πa, add a zero = a) theorem zero_add [s : add_monoid A] (a : A) : 0 + a = a := !add_monoid.zero_add @@ -140,10 +115,36 @@ theorem add_zero [s : add_monoid A] (a : A) : a + 0 = a := !add_monoid.add_zero structure add_comm_monoid [class] (A : Type) extends add_monoid A, add_comm_semigroup A +definition add_monoid.to_monoid {A : Type} [s : add_monoid A] : monoid A := +⦃ monoid, + mul := add_monoid.add, + mul_assoc := add_monoid.add_assoc, + one := add_monoid.zero A, + mul_one := add_monoid.add_zero, + one_mul := add_monoid.zero_add +⦄ + +definition add_comm_monoid.to_comm_monoid {A : Type} [s : add_comm_monoid A] : comm_monoid A := +⦃ comm_monoid, + add_monoid.to_monoid, + mul_comm := add_comm_monoid.add_comm +⦄ + +section add_comm_monoid + variables [s : add_comm_monoid A] + include s + + theorem add_comm_three (a b c : A) : a + b + c = c + b + a := + by rewrite [{a + _}add.comm, {_ + c}add.comm, -*add.assoc] + + theorem add.comm4 : Π (n m k l : A), n + m + (k + l) = n + k + (m + l) := + comm4 add.comm add.assoc +end add_comm_monoid + /- group -/ structure group [class] (A : Type) extends monoid A, has_inv A := -(mul_left_inv : ∀a, mul (inv a) a = one) +(mul_left_inv : Πa, mul (inv a) a = one) -- Note: with more work, we could derive the axiom one_mul @@ -163,25 +164,31 @@ section group theorem inv_eq_of_mul_eq_one {a b : A} (H : a * b = 1) : a⁻¹ = b := by rewrite [-mul_one a⁻¹, -H, inv_mul_cancel_left] - theorem one_inv : 1⁻¹ = (1:A) := inv_eq_of_mul_eq_one (one_mul 1) + theorem one_inv : 1⁻¹ = (1 : A) := inv_eq_of_mul_eq_one (one_mul 1) theorem inv_inv (a : A) : (a⁻¹)⁻¹ = a := inv_eq_of_mul_eq_one (mul.left_inv a) theorem inv.inj {a b : A} (H : a⁻¹ = b⁻¹) : a = b := - by rewrite [-inv_inv, H, inv_inv] + by rewrite [-inv_inv a, H, inv_inv b] theorem inv_eq_inv_iff_eq (a b : A) : a⁻¹ = b⁻¹ ↔ a = b := iff.intro (assume H, inv.inj H) (assume H, ap _ H) - theorem inv_eq_one_iff_eq_one (a b : A) : a⁻¹ = 1 ↔ a = 1 := + theorem inv_eq_one_iff_eq_one (a : A) : a⁻¹ = 1 ↔ a = 1 := one_inv ▸ inv_eq_inv_iff_eq a 1 + theorem eq_one_of_inv_eq_one (a : A) : a⁻¹ = 1 → a = 1 := + iff.mp !inv_eq_one_iff_eq_one + theorem eq_inv_of_eq_inv {a b : A} (H : a = b⁻¹) : b = a⁻¹ := by rewrite [H, inv_inv] theorem eq_inv_iff_eq_inv (a b : A) : a = b⁻¹ ↔ b = a⁻¹ := iff.intro !eq_inv_of_eq_inv !eq_inv_of_eq_inv + theorem eq_inv_of_mul_eq_one {a b : A} (H : a * b = 1) : a = b⁻¹ := + begin apply eq_inv_of_eq_inv, symmetry, exact inv_eq_of_mul_eq_one H end + theorem mul.right_inv (a : A) : a * a⁻¹ = 1 := calc a * a⁻¹ = (a⁻¹)⁻¹ * a⁻¹ : inv_inv @@ -254,14 +261,61 @@ section group theorem mul_eq_one_iff_mul_eq_one (a b : A) : a * b = 1 ↔ b * a = 1 := iff.intro !mul_eq_one_of_mul_eq_one !mul_eq_one_of_mul_eq_one - theorem eq_inv_of_mul_eq_one {a b : A} (H : a * b = 1) : a = b⁻¹ := - (inv_eq_of_mul_eq_one (mul_eq_one_of_mul_eq_one H))⁻¹ + definition conj_by (g a : A) := g * a * g⁻¹ + definition is_conjugate (a b : A) := Σ x, conj_by x b = a - definition group.to_left_cancel_semigroup [instance] [reducible] : left_cancel_semigroup A := + local infixl ` ~ ` := is_conjugate + local infixr ` ∘c `:55 := conj_by + + lemma conj_compose (f g a : A) : f ∘c g ∘c a = f*g ∘c a := + calc f ∘c g ∘c a = f * (g * a * g⁻¹) * f⁻¹ : rfl + ... = f * (g * a) * g⁻¹ * f⁻¹ : mul.assoc + ... = f * g * a * g⁻¹ * f⁻¹ : mul.assoc + ... = f * g * a * (g⁻¹ * f⁻¹) : mul.assoc + ... = f * g * a * (f * g)⁻¹ : mul_inv + lemma conj_id (a : A) : 1 ∘c a = a := + calc 1 * a * 1⁻¹ = a * 1⁻¹ : one_mul + ... = a * 1 : one_inv + ... = a : mul_one + lemma conj_one (g : A) : g ∘c 1 = 1 := + calc g * 1 * g⁻¹ = g * g⁻¹ : mul_one + ... = 1 : mul.right_inv + lemma conj_inv_cancel (g : A) : Π a, g⁻¹ ∘c g ∘c a = a := + assume a, calc + g⁻¹ ∘c g ∘c a = g⁻¹*g ∘c a : conj_compose + ... = 1 ∘c a : mul.left_inv + ... = a : conj_id + + lemma conj_inv (g : A) : Π a, (g ∘c a)⁻¹ = g ∘c a⁻¹ := + take a, calc + (g * a * g⁻¹)⁻¹ = g⁻¹⁻¹ * (g * a)⁻¹ : mul_inv + ... = g⁻¹⁻¹ * (a⁻¹ * g⁻¹) : mul_inv + ... = g⁻¹⁻¹ * a⁻¹ * g⁻¹ : mul.assoc + ... = g * a⁻¹ * g⁻¹ : inv_inv + + lemma is_conj.refl (a : A) : a ~ a := sigma.mk 1 (conj_id a) + + lemma is_conj.symm (a b : A) : a ~ b → b ~ a := + assume Pab, obtain x (Pconj : x ∘c b = a), from Pab, + assert Pxinv : x⁻¹ ∘c x ∘c b = x⁻¹ ∘c a, begin congruence, assumption end, + sigma.mk x⁻¹ (inverse (conj_inv_cancel x b ▸ Pxinv)) + + lemma is_conj.trans (a b c : A) : a ~ b → b ~ c → a ~ c := + assume Pab, assume Pbc, + obtain x (Px : x ∘c b = a), from Pab, + obtain y (Py : y ∘c c = b), from Pbc, + sigma.mk (x*y) (calc + x*y ∘c c = x ∘c y ∘c c : conj_compose + ... = x ∘c b : Py + ... = a : Px) + + definition group.to_left_cancel_semigroup [trans_instance] [reducible] : + left_cancel_semigroup A := ⦃ left_cancel_semigroup, s, mul_left_cancel := @mul_left_cancel A s ⦄ - definition group.to_right_cancel_semigroup [instance] [reducible] : right_cancel_semigroup A := + definition group.to_right_cancel_semigroup [trans_instance] [reducible] : + right_cancel_semigroup A := ⦃ right_cancel_semigroup, s, mul_right_cancel := @mul_right_cancel A s ⦄ @@ -272,7 +326,12 @@ structure comm_group [class] (A : Type) extends group A, comm_monoid A /- additive group -/ structure add_group [class] (A : Type) extends add_monoid A, has_neg A := -(add_left_inv : ∀a, add (neg a) a = zero) +(add_left_inv : Πa, add (neg a) a = zero) + +definition add_group.to_group {A : Type} [s : add_group A] : group A := +⦃ group, add_monoid.to_monoid, + mul_left_inv := add_group.add_left_inv ⦄ + section add_group @@ -290,7 +349,7 @@ section add_group theorem neg_eq_of_add_eq_zero {a b : A} (H : a + b = 0) : -a = b := by rewrite [-add_zero, -H, neg_add_cancel_left] - theorem neg_zero : -0 = (0:A) := neg_eq_of_add_eq_zero (zero_add 0) + theorem neg_zero : -0 = (0 : A) := neg_eq_of_add_eq_zero (zero_add 0) theorem neg_neg (a : A) : -(-a) = a := neg_eq_of_add_eq_zero (add.left_inv a) @@ -305,9 +364,15 @@ section add_group theorem neg_eq_neg_iff_eq (a b : A) : -a = -b ↔ a = b := iff.intro (assume H, neg.inj H) (assume H, ap _ H) + theorem eq_of_neg_eq_neg {a b : A} : -a = -b → a = b := + iff.mp !neg_eq_neg_iff_eq + theorem neg_eq_zero_iff_eq_zero (a : A) : -a = 0 ↔ a = 0 := neg_zero ▸ !neg_eq_neg_iff_eq + theorem eq_zero_of_neg_eq_zero {a : A} : -a = 0 → a = 0 := + iff.mp !neg_eq_zero_iff_eq_zero + theorem eq_neg_of_eq_neg {a b : A} (H : a = -b) : b = -a := H⁻¹ ▸ (neg_neg b)⁻¹ @@ -372,22 +437,26 @@ section add_group ... = (c + b) + -b : H ... = c : add_neg_cancel_right - definition add_group.to_left_cancel_semigroup [instance] [reducible] : + definition add_group.to_left_cancel_semigroup [trans_instance] [reducible] : add_left_cancel_semigroup A := ⦃ add_left_cancel_semigroup, s, add_left_cancel := @add_left_cancel A s ⦄ - definition add_group.to_add_right_cancel_semigroup [instance][reducible] : + definition add_group.to_add_right_cancel_semigroup [trans_instance] [reducible] : add_right_cancel_semigroup A := ⦃ add_right_cancel_semigroup, s, add_right_cancel := @add_right_cancel A s ⦄ + theorem add_neg_eq_neg_add_rev {a b : A} : a + -b = -(b + -a) := + by rewrite [neg_add_rev, neg_neg] + /- sub -/ -- TODO: derive corresponding facts for div in a field - definition sub [reducible] (a b : A) : A := a + -b + protected definition algebra.sub [reducible] (a b : A) : A := a + -b - infix - := sub + definition add_group_has_sub [reducible] [instance] : has_sub A := + has_sub.mk algebra.sub theorem sub_eq_add_neg (a b : A) : a - b = a + -b := rfl @@ -408,7 +477,8 @@ section add_group theorem zero_sub (a : A) : 0 - a = -a := !zero_add - theorem sub_zero (a : A) : a - 0 = a := subst (eq.symm neg_zero) !add_zero + theorem sub_zero (a : A) : a - 0 = a := + by rewrite [sub_eq_add_neg, neg_zero, add_zero] theorem sub_neg_eq_add (a b : A) : a - (-b) = a + b := by change a + -(-b) = a + b; rewrite neg_neg @@ -416,7 +486,7 @@ section add_group theorem neg_sub (a b : A) : -(a - b) = b - a := neg_eq_of_add_eq_zero (calc - a - b + (b - a) = a - b + b - a : by rewrite -add.assoc + a - b + (b - a) = a - b + b - a : by krewrite -add.assoc ... = a - a : sub_add_cancel ... = 0 : sub_self) @@ -424,8 +494,8 @@ section add_group theorem sub_add_eq_sub_sub_swap (a b c : A) : a - (b + c) = a - c - b := calc - a - (b + c) = a + (-c - b) : neg_add_rev - ... = a - c - b : by rewrite add.assoc + a - (b + c) = a + (-c - b) : by rewrite [sub_eq_add_neg, neg_add_rev] + ... = a - c - b : by krewrite -add.assoc theorem sub_eq_iff_eq_add (a b c : A) : a - b = c ↔ a = c + b := iff.intro (assume H, eq_add_of_add_neg_eq H) (assume H, add_neg_eq_of_eq_add H) @@ -450,6 +520,7 @@ section add_group theorem add_eq_of_eq_sub {a b c : A} (H : a = c - b) : a + b = c := add_eq_of_eq_add_neg H + end add_group structure add_comm_group [class] (A : Type) extends add_group A, add_comm_monoid A @@ -484,6 +555,18 @@ section add_comm_group theorem add_eq_of_eq_sub' {a b c : A} (H : b = c - a) : a + b = c := !add.comm ▸ add_eq_of_eq_sub H + + theorem sub_sub_self (a b : A) : a - (a - b) = b := + by rewrite [sub_eq_add_neg, neg_sub, add.comm, sub_add_cancel] + + theorem add_sub_comm (a b c d : A) : a + b - (c + d) = (a - c) + (b - d) := + by rewrite [sub_add_eq_sub_sub, -sub_add_eq_add_sub a c b, add_sub] + + theorem sub_eq_sub_add_sub (a b c : A) : a - b = c - b + (a - c) := + by rewrite [add_sub, sub_add_cancel] ⬝ !add.comm + + theorem neg_neg_sub_neg (a b : A) : - (-a - -b) = a - b := + by rewrite [neg_sub, sub_neg_eq_add, neg_add_eq_sub] end add_comm_group definition group_of_add_group (A : Type) [G : add_group A] : group A := @@ -494,80 +577,127 @@ 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, - is_hset_carrier := !add_group.is_hset_carrier⦄ + mul_left_inv := add.left_inv⦄ -/- bundled structures -/ -structure Semigroup := -(carrier : Type) (struct : semigroup carrier) +namespace norm_num +reveal add.assoc -attribute Semigroup.carrier [coercion] -attribute Semigroup.struct [instance] +definition add1 [s : has_add A] [s' : has_one A] (a : A) : A := add a one -structure CommSemigroup := -(carrier : Type) (struct : comm_semigroup carrier) +theorem add_comm_four [s : add_comm_semigroup A] (a b : A) : a + a + (b + b) = (a + b) + (a + b) := + by rewrite [-add.assoc at {1}, add.comm, {a + b}add.comm at {1}, *add.assoc] -attribute CommSemigroup.carrier [coercion] -attribute CommSemigroup.struct [instance] +theorem add_comm_middle [s : add_comm_semigroup A] (a b c : A) : a + b + c = a + c + b := + by rewrite [add.assoc, add.comm b, -add.assoc] -structure Monoid := -(carrier : Type) (struct : monoid carrier) +theorem bit0_add_bit0 [s : add_comm_semigroup A] (a b : A) : bit0 a + bit0 b = bit0 (a + b) := + !add_comm_four -attribute Monoid.carrier [coercion] -attribute Monoid.struct [instance] +theorem bit0_add_bit0_helper [s : add_comm_semigroup A] (a b t : A) (H : a + b = t) : + bit0 a + bit0 b = bit0 t := + by rewrite -H; apply bit0_add_bit0 -structure CommMonoid := -(carrier : Type) (struct : comm_monoid carrier) +theorem bit1_add_bit0 [s : add_comm_semigroup A] [s' : has_one A] (a b : A) : + bit1 a + bit0 b = bit1 (a + b) := + begin + rewrite [↑bit0, ↑bit1, add_comm_middle], congruence, apply add_comm_four + end -attribute CommMonoid.carrier [coercion] -attribute CommMonoid.struct [instance] +theorem bit1_add_bit0_helper [s : add_comm_semigroup A] [s' : has_one A] (a b t : A) + (H : a + b = t) : bit1 a + bit0 b = bit1 t := + by rewrite -H; apply bit1_add_bit0 -structure Group := -(carrier : Type) (struct : group carrier) +theorem bit0_add_bit1 [s : add_comm_semigroup A] [s' : has_one A] (a b : A) : + bit0 a + bit1 b = bit1 (a + b) := + by rewrite [{bit0 a + _}add.comm, {a + _}add.comm]; apply bit1_add_bit0 -attribute Group.carrier [coercion] -attribute Group.struct [instance] +theorem bit0_add_bit1_helper [s : add_comm_semigroup A] [s' : has_one A] (a b t : A) + (H : a + b = t) : bit0 a + bit1 b = bit1 t := + by rewrite -H; apply bit0_add_bit1 -structure CommGroup := -(carrier : Type) (struct : comm_group carrier) +theorem bit1_add_bit1 [s : add_comm_semigroup A] [s' : has_one A] (a b : A) : + bit1 a + bit1 b = bit0 (add1 (a + b)) := + begin + rewrite ↑[bit0, bit1, add1, add.assoc], + rewrite [*add.assoc, {_ + (b + 1)}add.comm, {_ + (b + 1 + _)}add.comm, + {_ + (b + 1 + _ + _)}add.comm, *add.assoc, {1 + a}add.comm, -{b + (a + 1)}add.assoc, + {b + a}add.comm, *add.assoc] + end -attribute CommGroup.carrier [coercion] -attribute CommGroup.struct [instance] +theorem bit1_add_bit1_helper [s : add_comm_semigroup A] [s' : has_one A] (a b t s: A) + (H : (a + b) = t) (H2 : add1 t = s) : bit1 a + bit1 b = bit0 s := + begin rewrite [-H2, -H], apply bit1_add_bit1 end -structure AddSemigroup := -(carrier : Type) (struct : add_semigroup carrier) +theorem bin_add_zero [s : add_monoid A] (a : A) : a + zero = a := !add_zero -attribute AddSemigroup.carrier [coercion] -attribute AddSemigroup.struct [instance] +theorem bin_zero_add [s : add_monoid A] (a : A) : zero + a = a := !zero_add -structure AddCommSemigroup := -(carrier : Type) (struct : add_comm_semigroup carrier) +theorem one_add_bit0 [s : add_comm_semigroup A] [s' : has_one A] (a : A) : one + bit0 a = bit1 a := + begin rewrite ↑[bit0, bit1], rewrite add.comm end -attribute AddCommSemigroup.carrier [coercion] -attribute AddCommSemigroup.struct [instance] +theorem bit0_add_one [s : has_add A] [s' : has_one A] (a : A) : bit0 a + one = bit1 a := + rfl -structure AddMonoid := -(carrier : Type) (struct : add_monoid carrier) +theorem bit1_add_one [s : has_add A] [s' : has_one A] (a : A) : bit1 a + one = add1 (bit1 a) := + rfl -attribute AddMonoid.carrier [coercion] -attribute AddMonoid.struct [instance] +theorem bit1_add_one_helper [s : has_add A] [s' : has_one A] (a t : A) (H : add1 (bit1 a) = t) : + bit1 a + one = t := + by rewrite -H -structure AddCommMonoid := -(carrier : Type) (struct : add_comm_monoid carrier) +theorem one_add_bit1 [s : add_comm_semigroup A] [s' : has_one A] (a : A) : + one + bit1 a = add1 (bit1 a) := !add.comm -attribute AddCommMonoid.carrier [coercion] -attribute AddCommMonoid.struct [instance] +theorem one_add_bit1_helper [s : add_comm_semigroup A] [s' : has_one A] (a t : A) + (H : add1 (bit1 a) = t) : one + bit1 a = t := + by rewrite -H; apply one_add_bit1 -structure AddGroup := -(carrier : Type) (struct : add_group carrier) +theorem add1_bit0 [s : has_add A] [s' : has_one A] (a : A) : add1 (bit0 a) = bit1 a := + rfl -attribute AddGroup.carrier [coercion] -attribute AddGroup.struct [instance] +theorem add1_bit1 [s : add_comm_semigroup A] [s' : has_one A] (a : A) : + add1 (bit1 a) = bit0 (add1 a) := + begin + rewrite ↑[add1, bit1, bit0], + rewrite [add.assoc, add_comm_four] + end -structure AddCommGroup := -(carrier : Type) (struct : add_comm_group carrier) +theorem add1_bit1_helper [s : add_comm_semigroup A] [s' : has_one A] (a t : A) (H : add1 a = t) : + add1 (bit1 a) = bit0 t := + by rewrite -H; apply add1_bit1 -attribute AddCommGroup.carrier [coercion] -attribute AddCommGroup.struct [instance] +theorem add1_one [s : has_add A] [s' : has_one A] : add1 (one : A) = bit0 one := + rfl + +theorem add1_zero [s : add_monoid A] [s' : has_one A] : add1 (zero : A) = one := + begin + rewrite [↑add1, zero_add] + end + +theorem one_add_one [s : has_add A] [s' : has_one A] : (one : A) + one = bit0 one := + rfl + +theorem subst_into_sum [s : has_add A] (l r tl tr t : A) (prl : l = tl) (prr : r = tr) + (prt : tl + tr = t) : l + r = t := + by rewrite [prl, prr, prt] + +theorem neg_zero_helper [s : add_group A] (a : A) (H : a = 0) : - a = 0 := + by rewrite [H, neg_zero] + +end norm_num end algebra +open algebra + +attribute [simp] + zero_add add_zero one_mul mul_one + at simplifier.unit + +attribute [simp] + neg_neg sub_eq_add_neg + at simplifier.neg + +attribute [simp] + add.assoc add.comm add.left_comm + mul.left_comm mul.comm mul.assoc + at simplifier.ac diff --git a/hott/algebra/lattice.hlean b/hott/algebra/lattice.hlean new file mode 100644 index 000000000..70b289766 --- /dev/null +++ b/hott/algebra/lattice.hlean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: Jeremy Avigad +-/ +import .order + +open eq + +variable {A : Type} +set_option class.force_new true + +/- lattices (we could split this to upper- and lower-semilattices, if needed) -/ + +namespace algebra +structure lattice [class] (A : Type) extends weak_order A := +(inf : A → A → A) +(sup : A → A → A) +(inf_le_left : Π a b, le (inf a b) a) +(inf_le_right : Π a b, le (inf a b) b) +(le_inf : Πa b c, le c a → le c b → le c (inf a b)) +(le_sup_left : Π a b, le a (sup a b)) +(le_sup_right : Π a b, le b (sup a b)) +(sup_le : Π a b c, le a c → le b c → le (sup a b) c) + +definition inf := @lattice.inf +definition sup := @lattice.sup +infix ` ⊓ `:70 := inf +infix ` ⊔ `:65 := sup + +section + variable [s : lattice A] + include s + + theorem inf_le_left (a b : A) : a ⊓ b ≤ a := !lattice.inf_le_left + + theorem inf_le_right (a b : A) : a ⊓ b ≤ b := !lattice.inf_le_right + + theorem le_inf {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) : c ≤ a ⊓ b := !lattice.le_inf H₁ H₂ + + theorem le_sup_left (a b : A) : a ≤ a ⊔ b := !lattice.le_sup_left + + theorem le_sup_right (a b : A) : b ≤ a ⊔ b := !lattice.le_sup_right + + theorem sup_le {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) : a ⊔ b ≤ c := !lattice.sup_le H₁ H₂ + + /- inf -/ + + theorem eq_inf {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) (H₃ : Π{d}, d ≤ a → d ≤ b → d ≤ c) : + c = a ⊓ b := + le.antisymm (le_inf H₁ H₂) (H₃ !inf_le_left !inf_le_right) + + theorem inf.comm (a b : A) : a ⊓ b = b ⊓ a := + eq_inf !inf_le_right !inf_le_left (λ c H₁ H₂, le_inf H₂ H₁) + + theorem inf.assoc (a b c : A) : (a ⊓ b) ⊓ c = a ⊓ (b ⊓ c) := + begin + apply eq_inf, + { apply le.trans, apply inf_le_left, apply inf_le_left }, + { apply le_inf, apply le.trans, apply inf_le_left, apply inf_le_right, apply inf_le_right }, + { intros [d, H₁, H₂], apply le_inf, apply le_inf H₁, apply le.trans H₂, apply inf_le_left, + apply le.trans H₂, apply inf_le_right } + end + + theorem inf.left_comm (a b c : A) : a ⊓ (b ⊓ c) = b ⊓ (a ⊓ c) := + binary.left_comm (@inf.comm A s) (@inf.assoc A s) a b c + + theorem inf.right_comm (a b c : A) : (a ⊓ b) ⊓ c = (a ⊓ c) ⊓ b := + binary.right_comm (@inf.comm A s) (@inf.assoc A s) a b c + + theorem inf_self (a : A) : a ⊓ a = a := + by apply inverse; apply eq_inf (le.refl a) !le.refl; intros; assumption + + theorem inf_eq_left {a b : A} (H : a ≤ b) : a ⊓ b = a := + by apply inverse; apply eq_inf !le.refl H; intros; assumption + + theorem inf_eq_right {a b : A} (H : b ≤ a) : a ⊓ b = b := + eq.subst !inf.comm (inf_eq_left H) + + /- sup -/ + + theorem eq_sup {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) (H₃ : Π{d}, a ≤ d → b ≤ d → c ≤ d) : + c = a ⊔ b := + le.antisymm (H₃ !le_sup_left !le_sup_right) (sup_le H₁ H₂) + + theorem sup.comm (a b : A) : a ⊔ b = b ⊔ a := + eq_sup !le_sup_right !le_sup_left (λ c H₁ H₂, sup_le H₂ H₁) + + theorem sup.assoc (a b c : A) : (a ⊔ b) ⊔ c = a ⊔ (b ⊔ c) := + begin + apply eq_sup, + { apply le.trans, apply le_sup_left a b, apply le_sup_left }, + { apply sup_le, apply le.trans, apply le_sup_right a b, apply le_sup_left, apply le_sup_right }, + { intros [d, H₁, H₂], apply sup_le, apply sup_le H₁, apply le.trans !le_sup_left H₂, + apply le.trans !le_sup_right H₂} + end + + theorem sup.left_comm (a b c : A) : a ⊔ (b ⊔ c) = b ⊔ (a ⊔ c) := + binary.left_comm (@sup.comm A s) (@sup.assoc A s) a b c + + theorem sup.right_comm (a b c : A) : (a ⊔ b) ⊔ c = (a ⊔ c) ⊔ b := + binary.right_comm (@sup.comm A s) (@sup.assoc A s) a b c + + theorem sup_self (a : A) : a ⊔ a = a := + by apply inverse; apply eq_sup (le.refl a) !le.refl; intros; assumption + + theorem sup_eq_left {a b : A} (H : b ≤ a) : a ⊔ b = a := + by apply inverse; apply eq_sup !le.refl H; intros; assumption + + theorem sup_eq_right {a b : A} (H : a ≤ b) : a ⊔ b = b := + eq.subst !sup.comm (sup_eq_left H) +end + +end algebra diff --git a/hott/algebra/order.hlean b/hott/algebra/order.hlean index a4208e38c..ed8aa5752 100644 --- a/hott/algebra/order.hlean +++ b/hott/algebra/order.hlean @@ -3,45 +3,17 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Jeremy Avigad -Various types of orders. We develop weak orders "≤" and strict orders "<" separately. We also -consider structures with both, where the two are related by - - x < y ↔ (x ≤ y × x ≠ y) (order_pair) - x ≤ y ↔ (x < y ⊎ x = y) (strong_order_pair) - -These might not hold constructively in some applications, but we can define additional structures -with both < and ≤ as needed. -Ported from the standard library +Weak orders "≤", strict orders "<", and structures that include both. -/ - ---import logic.eq logic.connectives -open core prod - -namespace algebra +import algebra.binary algebra.priority +open eq eq.ops algebra +--set_option class.force_new true variable {A : Type} -/- overloaded symbols -/ - -structure has_le.{l} [class] (A : Type.{l}) : Type.{l+1} := -(le : A → A → Type.{l}) - -structure has_lt [class] (A : Type) := -(lt : A → A → Type₀) - -infixl <= := has_le.le -infixl ≤ := has_le.le -infixl < := has_lt.lt - -definition has_le.ge [reducible] {A : Type} [s : has_le A] (a b : A) := b ≤ a -notation a ≥ b := has_le.ge a b -notation a >= b := has_le.ge a b - -definition has_lt.gt [reducible] {A : Type} [s : has_lt A] (a b : A) := b < a -notation a > b := has_lt.gt a b - /- weak orders -/ +namespace algebra structure weak_order [class] (A : Type) extends has_le A := (le_refl : Πa, le a a) (le_trans : Πa b c, le a b → le b c → le a c) @@ -51,19 +23,22 @@ section variable [s : weak_order A] include s - definition le.refl (a : A) : a ≤ a := !weak_order.le_refl + theorem le.refl (a : A) : a ≤ a := !weak_order.le_refl - definition le.trans [trans] {a b c : A} : a ≤ b → b ≤ c → a ≤ c := !weak_order.le_trans + theorem le.trans [trans] {a b c : A} : a ≤ b → b ≤ c → a ≤ c := !weak_order.le_trans - definition ge.trans [trans] {a b c : A} (H1 : a ≥ b) (H2: b ≥ c) : a ≥ c := le.trans H2 H1 + theorem ge.trans [trans] {a b c : A} (H1 : a ≥ b) (H2: b ≥ c) : a ≥ c := le.trans H2 H1 - definition le.antisymm {a b : A} : a ≤ b → b ≤ a → a = b := !weak_order.le_antisymm + theorem le.antisymm {a b : A} : a ≤ b → b ≤ a → a = b := !weak_order.le_antisymm + + -- Alternate syntax. (Abbreviations do not migrate well.) + theorem eq_of_le_of_ge {a b : A} : a ≤ b → b ≤ a → a = b := !le.antisymm end -structure linear_weak_order [class] (A : Type) extends weak_order A : Type := +structure linear_weak_order [class] (A : Type) extends weak_order A := (le_total : Πa b, le a b ⊎ le b a) -definition le.total [s : linear_weak_order A] (a b : A) : a ≤ b ⊎ b ≤ a := +theorem le.total [s : linear_weak_order A] (a b : A) : a ≤ b ⊎ b ≤ a := !linear_weak_order.le_total /- strict orders -/ @@ -76,27 +51,31 @@ section variable [s : strict_order A] include s - definition lt.irrefl (a : A) : ¬ a < a := !strict_order.lt_irrefl + theorem lt.irrefl (a : A) : ¬ a < a := !strict_order.lt_irrefl + theorem not_lt_self (a : A) : ¬ a < a := !lt.irrefl -- alternate syntax - definition lt.trans [trans] {a b c : A} : a < b → b < c → a < c := !strict_order.lt_trans + theorem lt_self_iff_empty (a : A) : a < a ↔ empty := + iff_empty_intro (lt.irrefl a) - definition gt.trans [trans] {a b c : A} (H1 : a > b) (H2: b > c) : a > c := lt.trans H2 H1 + theorem lt.trans [trans] {a b c : A} : a < b → b < c → a < c := !strict_order.lt_trans - definition ne_of_lt {a b : A} (lt_ab : a < b) : a ≠ b := + theorem gt.trans [trans] {a b c : A} (H1 : a > b) (H2: b > c) : a > c := lt.trans H2 H1 + + theorem ne_of_lt {a b : A} (lt_ab : a < b) : a ≠ b := assume eq_ab : a = b, show empty, from lt.irrefl b (eq_ab ▸ lt_ab) - definition ne_of_gt {a b : A} (gt_ab : a > b) : a ≠ b := + theorem ne_of_gt {a b : A} (gt_ab : a > b) : a ≠ b := ne.symm (ne_of_lt gt_ab) - definition lt.asymm {a b : A} (H : a < b) : ¬ b < a := + theorem lt.asymm {a b : A} (H : a < b) : ¬ b < a := assume H1 : b < a, lt.irrefl _ (lt.trans H H1) + + theorem not_lt_of_gt {a b : A} (H : a > b) : ¬ a < b := !lt.asymm H -- alternate syntax end /- well-founded orders -/ --- TODO: do these duplicate what Leo has done? if so, eliminate - structure wf_strict_order [class] (A : Type) extends strict_order A := (wf_rec : ΠP : A → Type, (Πx, (Πy, lt y x → P y) → P x) → Πx, P x) @@ -109,132 +88,104 @@ definition wf.ind_on := @wf.rec_on /- structures with a weak and a strict order -/ structure order_pair [class] (A : Type) extends weak_order A, has_lt A := -(lt_iff_le_and_ne : Πa b, lt a b ↔ (le a b × a ≠ b)) +(le_of_lt : Π a b, lt a b → le a b) +(lt_of_lt_of_le : Π a b c, lt a b → le b c → lt a c) +(lt_of_le_of_lt : Π a b c, le a b → lt b c → lt a c) +(lt_irrefl : Π a, ¬ lt a a) section variable [s : order_pair A] variables {a b c : A} include s - definition lt_iff_le_and_ne : a < b ↔ (a ≤ b × a ≠ b) := - !order_pair.lt_iff_le_and_ne + theorem le_of_lt : a < b → a ≤ b := !order_pair.le_of_lt - definition le_of_lt (H : a < b) : a ≤ b := - pr1 (iff.mp lt_iff_le_and_ne H) + theorem lt_of_lt_of_le [trans] : a < b → b ≤ c → a < c := !order_pair.lt_of_lt_of_le - definition lt_of_le_of_ne (H1 : a ≤ b) (H2 : a ≠ b) : a < b := - iff.mp (iff.symm lt_iff_le_and_ne) (pair H1 H2) + theorem lt_of_le_of_lt [trans] : a ≤ b → b < c → a < c := !order_pair.lt_of_le_of_lt - private definition lt_irrefl (s' : order_pair A) (a : A) : ¬ a < a := - assume H : a < a, - have H1 : a ≠ a, from pr2 (iff.mp !lt_iff_le_and_ne H), - H1 rfl + private theorem lt_irrefl (s' : order_pair A) (a : A) : ¬ a < a := !order_pair.lt_irrefl - private definition lt_trans (s' : order_pair A) (a b c: A) (lt_ab : a < b) (lt_bc : b < c) : a < c := - have le_ab : a ≤ b, from le_of_lt lt_ab, - have le_bc : b ≤ c, from le_of_lt lt_bc, - have le_ac : a ≤ c, from le.trans le_ab le_bc, - have ne_ac : a ≠ c, from - assume eq_ac : a = c, - have le_ba : b ≤ a, from eq_ac⁻¹ ▸ le_bc, - have eq_ab : a = b, from le.antisymm le_ab le_ba, - have ne_ab : a ≠ b, from pr2 (iff.mp lt_iff_le_and_ne lt_ab), - ne_ab eq_ab, - show a < c, from lt_of_le_of_ne le_ac ne_ac + private theorem lt_trans (s' : order_pair A) (a b c: A) (lt_ab : a < b) (lt_bc : b < c) : a < c := + lt_of_lt_of_le lt_ab (le_of_lt lt_bc) - definition order_pair.to_strict_order [instance] [reducible] : strict_order A := + definition order_pair.to_strict_order [trans_instance] [reducible] : strict_order A := ⦃ strict_order, s, lt_irrefl := lt_irrefl s, lt_trans := lt_trans s ⦄ - definition lt_of_lt_of_le [trans] : a < b → b ≤ c → a < c := - assume lt_ab : a < b, - assume le_bc : b ≤ c, - have le_ac : a ≤ c, from le.trans (le_of_lt lt_ab) le_bc, - have ne_ac : a ≠ c, from - assume eq_ac : a = c, - 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 lt_of_le_of_ne le_ac ne_ac + theorem gt_of_gt_of_ge [trans] (H1 : a > b) (H2 : b ≥ c) : a > c := lt_of_le_of_lt H2 H1 - definition lt_of_le_of_lt [trans] : a ≤ b → b < c → a < c := - assume le_ab : a ≤ b, - assume lt_bc : b < c, - have le_ac : a ≤ c, from le.trans le_ab (le_of_lt lt_bc), - have ne_ac : a ≠ c, from - assume eq_ac : a = c, - 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 lt_of_le_of_ne le_ac ne_ac + theorem gt_of_ge_of_gt [trans] (H1 : a ≥ b) (H2 : b > c) : a > c := lt_of_lt_of_le H2 H1 - definition gt_of_gt_of_ge [trans] (H1 : a > b) (H2 : b ≥ c) : a > c := lt_of_le_of_lt H2 H1 - - definition gt_of_ge_of_gt [trans] (H1 : a ≥ b) (H2 : b > c) : a > c := lt_of_lt_of_le H2 H1 - - definition not_le_of_lt (H : a < b) : ¬ b ≤ a := - assume H1 : b ≤ a, + theorem not_le_of_gt (H : a > b) : ¬ a ≤ b := + assume H1 : a ≤ b, lt.irrefl _ (lt_of_lt_of_le H H1) - definition not_lt_of_le (H : a ≤ b) : ¬ b < a := - assume H1 : b < a, + theorem not_lt_of_ge (H : a ≥ b) : ¬ a < b := + assume H1 : a < b, lt.irrefl _ (lt_of_le_of_lt H H1) end -structure strong_order_pair [class] (A : Type) extends order_pair A := +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) +(lt_irrefl : Π a, ¬ lt a a) -definition le_iff_lt_or_eq [s : strong_order_pair A] {a b : A} : a ≤ b ↔ a < b ⊎ a = b := +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 -definition lt_or_eq_of_le [s : strong_order_pair A] {a b : A} (le_ab : a ≤ b) : a < b ⊎ a = b := +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 --- We can also construct a strong order pair by defining a strict order, and then defining --- x ≤ y ↔ x < y ⊎ x = y +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 -structure strict_order_with_le [class] (A : Type) extends strict_order A, has_le A := -(le_iff_lt_or_eq : Πa b, le a b ↔ lt a b ⊎ a = b) +private theorem lt_irrefl' [s : strong_order_pair A] (a : A) : ¬ a < a := +!strong_order_pair.lt_irrefl -private definition le_refl (s : strict_order_with_le A) (a : A) : a ≤ a := -iff.mp (iff.symm !strict_order_with_le.le_iff_lt_or_eq) (sum.inr rfl) +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) -private definition le_trans (s : strict_order_with_le A) (a b c : A) (le_ab : a ≤ b) (le_bc : b ≤ c) : a ≤ c := -sum.rec_on (iff.mp !strict_order_with_le.le_iff_lt_or_eq le_ab) - (assume lt_ab : a < b, - sum.rec_on (iff.mp !strict_order_with_le.le_iff_lt_or_eq le_bc) - (assume lt_bc : b < c, - iff.elim_right - !strict_order_with_le.le_iff_lt_or_eq (sum.inl (lt.trans lt_ab lt_bc))) - (assume eq_bc : b = c, eq_bc ▸ le_ab)) - (assume eq_ab : a = b, - eq_ab⁻¹ ▸ le_bc) - -private definition le_antisymm (s : strict_order_with_le A) (a b : A) (le_ab : a ≤ b) (le_ba : b ≤ a) : a = b := -sum.rec_on (iff.mp !strict_order_with_le.le_iff_lt_or_eq le_ab) - (assume lt_ab : a < b, - sum.rec_on (iff.mp !strict_order_with_le.le_iff_lt_or_eq le_ba) - (assume lt_ba : b < a, absurd (lt.trans lt_ab lt_ba) (lt.irrefl a)) - (assume eq_ba : b = a, eq_ba⁻¹)) - (assume eq_ab : a = b, eq_ab) - -private definition lt_iff_le_ne (s : strict_order_with_le A) (a b : A) : a < b ↔ a ≤ b × a ≠ b := +private theorem lt_iff_le_and_ne [s : strong_order_pair A] {a b : A} : a < b ↔ (a ≤ b × a ≠ b) := iff.intro - (assume lt_ab : a < b, - have le_ab : a ≤ b, from - iff.elim_right !strict_order_with_le.le_iff_lt_or_eq (sum.inl lt_ab), - show a ≤ b × a ≠ b, from pair le_ab (ne_of_lt lt_ab)) - (assume H : a ≤ b × a ≠ b, - have H1 : a < b ⊎ a = b, from - iff.mp !strict_order_with_le.le_iff_lt_or_eq (pr1 H), - show a < b, from sum_resolve_left H1 (pr2 H)) + (take Hlt, pair (le_of_lt_or_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), + sum_resolve_left Hor (prod.pr2 Hand)) -definition strict_order_with_le.to_order_pair [instance] [reducible] [s : strict_order_with_le A] : - strong_order_pair A := -⦃ strong_order_pair, s, - le_refl := le_refl s, - le_trans := le_trans s, - le_antisymm := le_antisymm s, - lt_iff_le_and_ne := lt_iff_le_ne s ⦄ +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) + +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) + +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, +assume le_bc : b ≤ c, +have le_ac : a ≤ c, from le.trans (le_of_lt' _ _ lt_ab) le_bc, +have ne_ac : a ≠ c, from + assume eq_ac : a = c, + 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) + +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, +assume lt_bc : b < c, +have le_ac : a ≤ c, from le.trans le_ab (le_of_lt' _ _ lt_bc), +have ne_ac : a ≠ c, from + assume eq_ac : a = c, + 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) + +definition strong_order_pair.to_order_pair [trans_instance] [reducible] + [s : strong_order_pair A] : order_pair A := +⦃ order_pair, s, + lt_irrefl := lt_irrefl', + le_of_lt := le_of_lt', + lt_of_le_of_lt := lt_of_le_of_lt', + lt_of_lt_of_le := lt_of_lt_of_le' ⦄ /- linear orders -/ @@ -243,52 +194,54 @@ structure linear_order_pair [class] (A : Type) extends order_pair A, linear_weak structure linear_strong_order_pair [class] (A : Type) extends strong_order_pair A, linear_weak_order A +definition linear_strong_order_pair.to_linear_order_pair [trans_instance] [reducible] + [s : linear_strong_order_pair A] : linear_order_pair A := +⦃ linear_order_pair, s, strong_order_pair.to_order_pair ⦄ + section variable [s : linear_strong_order_pair A] variables (a b c : A) include s - definition lt.trichotomy : a < b ⊎ a = b ⊎ b < a := - sum.rec_on (le.total a b) + theorem lt.trichotomy : a < b ⊎ a = b ⊎ b < a := + sum.elim (le.total a b) (assume H : a ≤ b, - sum.rec_on (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_or_eq _ _ _ _) H) (assume H1, sum.inl H1) (assume H1, sum.inr (sum.inl H1))) (assume H : b ≤ a, - sum.rec_on (iff.mp !le_iff_lt_or_eq H) + sum.elim (iff.mp (@le_iff_lt_or_eq _ _ _ _) H) (assume H1, sum.inr (sum.inr H1)) (assume H1, sum.inr (sum.inl (H1⁻¹)))) - definition lt.by_cases {a b : A} {P : Type} + theorem lt.by_cases {a b : A} {P : Type} (H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P := - sum.rec_on !lt.trichotomy + sum.elim !lt.trichotomy (assume H, H1 H) - (assume H, sum.rec_on H (assume H', H2 H') (assume H', H3 H')) + (assume H, sum.elim H (assume H', H2 H') (assume H', H3 H')) - definition linear_strong_order_pair.to_linear_order_pair [instance] [reducible] - : linear_order_pair A := - ⦃ linear_order_pair, s ⦄ - - definition le_of_not_lt {a b : A} (H : ¬ a < b) : b ≤ a := + 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') - definition lt_of_not_le {a b : A} (H : ¬ a ≤ b) : b < a := + theorem lt_of_not_ge {a b : A} (H : ¬ a ≥ b) : a < b := lt.by_cases (assume H', absurd (le_of_lt H') H) (assume H', absurd (H' ▸ !le.refl) H) (assume H', H') - definition lt_or_ge : a < b ⊎ a ≥ b := + theorem lt_or_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)) - definition le_or_gt : a ≤ b ⊎ a > b := + theorem le_or_gt : a ≤ b ⊎ a > b := !sum.swap (lt_or_ge b a) - definition lt_or_gt_of_ne {a b : A} (H : a ≠ b) : a < b ⊎ a > b := + theorem lt_or_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 +open decidable + structure decidable_linear_order [class] (A : Type) extends linear_strong_order_pair A := (decidable_lt : decidable_rel lt) @@ -305,12 +258,12 @@ section by_cases (assume H : a < b, inl (le_of_lt H)) (assume H : ¬ a < b, - have H1 : b ≤ a, from le_of_not_lt H, + have H1 : b ≤ a, from le_of_not_gt H, by_cases - (assume H2 : b < a, inr (not_le_of_lt H2)) - (assume H2 : ¬ b < a, inl (le_of_not_lt H2))) + (assume H2 : b < a, inr (not_le_of_gt H2)) + (assume H2 : ¬ b < a, inl (le_of_not_gt H2))) - definition decidable_eq [instance] : decidable (a = b) := + definition has_decidable_eq [instance] : decidable (a = b) := by_cases (assume H : a ≤ b, by_cases @@ -319,35 +272,161 @@ 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 := + 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 := + begin + cases eq_or_lt_of_not_lt (not_lt_of_ge H), + exact sum.inl a_1⁻¹, + exact sum.inr a_1 + end + + -- testing equality first may result in more definitional equalities definition lt.cases {B : Type} (a b : A) (t_lt t_eq t_gt : B) : B := if a = b then t_eq else (if a < b then t_lt else t_gt) - definition lt.cases_of_eq {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a = b) : + theorem lt.cases_of_eq {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a = b) : lt.cases a b t_lt t_eq t_gt = t_eq := if_pos H - definition lt.cases_of_lt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a < b) : + theorem lt.cases_of_lt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a < b) : lt.cases a b t_lt t_eq t_gt = t_lt := if_neg (ne_of_lt H) ⬝ if_pos H - definition lt.cases_of_gt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a > b) : + theorem lt.cases_of_gt {B : Type} {a b : A} {t_lt t_eq t_gt : B} (H : a > b) : lt.cases a b t_lt t_eq t_gt = t_gt := if_neg (ne.symm (ne_of_lt H)) ⬝ if_neg (lt.asymm H) + + 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 -/ + + theorem min_le_left (a b : A) : min a b ≤ a := + by_cases + (assume H : a ≤ b, by rewrite [↑min, if_pos H]; apply le.refl) + (assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H]; apply le_of_lt (lt_of_not_ge H)) + + theorem min_le_right (a b : A) : min a b ≤ b := + by_cases + (assume H : a ≤ b, by rewrite [↑min, if_pos H]; apply H) + (assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H]; apply le.refl) + + theorem le_min {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) : c ≤ min a b := + by_cases + (assume H : a ≤ b, by rewrite [↑min, if_pos H]; apply H₁) + (assume H : ¬ a ≤ b, by rewrite [↑min, if_neg H]; apply H₂) + + theorem le_max_left (a b : A) : a ≤ max a b := + by_cases + (assume H : a ≤ b, by rewrite [↑max, if_pos H]; apply H) + (assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H]; apply le.refl) + + theorem le_max_right (a b : A) : b ≤ max a b := + by_cases + (assume H : a ≤ b, by rewrite [↑max, if_pos H]; apply le.refl) + (assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H]; apply le_of_lt (lt_of_not_ge H)) + + theorem max_le {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) : max a b ≤ c := + by_cases + (assume H : a ≤ b, by rewrite [↑max, if_pos H]; apply H₂) + (assume H : ¬ a ≤ b, by rewrite [↑max, if_neg H]; apply H₁) + + theorem le_max_left_iff_unit (a b : A) : a ≤ max a b ↔ unit := + iff_unit_intro (le_max_left a b) + + 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 -/ + + 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 := + le.antisymm (le_min H₁ H₂) (H₃ !min_le_left !min_le_right) + + theorem min.comm (a b : A) : min a b = min b a := + eq_min !min_le_right !min_le_left (λ c H₁ H₂, le_min H₂ H₁) + + theorem min.assoc (a b c : A) : min (min a b) c = min a (min b c) := + begin + apply eq_min, + { apply le.trans, apply min_le_left, apply min_le_left }, + { apply le_min, apply le.trans, apply min_le_left, apply min_le_right, apply min_le_right }, + { intros [d, H₁, H₂], apply le_min, apply le_min H₁, apply le.trans H₂, apply min_le_left, + apply le.trans H₂, apply min_le_right } + end + + theorem min.left_comm (a b c : A) : min a (min b c) = min b (min a c) := + binary.left_comm (@min.comm A s) (@min.assoc A s) a b c + + theorem min.right_comm (a b c : A) : min (min a b) c = min (min a c) b := + binary.right_comm (@min.comm A s) (@min.assoc A s) a b c + + theorem min_self (a : A) : min a a = a := + by apply inverse; apply eq_min (le.refl a) !le.refl; intros; assumption + + theorem min_eq_left {a b : A} (H : a ≤ b) : min a b = a := + by apply inverse; apply eq_min !le.refl H; intros; assumption + + theorem min_eq_right {a b : A} (H : b ≤ a) : min a b = b := + eq.subst !min.comm (min_eq_left H) + + theorem eq_max {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) (H₃ : Π{d}, a ≤ d → b ≤ d → c ≤ d) : + c = max a b := + le.antisymm (H₃ !le_max_left !le_max_right) (max_le H₁ H₂) + + theorem max.comm (a b : A) : max a b = max b a := + eq_max !le_max_right !le_max_left (λ c H₁ H₂, max_le H₂ H₁) + + theorem max.assoc (a b c : A) : max (max a b) c = max a (max b c) := + begin + apply eq_max, + { apply le.trans, apply le_max_left a b, apply le_max_left }, + { apply max_le, apply le.trans, apply le_max_right a b, apply le_max_left, apply le_max_right }, + { intros [d, H₁, H₂], apply max_le, apply max_le H₁, apply le.trans !le_max_left H₂, + apply le.trans !le_max_right H₂} + end + + theorem max.left_comm (a b c : A) : max a (max b c) = max b (max a c) := + binary.left_comm (@max.comm A s) (@max.assoc A s) a b c + + theorem max.right_comm (a b c : A) : max (max a b) c = max (max a c) b := + binary.right_comm (@max.comm A s) (@max.assoc A s) a b c + + theorem max_self (a : A) : max a a = a := + by apply inverse; apply eq_max (le.refl a) !le.refl; intros; assumption + + theorem max_eq_left {a b : A} (H : b ≤ a) : max a b = a := + by apply inverse; apply eq_max !le.refl H; intros; assumption + + theorem max_eq_right {a b : A} (H : a ≤ b) : max a b = b := + eq.subst !max.comm (max_eq_left H) + + /- these rely on lt_of_lt -/ + + theorem min_eq_left_of_lt {a b : A} (H : a < b) : min a b = a := + min_eq_left (le_of_lt H) + + theorem min_eq_right_of_lt {a b : A} (H : b < a) : min a b = b := + min_eq_right (le_of_lt H) + + theorem max_eq_left_of_lt {a b : A} (H : b < a) : max a b = a := + max_eq_left (le_of_lt H) + + theorem max_eq_right_of_lt {a b : A} (H : a < b) : max a b = b := + max_eq_right (le_of_lt H) + + /- 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 + (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 + (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 - end algebra - -/- -For reference, these are all the transitivity rules defined in this file: -calc_trans le.trans -calc_trans lt.trans - -calc_trans lt_of_lt_of_le -calc_trans lt_of_le_of_lt - -calc_trans ge.trans -calc_trans gt.trans - -calc_trans gt_of_gt_of_ge -calc_trans gt_of_ge_of_gt --/ diff --git a/hott/algebra/ordered_field.hlean b/hott/algebra/ordered_field.hlean new file mode 100644 index 000000000..01a6cd913 --- /dev/null +++ b/hott/algebra/ordered_field.hlean @@ -0,0 +1,518 @@ +/- +Copyright (c) 2014 Robert Lewis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Lewis +-/ +import algebra.ordered_ring algebra.field +open eq eq.ops algebra + +namespace algebra +structure linear_ordered_field [class] (A : Type) extends linear_ordered_ring A, field A + +section linear_ordered_field + + variable {A : Type} + variables [s : linear_ordered_field A] {a b c d : A} + include s + + -- helpers for following + theorem mul_zero_lt_mul_inv_of_pos (H : 0 < a) : a * 0 < a * (1 / a) := + calc + a * 0 = 0 : mul_zero + ... < 1 : zero_lt_one + ... = a * a⁻¹ : mul_inv_cancel (ne.symm (ne_of_lt H)) + ... = a * (1 / a) : inv_eq_one_div + + theorem mul_zero_lt_mul_inv_of_neg (H : a < 0) : a * 0 < a * (1 / a) := + calc + a * 0 = 0 : mul_zero + ... < 1 : zero_lt_one + ... = a * a⁻¹ : mul_inv_cancel (ne_of_lt H) + ... = a * (1 / a) : inv_eq_one_div + + theorem one_div_pos_of_pos (H : 0 < a) : 0 < 1 / a := + lt_of_mul_lt_mul_left (mul_zero_lt_mul_inv_of_pos H) (le_of_lt H) + + theorem one_div_neg_of_neg (H : a < 0) : 1 / a < 0 := + gt_of_mul_lt_mul_neg_left (mul_zero_lt_mul_inv_of_neg H) (le_of_lt H) + + + theorem le_mul_of_ge_one_right (Hb : b ≥ 0) (H : a ≥ 1) : b ≤ b * a := + mul_one _ ▸ (mul_le_mul_of_nonneg_left H Hb) + + theorem lt_mul_of_gt_one_right (Hb : b > 0) (H : a > 1) : b < b * a := + mul_one _ ▸ (mul_lt_mul_of_pos_left H Hb) + + theorem one_le_div_iff_le (a : A) {b : A} (Hb : b > 0) : 1 ≤ a / b ↔ b ≤ a := + have Hb' : b ≠ 0, from ne.symm (ne_of_lt Hb), + iff.intro + (assume H : 1 ≤ a / b, + calc + b = b : refl + ... ≤ b * (a / b) : le_mul_of_ge_one_right (le_of_lt Hb) H + ... = a : mul_div_cancel' Hb') + (assume H : b ≤ a, + have Hbinv : 1 / b > 0, from one_div_pos_of_pos Hb, calc + 1 = b * (1 / b) : mul_one_div_cancel Hb' + ... ≤ a * (1 / b) : mul_le_mul_of_nonneg_right H (le_of_lt Hbinv) + ... = a / b : div_eq_mul_one_div) + + theorem le_of_one_le_div (Hb : b > 0) (H : 1 ≤ a / b) : b ≤ a := + (iff.mp (!one_le_div_iff_le Hb)) H + + theorem one_le_div_of_le (Hb : b > 0) (H : b ≤ a) : 1 ≤ a / b := + (iff.mpr (!one_le_div_iff_le Hb)) H + + theorem one_lt_div_iff_lt (a : A) {b : A} (Hb : b > 0) : 1 < a / b ↔ b < a := + have Hb' : b ≠ 0, from ne.symm (ne_of_lt Hb), + iff.intro + (assume H : 1 < a / b, + calc + b < b * (a / b) : lt_mul_of_gt_one_right Hb H + ... = a : mul_div_cancel' Hb') + (assume H : b < a, + have Hbinv : 1 / b > 0, from one_div_pos_of_pos Hb, calc + 1 = b * (1 / b) : mul_one_div_cancel Hb' + ... < a * (1 / b) : mul_lt_mul_of_pos_right H Hbinv + ... = a / b : div_eq_mul_one_div) + + theorem lt_of_one_lt_div (Hb : b > 0) (H : 1 < a / b) : b < a := + (iff.mp (!one_lt_div_iff_lt Hb)) H + + theorem one_lt_div_of_lt (Hb : b > 0) (H : b < a) : 1 < a / b := + (iff.mpr (!one_lt_div_iff_lt Hb)) H + + theorem exists_lt (a : A) : Σ x, x < a := + have H : a - 1 < a, from add_lt_of_le_of_neg (le.refl _) zero_gt_neg_one, + sigma.mk _ H + + theorem exists_gt (a : A) : Σ x, x > a := + have H : a + 1 > a, from lt_add_of_le_of_pos (le.refl _) zero_lt_one, + sigma.mk _ H + + -- the following theorems amount to four iffs, for <, ≤, ≥, >. + + theorem mul_le_of_le_div (Hc : 0 < c) (H : a ≤ b / c) : a * c ≤ b := + !div_mul_cancel (ne.symm (ne_of_lt Hc)) ▸ mul_le_mul_of_nonneg_right H (le_of_lt Hc) + + theorem le_div_of_mul_le (Hc : 0 < c) (H : a * c ≤ b) : a ≤ b / c := + calc + a = a * c * (1 / c) : !mul_mul_div (ne.symm (ne_of_lt Hc)) + ... ≤ b * (1 / c) : mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hc)) + ... = b / c : div_eq_mul_one_div + + theorem mul_lt_of_lt_div (Hc : 0 < c) (H : a < b / c) : a * c < b := + !div_mul_cancel (ne.symm (ne_of_lt Hc)) ▸ mul_lt_mul_of_pos_right H Hc + + theorem lt_div_of_mul_lt (Hc : 0 < c) (H : a * c < b) : a < b / c := + calc + a = a * c * (1 / c) : !mul_mul_div (ne.symm (ne_of_lt Hc)) + ... < b * (1 / c) : mul_lt_mul_of_pos_right H (one_div_pos_of_pos Hc) + ... = b / c : div_eq_mul_one_div + + theorem mul_le_of_div_le_of_neg (Hc : c < 0) (H : b / c ≤ a) : a * c ≤ b := + !div_mul_cancel (ne_of_lt Hc) ▸ mul_le_mul_of_nonpos_right H (le_of_lt Hc) + + theorem div_le_of_mul_le_of_neg (Hc : c < 0) (H : a * c ≤ b) : b / c ≤ a := + calc + a = a * c * (1 / c) : !mul_mul_div (ne_of_lt Hc) + ... ≥ b * (1 / c) : mul_le_mul_of_nonpos_right H (le_of_lt (one_div_neg_of_neg Hc)) + ... = b / c : div_eq_mul_one_div + + theorem mul_lt_of_gt_div_of_neg (Hc : c < 0) (H : a > b / c) : a * c < b := + !div_mul_cancel (ne_of_lt Hc) ▸ mul_lt_mul_of_neg_right H Hc + + theorem div_lt_of_mul_gt_of_neg (Hc : c < 0) (H : a * c < b) : b / c < a := + calc + a = a * c * (1 / c) : !mul_mul_div (ne_of_lt Hc) + ... > b * (1 / c) : mul_lt_mul_of_neg_right H (one_div_neg_of_neg Hc) + ... = b / c : div_eq_mul_one_div + + theorem div_le_of_le_mul (Hb : b > 0) (H : a ≤ b * c) : a / b ≤ c := + calc + a / b = a * (1 / b) : div_eq_mul_one_div + ... ≤ (b * c) * (1 / b) : mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hb)) + ... = (b * c) / b : div_eq_mul_one_div + ... = c : mul_div_cancel_left (ne.symm (ne_of_lt Hb)) + + theorem le_mul_of_div_le (Hc : c > 0) (H : a / c ≤ b) : a ≤ b * c := + calc + a = a / c * c : !div_mul_cancel (ne.symm (ne_of_lt Hc)) + ... ≤ b * c : mul_le_mul_of_nonneg_right H (le_of_lt Hc) + + -- following these in the isabelle file, there are 8 biconditionals for the above with - signs + -- skipping for now + + theorem mul_sub_mul_div_mul_neg (Hc : c ≠ 0) (Hd : d ≠ 0) (H : a / c < b / d) : + (a * d - b * c) / (c * d) < 0 := + have H1 : a / c - b / d < 0, from calc + a / c - b / d < b / d - b / d : sub_lt_sub_right H + ... = 0 : sub_self, + calc + 0 > a / c - b / d : H1 + ... = (a * d - c * b) / (c * d) : !div_sub_div Hc Hd + ... = (a * d - b * c) / (c * d) : mul.comm + + theorem mul_sub_mul_div_mul_nonpos (Hc : c ≠ 0) (Hd : d ≠ 0) (H : a / c ≤ b / d) : + (a * d - b * c) / (c * d) ≤ 0 := + have H1 : a / c - b / d ≤ 0, from calc + a / c - b / d ≤ b / d - b / d : sub_le_sub_right H + ... = 0 : sub_self, + calc + 0 ≥ a / c - b / d : H1 + ... = (a * d - c * b) / (c * d) : !div_sub_div Hc Hd + ... = (a * d - b * c) / (c * d) : mul.comm + + theorem div_lt_div_of_mul_sub_mul_div_neg (Hc : c ≠ 0) (Hd : d ≠ 0) + (H : (a * d - b * c) / (c * d) < 0) : a / c < b / d := + assert H1 : (a * d - c * b) / (c * d) < 0, by rewrite [mul.comm c b]; exact H, + assert H2 : a / c - b / d < 0, by rewrite [!div_sub_div Hc Hd]; exact H1, + assert H3 : a / c - b / d + b / d < 0 + b / d, from add_lt_add_right H2 _, + begin rewrite [zero_add at H3, sub_eq_add_neg at H3, neg_add_cancel_right at H3], exact H3 end + + theorem div_le_div_of_mul_sub_mul_div_nonpos (Hc : c ≠ 0) (Hd : d ≠ 0) + (H : (a * d - b * c) / (c * d) ≤ 0) : a / c ≤ b / d := + assert H1 : (a * d - c * b) / (c * d) ≤ 0, by rewrite [mul.comm c b]; exact H, + assert H2 : a / c - b / d ≤ 0, by rewrite [!div_sub_div Hc Hd]; exact H1, + assert H3 : a / c - b / d + b / d ≤ 0 + b / d, from add_le_add_right H2 _, + begin rewrite [zero_add at H3, sub_eq_add_neg at H3, neg_add_cancel_right at H3], exact H3 end + + theorem div_pos_of_pos_of_pos (Ha : 0 < a) (Hb : 0 < b) : 0 < a / b := + begin + rewrite div_eq_mul_one_div, + apply mul_pos, + exact Ha, + apply one_div_pos_of_pos, + exact Hb + end + + theorem div_nonneg_of_nonneg_of_pos (Ha : 0 ≤ a) (Hb : 0 < b) : 0 ≤ a / b := + begin + rewrite div_eq_mul_one_div, + apply mul_nonneg, + exact Ha, + apply le_of_lt, + apply one_div_pos_of_pos, + exact Hb + end + + theorem div_neg_of_neg_of_pos (Ha : a < 0) (Hb : 0 < b) : a / b < 0:= + begin + rewrite div_eq_mul_one_div, + apply mul_neg_of_neg_of_pos, + exact Ha, + apply one_div_pos_of_pos, + exact Hb + end + + theorem div_nonpos_of_nonpos_of_pos (Ha : a ≤ 0) (Hb : 0 < b) : a / b ≤ 0 := + begin + rewrite div_eq_mul_one_div, + apply mul_nonpos_of_nonpos_of_nonneg, + exact Ha, + apply le_of_lt, + apply one_div_pos_of_pos, + exact Hb + end + + theorem div_neg_of_pos_of_neg (Ha : 0 < a) (Hb : b < 0) : a / b < 0 := + begin + rewrite div_eq_mul_one_div, + apply mul_neg_of_pos_of_neg, + exact Ha, + apply one_div_neg_of_neg, + exact Hb + end + + theorem div_nonpos_of_nonneg_of_neg (Ha : 0 ≤ a) (Hb : b < 0) : a / b ≤ 0 := + begin + rewrite div_eq_mul_one_div, + apply mul_nonpos_of_nonneg_of_nonpos, + exact Ha, + apply le_of_lt, + apply one_div_neg_of_neg, + exact Hb + end + + theorem div_pos_of_neg_of_neg (Ha : a < 0) (Hb : b < 0) : 0 < a / b := + begin + rewrite div_eq_mul_one_div, + apply mul_pos_of_neg_of_neg, + exact Ha, + apply one_div_neg_of_neg, + exact Hb + end + + theorem div_nonneg_of_nonpos_of_neg (Ha : a ≤ 0) (Hb : b < 0) : 0 ≤ a / b := + begin + rewrite div_eq_mul_one_div, + apply mul_nonneg_of_nonpos_of_nonpos, + exact Ha, + apply le_of_lt, + apply one_div_neg_of_neg, + exact Hb + end + + theorem div_lt_div_of_lt_of_pos (H : a < b) (Hc : 0 < c) : a / c < b / c := + begin + rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div], + exact mul_lt_mul_of_pos_right H (one_div_pos_of_pos Hc) + end + + theorem div_le_div_of_le_of_pos (H : a ≤ b) (Hc : 0 < c) : a / c ≤ b / c := + begin + rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div], + exact mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hc)) + end + + theorem div_lt_div_of_lt_of_neg (H : b < a) (Hc : c < 0) : a / c < b / c := + begin + rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div], + exact mul_lt_mul_of_neg_right H (one_div_neg_of_neg Hc) + end + + theorem div_le_div_of_le_of_neg (H : b ≤ a) (Hc : c < 0) : a / c ≤ b / c := + begin + rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div], + exact mul_le_mul_of_nonpos_right H (le_of_lt (one_div_neg_of_neg Hc)) + end + + theorem two_pos : (1 : A) + 1 > 0 := + add_pos zero_lt_one zero_lt_one + + theorem one_add_one_ne_zero : 1 + 1 ≠ (0:A) := + ne.symm (ne_of_lt two_pos) + + theorem two_ne_zero : 2 ≠ (0:A) := + by unfold bit0; apply one_add_one_ne_zero + + theorem add_halves (a : A) : a / 2 + a / 2 = a := + calc + a / 2 + a / 2 = (a + a) / 2 : by rewrite div_add_div_same + ... = (a * 1 + a * 1) / 2 : by rewrite mul_one + ... = (a * (1 + 1)) / 2 : by rewrite left_distrib + ... = (a * 2) / 2 : by rewrite one_add_one_eq_two + ... = a : by rewrite [@mul_div_cancel A _ _ _ two_ne_zero] + + theorem sub_self_div_two (a : A) : a - a / 2 = a / 2 := + by rewrite [-{a}add_halves at {1}, add_sub_cancel] + + theorem add_midpoint {a b : A} (H : a < b) : a + (b - a) / 2 < b := + begin + rewrite [-div_sub_div_same, sub_eq_add_neg, {b / 2 + _}add.comm, -add.assoc, -sub_eq_add_neg], + apply add_lt_of_lt_sub_right, + rewrite *sub_self_div_two, + apply div_lt_div_of_lt_of_pos H two_pos + end + + theorem div_two_sub_self (a : A) : a / 2 - a = - (a / 2) := + by rewrite [-{a}add_halves at {2}, sub_add_eq_sub_sub, sub_self, zero_sub] + + theorem add_self_div_two (a : A) : (a + a) / 2 = a := + symm (iff.mpr (!eq_div_iff_mul_eq (ne_of_gt (add_pos zero_lt_one zero_lt_one))) + (by krewrite [left_distrib, *mul_one])) + + theorem two_ge_one : (2:A) ≥ 1 := + calc (2:A) = 1+1 : one_add_one_eq_two + ... ≥ 1+0 : add_le_add_left (le_of_lt zero_lt_one) + ... = 1 : add_zero + + theorem mul_le_mul_of_mul_div_le (H : a * (b / c) ≤ d) (Hc : c > 0) : b * a ≤ d * c := + begin + rewrite [-mul_div_assoc at H, mul.comm b], + apply le_mul_of_div_le Hc H + end + + theorem div_two_lt_of_pos (H : a > 0) : a / (1 + 1) < a := + have Ha : a / (1 + 1) > 0, from div_pos_of_pos_of_pos H (add_pos zero_lt_one zero_lt_one), + calc + a / (1 + 1) < a / (1 + 1) + a / (1 + 1) : lt_add_of_pos_left Ha + ... = a : add_halves + + theorem div_mul_le_div_mul_of_div_le_div_pos {e : A} (Hb : b ≠ 0) (Hd : d ≠ 0) (H : a / b ≤ c / d) + (He : e > 0) : a / (b * e) ≤ c / (d * e) := + begin + rewrite [!field.div_mul_eq_div_mul_one_div Hb (ne_of_gt He), + !field.div_mul_eq_div_mul_one_div Hd (ne_of_gt He)], + apply mul_le_mul_of_nonneg_right H, + apply le_of_lt, + 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 := + 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 + ... = b + a + b - b : add_sub_cancel + ... = b + b + a - b : add.right_comm + ... = (b + b) + (a - b) : add_sub, + assert H3 : (a + a) / 2 > ((b + b) + (a - b)) / 2, + from div_lt_div_of_lt_of_pos H2 two_pos, + by rewrite [one_add_one_eq_two, sub_eq_add_neg, add_self_div_two at H3, -div_add_div_same at H3, add_self_div_two at H3]; + exact H3) + (div_pos_of_pos_of_pos (iff.mpr !sub_pos_iff_lt H) two_pos)) + + theorem ge_of_forall_ge_sub {a b : A} (H : Π ε : A, ε > 0 → a ≥ b - ε) : a ≥ b := + begin + apply le_of_not_gt, + intro Hb, + cases exists_add_lt_and_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 + +end linear_ordered_field + +structure discrete_linear_ordered_field [class] (A : Type) extends linear_ordered_field A, + decidable_linear_ordered_comm_ring A := + (inv_zero : inv zero = zero) + +section discrete_linear_ordered_field + + variable {A : Type} + variables [s : discrete_linear_ordered_field A] {a b c : A} + include s + + definition dec_eq_of_dec_lt : Π x y : A, decidable (x = y) := + take x y, + decidable.by_cases + (assume H : x < y, decidable.inr (ne_of_lt H)) + (assume H : ¬ x < y, + decidable.by_cases + (assume H' : y < x, decidable.inr (ne.symm (ne_of_lt H'))) + (assume H' : ¬ y < x, + decidable.inl (le.antisymm (le_of_not_gt H') (le_of_not_gt H)))) + + definition discrete_linear_ordered_field.to_discrete_field [trans_instance] [reducible] + : discrete_field A := + ⦃ discrete_field, s, has_decidable_eq := dec_eq_of_dec_lt⦄ + + theorem pos_of_one_div_pos (H : 0 < 1 / a) : 0 < a := + have H1 : 0 < 1 / (1 / a), from one_div_pos_of_pos H, + have H2 : 1 / a ≠ 0, from + (assume H3 : 1 / a = 0, + have H4 : 1 / (1 / a) = 0, from H3⁻¹ ▸ !div_zero, + absurd H4 (ne.symm (ne_of_lt H1))), + (division_ring.one_div_one_div (ne_zero_of_one_div_ne_zero H2)) ▸ H1 + + theorem neg_of_one_div_neg (H : 1 / a < 0) : a < 0 := + have H1 : 0 < - (1 / a), from neg_pos_of_neg H, + have Ha : a ≠ 0, from ne_zero_of_one_div_ne_zero (ne_of_lt H), + have H2 : 0 < 1 / (-a), from (division_ring.one_div_neg_eq_neg_one_div Ha)⁻¹ ▸ H1, + have H3 : 0 < -a, from pos_of_one_div_pos H2, + neg_of_neg_pos H3 + + theorem le_of_one_div_le_one_div (H : 0 < a) (Hl : 1 / a ≤ 1 / b) : b ≤ a := + have Hb : 0 < b, from pos_of_one_div_pos (calc + 0 < 1 / a : one_div_pos_of_pos H + ... ≤ 1 / b : Hl), + have H' : 1 ≤ a / b, from (calc + 1 = a / a : div_self (ne.symm (ne_of_lt H)) + ... = a * (1 / a) : div_eq_mul_one_div + ... ≤ a * (1 / b) : mul_le_mul_of_nonneg_left Hl (le_of_lt H) + ... = a / b : div_eq_mul_one_div + ), le_of_one_le_div Hb H' + + theorem le_of_one_div_le_one_div_of_neg (H : b < 0) (Hl : 1 / a ≤ 1 / b) : b ≤ a := + assert Ha : a ≠ 0, from ne_of_lt (neg_of_one_div_neg (calc + 1 / a ≤ 1 / b : Hl + ... < 0 : one_div_neg_of_neg H)), + have H' : -b > 0, from neg_pos_of_neg H, + have Hl' : - (1 / b) ≤ - (1 / a), from neg_le_neg Hl, + have Hl'' : 1 / - b ≤ 1 / - a, from calc + 1 / -b = - (1 / b) : by rewrite [division_ring.one_div_neg_eq_neg_one_div (ne_of_lt H)] + ... ≤ - (1 / a) : Hl' + ... = 1 / -a : by rewrite [division_ring.one_div_neg_eq_neg_one_div Ha], + le_of_neg_le_neg (le_of_one_div_le_one_div H' Hl'') + + theorem lt_of_one_div_lt_one_div (H : 0 < a) (Hl : 1 / a < 1 / b) : b < a := + have Hb : 0 < b, from pos_of_one_div_pos (calc + 0 < 1 / a : one_div_pos_of_pos H + ... < 1 / b : Hl), + have H : 1 < a / b, from (calc + 1 = a / a : div_self (ne.symm (ne_of_lt H)) + ... = a * (1 / a) : div_eq_mul_one_div + ... < a * (1 / b) : mul_lt_mul_of_pos_left Hl H + ... = a / b : div_eq_mul_one_div), + lt_of_one_lt_div Hb H + + theorem lt_of_one_div_lt_one_div_of_neg (H : b < 0) (Hl : 1 / a < 1 / b) : b < a := + have H1 : b ≤ a, from le_of_one_div_le_one_div_of_neg H (le_of_lt Hl), + have Hn : b ≠ a, from + (assume Hn' : b = a, + have Hl' : 1 / a = 1 / b, from Hn' ▸ refl _, + absurd Hl' (ne_of_lt Hl)), + lt_of_le_of_ne H1 Hn + + theorem one_div_lt_one_div_of_lt (Ha : 0 < a) (H : a < b) : 1 / b < 1 / a := + lt_of_not_ge + (assume H', + absurd H (not_lt_of_ge (le_of_one_div_le_one_div Ha H'))) + + theorem one_div_le_one_div_of_le (Ha : 0 < a) (H : a ≤ b) : 1 / b ≤ 1 / a := + le_of_not_gt + (assume H', + absurd H (not_le_of_gt (lt_of_one_div_lt_one_div Ha H'))) + + theorem one_div_lt_one_div_of_lt_of_neg (Hb : b < 0) (H : a < b) : 1 / b < 1 / a := + lt_of_not_ge + (assume H', + absurd H (not_lt_of_ge (le_of_one_div_le_one_div_of_neg Hb H'))) + + theorem one_div_le_one_div_of_le_of_neg (Hb : b < 0) (H : a ≤ b) : 1 / b ≤ 1 / a := + le_of_not_gt + (assume H', + absurd H (not_le_of_gt (lt_of_one_div_lt_one_div_of_neg Hb H'))) + + theorem one_lt_one_div (H1 : 0 < a) (H2 : a < 1) : 1 < 1 / a := + one_div_one ▸ one_div_lt_one_div_of_lt H1 H2 + + theorem one_le_one_div (H1 : 0 < a) (H2 : a ≤ 1) : 1 ≤ 1 / a := + one_div_one ▸ one_div_le_one_div_of_le H1 H2 + + theorem one_div_lt_neg_one (H1 : a < 0) (H2 : -1 < a) : 1 / a < -1 := + one_div_neg_one_eq_neg_one ▸ one_div_lt_one_div_of_lt_of_neg H1 H2 + + theorem one_div_le_neg_one (H1 : a < 0) (H2 : -1 ≤ a) : 1 / a ≤ -1 := + one_div_neg_one_eq_neg_one ▸ one_div_le_one_div_of_le_of_neg H1 H2 + + theorem div_lt_div_of_pos_of_lt_of_pos (Hb : 0 < b) (H : b < a) (Hc : 0 < c) : c / a < c / b := + begin + apply iff.mp !sub_neg_iff_lt, + rewrite [div_eq_mul_one_div, {c / b}div_eq_mul_one_div, -mul_sub_left_distrib], + apply mul_neg_of_pos_of_neg, + exact Hc, + apply iff.mpr !sub_neg_iff_lt, + apply one_div_lt_one_div_of_lt, + repeat assumption + end + + theorem div_mul_le_div_mul_of_div_le_div_pos' {d e : A} (H : a / b ≤ c / d) + (He : e > 0) : a / (b * e) ≤ c / (d * e) := + begin + rewrite [2 div_mul_eq_div_mul_one_div], + apply mul_le_mul_of_nonneg_right H, + apply le_of_lt, + apply one_div_pos_of_pos He + end + + theorem abs_one_div (a : A) : abs (1 / a) = 1 / abs a := + if H : a > 0 then + by rewrite [abs_of_pos H, abs_of_pos (one_div_pos_of_pos H)] + else + (if H' : a < 0 then + by rewrite [abs_of_neg H', abs_of_neg (one_div_neg_of_neg H'), + -(division_ring.one_div_neg_eq_neg_one_div (ne_of_lt H'))] + else + assert Heq : a = 0, from eq_of_le_of_ge (le_of_not_gt H) (le_of_not_gt H'), + by rewrite [Heq, div_zero, *abs_zero, div_zero]) + + theorem sign_eq_div_abs (a : A) : sign a = a / (abs a) := + decidable.by_cases + (suppose a = 0, by subst a; rewrite [zero_div, sign_zero]) + (suppose a ≠ 0, + have abs a ≠ 0, from assume H, this (eq_zero_of_abs_eq_zero H), + !eq_div_of_mul_eq this !eq_sign_mul_abs⁻¹) + +end discrete_linear_ordered_field +end algebra diff --git a/hott/algebra/ordered_group.hlean b/hott/algebra/ordered_group.hlean index 7d81fe1d0..c74300438 100644 --- a/hott/algebra/ordered_group.hlean +++ b/hott/algebra/ordered_group.hlean @@ -3,135 +3,126 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad -Partially ordered additive groups, modeled on Isabelle's library. We could refine the structures, -but we would have to declare more inheritance paths. -Ported from the standard library +Partially ordered additive groups, modeled on Isabelle's library. These classes can be refined +if necessary. -/ - -import .order .group -open core - -namespace algebra +import algebra.binary algebra.group algebra.order +open eq eq.ops algebra -- note: ⁻¹ will be overloaded +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 := (add_le_add_left : Πa b, le a b → Πc, le (add c a) (add c b)) (le_of_add_le_add_left : Πa b c, le (add a b) (add a c) → le b c) +(add_lt_add_left : Πa b, lt a b → Πc, lt (add c a) (add c b)) +(lt_of_add_lt_add_left : Πa b c, lt (add a b) (add a c) → lt b c) section variables [s : ordered_cancel_comm_monoid A] variables {a b c d e : A} include s - definition add_le_add_left (H : a ≤ b) (c : A) : c + a ≤ c + b := - !ordered_cancel_comm_monoid.add_le_add_left H c + theorem add_lt_add_left (H : a < b) (c : A) : c + a < c + b := + !ordered_cancel_comm_monoid.add_lt_add_left H c - definition add_le_add_right (H : a ≤ b) (c : A) : a + c ≤ b + c := - (add.comm c a) ▸ (add.comm c b) ▸ (add_le_add_left H c) - - definition add_le_add (Hab : a ≤ b) (Hcd : c ≤ d) : a + c ≤ b + d := - le.trans (add_le_add_right Hab c) (add_le_add_left Hcd b) - - definition add_lt_add_left (H : a < b) (c : A) : c + a < c + b := - have H1 : c + a ≤ c + b, from add_le_add_left (le_of_lt H) c, - have H2 : c + a ≠ c + b, from - take H3 : c + a = c + b, - have H4 : a = b, from add.left_cancel H3, - ne_of_lt H H4, - lt_of_le_of_ne H1 H2 - - definition add_lt_add_right (H : a < b) (c : A) : a + c < b + c := + theorem add_lt_add_right (H : a < b) (c : A) : a + c < b + c := begin rewrite [add.comm, {b + _}add.comm], exact (add_lt_add_left H c) end - definition le_add_of_nonneg_right (H : b ≥ 0) : a ≤ a + b := + theorem add_le_add_left (H : a ≤ b) (c : A) : c + a ≤ c + b := + !ordered_cancel_comm_monoid.add_le_add_left H c + + theorem add_le_add_right (H : a ≤ b) (c : A) : a + c ≤ b + c := + (add.comm c a) ▸ (add.comm c b) ▸ (add_le_add_left H c) + + theorem add_le_add (Hab : a ≤ b) (Hcd : c ≤ d) : a + c ≤ b + d := + le.trans (add_le_add_right Hab c) (add_le_add_left Hcd b) + + theorem le_add_of_nonneg_right (H : b ≥ 0) : a ≤ a + b := begin have H1 : a + b ≥ a + 0, from add_le_add_left H a, rewrite add_zero at H1, exact H1 end - definition le_add_of_nonneg_left (H : b ≥ 0) : a ≤ b + a := + theorem le_add_of_nonneg_left (H : b ≥ 0) : a ≤ b + a := begin have H1 : 0 + a ≤ b + a, from add_le_add_right H a, rewrite zero_add at H1, exact H1 end - definition add_lt_add (Hab : a < b) (Hcd : c < d) : a + c < b + d := + theorem add_lt_add (Hab : a < b) (Hcd : c < d) : a + c < b + d := lt.trans (add_lt_add_right Hab c) (add_lt_add_left Hcd b) - definition add_lt_add_of_le_of_lt (Hab : a ≤ b) (Hcd : c < d) : a + c < b + d := + theorem add_lt_add_of_le_of_lt (Hab : a ≤ b) (Hcd : c < d) : a + c < b + d := lt_of_le_of_lt (add_le_add_right Hab c) (add_lt_add_left Hcd b) - definition add_lt_add_of_lt_of_le (Hab : a < b) (Hcd : c ≤ d) : a + c < b + d := + theorem add_lt_add_of_lt_of_le (Hab : a < b) (Hcd : c ≤ d) : a + c < b + d := lt_of_lt_of_le (add_lt_add_right Hab c) (add_le_add_left Hcd b) - definition lt_add_of_pos_right (H : b > 0) : a < a + b := !add_zero ▸ add_lt_add_left H a + theorem lt_add_of_pos_right (H : b > 0) : a < a + b := !add_zero ▸ add_lt_add_left H a - definition lt_add_of_pos_left (H : b > 0) : a < b + a := !zero_add ▸ add_lt_add_right H a + theorem lt_add_of_pos_left (H : b > 0) : a < b + a := !zero_add ▸ add_lt_add_right H a -- here we start using le_of_add_le_add_left. - definition le_of_add_le_add_left (H : a + b ≤ a + c) : b ≤ c := + theorem le_of_add_le_add_left (H : a + b ≤ a + c) : b ≤ c := !ordered_cancel_comm_monoid.le_of_add_le_add_left H - definition le_of_add_le_add_right (H : a + b ≤ c + b) : a ≤ c := + theorem le_of_add_le_add_right (H : a + b ≤ c + b) : a ≤ c := le_of_add_le_add_left (show b + a ≤ b + c, begin rewrite [add.comm, {b + _}add.comm], exact H end) - definition lt_of_add_lt_add_left (H : a + b < a + c) : b < c := - have H1 : b ≤ c, from le_of_add_le_add_left (le_of_lt H), - have H2 : b ≠ c, from - assume H3 : b = c, lt.irrefl _ (H3 ▸ H), - lt_of_le_of_ne H1 H2 + theorem lt_of_add_lt_add_left (H : a + b < a + c) : b < c := + !ordered_cancel_comm_monoid.lt_of_add_lt_add_left H - definition lt_of_add_lt_add_right (H : a + b < c + b) : a < c := + theorem lt_of_add_lt_add_right (H : a + b < c + b) : a < c := lt_of_add_lt_add_left ((add.comm a b) ▸ (add.comm c b) ▸ H) - definition add_le_add_left_iff (a b c : A) : a + b ≤ a + c ↔ b ≤ c := + theorem add_le_add_left_iff (a b c : A) : a + b ≤ a + c ↔ b ≤ c := iff.intro le_of_add_le_add_left (assume H, add_le_add_left H _) - definition add_le_add_right_iff (a b c : A) : a + b ≤ c + b ↔ a ≤ c := + theorem add_le_add_right_iff (a b c : A) : a + b ≤ c + b ↔ a ≤ c := iff.intro le_of_add_le_add_right (assume H, add_le_add_right H _) - definition add_lt_add_left_iff (a b c : A) : a + b < a + c ↔ b < c := + theorem add_lt_add_left_iff (a b c : A) : a + b < a + c ↔ b < c := iff.intro lt_of_add_lt_add_left (assume H, add_lt_add_left H _) - definition add_lt_add_right_iff (a b c : A) : a + b < c + b ↔ a < c := + theorem add_lt_add_right_iff (a b c : A) : a + b < c + b ↔ a < c := iff.intro lt_of_add_lt_add_right (assume H, add_lt_add_right H _) -- here we start using properties of zero. - definition add_nonneg (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a + b := + theorem add_nonneg (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a + b := !zero_add ▸ (add_le_add Ha Hb) - definition add_pos (Ha : 0 < a) (Hb : 0 < b) : 0 < a + b := + theorem add_pos (Ha : 0 < a) (Hb : 0 < b) : 0 < a + b := !zero_add ▸ (add_lt_add Ha Hb) - definition add_pos_of_pos_of_nonneg (Ha : 0 < a) (Hb : 0 ≤ b) : 0 < a + b := + theorem add_pos_of_pos_of_nonneg (Ha : 0 < a) (Hb : 0 ≤ b) : 0 < a + b := !zero_add ▸ (add_lt_add_of_lt_of_le Ha Hb) - definition add_pos_of_nonneg_of_pos (Ha : 0 ≤ a) (Hb : 0 < b) : 0 < a + b := + theorem add_pos_of_nonneg_of_pos (Ha : 0 ≤ a) (Hb : 0 < b) : 0 < a + b := !zero_add ▸ (add_lt_add_of_le_of_lt Ha Hb) - definition add_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : a + b ≤ 0 := + theorem add_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : a + b ≤ 0 := !zero_add ▸ (add_le_add Ha Hb) - definition add_neg (Ha : a < 0) (Hb : b < 0) : a + b < 0 := + theorem add_neg (Ha : a < 0) (Hb : b < 0) : a + b < 0 := !zero_add ▸ (add_lt_add Ha Hb) - definition add_neg_of_neg_of_nonpos (Ha : a < 0) (Hb : b ≤ 0) : a + b < 0 := + theorem add_neg_of_neg_of_nonpos (Ha : a < 0) (Hb : b ≤ 0) : a + b < 0 := !zero_add ▸ (add_lt_add_of_lt_of_le Ha Hb) - definition add_neg_of_nonpos_of_neg (Ha : a ≤ 0) (Hb : b < 0) : a + b < 0 := + theorem add_neg_of_nonpos_of_neg (Ha : a ≤ 0) (Hb : b < 0) : a + b < 0 := !zero_add ▸ (add_lt_add_of_le_of_lt Ha Hb) -- TODO: add nonpos version (will be easier with simplifier) - definition add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg + theorem add_eq_zero_iff_eq_zero_and_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, @@ -144,267 +135,549 @@ section have Hb' : b ≤ 0, from calc b = 0 + b : by rewrite zero_add - ... ≤ a + b : add_le_add_right Ha + ... ≤ a + b : by exact add_le_add_right Ha _ ... = 0 : Hab, have Hbz : b = 0, from le.antisymm Hb' Hb, pair Haz Hbz) (assume Hab : a = 0 × b = 0, - match Hab with - | pair Ha' Hb' := by rewrite [Ha', Hb', add_zero] - end) + obtain Ha' Hb', from Hab, + by rewrite [Ha', Hb', add_zero]) - definition le_add_of_nonneg_of_le (Ha : 0 ≤ a) (Hbc : b ≤ c) : b ≤ a + c := + theorem le_add_of_nonneg_of_le (Ha : 0 ≤ a) (Hbc : b ≤ c) : b ≤ a + c := !zero_add ▸ add_le_add Ha Hbc - definition le_add_of_le_of_nonneg (Hbc : b ≤ c) (Ha : 0 ≤ a) : b ≤ c + a := + theorem le_add_of_le_of_nonneg (Hbc : b ≤ c) (Ha : 0 ≤ a) : b ≤ c + a := !add_zero ▸ add_le_add Hbc Ha - definition lt_add_of_pos_of_le (Ha : 0 < a) (Hbc : b ≤ c) : b < a + c := + theorem lt_add_of_pos_of_le (Ha : 0 < a) (Hbc : b ≤ c) : b < a + c := !zero_add ▸ add_lt_add_of_lt_of_le Ha Hbc - definition lt_add_of_le_of_pos (Hbc : b ≤ c) (Ha : 0 < a) : b < c + a := + theorem lt_add_of_le_of_pos (Hbc : b ≤ c) (Ha : 0 < a) : b < c + a := !add_zero ▸ add_lt_add_of_le_of_lt Hbc Ha - definition add_le_of_nonpos_of_le (Ha : a ≤ 0) (Hbc : b ≤ c) : a + b ≤ c := + theorem add_le_of_nonpos_of_le (Ha : a ≤ 0) (Hbc : b ≤ c) : a + b ≤ c := !zero_add ▸ add_le_add Ha Hbc - definition add_le_of_le_of_nonpos (Hbc : b ≤ c) (Ha : a ≤ 0) : b + a ≤ c := + theorem add_le_of_le_of_nonpos (Hbc : b ≤ c) (Ha : a ≤ 0) : b + a ≤ c := !add_zero ▸ add_le_add Hbc Ha - definition add_lt_of_neg_of_le (Ha : a < 0) (Hbc : b ≤ c) : a + b < c := + theorem add_lt_of_neg_of_le (Ha : a < 0) (Hbc : b ≤ c) : a + b < c := !zero_add ▸ add_lt_add_of_lt_of_le Ha Hbc - definition add_lt_of_le_of_neg (Hbc : b ≤ c) (Ha : a < 0) : b + a < c := + theorem add_lt_of_le_of_neg (Hbc : b ≤ c) (Ha : a < 0) : b + a < c := !add_zero ▸ add_lt_add_of_le_of_lt Hbc Ha - definition lt_add_of_nonneg_of_lt (Ha : 0 ≤ a) (Hbc : b < c) : b < a + c := + theorem lt_add_of_nonneg_of_lt (Ha : 0 ≤ a) (Hbc : b < c) : b < a + c := !zero_add ▸ add_lt_add_of_le_of_lt Ha Hbc - definition lt_add_of_lt_of_nonneg (Hbc : b < c) (Ha : 0 ≤ a) : b < c + a := + theorem lt_add_of_lt_of_nonneg (Hbc : b < c) (Ha : 0 ≤ a) : b < c + a := !add_zero ▸ add_lt_add_of_lt_of_le Hbc Ha - definition lt_add_of_pos_of_lt (Ha : 0 < a) (Hbc : b < c) : b < a + c := + theorem lt_add_of_pos_of_lt (Ha : 0 < a) (Hbc : b < c) : b < a + c := !zero_add ▸ add_lt_add Ha Hbc - definition lt_add_of_lt_of_pos (Hbc : b < c) (Ha : 0 < a) : b < c + a := + theorem lt_add_of_lt_of_pos (Hbc : b < c) (Ha : 0 < a) : b < c + a := !add_zero ▸ add_lt_add Hbc Ha - definition add_lt_of_nonpos_of_lt (Ha : a ≤ 0) (Hbc : b < c) : a + b < c := + theorem add_lt_of_nonpos_of_lt (Ha : a ≤ 0) (Hbc : b < c) : a + b < c := !zero_add ▸ add_lt_add_of_le_of_lt Ha Hbc - definition add_lt_of_lt_of_nonpos (Hbc : b < c) (Ha : a ≤ 0) : b + a < c := + theorem add_lt_of_lt_of_nonpos (Hbc : b < c) (Ha : a ≤ 0) : b + a < c := !add_zero ▸ add_lt_add_of_lt_of_le Hbc Ha - definition add_lt_of_neg_of_lt (Ha : a < 0) (Hbc : b < c) : a + b < c := + theorem add_lt_of_neg_of_lt (Ha : a < 0) (Hbc : b < c) : a + b < c := !zero_add ▸ add_lt_add Ha Hbc - definition add_lt_of_lt_of_neg (Hbc : b < c) (Ha : a < 0) : b + a < c := + theorem add_lt_of_lt_of_neg (Hbc : b < c) (Ha : a < 0) : b + a < c := !add_zero ▸ add_lt_add Hbc Ha end --- TODO: add properties of max and min - /- partially ordered groups -/ structure ordered_comm_group [class] (A : Type) extends add_comm_group A, order_pair A := (add_le_add_left : Πa b, le a b → Πc, le (add c a) (add c b)) +(add_lt_add_left : Πa b, lt a b → Π c, lt (add c a) (add c b)) -definition ordered_comm_group.le_of_add_le_add_left [s : ordered_comm_group A] {a b c : A} (H : a + b ≤ a + c) : b ≤ c := +theorem ordered_comm_group.le_of_add_le_add_left [s : ordered_comm_group A] {a b c : A} + (H : a + b ≤ a + c) : b ≤ c := assert H' : -a + (a + b) ≤ -a + (a + c), from ordered_comm_group.add_le_add_left _ _ H _, by rewrite *neg_add_cancel_left at H'; exact H' -definition ordered_comm_group.to_ordered_cancel_comm_monoid [instance] [reducible] +theorem ordered_comm_group.lt_of_add_lt_add_left [s : ordered_comm_group A] {a b c : A} + (H : a + b < a + c) : b < c := +assert H' : -a + (a + b) < -a + (a + c), from ordered_comm_group.add_lt_add_left _ _ H _, +by rewrite *neg_add_cancel_left at H'; exact H' + +definition ordered_comm_group.to_ordered_cancel_comm_monoid [trans_instance] [reducible] [s : ordered_comm_group A] : ordered_cancel_comm_monoid A := ⦃ ordered_cancel_comm_monoid, s, add_left_cancel := @add.left_cancel A _, add_right_cancel := @add.right_cancel A _, - le_of_add_le_add_left := @ordered_comm_group.le_of_add_le_add_left A _ ⦄ + le_of_add_le_add_left := @ordered_comm_group.le_of_add_le_add_left A _, + lt_of_add_lt_add_left := @ordered_comm_group.lt_of_add_lt_add_left A _⦄ section variables [s : ordered_comm_group A] (a b c d e : A) include s - definition neg_le_neg {a b : A} (H : a ≤ b) : -b ≤ -a := + theorem neg_le_neg {a b : A} (H : a ≤ b) : -b ≤ -a := have H1 : 0 ≤ -a + b, from !add.left_inv ▸ !(add_le_add_left H), !add_neg_cancel_right ▸ !zero_add ▸ add_le_add_right H1 (-b) - definition le_of_neg_le_neg {a b : A} (H : -b ≤ -a) : a ≤ b := + theorem le_of_neg_le_neg {a b : A} (H : -b ≤ -a) : a ≤ b := neg_neg a ▸ neg_neg b ▸ neg_le_neg H - definition neg_le_neg_iff_le : -a ≤ -b ↔ b ≤ a := + theorem neg_le_neg_iff_le : -a ≤ -b ↔ b ≤ a := iff.intro le_of_neg_le_neg neg_le_neg - definition nonneg_of_neg_nonpos {a : A} (H : -a ≤ 0) : 0 ≤ a := + theorem nonneg_of_neg_nonpos {a : A} (H : -a ≤ 0) : 0 ≤ a := le_of_neg_le_neg (neg_zero⁻¹ ▸ H) - definition neg_nonpos_of_nonneg {a : A} (H : 0 ≤ a) : -a ≤ 0 := + theorem neg_nonpos_of_nonneg {a : A} (H : 0 ≤ a) : -a ≤ 0 := neg_zero ▸ neg_le_neg H - definition neg_nonpos_iff_nonneg : -a ≤ 0 ↔ 0 ≤ a := + theorem neg_nonpos_iff_nonneg : -a ≤ 0 ↔ 0 ≤ a := iff.intro nonneg_of_neg_nonpos neg_nonpos_of_nonneg - definition nonpos_of_neg_nonneg {a : A} (H : 0 ≤ -a) : a ≤ 0 := + theorem nonpos_of_neg_nonneg {a : A} (H : 0 ≤ -a) : a ≤ 0 := le_of_neg_le_neg (neg_zero⁻¹ ▸ H) - definition neg_nonneg_of_nonpos {a : A} (H : a ≤ 0) : 0 ≤ -a := + theorem neg_nonneg_of_nonpos {a : A} (H : a ≤ 0) : 0 ≤ -a := neg_zero ▸ neg_le_neg H - definition neg_nonneg_iff_nonpos : 0 ≤ -a ↔ a ≤ 0 := + theorem neg_nonneg_iff_nonpos : 0 ≤ -a ↔ a ≤ 0 := iff.intro nonpos_of_neg_nonneg neg_nonneg_of_nonpos - definition neg_lt_neg {a b : A} (H : a < b) : -b < -a := + theorem neg_lt_neg {a b : A} (H : a < b) : -b < -a := have H1 : 0 < -a + b, from !add.left_inv ▸ !(add_lt_add_left H), !add_neg_cancel_right ▸ !zero_add ▸ add_lt_add_right H1 (-b) - definition lt_of_neg_lt_neg {a b : A} (H : -b < -a) : a < b := + theorem lt_of_neg_lt_neg {a b : A} (H : -b < -a) : a < b := neg_neg a ▸ neg_neg b ▸ neg_lt_neg H - definition neg_lt_neg_iff_lt : -a < -b ↔ b < a := + theorem neg_lt_neg_iff_lt : -a < -b ↔ b < a := iff.intro lt_of_neg_lt_neg neg_lt_neg - definition pos_of_neg_neg {a : A} (H : -a < 0) : 0 < a := + theorem pos_of_neg_neg {a : A} (H : -a < 0) : 0 < a := lt_of_neg_lt_neg (neg_zero⁻¹ ▸ H) - definition neg_neg_of_pos {a : A} (H : 0 < a) : -a < 0 := + theorem neg_neg_of_pos {a : A} (H : 0 < a) : -a < 0 := neg_zero ▸ neg_lt_neg H - definition neg_neg_iff_pos : -a < 0 ↔ 0 < a := + theorem neg_neg_iff_pos : -a < 0 ↔ 0 < a := iff.intro pos_of_neg_neg neg_neg_of_pos - definition neg_of_neg_pos {a : A} (H : 0 < -a) : a < 0 := + theorem neg_of_neg_pos {a : A} (H : 0 < -a) : a < 0 := lt_of_neg_lt_neg (neg_zero⁻¹ ▸ H) - definition neg_pos_of_neg {a : A} (H : a < 0) : 0 < -a := + theorem neg_pos_of_neg {a : A} (H : a < 0) : 0 < -a := neg_zero ▸ neg_lt_neg H - definition neg_pos_iff_neg : 0 < -a ↔ a < 0 := + theorem neg_pos_iff_neg : 0 < -a ↔ a < 0 := iff.intro neg_of_neg_pos neg_pos_of_neg - definition le_neg_iff_le_neg : a ≤ -b ↔ b ≤ -a := !neg_neg ▸ !neg_le_neg_iff_le + theorem le_neg_iff_le_neg : a ≤ -b ↔ b ≤ -a := !neg_neg ▸ !neg_le_neg_iff_le - definition neg_le_iff_neg_le : -a ≤ b ↔ -b ≤ a := !neg_neg ▸ !neg_le_neg_iff_le + theorem le_neg_of_le_neg {a b : A} : a ≤ -b → b ≤ -a := iff.mp !le_neg_iff_le_neg - definition lt_neg_iff_lt_neg : a < -b ↔ b < -a := !neg_neg ▸ !neg_lt_neg_iff_lt + theorem neg_le_iff_neg_le : -a ≤ b ↔ -b ≤ a := !neg_neg ▸ !neg_le_neg_iff_le - definition neg_lt_iff_neg_lt : -a < b ↔ -b < a := !neg_neg ▸ !neg_lt_neg_iff_lt + theorem neg_le_of_neg_le {a b : A} : -a ≤ b → -b ≤ a := iff.mp !neg_le_iff_neg_le - definition sub_nonneg_iff_le : 0 ≤ a - b ↔ b ≤ a := !sub_self ▸ !add_le_add_right_iff + theorem lt_neg_iff_lt_neg : a < -b ↔ b < -a := !neg_neg ▸ !neg_lt_neg_iff_lt - definition sub_nonpos_iff_le : a - b ≤ 0 ↔ a ≤ b := !sub_self ▸ !add_le_add_right_iff + theorem lt_neg_of_lt_neg {a b : A} : a < -b → b < -a := iff.mp !lt_neg_iff_lt_neg - definition sub_pos_iff_lt : 0 < a - b ↔ b < a := !sub_self ▸ !add_lt_add_right_iff + theorem neg_lt_iff_neg_lt : -a < b ↔ -b < a := !neg_neg ▸ !neg_lt_neg_iff_lt - definition sub_neg_iff_lt : a - b < 0 ↔ a < b := !sub_self ▸ !add_lt_add_right_iff + theorem neg_lt_of_neg_lt {a b : A} : -a < b → -b < a := iff.mp !neg_lt_iff_neg_lt - definition add_le_iff_le_neg_add : a + b ≤ c ↔ b ≤ -a + c := + theorem sub_nonneg_iff_le : 0 ≤ a - b ↔ b ≤ a := !sub_self ▸ !add_le_add_right_iff + + theorem sub_nonneg_of_le {a b : A} : b ≤ a → 0 ≤ a - b := iff.mpr !sub_nonneg_iff_le + + theorem le_of_sub_nonneg {a b : A} : 0 ≤ a - b → b ≤ a := iff.mp !sub_nonneg_iff_le + + theorem sub_nonpos_iff_le : a - b ≤ 0 ↔ a ≤ b := !sub_self ▸ !add_le_add_right_iff + + theorem sub_nonpos_of_le {a b : A} : a ≤ b → a - b ≤ 0 := iff.mpr !sub_nonpos_iff_le + + theorem le_of_sub_nonpos {a b : A} : a - b ≤ 0 → a ≤ b := iff.mp !sub_nonpos_iff_le + + theorem sub_pos_iff_lt : 0 < a - b ↔ b < a := !sub_self ▸ !add_lt_add_right_iff + + theorem sub_pos_of_lt {a b : A} : b < a → 0 < a - b := iff.mpr !sub_pos_iff_lt + + theorem lt_of_sub_pos {a b : A} : 0 < a - b → b < a := iff.mp !sub_pos_iff_lt + + theorem sub_neg_iff_lt : a - b < 0 ↔ a < b := !sub_self ▸ !add_lt_add_right_iff + + theorem sub_neg_of_lt {a b : A} : a < b → a - b < 0 := iff.mpr !sub_neg_iff_lt + + theorem lt_of_sub_neg {a b : A} : a - b < 0 → a < b := iff.mp !sub_neg_iff_lt + + theorem add_le_iff_le_neg_add : a + b ≤ c ↔ b ≤ -a + c := have H: a + b ≤ c ↔ -a + (a + b) ≤ -a + c, from iff.symm (!add_le_add_left_iff), !neg_add_cancel_left ▸ H - definition add_le_iff_le_sub_left : a + b ≤ c ↔ b ≤ c - a := + theorem add_le_of_le_neg_add {a b c : A} : b ≤ -a + c → a + b ≤ c := + iff.mpr !add_le_iff_le_neg_add + + theorem le_neg_add_of_add_le {a b c : A} : a + b ≤ c → b ≤ -a + c := + iff.mp !add_le_iff_le_neg_add + + theorem add_le_iff_le_sub_left : a + b ≤ c ↔ b ≤ c - a := by rewrite [sub_eq_add_neg, {c+_}add.comm]; apply add_le_iff_le_neg_add - definition add_le_iff_le_sub_right : a + b ≤ c ↔ a ≤ c - b := - have H: a + b ≤ c ↔ a + b - b ≤ c - b, from iff.symm (!add_le_add_right_iff), + theorem add_le_of_le_sub_left {a b c : A} : b ≤ c - a → a + b ≤ c := + iff.mpr !add_le_iff_le_sub_left + + theorem le_sub_left_of_add_le {a b c : A} : a + b ≤ c → b ≤ c - a := + 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, !add_neg_cancel_right ▸ H - definition le_add_iff_neg_add_le : a ≤ b + c ↔ -b + a ≤ c := + theorem add_le_of_le_sub_right {a b c : A} : a ≤ c - b → a + b ≤ c := + iff.mpr !add_le_iff_le_sub_right + + theorem le_sub_right_of_add_le {a b c : A} : a + b ≤ c → a ≤ c - b := + iff.mp !add_le_iff_le_sub_right + + theorem le_add_iff_neg_add_le : a ≤ b + c ↔ -b + a ≤ c := assert H: a ≤ b + c ↔ -b + a ≤ -b + (b + c), from iff.symm (!add_le_add_left_iff), by rewrite neg_add_cancel_left at H; exact H - definition le_add_iff_sub_left_le : a ≤ b + c ↔ a - b ≤ c := + theorem le_add_of_neg_add_le {a b c : A} : -b + a ≤ c → a ≤ b + c := + iff.mpr !le_add_iff_neg_add_le + + theorem neg_add_le_of_le_add {a b c : A} : a ≤ b + c → -b + a ≤ c := + iff.mp !le_add_iff_neg_add_le + + theorem le_add_iff_sub_left_le : a ≤ b + c ↔ a - b ≤ c := by rewrite [sub_eq_add_neg, {a+_}add.comm]; apply le_add_iff_neg_add_le - definition le_add_iff_sub_right_le : a ≤ b + c ↔ a - c ≤ b := - assert H: a ≤ b + c ↔ a - c ≤ b + c - c, from iff.symm (!add_le_add_right_iff), - by rewrite add_neg_cancel_right at H; exact H + theorem le_add_of_sub_left_le {a b c : A} : a - b ≤ c → a ≤ b + c := + iff.mpr !le_add_iff_sub_left_le - definition add_lt_iff_lt_neg_add_left : a + b < c ↔ b < -a + c := + theorem sub_left_le_of_le_add {a b c : A} : a ≤ b + c → a - b ≤ c := + iff.mp !le_add_iff_sub_left_le + + theorem le_add_iff_sub_right_le : a ≤ b + c ↔ a - c ≤ b := + assert H: a ≤ b + c ↔ a - c ≤ b + c - c, from iff.symm (!add_le_add_right_iff), + by rewrite [sub_eq_add_neg (b+c) c at H, add_neg_cancel_right at H]; exact H + + theorem le_add_of_sub_right_le {a b c : A} : a - c ≤ b → a ≤ b + c := + iff.mpr !le_add_iff_sub_right_le + + theorem sub_right_le_of_le_add {a b c : A} : a ≤ b + c → a - c ≤ b := + iff.mp !le_add_iff_sub_right_le + + theorem le_add_iff_neg_add_le_left : a ≤ b + c ↔ -b + a ≤ c := + assert H: a ≤ b + c ↔ -b + a ≤ -b + (b + c), from iff.symm (!add_le_add_left_iff), + by rewrite neg_add_cancel_left at H; exact H + + theorem le_add_of_neg_add_le_left {a b c : A} : -b + a ≤ c → a ≤ b + c := + iff.mpr !le_add_iff_neg_add_le_left + + theorem neg_add_le_left_of_le_add {a b c : A} : a ≤ b + c → -b + a ≤ c := + iff.mp !le_add_iff_neg_add_le_left + + theorem le_add_iff_neg_add_le_right : a ≤ b + c ↔ -c + a ≤ b := + by rewrite add.comm; apply le_add_iff_neg_add_le_left + + theorem le_add_of_neg_add_le_right {a b c : A} : -c + a ≤ b → a ≤ b + c := + iff.mpr !le_add_iff_neg_add_le_right + + theorem neg_add_le_right_of_le_add {a b c : A} : a ≤ b + c → -c + a ≤ b := + iff.mp !le_add_iff_neg_add_le_right + + theorem le_add_iff_neg_le_sub_left : c ≤ a + b ↔ -a ≤ b - c := + assert H : c ≤ a + b ↔ -a + c ≤ b, from !le_add_iff_neg_add_le, + assert H' : -a + c ≤ b ↔ -a ≤ b - c, from !add_le_iff_le_sub_right, + iff.trans H H' + + theorem le_add_of_neg_le_sub_left {a b c : A} : -a ≤ b - c → c ≤ a + b := + iff.mpr !le_add_iff_neg_le_sub_left + + theorem neg_le_sub_left_of_le_add {a b c : A} : c ≤ a + b → -a ≤ b - c := + iff.mp !le_add_iff_neg_le_sub_left + + theorem le_add_iff_neg_le_sub_right : c ≤ a + b ↔ -b ≤ a - c := + by rewrite add.comm; apply le_add_iff_neg_le_sub_left + + theorem le_add_of_neg_le_sub_right {a b c : A} : -b ≤ a - c → c ≤ a + b := + iff.mpr !le_add_iff_neg_le_sub_right + + theorem neg_le_sub_right_of_le_add {a b c : A} : c ≤ a + b → -b ≤ a - c := + iff.mp !le_add_iff_neg_le_sub_right + + theorem add_lt_iff_lt_neg_add_left : a + b < c ↔ b < -a + c := assert H: a + b < c ↔ -a + (a + b) < -a + c, from iff.symm (!add_lt_add_left_iff), begin rewrite neg_add_cancel_left at H, exact H end - definition add_lt_iff_lt_neg_add_right : a + b < c ↔ a < -b + c := + theorem add_lt_of_lt_neg_add_left {a b c : A} : b < -a + c → a + b < c := + iff.mpr !add_lt_iff_lt_neg_add_left + + theorem lt_neg_add_left_of_add_lt {a b c : A} : a + b < c → b < -a + c := + iff.mp !add_lt_iff_lt_neg_add_left + + theorem add_lt_iff_lt_neg_add_right : a + b < c ↔ a < -b + c := by rewrite add.comm; apply add_lt_iff_lt_neg_add_left - definition add_lt_iff_lt_sub_left : a + b < c ↔ b < c - a := + theorem add_lt_of_lt_neg_add_right {a b c : A} : a < -b + c → a + b < c := + iff.mpr !add_lt_iff_lt_neg_add_right + + theorem lt_neg_add_right_of_add_lt {a b c : A} : a + b < c → a < -b + c := + iff.mp !add_lt_iff_lt_neg_add_right + + theorem add_lt_iff_lt_sub_left : a + b < c ↔ b < c - a := begin rewrite [sub_eq_add_neg, {c+_}add.comm], apply add_lt_iff_lt_neg_add_left end - definition add_lt_add_iff_lt_sub_right : a + b < c ↔ a < c - b := - assert H: a + b < c ↔ a + b - b < c - b, from iff.symm (!add_lt_add_right_iff), - by rewrite add_neg_cancel_right at H; exact H + theorem add_lt_of_lt_sub_left {a b c : A} : b < c - a → a + b < c := + iff.mpr !add_lt_iff_lt_sub_left - definition lt_add_iff_neg_add_lt_left : a < b + c ↔ -b + a < c := + theorem lt_sub_left_of_add_lt {a b c : A} : a + b < c → b < c - a := + iff.mp !add_lt_iff_lt_sub_left + + theorem add_lt_iff_lt_sub_right : a + b < c ↔ a < c - b := + assert H: a + b < c ↔ a + b - b < c - b, from iff.symm (!add_lt_add_right_iff), + by rewrite [sub_eq_add_neg at H, add_neg_cancel_right at H]; exact H + + theorem add_lt_of_lt_sub_right {a b c : A} : a < c - b → a + b < c := + iff.mpr !add_lt_iff_lt_sub_right + + theorem lt_sub_right_of_add_lt {a b c : A} : a + b < c → a < c - b := + iff.mp !add_lt_iff_lt_sub_right + + theorem lt_add_iff_neg_add_lt_left : a < b + c ↔ -b + a < c := assert H: a < b + c ↔ -b + a < -b + (b + c), from iff.symm (!add_lt_add_left_iff), by rewrite neg_add_cancel_left at H; exact H - definition lt_add_iff_neg_add_lt_right : a < b + c ↔ -c + a < b := + theorem lt_add_of_neg_add_lt_left {a b c : A} : -b + a < c → a < b + c := + iff.mpr !lt_add_iff_neg_add_lt_left + + theorem neg_add_lt_left_of_lt_add {a b c : A} : a < b + c → -b + a < c := + iff.mp !lt_add_iff_neg_add_lt_left + + theorem lt_add_iff_neg_add_lt_right : a < b + c ↔ -c + a < b := by rewrite add.comm; apply lt_add_iff_neg_add_lt_left - definition lt_add_iff_sub_lt_left : a < b + c ↔ a - b < c := + theorem lt_add_of_neg_add_lt_right {a b c : A} : -c + a < b → a < b + c := + iff.mpr !lt_add_iff_neg_add_lt_right + + theorem neg_add_lt_right_of_lt_add {a b c : A} : a < b + c → -c + a < b := + iff.mp !lt_add_iff_neg_add_lt_right + + theorem lt_add_iff_sub_lt_left : a < b + c ↔ a - b < c := by rewrite [sub_eq_add_neg, {a + _}add.comm]; apply lt_add_iff_neg_add_lt_left - definition lt_add_iff_sub_lt_right : a < b + c ↔ a - c < b := + theorem lt_add_of_sub_lt_left {a b c : A} : a - b < c → a < b + c := + iff.mpr !lt_add_iff_sub_lt_left + + theorem sub_lt_left_of_lt_add {a b c : A} : a < b + c → a - b < c := + iff.mp !lt_add_iff_sub_lt_left + + theorem lt_add_iff_sub_lt_right : a < b + c ↔ a - c < b := by rewrite add.comm; apply lt_add_iff_sub_lt_left + theorem lt_add_of_sub_lt_right {a b c : A} : a - c < b → a < b + c := + iff.mpr !lt_add_iff_sub_lt_right + + theorem sub_lt_right_of_lt_add {a b c : A} : a < b + c → a - c < b := + iff.mp !lt_add_iff_sub_lt_right + + theorem sub_lt_of_sub_lt {a b c : A} : a - b < c → a - c < b := + begin + intro H, + apply sub_lt_left_of_lt_add, + apply lt_add_of_sub_lt_right H + end + + theorem sub_le_of_sub_le {a b c : A} : a - b ≤ c → a - c ≤ b := + begin + intro H, + apply sub_left_le_of_le_add, + apply le_add_of_sub_right_le H + end + -- TODO: the Isabelle library has varations on a + b ≤ b ↔ a ≤ 0 - definition le_iff_le_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a ≤ b ↔ c ≤ d := + theorem le_iff_le_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a ≤ b ↔ c ≤ d := calc a ≤ b ↔ a - b ≤ 0 : iff.symm (sub_nonpos_iff_le a b) ... = (c - d ≤ 0) : by rewrite H ... ↔ c ≤ d : sub_nonpos_iff_le c d - definition lt_iff_lt_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a < b ↔ c < d := + theorem lt_iff_lt_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a < b ↔ c < d := calc a < b ↔ a - b < 0 : iff.symm (sub_neg_iff_lt a b) ... = (c - d < 0) : by rewrite H ... ↔ c < d : sub_neg_iff_lt c d - definition sub_le_sub_left {a b : A} (H : a ≤ b) (c : A) : c - b ≤ c - a := + theorem sub_le_sub_left {a b : A} (H : a ≤ b) (c : A) : c - b ≤ c - a := add_le_add_left (neg_le_neg H) c - definition sub_le_sub_right {a b : A} (H : a ≤ b) (c : A) : a - c ≤ b - c := add_le_add_right H (-c) + theorem sub_le_sub_right {a b : A} (H : a ≤ b) (c : A) : a - c ≤ b - c := add_le_add_right H (-c) - definition sub_le_sub {a b c d : A} (Hab : a ≤ b) (Hcd : c ≤ d) : a - d ≤ b - c := + theorem sub_le_sub {a b c d : A} (Hab : a ≤ b) (Hcd : c ≤ d) : a - d ≤ b - c := add_le_add Hab (neg_le_neg Hcd) - definition sub_lt_sub_left {a b : A} (H : a < b) (c : A) : c - b < c - a := + theorem sub_lt_sub_left {a b : A} (H : a < b) (c : A) : c - b < c - a := add_lt_add_left (neg_lt_neg H) c - definition sub_lt_sub_right {a b : A} (H : a < b) (c : A) : a - c < b - c := add_lt_add_right H (-c) + theorem sub_lt_sub_right {a b : A} (H : a < b) (c : A) : a - c < b - c := add_lt_add_right H (-c) - definition sub_lt_sub {a b c d : A} (Hab : a < b) (Hcd : c < d) : a - d < b - c := + theorem sub_lt_sub {a b c d : A} (Hab : a < b) (Hcd : c < d) : a - d < b - c := add_lt_add Hab (neg_lt_neg Hcd) - definition sub_lt_sub_of_le_of_lt {a b c d : A} (Hab : a ≤ b) (Hcd : c < d) : a - d < b - c := + theorem sub_lt_sub_of_le_of_lt {a b c d : A} (Hab : a ≤ b) (Hcd : c < d) : a - d < b - c := add_lt_add_of_le_of_lt Hab (neg_lt_neg Hcd) - definition sub_lt_sub_of_lt_of_le {a b c d : A} (Hab : a < b) (Hcd : c ≤ d) : a - d < b - c := + theorem sub_lt_sub_of_lt_of_le {a b c d : A} (Hab : a < b) (Hcd : c ≤ d) : a - d < b - c := add_lt_add_of_lt_of_le Hab (neg_le_neg Hcd) - definition sub_le_self (a : A) {b : A} (H : b ≥ 0) : a - b ≤ a := + theorem sub_le_self (a : A) {b : A} (H : b ≥ 0) : a - b ≤ a := calc a - b = a + -b : rfl ... ≤ a + 0 : add_le_add_left (neg_nonpos_of_nonneg H) ... = a : by rewrite add_zero - definition sub_lt_self (a : A) {b : A} (H : b > 0) : a - b < a := + theorem sub_lt_self (a : A) {b : A} (H : b > 0) : a - b < a := calc a - b = a + -b : rfl ... < a + 0 : add_lt_add_left (neg_neg_of_pos H) ... = a : by rewrite add_zero + + theorem add_le_add_three {a b c d e f : A} (H1 : a ≤ d) (H2 : b ≤ e) (H3 : c ≤ f) : + a + b + c ≤ d + e + f := + begin + apply le.trans, + apply add_le_add, + apply add_le_add, + repeat assumption, + apply le.refl + end + + theorem sub_le_of_nonneg {b : A} (H : b ≥ 0) : a - b ≤ a := + add_le_of_le_of_nonpos (le.refl a) (neg_nonpos_of_nonneg H) + + theorem sub_lt_of_pos {b : A} (H : b > 0) : a - b < a := + add_lt_of_le_of_neg (le.refl a) (neg_neg_of_pos H) + + theorem neg_add_neg_le_neg_of_pos {a : A} (H : a > 0) : -a + -a ≤ -a := + !neg_add ▸ neg_le_neg (le_add_of_nonneg_left (le_of_lt H)) end +/- linear ordered group with decidable order -/ + structure decidable_linear_ordered_comm_group [class] (A : Type) - extends ordered_comm_group A, decidable_linear_order A + extends add_comm_group A, decidable_linear_order A := + (add_le_add_left : Π a b, le a b → Π c, le (add c a) (add c b)) + (add_lt_add_left : Π a b, lt a b → Π c, lt (add c a) (add c b)) + +definition decidable_linear_ordered_comm_group.to_ordered_comm_group + [trans_instance] [reducible] + (A : Type) [s : decidable_linear_ordered_comm_group A] : ordered_comm_group A := +⦃ ordered_comm_group, s, + le_of_lt := @le_of_lt A _, + lt_of_le_of_lt := @lt_of_le_of_lt A _, + lt_of_lt_of_le := @lt_of_lt_of_le A _ ⦄ section variables [s : decidable_linear_ordered_comm_group A] variables {a b c d e : A} include s - definition eq_zero_of_neg_eq (H : -a = a) : a = 0 := + /- these can be generalized to a lattice ordered group -/ + + theorem min_add_add_left : min (a + b) (a + c) = a + min b c := + inverse (eq_min + (show a + min b c ≤ a + b, from add_le_add_left !min_le_left _) + (show a + min b c ≤ a + c, from add_le_add_left !min_le_right _) + (take d, + assume H₁ : d ≤ a + b, + assume H₂ : d ≤ a + c, + have H : d - a ≤ min b c, + from le_min (iff.mp !le_add_iff_sub_left_le H₁) (iff.mp !le_add_iff_sub_left_le H₂), + show d ≤ a + min b c, from iff.mpr !le_add_iff_sub_left_le H)) + + theorem min_add_add_right : min (a + c) (b + c) = min a b + c := + by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply min_add_add_left + + theorem max_add_add_left : max (a + b) (a + c) = a + max b c := + inverse (eq_max + (add_le_add_left !le_max_left _) + (add_le_add_left !le_max_right _) + (λ d H₁ H₂, + have H : max b c ≤ d - a, + from max_le (iff.mp !add_le_iff_le_sub_left H₁) (iff.mp !add_le_iff_le_sub_left H₂), + show a + max b c ≤ d, from iff.mpr !add_le_iff_le_sub_left H)) + + theorem max_add_add_right : max (a + c) (b + c) = max a b + c := + by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply max_add_add_left + + theorem max_neg_neg : max (-a) (-b) = - min a b := + inverse (eq_max + (show -a ≤ -(min a b), from neg_le_neg !min_le_left) + (show -b ≤ -(min a b), from neg_le_neg !min_le_right) + (take d, + assume H₁ : -a ≤ d, + assume H₂ : -b ≤ d, + have H : -d ≤ min a b, + from le_min (!iff.mp !neg_le_iff_neg_le H₁) (!iff.mp !neg_le_iff_neg_le H₂), + show -(min a b) ≤ d, from !iff.mp !neg_le_iff_neg_le H)) + + theorem min_eq_neg_max_neg_neg : min a b = - max (-a) (-b) := + by rewrite [max_neg_neg, neg_neg] + + theorem min_neg_neg : min (-a) (-b) = - max a b := + by rewrite [min_eq_neg_max_neg_neg, *neg_neg] + + theorem max_eq_neg_min_neg_neg : max a b = - min (-a) (-b) := + by rewrite [min_neg_neg, neg_neg] + + /- absolute value -/ + variables {a b c} + + definition abs (a : A) : A := max a (-a) + + theorem abs_of_nonneg (H : a ≥ 0) : abs a = a := + have H' : -a ≤ a, from le.trans (neg_nonpos_of_nonneg H) H, + max_eq_left H' + + theorem abs_of_pos (H : a > 0) : abs a = a := + abs_of_nonneg (le_of_lt H) + + theorem abs_of_nonpos (H : a ≤ 0) : abs a = -a := + have H' : a ≤ -a, from le.trans H (neg_nonneg_of_nonpos H), + max_eq_right H' + + theorem abs_of_neg (H : a < 0) : abs a = -a := abs_of_nonpos (le_of_lt H) + + theorem abs_zero : abs 0 = (0:A) := abs_of_nonneg (le.refl _) + + theorem abs_neg (a : A) : abs (-a) = abs a := + by rewrite [↑abs, max.comm, neg_neg] + + theorem abs_pos_of_pos (H : a > 0) : abs a > 0 := + by rewrite (abs_of_pos H); exact H + + theorem abs_pos_of_neg (H : a < 0) : abs a > 0 := + !abs_neg ▸ abs_pos_of_pos (neg_pos_of_neg H) + + theorem abs_sub (a b : A) : abs (a - b) = abs (b - a) := + by rewrite [-neg_sub, abs_neg] + + theorem ne_zero_of_abs_ne_zero {a : A} (H : abs a ≠ 0) : a ≠ 0 := + assume Ha, H (Ha⁻¹ ▸ abs_zero) + + /- these assume a linear order -/ + + theorem eq_zero_of_neg_eq (H : -a = a) : a = 0 := lt.by_cases (assume H1 : a < 0, have H2: a > 0, from H ▸ neg_pos_of_neg H1, @@ -414,75 +687,48 @@ section have H2: a < 0, from H ▸ neg_neg_of_pos H1, absurd H1 (lt.asymm H2)) - definition abs (a : A) : A := if 0 ≤ a then a else -a - - definition abs_of_nonneg (H : a ≥ 0) : abs a = a := if_pos H - - definition abs_of_pos (H : a > 0) : abs a = a := if_pos (le_of_lt H) - - definition abs_of_neg (H : a < 0) : abs a = -a := if_neg (not_le_of_lt H) - - definition abs_zero : abs 0 = (0:A) := abs_of_nonneg (le.refl _) - - definition abs_of_nonpos (H : a ≤ 0) : abs a = -a := - decidable.by_cases - (assume H1 : a = 0, by rewrite [H1, abs_zero, neg_zero]) - (assume H1 : a ≠ 0, - have H2 : a < 0, from lt_of_le_of_ne H H1, - abs_of_neg H2) - - definition abs_neg (a : A) : abs (-a) = abs a := - sum.rec_on (le.total 0 a) - (assume H1 : 0 ≤ a, by rewrite [abs_of_nonpos (neg_nonpos_of_nonneg H1), neg_neg, abs_of_nonneg H1]) - (assume H1 : a ≤ 0, by rewrite [abs_of_nonneg (neg_nonneg_of_nonpos H1), abs_of_nonpos H1]) - - definition abs_nonneg (a : A) : abs a ≥ 0 := - sum.rec_on (le.total 0 a) + theorem abs_nonneg (a : A) : abs a ≥ 0 := + sum.elim (le.total 0 a) (assume H : 0 ≤ a, by rewrite (abs_of_nonneg H); exact H) (assume H : a ≤ 0, calc 0 ≤ -a : neg_nonneg_of_nonpos H ... = abs a : abs_of_nonpos H) - definition abs_abs (a : A) : abs (abs a) = abs a := abs_of_nonneg !abs_nonneg + theorem abs_abs (a : A) : abs (abs a) = abs a := abs_of_nonneg !abs_nonneg - definition le_abs_self (a : A) : a ≤ abs a := - sum.rec_on (le.total 0 a) + theorem le_abs_self (a : A) : a ≤ abs a := + sum.elim (le.total 0 a) (assume H : 0 ≤ a, abs_of_nonneg H ▸ !le.refl) (assume H : a ≤ 0, le.trans H !abs_nonneg) - definition neg_le_abs_self (a : A) : -a ≤ abs a := + theorem neg_le_abs_self (a : A) : -a ≤ abs a := !abs_neg ▸ !le_abs_self - definition eq_zero_of_abs_eq_zero (H : abs a = 0) : a = 0 := + theorem eq_zero_of_abs_eq_zero (H : abs a = 0) : a = 0 := have H1 : a ≤ 0, from H ▸ le_abs_self a, have H2 : -a ≤ 0, from H ▸ abs_neg a ▸ le_abs_self (-a), le.antisymm H1 (nonneg_of_neg_nonpos H2) - definition abs_eq_zero_iff_eq_zero (a : A) : abs a = 0 ↔ a = 0 := + theorem abs_eq_zero_iff_eq_zero (a : A) : abs a = 0 ↔ a = 0 := iff.intro eq_zero_of_abs_eq_zero (assume H, ap abs H ⬝ !abs_zero) - definition abs_pos_of_pos (H : a > 0) : abs a > 0 := - by rewrite (abs_of_pos H); exact H + theorem eq_of_abs_sub_eq_zero {a b : A} (H : abs (a - b) = 0) : a = b := + have a - b = 0, from eq_zero_of_abs_eq_zero H, + show a = b, from eq_of_sub_eq_zero this - definition abs_pos_of_neg (H : a < 0) : abs a > 0 := - !abs_neg ▸ abs_pos_of_pos (neg_pos_of_neg H) + 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 - definition abs_pos_of_ne_zero (H : a ≠ 0) : abs a > 0 := - sum.rec_on (lt_or_gt_of_ne H) abs_pos_of_neg abs_pos_of_pos - - definition abs_sub (a b : A) : abs (a - b) = abs (b - a) := - by rewrite [-neg_sub, abs_neg] - - definition abs.by_cases {P : A → Type} {a : A} (H1 : P a) (H2 : P (-a)) : P (abs a) := - sum.rec_on (le.total 0 a) + theorem abs.by_cases {P : A → Type} {a : A} (H1 : P a) (H2 : P (-a)) : P (abs a) := + sum.elim (le.total 0 a) (assume H : 0 ≤ a, (abs_of_nonneg H)⁻¹ ▸ H1) (assume H : a ≤ 0, (abs_of_nonpos H)⁻¹ ▸ H2) - definition abs_le_of_le_of_neg_le (H1 : a ≤ b) (H2 : -a ≤ b) : abs a ≤ b := + theorem abs_le_of_le_of_neg_le (H1 : a ≤ b) (H2 : -a ≤ b) : abs a ≤ b := abs.by_cases H1 H2 - definition abs_lt_of_lt_of_neg_lt (H1 : a < b) (H2 : -a < b) : abs a < b := + theorem abs_lt_of_lt_of_neg_lt (H1 : a < b) (H2 : -a < b) : abs a < b := abs.by_cases H1 H2 -- the triangle inequality @@ -496,7 +742,7 @@ section ... = abs a + b : by rewrite (abs_of_nonneg H2) ... = abs a + abs b : by rewrite (abs_of_nonneg H3)) (assume H3 : ¬ b ≥ 0, - assert H4 : b ≤ 0, from le_of_lt (lt_of_not_le H3), + assert H4 : b ≤ 0, from le_of_lt (lt_of_not_ge H3), calc abs (a + b) = a + b : by rewrite (abs_of_nonneg H1) ... = abs a + b : by rewrite (abs_of_nonneg H2) @@ -505,13 +751,13 @@ section ... = abs a + abs b : by rewrite (abs_of_nonpos H4)) private lemma aux2 {a b : A} (H1 : a + b ≥ 0) : abs (a + b) ≤ abs a + abs b := - sum.rec_on (le.total b 0) + sum.elim (le.total b 0) (assume H2 : b ≤ 0, have H3 : ¬ a < 0, from assume H4 : a < 0, have H5 : a + b < 0, from !add_zero ▸ add_lt_add_of_lt_of_le H4 H2, - not_lt_of_le H1 H5, - aux1 H1 (le_of_not_lt H3)) + not_lt_of_ge H1 H5, + aux1 H1 (le_of_not_gt H3)) (assume H2 : 0 ≤ b, begin have H3 : abs (b + a) ≤ abs b + abs a, @@ -523,8 +769,8 @@ section exact H3 end) - definition abs_add_le_abs_add_abs (a b : A) : abs (a + b) ≤ abs a + abs b := - sum.rec_on (le.total 0 (a + b)) + theorem abs_add_le_abs_add_abs (a b : A) : abs (a + b) ≤ abs a + abs b := + sum.elim (le.total 0 (a + b)) (assume H2 : 0 ≤ a + b, aux2 H2) (assume H2 : a + b ≤ 0, assert H3 : -a + -b = -(a + b), by rewrite neg_add, @@ -534,15 +780,45 @@ section abs (a + b) = abs (-a + -b) : by rewrite [-abs_neg, neg_add] ... ≤ abs (-a) + abs (-b) : aux2 H5 ... = abs a + abs b : by rewrite *abs_neg) - end - definition abs_sub_abs_le_abs_sub (a b : A) : abs a - abs b ≤ abs (a - b) := + theorem abs_sub_abs_le_abs_sub (a b : A) : abs a - abs b ≤ abs (a - b) := have H1 : abs a - abs b + abs b ≤ abs (a - b) + abs b, from calc abs a - abs b + abs b = abs a : by rewrite sub_add_cancel ... = abs (a - b + b) : by rewrite sub_add_cancel ... ≤ abs (a - b) + abs b : abs_add_le_abs_add_abs, - algebra.le_of_add_le_add_right H1 + le_of_add_le_add_right H1 + + theorem abs_sub_le (a b c : A) : abs (a - c) ≤ abs (a - b) + abs (b - c) := + calc + abs (a - c) = abs (a - b + (b - c)) : by rewrite [*sub_eq_add_neg, add.assoc, neg_add_cancel_left] + ... ≤ abs (a - b) + abs (b - c) : abs_add_le_abs_add_abs + + theorem abs_add_three (a b c : A) : abs (a + b + c) ≤ abs a + abs b + abs c := + begin + apply le.trans, + apply abs_add_le_abs_add_abs, + apply le.trans, + apply add_le_add_right, + apply abs_add_le_abs_add_abs, + apply le.refl + end + + theorem dist_bdd_within_interval {a b lb ub : A} (H : lb < ub) (Hal : lb ≤ a) (Hau : a ≤ ub) + (Hbl : lb ≤ b) (Hbu : b ≤ ub) : abs (a - b) ≤ ub - lb := + begin + cases (decidable.em (b ≤ a)) with [Hba, Hba], + rewrite (abs_of_nonneg (iff.mpr !sub_nonneg_iff_le Hba)), + apply sub_le_sub, + apply Hau, + apply Hbl, + rewrite [abs_of_neg (iff.mpr !sub_neg_iff_lt (lt_of_not_ge Hba)), neg_sub], + apply sub_le_sub, + apply Hbu, + apply Hal + end + + end end end algebra diff --git a/hott/algebra/ordered_ring.hlean b/hott/algebra/ordered_ring.hlean index 7bbd266e9..966723d45 100644 --- a/hott/algebra/ordered_ring.hlean +++ b/hott/algebra/ordered_ring.hlean @@ -6,23 +6,22 @@ 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 of "linear_ordered_comm_ring". This development is modeled after Isabelle's library. - -Ported from the standard library -/ import algebra.ordered_group algebra.ring -open core - -namespace algebra +open eq eq.ops +set_option class.force_new true variable {A : Type} -definition absurd_a_lt_a {B : Type} {a : A} [s : strict_order A] (H : a < a) : B := +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) +/- semiring structures -/ + structure ordered_semiring [class] (A : Type) - extends has_mul A, has_zero A, has_lt A, -- TODO: remove hack for improving performance - semiring A, ordered_cancel_comm_monoid A, zero_ne_one_class A := + extends semiring A, ordered_cancel_comm_monoid A := (mul_le_mul_of_nonneg_left: Πa b c, le a b → le zero c → le (mul c a) (mul c b)) (mul_le_mul_of_nonneg_right: Πa b c, le a b → le zero c → le (mul a c) (mul b c)) (mul_lt_mul_of_pos_left: Πa b c, lt a b → lt zero c → lt (mul c a) (mul c b)) @@ -33,126 +32,174 @@ section variables (a b c d e : A) include s - definition mul_le_mul_of_nonneg_left {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) : + theorem mul_le_mul_of_nonneg_left {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) : c * a ≤ c * b := !ordered_semiring.mul_le_mul_of_nonneg_left Hab Hc - definition mul_le_mul_of_nonneg_right {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) : + theorem mul_le_mul_of_nonneg_right {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) : a * c ≤ b * c := !ordered_semiring.mul_le_mul_of_nonneg_right Hab Hc -- TODO: there are four variations, depending on which variables we assume to be nonneg - definition mul_le_mul {a b c d : A} (Hac : a ≤ c) (Hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : + theorem mul_le_mul {a b c d : A} (Hac : a ≤ c) (Hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d := calc a * b ≤ c * b : mul_le_mul_of_nonneg_right Hac nn_b ... ≤ c * d : mul_le_mul_of_nonneg_left Hbd nn_c - definition mul_nonneg {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) : a * b ≥ 0 := + theorem mul_nonneg {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) : a * b ≥ 0 := begin have H : 0 * b ≤ a * b, from mul_le_mul_of_nonneg_right Ha Hb, rewrite zero_mul at H, exact H end - definition mul_nonpos_of_nonneg_of_nonpos {a b : A} (Ha : a ≥ 0) (Hb : b ≤ 0) : a * b ≤ 0 := + theorem mul_nonpos_of_nonneg_of_nonpos {a b : A} (Ha : a ≥ 0) (Hb : b ≤ 0) : a * b ≤ 0 := begin have H : a * b ≤ a * 0, from mul_le_mul_of_nonneg_left Hb Ha, rewrite mul_zero at H, exact H end - definition mul_nonpos_of_nonpos_of_nonneg {a b : A} (Ha : a ≤ 0) (Hb : b ≥ 0) : a * b ≤ 0 := + theorem mul_nonpos_of_nonpos_of_nonneg {a b : A} (Ha : a ≤ 0) (Hb : b ≥ 0) : a * b ≤ 0 := begin have H : a * b ≤ 0 * b, from mul_le_mul_of_nonneg_right Ha Hb, rewrite zero_mul at H, exact H end - definition mul_lt_mul_of_pos_left {a b c : A} (Hab : a < b) (Hc : 0 < c) : + theorem mul_lt_mul_of_pos_left {a b c : A} (Hab : a < b) (Hc : 0 < c) : c * a < c * b := !ordered_semiring.mul_lt_mul_of_pos_left Hab Hc - definition mul_lt_mul_of_pos_right {a b c : A} (Hab : a < b) (Hc : 0 < c) : + theorem mul_lt_mul_of_pos_right {a b c : A} (Hab : a < b) (Hc : 0 < c) : a * c < b * c := !ordered_semiring.mul_lt_mul_of_pos_right Hab Hc -- TODO: once again, there are variations - definition mul_lt_mul {a b c d : A} (Hac : a < c) (Hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) : + theorem mul_lt_mul {a b c d : A} (Hac : a < c) (Hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) : a * b < c * d := calc a * b < c * b : mul_lt_mul_of_pos_right Hac pos_b ... ≤ c * d : mul_le_mul_of_nonneg_left Hbd nn_c - definition mul_pos {a b : A} (Ha : a > 0) (Hb : b > 0) : a * b > 0 := + theorem mul_pos {a b : A} (Ha : a > 0) (Hb : b > 0) : a * b > 0 := begin have H : 0 * b < a * b, from mul_lt_mul_of_pos_right Ha Hb, rewrite zero_mul at H, exact H end - definition mul_neg_of_pos_of_neg {a b : A} (Ha : a > 0) (Hb : b < 0) : a * b < 0 := + theorem mul_neg_of_pos_of_neg {a b : A} (Ha : a > 0) (Hb : b < 0) : a * b < 0 := begin have H : a * b < a * 0, from mul_lt_mul_of_pos_left Hb Ha, rewrite mul_zero at H, exact H end - definition mul_neg_of_neg_of_pos {a b : A} (Ha : a < 0) (Hb : b > 0) : a * b < 0 := + theorem mul_neg_of_neg_of_pos {a b : A} (Ha : a < 0) (Hb : b > 0) : a * b < 0 := begin have H : a * b < 0 * b, from mul_lt_mul_of_pos_right Ha Hb, rewrite zero_mul at H, exact H end - end structure linear_ordered_semiring [class] (A : Type) - extends ordered_semiring A, linear_strong_order_pair A + extends ordered_semiring A, linear_strong_order_pair A := +(zero_lt_one : lt zero one) section variable [s : linear_ordered_semiring A] variables {a b c : A} include s - definition lt_of_mul_lt_mul_left (H : c * a < c * b) (Hc : c ≥ 0) : a < b := - lt_of_not_le + theorem zero_lt_one : 0 < (1:A) := linear_ordered_semiring.zero_lt_one A + + theorem lt_of_mul_lt_mul_left (H : c * a < c * b) (Hc : c ≥ 0) : a < b := + lt_of_not_ge (assume H1 : b ≤ a, have H2 : c * b ≤ c * a, from mul_le_mul_of_nonneg_left H1 Hc, - not_lt_of_le H2 H) + not_lt_of_ge H2 H) - definition lt_of_mul_lt_mul_right (H : a * c < b * c) (Hc : c ≥ 0) : a < b := - lt_of_not_le + theorem lt_of_mul_lt_mul_right (H : a * c < b * c) (Hc : c ≥ 0) : a < b := + lt_of_not_ge (assume H1 : b ≤ a, have H2 : b * c ≤ a * c, from mul_le_mul_of_nonneg_right H1 Hc, - not_lt_of_le H2 H) + not_lt_of_ge H2 H) - definition le_of_mul_le_mul_left (H : c * a ≤ c * b) (Hc : c > 0) : a ≤ b := - le_of_not_lt + theorem le_of_mul_le_mul_left (H : c * a ≤ c * b) (Hc : c > 0) : a ≤ b := + le_of_not_gt (assume H1 : b < a, have H2 : c * b < c * a, from mul_lt_mul_of_pos_left H1 Hc, - not_le_of_lt H2 H) + not_le_of_gt H2 H) - definition le_of_mul_le_mul_right (H : a * c ≤ b * c) (Hc : c > 0) : a ≤ b := - le_of_not_lt + theorem le_of_mul_le_mul_right (H : a * c ≤ b * c) (Hc : c > 0) : a ≤ b := + le_of_not_gt (assume H1 : b < a, have H2 : b * c < a * c, from mul_lt_mul_of_pos_right H1 Hc, - not_le_of_lt H2 H) + not_le_of_gt H2 H) - definition pos_of_mul_pos_left (H : 0 < a * b) (H1 : 0 ≤ a) : 0 < b := - lt_of_not_le + theorem le_iff_mul_le_mul_left (a b : A) {c : A} (H : c > 0) : a ≤ b ↔ c * a ≤ c * b := + iff.intro + (assume H', mul_le_mul_of_nonneg_left H' (le_of_lt H)) + (assume H', le_of_mul_le_mul_left H' H) + + theorem le_iff_mul_le_mul_right (a b : A) {c : A} (H : c > 0) : a ≤ b ↔ a * c ≤ b * c := + iff.intro + (assume H', mul_le_mul_of_nonneg_right H' (le_of_lt H)) + (assume H', le_of_mul_le_mul_right H' H) + + theorem pos_of_mul_pos_left (H : 0 < a * b) (H1 : 0 ≤ a) : 0 < b := + lt_of_not_ge (assume H2 : b ≤ 0, have H3 : a * b ≤ 0, from mul_nonpos_of_nonneg_of_nonpos H1 H2, - not_lt_of_le H3 H) + not_lt_of_ge H3 H) - definition pos_of_mul_pos_right (H : 0 < a * b) (H1 : 0 ≤ b) : 0 < a := - lt_of_not_le + theorem pos_of_mul_pos_right (H : 0 < a * b) (H1 : 0 ≤ b) : 0 < a := + lt_of_not_ge (assume H2 : a ≤ 0, have H3 : a * b ≤ 0, from mul_nonpos_of_nonpos_of_nonneg H2 H1, - not_lt_of_le H3 H) + not_lt_of_ge H3 H) + + theorem nonneg_of_mul_nonneg_left (H : 0 ≤ a * b) (H1 : 0 < a) : 0 ≤ b := + le_of_not_gt + (assume H2 : b < 0, + not_le_of_gt (mul_neg_of_pos_of_neg H1 H2) H) + + theorem nonneg_of_mul_nonneg_right (H : 0 ≤ a * b) (H1 : 0 < b) : 0 ≤ a := + le_of_not_gt + (assume H2 : a < 0, + not_le_of_gt (mul_neg_of_neg_of_pos H2 H1) H) + + theorem neg_of_mul_neg_left (H : a * b < 0) (H1 : 0 ≤ a) : b < 0 := + lt_of_not_ge + (assume H2 : b ≥ 0, + not_lt_of_ge (mul_nonneg H1 H2) H) + + theorem neg_of_mul_neg_right (H : a * b < 0) (H1 : 0 ≤ b) : a < 0 := + lt_of_not_ge + (assume H2 : a ≥ 0, + not_lt_of_ge (mul_nonneg H2 H1) H) + + theorem nonpos_of_mul_nonpos_left (H : a * b ≤ 0) (H1 : 0 < a) : b ≤ 0 := + le_of_not_gt + (assume H2 : b > 0, + not_le_of_gt (mul_pos H1 H2) H) + + theorem nonpos_of_mul_nonpos_right (H : a * b ≤ 0) (H1 : 0 < b) : a ≤ 0 := + le_of_not_gt + (assume H2 : a > 0, + not_le_of_gt (mul_pos H2 H1) H) end -structure ordered_ring [class] (A : Type) extends ring A, ordered_comm_group A, zero_ne_one_class A := +structure decidable_linear_ordered_semiring [class] (A : Type) + extends linear_ordered_semiring A, decidable_linear_order A + +/- ring structures -/ + +structure ordered_ring [class] (A : Type) + extends ring A, ordered_comm_group A, zero_ne_one_class A := (mul_nonneg : Πa b, le zero a → le zero b → le zero (mul a b)) (mul_pos : Πa b, lt zero a → lt zero b → lt zero (mul a b)) -definition ordered_ring.mul_le_mul_of_nonneg_left [s : ordered_ring A] {a b c : A} +theorem ordered_ring.mul_le_mul_of_nonneg_left [s : ordered_ring A] {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) : c * a ≤ c * b := have H1 : 0 ≤ b - a, from iff.elim_right !sub_nonneg_iff_le Hab, assert H2 : 0 ≤ c * (b - a), from ordered_ring.mul_nonneg _ _ Hc H1, @@ -161,7 +208,7 @@ begin exact (iff.mp !sub_nonneg_iff_le H2) end -definition ordered_ring.mul_le_mul_of_nonneg_right [s : ordered_ring A] {a b c : A} +theorem ordered_ring.mul_le_mul_of_nonneg_right [s : ordered_ring A] {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) : a * c ≤ b * c := have H1 : 0 ≤ b - a, from iff.elim_right !sub_nonneg_iff_le Hab, assert H2 : 0 ≤ (b - a) * c, from ordered_ring.mul_nonneg _ _ H1 Hc, @@ -170,7 +217,7 @@ begin exact (iff.mp !sub_nonneg_iff_le H2) end -definition ordered_ring.mul_lt_mul_of_pos_left [s : ordered_ring A] {a b c : A} +theorem ordered_ring.mul_lt_mul_of_pos_left [s : ordered_ring A] {a b c : A} (Hab : a < b) (Hc : 0 < c) : c * a < c * b := have H1 : 0 < b - a, from iff.elim_right !sub_pos_iff_lt Hab, assert H2 : 0 < c * (b - a), from ordered_ring.mul_pos _ _ Hc H1, @@ -179,7 +226,7 @@ begin exact (iff.mp !sub_pos_iff_lt H2) end -definition ordered_ring.mul_lt_mul_of_pos_right [s : ordered_ring A] {a b c : A} +theorem ordered_ring.mul_lt_mul_of_pos_right [s : ordered_ring A] {a b c : A} (Hab : a < b) (Hc : 0 < c) : a * c < b * c := have H1 : 0 < b - a, from iff.elim_right !sub_pos_iff_lt Hab, assert H2 : 0 < (b - a) * c, from ordered_ring.mul_pos _ _ H1 Hc, @@ -188,7 +235,8 @@ begin exact (iff.mp !sub_pos_iff_lt H2) end -definition ordered_ring.to_ordered_semiring [instance] [reducible] [s : ordered_ring A] : +definition ordered_ring.to_ordered_semiring [trans_instance] [reducible] + [s : ordered_ring A] : ordered_semiring A := ⦃ ordered_semiring, s, mul_zero := mul_zero, @@ -199,14 +247,15 @@ definition ordered_ring.to_ordered_semiring [instance] [reducible] [s : ordered_ mul_le_mul_of_nonneg_left := @ordered_ring.mul_le_mul_of_nonneg_left A _, mul_le_mul_of_nonneg_right := @ordered_ring.mul_le_mul_of_nonneg_right A _, mul_lt_mul_of_pos_left := @ordered_ring.mul_lt_mul_of_pos_left A _, - mul_lt_mul_of_pos_right := @ordered_ring.mul_lt_mul_of_pos_right A _ ⦄ + mul_lt_mul_of_pos_right := @ordered_ring.mul_lt_mul_of_pos_right A _, + lt_of_add_lt_add_left := @lt_of_add_lt_add_left A _⦄ section variable [s : ordered_ring A] variables {a b c : A} include s - definition mul_le_mul_of_nonpos_left (H : b ≤ a) (Hc : c ≤ 0) : c * a ≤ c * b := + theorem mul_le_mul_of_nonpos_left (H : b ≤ a) (Hc : c ≤ 0) : c * a ≤ c * b := have Hc' : -c ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos Hc, assert H1 : -c * b ≤ -c * a, from mul_le_mul_of_nonneg_left H Hc', have H2 : -(c * b) ≤ -(c * a), @@ -216,7 +265,7 @@ section end, iff.mp !neg_le_neg_iff_le H2 - definition mul_le_mul_of_nonpos_right (H : b ≤ a) (Hc : c ≤ 0) : a * c ≤ b * c := + theorem mul_le_mul_of_nonpos_right (H : b ≤ a) (Hc : c ≤ 0) : a * c ≤ b * c := have Hc' : -c ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos Hc, assert H1 : b * -c ≤ a * -c, from mul_le_mul_of_nonneg_right H Hc', have H2 : -(b * c) ≤ -(a * c), @@ -226,14 +275,14 @@ section end, iff.mp !neg_le_neg_iff_le H2 - definition mul_nonneg_of_nonpos_of_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : 0 ≤ a * b := + theorem mul_nonneg_of_nonpos_of_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : 0 ≤ a * b := begin have H : 0 * b ≤ a * b, from mul_le_mul_of_nonpos_right Ha Hb, rewrite zero_mul at H, exact H end - definition mul_lt_mul_of_neg_left (H : b < a) (Hc : c < 0) : c * a < c * b := + theorem mul_lt_mul_of_neg_left (H : b < a) (Hc : c < 0) : c * a < c * b := have Hc' : -c > 0, from iff.mpr !neg_pos_iff_neg Hc, assert H1 : -c * b < -c * a, from mul_lt_mul_of_pos_left H Hc', have H2 : -(c * b) < -(c * a), @@ -243,7 +292,7 @@ section end, iff.mp !neg_lt_neg_iff_lt H2 - definition mul_lt_mul_of_neg_right (H : b < a) (Hc : c < 0) : a * c < b * c := + theorem mul_lt_mul_of_neg_right (H : b < a) (Hc : c < 0) : a * c < b * c := have Hc' : -c > 0, from iff.mpr !neg_pos_iff_neg Hc, assert H1 : b * -c < a * -c, from mul_lt_mul_of_pos_right H Hc', have H2 : -(b * c) < -(a * c), @@ -253,7 +302,7 @@ section end, iff.mp !neg_lt_neg_iff_lt H2 - definition mul_pos_of_neg_of_neg (Ha : a < 0) (Hb : b < 0) : 0 < a * b := + theorem mul_pos_of_neg_of_neg (Ha : a < 0) (Hb : b < 0) : 0 < a * b := begin have H : 0 * b < a * b, from mul_lt_mul_of_neg_right Ha Hb, rewrite zero_mul at H, @@ -264,11 +313,11 @@ end -- TODO: we can eliminate mul_pos_of_pos, but now it is not worth the effort to redeclare the -- class instance -structure linear_ordered_ring [class] (A : Type) extends ordered_ring A, linear_strong_order_pair A +structure linear_ordered_ring [class] (A : Type) + extends ordered_ring A, linear_strong_order_pair A := + (zero_lt_one : lt zero one) --- print fields linear_ordered_semiring - -definition linear_ordered_ring.to_linear_ordered_semiring [instance] [reducible] +definition linear_ordered_ring.to_linear_ordered_semiring [trans_instance] [reducible] [s : linear_ordered_ring A] : linear_ordered_semiring A := ⦃ linear_ordered_semiring, s, @@ -281,11 +330,12 @@ definition linear_ordered_ring.to_linear_ordered_semiring [instance] [reducible] mul_le_mul_of_nonneg_right := @mul_le_mul_of_nonneg_right A _, mul_lt_mul_of_pos_left := @mul_lt_mul_of_pos_left A _, mul_lt_mul_of_pos_right := @mul_lt_mul_of_pos_right A _, - le_total := linear_ordered_ring.le_total ⦄ + le_total := linear_ordered_ring.le_total, + lt_of_add_lt_add_left := @lt_of_add_lt_add_left A _ ⦄ structure linear_ordered_comm_ring [class] (A : Type) extends linear_ordered_ring A, comm_monoid A -definition 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_or_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, @@ -321,7 +371,7 @@ lt.by_cases end)) -- Linearity implies no zero divisors. Doesn't need commutativity. -definition linear_ordered_comm_ring.to_integral_domain [instance] [reducible] +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 := @@ -332,15 +382,14 @@ section variables (a b c : A) include s - definition mul_self_nonneg : a * a ≥ 0 := - sum.rec_on (le.total 0 a) + theorem mul_self_nonneg : a * a ≥ 0 := + sum.elim (le.total 0 a) (assume H : a ≥ 0, mul_nonneg H H) (assume H : a ≤ 0, mul_nonneg_of_nonpos_of_nonpos H H) - definition zero_le_one : 0 ≤ (1:A) := one_mul 1 ▸ mul_self_nonneg (1 : A) - definition zero_lt_one : 0 < (1:A) := lt_of_le_of_ne zero_le_one zero_ne_one + theorem zero_le_one : 0 ≤ (1:A) := one_mul 1 ▸ mul_self_nonneg 1 - definition pos_and_pos_or_neg_and_neg_of_mul_pos {a b : A} (Hab : a * b > 0) : + theorem pos_and_pos_or_neg_and_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, @@ -369,7 +418,7 @@ section end) (assume Hb : b < 0, sum.inr (pair Ha Hb))) - definition gt_of_mul_lt_mul_neg_left {a b c : A} (H : c * a < c * b) (Hc : c ≤ 0) : a > b := + theorem gt_of_mul_lt_mul_neg_left {a b c : A} (H : c * a < c * b) (Hc : c ≤ 0) : a > b := have nhc : -c ≥ 0, from neg_nonneg_of_nonpos Hc, have H2 : -(c * b) < -(c * a), from iff.mpr (neg_lt_neg_iff_lt _ _) H, have H3 : (-c) * b < (-c) * a, from calc @@ -378,9 +427,27 @@ section ... = (-c) * a : neg_mul_eq_neg_mul, lt_of_mul_lt_mul_left H3 nhc - definition zero_gt_neg_one : -1 < (0 : A) := + theorem zero_gt_neg_one : -1 < (0:A) := neg_zero ▸ (neg_lt_neg zero_lt_one) + theorem le_of_mul_le_of_ge_one {a b c : A} (H : a * c ≤ b) (Hb : b ≥ 0) (Hc : c ≥ 1) : a ≤ b := + have H' : a * c ≤ b * c, from calc + a * c ≤ b : H + ... = b * 1 : mul_one + ... ≤ b * c : mul_le_mul_of_nonneg_left Hc Hb, + le_of_mul_le_mul_right H' (lt_of_lt_of_le zero_lt_one Hc) + + theorem nonneg_le_nonneg_of_squares_le {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) (H : a * a ≤ b * b) : + a ≤ b := + begin + apply le_of_not_gt, + intro Hab, + let Hposa := lt_of_le_of_lt Hb Hab, + let H' := calc + b * b ≤ a * b : mul_le_mul_of_nonneg_right (le_of_lt Hab) Hb + ... < a * a : mul_lt_mul_of_pos_left Hab Hposa, + apply (not_le_of_gt H') H + end end /- TODO: Isabelle's library has all kinds of cancelation rules for the simplifier. @@ -396,17 +463,17 @@ section definition sign (a : A) : A := lt.cases a 0 (-1) 0 1 - definition sign_of_neg (H : a < 0) : sign a = -1 := lt.cases_of_lt H + theorem sign_of_neg (H : a < 0) : sign a = -1 := lt.cases_of_lt H - definition sign_zero : sign 0 = (0:A) := lt.cases_of_eq rfl + theorem sign_zero : sign 0 = (0:A) := lt.cases_of_eq rfl - definition sign_of_pos (H : a > 0) : sign a = 1 := lt.cases_of_gt H + theorem sign_of_pos (H : a > 0) : sign a = 1 := lt.cases_of_gt H - definition sign_one : sign 1 = (1:A) := sign_of_pos zero_lt_one + theorem sign_one : sign 1 = (1:A) := sign_of_pos zero_lt_one - definition sign_neg_one : sign (-1) = -(1:A) := sign_of_neg (neg_neg_of_pos zero_lt_one) + theorem sign_neg_one : sign (-1) = -(1:A) := sign_of_neg (neg_neg_of_pos zero_lt_one) - definition sign_sign (a : A) : sign (sign a) = sign a := + theorem sign_sign (a : A) : sign (sign a) = sign a := lt.by_cases (assume H : a > 0, calc @@ -424,7 +491,7 @@ section ... = -1 : by rewrite sign_neg_one ... = sign a : by rewrite (sign_of_neg H)) - definition pos_of_sign_eq_one (H : sign a = 1) : a > 0 := + theorem pos_of_sign_eq_one (H : sign a = 1) : a > 0 := lt.by_cases (assume H1 : 0 < a, H1) (assume H1 : 0 = a, @@ -436,7 +503,7 @@ section have H2 : -1 = 1, from (sign_of_neg H1)⁻¹ ⬝ H, absurd ((eq_zero_of_neg_eq H2)⁻¹) zero_ne_one) - definition eq_zero_of_sign_eq_zero (H : sign a = 0) : a = 0 := + theorem eq_zero_of_sign_eq_zero (H : sign a = 0) : a = 0 := lt.by_cases (assume H1 : 0 < a, absurd (H⁻¹ ⬝ sign_of_pos H1) zero_ne_one) @@ -446,7 +513,7 @@ section have H3 : 1 = 0, from eq_neg_of_eq_neg H2 ⬝ neg_zero, absurd (H3⁻¹) zero_ne_one) - definition neg_of_sign_eq_neg_one (H : sign a = -1) : a < 0 := + theorem neg_of_sign_eq_neg_one (H : sign a = -1) : a < 0 := lt.by_cases (assume H1 : 0 < a, have H2 : -1 = 1, from H⁻¹ ⬝ (sign_of_pos H1), @@ -461,7 +528,7 @@ section absurd (H3⁻¹) zero_ne_one) (assume H1 : 0 > a, H1) - definition sign_neg (a : A) : sign (-a) = -(sign a) := + theorem sign_neg (a : A) : sign (-a) = -(sign a) := lt.by_cases (assume H1 : 0 < a, calc @@ -481,7 +548,7 @@ section ... = -(-1) : by rewrite neg_neg ... = -(sign a) : sign_of_neg H1) - definition sign_mul (a b : A) : sign (a * b) = sign a * sign b := + theorem sign_mul (a b : A) : sign (a * b) = sign a * sign b := lt.by_cases (assume z_lt_a : 0 < a, lt.by_cases @@ -504,7 +571,7 @@ section sign_of_pos (mul_pos_of_neg_of_neg z_gt_a z_gt_b), neg_mul_neg, one_mul])) - definition abs_eq_sign_mul (a : A) : abs a = sign a * a := + theorem abs_eq_sign_mul (a : A) : abs a = sign a * a := lt.by_cases (assume H1 : 0 < a, calc @@ -524,7 +591,7 @@ section ... = -1 * a : by rewrite neg_eq_neg_one_mul ... = sign a * a : by rewrite (sign_of_neg H1)) - definition eq_sign_mul_abs (a : A) : a = sign a * abs a := + theorem eq_sign_mul_abs (a : A) : a = sign a * abs a := lt.by_cases (assume H1 : 0 < a, calc @@ -544,16 +611,22 @@ section ... = -1 * abs a : by rewrite neg_eq_neg_one_mul ... = sign a * abs a : by rewrite (sign_of_neg H1)) - definition abs_dvd_iff (a b : A) : abs a ∣ b ↔ a ∣ b := + theorem abs_dvd_iff (a b : A) : abs a ∣ b ↔ a ∣ b := abs.by_cases !iff.refl !neg_dvd_iff_dvd - definition dvd_abs_iff (a b : A) : a ∣ abs b ↔ a ∣ b := + theorem abs_dvd_of_dvd {a b : A} : a ∣ b → abs a ∣ b := + iff.mpr !abs_dvd_iff + + theorem dvd_abs_iff (a b : A) : a ∣ abs b ↔ a ∣ b := abs.by_cases !iff.refl !dvd_neg_iff_dvd - definition abs_mul (a b : A) : abs (a * b) = abs a * abs b := - sum.rec_on (le.total 0 a) + theorem dvd_abs_of_dvd {a b : A} : a ∣ b → a ∣ abs b := + iff.mpr !dvd_abs_iff + + theorem abs_mul (a b : A) : abs (a * b) = abs a * abs b := + sum.elim (le.total 0 a) (assume H1 : 0 ≤ a, - sum.rec_on (le.total 0 b) + sum.elim (le.total 0 b) (assume H2 : 0 ≤ b, calc abs (a * b) = a * b : abs_of_nonneg (mul_nonneg H1 H2) @@ -566,7 +639,7 @@ section ... = abs a * -b : by rewrite (abs_of_nonneg H1) ... = abs a * abs b : by rewrite (abs_of_nonpos H2))) (assume H1 : a ≤ 0, - sum.rec_on (le.total 0 b) + sum.elim (le.total 0 b) (assume H2 : 0 ≤ b, calc abs (a * b) = -(a * b) : abs_of_nonpos (mul_nonpos_of_nonpos_of_nonneg H1 H2) @@ -580,10 +653,92 @@ section ... = abs a * -b : by rewrite (abs_of_nonpos H1) ... = abs a * abs b : by rewrite (abs_of_nonpos H2))) - definition abs_mul_self (a : A) : abs a * abs a = a * a := + theorem abs_mul_abs_self (a : A) : abs a * abs a = a * a := abs.by_cases rfl !neg_mul_neg + + theorem abs_mul_self (a : A) : abs (a * a) = a * a := + by rewrite [abs_mul, abs_mul_abs_self] + + theorem sub_le_of_abs_sub_le_left (H : abs (a - b) ≤ c) : b - c ≤ a := + if Hz : 0 ≤ a - b then + (calc + a ≥ b : (iff.mp !sub_nonneg_iff_le) Hz + ... ≥ b - c : sub_le_of_nonneg _ (le.trans !abs_nonneg H)) + else + (have Habs : b - a ≤ c, by rewrite [abs_of_neg (lt_of_not_ge Hz) at H, neg_sub at H]; apply H, + have Habs' : b ≤ c + a, from (iff.mpr !le_add_iff_sub_right_le) Habs, + (iff.mp !le_add_iff_sub_left_le) Habs') + + theorem sub_le_of_abs_sub_le_right (H : abs (a - b) ≤ c) : a - c ≤ b := + sub_le_of_abs_sub_le_left (!abs_sub ▸ H) + + theorem sub_lt_of_abs_sub_lt_left (H : abs (a - b) < c) : b - c < a := + if Hz : 0 ≤ a - b then + (calc + a ≥ b : (iff.mp !sub_nonneg_iff_le) Hz + ... > b - c : sub_lt_of_pos _ (lt_of_le_of_lt !abs_nonneg H)) + else + (have Habs : b - a < c, by rewrite [abs_of_neg (lt_of_not_ge Hz) at H, neg_sub at H]; apply H, + have Habs' : b < c + a, from lt_add_of_sub_lt_right Habs, + sub_lt_left_of_lt_add Habs') + + theorem sub_lt_of_abs_sub_lt_right (H : abs (a - b) < c) : a - c < b := + sub_lt_of_abs_sub_lt_left (!abs_sub ▸ H) + + theorem abs_sub_square (a b : A) : abs (a - b) * abs (a - b) = a * a + b * b - (1 + 1) * a * b := + begin + rewrite [abs_mul_abs_self, *mul_sub_left_distrib, *mul_sub_right_distrib, + sub_eq_add_neg (a*b), sub_add_eq_sub_sub, sub_neg_eq_add, *right_distrib, sub_add_eq_sub_sub, *one_mul, + *add.assoc, {_ + b * b}add.comm, *sub_eq_add_neg], + rewrite [{a*a + b*b}add.comm], + rewrite [mul.comm b a, *add.assoc] + end + + theorem abs_abs_sub_abs_le_abs_sub (a b : A) : abs (abs a - abs b) ≤ abs (a - b) := + begin + apply nonneg_le_nonneg_of_squares_le, + repeat apply abs_nonneg, + rewrite [*abs_sub_square, *abs_abs, *abs_mul_abs_self], + apply sub_le_sub_left, + rewrite *mul.assoc, + apply mul_le_mul_of_nonneg_left, + rewrite -abs_mul, + apply le_abs_self, + apply le_of_lt, + apply add_pos, + apply zero_lt_one, + apply zero_lt_one + end + end /- TODO: Multiplication and one, starting with mult_right_le_one_le. -/ +namespace norm_num + +theorem pos_bit0_helper [s : linear_ordered_semiring A] (a : A) (H : a > 0) : bit0 a > 0 := + by rewrite ↑bit0; apply add_pos H H + +theorem nonneg_bit0_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit0 a ≥ 0 := + by rewrite ↑bit0; apply add_nonneg H H + +theorem pos_bit1_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit1 a > 0 := + begin + rewrite ↑bit1, + apply add_pos_of_nonneg_of_pos, + apply nonneg_bit0_helper _ H, + apply zero_lt_one + end + +theorem nonneg_bit1_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit1 a ≥ 0 := + by apply le_of_lt; apply pos_bit1_helper _ H + +theorem nonzero_of_pos_helper [s : linear_ordered_semiring A] (a : A) (H : a > 0) : a ≠ 0 := + ne_of_gt H + +theorem nonzero_of_neg_helper [s : linear_ordered_ring A] (a : A) (H : a ≠ 0) : -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 new file mode 100644 index 000000000..eaea71bea --- /dev/null +++ b/hott/algebra/port.md @@ -0,0 +1,9 @@ +We have ported 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) diff --git a/hott/algebra/priority.hlean b/hott/algebra/priority.hlean new file mode 100644 index 000000000..aa2ac4c5c --- /dev/null +++ b/hott/algebra/priority.hlean @@ -0,0 +1,6 @@ +/- +Copyright (c) 2015 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: Leonardo de Moura +-/ +protected definition algebra.prio := num.sub std.priority.default 100 diff --git a/hott/algebra/relation.hlean b/hott/algebra/relation.hlean index 26e6bb4bc..0b058c5d2 100644 --- a/hott/algebra/relation.hlean +++ b/hott/algebra/relation.hlean @@ -18,6 +18,7 @@ section definition transitive : Type := Π⦃x y z⦄, R x y → R y z → R x z end + /- classes for equivalence relations -/ structure is_reflexive [class] {T : Type} (R : T → T → Type) := (refl : reflexive R) @@ -70,39 +71,39 @@ namespace is_congruence /- tools to build instances -/ - theorem compose + definition compose {T2 : Type} {R2 : T2 → T2 → Type} {T3 : Type} {R3 : T3 → T3 → Type} {g : T2 → T3} (C2 : is_congruence R2 R3 g) ⦃T1 : Type⦄ {R1 : T1 → T1 → Type} - {f : T1 → T2} (C1 : is_congruence R1 R2 f) : + {f : T1 → T2} [C1 : is_congruence R1 R2 f] : is_congruence R1 R3 (λx, g (f x)) := is_congruence.mk (λx1 x2 H, app C2 (app C1 H)) - theorem compose21 + definition compose21 {T2 : Type} {R2 : T2 → T2 → Type} {T3 : Type} {R3 : T3 → T3 → Type} {T4 : Type} {R4 : T4 → T4 → Type} {g : T2 → T3 → T4} (C3 : is_congruence2 R2 R3 R4 g) ⦃T1 : Type⦄ {R1 : T1 → T1 → Type} - {f1 : T1 → T2} (C1 : is_congruence R1 R2 f1) - {f2 : T1 → T3} (C2 : is_congruence R1 R3 f2) : + {f1 : T1 → T2} [C1 : is_congruence R1 R2 f1] + {f2 : T1 → T3} [C2 : is_congruence R1 R3 f2] : is_congruence R1 R4 (λx, g (f1 x) (f2 x)) := is_congruence.mk (λx1 x2 H, app2 C3 (app C1 H) (app C2 H)) - theorem const {T2 : Type} (R2 : T2 → T2 → Type) (H : relation.reflexive R2) + definition const {T2 : Type} (R2 : T2 → T2 → Type) (H : relation.reflexive R2) ⦃T1 : Type⦄ (R1 : T1 → T1 → Type) (c : T2) : is_congruence R1 R2 (λu : T1, c) := is_congruence.mk (λx y H1, H c) end is_congruence -theorem congruence_const [instance] {T2 : Type} (R2 : T2 → T2 → Type) +definition congruence_const [instance] {T2 : Type} (R2 : T2 → T2 → Type) [C : is_reflexive R2] ⦃T1 : Type⦄ (R1 : T1 → T1 → Type) (c : T2) : is_congruence R1 R2 (λu : T1, c) := is_congruence.const R2 (is_reflexive.refl R2) R1 c -theorem congruence_trivial [instance] {T : Type} (R : T → T → Type) : +definition congruence_star [instance] {T : Type} (R : T → T → Type) : is_congruence R R (λu, u) := is_congruence.mk (λx y H, H) diff --git a/hott/algebra/ring.hlean b/hott/algebra/ring.hlean index 353a21719..086a7d6eb 100644 --- a/hott/algebra/ring.hlean +++ b/hott/algebra/ring.hlean @@ -5,40 +5,38 @@ Authors: Jeremy Avigad, Leonardo de Moura Structures with multiplicative and additive components, including semirings, rings, and fields. The development is modeled after Isabelle's library. -Ported from the standard library -/ import algebra.group - -open core - -namespace algebra +open algebra eq variable {A : Type} +set_option class.force_new true /- 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)) -definition left_distrib [s : distrib A] (a b c : A) : a * (b + c) = a * b + a * c := +theorem left_distrib [s : distrib A] (a b c : A) : a * (b + c) = a * b + a * c := !distrib.left_distrib -definition right_distrib [s: distrib A] (a b c : A) : (a + b) * c = a * c + b * c := +theorem right_distrib [s: distrib A] (a b c : A) : (a + b) * c = a * c + b * c := !distrib.right_distrib structure mul_zero_class [class] (A : Type) extends has_mul A, has_zero A := (zero_mul : Πa, mul zero a = zero) (mul_zero : Πa, mul a zero = zero) -definition zero_mul [s : mul_zero_class A] (a : A) : 0 * a = 0 := !mul_zero_class.zero_mul -definition mul_zero [s : mul_zero_class A] (a : A) : a * 0 = 0 := !mul_zero_class.mul_zero +theorem zero_mul [s : mul_zero_class A] (a : A) : 0 * a = 0 := !mul_zero_class.zero_mul +theorem mul_zero [s : mul_zero_class A] (a : A) : a * 0 = 0 := !mul_zero_class.mul_zero structure zero_ne_one_class [class] (A : Type) extends has_zero A, has_one A := (zero_ne_one : zero ≠ one) -definition zero_ne_one [s: zero_ne_one_class A] : 0 ≠ 1 := @zero_ne_one_class.zero_ne_one A s +theorem zero_ne_one [s: zero_ne_one_class A] : 0 ≠ (1:A) := @zero_ne_one_class.zero_ne_one A s /- semiring -/ @@ -49,20 +47,26 @@ section semiring variables [s : semiring A] (a b c : A) include s - definition ne_zero_of_mul_ne_zero_right {a b : A} (H : a * b ≠ 0) : a ≠ 0 := - assume H1 : a = 0, - have H2 : a * b = 0, from H1⁻¹ ▸ zero_mul b, - H H2 + theorem one_add_one_eq_two : 1 + 1 = (2:A) := + by unfold bit0 - definition ne_zero_of_mul_ne_zero_left {a b : A} (H : a * b ≠ 0) : b ≠ 0 := - assume H1 : b = 0, - have H2 : a * b = 0, from H1⁻¹ ▸ mul_zero a, - H H2 + theorem ne_zero_of_mul_ne_zero_right {a b : A} (H : a * b ≠ 0) : a ≠ 0 := + suppose a = 0, + have a * b = 0, from this⁻¹ ▸ zero_mul b, + H this + + theorem ne_zero_of_mul_ne_zero_left {a b : A} (H : a * b ≠ 0) : b ≠ 0 := + suppose b = 0, + have a * b = 0, from this⁻¹ ▸ mul_zero a, + H this + + theorem distrib_three_right (a b c d : A) : (a + b + c) * d = a * d + b * d + c * d := + by rewrite *right_distrib end semiring /- comm semiring -/ -structure comm_semiring [class] (A : Type) extends semiring A, comm_semigroup A +structure comm_semiring [class] (A : Type) extends semiring A, comm_monoid A -- TODO: we could also define a cancelative comm_semiring, i.e. satisfying -- c ≠ 0 → c * a = c * b → a = b. @@ -70,29 +74,35 @@ section comm_semiring variables [s : comm_semiring A] (a b c : A) include s - definition dvd (a b : A) : Type := Σc, b = a * c - notation a ∣ b := dvd a b + protected definition algebra.dvd (a b : A) : Type := Σc, b = a * c - definition dvd.intro {a b c : A} (H : a * c = b) : a ∣ b := + definition comm_semiring_has_dvd [reducible] [instance] [priority algebra.prio] : has_dvd A := + has_dvd.mk algebra.dvd + + theorem dvd.intro {a b c : A} (H : a * c = b) : a ∣ b := sigma.mk _ H⁻¹ - definition dvd.intro_left {a b c : A} (H : c * a = b) : a ∣ b := + theorem dvd_of_mul_right_eq {a b c : A} (H : a * c = b) : a ∣ b := dvd.intro H + + theorem dvd.intro_left {a b c : A} (H : c * a = b) : a ∣ b := dvd.intro (!mul.comm ▸ H) - definition exists_eq_mul_right_of_dvd {a b : A} (H : a ∣ b) : Σc, b = a * c := H + theorem dvd_of_mul_left_eq {a b c : A} (H : c * a = b) : a ∣ b := dvd.intro_left H - definition dvd.elim {P : Type} {a b : A} (H₁ : a ∣ b) (H₂ : Πc, b = a * c → P) : P := + theorem exists_eq_mul_right_of_dvd {a b : A} (H : a ∣ b) : Σc, b = a * c := H + + theorem dvd.elim {P : Type} {a b : A} (H₁ : a ∣ b) (H₂ : Πc, b = a * c → P) : P := sigma.rec_on H₁ H₂ - definition exists_eq_mul_left_of_dvd {a b : A} (H : a ∣ b) : Σc, b = c * a := + theorem exists_eq_mul_left_of_dvd {a b : A} (H : a ∣ b) : Σc, b = c * a := dvd.elim H (take c, assume H1 : b = a * c, sigma.mk c (H1 ⬝ !mul.comm)) - definition dvd.elim_left {P : Type} {a b : A} (H₁ : a ∣ b) (H₂ : Πc, b = c * a → P) : P := + theorem dvd.elim_left {P : Type} {a b : A} (H₁ : a ∣ b) (H₂ : Πc, b = c * a → P) : P := sigma.rec_on (exists_eq_mul_left_of_dvd H₁) (take c, assume H₃ : b = c * a, H₂ c H₃) - definition dvd.refl : a ∣ a := dvd.intro !mul_one + theorem dvd.refl : a ∣ a := dvd.intro !mul_one - definition dvd.trans {a b c : A} (H₁ : a ∣ b) (H₂ : b ∣ c) : a ∣ c := + theorem dvd.trans {a b c : A} (H₁ : a ∣ b) (H₂ : b ∣ c) : a ∣ c := dvd.elim H₁ (take d, assume H₃ : b = a * d, dvd.elim H₂ @@ -100,70 +110,70 @@ section comm_semiring dvd.intro (show a * (d * e) = c, by rewrite [-mul.assoc, -H₃, H₄]))) - definition eq_zero_of_zero_dvd {a : A} (H : 0 ∣ a) : a = 0 := + theorem eq_zero_of_zero_dvd {a : A} (H : 0 ∣ a) : a = 0 := dvd.elim H (take c, assume H' : a = 0 * c, H' ⬝ !zero_mul) - definition dvd_zero : a ∣ 0 := dvd.intro !mul_zero + theorem dvd_zero : a ∣ 0 := dvd.intro !mul_zero - definition one_dvd : 1 ∣ a := dvd.intro !one_mul + theorem one_dvd : 1 ∣ a := dvd.intro !one_mul - definition dvd_mul_right : a ∣ a * b := dvd.intro rfl + theorem dvd_mul_right : a ∣ a * b := dvd.intro rfl - definition dvd_mul_left : a ∣ b * a := mul.comm a b ▸ dvd_mul_right a b + theorem dvd_mul_left : a ∣ b * a := mul.comm a b ▸ dvd_mul_right a b - definition dvd_mul_of_dvd_left {a b : A} (H : a ∣ b) (c : A) : a ∣ b * c := + theorem dvd_mul_of_dvd_left {a b : A} (H : a ∣ b) (c : A) : a ∣ b * c := dvd.elim H (take d, - assume H₁ : b = a * d, + suppose b = a * d, dvd.intro - (show a * (d * c) = b * c, from by rewrite [-mul.assoc, H₁])) + (show a * (d * c) = b * c, from by rewrite [-mul.assoc]; substvars)) - definition dvd_mul_of_dvd_right {a b : A} (H : a ∣ b) (c : A) : a ∣ c * b := + theorem dvd_mul_of_dvd_right {a b : A} (H : a ∣ b) (c : A) : a ∣ c * b := !mul.comm ▸ (dvd_mul_of_dvd_left H _) - definition mul_dvd_mul {a b c d : A} (dvd_ab : (a ∣ b)) (dvd_cd : c ∣ d) : a * c ∣ b * d := + theorem mul_dvd_mul {a b c d : A} (dvd_ab : a ∣ b) (dvd_cd : c ∣ d) : a * c ∣ b * d := dvd.elim dvd_ab - (take e, assume Haeb : b = a * e, + (take e, suppose b = a * e, dvd.elim dvd_cd - (take f, assume Hcfd : d = c * f, + (take f, suppose d = c * f, dvd.intro (show a * c * (e * f) = b * d, - by rewrite [mul.assoc, {c*_}mul.left_comm, -mul.assoc, Haeb, Hcfd]))) + by rewrite [mul.assoc, {c*_}mul.left_comm, -mul.assoc]; substvars))) - definition dvd_of_mul_right_dvd {a b c : A} (H : a * b ∣ c) : a ∣ c := + theorem dvd_of_mul_right_dvd {a b c : A} (H : a * b ∣ c) : a ∣ c := dvd.elim H (take d, assume Habdc : c = a * b * d, dvd.intro (!mul.assoc⁻¹ ⬝ Habdc⁻¹)) - definition dvd_of_mul_left_dvd {a b c : A} (H : a * b ∣ c) : b ∣ c := + theorem dvd_of_mul_left_dvd {a b c : A} (H : a * b ∣ c) : b ∣ c := dvd_of_mul_right_dvd (mul.comm a b ▸ H) - definition dvd_add {a b c : A} (Hab : a ∣ b) (Hac : a ∣ c) : a ∣ b + c := + theorem dvd_add {a b c : A} (Hab : a ∣ b) (Hac : a ∣ c) : a ∣ b + c := dvd.elim Hab - (take d, assume Hadb : b = a * d, + (take d, suppose b = a * d, dvd.elim Hac - (take e, assume Haec : c = a * e, + (take e, suppose c = a * e, dvd.intro (show a * (d + e) = b + c, - by rewrite [left_distrib, -Hadb, -Haec]))) + by rewrite [left_distrib]; substvars))) end comm_semiring /- ring -/ structure ring [class] (A : Type) extends add_comm_group A, monoid A, distrib A -definition ring.mul_zero [s : ring A] (a : A) : a * 0 = 0 := -have H : a * 0 + 0 = a * 0 + a * 0, from calc +theorem ring.mul_zero [s : ring A] (a : A) : a * 0 = 0 := +have a * 0 + 0 = a * 0 + a * 0, from calc a * 0 + 0 = a * 0 : by rewrite add_zero ... = a * (0 + 0) : by rewrite add_zero ... = a * 0 + a * 0 : by rewrite {a*_}ring.left_distrib, -show a * 0 = 0, from (add.left_cancel H)⁻¹ +show a * 0 = 0, from (add.left_cancel this)⁻¹ -definition ring.zero_mul [s : ring A] (a : A) : 0 * a = 0 := -have H : 0 * a + 0 = 0 * a + 0 * a, from calc +theorem ring.zero_mul [s : ring A] (a : A) : 0 * a = 0 := +have 0 * a + 0 = 0 * a + 0 * a, from calc 0 * a + 0 = 0 * a : by rewrite add_zero ... = (0 + 0) * a : by rewrite add_zero ... = 0 * a + 0 * a : by rewrite {_*a}ring.right_distrib, -show 0 * a = 0, from (add.left_cancel H)⁻¹ +show 0 * a = 0, from (add.left_cancel this)⁻¹ -definition ring.to_semiring [instance] [reducible] [s : ring A] : semiring A := +definition ring.to_semiring [trans_instance] [reducible] [s : ring A] : semiring A := ⦃ semiring, s, mul_zero := ring.mul_zero, zero_mul := ring.zero_mul ⦄ @@ -172,38 +182,41 @@ section variables [s : ring A] (a b c d e : A) include s - definition neg_mul_eq_neg_mul : -(a * b) = -a * b := + theorem neg_mul_eq_neg_mul : -(a * b) = -a * b := neg_eq_of_add_eq_zero begin rewrite [-right_distrib, add.right_inv, zero_mul] end - definition neg_mul_eq_mul_neg : -(a * b) = a * -b := + theorem neg_mul_eq_mul_neg : -(a * b) = a * -b := neg_eq_of_add_eq_zero begin rewrite [-left_distrib, add.right_inv, mul_zero] end - definition neg_mul_neg : -a * -b = a * b := + theorem neg_mul_eq_neg_mul_symm : - a * b = - (a * b) := inverse !neg_mul_eq_neg_mul + theorem mul_neg_eq_neg_mul_symm : a * - b = - (a * b) := inverse !neg_mul_eq_mul_neg + + theorem neg_mul_neg : -a * -b = a * b := calc -a * -b = -(a * -b) : by rewrite -neg_mul_eq_neg_mul ... = - -(a * b) : by rewrite -neg_mul_eq_mul_neg ... = a * b : by rewrite neg_neg - definition neg_mul_comm : -a * b = a * -b := !neg_mul_eq_neg_mul⁻¹ ⬝ !neg_mul_eq_mul_neg + theorem neg_mul_comm : -a * b = a * -b := !neg_mul_eq_neg_mul⁻¹ ⬝ !neg_mul_eq_mul_neg - definition neg_eq_neg_one_mul : -a = -1 * a := + theorem neg_eq_neg_one_mul : -a = -1 * a := calc -a = -(1 * a) : by rewrite one_mul ... = -1 * a : by rewrite neg_mul_eq_neg_mul - definition mul_sub_left_distrib : a * (b - c) = a * b - a * c := + theorem mul_sub_left_distrib : a * (b - c) = a * b - a * c := calc a * (b - c) = a * b + a * -c : left_distrib ... = a * b + - (a * c) : by rewrite -neg_mul_eq_mul_neg ... = a * b - a * c : rfl - definition mul_sub_right_distrib : (a - b) * c = a * c - b * c := + theorem mul_sub_right_distrib : (a - b) * c = a * c - b * c := calc (a - b) * c = a * c + -b * c : right_distrib ... = a * c + - (b * c) : by rewrite neg_mul_eq_neg_mul @@ -213,36 +226,42 @@ section -- TODO: there is also the other direction. It will be easier when we -- have the simplifier. - definition mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d := + theorem mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d := calc a * e + c = b * e + d ↔ a * e + c = d + b * e : by rewrite {b*e+_}add.comm ... ↔ a * e + c - b * e = d : iff.symm !sub_eq_iff_eq_add ... ↔ a * e - b * e + c = d : by rewrite sub_add_eq_add_sub ... ↔ (a - b) * e + c = d : by rewrite mul_sub_right_distrib - definition mul_neg_one_eq_neg : a * (-1) = -a := - have H : a + a * -1 = 0, from calc + theorem mul_add_eq_mul_add_of_sub_mul_add_eq : (a - b) * e + c = d → a * e + c = b * e + d := + iff.mpr !mul_add_eq_mul_add_iff_sub_mul_add_eq + + theorem sub_mul_add_eq_of_mul_add_eq_mul_add : a * e + c = b * e + d → (a - b) * e + c = d := + iff.mp !mul_add_eq_mul_add_iff_sub_mul_add_eq + + theorem mul_neg_one_eq_neg : a * (-1) = -a := + have a + a * -1 = 0, from calc a + a * -1 = a * 1 + a * -1 : mul_one ... = a * (1 + -1) : left_distrib ... = a * 0 : add.right_inv ... = 0 : mul_zero, - inverse (neg_eq_of_add_eq_zero H) + symm (neg_eq_of_add_eq_zero this) - definition ne_zero_and_ne_zero_of_mul_ne_zero {a b : A} (H : a * b ≠ 0) : a ≠ 0 × b ≠ 0 := - have Ha : a ≠ 0, from - (assume Ha1 : a = 0, - have H1 : a * b = 0, by rewrite [Ha1, zero_mul], - absurd H1 H), - have Hb : b ≠ 0, from - (assume Hb1 : b = 0, - have H1 : a * b = 0, by rewrite [Hb1, mul_zero], - absurd H1 H), - pair Ha Hb + theorem ne_zero_and_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], + absurd this H), + have b ≠ 0, from + (suppose b = 0, + have a * b = 0, by rewrite [this, mul_zero], + absurd this H), + pair `a ≠ 0` `b ≠ 0` end structure comm_ring [class] (A : Type) extends ring A, comm_semigroup A -definition comm_ring.to_comm_semiring [instance] [reducible] [s : comm_ring A] : comm_semiring A := +definition comm_ring.to_comm_semiring [trans_instance] [reducible] [s : comm_ring A] : comm_semiring A := ⦃ comm_semiring, s, mul_zero := mul_zero, zero_mul := zero_mul ⦄ @@ -251,43 +270,58 @@ section variables [s : comm_ring A] (a b c d e : A) include s - definition mul_self_sub_mul_self_eq : a * a - b * b = (a + b) * (a - b) := - by rewrite [left_distrib, *right_distrib, add.assoc, -{b*a + _}add.assoc, - -*neg_mul_eq_mul_neg, {a*b}mul.comm, add.right_inv, zero_add] + theorem mul_self_sub_mul_self_eq : a * a - b * b = (a + b) * (a - b) := + begin + krewrite [left_distrib, *right_distrib, add.assoc], + rewrite [-{b*a + _}add.assoc, + -*neg_mul_eq_mul_neg, {a*b}mul.comm, add.right_inv, zero_add] + end - definition mul_self_sub_one_eq : a * a - 1 = (a + 1) * (a - 1) := - mul_one 1 ▸ mul_self_sub_mul_self_eq a 1 + theorem mul_self_sub_one_eq : a * a - 1 = (a + 1) * (a - 1) := + by rewrite [-mul_self_sub_mul_self_eq, mul_one] - definition dvd_neg_iff_dvd : (a ∣ -b) ↔ (a ∣ b) := + theorem dvd_neg_iff_dvd : (a ∣ -b) ↔ (a ∣ b) := iff.intro - (assume H : (a ∣ -b), - dvd.elim H - (take c, assume H' : -b = a * c, + (suppose a ∣ -b, + dvd.elim this + (take c, suppose -b = a * c, dvd.intro (show a * -c = b, - by rewrite [-neg_mul_eq_mul_neg, -H', neg_neg]))) - (assume H : (a ∣ b), - dvd.elim H - (take c, assume H' : b = a * c, + by rewrite [-neg_mul_eq_mul_neg, -this, neg_neg]))) + (suppose a ∣ b, + dvd.elim this + (take c, suppose b = a * c, dvd.intro (show a * -c = -b, - by rewrite [-neg_mul_eq_mul_neg, -H']))) + by rewrite [-neg_mul_eq_mul_neg, -this]))) - definition neg_dvd_iff_dvd : (-a ∣ b) ↔ (a ∣ b) := + theorem dvd_neg_of_dvd : (a ∣ b) → (a ∣ -b) := + iff.mpr !dvd_neg_iff_dvd + + theorem dvd_of_dvd_neg : (a ∣ -b) → (a ∣ b) := + iff.mp !dvd_neg_iff_dvd + + theorem neg_dvd_iff_dvd : (-a ∣ b) ↔ (a ∣ b) := iff.intro - (assume H : (-a ∣ b), - dvd.elim H - (take c, assume H' : b = -a * c, + (suppose -a ∣ b, + dvd.elim this + (take c, suppose b = -a * c, dvd.intro - (show a * -c = b, by rewrite [-neg_mul_comm, H']))) - (assume H : (a ∣ b), - dvd.elim H - (take c, assume H' : b = a * c, + (show a * -c = b, by rewrite [-neg_mul_comm, this]))) + (suppose a ∣ b, + dvd.elim this + (take c, suppose b = a * c, dvd.intro - (show -a * -c = b, by rewrite [neg_mul_neg, H']))) + (show -a * -c = b, by rewrite [neg_mul_neg, this]))) - definition dvd_sub (H₁ : (a ∣ b)) (H₂ : (a ∣ c)) : (a ∣ b - c) := - dvd_add H₁ (iff.elim_right !dvd_neg_iff_dvd H₂) + theorem neg_dvd_of_dvd : (a ∣ b) → (-a ∣ b) := + iff.mpr !neg_dvd_iff_dvd + + theorem dvd_of_neg_dvd : (-a ∣ b) → (a ∣ b) := + iff.mp !neg_dvd_iff_dvd + + theorem dvd_sub (H₁ : (a ∣ b)) (H₂ : (a ∣ c)) : (a ∣ b - c) := + dvd_add H₁ (!dvd_neg_of_dvd H₂) end /- integral domains -/ @@ -295,67 +329,172 @@ end 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) -definition eq_zero_or_eq_zero_of_mul_eq_zero {A : Type} [s : no_zero_divisors A] {a b : A} +theorem eq_zero_or_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 -structure integral_domain [class] (A : Type) extends comm_ring A, no_zero_divisors A +structure integral_domain [class] (A : Type) extends comm_ring A, no_zero_divisors A, + zero_ne_one_class A section variables [s : integral_domain A] (a b c d e : A) include s - definition mul_ne_zero {a b : A} (H1 : a ≠ 0) (H2 : b ≠ 0) : a * b ≠ 0 := - assume H : a * b = 0, - sum.rec_on (eq_zero_or_eq_zero_of_mul_eq_zero H) (assume H3, H1 H3) (assume H4, H2 H4) + 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) - definition eq_of_mul_eq_mul_right {a b c : A} (Ha : a ≠ 0) (H : b * a = c * a) : b = c := - have H1 : b * a - c * a = 0, from iff.mp !eq_iff_sub_eq_zero H, - have H2 : (b - c) * a = 0, using H1, by rewrite [mul_sub_right_distrib, H1], - have H3 : b - c = 0, from sum_resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero H2) Ha, - iff.elim_right !eq_iff_sub_eq_zero H3 + 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, + iff.elim_right !eq_iff_sub_eq_zero this - definition eq_of_mul_eq_mul_left {a b c : A} (Ha : a ≠ 0) (H : a * b = a * c) : b = c := - have H1 : a * b - a * c = 0, from iff.mp !eq_iff_sub_eq_zero H, - have H2 : a * (b - c) = 0, using H1, by rewrite [mul_sub_left_distrib, H1], - have H3 : b - c = 0, from sum_resolve_right (eq_zero_or_eq_zero_of_mul_eq_zero H2) Ha, - iff.elim_right !eq_iff_sub_eq_zero H3 + 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, + iff.elim_right !eq_iff_sub_eq_zero this -- TODO: do we want the iff versions? - definition mul_self_eq_mul_self_iff (a b : A) : a * a = b * b ↔ a = b ⊎ a = -b := - iff.intro - (λ H : a * a = b * b, - have aux₁ : (a - b) * (a + b) = 0, - by rewrite [mul.comm, -mul_self_sub_mul_self_eq, H, sub_self], - assert aux₂ : a - b = 0 ⊎ a + b = 0, from !eq_zero_or_eq_zero_of_mul_eq_zero aux₁, - sum.rec_on aux₂ - (λ H : a - b = 0, sum.inl (eq_of_sub_eq_zero H)) - (λ H : a + b = 0, sum.inr (eq_neg_of_add_eq_zero H))) - (λ H : a = b ⊎ a = -b, sum.rec_on H - (λ a_eq_b, by rewrite a_eq_b) - (λ a_eq_mb, by rewrite [a_eq_mb, neg_mul_neg])) + theorem eq_zero_of_mul_eq_self_right {a b : A} (H₁ : b ≠ 1) (H₂ : a * b = a) : a = 0 := + have b - 1 ≠ 0, from + 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` - definition mul_self_eq_one_iff (a : A) : a * a = 1 ↔ a = 1 ⊎ a = -1 := - assert aux : a * a = 1 * 1 ↔ a = 1 ⊎ a = -1, from mul_self_eq_mul_self_iff a 1, - by rewrite mul_one at aux; exact aux + 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₂) + + theorem mul_self_eq_mul_self_iff (a b : A) : a * a = b * b ↔ a = b ⊎ a = -b := + iff.intro + (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, + 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))) + (suppose a = b ⊎ a = -b, sum.elim this + (suppose a = b, by rewrite this) + (suppose a = -b, by rewrite [this, neg_mul_neg])) + + theorem mul_self_eq_one_iff (a : A) : a * a = 1 ↔ a = 1 ⊎ a = -1 := + 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 - definition dvd_of_mul_dvd_mul_left {a b c : A} (Ha : a ≠ 0) (Hdvd : (a * b ∣ a * c)) : (b ∣ c) := + theorem dvd_of_mul_dvd_mul_left {a b c : A} (Ha : a ≠ 0) (Hdvd : (a * b ∣ a * c)) : (b ∣ c) := dvd.elim Hdvd (take d, - assume H : a * c = a * b * d, - have H1 : b * d = c, from eq_of_mul_eq_mul_left Ha (mul.assoc a b d ▸ H⁻¹), - dvd.intro H1) + suppose a * c = a * b * d, + have b * d = c, from eq_of_mul_eq_mul_left Ha (mul.assoc a b d ▸ this⁻¹), + dvd.intro this) - definition dvd_of_mul_dvd_mul_right {a b c : A} (Ha : a ≠ 0) (Hdvd : (b * a ∣ c * a)) : (b ∣ c) := + theorem dvd_of_mul_dvd_mul_right {a b c : A} (Ha : a ≠ 0) (Hdvd : (b * a ∣ c * a)) : (b ∣ c) := dvd.elim Hdvd (take d, - assume H : c * a = b * a * d, - have H1 : b * d * a = c * a, from by rewrite [mul.right_comm, -H], - have H2 : b * d = c, from eq_of_mul_eq_mul_right Ha H1, - dvd.intro H2) + suppose c * a = b * a * d, + have b * d * a = c * a, from by rewrite [mul.right_comm, -this], + have b * d = c, from eq_of_mul_eq_mul_right Ha this, + dvd.intro this) end +namespace norm_num + +theorem mul_zero [s : mul_zero_class A] (a : A) : a * zero = zero := + by rewrite [↑zero, mul_zero] + +theorem zero_mul [s : mul_zero_class A] (a : A) : zero * a = zero := + by rewrite [↑zero, zero_mul] + +theorem mul_one [s : monoid A] (a : A) : a * one = a := + by rewrite [↑one, mul_one] + +theorem mul_bit0 [s : distrib A] (a b : A) : a * (bit0 b) = bit0 (a * b) := + by rewrite [↑bit0, left_distrib] + +theorem mul_bit0_helper [s : distrib A] (a b t : A) (H : a * b = t) : a * (bit0 b) = bit0 t := + by rewrite -H; apply mul_bit0 + +theorem mul_bit1 [s : semiring A] (a b : A) : a * (bit1 b) = bit0 (a * b) + a := + by rewrite [↑bit1, ↑bit0, +left_distrib, ↑one, mul_one] + +theorem mul_bit1_helper [s : semiring A] (a b s t : A) (Hs : a * b = s) (Ht : bit0 s + a = t) : + a * (bit1 b) = t := + begin rewrite [-Ht, -Hs, mul_bit1] end + +theorem subst_into_prod [s : has_mul A] (l r tl tr t : A) (prl : l = tl) (prr : r = tr) + (prt : tl * tr = t) : + l * r = t := + by rewrite [prl, prr, prt] + +theorem mk_cong (op : A → A) (a b : A) (H : a = b) : op a = op b := + by congruence; exact H + +theorem mk_eq (a : A) : a = a := rfl + +theorem neg_add_neg_eq_of_add_add_eq_zero [s : add_comm_group A] (a b c : A) (H : c + a + b = 0) : + -a + -b = c := + begin + apply add_neg_eq_of_eq_add, + apply neg_eq_of_add_eq_zero, + rewrite [add.comm, add.assoc, add.comm b, -add.assoc, H] + end + +theorem neg_add_neg_helper [s : add_comm_group A] (a b c : A) (H : a + b = c) : -a + -b = -c := + begin apply iff.mp !neg_eq_neg_iff_eq, rewrite [neg_add, *neg_neg, H] end + +theorem neg_add_pos_eq_of_eq_add [s : add_comm_group A] (a b c : A) (H : b = c + a) : -a + b = c := + begin apply neg_add_eq_of_eq_add, rewrite add.comm, exact H end + +theorem neg_add_pos_helper1 [s : add_comm_group A] (a b c : A) (H : b + c = a) : -a + b = -c := + begin apply neg_add_eq_of_eq_add, apply eq_add_neg_of_add_eq H end + +theorem neg_add_pos_helper2 [s : add_comm_group A] (a b c : A) (H : a + c = b) : -a + b = c := + begin apply neg_add_eq_of_eq_add, rewrite H end + +theorem pos_add_neg_helper [s : add_comm_group A] (a b c : A) (H : b + a = c) : a + b = c := + by rewrite [add.comm, H] + +theorem sub_eq_add_neg_helper [s : add_comm_group A] (t₁ t₂ e w₁ w₂: A) (H₁ : t₁ = w₁) + (H₂ : t₂ = w₂) (H : w₁ + -w₂ = e) : t₁ - t₂ = e := + by rewrite [sub_eq_add_neg, H₁, H₂, H] + +theorem pos_add_pos_helper [s : add_comm_group A] (a b c h₁ h₂ : A) (H₁ : a = h₁) (H₂ : b = h₂) + (H : h₁ + h₂ = c) : a + b = c := + by rewrite [H₁, H₂, H] + +theorem subst_into_subtr [s : add_group A] (l r t : A) (prt : l + -r = t) : l - r = t := + by rewrite [sub_eq_add_neg, prt] + +theorem neg_neg_helper [s : add_group A] (a b : A) (H : a = -b) : -a = b := + by rewrite [H, neg_neg] + +theorem neg_mul_neg_helper [s : ring A] (a b c : A) (H : a * b = c) : (-a) * (-b) = c := + begin rewrite [neg_mul_neg, H] end + +theorem neg_mul_pos_helper [s : ring A] (a b c : A) (H : a * b = c) : (-a) * b = -c := + begin rewrite [-neg_mul_eq_neg_mul, H] end + +theorem pos_mul_neg_helper [s : ring A] (a b c : A) (H : a * b = c) : a * (-b) = -c := + begin rewrite [-neg_mul_comm, -neg_mul_eq_neg_mul, H] end + +end norm_num end algebra +open algebra + +attribute [simp] + zero_mul mul_zero + at simplifier.unit + +attribute [simp] + neg_mul_eq_neg_mul_symm mul_neg_eq_neg_mul_symm + at simplifier.neg + +attribute [simp] + left_distrib right_distrib + at simplifier.distrib diff --git a/hott/init/datatypes.hlean b/hott/init/datatypes.hlean index cdcf59c45..7e626f8ac 100644 --- a/hott/init/datatypes.hlean +++ b/hott/init/datatypes.hlean @@ -92,10 +92,14 @@ inductive string : Type := | empty : string | str : char → string → string -inductive nat := -| zero : nat -| succ : nat → nat - inductive option (A : Type) : Type := | none {} : option A | some : A → option A + +-- Remark: we manually generate the nat.rec_on, nat.induction_on, nat.cases_on and nat.no_confusion. +-- We do that because we want 0 instead of nat.zero in these eliminators. +set_option inductive.rec_on false +set_option inductive.cases_on false +inductive nat := +| zero : nat +| succ : nat → nat diff --git a/hott/init/logic.hlean b/hott/init/logic.hlean index 092727f12..deb59755f 100644 --- a/hott/init/logic.hlean +++ b/hott/init/logic.hlean @@ -61,13 +61,13 @@ namespace eq theorem mpr {a b : Type} : (a = b) → b → a := assume H₁ H₂, eq.rec_on (eq.symm H₁) H₂ - namespace ops - postfix ⁻¹ := symm --input with \sy or \-1 or \inv - infixl ⬝ := trans - infixr ▸ := subst - end ops + namespace ops end ops -- this is just to ensure that this namespace exists. There is nothing in it end eq +local postfix ⁻¹ := eq.symm --input with \sy or \-1 or \inv +local infixl ⬝ := eq.trans +local infixr ▸ := eq.subst + -- Auxiliary definition used by automation. It has the same type of eq.rec in the standard library definition eq.nrec.{l₁ l₂} {A : Type.{l₂}} {a : A} {C : A → Type.{l₁}} (H₁ : C a) (b : A) (H₂ : a = b) : C b := eq.rec H₁ H₂ diff --git a/hott/init/nat.hlean b/hott/init/nat.hlean index e66a88d4a..b47e27f1e 100644 --- a/hott/init/nat.hlean +++ b/hott/init/nat.hlean @@ -4,50 +4,74 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Leonardo de Moura -/ prelude -import init.wf init.tactic init.hedberg init.util init.types - -open eq decidable sum lift is_trunc +import init.wf init.tactic init.num init.types init.path +open eq eq.ops decidable +open algebra sum +set_option class.force_new true notation `ℕ` := nat namespace nat + protected definition rec_on [reducible] [recursor] [unfold 2] + {C : ℕ → Type} (n : ℕ) (H₁ : C 0) (H₂ : Π (a : ℕ), C a → C (succ a)) : C n := + nat.rec H₁ H₂ n + + protected definition cases_on [reducible] [recursor] [unfold 2] + {C : ℕ → Type} (n : ℕ) (H₁ : C 0) (H₂ : Π (a : ℕ), C (succ a)) : C n := + nat.rec H₁ (λ a ih, H₂ a) n + + protected definition no_confusion_type.{u} [reducible] (P : Type.{u}) (v₁ v₂ : ℕ) : Type.{u} := + nat.rec + (nat.rec + (P → lift P) + (λ a₂ ih, lift P) + v₂) + (λ a₁ ih, nat.rec + (lift P) + (λ a₂ ih, (a₁ = a₂ → P) → lift P) + v₂) + v₁ + + protected definition no_confusion [reducible] [unfold 4] + {P : Type} {v₁ v₂ : ℕ} (H : v₁ = v₂) : nat.no_confusion_type P v₁ v₂ := + eq.rec (λ H₁ : v₁ = v₁, nat.rec (λ h, lift.up h) (λ a ih h, lift.up (h (eq.refl a))) v₁) H H /- basic definitions on natural numbers -/ - inductive le (a : ℕ) : ℕ → Type₀ := - | refl : le a a + inductive le (a : ℕ) : ℕ → Type := + | nat_refl : le a a -- use nat_refl to avoid overloading le.refl | step : Π {b}, le a b → le a (succ b) - infix ` ≤ ` := le - attribute le.refl [refl] + definition nat_has_le [instance] [reducible] [priority nat.prio]: has_le nat := has_le.mk nat.le - definition lt [reducible] (n m : ℕ) := succ n ≤ m - definition ge [reducible] (n m : ℕ) := m ≤ n - definition gt [reducible] (n m : ℕ) := succ m ≤ n - infix ` < ` := lt - infix ` ≥ ` := ge - infix ` > ` := gt + protected lemma le_refl [refl] : Π a : nat, a ≤ a := + le.nat_refl + + protected definition lt [reducible] (n m : ℕ) := succ n ≤ m + definition nat_has_lt [instance] [reducible] [priority nat.prio] : has_lt nat := has_lt.mk nat.lt definition pred [unfold 1] (a : nat) : nat := nat.cases_on a zero (λ a₁, a₁) -- add is defined in init.num - definition sub (a b : nat) : nat := - nat.rec_on b a (λ b₁ r, pred r) + protected definition sub (a b : nat) : nat := + nat.rec_on b a (λ b₁, pred) - definition mul (a b : nat) : nat := + protected definition mul (a b : nat) : nat := nat.rec_on b zero (λ b₁ r, r + a) - notation a - b := sub a b - notation a * b := mul a b + definition nat_has_sub [instance] [reducible] [priority nat.prio] : has_sub nat := + has_sub.mk nat.sub + definition nat_has_mul [instance] [reducible] [priority nat.prio] : has_mul nat := + has_mul.mk nat.mul /- properties of ℕ -/ protected definition is_inhabited [instance] : inhabited nat := inhabited.mk zero - protected definition has_decidable_eq [instance] : ∀ x y : nat, decidable (x = y) + protected definition has_decidable_eq [instance] [priority nat.prio] : Π x y : nat, decidable (x = y) | has_decidable_eq zero zero := inl rfl | has_decidable_eq (succ x) zero := inr (by contradiction) | has_decidable_eq zero (succ y) := inr (by contradiction) @@ -59,109 +83,110 @@ namespace nat /- properties of inequality -/ - definition le_of_eq {n m : ℕ} (p : n = m) : n ≤ m := p ▸ le.refl n + protected theorem le_of_eq {n m : ℕ} (p : n = m) : n ≤ m := p ▸ !nat.le_refl - definition le_succ (n : ℕ) : n ≤ succ n := by repeat constructor + theorem le_succ (n : ℕ) : n ≤ succ n := le.step !nat.le_refl - definition pred_le (n : ℕ) : pred n ≤ n := by cases n;all_goals (repeat constructor) + theorem pred_le (n : ℕ) : pred n ≤ n := by cases n;repeat constructor - definition le.trans [trans] {n m k : ℕ} (H1 : n ≤ m) (H2 : m ≤ k) : n ≤ k := - by induction H2 with n H2 IH;exact H1;exact le.step IH + theorem le_succ_iff_unit [simp] (n : ℕ) : n ≤ succ n ↔ unit := + iff_unit_intro (le_succ n) - definition le_succ_of_le {n m : ℕ} (H : n ≤ m) : n ≤ succ m := le.trans H !le_succ + theorem pred_le_iff_unit [simp] (n : ℕ) : pred n ≤ n ↔ unit := + iff_unit_intro (pred_le n) - definition le_of_succ_le {n m : ℕ} (H : succ n ≤ m) : n ≤ m := le.trans !le_succ H + protected theorem le_trans {n m k : ℕ} (H1 : n ≤ m) : m ≤ k → n ≤ k := + le.rec H1 (λp H2, le.step) - definition le_of_lt {n m : ℕ} (H : n < m) : n ≤ m := le_of_succ_le H + theorem le_succ_of_le {n m : ℕ} (H : n ≤ m) : n ≤ succ m := nat.le_trans H !le_succ - definition succ_le_succ [unfold 3] {n m : ℕ} (H : n ≤ m) : succ n ≤ succ m := - by induction H;reflexivity;exact le.step v_0 + theorem le_of_succ_le {n m : ℕ} (H : succ n ≤ m) : n ≤ m := nat.le_trans !le_succ H - definition pred_le_pred [unfold 3] {n m : ℕ} (H : n ≤ m) : pred n ≤ pred m := - by induction H;reflexivity;cases b;exact v_0;exact le.step v_0 + protected theorem le_of_lt {n m : ℕ} (H : n < m) : n ≤ m := le_of_succ_le H - definition le_of_succ_le_succ [unfold 3] {n m : ℕ} (H : succ n ≤ succ m) : n ≤ m := - pred_le_pred H + theorem succ_le_succ {n m : ℕ} : n ≤ m → succ n ≤ succ m := + le.rec !nat.le_refl (λa b, le.step) - definition le_succ_of_pred_le [unfold 1] {n m : ℕ} (H : pred n ≤ m) : n ≤ succ m := - by cases n;exact le.step H;exact succ_le_succ H + theorem pred_le_pred {n m : ℕ} : n ≤ m → pred n ≤ pred m := + le.rec !nat.le_refl (nat.rec (λa b, b) (λa b c, le.step)) - definition not_succ_le_self {n : ℕ} : ¬succ n ≤ n := - by induction n with n IH;all_goals intros;cases a;apply IH;exact le_of_succ_le_succ a + theorem le_of_succ_le_succ {n m : ℕ} : succ n ≤ succ m → n ≤ m := + pred_le_pred - definition zero_le (n : ℕ) : 0 ≤ n := - by induction n with n IH;apply le.refl;exact le.step IH + theorem le_succ_of_pred_le {n m : ℕ} : pred n ≤ m → n ≤ succ m := + nat.cases_on n le.step (λa, succ_le_succ) - definition lt.step {n m : ℕ} (H : n < m) : n < succ m := - le.step H - - definition zero_lt_succ (n : ℕ) : 0 < succ n := - by induction n with n IH;apply le.refl;exact le.step IH - - definition lt.trans [trans] {n m k : ℕ} (H1 : n < m) (H2 : m < k) : n < k := - le.trans (le.step H1) H2 - - definition lt_of_le_of_lt [trans] {n m k : ℕ} (H1 : n ≤ m) (H2 : m < k) : n < k := - le.trans (succ_le_succ H1) H2 - - definition lt_of_lt_of_le [trans] {n m k : ℕ} (H1 : n < m) (H2 : m ≤ k) : n < k := - le.trans H1 H2 - - definition le.antisymm {n m : ℕ} (H1 : n ≤ m) (H2 : m ≤ n) : n = m := - begin - cases H1 with m' H1', - { reflexivity}, - { cases H2 with n' H2', - { reflexivity}, - { exfalso, apply not_succ_le_self, exact lt.trans H1' H2'}}, - end - - definition not_succ_le_zero (n : ℕ) : ¬succ n ≤ zero := + theorem not_succ_le_zero (n : ℕ) : ¬succ n ≤ 0 := by intro H; cases H - definition lt.irrefl (n : ℕ) : ¬n < n := not_succ_le_self + theorem succ_le_zero_iff_empty (n : ℕ) : succ n ≤ 0 ↔ empty := + iff_empty_intro !not_succ_le_zero - definition self_lt_succ (n : ℕ) : n < succ n := !le.refl - definition lt.base (n : ℕ) : n < succ n := !le.refl + theorem not_succ_le_self : Π {n : ℕ}, ¬succ n ≤ n := + nat.rec !not_succ_le_zero (λa b c, b (le_of_succ_le_succ c)) - definition le_lt_antisymm {n m : ℕ} (H1 : n ≤ m) (H2 : m < n) : empty := - !lt.irrefl (lt_of_le_of_lt H1 H2) + theorem succ_le_self_iff_empty [simp] (n : ℕ) : succ n ≤ n ↔ empty := + iff_empty_intro not_succ_le_self - definition lt_le_antisymm {n m : ℕ} (H1 : n < m) (H2 : m ≤ n) : empty := + theorem zero_le : Π (n : ℕ), 0 ≤ n := + nat.rec !nat.le_refl (λa, le.step) + + theorem zero_le_iff_unit [simp] (n : ℕ) : 0 ≤ n ↔ unit := + iff_unit_intro !zero_le + + theorem lt.step {n m : ℕ} : n < m → n < succ m := le.step + + theorem zero_lt_succ (n : ℕ) : 0 < succ n := + succ_le_succ !zero_le + + theorem zero_lt_succ_iff_unit [simp] (n : ℕ) : 0 < succ n ↔ unit := + iff_unit_intro (zero_lt_succ n) + + protected theorem lt_trans {n m k : ℕ} (H1 : n < m) : m < k → n < k := + nat.le_trans (le.step H1) + + protected theorem lt_of_le_of_lt {n m k : ℕ} (H1 : n ≤ m) : m < k → n < k := + nat.le_trans (succ_le_succ H1) + + protected theorem lt_of_lt_of_le {n m k : ℕ} : n < m → m ≤ k → n < k := nat.le_trans + + protected theorem lt_irrefl (n : ℕ) : ¬n < n := not_succ_le_self + + theorem lt_self_iff_empty (n : ℕ) : n < n ↔ empty := + iff_empty_intro (λ H, absurd H (nat.lt_irrefl n)) + + theorem self_lt_succ (n : ℕ) : n < succ n := !nat.le_refl + + theorem self_lt_succ_iff_unit [simp] (n : ℕ) : n < succ n ↔ unit := + iff_unit_intro (self_lt_succ n) + + theorem lt.base (n : ℕ) : n < succ n := !nat.le_refl + + theorem le_lt_antisymm {n m : ℕ} (H1 : n ≤ m) (H2 : m < n) : empty := + !nat.lt_irrefl (nat.lt_of_le_of_lt H1 H2) + + protected theorem le_antisymm {n m : ℕ} (H1 : n ≤ m) : m ≤ n → n = m := + le.cases_on H1 (λa, rfl) (λa b c, absurd (nat.lt_of_le_of_lt b c) !nat.lt_irrefl) + + theorem lt_le_antisymm {n m : ℕ} (H1 : n < m) (H2 : m ≤ n) : empty := le_lt_antisymm H2 H1 - definition lt.asymm {n m : ℕ} (H1 : n < m) (H2 : m < n) : empty := - le_lt_antisymm (le_of_lt H1) H2 + protected theorem nat.lt_asymm {n m : ℕ} (H1 : n < m) : ¬ m < n := + le_lt_antisymm (nat.le_of_lt H1) - definition lt.trichotomy (a b : ℕ) : a < b ⊎ a = b ⊎ b < a := - begin - revert b, induction a with a IH, - { intro b, cases b, - exact inr (inl idp), - exact inl !zero_lt_succ}, - { intro b, cases b with b, - exact inr (inr !zero_lt_succ), - { cases IH b with H H, - exact inl (succ_le_succ H), - cases H with H H, - exact inr (inl (ap succ H)), - exact inr (inr (succ_le_succ H))}} - end + theorem not_lt_zero (a : ℕ) : ¬ a < 0 := !not_succ_le_zero - definition lt.by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P := - by induction (lt.trichotomy a b) with H H; exact H1 H; cases H with H H; exact H2 H;exact H3 H + theorem lt_zero_iff_empty [simp] (a : ℕ) : a < 0 ↔ empty := + iff_empty_intro (not_lt_zero a) - definition lt_ge_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a ≥ b → P) : P := - lt.by_cases H1 (λH, H2 (le_of_eq H⁻¹)) (λH, H2 (le_of_lt H)) + protected theorem eq_or_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)) - definition lt_or_ge (a b : ℕ) : (a < b) ⊎ (a ≥ b) := - lt_ge_by_cases inl inr - - definition not_lt_zero (a : ℕ) : ¬ a < zero := - by intro H; cases H + protected theorem le_of_eq_or_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 - definition lt.wf [instance] : well_founded lt := + definition lt.wf [instance] : well_founded (lt : ℕ → ℕ → Type₀) := begin constructor, intro n, induction n with n IH, { constructor, intros n H, exfalso, exact !not_lt_zero H}, @@ -170,130 +195,87 @@ namespace nat { intros n₁ hlt, induction hlt, { intro p, injection p with q, exact q ▸ IH}, { intro p, injection p with q, exact (acc.inv (q ▸ IH) a)}}, - apply aux H idp}, + apply aux H rfl}, end - definition measure {A : Type} (f : A → ℕ) : A → A → Type₀ := - inv_image lt f + definition measure {A : Type} : (A → ℕ) → A → A → Type₀ := + inv_image lt definition measure.wf {A : Type} (f : A → ℕ) : well_founded (measure f) := inv_image.wf f lt.wf - definition succ_lt_succ {a b : ℕ} (H : a < b) : succ a < succ b := - succ_le_succ H + theorem succ_lt_succ {a b : ℕ} : a < b → succ a < succ b := + succ_le_succ - definition lt_of_succ_lt {a b : ℕ} (H : succ a < b) : a < b := - le_of_succ_le H + theorem lt_of_succ_lt {a b : ℕ} : succ a < b → a < b := + le_of_succ_le - definition lt_of_succ_lt_succ {a b : ℕ} (H : succ a < succ b) : a < b := - le_of_succ_le_succ H + theorem lt_of_succ_lt_succ {a b : ℕ} : succ a < succ b → a < b := + le_of_succ_le_succ - definition decidable_le [instance] : decidable_rel le := - begin - intros n, induction n with n IH, - { intro m, left, apply zero_le}, - { intro m, cases m with m, - { right, apply not_succ_le_zero}, - { let H := IH m, clear IH, - cases H with H H, - left, exact succ_le_succ H, - right, intro H2, exact H (le_of_succ_le_succ H2)}} - end + definition decidable_le [instance] [priority nat.prio] : Π a b : nat, decidable (a ≤ b) := + nat.rec (λm, (decidable.inl !zero_le)) + (λn IH m, !nat.cases_on (decidable.inr (not_succ_le_zero n)) + (λm, decidable.rec (λH, inl (succ_le_succ H)) + (λH, inr (λa, H (le_of_succ_le_succ a))) (IH m))) - definition decidable_lt [instance] : decidable_rel lt := _ - definition decidable_gt [instance] : decidable_rel gt := _ - definition decidable_ge [instance] : decidable_rel ge := _ + definition decidable_lt [instance] [priority nat.prio] : Π a b : nat, decidable (a < b) := + λ a b, decidable_le (succ a) b - definition eq_or_lt_of_le {a b : ℕ} (H : a ≤ b) : a = b ⊎ a < b := - by cases H with b' H; exact sum.inl rfl; exact sum.inr (succ_le_succ H) + protected theorem lt_or_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 + 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))) - definition le_of_eq_or_lt {a b : ℕ} (H : a = b ⊎ a < b) : a ≤ b := - by cases H with H H; exact le_of_eq H; exact le_of_lt H + protected definition lt_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P) + (H3 : b < a → P) : P := + nat.lt_ge_by_cases H1 (λh₁, + nat.lt_ge_by_cases H3 (λh₂, H2 (nat.le_antisymm h₂ h₁))) - definition eq_or_lt_of_not_lt {a b : ℕ} (hnlt : ¬ a < b) : a = b ⊎ b < a := - sum.rec_on (lt.trichotomy a b) + 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 := + sum.rec_on (nat.lt_trichotomy a b) (λ hlt, absurd hlt hnlt) (λ h, h) - definition lt_succ_of_le {a b : ℕ} (h : a ≤ b) : a < succ b := - succ_le_succ h + theorem lt_succ_of_le {a b : ℕ} : a ≤ b → a < succ b := + succ_le_succ - definition lt_of_succ_le {a b : ℕ} (h : succ a ≤ b) : a < b := h + theorem lt_of_succ_le {a b : ℕ} (h : succ a ≤ b) : a < b := h - definition succ_le_of_lt {a b : ℕ} (h : a < b) : succ a ≤ b := h + theorem succ_le_of_lt {a b : ℕ} (h : a < b) : succ a ≤ b := h - definition max (a b : ℕ) : ℕ := if a < b then b else a - definition min (a b : ℕ) : ℕ := if a < b then a else b + theorem succ_sub_succ_eq_sub [simp] (a b : ℕ) : succ a - succ b = a - b := + nat.rec (by esimp) (λ b, ap pred) b - definition max_self (a : ℕ) : max a a = a := - eq.rec_on !if_t_t rfl + theorem sub_eq_succ_sub_succ (a b : ℕ) : a - b = succ a - succ b := + inverse !succ_sub_succ_eq_sub - definition max_eq_right {a b : ℕ} (H : a < b) : max a b = b := - if_pos H + theorem zero_sub_eq_zero [simp] (a : ℕ) : 0 - a = 0 := + nat.rec rfl (λ a, ap pred) a - definition max_eq_left {a b : ℕ} (H : ¬ a < b) : max a b = a := - if_neg H + theorem zero_eq_zero_sub (a : ℕ) : 0 = 0 - a := + inverse !zero_sub_eq_zero - definition eq_max_right {a b : ℕ} (H : a < b) : b = max a b := - eq.rec_on (max_eq_right H) rfl + theorem sub_le (a b : ℕ) : a - b ≤ a := + nat.rec_on b !nat.le_refl (λ b₁, nat.le_trans !pred_le) - definition eq_max_left {a b : ℕ} (H : ¬ a < b) : a = max a b := - eq.rec_on (max_eq_left H) rfl + theorem sub_le_iff_unit [simp] (a b : ℕ) : a - b ≤ a ↔ unit := + iff_unit_intro (sub_le a b) - definition le_max_left (a b : ℕ) : a ≤ max a b := - by_cases - (λ h : a < b, le_of_lt (eq.rec_on (eq_max_right h) h)) - (λ h : ¬ a < b, eq.rec_on (eq_max_left h) !le.refl) + theorem sub_lt {a b : ℕ} (H1 : 0 < a) (H2 : 0 < b) : a - b < a := + !nat.cases_on (λh, absurd h !nat.lt_irrefl) + (λa h, succ_le_succ (!nat.cases_on (λh, absurd h !nat.lt_irrefl) + (λb c, tr_rev _ !succ_sub_succ_eq_sub !sub_le) H2)) H1 - definition le_max_right (a b : ℕ) : b ≤ max a b := - by_cases - (λ h : a < b, eq.rec_on (eq_max_right h) !le.refl) - (λ h : ¬ a < b, sum.rec_on (eq_or_lt_of_not_lt h) - (λ heq, eq.rec_on heq (eq.rec_on (inverse (max_self a)) !le.refl)) - (λ h : b < a, - have aux : a = max a b, from eq_max_left (lt.asymm h), - eq.rec_on aux (le_of_lt h))) + theorem sub_lt_succ (a b : ℕ) : a - b < succ a := + lt_succ_of_le !sub_le - definition succ_sub_succ_eq_sub (a b : ℕ) : succ a - succ b = a - b := - by induction b with b IH; reflexivity; apply ap pred IH - - definition sub_eq_succ_sub_succ (a b : ℕ) : a - b = succ a - succ b := - eq.rec_on (succ_sub_succ_eq_sub a b) rfl - - definition zero_sub_eq_zero (a : ℕ) : zero - a = zero := - nat.rec_on a - rfl - (λ a₁ (ih : zero - a₁ = zero), ap pred ih) - - definition zero_eq_zero_sub (a : ℕ) : zero = zero - a := - eq.rec_on (zero_sub_eq_zero a) rfl - - definition sub_lt {a b : ℕ} : zero < a → zero < b → a - b < a := - have aux : Π {a}, zero < a → Π {b}, zero < b → a - b < a, from - λa h₁, le.rec_on h₁ - (λb h₂, le.cases_on h₂ - (lt.base zero) - (λ b₁ bpos, - eq.rec_on (sub_eq_succ_sub_succ zero b₁) - (eq.rec_on (zero_eq_zero_sub b₁) (lt.base zero)))) - (λa₁ apos ih b h₂, le.cases_on h₂ - (lt.base a₁) - (λ b₁ bpos, - eq.rec_on (sub_eq_succ_sub_succ a₁ b₁) - (lt.trans (@ih b₁ bpos) (lt.base a₁)))), - λ h₁ h₂, aux h₁ h₂ - - definition sub_le (a b : ℕ) : a - b ≤ a := - nat.rec_on b - (le.refl a) - (λ b₁ ih, le.trans !pred_le ih) - - lemma sub_lt_succ (a b : ℕ) : a - b < succ a := lt_succ_of_le (sub_le a b) + theorem sub_lt_succ_iff_unit [simp] (a b : ℕ) : a - b < succ a ↔ unit := + iff_unit_intro !sub_lt_succ end nat - -namespace nat_esimp - open nat - attribute add mul sub [unfold 2] - attribute of_num [unfold 1] -end nat_esimp diff --git a/hott/init/num.hlean b/hott/init/num.hlean index ed635b009..57c6e7401 100644 --- a/hott/init/num.hlean +++ b/hott/init/num.hlean @@ -3,25 +3,17 @@ Copyright (c) 2014 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ - prelude -import init.logic init.bool -open bool - -definition pos_num.is_inhabited [instance] : inhabited pos_num := -inhabited.mk pos_num.one +import init.bool +open bool algebra namespace pos_num - notation a + b := add a b - - definition mul (a b : pos_num) : pos_num := + protected definition mul (a b : pos_num) : pos_num := pos_num.rec_on a b (λn r, bit0 r + b) (λn r, bit0 r) - notation a * b := mul a b - definition lt (a b : pos_num) : bool := pos_num.rec_on a (λ b, pos_num.cases_on b @@ -39,15 +31,11 @@ namespace pos_num b definition le (a b : pos_num) : bool := - lt a (succ b) - - definition equal (a b : pos_num) : bool := - le a b && le b a - + pos_num.lt a (succ b) end pos_num -definition num.is_inhabited [instance] : inhabited num := -inhabited.mk num.zero +definition pos_num_has_mul [instance] [reducible] : has_mul pos_num := +has_mul.mk pos_num.mul namespace num open pos_num @@ -58,13 +46,15 @@ namespace num definition size (a : num) : num := num.rec_on a (pos one) (λp, pos (size p)) - definition mul (a b : num) : num := + protected definition mul (a b : num) : num := num.rec_on a zero (λpa, num.rec_on b zero (λpb, pos (pos_num.mul pa pb))) +end num - notation a + b := add a b - notation a * b := mul a b +definition num_has_mul [instance] [reducible] : has_mul num := +has_mul.mk num.mul - definition le (a b : num) : bool := +namespace num + protected definition le (a b : num) : bool := num.rec_on a tt (λpa, num.rec_on b ff (λpb, pos_num.le pa pb)) private definition psub (a b : pos_num) : num := @@ -86,23 +76,9 @@ namespace num (λm, 2 * f m))) b - definition sub (a b : num) : num := + protected definition sub (a b : num) : num := num.rec_on a zero (λpa, num.rec_on b a (λpb, psub pa pb)) - - notation a ≤ b := le a b - notation a - b := sub a b end num --- the coercion from num to nat is defined here, --- so that it can already be used in init.trunc and init.tactic -namespace nat - definition add (a b : nat) : nat := - nat.rec_on b a (λ b₁ r, succ r) - - notation a + b := add a b - - definition of_num [coercion] (n : num) : nat := - num.rec zero - (λ n, pos_num.rec (succ zero) (λ n r, r + r + (succ zero)) (λ n r, r + r) n) n -end nat -attribute nat.of_num [reducible] -- of_num is also reducible if namespace "nat" is not opened +definition num_has_sub [instance] [reducible] : has_sub num := +has_sub.mk num.sub diff --git a/hott/init/reserved_notation.hlean b/hott/init/reserved_notation.hlean index 70de28994..18ae9dbf6 100644 --- a/hott/init/reserved_notation.hlean +++ b/hott/init/reserved_notation.hlean @@ -1,7 +1,7 @@ /- Copyright (c) 2014 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Leonardo de Moura, Floris van Doorn +Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn -/ prelude import init.datatypes @@ -9,15 +9,36 @@ import init.datatypes notation `assume` binders `,` r:(scoped f, f) := r notation `take` binders `,` r:(scoped f, f) := r -structure has_zero [class] (A : Type) := (zero : A) -structure has_one [class] (A : Type) := (one : A) -structure has_add [class] (A : Type) := (add : A → A → A) +structure has_zero [class] (A : Type) := (zero : A) +structure has_one [class] (A : Type) := (one : A) +structure has_add [class] (A : Type) := (add : A → A → A) +structure has_mul [class] (A : Type) := (mul : A → A → A) +structure has_inv [class] (A : Type) := (inv : A → A) +structure has_neg [class] (A : Type) := (neg : A → A) +structure has_sub [class] (A : Type) := (sub : A → A → A) +structure has_div [class] (A : Type) := (div : A → A → A) +structure has_mod [class] (A : Type) := (mod : A → A → A) +structure has_dvd.{l} [class] (A : Type.{l}) : Type.{l+1} := (dvd : A → A → Type.{l}) +structure has_le.{l} [class] (A : Type.{l}) : Type.{l+1} := (le : A → A → Type.{l}) +structure has_lt.{l} [class] (A : Type.{l}) : Type.{l+1} := (lt : A → A → Type.{l}) -definition zero [reducible] {A : Type} [s : has_zero A] : A := has_zero.zero A -definition one [reducible] {A : Type} [s : has_one A] : A := has_one.one A -definition add [reducible] {A : Type} [s : has_add A] : A → A → A := has_add.add -definition bit0 [reducible] {A : Type} [s : has_add A] (a : A) : A := add a a -definition bit1 [reducible] {A : Type} [s₁ : has_one A] [s₂ : has_add A] (a : A) : A := add (bit0 a) one +definition zero [reducible] {A : Type} [s : has_zero A] : A:= has_zero.zero A +definition one {A : Type} [s : has_one A] : A := has_one.one A +definition add {A : Type} [s : has_add A] : A → A → A := has_add.add +definition mul {A : Type} [s : has_mul A] : A → A → A := has_mul.mul +definition sub {A : Type} [s : has_sub A] : A → A → A := has_sub.sub +definition div {A : Type} [s : has_div A] : A → A → A := has_div.div +definition dvd {A : Type} [s : has_dvd A] : A → A → Type := has_dvd.dvd +definition mod {A : Type} [s : has_mod A] : A → A → A := has_mod.mod +definition neg {A : Type} [s : has_neg A] : A → A := has_neg.neg +definition inv {A : Type} [s : has_inv A] : A → A := has_inv.inv +definition le {A : Type} [s : has_le A] : A → A → Type := has_le.le +definition lt {A : Type} [s : has_lt A] : A → A → Type := has_lt.lt + +definition ge [reducible] {A : Type} [s : has_le A] (a b : A) : Type := le b a +definition gt [reducible] {A : Type} [s : has_lt A] (a b : A) : Type := lt b a +definition bit0 {A : Type} [s : has_add A] (a : A) : A := add a a +definition bit1 {A : Type} [s₁ : has_one A] [s₂ : has_add A] (a : A) : A := add (bit0 a) one definition num_has_zero [reducible] [instance] : has_zero num := has_zero.mk num.zero @@ -69,6 +90,26 @@ has_add.mk num.add definition std.priority.default : num := 1000 definition std.priority.max : num := 4294967295 +namespace nat + protected definition prio := num.add std.priority.default 100 + + protected definition add (a b : nat) : nat := + nat.rec a (λ b₁ r, succ r) b + + definition of_num (n : num) : nat := + num.rec zero + (λ n, pos_num.rec (succ zero) (λ n r, nat.add (nat.add r r) (succ zero)) (λ n r, nat.add r r) n) n +end nat + +definition nat_has_zero [reducible] [instance] [priority nat.prio] : has_zero nat := +has_zero.mk nat.zero + +definition nat_has_one [reducible] [instance] [priority nat.prio] : has_one nat := +has_one.mk (nat.succ (nat.zero)) + +definition nat_has_add [reducible] [instance] [priority nat.prio] : has_add nat := +has_add.mk nat.add + /- Global declarations of right binding strength @@ -105,11 +146,12 @@ reserve infix ` ≈ `:50 reserve infix ` ~ `:50 reserve infix ` ≡ `:50 -reserve infixr ` ∘ `:60 -- input with \comp +reserve infixr ` ∘ `:60 -- input with \comp reserve postfix `⁻¹`:std.prec.max_plus -- input with \sy or \-1 or \inv reserve infixl ` ⬝ `:75 reserve infixr ` ▸ `:75 +reserve infixr ` ▹ `:75 /- types and type constructors -/ @@ -121,10 +163,9 @@ reserve infixr ` × `:30 reserve infixl ` + `:65 reserve infixl ` - `:65 reserve infixl ` * `:70 -reserve infixl ` div `:70 -reserve infixl ` mod `:70 reserve infixl ` / `:70 -reserve prefix ` - `:100 +reserve infixl ` % `:70 +reserve prefix `-`:100 reserve infix ` ^ `:80 reserve infix ` <= `:50 @@ -153,3 +194,34 @@ reserve infix ` ⊇ `:50 reserve infix ` ∣ `:50 reserve infixl ` ++ `:65 reserve infixr ` :: `:67 + +/- + in the HoTT library we might not always want to overload the following notation, + so we put it in namespace algebra +-/ + +infix + := add +infix * := mul +infix - := sub +infix / := div +infix ∣ := dvd +infix % := mod +prefix - := neg +namespace algebra +postfix ⁻¹ := inv +end algebra +infix ≤ := le +infix ≥ := ge +infix < := lt +infix > := gt + +notation [parsing_only] x ` +[`:65 A:0 `] `:0 y:65 := @add A _ x y +notation [parsing_only] x ` -[`:65 A:0 `] `:0 y:65 := @sub A _ x y +notation [parsing_only] x ` *[`:70 A:0 `] `:0 y:70 := @mul A _ x y +notation [parsing_only] x ` /[`:70 A:0 `] `:0 y:70 := @div A _ x y +notation [parsing_only] x ` ∣[`:70 A:0 `] `:0 y:70 := @dvd A _ x y +notation [parsing_only] x ` %[`:70 A:0 `] `:0 y:70 := @mod A _ x y +notation [parsing_only] x ` ≤[`:50 A:0 `] `:0 y:50 := @le A _ x y +notation [parsing_only] x ` ≥[`:50 A:0 `] `:0 y:50 := @ge A _ x y +notation [parsing_only] x ` <[`:50 A:0 `] `:0 y:50 := @lt A _ x y +notation [parsing_only] x ` >[`:50 A:0 `] `:0 y:50 := @gt A _ x y diff --git a/hott/init/trunc.hlean b/hott/init/trunc.hlean index 4767025f2..43751a484 100644 --- a/hott/init/trunc.hlean +++ b/hott/init/trunc.hlean @@ -11,8 +11,9 @@ Ported from Coq HoTT. --TODO: can we replace some definitions with a hprop as codomain by theorems? prelude -import .logic .equiv .types .pathover +import .nat .logic .equiv .pathover open eq nat sigma unit +set_option class.force_new true namespace is_trunc @@ -22,15 +23,19 @@ namespace is_trunc | minus_two : trunc_index | succ : trunc_index → trunc_index + open trunc_index + + definition has_zero_trunc_index [instance] [reducible] : has_zero trunc_index := + has_zero.mk (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) -/ + notation `-1` := trunc_index.succ trunc_index.minus_two -- ISSUE: -1 gets printed as -2.+1? + notation `-2` := trunc_index.minus_two postfix ` .+1`:(max+1) := trunc_index.succ postfix ` .+2`:(max+1) := λn, (n .+1 .+1) - notation `-2` := trunc_index.minus_two - notation `-1` := -2.+1 -- ISSUE: -1 gets printed as -2.+1 - export [coercions] nat notation `ℕ₋₂` := trunc_index namespace trunc_index @@ -157,7 +162,7 @@ namespace is_trunc -- these must be definitions, because we need them to compute sometimes definition is_trunc_of_is_contr (A : Type) (n : trunc_index) [H : is_contr A] : is_trunc n A := - trunc_index.rec_on n H _ + trunc_index.rec_on n H (λn H, _) definition is_trunc_succ_of_is_hprop (A : Type) (n : trunc_index) [H : is_hprop A] : is_trunc (n.+1) A := @@ -165,7 +170,7 @@ namespace is_trunc definition is_trunc_succ_succ_of_is_hset (A : Type) (n : trunc_index) [H : is_hset A] : is_trunc (n.+2) A := - is_trunc_of_leq A (show 0 ≤ n.+2, from star) + @(is_trunc_of_leq A (show 0 ≤ n.+2, from proof star qed)) H /- hprops -/ diff --git a/hott/init/types.hlean b/hott/init/types.hlean index 56cc786e6..7e5317119 100644 --- a/hott/init/types.hlean +++ b/hott/init/types.hlean @@ -48,10 +48,10 @@ end sigma -- Sum type -- -------- +infixr ⊎ := sum +infixr + := sum namespace sum - infixr ⊎ := sum - infixr + := sum infixr [parsing_only] `+t`:25 := sum -- notation which is never overloaded namespace low_precedence_plus reserve infixr ` + `:25 -- conflicts with notation for addition @@ -59,6 +59,9 @@ namespace sum end low_precedence_plus 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)) @@ -79,12 +82,12 @@ end sum -- ------------ abbreviation pair [constructor] := @prod.mk +infixr × := prod namespace prod -- notation for n-ary tuples notation `(` h `, ` t:(foldl `,` (e r, prod.mk r e) h) `)` := t - infixr × := prod infixr [parsing_only] `×t`:30 := prod -- notation which is never overloaded namespace ops diff --git a/library/algebra/algebra.md b/library/algebra/algebra.md index cad53e13f..7b150b647 100644 --- a/library/algebra/algebra.md +++ b/library/algebra/algebra.md @@ -19,6 +19,7 @@ Algebraic structures. * [ring_power](ring_power.lean) : power in ring structures * [field](field.lean) * [ordered_field](ordered_field.lean) -* [category](category/category.md) : category theory +* [bundled](bundled.lean) : bundled versions of the algebraic structures +* [category](category/category.md) : category theory (outdated, see HoTT category theory folder) We set a low priority for algebraic operations, so that the elaborator tries concrete structures first. \ No newline at end of file diff --git a/library/algebra/category/category.md b/library/algebra/category/category.md index ce646a70e..78eb39ac6 100644 --- a/library/algebra/category/category.md +++ b/library/algebra/category/category.md @@ -1,6 +1,8 @@ algebra.category ================ +Everything in this folder is outdated. See HoTT category folder for a up-to-date version. + Algebraic structures. * [basic](basic.lean) : definition of fully and partially bundled categories diff --git a/library/algebra/group.lean b/library/algebra/group.lean index 60769bd90..c9d933813 100644 --- a/library/algebra/group.lean +++ b/library/algebra/group.lean @@ -167,7 +167,7 @@ section group theorem inv_inv (a : A) : (a⁻¹)⁻¹ = a := inv_eq_of_mul_eq_one (mul.left_inv a) theorem inv.inj {a b : A} (H : a⁻¹ = b⁻¹) : a = b := - by rewrite [-inv_inv, H, inv_inv] + by rewrite [-inv_inv a, H, inv_inv b] theorem inv_eq_inv_iff_eq (a b : A) : a⁻¹ = b⁻¹ ↔ a = b := iff.intro (assume H, inv.inj H) (assume H, congr_arg _ H) @@ -185,7 +185,7 @@ section group iff.intro !eq_inv_of_eq_inv !eq_inv_of_eq_inv theorem eq_inv_of_mul_eq_one {a b : A} (H : a * b = 1) : a = b⁻¹ := - begin rewrite [eq_inv_iff_eq_inv], apply eq.symm, exact inv_eq_of_mul_eq_one H end + begin apply eq_inv_of_eq_inv, symmetry, exact inv_eq_of_mul_eq_one H end theorem mul.right_inv (a : A) : a * a⁻¹ = 1 := calc diff --git a/library/algebra/ordered_group.lean b/library/algebra/ordered_group.lean index 2c9576b6a..505c1e485 100644 --- a/library/algebra/ordered_group.lean +++ b/library/algebra/ordered_group.lean @@ -208,7 +208,6 @@ theorem ordered_comm_group.lt_of_add_lt_add_left [s : ordered_comm_group A] {a b assert H' : -a + (a + b) < -a + (a + c), from ordered_comm_group.add_lt_add_left _ _ H _, by rewrite *neg_add_cancel_left at H'; exact H' -set_option pp.all true definition ordered_comm_group.to_ordered_cancel_comm_monoid [trans_instance] [reducible] [s : ordered_comm_group A] : ordered_cancel_comm_monoid A := ⦃ ordered_cancel_comm_monoid, s, diff --git a/library/init/nat.lean b/library/init/nat.lean index 0cad98f68..f325fa5c2 100644 --- a/library/init/nat.lean +++ b/library/init/nat.lean @@ -192,7 +192,7 @@ namespace nat well_founded.intro (nat.rec (!acc.intro (λn H, absurd H (not_lt_zero n))) (λn IH, !acc.intro (λm H, - elim (nat.eq_or_lt_of_le (le_of_succ_le_succ H)) + or.elim (nat.eq_or_lt_of_le (le_of_succ_le_succ H)) (λe, eq.substr e IH) (acc.inv IH)))) definition measure {A : Type} : (A → ℕ) → A → A → Prop := @@ -222,10 +222,10 @@ namespace nat protected theorem lt_or_ge (a b : ℕ) : a < b ∨ a ≥ b := nat.rec (inr !zero_le) (λn, or.rec (λh, inl (le_succ_of_le h)) - (λh, elim (nat.eq_or_lt_of_le h) (λe, inl (eq.subst e !nat.le_refl)) inr)) b + (λh, or.elim (nat.eq_or_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 (elim !nat.lt_or_ge (λa, absurd a h) (λa, a))) + by_cases H1 (λh, H2 (or.elim !nat.lt_or_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 := diff --git a/script/port.pl b/script/port.pl index 499efce49..a82d3d933 100755 --- a/script/port.pl +++ b/script/port.pl @@ -14,6 +14,10 @@ # The arguments "fromi" and "toi" are optional, but should be provided in pairs. # These arguments will replace "fromi" by "toi" in the specified file, # before doing any other renamings. +# +# We use slightly different regular expressions here. Given the replacement rule foo:bar, we replace +# foo by bar except is foo is preceded or followed by a letter. We still replace foo if it's +# followed by a digit, underscore, period or similar. use strict; use warnings; @@ -61,17 +65,17 @@ sub show_renamings { # rename all identifiers a file; original goes in file.orig sub rename_in_file { my $filename = shift; - local($^I, @ARGV) = ('.orig', $filename); + local($^I, @ARGV) = ('.temp', $filename); while (<>) { foreach my $lkey (keys %literalrenamings2) { # replace all instances of lkey # if (/$lkey/) {print STDOUT "renamed ", $lkey, "\n"; } - s/$lkey/$literalrenamings2{$lkey}/g + s/$lkey/$literalrenamings2{$lkey}/g; } foreach my $key (keys %renamings) { # replace instances of key, not preceeded by a letter, and not # followed by a letter, number, or ' - s/(?ensure_type(A, cs)); levels ls(A_lvl); bool is_strict = true; diff --git a/src/frontends/lean/notation_cmd.cpp b/src/frontends/lean/notation_cmd.cpp index a01f3e0f2..c46407517 100644 --- a/src/frontends/lean/notation_cmd.cpp +++ b/src/frontends/lean/notation_cmd.cpp @@ -42,12 +42,12 @@ static unsigned parse_precedence_core(parser & p) { return p.parse_small_nat(); } else { environment env = p.env(); - if (!is_standard(env)) { - // TODO(Leo): remove this if we decide to implement - // arithmetical notation using type classes in the HoTT - // library. - env = open_num_notation(p.env()); - } + // if (!is_standard(env)) { + // // TODO(Leo): remove this if we decide to implement + // // arithmetical notation using type classes in the HoTT + // // library. + // env = open_num_notation(p.env()); + // } env = open_prec_aliases(env); parser::local_scope scope(p, env); expr pre_val = p.parse_expr(get_max_prec());