src/HOL/OrderedGroup.thy
changeset 34973 ae634fad947e
parent 34147 319616f4eecf
child 35028 108662d50512
equal deleted inserted replaced
34972:cc1d4c3ca9db 34973:ae634fad947e
    21   \item \emph{Algebra I} by van der Waerden, Springer.
    21   \item \emph{Algebra I} by van der Waerden, Springer.
    22   \end{itemize}
    22   \end{itemize}
    23 *}
    23 *}
    24 
    24 
    25 ML {*
    25 ML {*
    26 structure Algebra_Simps = Named_Thms
    26 structure Algebra_Simps = Named_Thms(
    27 (
       
    28   val name = "algebra_simps"
    27   val name = "algebra_simps"
    29   val description = "algebra simplification rules"
    28   val description = "algebra simplification rules"
    30 )
    29 )
    31 *}
    30 *}
    32 
    31 
    42 inverses or division. This is catered for by @{text field_simps}. *}
    41 inverses or division. This is catered for by @{text field_simps}. *}
    43 
    42 
    44 subsection {* Semigroups and Monoids *}
    43 subsection {* Semigroups and Monoids *}
    45 
    44 
    46 class semigroup_add = plus +
    45 class semigroup_add = plus +
    47   assumes add_assoc[algebra_simps]: "(a + b) + c = a + (b + c)"
    46   assumes add_assoc [algebra_simps]: "(a + b) + c = a + (b + c)"
       
    47 
       
    48 sublocale semigroup_add < plus!: semigroup plus proof
       
    49 qed (fact add_assoc)
    48 
    50 
    49 class ab_semigroup_add = semigroup_add +
    51 class ab_semigroup_add = semigroup_add +
    50   assumes add_commute[algebra_simps]: "a + b = b + a"
    52   assumes add_commute [algebra_simps]: "a + b = b + a"
    51 begin
    53 
    52 
    54 sublocale ab_semigroup_add < plus!: abel_semigroup plus proof
    53 lemma add_left_commute[algebra_simps]: "a + (b + c) = b + (a + c)"
    55 qed (fact add_commute)
    54 by (rule mk_left_commute [of "plus", OF add_assoc add_commute])
    56 
       
    57 context ab_semigroup_add
       
    58 begin
       
    59 
       
    60 lemmas add_left_commute [algebra_simps] = plus.left_commute
    55 
    61 
    56 theorems add_ac = add_assoc add_commute add_left_commute
    62 theorems add_ac = add_assoc add_commute add_left_commute
    57 
    63 
    58 end
    64 end
    59 
    65 
    60 theorems add_ac = add_assoc add_commute add_left_commute
    66 theorems add_ac = add_assoc add_commute add_left_commute
    61 
    67 
    62 class semigroup_mult = times +
    68 class semigroup_mult = times +
    63   assumes mult_assoc[algebra_simps]: "(a * b) * c = a * (b * c)"
    69   assumes mult_assoc [algebra_simps]: "(a * b) * c = a * (b * c)"
       
    70 
       
    71 sublocale semigroup_mult < times!: semigroup times proof
       
    72 qed (fact mult_assoc)
    64 
    73 
    65 class ab_semigroup_mult = semigroup_mult +
    74 class ab_semigroup_mult = semigroup_mult +
    66   assumes mult_commute[algebra_simps]: "a * b = b * a"
    75   assumes mult_commute [algebra_simps]: "a * b = b * a"
    67 begin
    76 
    68 
    77 sublocale ab_semigroup_mult < times!: abel_semigroup times proof
    69 lemma mult_left_commute[algebra_simps]: "a * (b * c) = b * (a * c)"
    78 qed (fact mult_commute)
    70 by (rule mk_left_commute [of "times", OF mult_assoc mult_commute])
    79 
       
    80 context ab_semigroup_mult
       
    81 begin
       
    82 
       
    83 lemmas mult_left_commute [algebra_simps] = times.left_commute
    71 
    84 
    72 theorems mult_ac = mult_assoc mult_commute mult_left_commute
    85 theorems mult_ac = mult_assoc mult_commute mult_left_commute
    73 
    86 
    74 end
    87 end
    75 
    88 
    76 theorems mult_ac = mult_assoc mult_commute mult_left_commute
    89 theorems mult_ac = mult_assoc mult_commute mult_left_commute
    77 
    90 
    78 class ab_semigroup_idem_mult = ab_semigroup_mult +
    91 class ab_semigroup_idem_mult = ab_semigroup_mult +
    79   assumes mult_idem[simp]: "x * x = x"
    92   assumes mult_idem: "x * x = x"
    80 begin
    93 
    81 
    94 sublocale ab_semigroup_idem_mult < times!: semilattice times proof
    82 lemma mult_left_idem[simp]: "x * (x * y) = x * y"
    95 qed (fact mult_idem)
    83   unfolding mult_assoc [symmetric, of x] mult_idem ..
    96 
       
    97 context ab_semigroup_idem_mult
       
    98 begin
       
    99 
       
   100 lemmas mult_left_idem = times.left_idem
    84 
   101 
    85 end
   102 end
    86 
   103 
    87 class monoid_add = zero + semigroup_add +
   104 class monoid_add = zero + semigroup_add +
    88   assumes add_0_left [simp]: "0 + a = a"
   105   assumes add_0_left [simp]: "0 + a = a"
  1368 (
  1385 (
  1369 
  1386 
  1370 (* term order for abelian groups *)
  1387 (* term order for abelian groups *)
  1371 
  1388 
  1372 fun agrp_ord (Const (a, _)) = find_index (fn a' => a = a')
  1389 fun agrp_ord (Const (a, _)) = find_index (fn a' => a = a')
  1373       [@{const_name HOL.zero}, @{const_name HOL.plus},
  1390       [@{const_name Algebras.zero}, @{const_name Algebras.plus},
  1374         @{const_name HOL.uminus}, @{const_name HOL.minus}]
  1391         @{const_name Algebras.uminus}, @{const_name Algebras.minus}]
  1375   | agrp_ord _ = ~1;
  1392   | agrp_ord _ = ~1;
  1376 
  1393 
  1377 fun termless_agrp (a, b) = (TermOrd.term_lpo agrp_ord (a, b) = LESS);
  1394 fun termless_agrp (a, b) = (TermOrd.term_lpo agrp_ord (a, b) = LESS);
  1378 
  1395 
  1379 local
  1396 local
  1380   val ac1 = mk_meta_eq @{thm add_assoc};
  1397   val ac1 = mk_meta_eq @{thm add_assoc};
  1381   val ac2 = mk_meta_eq @{thm add_commute};
  1398   val ac2 = mk_meta_eq @{thm add_commute};
  1382   val ac3 = mk_meta_eq @{thm add_left_commute};
  1399   val ac3 = mk_meta_eq @{thm add_left_commute};
  1383   fun solve_add_ac thy _ (_ $ (Const (@{const_name HOL.plus},_) $ _ $ _) $ _) =
  1400   fun solve_add_ac thy _ (_ $ (Const (@{const_name Algebras.plus},_) $ _ $ _) $ _) =
  1384         SOME ac1
  1401         SOME ac1
  1385     | solve_add_ac thy _ (_ $ x $ (Const (@{const_name HOL.plus},_) $ y $ z)) =
  1402     | solve_add_ac thy _ (_ $ x $ (Const (@{const_name Algebras.plus},_) $ y $ z)) =
  1386         if termless_agrp (y, x) then SOME ac3 else NONE
  1403         if termless_agrp (y, x) then SOME ac3 else NONE
  1387     | solve_add_ac thy _ (_ $ x $ y) =
  1404     | solve_add_ac thy _ (_ $ x $ y) =
  1388         if termless_agrp (y, x) then SOME ac2 else NONE
  1405         if termless_agrp (y, x) then SOME ac2 else NONE
  1389     | solve_add_ac thy _ _ = NONE
  1406     | solve_add_ac thy _ _ = NONE
  1390 in
  1407 in