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