| author | traytel | 
| Fri, 02 Aug 2013 12:08:55 +0200 | |
| changeset 52839 | 2c0e1a84dcc7 | 
| parent 52435 | 6646bb548c6b | 
| child 54147 | 97a8ff4e4ac9 | 
| permissions | -rw-r--r-- | 
| 35050 
9f841f20dca6
renamed OrderedGroup to Groups; split theory Ring_and_Field into Rings Fields
 haftmann parents: 
35036diff
changeset | 1 | (* Title: HOL/Groups.thy | 
| 29269 
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
 wenzelm parents: 
28823diff
changeset | 2 | Author: Gertrud Bauer, Steven Obua, Lawrence C Paulson, Markus Wenzel, Jeremy Avigad | 
| 14738 | 3 | *) | 
| 4 | ||
| 35050 
9f841f20dca6
renamed OrderedGroup to Groups; split theory Ring_and_Field into Rings Fields
 haftmann parents: 
35036diff
changeset | 5 | header {* Groups, also combined with orderings *}
 | 
| 14738 | 6 | |
| 35050 
9f841f20dca6
renamed OrderedGroup to Groups; split theory Ring_and_Field into Rings Fields
 haftmann parents: 
35036diff
changeset | 7 | theory Groups | 
| 35092 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 8 | imports Orderings | 
| 15131 | 9 | begin | 
| 14738 | 10 | |
| 35301 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 11 | subsection {* Fact collections *}
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 12 | |
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 13 | ML {*
 | 
| 45294 | 14 | structure Ac_Simps = Named_Thms | 
| 15 | ( | |
| 16 |   val name = @{binding ac_simps}
 | |
| 36343 | 17 | val description = "associativity and commutativity simplification rules" | 
| 18 | ) | |
| 19 | *} | |
| 20 | ||
| 21 | setup Ac_Simps.setup | |
| 22 | ||
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 23 | text{* The rewrites accumulated in @{text algebra_simps} deal with the
 | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 24 | classical algebraic structures of groups, rings and family. They simplify | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 25 | terms by multiplying everything out (in case of a ring) and bringing sums and | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 26 | products into a canonical form (by ordered rewriting). As a result it decides | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 27 | group and ring equalities but also helps with inequalities. | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 28 | |
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 29 | Of course it also works for fields, but it knows nothing about multiplicative | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 30 | inverses or division. This is catered for by @{text field_simps}. *}
 | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 31 | |
| 36343 | 32 | ML {*
 | 
| 45294 | 33 | structure Algebra_Simps = Named_Thms | 
| 34 | ( | |
| 35 |   val name = @{binding algebra_simps}
 | |
| 35301 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 36 | val description = "algebra simplification rules" | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 37 | ) | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 38 | *} | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 39 | |
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 40 | setup Algebra_Simps.setup | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 41 | |
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 42 | text{* Lemmas @{text field_simps} multiply with denominators in (in)equations
 | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 43 | if they can be proved to be non-zero (for equations) or positive/negative | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 44 | (for inequations). Can be too aggressive and is therefore separate from the | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 45 | more benign @{text algebra_simps}. *}
 | 
| 35301 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 46 | |
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 47 | ML {*
 | 
| 45294 | 48 | structure Field_Simps = Named_Thms | 
| 49 | ( | |
| 50 |   val name = @{binding field_simps}
 | |
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 51 | val description = "algebra simplification rules for fields" | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 52 | ) | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 53 | *} | 
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 54 | |
| 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 55 | setup Field_Simps.setup | 
| 35301 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 56 | |
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 57 | |
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 58 | subsection {* Abstract structures *}
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 59 | |
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 60 | text {*
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 61 | These locales provide basic structures for interpretation into | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 62 | bigger structures; extensions require careful thinking, otherwise | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 63 | undesired effects may occur due to interpretation. | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 64 | *} | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 65 | |
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 66 | locale semigroup = | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 67 | fixes f :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "*" 70) | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 68 | assumes assoc [ac_simps]: "a * b * c = a * (b * c)" | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 69 | |
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 70 | locale abel_semigroup = semigroup + | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 71 | assumes commute [ac_simps]: "a * b = b * a" | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 72 | begin | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 73 | |
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 74 | lemma left_commute [ac_simps]: | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 75 | "b * (a * c) = a * (b * c)" | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 76 | proof - | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 77 | have "(b * a) * c = (a * b) * c" | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 78 | by (simp only: commute) | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 79 | then show ?thesis | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 80 | by (simp only: assoc) | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 81 | qed | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 82 | |
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 83 | end | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 84 | |
| 35720 | 85 | locale monoid = semigroup + | 
| 35723 
b6cf98f25c3f
tuned monoid locales and prefix of sublocale interpretations
 haftmann parents: 
35720diff
changeset | 86 |   fixes z :: 'a ("1")
 | 
| 
b6cf98f25c3f
tuned monoid locales and prefix of sublocale interpretations
 haftmann parents: 
35720diff
changeset | 87 | assumes left_neutral [simp]: "1 * a = a" | 
| 
b6cf98f25c3f
tuned monoid locales and prefix of sublocale interpretations
 haftmann parents: 
35720diff
changeset | 88 | assumes right_neutral [simp]: "a * 1 = a" | 
| 35720 | 89 | |
| 90 | locale comm_monoid = abel_semigroup + | |
| 35723 
b6cf98f25c3f
tuned monoid locales and prefix of sublocale interpretations
 haftmann parents: 
35720diff
changeset | 91 |   fixes z :: 'a ("1")
 | 
| 
b6cf98f25c3f
tuned monoid locales and prefix of sublocale interpretations
 haftmann parents: 
35720diff
changeset | 92 | assumes comm_neutral: "a * 1 = a" | 
| 35720 | 93 | |
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 94 | sublocale comm_monoid < monoid | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 95 | by default (simp_all add: commute comm_neutral) | 
| 35720 | 96 | |
| 35301 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 97 | |
| 35267 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 98 | subsection {* Generic operations *}
 | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 99 | |
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 100 | class zero = | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 101 |   fixes zero :: 'a  ("0")
 | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 102 | |
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 103 | class one = | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 104 |   fixes one  :: 'a  ("1")
 | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 105 | |
| 36176 
3fe7e97ccca8
replaced generic 'hide' command by more conventional 'hide_class', 'hide_type', 'hide_const', 'hide_fact' -- frees some popular keywords;
 wenzelm parents: 
35828diff
changeset | 106 | hide_const (open) zero one | 
| 35267 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 107 | |
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 108 | lemma Let_0 [simp]: "Let 0 f = f 0" | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 109 | unfolding Let_def .. | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 110 | |
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 111 | lemma Let_1 [simp]: "Let 1 f = f 1" | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 112 | unfolding Let_def .. | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 113 | |
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 114 | setup {*
 | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 115 | Reorient_Proc.add | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 116 |     (fn Const(@{const_name Groups.zero}, _) => true
 | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 117 |       | Const(@{const_name Groups.one}, _) => true
 | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 118 | | _ => false) | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 119 | *} | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 120 | |
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 121 | simproc_setup reorient_zero ("0 = x") = Reorient_Proc.proc
 | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 122 | simproc_setup reorient_one ("1 = x") = Reorient_Proc.proc
 | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 123 | |
| 52143 | 124 | typed_print_translation {*
 | 
| 42247 
12fe41a92cd5
typed_print_translation: discontinued show_sorts argument;
 wenzelm parents: 
42245diff
changeset | 125 | let | 
| 
12fe41a92cd5
typed_print_translation: discontinued show_sorts argument;
 wenzelm parents: 
42245diff
changeset | 126 | fun tr' c = (c, fn ctxt => fn T => fn ts => | 
| 52210 
0226035df99d
more explicit Printer.type_emphasis, depending on show_type_emphasis;
 wenzelm parents: 
52143diff
changeset | 127 | if null ts andalso Printer.type_emphasis ctxt T then | 
| 42248 | 128 |         Syntax.const @{syntax_const "_constrain"} $ Syntax.const c $
 | 
| 52210 
0226035df99d
more explicit Printer.type_emphasis, depending on show_type_emphasis;
 wenzelm parents: 
52143diff
changeset | 129 | Syntax_Phases.term_of_typ ctxt T | 
| 
0226035df99d
more explicit Printer.type_emphasis, depending on show_type_emphasis;
 wenzelm parents: 
52143diff
changeset | 130 | else raise Match); | 
| 42247 
12fe41a92cd5
typed_print_translation: discontinued show_sorts argument;
 wenzelm parents: 
42245diff
changeset | 131 |   in map tr' [@{const_syntax Groups.one}, @{const_syntax Groups.zero}] end;
 | 
| 35267 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 132 | *} -- {* show types that are presumably too general *}
 | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 133 | |
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 134 | class plus = | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 135 | fixes plus :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "+" 65) | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 136 | |
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 137 | class minus = | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 138 | fixes minus :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "-" 65) | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 139 | |
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 140 | class uminus = | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 141 |   fixes uminus :: "'a \<Rightarrow> 'a"  ("- _" [81] 80)
 | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 142 | |
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 143 | class times = | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 144 | fixes times :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "*" 70) | 
| 
8dfd816713c6
moved remaning class operations from Algebras.thy to Groups.thy
 haftmann parents: 
35216diff
changeset | 145 | |
| 35092 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 146 | |
| 23085 | 147 | subsection {* Semigroups and Monoids *}
 | 
| 14738 | 148 | |
| 22390 | 149 | class semigroup_add = plus + | 
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 150 | assumes add_assoc [algebra_simps, field_simps]: "(a + b) + c = a + (b + c)" | 
| 34973 
ae634fad947e
dropped mk_left_commute; use interpretation of locale abel_semigroup instead
 haftmann parents: 
34147diff
changeset | 151 | |
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 152 | sublocale semigroup_add < add!: semigroup plus | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 153 | by default (fact add_assoc) | 
| 22390 | 154 | |
| 155 | class ab_semigroup_add = semigroup_add + | |
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 156 | assumes add_commute [algebra_simps, field_simps]: "a + b = b + a" | 
| 34973 
ae634fad947e
dropped mk_left_commute; use interpretation of locale abel_semigroup instead
 haftmann parents: 
34147diff
changeset | 157 | |
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 158 | sublocale ab_semigroup_add < add!: abel_semigroup plus | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 159 | by default (fact add_commute) | 
| 34973 
ae634fad947e
dropped mk_left_commute; use interpretation of locale abel_semigroup instead
 haftmann parents: 
34147diff
changeset | 160 | |
| 
ae634fad947e
dropped mk_left_commute; use interpretation of locale abel_semigroup instead
 haftmann parents: 
34147diff
changeset | 161 | context ab_semigroup_add | 
| 25062 | 162 | begin | 
| 14738 | 163 | |
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 164 | lemmas add_left_commute [algebra_simps, field_simps] = add.left_commute | 
| 25062 | 165 | |
| 166 | theorems add_ac = add_assoc add_commute add_left_commute | |
| 167 | ||
| 168 | end | |
| 14738 | 169 | |
| 170 | theorems add_ac = add_assoc add_commute add_left_commute | |
| 171 | ||
| 22390 | 172 | class semigroup_mult = times + | 
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 173 | assumes mult_assoc [algebra_simps, field_simps]: "(a * b) * c = a * (b * c)" | 
| 34973 
ae634fad947e
dropped mk_left_commute; use interpretation of locale abel_semigroup instead
 haftmann parents: 
34147diff
changeset | 174 | |
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 175 | sublocale semigroup_mult < mult!: semigroup times | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 176 | by default (fact mult_assoc) | 
| 14738 | 177 | |
| 22390 | 178 | class ab_semigroup_mult = semigroup_mult + | 
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 179 | assumes mult_commute [algebra_simps, field_simps]: "a * b = b * a" | 
| 34973 
ae634fad947e
dropped mk_left_commute; use interpretation of locale abel_semigroup instead
 haftmann parents: 
34147diff
changeset | 180 | |
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 181 | sublocale ab_semigroup_mult < mult!: abel_semigroup times | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 182 | by default (fact mult_commute) | 
| 34973 
ae634fad947e
dropped mk_left_commute; use interpretation of locale abel_semigroup instead
 haftmann parents: 
34147diff
changeset | 183 | |
| 
ae634fad947e
dropped mk_left_commute; use interpretation of locale abel_semigroup instead
 haftmann parents: 
34147diff
changeset | 184 | context ab_semigroup_mult | 
| 23181 | 185 | begin | 
| 14738 | 186 | |
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 187 | lemmas mult_left_commute [algebra_simps, field_simps] = mult.left_commute | 
| 25062 | 188 | |
| 189 | theorems mult_ac = mult_assoc mult_commute mult_left_commute | |
| 23181 | 190 | |
| 191 | end | |
| 14738 | 192 | |
| 193 | theorems mult_ac = mult_assoc mult_commute mult_left_commute | |
| 194 | ||
| 23085 | 195 | class monoid_add = zero + semigroup_add + | 
| 35720 | 196 | assumes add_0_left: "0 + a = a" | 
| 197 | and add_0_right: "a + 0 = a" | |
| 198 | ||
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 199 | sublocale monoid_add < add!: monoid plus 0 | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 200 | by default (fact add_0_left add_0_right)+ | 
| 23085 | 201 | |
| 26071 | 202 | lemma zero_reorient: "0 = x \<longleftrightarrow> x = 0" | 
| 29667 | 203 | by (rule eq_commute) | 
| 26071 | 204 | |
| 22390 | 205 | class comm_monoid_add = zero + ab_semigroup_add + | 
| 25062 | 206 | assumes add_0: "0 + a = a" | 
| 23085 | 207 | |
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 208 | sublocale comm_monoid_add < add!: comm_monoid plus 0 | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 209 | by default (insert add_0, simp add: ac_simps) | 
| 25062 | 210 | |
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 211 | subclass (in comm_monoid_add) monoid_add | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 212 | by default (fact add.left_neutral add.right_neutral)+ | 
| 14738 | 213 | |
| 49388 | 214 | class comm_monoid_diff = comm_monoid_add + minus + | 
| 215 | assumes diff_zero [simp]: "a - 0 = a" | |
| 216 | and zero_diff [simp]: "0 - a = 0" | |
| 217 | and add_diff_cancel_left [simp]: "(c + a) - (c + b) = a - b" | |
| 218 | and diff_diff_add: "a - b - c = a - (b + c)" | |
| 219 | begin | |
| 220 | ||
| 221 | lemma add_diff_cancel_right [simp]: | |
| 222 | "(a + c) - (b + c) = a - b" | |
| 223 | using add_diff_cancel_left [symmetric] by (simp add: add.commute) | |
| 224 | ||
| 225 | lemma add_diff_cancel_left' [simp]: | |
| 226 | "(b + a) - b = a" | |
| 227 | proof - | |
| 228 | have "(b + a) - (b + 0) = a" by (simp only: add_diff_cancel_left diff_zero) | |
| 229 | then show ?thesis by simp | |
| 230 | qed | |
| 231 | ||
| 232 | lemma add_diff_cancel_right' [simp]: | |
| 233 | "(a + b) - b = a" | |
| 234 | using add_diff_cancel_left' [symmetric] by (simp add: add.commute) | |
| 235 | ||
| 236 | lemma diff_add_zero [simp]: | |
| 237 | "a - (a + b) = 0" | |
| 238 | proof - | |
| 239 | have "a - (a + b) = (a + 0) - (a + b)" by simp | |
| 240 | also have "\<dots> = 0" by (simp only: add_diff_cancel_left zero_diff) | |
| 241 | finally show ?thesis . | |
| 242 | qed | |
| 243 | ||
| 244 | lemma diff_cancel [simp]: | |
| 245 | "a - a = 0" | |
| 246 | proof - | |
| 247 | have "(a + 0) - (a + 0) = 0" by (simp only: add_diff_cancel_left diff_zero) | |
| 248 | then show ?thesis by simp | |
| 249 | qed | |
| 250 | ||
| 251 | lemma diff_right_commute: | |
| 252 | "a - c - b = a - b - c" | |
| 253 | by (simp add: diff_diff_add add.commute) | |
| 254 | ||
| 255 | lemma add_implies_diff: | |
| 256 | assumes "c + b = a" | |
| 257 | shows "c = a - b" | |
| 258 | proof - | |
| 259 | from assms have "(b + c) - (b + 0) = a - b" by (simp add: add.commute) | |
| 260 | then show "c = a - b" by simp | |
| 261 | qed | |
| 262 | ||
| 263 | end | |
| 264 | ||
| 22390 | 265 | class monoid_mult = one + semigroup_mult + | 
| 35720 | 266 | assumes mult_1_left: "1 * a = a" | 
| 267 | and mult_1_right: "a * 1 = a" | |
| 268 | ||
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 269 | sublocale monoid_mult < mult!: monoid times 1 | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 270 | by default (fact mult_1_left mult_1_right)+ | 
| 14738 | 271 | |
| 26071 | 272 | lemma one_reorient: "1 = x \<longleftrightarrow> x = 1" | 
| 29667 | 273 | by (rule eq_commute) | 
| 26071 | 274 | |
| 22390 | 275 | class comm_monoid_mult = one + ab_semigroup_mult + | 
| 25062 | 276 | assumes mult_1: "1 * a = a" | 
| 14738 | 277 | |
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 278 | sublocale comm_monoid_mult < mult!: comm_monoid times 1 | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 279 | by default (insert mult_1, simp add: ac_simps) | 
| 25062 | 280 | |
| 51546 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 281 | subclass (in comm_monoid_mult) monoid_mult | 
| 
2e26df807dc7
more uniform style for interpretation and sublocale declarations
 haftmann parents: 
49690diff
changeset | 282 | by default (fact mult.left_neutral mult.right_neutral)+ | 
| 14738 | 283 | |
| 22390 | 284 | class cancel_semigroup_add = semigroup_add + | 
| 25062 | 285 | assumes add_left_imp_eq: "a + b = a + c \<Longrightarrow> b = c" | 
| 286 | assumes add_right_imp_eq: "b + a = c + a \<Longrightarrow> b = c" | |
| 27474 
a89d755b029d
move proofs of add_left_cancel and add_right_cancel into the correct locale
 huffman parents: 
27250diff
changeset | 287 | begin | 
| 
a89d755b029d
move proofs of add_left_cancel and add_right_cancel into the correct locale
 huffman parents: 
27250diff
changeset | 288 | |
| 
a89d755b029d
move proofs of add_left_cancel and add_right_cancel into the correct locale
 huffman parents: 
27250diff
changeset | 289 | lemma add_left_cancel [simp]: | 
| 
a89d755b029d
move proofs of add_left_cancel and add_right_cancel into the correct locale
 huffman parents: 
27250diff
changeset | 290 | "a + b = a + c \<longleftrightarrow> b = c" | 
| 29667 | 291 | by (blast dest: add_left_imp_eq) | 
| 27474 
a89d755b029d
move proofs of add_left_cancel and add_right_cancel into the correct locale
 huffman parents: 
27250diff
changeset | 292 | |
| 
a89d755b029d
move proofs of add_left_cancel and add_right_cancel into the correct locale
 huffman parents: 
27250diff
changeset | 293 | lemma add_right_cancel [simp]: | 
| 
a89d755b029d
move proofs of add_left_cancel and add_right_cancel into the correct locale
 huffman parents: 
27250diff
changeset | 294 | "b + a = c + a \<longleftrightarrow> b = c" | 
| 29667 | 295 | by (blast dest: add_right_imp_eq) | 
| 27474 
a89d755b029d
move proofs of add_left_cancel and add_right_cancel into the correct locale
 huffman parents: 
27250diff
changeset | 296 | |
| 
a89d755b029d
move proofs of add_left_cancel and add_right_cancel into the correct locale
 huffman parents: 
27250diff
changeset | 297 | end | 
| 14738 | 298 | |
| 22390 | 299 | class cancel_ab_semigroup_add = ab_semigroup_add + | 
| 25062 | 300 | assumes add_imp_eq: "a + b = a + c \<Longrightarrow> b = c" | 
| 25267 | 301 | begin | 
| 14738 | 302 | |
| 25267 | 303 | subclass cancel_semigroup_add | 
| 28823 | 304 | proof | 
| 22390 | 305 | fix a b c :: 'a | 
| 306 | assume "a + b = a + c" | |
| 307 | then show "b = c" by (rule add_imp_eq) | |
| 308 | next | |
| 14738 | 309 | fix a b c :: 'a | 
| 310 | assume "b + a = c + a" | |
| 22390 | 311 | then have "a + b = a + c" by (simp only: add_commute) | 
| 312 | then show "b = c" by (rule add_imp_eq) | |
| 14738 | 313 | qed | 
| 314 | ||
| 25267 | 315 | end | 
| 316 | ||
| 29904 | 317 | class cancel_comm_monoid_add = cancel_ab_semigroup_add + comm_monoid_add | 
| 318 | ||
| 319 | ||
| 23085 | 320 | subsection {* Groups *}
 | 
| 321 | ||
| 25762 | 322 | class group_add = minus + uminus + monoid_add + | 
| 25062 | 323 | assumes left_minus [simp]: "- a + a = 0" | 
| 324 | assumes diff_minus: "a - b = a + (- b)" | |
| 325 | begin | |
| 23085 | 326 | |
| 34147 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 327 | lemma minus_unique: | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 328 | assumes "a + b = 0" shows "- a = b" | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 329 | proof - | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 330 | have "- a = - a + (a + b)" using assms by simp | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 331 | also have "\<dots> = b" by (simp add: add_assoc [symmetric]) | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 332 | finally show ?thesis . | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 333 | qed | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 334 | |
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 335 | lemmas equals_zero_I = minus_unique (* legacy name *) | 
| 14738 | 336 | |
| 25062 | 337 | lemma minus_zero [simp]: "- 0 = 0" | 
| 14738 | 338 | proof - | 
| 34147 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 339 | have "0 + 0 = 0" by (rule add_0_right) | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 340 | thus "- 0 = 0" by (rule minus_unique) | 
| 14738 | 341 | qed | 
| 342 | ||
| 25062 | 343 | lemma minus_minus [simp]: "- (- a) = a" | 
| 23085 | 344 | proof - | 
| 34147 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 345 | have "- a + a = 0" by (rule left_minus) | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 346 | thus "- (- a) = a" by (rule minus_unique) | 
| 23085 | 347 | qed | 
| 14738 | 348 | |
| 25062 | 349 | lemma right_minus [simp]: "a + - a = 0" | 
| 14738 | 350 | proof - | 
| 25062 | 351 | have "a + - a = - (- a) + - a" by simp | 
| 352 | also have "\<dots> = 0" by (rule left_minus) | |
| 14738 | 353 | finally show ?thesis . | 
| 354 | qed | |
| 355 | ||
| 40368 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 356 | subclass cancel_semigroup_add | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 357 | proof | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 358 | fix a b c :: 'a | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 359 | assume "a + b = a + c" | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 360 | then have "- a + a + b = - a + a + c" | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 361 | unfolding add_assoc by simp | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 362 | then show "b = c" by simp | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 363 | next | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 364 | fix a b c :: 'a | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 365 | assume "b + a = c + a" | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 366 | then have "b + a + - a = c + a + - a" by simp | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 367 | then show "b = c" unfolding add_assoc by simp | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 368 | qed | 
| 
47c186c8577d
added class relation group_add < cancel_semigroup_add
 haftmann parents: 
39134diff
changeset | 369 | |
| 34147 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 370 | lemma minus_add_cancel: "- a + (a + b) = b" | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 371 | by (simp add: add_assoc [symmetric]) | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 372 | |
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 373 | lemma add_minus_cancel: "a + (- a + b) = b" | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 374 | by (simp add: add_assoc [symmetric]) | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 375 | |
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 376 | lemma minus_add: "- (a + b) = - b + - a" | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 377 | proof - | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 378 | have "(a + b) + (- b + - a) = 0" | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 379 | by (simp add: add_assoc add_minus_cancel) | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 380 | thus "- (a + b) = - b + - a" | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 381 | by (rule minus_unique) | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 382 | qed | 
| 
319616f4eecf
generalize lemma add_minus_cancel, add lemma minus_add, simplify some proofs
 huffman parents: 
34146diff
changeset | 383 | |
| 25062 | 384 | lemma right_minus_eq: "a - b = 0 \<longleftrightarrow> a = b" | 
| 14738 | 385 | proof | 
| 23085 | 386 | assume "a - b = 0" | 
| 387 | have "a = (a - b) + b" by (simp add:diff_minus add_assoc) | |
| 388 | also have "\<dots> = b" using `a - b = 0` by simp | |
| 389 | finally show "a = b" . | |
| 14738 | 390 | next | 
| 23085 | 391 | assume "a = b" thus "a - b = 0" by (simp add: diff_minus) | 
| 14738 | 392 | qed | 
| 393 | ||
| 25062 | 394 | lemma diff_self [simp]: "a - a = 0" | 
| 29667 | 395 | by (simp add: diff_minus) | 
| 14738 | 396 | |
| 25062 | 397 | lemma diff_0 [simp]: "0 - a = - a" | 
| 29667 | 398 | by (simp add: diff_minus) | 
| 14738 | 399 | |
| 25062 | 400 | lemma diff_0_right [simp]: "a - 0 = a" | 
| 29667 | 401 | by (simp add: diff_minus) | 
| 14738 | 402 | |
| 25062 | 403 | lemma diff_minus_eq_add [simp]: "a - - b = a + b" | 
| 29667 | 404 | by (simp add: diff_minus) | 
| 14738 | 405 | |
| 25062 | 406 | lemma neg_equal_iff_equal [simp]: | 
| 407 | "- a = - b \<longleftrightarrow> a = b" | |
| 14738 | 408 | proof | 
| 409 | assume "- a = - b" | |
| 29667 | 410 | hence "- (- a) = - (- b)" by simp | 
| 25062 | 411 | thus "a = b" by simp | 
| 14738 | 412 | next | 
| 25062 | 413 | assume "a = b" | 
| 414 | thus "- a = - b" by simp | |
| 14738 | 415 | qed | 
| 416 | ||
| 25062 | 417 | lemma neg_equal_0_iff_equal [simp]: | 
| 418 | "- a = 0 \<longleftrightarrow> a = 0" | |
| 29667 | 419 | by (subst neg_equal_iff_equal [symmetric], simp) | 
| 14738 | 420 | |
| 25062 | 421 | lemma neg_0_equal_iff_equal [simp]: | 
| 422 | "0 = - a \<longleftrightarrow> 0 = a" | |
| 29667 | 423 | by (subst neg_equal_iff_equal [symmetric], simp) | 
| 14738 | 424 | |
| 425 | text{*The next two equations can make the simplifier loop!*}
 | |
| 426 | ||
| 25062 | 427 | lemma equation_minus_iff: | 
| 428 | "a = - b \<longleftrightarrow> b = - a" | |
| 14738 | 429 | proof - | 
| 25062 | 430 | have "- (- a) = - b \<longleftrightarrow> - a = b" by (rule neg_equal_iff_equal) | 
| 431 | thus ?thesis by (simp add: eq_commute) | |
| 432 | qed | |
| 433 | ||
| 434 | lemma minus_equation_iff: | |
| 435 | "- a = b \<longleftrightarrow> - b = a" | |
| 436 | proof - | |
| 437 | have "- a = - (- b) \<longleftrightarrow> a = -b" by (rule neg_equal_iff_equal) | |
| 14738 | 438 | thus ?thesis by (simp add: eq_commute) | 
| 439 | qed | |
| 440 | ||
| 28130 
32b4185bfdc7
move diff_add_cancel, add_diff_cancel from class ab_group_add to group_add
 huffman parents: 
27516diff
changeset | 441 | lemma diff_add_cancel: "a - b + b = a" | 
| 29667 | 442 | by (simp add: diff_minus add_assoc) | 
| 28130 
32b4185bfdc7
move diff_add_cancel, add_diff_cancel from class ab_group_add to group_add
 huffman parents: 
27516diff
changeset | 443 | |
| 
32b4185bfdc7
move diff_add_cancel, add_diff_cancel from class ab_group_add to group_add
 huffman parents: 
27516diff
changeset | 444 | lemma add_diff_cancel: "a + b - b = a" | 
| 29667 | 445 | by (simp add: diff_minus add_assoc) | 
| 446 | ||
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 447 | declare diff_minus[symmetric, algebra_simps, field_simps] | 
| 28130 
32b4185bfdc7
move diff_add_cancel, add_diff_cancel from class ab_group_add to group_add
 huffman parents: 
27516diff
changeset | 448 | |
| 29914 
c9ced4f54e82
generalize lemma eq_neg_iff_add_eq_0, and move to OrderedGroup
 huffman parents: 
29904diff
changeset | 449 | lemma eq_neg_iff_add_eq_0: "a = - b \<longleftrightarrow> a + b = 0" | 
| 
c9ced4f54e82
generalize lemma eq_neg_iff_add_eq_0, and move to OrderedGroup
 huffman parents: 
29904diff
changeset | 450 | proof | 
| 
c9ced4f54e82
generalize lemma eq_neg_iff_add_eq_0, and move to OrderedGroup
 huffman parents: 
29904diff
changeset | 451 | assume "a = - b" then show "a + b = 0" by simp | 
| 
c9ced4f54e82
generalize lemma eq_neg_iff_add_eq_0, and move to OrderedGroup
 huffman parents: 
29904diff
changeset | 452 | next | 
| 
c9ced4f54e82
generalize lemma eq_neg_iff_add_eq_0, and move to OrderedGroup
 huffman parents: 
29904diff
changeset | 453 | assume "a + b = 0" | 
| 
c9ced4f54e82
generalize lemma eq_neg_iff_add_eq_0, and move to OrderedGroup
 huffman parents: 
29904diff
changeset | 454 | moreover have "a + (b + - b) = (a + b) + - b" | 
| 
c9ced4f54e82
generalize lemma eq_neg_iff_add_eq_0, and move to OrderedGroup
 huffman parents: 
29904diff
changeset | 455 | by (simp only: add_assoc) | 
| 
c9ced4f54e82
generalize lemma eq_neg_iff_add_eq_0, and move to OrderedGroup
 huffman parents: 
29904diff
changeset | 456 | ultimately show "a = - b" by simp | 
| 
c9ced4f54e82
generalize lemma eq_neg_iff_add_eq_0, and move to OrderedGroup
 huffman parents: 
29904diff
changeset | 457 | qed | 
| 
c9ced4f54e82
generalize lemma eq_neg_iff_add_eq_0, and move to OrderedGroup
 huffman parents: 
29904diff
changeset | 458 | |
| 44348 | 459 | lemma add_eq_0_iff: "x + y = 0 \<longleftrightarrow> y = - x" | 
| 460 | unfolding eq_neg_iff_add_eq_0 [symmetric] | |
| 461 | by (rule equation_minus_iff) | |
| 462 | ||
| 45548 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 463 | lemma minus_diff_eq [simp]: "- (a - b) = b - a" | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 464 | by (simp add: diff_minus minus_add) | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 465 | |
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 466 | lemma add_diff_eq[algebra_simps, field_simps]: "a + (b - c) = (a + b) - c" | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 467 | by (simp add: diff_minus add_assoc) | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 468 | |
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 469 | lemma diff_eq_eq[algebra_simps, field_simps]: "a - b = c \<longleftrightarrow> a = c + b" | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 470 | by (auto simp add: diff_minus add_assoc) | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 471 | |
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 472 | lemma eq_diff_eq[algebra_simps, field_simps]: "a = c - b \<longleftrightarrow> a + b = c" | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 473 | by (auto simp add: diff_minus add_assoc) | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 474 | |
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 475 | lemma diff_diff_eq2[algebra_simps, field_simps]: "a - (b - c) = (a + c) - b" | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 476 | by (simp add: diff_minus minus_add add_assoc) | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 477 | |
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 478 | lemma eq_iff_diff_eq_0: "a = b \<longleftrightarrow> a - b = 0" | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 479 | by (fact right_minus_eq [symmetric]) | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 480 | |
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 481 | lemma diff_eq_diff_eq: | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 482 | "a - b = c - d \<Longrightarrow> a = b \<longleftrightarrow> c = d" | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 483 | by (simp add: eq_iff_diff_eq_0 [of a b] eq_iff_diff_eq_0 [of c d]) | 
| 
3e2722d66169
Groups.thy: generalize several lemmas from class ab_group_add to class group_add
 huffman parents: 
45294diff
changeset | 484 | |
| 25062 | 485 | end | 
| 486 | ||
| 25762 | 487 | class ab_group_add = minus + uminus + comm_monoid_add + | 
| 25062 | 488 | assumes ab_left_minus: "- a + a = 0" | 
| 489 | assumes ab_diff_minus: "a - b = a + (- b)" | |
| 25267 | 490 | begin | 
| 25062 | 491 | |
| 25267 | 492 | subclass group_add | 
| 28823 | 493 | proof qed (simp_all add: ab_left_minus ab_diff_minus) | 
| 25062 | 494 | |
| 29904 | 495 | subclass cancel_comm_monoid_add | 
| 28823 | 496 | proof | 
| 25062 | 497 | fix a b c :: 'a | 
| 498 | assume "a + b = a + c" | |
| 499 | then have "- a + a + b = - a + a + c" | |
| 500 | unfolding add_assoc by simp | |
| 501 | then show "b = c" by simp | |
| 502 | qed | |
| 503 | ||
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 504 | lemma uminus_add_conv_diff[algebra_simps, field_simps]: | 
| 25062 | 505 | "- a + b = b - a" | 
| 29667 | 506 | by (simp add:diff_minus add_commute) | 
| 25062 | 507 | |
| 508 | lemma minus_add_distrib [simp]: | |
| 509 | "- (a + b) = - a + - b" | |
| 34146 
14595e0c27e8
rename equals_zero_I to minus_unique (keep old name too)
 huffman parents: 
33364diff
changeset | 510 | by (rule minus_unique) (simp add: add_ac) | 
| 25062 | 511 | |
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 512 | lemma diff_add_eq[algebra_simps, field_simps]: "(a - b) + c = (a + c) - b" | 
| 29667 | 513 | by (simp add: diff_minus add_ac) | 
| 25077 | 514 | |
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 515 | lemma diff_diff_eq[algebra_simps, field_simps]: "(a - b) - c = a - (b + c)" | 
| 29667 | 516 | by (simp add: diff_minus add_ac) | 
| 25077 | 517 | |
| 35216 | 518 | (* FIXME: duplicates right_minus_eq from class group_add *) | 
| 519 | (* but only this one is declared as a simp rule. *) | |
| 35828 
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
 blanchet parents: 
35723diff
changeset | 520 | lemma diff_eq_0_iff_eq [simp, no_atp]: "a - b = 0 \<longleftrightarrow> a = b" | 
| 44348 | 521 | by (rule right_minus_eq) | 
| 30629 | 522 | |
| 48556 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 523 | lemma add_diff_cancel_left: "(c + a) - (c + b) = a - b" | 
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 524 | by (simp add: diff_minus add_ac) | 
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 525 | |
| 25062 | 526 | end | 
| 14738 | 527 | |
| 37884 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 528 | |
| 14738 | 529 | subsection {* (Partially) Ordered Groups *} 
 | 
| 530 | ||
| 35301 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 531 | text {*
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 532 | The theory of partially ordered groups is taken from the books: | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 533 |   \begin{itemize}
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 534 |   \item \emph{Lattice Theory} by Garret Birkhoff, American Mathematical Society 1979 
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 535 |   \item \emph{Partially Ordered Algebraic Systems}, Pergamon Press 1963
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 536 |   \end{itemize}
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 537 | Most of the used notions can also be looked up in | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 538 |   \begin{itemize}
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 539 |   \item \url{http://www.mathworld.com} by Eric Weisstein et. al.
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 540 |   \item \emph{Algebra I} by van der Waerden, Springer.
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 541 |   \end{itemize}
 | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 542 | *} | 
| 
90e42f9ba4d1
distributed theory Algebras to theories Groups and Lattices
 haftmann parents: 
35267diff
changeset | 543 | |
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 544 | class ordered_ab_semigroup_add = order + ab_semigroup_add + | 
| 25062 | 545 | assumes add_left_mono: "a \<le> b \<Longrightarrow> c + a \<le> c + b" | 
| 546 | begin | |
| 24380 
c215e256beca
moved ordered_ab_semigroup_add to OrderedGroup.thy
 haftmann parents: 
24286diff
changeset | 547 | |
| 25062 | 548 | lemma add_right_mono: | 
| 549 | "a \<le> b \<Longrightarrow> a + c \<le> b + c" | |
| 29667 | 550 | by (simp add: add_commute [of _ c] add_left_mono) | 
| 14738 | 551 | |
| 552 | text {* non-strict, in both arguments *}
 | |
| 553 | lemma add_mono: | |
| 25062 | 554 | "a \<le> b \<Longrightarrow> c \<le> d \<Longrightarrow> a + c \<le> b + d" | 
| 14738 | 555 | apply (erule add_right_mono [THEN order_trans]) | 
| 556 | apply (simp add: add_commute add_left_mono) | |
| 557 | done | |
| 558 | ||
| 25062 | 559 | end | 
| 560 | ||
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 561 | class ordered_cancel_ab_semigroup_add = | 
| 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 562 | ordered_ab_semigroup_add + cancel_ab_semigroup_add | 
| 25062 | 563 | begin | 
| 564 | ||
| 14738 | 565 | lemma add_strict_left_mono: | 
| 25062 | 566 | "a < b \<Longrightarrow> c + a < c + b" | 
| 29667 | 567 | by (auto simp add: less_le add_left_mono) | 
| 14738 | 568 | |
| 569 | lemma add_strict_right_mono: | |
| 25062 | 570 | "a < b \<Longrightarrow> a + c < b + c" | 
| 29667 | 571 | by (simp add: add_commute [of _ c] add_strict_left_mono) | 
| 14738 | 572 | |
| 573 | text{*Strict monotonicity in both arguments*}
 | |
| 25062 | 574 | lemma add_strict_mono: | 
| 575 | "a < b \<Longrightarrow> c < d \<Longrightarrow> a + c < b + d" | |
| 576 | apply (erule add_strict_right_mono [THEN less_trans]) | |
| 14738 | 577 | apply (erule add_strict_left_mono) | 
| 578 | done | |
| 579 | ||
| 580 | lemma add_less_le_mono: | |
| 25062 | 581 | "a < b \<Longrightarrow> c \<le> d \<Longrightarrow> a + c < b + d" | 
| 582 | apply (erule add_strict_right_mono [THEN less_le_trans]) | |
| 583 | apply (erule add_left_mono) | |
| 14738 | 584 | done | 
| 585 | ||
| 586 | lemma add_le_less_mono: | |
| 25062 | 587 | "a \<le> b \<Longrightarrow> c < d \<Longrightarrow> a + c < b + d" | 
| 588 | apply (erule add_right_mono [THEN le_less_trans]) | |
| 14738 | 589 | apply (erule add_strict_left_mono) | 
| 590 | done | |
| 591 | ||
| 25062 | 592 | end | 
| 593 | ||
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 594 | class ordered_ab_semigroup_add_imp_le = | 
| 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 595 | ordered_cancel_ab_semigroup_add + | 
| 25062 | 596 | assumes add_le_imp_le_left: "c + a \<le> c + b \<Longrightarrow> a \<le> b" | 
| 597 | begin | |
| 598 | ||
| 14738 | 599 | lemma add_less_imp_less_left: | 
| 29667 | 600 | assumes less: "c + a < c + b" shows "a < b" | 
| 14738 | 601 | proof - | 
| 602 | from less have le: "c + a <= c + b" by (simp add: order_le_less) | |
| 603 | have "a <= b" | |
| 604 | apply (insert le) | |
| 605 | apply (drule add_le_imp_le_left) | |
| 606 | by (insert le, drule add_le_imp_le_left, assumption) | |
| 607 | moreover have "a \<noteq> b" | |
| 608 | proof (rule ccontr) | |
| 609 | assume "~(a \<noteq> b)" | |
| 610 | then have "a = b" by simp | |
| 611 | then have "c + a = c + b" by simp | |
| 612 | with less show "False"by simp | |
| 613 | qed | |
| 614 | ultimately show "a < b" by (simp add: order_le_less) | |
| 615 | qed | |
| 616 | ||
| 617 | lemma add_less_imp_less_right: | |
| 25062 | 618 | "a + c < b + c \<Longrightarrow> a < b" | 
| 14738 | 619 | apply (rule add_less_imp_less_left [of c]) | 
| 620 | apply (simp add: add_commute) | |
| 621 | done | |
| 622 | ||
| 623 | lemma add_less_cancel_left [simp]: | |
| 25062 | 624 | "c + a < c + b \<longleftrightarrow> a < b" | 
| 29667 | 625 | by (blast intro: add_less_imp_less_left add_strict_left_mono) | 
| 14738 | 626 | |
| 627 | lemma add_less_cancel_right [simp]: | |
| 25062 | 628 | "a + c < b + c \<longleftrightarrow> a < b" | 
| 29667 | 629 | by (blast intro: add_less_imp_less_right add_strict_right_mono) | 
| 14738 | 630 | |
| 631 | lemma add_le_cancel_left [simp]: | |
| 25062 | 632 | "c + a \<le> c + b \<longleftrightarrow> a \<le> b" | 
| 29667 | 633 | by (auto, drule add_le_imp_le_left, simp_all add: add_left_mono) | 
| 14738 | 634 | |
| 635 | lemma add_le_cancel_right [simp]: | |
| 25062 | 636 | "a + c \<le> b + c \<longleftrightarrow> a \<le> b" | 
| 29667 | 637 | by (simp add: add_commute [of a c] add_commute [of b c]) | 
| 14738 | 638 | |
| 639 | lemma add_le_imp_le_right: | |
| 25062 | 640 | "a + c \<le> b + c \<Longrightarrow> a \<le> b" | 
| 29667 | 641 | by simp | 
| 25062 | 642 | |
| 25077 | 643 | lemma max_add_distrib_left: | 
| 644 | "max x y + z = max (x + z) (y + z)" | |
| 645 | unfolding max_def by auto | |
| 646 | ||
| 647 | lemma min_add_distrib_left: | |
| 648 | "min x y + z = min (x + z) (y + z)" | |
| 649 | unfolding min_def by auto | |
| 650 | ||
| 44848 
f4d0b060c7ca
remove lemmas nat_add_min_{left,right} in favor of generic lemmas min_add_distrib_{left,right}
 huffman parents: 
44433diff
changeset | 651 | lemma max_add_distrib_right: | 
| 
f4d0b060c7ca
remove lemmas nat_add_min_{left,right} in favor of generic lemmas min_add_distrib_{left,right}
 huffman parents: 
44433diff
changeset | 652 | "x + max y z = max (x + y) (x + z)" | 
| 
f4d0b060c7ca
remove lemmas nat_add_min_{left,right} in favor of generic lemmas min_add_distrib_{left,right}
 huffman parents: 
44433diff
changeset | 653 | unfolding max_def by auto | 
| 
f4d0b060c7ca
remove lemmas nat_add_min_{left,right} in favor of generic lemmas min_add_distrib_{left,right}
 huffman parents: 
44433diff
changeset | 654 | |
| 
f4d0b060c7ca
remove lemmas nat_add_min_{left,right} in favor of generic lemmas min_add_distrib_{left,right}
 huffman parents: 
44433diff
changeset | 655 | lemma min_add_distrib_right: | 
| 
f4d0b060c7ca
remove lemmas nat_add_min_{left,right} in favor of generic lemmas min_add_distrib_{left,right}
 huffman parents: 
44433diff
changeset | 656 | "x + min y z = min (x + y) (x + z)" | 
| 
f4d0b060c7ca
remove lemmas nat_add_min_{left,right} in favor of generic lemmas min_add_distrib_{left,right}
 huffman parents: 
44433diff
changeset | 657 | unfolding min_def by auto | 
| 
f4d0b060c7ca
remove lemmas nat_add_min_{left,right} in favor of generic lemmas min_add_distrib_{left,right}
 huffman parents: 
44433diff
changeset | 658 | |
| 25062 | 659 | end | 
| 660 | ||
| 52289 | 661 | class ordered_cancel_comm_monoid_diff = comm_monoid_diff + ordered_ab_semigroup_add_imp_le + | 
| 662 | assumes le_iff_add: "a \<le> b \<longleftrightarrow> (\<exists>c. b = a + c)" | |
| 663 | begin | |
| 664 | ||
| 665 | context | |
| 666 | fixes a b | |
| 667 | assumes "a \<le> b" | |
| 668 | begin | |
| 669 | ||
| 670 | lemma add_diff_inverse: | |
| 671 | "a + (b - a) = b" | |
| 672 | using `a \<le> b` by (auto simp add: le_iff_add) | |
| 673 | ||
| 674 | lemma add_diff_assoc: | |
| 675 | "c + (b - a) = c + b - a" | |
| 676 | using `a \<le> b` by (auto simp add: le_iff_add add_left_commute [of c]) | |
| 677 | ||
| 678 | lemma add_diff_assoc2: | |
| 679 | "b - a + c = b + c - a" | |
| 680 | using `a \<le> b` by (auto simp add: le_iff_add add_assoc) | |
| 681 | ||
| 682 | lemma diff_add_assoc: | |
| 683 | "c + b - a = c + (b - a)" | |
| 684 | using `a \<le> b` by (simp add: add_commute add_diff_assoc) | |
| 685 | ||
| 686 | lemma diff_add_assoc2: | |
| 687 | "b + c - a = b - a + c" | |
| 688 | using `a \<le> b`by (simp add: add_commute add_diff_assoc) | |
| 689 | ||
| 690 | lemma diff_diff_right: | |
| 691 | "c - (b - a) = c + a - b" | |
| 692 | by (simp add: add_diff_inverse add_diff_cancel_left [of a c "b - a", symmetric] add_commute) | |
| 693 | ||
| 694 | lemma diff_add: | |
| 695 | "b - a + a = b" | |
| 696 | by (simp add: add_commute add_diff_inverse) | |
| 697 | ||
| 698 | lemma le_add_diff: | |
| 699 | "c \<le> b + c - a" | |
| 700 | by (auto simp add: add_commute diff_add_assoc2 le_iff_add) | |
| 701 | ||
| 702 | lemma le_imp_diff_is_add: | |
| 703 | "a \<le> b \<Longrightarrow> b - a = c \<longleftrightarrow> b = c + a" | |
| 704 | by (auto simp add: add_commute add_diff_inverse) | |
| 705 | ||
| 706 | lemma le_diff_conv2: | |
| 707 | "c \<le> b - a \<longleftrightarrow> c + a \<le> b" (is "?P \<longleftrightarrow> ?Q") | |
| 708 | proof | |
| 709 | assume ?P | |
| 710 | then have "c + a \<le> b - a + a" by (rule add_right_mono) | |
| 711 | then show ?Q by (simp add: add_diff_inverse add_commute) | |
| 712 | next | |
| 713 | assume ?Q | |
| 714 | then have "a + c \<le> a + (b - a)" by (simp add: add_diff_inverse add_commute) | |
| 715 | then show ?P by simp | |
| 716 | qed | |
| 717 | ||
| 718 | end | |
| 719 | ||
| 720 | end | |
| 721 | ||
| 722 | ||
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 723 | subsection {* Support for reasoning about signs *}
 | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 724 | |
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 725 | class ordered_comm_monoid_add = | 
| 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 726 | ordered_cancel_ab_semigroup_add + comm_monoid_add | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 727 | begin | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 728 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 729 | lemma add_pos_nonneg: | 
| 29667 | 730 | assumes "0 < a" and "0 \<le> b" shows "0 < a + b" | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 731 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 732 | have "0 + 0 < a + b" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 733 | using assms by (rule add_less_le_mono) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 734 | then show ?thesis by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 735 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 736 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 737 | lemma add_pos_pos: | 
| 29667 | 738 | assumes "0 < a" and "0 < b" shows "0 < a + b" | 
| 739 | by (rule add_pos_nonneg) (insert assms, auto) | |
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 740 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 741 | lemma add_nonneg_pos: | 
| 29667 | 742 | assumes "0 \<le> a" and "0 < b" shows "0 < a + b" | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 743 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 744 | have "0 + 0 < a + b" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 745 | using assms by (rule add_le_less_mono) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 746 | then show ?thesis by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 747 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 748 | |
| 36977 
71c8973a604b
declare add_nonneg_nonneg [simp]; remove now-redundant lemmas realpow_two_le_order(2)
 huffman parents: 
36348diff
changeset | 749 | lemma add_nonneg_nonneg [simp]: | 
| 29667 | 750 | assumes "0 \<le> a" and "0 \<le> b" shows "0 \<le> a + b" | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 751 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 752 | have "0 + 0 \<le> a + b" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 753 | using assms by (rule add_mono) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 754 | then show ?thesis by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 755 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 756 | |
| 30691 | 757 | lemma add_neg_nonpos: | 
| 29667 | 758 | assumes "a < 0" and "b \<le> 0" shows "a + b < 0" | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 759 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 760 | have "a + b < 0 + 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 761 | using assms by (rule add_less_le_mono) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 762 | then show ?thesis by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 763 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 764 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 765 | lemma add_neg_neg: | 
| 29667 | 766 | assumes "a < 0" and "b < 0" shows "a + b < 0" | 
| 767 | by (rule add_neg_nonpos) (insert assms, auto) | |
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 768 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 769 | lemma add_nonpos_neg: | 
| 29667 | 770 | assumes "a \<le> 0" and "b < 0" shows "a + b < 0" | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 771 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 772 | have "a + b < 0 + 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 773 | using assms by (rule add_le_less_mono) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 774 | then show ?thesis by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 775 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 776 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 777 | lemma add_nonpos_nonpos: | 
| 29667 | 778 | assumes "a \<le> 0" and "b \<le> 0" shows "a + b \<le> 0" | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 779 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 780 | have "a + b \<le> 0 + 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 781 | using assms by (rule add_mono) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 782 | then show ?thesis by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 783 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 784 | |
| 30691 | 785 | lemmas add_sign_intros = | 
| 786 | add_pos_nonneg add_pos_pos add_nonneg_pos add_nonneg_nonneg | |
| 787 | add_neg_nonpos add_neg_neg add_nonpos_neg add_nonpos_nonpos | |
| 788 | ||
| 29886 | 789 | lemma add_nonneg_eq_0_iff: | 
| 790 | assumes x: "0 \<le> x" and y: "0 \<le> y" | |
| 791 | shows "x + y = 0 \<longleftrightarrow> x = 0 \<and> y = 0" | |
| 792 | proof (intro iffI conjI) | |
| 793 | have "x = x + 0" by simp | |
| 794 | also have "x + 0 \<le> x + y" using y by (rule add_left_mono) | |
| 795 | also assume "x + y = 0" | |
| 796 | also have "0 \<le> x" using x . | |
| 797 | finally show "x = 0" . | |
| 798 | next | |
| 799 | have "y = 0 + y" by simp | |
| 800 | also have "0 + y \<le> x + y" using x by (rule add_right_mono) | |
| 801 | also assume "x + y = 0" | |
| 802 | also have "0 \<le> y" using y . | |
| 803 | finally show "y = 0" . | |
| 804 | next | |
| 805 | assume "x = 0 \<and> y = 0" | |
| 806 | then show "x + y = 0" by simp | |
| 807 | qed | |
| 808 | ||
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 809 | end | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 810 | |
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 811 | class ordered_ab_group_add = | 
| 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 812 | ab_group_add + ordered_ab_semigroup_add | 
| 25062 | 813 | begin | 
| 814 | ||
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 815 | subclass ordered_cancel_ab_semigroup_add .. | 
| 25062 | 816 | |
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 817 | subclass ordered_ab_semigroup_add_imp_le | 
| 28823 | 818 | proof | 
| 25062 | 819 | fix a b c :: 'a | 
| 820 | assume "c + a \<le> c + b" | |
| 821 | hence "(-c) + (c + a) \<le> (-c) + (c + b)" by (rule add_left_mono) | |
| 822 | hence "((-c) + c) + a \<le> ((-c) + c) + b" by (simp only: add_assoc) | |
| 823 | thus "a \<le> b" by simp | |
| 824 | qed | |
| 825 | ||
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 826 | subclass ordered_comm_monoid_add .. | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 827 | |
| 25077 | 828 | lemma max_diff_distrib_left: | 
| 829 | shows "max x y - z = max (x - z) (y - z)" | |
| 29667 | 830 | by (simp add: diff_minus, rule max_add_distrib_left) | 
| 25077 | 831 | |
| 832 | lemma min_diff_distrib_left: | |
| 833 | shows "min x y - z = min (x - z) (y - z)" | |
| 29667 | 834 | by (simp add: diff_minus, rule min_add_distrib_left) | 
| 25077 | 835 | |
| 836 | lemma le_imp_neg_le: | |
| 29667 | 837 | assumes "a \<le> b" shows "-b \<le> -a" | 
| 25077 | 838 | proof - | 
| 29667 | 839 | have "-a+a \<le> -a+b" using `a \<le> b` by (rule add_left_mono) | 
| 840 | hence "0 \<le> -a+b" by simp | |
| 841 | hence "0 + (-b) \<le> (-a + b) + (-b)" by (rule add_right_mono) | |
| 842 | thus ?thesis by (simp add: add_assoc) | |
| 25077 | 843 | qed | 
| 844 | ||
| 845 | lemma neg_le_iff_le [simp]: "- b \<le> - a \<longleftrightarrow> a \<le> b" | |
| 846 | proof | |
| 847 | assume "- b \<le> - a" | |
| 29667 | 848 | hence "- (- a) \<le> - (- b)" by (rule le_imp_neg_le) | 
| 25077 | 849 | thus "a\<le>b" by simp | 
| 850 | next | |
| 851 | assume "a\<le>b" | |
| 852 | thus "-b \<le> -a" by (rule le_imp_neg_le) | |
| 853 | qed | |
| 854 | ||
| 855 | lemma neg_le_0_iff_le [simp]: "- a \<le> 0 \<longleftrightarrow> 0 \<le> a" | |
| 29667 | 856 | by (subst neg_le_iff_le [symmetric], simp) | 
| 25077 | 857 | |
| 858 | lemma neg_0_le_iff_le [simp]: "0 \<le> - a \<longleftrightarrow> a \<le> 0" | |
| 29667 | 859 | by (subst neg_le_iff_le [symmetric], simp) | 
| 25077 | 860 | |
| 861 | lemma neg_less_iff_less [simp]: "- b < - a \<longleftrightarrow> a < b" | |
| 29667 | 862 | by (force simp add: less_le) | 
| 25077 | 863 | |
| 864 | lemma neg_less_0_iff_less [simp]: "- a < 0 \<longleftrightarrow> 0 < a" | |
| 29667 | 865 | by (subst neg_less_iff_less [symmetric], simp) | 
| 25077 | 866 | |
| 867 | lemma neg_0_less_iff_less [simp]: "0 < - a \<longleftrightarrow> a < 0" | |
| 29667 | 868 | by (subst neg_less_iff_less [symmetric], simp) | 
| 25077 | 869 | |
| 870 | text{*The next several equations can make the simplifier loop!*}
 | |
| 871 | ||
| 872 | lemma less_minus_iff: "a < - b \<longleftrightarrow> b < - a" | |
| 873 | proof - | |
| 874 | have "(- (-a) < - b) = (b < - a)" by (rule neg_less_iff_less) | |
| 875 | thus ?thesis by simp | |
| 876 | qed | |
| 877 | ||
| 878 | lemma minus_less_iff: "- a < b \<longleftrightarrow> - b < a" | |
| 879 | proof - | |
| 880 | have "(- a < - (-b)) = (- b < a)" by (rule neg_less_iff_less) | |
| 881 | thus ?thesis by simp | |
| 882 | qed | |
| 883 | ||
| 884 | lemma le_minus_iff: "a \<le> - b \<longleftrightarrow> b \<le> - a" | |
| 885 | proof - | |
| 886 | have mm: "!! a (b::'a). (-(-a)) < -b \<Longrightarrow> -(-b) < -a" by (simp only: minus_less_iff) | |
| 887 | have "(- (- a) <= -b) = (b <= - a)" | |
| 888 | apply (auto simp only: le_less) | |
| 889 | apply (drule mm) | |
| 890 | apply (simp_all) | |
| 891 | apply (drule mm[simplified], assumption) | |
| 892 | done | |
| 893 | then show ?thesis by simp | |
| 894 | qed | |
| 895 | ||
| 896 | lemma minus_le_iff: "- a \<le> b \<longleftrightarrow> - b \<le> a" | |
| 29667 | 897 | by (auto simp add: le_less minus_less_iff) | 
| 25077 | 898 | |
| 37884 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 899 | lemma diff_less_0_iff_less [simp, no_atp]: | 
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 900 | "a - b < 0 \<longleftrightarrow> a < b" | 
| 25077 | 901 | proof - | 
| 37884 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 902 | have "a - b < 0 \<longleftrightarrow> a + (- b) < b + (- b)" by (simp add: diff_minus) | 
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 903 | also have "... \<longleftrightarrow> a < b" by (simp only: add_less_cancel_right) | 
| 25077 | 904 | finally show ?thesis . | 
| 905 | qed | |
| 906 | ||
| 37884 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 907 | lemmas less_iff_diff_less_0 = diff_less_0_iff_less [symmetric] | 
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 908 | |
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 909 | lemma diff_less_eq[algebra_simps, field_simps]: "a - b < c \<longleftrightarrow> a < c + b" | 
| 25077 | 910 | apply (subst less_iff_diff_less_0 [of a]) | 
| 911 | apply (rule less_iff_diff_less_0 [of _ c, THEN ssubst]) | |
| 912 | apply (simp add: diff_minus add_ac) | |
| 913 | done | |
| 914 | ||
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 915 | lemma less_diff_eq[algebra_simps, field_simps]: "a < c - b \<longleftrightarrow> a + b < c" | 
| 36302 | 916 | apply (subst less_iff_diff_less_0 [of "a + b"]) | 
| 25077 | 917 | apply (subst less_iff_diff_less_0 [of a]) | 
| 918 | apply (simp add: diff_minus add_ac) | |
| 919 | done | |
| 920 | ||
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 921 | lemma diff_le_eq[algebra_simps, field_simps]: "a - b \<le> c \<longleftrightarrow> a \<le> c + b" | 
| 29667 | 922 | by (auto simp add: le_less diff_less_eq diff_add_cancel add_diff_cancel) | 
| 25077 | 923 | |
| 36348 
89c54f51f55a
dropped group_simps, ring_simps, field_eq_simps; classes division_ring_inverse_zero, field_inverse_zero, linordered_field_inverse_zero
 haftmann parents: 
36343diff
changeset | 924 | lemma le_diff_eq[algebra_simps, field_simps]: "a \<le> c - b \<longleftrightarrow> a + b \<le> c" | 
| 29667 | 925 | by (auto simp add: le_less less_diff_eq diff_add_cancel add_diff_cancel) | 
| 25077 | 926 | |
| 37884 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 927 | lemma diff_le_0_iff_le [simp, no_atp]: | 
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 928 | "a - b \<le> 0 \<longleftrightarrow> a \<le> b" | 
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 929 | by (simp add: algebra_simps) | 
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 930 | |
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 931 | lemmas le_iff_diff_le_0 = diff_le_0_iff_le [symmetric] | 
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 932 | |
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 933 | lemma diff_eq_diff_less: | 
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 934 | "a - b = c - d \<Longrightarrow> a < b \<longleftrightarrow> c < d" | 
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 935 | by (auto simp only: less_iff_diff_less_0 [of a b] less_iff_diff_less_0 [of c d]) | 
| 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 936 | |
| 37889 
0d8058e0c270
keep explicit diff_def as legacy theorem; modernized abel_cancel simproc setup
 haftmann parents: 
37884diff
changeset | 937 | lemma diff_eq_diff_less_eq: | 
| 
0d8058e0c270
keep explicit diff_def as legacy theorem; modernized abel_cancel simproc setup
 haftmann parents: 
37884diff
changeset | 938 | "a - b = c - d \<Longrightarrow> a \<le> b \<longleftrightarrow> c \<le> d" | 
| 
0d8058e0c270
keep explicit diff_def as legacy theorem; modernized abel_cancel simproc setup
 haftmann parents: 
37884diff
changeset | 939 | by (auto simp only: le_iff_diff_le_0 [of a b] le_iff_diff_le_0 [of c d]) | 
| 25077 | 940 | |
| 941 | end | |
| 942 | ||
| 48891 | 943 | ML_file "Tools/group_cancel.ML" | 
| 48556 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 944 | |
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 945 | simproc_setup group_cancel_add ("a + b::'a::ab_group_add") =
 | 
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 946 |   {* fn phi => fn ss => try Group_Cancel.cancel_add_conv *}
 | 
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 947 | |
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 948 | simproc_setup group_cancel_diff ("a - b::'a::ab_group_add") =
 | 
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 949 |   {* fn phi => fn ss => try Group_Cancel.cancel_diff_conv *}
 | 
| 37884 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 950 | |
| 48556 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 951 | simproc_setup group_cancel_eq ("a = (b::'a::ab_group_add)") =
 | 
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 952 |   {* fn phi => fn ss => try Group_Cancel.cancel_eq_conv *}
 | 
| 37889 
0d8058e0c270
keep explicit diff_def as legacy theorem; modernized abel_cancel simproc setup
 haftmann parents: 
37884diff
changeset | 953 | |
| 48556 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 954 | simproc_setup group_cancel_le ("a \<le> (b::'a::ordered_ab_group_add)") =
 | 
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 955 |   {* fn phi => fn ss => try Group_Cancel.cancel_le_conv *}
 | 
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 956 | |
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 957 | simproc_setup group_cancel_less ("a < (b::'a::ordered_ab_group_add)") =
 | 
| 
62a3fbf9d35b
replace abel_cancel simprocs with functionally equivalent, but simpler and faster ones
 huffman parents: 
45548diff
changeset | 958 |   {* fn phi => fn ss => try Group_Cancel.cancel_less_conv *}
 | 
| 37884 
314a88278715
discontinued pretending that abel_cancel is logic-independent; cleaned up junk
 haftmann parents: 
36977diff
changeset | 959 | |
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 960 | class linordered_ab_semigroup_add = | 
| 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 961 | linorder + ordered_ab_semigroup_add | 
| 25062 | 962 | |
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 963 | class linordered_cancel_ab_semigroup_add = | 
| 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 964 | linorder + ordered_cancel_ab_semigroup_add | 
| 25267 | 965 | begin | 
| 25062 | 966 | |
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 967 | subclass linordered_ab_semigroup_add .. | 
| 25062 | 968 | |
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 969 | subclass ordered_ab_semigroup_add_imp_le | 
| 28823 | 970 | proof | 
| 25062 | 971 | fix a b c :: 'a | 
| 972 | assume le: "c + a <= c + b" | |
| 973 | show "a <= b" | |
| 974 | proof (rule ccontr) | |
| 975 | assume w: "~ a \<le> b" | |
| 976 | hence "b <= a" by (simp add: linorder_not_le) | |
| 977 | hence le2: "c + b <= c + a" by (rule add_left_mono) | |
| 978 | have "a = b" | |
| 979 | apply (insert le) | |
| 980 | apply (insert le2) | |
| 981 | apply (drule antisym, simp_all) | |
| 982 | done | |
| 983 | with w show False | |
| 984 | by (simp add: linorder_not_le [symmetric]) | |
| 985 | qed | |
| 986 | qed | |
| 987 | ||
| 25267 | 988 | end | 
| 989 | ||
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 990 | class linordered_ab_group_add = linorder + ordered_ab_group_add | 
| 25267 | 991 | begin | 
| 25230 | 992 | |
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 993 | subclass linordered_cancel_ab_semigroup_add .. | 
| 25230 | 994 | |
| 35036 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 995 | lemma neg_less_eq_nonneg [simp]: | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 996 | "- a \<le> a \<longleftrightarrow> 0 \<le> a" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 997 | proof | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 998 | assume A: "- a \<le> a" show "0 \<le> a" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 999 | proof (rule classical) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1000 | assume "\<not> 0 \<le> a" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1001 | then have "a < 0" by auto | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1002 | with A have "- a < 0" by (rule le_less_trans) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1003 | then show ?thesis by auto | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1004 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1005 | next | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1006 | assume A: "0 \<le> a" show "- a \<le> a" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1007 | proof (rule order_trans) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1008 | show "- a \<le> 0" using A by (simp add: minus_le_iff) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1009 | next | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1010 | show "0 \<le> a" using A . | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1011 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1012 | qed | 
| 35036 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1013 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1014 | lemma neg_less_nonneg [simp]: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1015 | "- a < a \<longleftrightarrow> 0 < a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1016 | proof | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1017 | assume A: "- a < a" show "0 < a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1018 | proof (rule classical) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1019 | assume "\<not> 0 < a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1020 | then have "a \<le> 0" by auto | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1021 | with A have "- a < 0" by (rule less_le_trans) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1022 | then show ?thesis by auto | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1023 | qed | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1024 | next | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1025 | assume A: "0 < a" show "- a < a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1026 | proof (rule less_trans) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1027 | show "- a < 0" using A by (simp add: minus_le_iff) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1028 | next | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1029 | show "0 < a" using A . | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1030 | qed | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1031 | qed | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1032 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1033 | lemma less_eq_neg_nonpos [simp]: | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1034 | "a \<le> - a \<longleftrightarrow> a \<le> 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1035 | proof | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1036 | assume A: "a \<le> - a" show "a \<le> 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1037 | proof (rule classical) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1038 | assume "\<not> a \<le> 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1039 | then have "0 < a" by auto | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1040 | then have "0 < - a" using A by (rule less_le_trans) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1041 | then show ?thesis by auto | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1042 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1043 | next | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1044 | assume A: "a \<le> 0" show "a \<le> - a" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1045 | proof (rule order_trans) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1046 | show "0 \<le> - a" using A by (simp add: minus_le_iff) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1047 | next | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1048 | show "a \<le> 0" using A . | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1049 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1050 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1051 | |
| 35036 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1052 | lemma equal_neg_zero [simp]: | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1053 | "a = - a \<longleftrightarrow> a = 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1054 | proof | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1055 | assume "a = 0" then show "a = - a" by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1056 | next | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1057 | assume A: "a = - a" show "a = 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1058 | proof (cases "0 \<le> a") | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1059 | case True with A have "0 \<le> - a" by auto | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1060 | with le_minus_iff have "a \<le> 0" by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1061 | with True show ?thesis by (auto intro: order_trans) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1062 | next | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1063 | case False then have B: "a \<le> 0" by auto | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1064 | with A have "- a \<le> 0" by auto | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1065 | with B show ?thesis by (auto intro: order_trans) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1066 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1067 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1068 | |
| 35036 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1069 | lemma neg_equal_zero [simp]: | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1070 | "- a = a \<longleftrightarrow> a = 0" | 
| 35036 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1071 | by (auto dest: sym) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1072 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1073 | lemma double_zero [simp]: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1074 | "a + a = 0 \<longleftrightarrow> a = 0" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1075 | proof | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1076 | assume assm: "a + a = 0" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1077 | then have a: "- a = a" by (rule minus_unique) | 
| 35216 | 1078 | then show "a = 0" by (simp only: neg_equal_zero) | 
| 35036 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1079 | qed simp | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1080 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1081 | lemma double_zero_sym [simp]: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1082 | "0 = a + a \<longleftrightarrow> a = 0" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1083 | by (rule, drule sym) simp_all | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1084 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1085 | lemma zero_less_double_add_iff_zero_less_single_add [simp]: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1086 | "0 < a + a \<longleftrightarrow> 0 < a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1087 | proof | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1088 | assume "0 < a + a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1089 | then have "0 - a < a" by (simp only: diff_less_eq) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1090 | then have "- a < a" by simp | 
| 35216 | 1091 | then show "0 < a" by (simp only: neg_less_nonneg) | 
| 35036 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1092 | next | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1093 | assume "0 < a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1094 | with this have "0 + 0 < a + a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1095 | by (rule add_strict_mono) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1096 | then show "0 < a + a" by simp | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1097 | qed | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1098 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1099 | lemma zero_le_double_add_iff_zero_le_single_add [simp]: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1100 | "0 \<le> a + a \<longleftrightarrow> 0 \<le> a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1101 | by (auto simp add: le_less) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1102 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1103 | lemma double_add_less_zero_iff_single_add_less_zero [simp]: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1104 | "a + a < 0 \<longleftrightarrow> a < 0" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1105 | proof - | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1106 | have "\<not> a + a < 0 \<longleftrightarrow> \<not> a < 0" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1107 | by (simp add: not_less) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1108 | then show ?thesis by simp | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1109 | qed | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1110 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1111 | lemma double_add_le_zero_iff_single_add_le_zero [simp]: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1112 | "a + a \<le> 0 \<longleftrightarrow> a \<le> 0" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1113 | proof - | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1114 | have "\<not> a + a \<le> 0 \<longleftrightarrow> \<not> a \<le> 0" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1115 | by (simp add: not_le) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1116 | then show ?thesis by simp | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1117 | qed | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1118 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1119 | lemma le_minus_self_iff: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1120 | "a \<le> - a \<longleftrightarrow> a \<le> 0" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1121 | proof - | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1122 | from add_le_cancel_left [of "- a" "a + a" 0] | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1123 | have "a \<le> - a \<longleftrightarrow> a + a \<le> 0" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1124 | by (simp add: add_assoc [symmetric]) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1125 | thus ?thesis by simp | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1126 | qed | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1127 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1128 | lemma minus_le_self_iff: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1129 | "- a \<le> a \<longleftrightarrow> 0 \<le> a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1130 | proof - | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1131 | from add_le_cancel_left [of "- a" 0 "a + a"] | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1132 | have "- a \<le> a \<longleftrightarrow> 0 \<le> a + a" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1133 | by (simp add: add_assoc [symmetric]) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1134 | thus ?thesis by simp | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1135 | qed | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1136 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1137 | lemma minus_max_eq_min: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1138 | "- max x y = min (-x) (-y)" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1139 | by (auto simp add: max_def min_def) | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1140 | |
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1141 | lemma minus_min_eq_max: | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1142 | "- min x y = max (-x) (-y)" | 
| 
b8c8d01cc20d
separate library theory for type classes combining lattices with various algebraic structures; more simp rules
 haftmann parents: 
35028diff
changeset | 1143 | by (auto simp add: max_def min_def) | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1144 | |
| 25267 | 1145 | end | 
| 1146 | ||
| 36302 | 1147 | context ordered_comm_monoid_add | 
| 1148 | begin | |
| 14738 | 1149 | |
| 15234 
ec91a90c604e
simplification tweaks for better arithmetic reasoning
 paulson parents: 
15229diff
changeset | 1150 | lemma add_increasing: | 
| 36302 | 1151 | "0 \<le> a \<Longrightarrow> b \<le> c \<Longrightarrow> b \<le> a + c" | 
| 1152 | by (insert add_mono [of 0 a b c], simp) | |
| 14738 | 1153 | |
| 15539 | 1154 | lemma add_increasing2: | 
| 36302 | 1155 | "0 \<le> c \<Longrightarrow> b \<le> a \<Longrightarrow> b \<le> a + c" | 
| 1156 | by (simp add: add_increasing add_commute [of a]) | |
| 15539 | 1157 | |
| 15234 
ec91a90c604e
simplification tweaks for better arithmetic reasoning
 paulson parents: 
15229diff
changeset | 1158 | lemma add_strict_increasing: | 
| 36302 | 1159 | "0 < a \<Longrightarrow> b \<le> c \<Longrightarrow> b < a + c" | 
| 1160 | by (insert add_less_le_mono [of 0 a b c], simp) | |
| 15234 
ec91a90c604e
simplification tweaks for better arithmetic reasoning
 paulson parents: 
15229diff
changeset | 1161 | |
| 
ec91a90c604e
simplification tweaks for better arithmetic reasoning
 paulson parents: 
15229diff
changeset | 1162 | lemma add_strict_increasing2: | 
| 36302 | 1163 | "0 \<le> a \<Longrightarrow> b < c \<Longrightarrow> b < a + c" | 
| 1164 | by (insert add_le_less_mono [of 0 a b c], simp) | |
| 1165 | ||
| 1166 | end | |
| 15234 
ec91a90c604e
simplification tweaks for better arithmetic reasoning
 paulson parents: 
15229diff
changeset | 1167 | |
| 35092 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1168 | class abs = | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1169 | fixes abs :: "'a \<Rightarrow> 'a" | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1170 | begin | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1171 | |
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1172 | notation (xsymbols) | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1173 |   abs  ("\<bar>_\<bar>")
 | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1174 | |
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1175 | notation (HTML output) | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1176 |   abs  ("\<bar>_\<bar>")
 | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1177 | |
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1178 | end | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1179 | |
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1180 | class sgn = | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1181 | fixes sgn :: "'a \<Rightarrow> 'a" | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1182 | |
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1183 | class abs_if = minus + uminus + ord + zero + abs + | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1184 | assumes abs_if: "\<bar>a\<bar> = (if a < 0 then - a else a)" | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1185 | |
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1186 | class sgn_if = minus + uminus + zero + one + ord + sgn + | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1187 | assumes sgn_if: "sgn x = (if x = 0 then 0 else if 0 < x then 1 else - 1)" | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1188 | begin | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1189 | |
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1190 | lemma sgn0 [simp]: "sgn 0 = 0" | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1191 | by (simp add:sgn_if) | 
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1192 | |
| 
cfe605c54e50
moved less_eq, less to Orderings.thy; moved abs, sgn to Groups.thy
 haftmann parents: 
35050diff
changeset | 1193 | end | 
| 14738 | 1194 | |
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 1195 | class ordered_ab_group_add_abs = ordered_ab_group_add + abs + | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1196 | assumes abs_ge_zero [simp]: "\<bar>a\<bar> \<ge> 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1197 | and abs_ge_self: "a \<le> \<bar>a\<bar>" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1198 | and abs_leI: "a \<le> b \<Longrightarrow> - a \<le> b \<Longrightarrow> \<bar>a\<bar> \<le> b" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1199 | and abs_minus_cancel [simp]: "\<bar>-a\<bar> = \<bar>a\<bar>" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1200 | and abs_triangle_ineq: "\<bar>a + b\<bar> \<le> \<bar>a\<bar> + \<bar>b\<bar>" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1201 | begin | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1202 | |
| 25307 | 1203 | lemma abs_minus_le_zero: "- \<bar>a\<bar> \<le> 0" | 
| 1204 | unfolding neg_le_0_iff_le by simp | |
| 1205 | ||
| 1206 | lemma abs_of_nonneg [simp]: | |
| 29667 | 1207 | assumes nonneg: "0 \<le> a" shows "\<bar>a\<bar> = a" | 
| 25307 | 1208 | proof (rule antisym) | 
| 1209 | from nonneg le_imp_neg_le have "- a \<le> 0" by simp | |
| 1210 | from this nonneg have "- a \<le> a" by (rule order_trans) | |
| 1211 | then show "\<bar>a\<bar> \<le> a" by (auto intro: abs_leI) | |
| 1212 | qed (rule abs_ge_self) | |
| 1213 | ||
| 1214 | lemma abs_idempotent [simp]: "\<bar>\<bar>a\<bar>\<bar> = \<bar>a\<bar>" | |
| 29667 | 1215 | by (rule antisym) | 
| 36302 | 1216 | (auto intro!: abs_ge_self abs_leI order_trans [of "- \<bar>a\<bar>" 0 "\<bar>a\<bar>"]) | 
| 25307 | 1217 | |
| 1218 | lemma abs_eq_0 [simp]: "\<bar>a\<bar> = 0 \<longleftrightarrow> a = 0" | |
| 1219 | proof - | |
| 1220 | have "\<bar>a\<bar> = 0 \<Longrightarrow> a = 0" | |
| 1221 | proof (rule antisym) | |
| 1222 | assume zero: "\<bar>a\<bar> = 0" | |
| 1223 | with abs_ge_self show "a \<le> 0" by auto | |
| 1224 | from zero have "\<bar>-a\<bar> = 0" by simp | |
| 36302 | 1225 | with abs_ge_self [of "- a"] have "- a \<le> 0" by auto | 
| 25307 | 1226 | with neg_le_0_iff_le show "0 \<le> a" by auto | 
| 1227 | qed | |
| 1228 | then show ?thesis by auto | |
| 1229 | qed | |
| 1230 | ||
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1231 | lemma abs_zero [simp]: "\<bar>0\<bar> = 0" | 
| 29667 | 1232 | by simp | 
| 16775 
c1b87ef4a1c3
added lemmas to OrderedGroup.thy (reasoning about signs, absolute value, triangle inequalities)
 avigad parents: 
16417diff
changeset | 1233 | |
| 35828 
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
 blanchet parents: 
35723diff
changeset | 1234 | lemma abs_0_eq [simp, no_atp]: "0 = \<bar>a\<bar> \<longleftrightarrow> a = 0" | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1235 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1236 | have "0 = \<bar>a\<bar> \<longleftrightarrow> \<bar>a\<bar> = 0" by (simp only: eq_ac) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1237 | thus ?thesis by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1238 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1239 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1240 | lemma abs_le_zero_iff [simp]: "\<bar>a\<bar> \<le> 0 \<longleftrightarrow> a = 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1241 | proof | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1242 | assume "\<bar>a\<bar> \<le> 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1243 | then have "\<bar>a\<bar> = 0" by (rule antisym) simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1244 | thus "a = 0" by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1245 | next | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1246 | assume "a = 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1247 | thus "\<bar>a\<bar> \<le> 0" by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1248 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1249 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1250 | lemma zero_less_abs_iff [simp]: "0 < \<bar>a\<bar> \<longleftrightarrow> a \<noteq> 0" | 
| 29667 | 1251 | by (simp add: less_le) | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1252 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1253 | lemma abs_not_less_zero [simp]: "\<not> \<bar>a\<bar> < 0" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1254 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1255 | have a: "\<And>x y. x \<le> y \<Longrightarrow> \<not> y < x" by auto | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1256 | show ?thesis by (simp add: a) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1257 | qed | 
| 16775 
c1b87ef4a1c3
added lemmas to OrderedGroup.thy (reasoning about signs, absolute value, triangle inequalities)
 avigad parents: 
16417diff
changeset | 1258 | |
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1259 | lemma abs_ge_minus_self: "- a \<le> \<bar>a\<bar>" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1260 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1261 | have "- a \<le> \<bar>-a\<bar>" by (rule abs_ge_self) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1262 | then show ?thesis by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1263 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1264 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1265 | lemma abs_minus_commute: | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1266 | "\<bar>a - b\<bar> = \<bar>b - a\<bar>" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1267 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1268 | have "\<bar>a - b\<bar> = \<bar>- (a - b)\<bar>" by (simp only: abs_minus_cancel) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1269 | also have "... = \<bar>b - a\<bar>" by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1270 | finally show ?thesis . | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1271 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1272 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1273 | lemma abs_of_pos: "0 < a \<Longrightarrow> \<bar>a\<bar> = a" | 
| 29667 | 1274 | by (rule abs_of_nonneg, rule less_imp_le) | 
| 16775 
c1b87ef4a1c3
added lemmas to OrderedGroup.thy (reasoning about signs, absolute value, triangle inequalities)
 avigad parents: 
16417diff
changeset | 1275 | |
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1276 | lemma abs_of_nonpos [simp]: | 
| 29667 | 1277 | assumes "a \<le> 0" shows "\<bar>a\<bar> = - a" | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1278 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1279 | let ?b = "- a" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1280 | have "- ?b \<le> 0 \<Longrightarrow> \<bar>- ?b\<bar> = - (- ?b)" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1281 | unfolding abs_minus_cancel [of "?b"] | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1282 | unfolding neg_le_0_iff_le [of "?b"] | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1283 | unfolding minus_minus by (erule abs_of_nonneg) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1284 | then show ?thesis using assms by auto | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1285 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1286 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1287 | lemma abs_of_neg: "a < 0 \<Longrightarrow> \<bar>a\<bar> = - a" | 
| 29667 | 1288 | by (rule abs_of_nonpos, rule less_imp_le) | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1289 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1290 | lemma abs_le_D1: "\<bar>a\<bar> \<le> b \<Longrightarrow> a \<le> b" | 
| 29667 | 1291 | by (insert abs_ge_self, blast intro: order_trans) | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1292 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1293 | lemma abs_le_D2: "\<bar>a\<bar> \<le> b \<Longrightarrow> - a \<le> b" | 
| 36302 | 1294 | by (insert abs_le_D1 [of "- a"], simp) | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1295 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1296 | lemma abs_le_iff: "\<bar>a\<bar> \<le> b \<longleftrightarrow> a \<le> b \<and> - a \<le> b" | 
| 29667 | 1297 | by (blast intro: abs_leI dest: abs_le_D1 abs_le_D2) | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1298 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1299 | lemma abs_triangle_ineq2: "\<bar>a\<bar> - \<bar>b\<bar> \<le> \<bar>a - b\<bar>" | 
| 36302 | 1300 | proof - | 
| 1301 | have "\<bar>a\<bar> = \<bar>b + (a - b)\<bar>" | |
| 1302 | by (simp add: algebra_simps add_diff_cancel) | |
| 1303 | then have "\<bar>a\<bar> \<le> \<bar>b\<bar> + \<bar>a - b\<bar>" | |
| 1304 | by (simp add: abs_triangle_ineq) | |
| 1305 | then show ?thesis | |
| 1306 | by (simp add: algebra_simps) | |
| 1307 | qed | |
| 1308 | ||
| 1309 | lemma abs_triangle_ineq2_sym: "\<bar>a\<bar> - \<bar>b\<bar> \<le> \<bar>b - a\<bar>" | |
| 1310 | by (simp only: abs_minus_commute [of b] abs_triangle_ineq2) | |
| 16775 
c1b87ef4a1c3
added lemmas to OrderedGroup.thy (reasoning about signs, absolute value, triangle inequalities)
 avigad parents: 
16417diff
changeset | 1311 | |
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1312 | lemma abs_triangle_ineq3: "\<bar>\<bar>a\<bar> - \<bar>b\<bar>\<bar> \<le> \<bar>a - b\<bar>" | 
| 36302 | 1313 | by (simp add: abs_le_iff abs_triangle_ineq2 abs_triangle_ineq2_sym) | 
| 16775 
c1b87ef4a1c3
added lemmas to OrderedGroup.thy (reasoning about signs, absolute value, triangle inequalities)
 avigad parents: 
16417diff
changeset | 1314 | |
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1315 | lemma abs_triangle_ineq4: "\<bar>a - b\<bar> \<le> \<bar>a\<bar> + \<bar>b\<bar>" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1316 | proof - | 
| 36302 | 1317 | have "\<bar>a - b\<bar> = \<bar>a + - b\<bar>" by (subst diff_minus, rule refl) | 
| 1318 | also have "... \<le> \<bar>a\<bar> + \<bar>- b\<bar>" by (rule abs_triangle_ineq) | |
| 29667 | 1319 | finally show ?thesis by simp | 
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1320 | qed | 
| 16775 
c1b87ef4a1c3
added lemmas to OrderedGroup.thy (reasoning about signs, absolute value, triangle inequalities)
 avigad parents: 
16417diff
changeset | 1321 | |
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1322 | lemma abs_diff_triangle_ineq: "\<bar>a + b - (c + d)\<bar> \<le> \<bar>a - c\<bar> + \<bar>b - d\<bar>" | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1323 | proof - | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1324 | have "\<bar>a + b - (c+d)\<bar> = \<bar>(a-c) + (b-d)\<bar>" by (simp add: diff_minus add_ac) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1325 | also have "... \<le> \<bar>a-c\<bar> + \<bar>b-d\<bar>" by (rule abs_triangle_ineq) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1326 | finally show ?thesis . | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1327 | qed | 
| 16775 
c1b87ef4a1c3
added lemmas to OrderedGroup.thy (reasoning about signs, absolute value, triangle inequalities)
 avigad parents: 
16417diff
changeset | 1328 | |
| 25303 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1329 | lemma abs_add_abs [simp]: | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1330 | "\<bar>\<bar>a\<bar> + \<bar>b\<bar>\<bar> = \<bar>a\<bar> + \<bar>b\<bar>" (is "?L = ?R") | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1331 | proof (rule antisym) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1332 | show "?L \<ge> ?R" by(rule abs_ge_self) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1333 | next | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1334 | have "?L \<le> \<bar>\<bar>a\<bar>\<bar> + \<bar>\<bar>b\<bar>\<bar>" by(rule abs_triangle_ineq) | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1335 | also have "\<dots> = ?R" by simp | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1336 | finally show "?L \<le> ?R" . | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1337 | qed | 
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1338 | |
| 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 haftmann parents: 
25267diff
changeset | 1339 | end | 
| 14738 | 1340 | |
| 15178 | 1341 | |
| 25090 | 1342 | subsection {* Tools setup *}
 | 
| 1343 | ||
| 35828 
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
 blanchet parents: 
35723diff
changeset | 1344 | lemma add_mono_thms_linordered_semiring [no_atp]: | 
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 1345 | fixes i j k :: "'a\<Colon>ordered_ab_semigroup_add" | 
| 25077 | 1346 | shows "i \<le> j \<and> k \<le> l \<Longrightarrow> i + k \<le> j + l" | 
| 1347 | and "i = j \<and> k \<le> l \<Longrightarrow> i + k \<le> j + l" | |
| 1348 | and "i \<le> j \<and> k = l \<Longrightarrow> i + k \<le> j + l" | |
| 1349 | and "i = j \<and> k = l \<Longrightarrow> i + k = j + l" | |
| 1350 | by (rule add_mono, clarify+)+ | |
| 1351 | ||
| 35828 
46cfc4b8112e
now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
 blanchet parents: 
35723diff
changeset | 1352 | lemma add_mono_thms_linordered_field [no_atp]: | 
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
34973diff
changeset | 1353 | fixes i j k :: "'a\<Colon>ordered_cancel_ab_semigroup_add" | 
| 25077 | 1354 | shows "i < j \<and> k = l \<Longrightarrow> i + k < j + l" | 
| 1355 | and "i = j \<and> k < l \<Longrightarrow> i + k < j + l" | |
| 1356 | and "i < j \<and> k \<le> l \<Longrightarrow> i + k < j + l" | |
| 1357 | and "i \<le> j \<and> k < l \<Longrightarrow> i + k < j + l" | |
| 1358 | and "i < j \<and> k < l \<Longrightarrow> i + k < j + l" | |
| 1359 | by (auto intro: add_strict_right_mono add_strict_left_mono | |
| 1360 | add_less_le_mono add_le_less_mono add_strict_mono) | |
| 1361 | ||
| 52435 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
52289diff
changeset | 1362 | code_identifier | 
| 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
52289diff
changeset | 1363 | code_module Groups \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith | 
| 33364 | 1364 | |
| 37889 
0d8058e0c270
keep explicit diff_def as legacy theorem; modernized abel_cancel simproc setup
 haftmann parents: 
37884diff
changeset | 1365 | |
| 
0d8058e0c270
keep explicit diff_def as legacy theorem; modernized abel_cancel simproc setup
 haftmann parents: 
37884diff
changeset | 1366 | text {* Legacy *}
 | 
| 
0d8058e0c270
keep explicit diff_def as legacy theorem; modernized abel_cancel simproc setup
 haftmann parents: 
37884diff
changeset | 1367 | |
| 
0d8058e0c270
keep explicit diff_def as legacy theorem; modernized abel_cancel simproc setup
 haftmann parents: 
37884diff
changeset | 1368 | lemmas diff_def = diff_minus | 
| 
0d8058e0c270
keep explicit diff_def as legacy theorem; modernized abel_cancel simproc setup
 haftmann parents: 
37884diff
changeset | 1369 | |
| 14738 | 1370 | end | 
| 49388 | 1371 |