groupScript.sml

1(* ------------------------------------------------------------------------- *)
2(* Group library                                                             *)
3(* ========================================================================= *)
4(*  A group is an algebraic structure: a monoid with all its elements        *)
5(*  invertible.                                                              *)
6(* ------------------------------------------------------------------------- *)
7(* Group Theory -- axioms to exponentiation.                                 *)
8(* Group Maps                                                                *)
9(* Group Theory -- Subgroups (Cosets, Lagrange's Theorem)                    *)
10(* Group Theory -- Normal subgroup and Quotient Groups.                      *)
11(* Group Theory -- Iterated Product.                                         *)
12(* Finite Group Order                                                        *)
13(* Finite Group Theory                                                       *)
14(* Applying Group Theory: Group Instances                                    *)
15(* Cyclic Group                                                              *)
16(* Group Action, Orbits and Fixed points.                                    *)
17(* Group Correspondence Theory                                               *)
18(* Congruences from Number Theory                                            *)
19(* ------------------------------------------------------------------------- *)
20(* (Joseph) Hing-Lun Chan, The Australian National University, 2014-2019     *)
21(* ------------------------------------------------------------------------- *)
22
23(*
24based on: examples/elliptic/groupScript.sml
25
26The idea behind this script is discussed in (Secton 2.1.1. Groups):
27
28Formalizing Elliptic Curve Cryptography in Higher Order Logic (Joe Hurd)
29http://www.gilith.com/research/papers/elliptic.pdf
30
31*)
32
33(*===========================================================================*)
34
35Theory group
36Ancestors
37  pred_set prim_rec arithmetic divides gcd gcdset list number
38  combinatorics prime
39  monoid (* for G*, monoid_invertibles_is_monoid *)
40Libs
41  jcLib
42
43
44(* val _ = load "jcLib"; *)
45
46
47
48(* ------------------------------------------------------------------------- *)
49(* Group Documentation                                                       *)
50(* ------------------------------------------------------------------------- *)
51(* Data type (same as monoid):
52   The generic symbol for group data is g.
53   g.carrier = Carrier set of group, overloaded as G.
54   g.op      = Binary operation of group, overloaded as *.
55   g.id      = Identity element of group, overloaded as #e.
56   g.exp     = Iteration of g.op (added by monoid)
57   g.inv     = Inverse of g.op   (added by monoid)
58*)
59(* Definitions and Theorems (# are exported):
60
61   Definitions:
62   Group_def               |- !g. Group g <=> Monoid g /\ (G* = G)
63   AbelianGroup_def        |- !g. AbelianGroup g <=> Group g /\ !x y. x IN G /\ y IN G ==> (x * y = y * x)
64   FiniteGroup_def         |- !g. FiniteGroup g <=> Group g /\ FINITE G
65   FiniteAbelianGroup_def  |- !g. FiniteAbelianGroup g <=> AbelianGroup g /\ FINITE G
66
67   Extract from definition:
68   group_clauses           |- !g. Group g ==> Monoid g /\ (G* = G)
69#  group_is_monoid         |- !g. Group g ==> Monoid g
70#  group_all_invertible    |- !g. Group g ==> (G* = G)
71
72   Simple theorems:
73   monoid_invertibles_is_group   |- !g. Monoid g ==> Group (Invertibles g)
74   finite_monoid_invertibles_is_finite_group
75                                 |- !g. FiniteMonoid g ==> FiniteGroup (Invertibles g)
76   FiniteAbelianGroup_def_alt    |- !g. FiniteAbelianGroup g <=>
77                                        FiniteGroup g /\ !x y. x IN G /\ y IN G ==> (x * y = y * x)
78   finite_group_is_group         |- !g. FiniteGroup g ==> Group g
79   finite_group_is_monoid        |- !g. FiniteGroup g ==> Monoid g
80   finite_group_is_finite_monoid |- !g. FiniteGroup g ==> FiniteMonoid g
81   abelian_group_is_abelian_monoid
82                                 |- !g. AbelianGroup g ==> AbelianMonoid g
83   finite_abelian_group_is_finite_abelian_monoid
84                                 |- !g. FiniteAbelianGroup g ==> FiniteAbelianMonoid g
85
86   Group theorems (lift or take from Monoid):
87   group_id_element   |- !g. Group g ==> #e IN G
88   group_op_element   |- !g. Group g ==> !x y. x IN G /\ y IN G ==> x * y IN G
89   group_assoc        |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> (x * y * z = x * (y * z))
90   group_lid          |- !g. Group g ==> !x. x IN G ==> (#e * x = x)
91   group_rid          |- !g. Group g ==> !x. x IN G ==> (x * #e = x)
92   group_id           |- !g. Group g ==> !x. x IN G ==> (#e * x = x) /\ (x * #e = x)
93   group_id_id        |- !g. Group g ==> (#e * #e = #e)
94   group_exp_element  |- !g. Group g ==> !x. x IN G ==> !n. x ** n IN G
95   group_exp_SUC      |- !g x n. x ** SUC n = x * x ** n
96   group_exp_suc      |- !g. Group g ==> !x. x IN G ==> !n. x ** SUC n = x ** n * x
97   group_exp_0        |- !g x. x ** 0 = #e
98   group_exp_1        |- !g. Group g ==> !x. x IN G ==> (x ** 1 = x)
99   group_id_exp       |- !g. Group g ==> !n. #e ** n = #e
100   group_comm_exp     |- !g. Group g ==> !x y. x IN G /\ y IN G ==> (x * y = y * x) ==> !n. x ** n * y = y * x ** n
101   group_exp_comm     |- !g. Group g ==> !x. x IN G ==> !n. x ** n * x = x * x ** n
102   group_comm_op_exp  |- !g. Group g ==> !x y. x IN G /\ y IN G /\ (x * y = y * x) ==> !n. (x * y) ** n = x ** n * y ** n
103   group_exp_add      |- !g. Group g ==> !x. x IN G ==> !n k. x ** (n + k) = x ** n * x ** k
104   group_exp_mult     |- !g. Group g ==> !x. x IN G ==> !n k. x ** (n * k) = (x ** n) ** k
105
106   Group theorems (from Monoid invertibles).
107#  group_inv_element  |- !g. Group g ==> !x. x IN G ==> |/ x IN G
108#  group_linv         |- !g. Group g ==> !x. x IN G ==> ( |/ x * x = #e)
109#  group_rinv         |- !g. Group g ==> !x. x IN G ==> (x * |/ x = #e)
110   group_inv_thm      |- !g. Group g ==> !x. x IN G ==> (x * |/ x = #e) /\ ( |/ x * x = #e)
111   group_carrier_nonempty  |- !g. Group g ==> G <> {}
112
113   Group theorems (not from Monoid):
114   group_lcancel     |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * y = x * z) <=> (y = z))
115   group_rcancel     |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((y * x = z * x) <=> (y = z))
116
117   Inverses with assocative law:
118   group_linv_assoc  |- !g. Group g ==> !x y. x IN G /\ y IN G ==> (y = x * ( |/ x * y)) /\ (y = |/ x * (x * y))
119   group_rinv_assoc  |- !g. Group g ==> !x y. x IN G /\ y IN G ==> (y = y * |/ x * x) /\ (y = y * x * |/ x)
120   group_lsolve      |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * y = z) <=> (x = z * |/ y))
121   group_rsolve      |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * y = z) <=> (y = |/ x * z))
122   group_lid_unique  |- !g. Group g ==> !x y. x IN G /\ y IN G ==> ((y * x = x) <=> (y = #e))
123   group_rid_unique  |- !g. Group g ==> !x y. x IN G /\ y IN G ==> ((x * y = x) <=> (y = #e))
124   group_id_unique   |- !g. Group g ==> !x y. x IN G /\ y IN G ==> ((y * x = x) <=> (y = #e)) /\
125                                                                   ((x * y = x) <=> (y = #e))
126   group_linv_unique |- !g. Group g ==> !x y. x IN G /\ y IN G ==> ((x * y = #e) <=> (x = |/ y))
127   group_rinv_unique |- !g. Group g ==> !x y. x IN G /\ y IN G ==> ((x * y = #e) <=> (y = |/ x))
128#  group_inv_inv     |- !g. Group g ==> !x. x IN G ==> ( |/ ( |/ x) = x)
129#  group_inv_eq      |- !g. Group g ==> !x y. x IN G /\ y IN G ==> (( |/ x = |/ y) <=> (x = y))
130#  group_inv_eq_swap |- !g. Group g ==> !x y. x IN G /\ y IN G ==> (( |/ x = y) <=> (x = |/ y))
131#  group_inv_id      |- !g. Group g ==> ( |/ #e = #e)
132   group_inv_eq_id   |- !g. Group g ==> !x. x IN G ==> (( |/ x = #e) <=> (x = #e))
133   group_inv_op      |- !g. Group g ==> !x y. x IN G /\ y IN G ==> ( |/ (x * y) = |/ y * |/ x)
134   group_pair_reduce |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> (x * z * |/ (y * z) = x * |/ y)
135   group_id_fix      |- !g. Group g ==> !x. x IN G ==> ((x * x = x) <=> (x = #e))
136   group_op_linv_eq_id  |- !g. Group g ==> !x y. x IN G /\ y IN G ==> (( |/ x * y = #e) <=> (x = y))
137   group_op_rinv_eq_id  |- !g. Group g ==> !x y. x IN G /\ y IN G ==> ((x * |/ y = #e) <=> (x = y))
138   group_op_linv_eqn    |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> (( |/ x * y = z) <=> (y = x * z))
139   group_op_rinv_eqn    |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * |/ y = z) <=> (x = z * y))
140   Invertibles_inv      |- !g x. Monoid g /\ x IN G* ==> ((Invertibles g).inv x = |/ x)
141   monoid_inv_id        |- !g. Monoid g ==> |/ #e = #e
142
143   Group defintion without explicit mention of Monoid.
144   group_def_alt        |- !g. Group g <=>
145                            (!x y. x IN G /\ y IN G ==> x * y IN G) /\
146                            (!x y z. x IN G /\ y IN G /\ z IN G ==> (x * y * z = x * (y * z))) /\
147                            #e IN G /\
148                            (!x. x IN G ==> (#e * x = x)) /\ !x. x IN G ==> ?y. y IN G /\ (y * x = #e)
149   group_def_by_inverse |- !g. Group g <=> Monoid g /\ !x. x IN G ==> ?y. y IN G /\ (y * x = #e)
150   group_alt            |- !g. Group g <=>
151                            (!x y::G. x * y IN G) /\ (!x y z::G. x * y * z = x * (y * z)) /\
152                            #e IN G /\ (!x::G. #e * x = x) /\ !x::G. |/ x IN G /\ |/ x * x = #e
153
154   Transformation of Group structure by modifying carrier (for field).
155   including_def   |- !g z. including g z = <|carrier := G UNION {z}; op := $*; id := #e|>
156   excluding_def   |- !g z. excluding g z = <|carrier := G DIFF {z}; op := $*; id := #e|>
157   group_including_property
158                   |- !g z. ((g including z).op = $* ) /\ ((g including z).id = #e) /\
159                      !x. x IN (g including z).carrier ==> x IN G \/ (x = z)
160   group_excluding_property
161                   |- !g z. ((g excluding z).op = $* ) /\ ((g excluding z).id = #e) /\
162                      !x. x IN (g excluding z).carrier ==> x IN G /\ x <> z
163   group_including_excluding_property
164                   |- !g z. ((g including z excluding z).op = $* ) /\
165                            ((g including z excluding z).id = #e) /\
166                            (z NOTIN G ==> ((g including z excluding z).carrier = G))
167   group_including_excluding_group
168                   |- !g z. z NOTIN G ==> (Group g <=> Group (g including z excluding z))
169   group_including_excluding_abelian
170                   |- !g z. z NOTIN G ==> (AbelianGroup g <=> AbelianGroup (g including z excluding z))
171   group_including_excluding_eqn |- !g z.  g including z excluding z =
172                   if z IN G then <|carrier := G DELETE z; op := $*; id := #e|> else g
173#  group_excluding_op  |- !g z. (g excluding z).op = $*
174   group_excluding_exp |- !g z x n. (g excluding z).exp x n = x ** n
175   abelian_monoid_invertible_excluding
176                       |- !g. AbelianMonoid g ==>
177                          !z. z NOTIN G* ==> (monoid_invertibles (g excluding z) = G* )
178
179   Group Exponentiation with Inverses:
180   group_exp_inv   |- !g. Group g ==> !x. x IN G ==> !n. |/ (x ** n) = |/ x ** n
181   group_inv_exp   |- !g. Group g ==> !x. x IN G ==> !n. |/ x ** n = |/ (x ** n)
182   group_exp_eq    |- !g. Group g ==> !x. x IN G ==> !m n. m < n /\ (x ** m = x ** n) ==> (x ** (n - m) = #e)
183   group_exp_mult_comm |- !g. Group g ==> !x. x IN G ==> !m n. (x ** m) ** n = (x ** n) ** m
184   group_comm_exp_exp  |- !g. Group g ==> !x y. x IN G /\ y IN G /\ (x * y = y * x) ==>
185                                          !n m. x ** n * y ** m = y ** m * x ** n
186
187*)
188
189(* ------------------------------------------------------------------------- *)
190(* Group Definition.                                                         *)
191(* ------------------------------------------------------------------------- *)
192
193(* Set up group type as a record
194   A Group has:
195   . a carrier set (set = function 'a -> bool, since MEM is a boolean function)
196   . an identity element
197   . an inverse function (unary operation)
198   . a product function called multiplication (binary operation)
199*)
200
201(* Monoid and Group share the same type: already defined in monoid.hol
202Datatype:
203  group = <| carrier:'a -> bool;
204                  id: 'a;
205                 inv:'a -> 'a; -- by val _ = add_record_field ("inv", ``monoid_inv``);
206                mult:'a -> 'a -> 'a
207           |>
208End
209*)
210Type group = “:'a monoid”
211
212(* Define Group by Monoid
213
214   NOTE:
215val _ = overload_on ("G", ``g.carrier``);
216val _ = overload_on ("G*", ``monoid_invertibles g``);
217 *)
218Definition Group_def:
219  Group (g:'a group) <=>
220    Monoid g /\ (G* = G)
221End
222
223(* ------------------------------------------------------------------------- *)
224(* More Group Defintions.                                                    *)
225(* ------------------------------------------------------------------------- *)
226(* Abelian Group: a Group with a commutative product: x * y = y * x. *)
227Definition AbelianGroup_def:
228  AbelianGroup (g:'a group) <=>
229    Group g /\ (!x y. x IN G /\ y IN G ==> (x * y = y * x))
230End
231
232(* Finite Group: a Group with a finite carrier set. *)
233Definition FiniteGroup_def:
234  FiniteGroup (g:'a group) <=>
235    Group g /\ FINITE G
236End
237
238(* Finite Abelian Group: a Group that is both Finite and Abelian. *)
239Definition FiniteAbelianGroup_def:
240  FiniteAbelianGroup (g:'a group) <=>
241    AbelianGroup g /\ FINITE G
242End
243
244(* ------------------------------------------------------------------------- *)
245(* Basic theorems from definition.                                           *)
246(* ------------------------------------------------------------------------- *)
247
248(* Group clauses from definition, internal use *)
249val group_clauses = Group_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> GEN_ALL;
250(* > val group_clauses = |- !g. Group g ==> Monoid g /\ (G* = G) *)
251
252(* Theorem: A Group is a Monoid. *)
253(* Proof: by definition. *)
254Theorem group_is_monoid[simp] =
255  Group_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH |> CONJUNCT1 |> DISCH_ALL |> GEN_ALL;
256(* > val group_is_monoid = |- !g. Group g ==> Monoid g : thm *)
257
258
259(* Theorem: Group Invertibles is the whole carrier set. *)
260(* Proof: by definition. *)
261Theorem group_all_invertible[simp] =
262  Group_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH |> CONJUNCT2 |> DISCH_ALL |> GEN_ALL;
263(* > val group_all_invertible = |- !g. Group g ==> (G* = G) : thm *)
264
265
266(* ------------------------------------------------------------------------ *)
267(* Simple Theorems                                                          *)
268(* ------------------------------------------------------------------------ *)
269
270(* Theorem: The Invertibles of a monoid form a group. *)
271(* Proof: by checking definition. *)
272Theorem monoid_invertibles_is_group:
273    !g. Monoid g ==> Group (Invertibles g)
274Proof
275  rw[Group_def, monoid_invertibles_is_monoid] >>
276  rw[Invertibles_def, monoid_invertibles_def, EXTENSION, EQ_IMP_THM] >>
277  metis_tac[]
278QED
279
280(* Theorem: FiniteMonoid g ==> FiniteGroup (Invertibles g) *)
281(* Proof:
282   Note Monoid g /\ FINITE G            by FiniteMonoid_def
283   Let s = (Invertibles g).carrier).
284   Then s SUBSET G                      by Invertibles_subset
285    ==> FINITE s                        by SUBSET_FINITE
286   Also Group (Invertibles g)           by monoid_invertibles_is_group
287    ==> FiniteGroup (Invertibles g)     by FiniteGroup_def
288*)
289Theorem finite_monoid_invertibles_is_finite_group:
290    !g:'a monoid. FiniteMonoid g ==> FiniteGroup (Invertibles g)
291Proof
292  metis_tac[monoid_invertibles_is_group, FiniteGroup_def, FiniteMonoid_def,
293            Invertibles_subset, SUBSET_FINITE]
294QED
295
296(* Theorem: Finite Abelian Group = Finite Group /\ commutativity. *)
297(* Proof: by definitions. *)
298Theorem FiniteAbelianGroup_def_alt:
299    !g:'a group. FiniteAbelianGroup g <=>
300                FiniteGroup g /\ (!x y. x IN G /\ y IN G ==> (x * y = y * x))
301Proof
302  rw[FiniteAbelianGroup_def, FiniteGroup_def, AbelianGroup_def, EQ_IMP_THM]
303QED
304
305(* Theorem: FiniteGroup g ==> Group g *)
306(* Proof: by FiniteGroup_def *)
307Theorem finite_group_is_group:
308    !g:'a group. FiniteGroup g ==> Group g
309Proof
310  rw[FiniteGroup_def]
311QED
312
313(* Theorem: FiniteGroup g ==> Monoid g *)
314(* Proof: by finite_group_is_group, group_is_monoid *)
315Theorem finite_group_is_monoid:
316    !g:'a group. FiniteGroup g ==> Monoid g
317Proof
318  rw[FiniteGroup_def]
319QED
320
321(* Theorem: For FINITE Group is FINITE monoid. *)
322(* Proof: by group_is_monoid. *)
323Theorem finite_group_is_finite_monoid:
324    !g:'a group. FiniteGroup g ==> FiniteMonoid g
325Proof
326  rw[FiniteGroup_def, FiniteMonoid_def, group_is_monoid]
327QED
328
329(* Theorem: AbelianGroup g ==> AbelianMonoid g *)
330(* Proof: by AbelianGroup_def, AbelianMonoid_def, group_is_monoid. *)
331Theorem abelian_group_is_abelian_monoid[simp]:
332    !g. AbelianGroup g ==> AbelianMonoid g
333Proof
334  rw[AbelianGroup_def, AbelianMonoid_def]
335QED
336
337(* Theorem: FiniteAbelianGroup g ==> FiniteAbelianMonoid g *)
338(* Proof: by FiniteAbelianGroup_def, FiniteAbelianMonoid_def, abelian_group_is_abelian_monoid. *)
339Theorem finite_abelian_group_is_finite_abelian_monoid:
340    !g. FiniteAbelianGroup g ==> FiniteAbelianMonoid g
341Proof
342  rw_tac std_ss[FiniteAbelianGroup_def, FiniteAbelianMonoid_def, abelian_group_is_abelian_monoid]
343QED
344
345(* ------------------------------------------------------------------------- *)
346(* Group theorems (from Monoid).                                             *)
347(* ------------------------------------------------------------------------- *)
348
349(* Do Theorem Lifting, but no need to export. *)
350
351(* Manual Lifting:
352
353- show_assums := true;
354> val it = () : unit
355
356- monoid_id_element;
357> val it =  [] |- !g. Monoid g ==> #e IN G : thm
358- monoid_id_element |> SPEC_ALL |> UNDISCH;
359> val it =  [Monoid g] |- #e IN G : thm
360- monoid_id_element |> SPEC_ALL |> UNDISCH |> PROVE_HYP (group_is_monoid |> SPEC_ALL |> UNDISCH);
361> val it =  [Group g] |- #e IN G : thm
362- monoid_id_element |> SPEC_ALL |> UNDISCH |> PROVE_HYP (group_is_monoid |> SPEC_ALL |> UNDISCH) |> DISCH_ALL |> GEN_ALL;
363> val it =  [] |- !g. Group g ==> #e IN G : thm
364
365or
366- group_is_monoid;
367> val it =  [] |- !g. Group g ==> Monoid g : thm
368- group_is_monoid |> SPEC_ALL |> UNDISCH;
369> val it =  [Group g] |- Monoid g : thm
370- group_is_monoid |> SPEC_ALL |> UNDISCH |> MP (monoid_id_element |> SPEC_ALL);
371> val it =  [Group g] |- #e IN G : thm
372- group_is_monoid |> SPEC_ALL |> UNDISCH |> MP (monoid_id_element |> SPEC_ALL) |> DISCH_ALL |> GEN_ALL;
373> val it =  [] |- !g. Group g ==> #e IN G : thm
374
375- show_assums := false;
376> val it = () : unit
377*)
378
379(* Lifting Monoid theorem for Group.
380   from: !g:'a monoid. Monoid g ==> ....
381     to: !g:'a group.  Group g ==> ....
382    via: !g:'a group.  Group g ==> Monoid g
383*)
384local
385val gim = group_is_monoid |> SPEC_ALL |> UNDISCH
386in
387fun lift_monoid_thm suffix = let
388   val mth = DB.fetch "monoid" ("monoid_" ^ suffix)
389   val mth' = mth |> SPEC_ALL
390in
391   save_thm("group_" ^ suffix, gim |> MP mth' |> DISCH_ALL |> GEN_ALL)
392end
393end; (* local *)
394
395(* Theorem: Group identity is an element. *)
396val group_id_element = lift_monoid_thm "id_element";
397(* > val group_id_element = |- !g. Group g ==> #e IN G : thm *)
398
399(* Theorem: [Group closure] Group product is an element. *)
400val group_op_element = lift_monoid_thm "op_element";
401(* > val group_op_element = |- !g. Group g ==> !x y. x IN G /\ y IN G ==> x * y IN G : thm *)
402
403(* Theorem: [Group associativity] (x * y) * z = x * (y * z) *)
404val group_assoc = lift_monoid_thm "assoc";
405(* > val group_assoc = |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> (x * y * z = x * (y * z)) : thm *)
406
407(* Theorem: [Group left identity] #e * x = x *)
408val group_lid = lift_monoid_thm "lid";
409(* > val group_lid = |- !g. Group g ==> !x. x IN G ==> (#e * x = x) : thm *)
410
411(* Theorem: [Group right identity] x * #e = x *)
412val group_rid = lift_monoid_thm "rid";
413(* > val group_rid = |- !g. Group g ==> !x. x IN G ==> (x * #e = x) : thm *)
414
415(* Theorem: [Group identities] #e * x = x /\ x * #e = x *)
416val group_id = lift_monoid_thm "id";
417(* > val group_id = |- !g. Group g ==> !x. x IN G ==> (#e * x = x) /\ (x * #e = x) : thm *)
418
419(* Theorem: #e * #e = #e *)
420val group_id_id = lift_monoid_thm "id_id";
421(* > val group_id_id = |- !g. Group g ==> (#e * #e = #e) : thm *)
422
423(* Theorem: (x ** n) in G *)
424val group_exp_element = lift_monoid_thm "exp_element";
425(* > val group_exp_element = |- !g. Group g ==> !x. x IN G ==> !n. x ** n IN G : thm *)
426
427(* Theorem: x ** SUC n = x * x ** n *)
428Theorem group_exp_SUC = monoid_exp_SUC;
429(* > val group_exp_SUC = |- !g x. x ** SUC n = x * x ** n : thm *)
430
431(* Theorem: x ** SUC n = x ** n * x *)
432val group_exp_suc = lift_monoid_thm "exp_suc";
433(* val group_exp_suc = |- !g. Group g ==> !x. x IN G ==> !n. x ** SUC n = x ** n * x : thm *)
434
435(* Theorem: x ** 0 = #e *)
436Theorem group_exp_0 = monoid_exp_0;
437(* > val group_exp_0 = |- !g x. x ** 0 = #e : thm *)
438
439(* Theorem: x ** 1 = x *)
440val group_exp_1 = lift_monoid_thm "exp_1";
441(* > val group_exp_1 = |- !g. Group g ==> !x. x IN G ==> (x ** 1 = x) : thm *)
442
443(* Theorem: (#e ** n) = #e  *)
444val group_id_exp = lift_monoid_thm "id_exp";
445(* > val group_id_exp = |- !g. Group g ==> !n. #e ** n = #e : thm *)
446
447(* Theorem: For abelian group g,  (x ** n) * y = y * (x ** n) *)
448val group_comm_exp = lift_monoid_thm "comm_exp";
449(* > val group_comm_exp = |- !g. Group g ==> !x y. x IN G /\ y IN G ==> (x * y = y * x) ==> !n. x ** n * y = y * x ** n : thm *)
450
451(* Theorem: (x ** n) * x = x * (x ** n) *)
452val group_exp_comm = lift_monoid_thm "exp_comm";
453(* > val group_exp_comm = |- !g. Group g ==> !x. x IN G ==> !n. x ** n * x = x * x ** n : thm *)
454
455(* Theorem: For abelian group, (x * y) ** n = (x ** n) * (y ** n) *)
456val group_comm_op_exp = lift_monoid_thm "comm_op_exp";
457(* > val group_comm_op_exp = |- !g. Group g ==> !x y. x IN G /\ y IN G /\ (x * y = y * x) ==> !n. (x * y) ** n = x ** n * y ** n : thm *)
458
459(* Theorem: x ** (m + n) = (x ** m) * (x ** n) *)
460val group_exp_add = lift_monoid_thm "exp_add";
461(* > val group_exp_add = |- !g. Group g ==> !x. x IN G ==> !n k. x ** (n + k) = x ** n * x ** k : thm *)
462
463(* Theorem: x ** (m * n) = (x ** m) ** n  *)
464val group_exp_mult = lift_monoid_thm "exp_mult";
465(* > val group_exp_mult = |- !g. Group g ==> !x. x IN G ==> !n k. x ** (n * k) = (x ** n) ** k : thm *)
466
467(* ------------------------------------------------------------------------- *)
468(* Group theorems (from Monoid invertibles).                                 *)
469(* ------------------------------------------------------------------------- *)
470
471(* val _ = overload_on("|/", ``monoid_inv g``); *)
472(* val _ = overload_on("|/", ``reciprocal``); *)
473
474(* Theorem: [Group inverse element] |/ x IN G *)
475(* Proof: by Group_def and monoid_inv_def. *)
476Theorem group_inv_element[simp]:
477  !g:'a group. Group g ==> !x. x IN G ==> |/x IN G
478Proof rw[monoid_inv_def]
479QED
480
481val gim = Group_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH_ALL |> CONJUNCT1;
482val ginv = Group_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH_ALL |> CONJUNCT2;
483
484(* Theorem: [Group left inverse] |/ x * x = #e *)
485(* Proof: by Group_def and monoid_inv_def. *)
486Theorem group_linv[simp] =
487  monoid_inv_def |> SPEC_ALL |> REWRITE_RULE [gim, ginv] |> SPEC_ALL |> UNDISCH_ALL
488                 |> CONJUNCT2 |> CONJUNCT2 |> DISCH ``x IN G`` |> GEN ``x`` |> DISCH ``Group g`` |> GEN_ALL
489(* > val group_linv = |- !g. Group g ==> !x. x IN G ==> ( |/ x * x = #e) : thm *)
490
491(* Theorem: [Group right inverse] x * |/ x = #e *)
492(* Proof: by Group_def and monoid_inv_def. *)
493Theorem group_rinv[simp] =
494  monoid_inv_def |> SPEC_ALL |> REWRITE_RULE [gim, ginv] |> SPEC_ALL |> UNDISCH_ALL
495                 |> CONJUNCT2 |> CONJUNCT1 |> DISCH ``x IN G`` |> GEN ``x`` |> DISCH ``Group g`` |> GEN_ALL;
496(* > val group_rinv = |- !g. Group g ==> !x. x IN G ==> (x * |/ x = #e) : thm *)
497
498(* Theorem: [Group inverses] x * |/ x = #e /\ |/x * x = #e *)
499Theorem group_inv_thm =
500  monoid_inv_def |> SPEC_ALL |> REWRITE_RULE [gim, ginv] |> SPEC_ALL |> UNDISCH_ALL
501                 |> CONJUNCT2 |> DISCH ``x IN G`` |> GEN ``x`` |> DISCH ``Group g`` |> GEN_ALL;
502(* > val group_inv_thm = |- !g. Group g ==> !x. x IN G ==> (x * |/ x = #e) /\ ( |/ x * x = #e) : thm *)
503
504(* Theorem: [Group carrier nonempty] G <> {} *)
505val group_carrier_nonempty = lift_monoid_thm "carrier_nonempty";
506(* > val group_carrier_nonempty = |- !g. Group g ==> G <> {} : thm *)
507
508(* ------------------------------------------------------------------------- *)
509(* Group Theorems (not from Monoid).                                         *)
510(* ------------------------------------------------------------------------- *)
511
512(* Just an exercise to show that right inverse can be deduced from left inverse for Group. *)
513
514(* Theorem: [Group right inverse] x * |/ x = #e *)
515(* Proof:
516     x * |/ x
517   = #e  * (x * |/ x)                   by left identity: #e * X = X, where X = (x * |/ x)
518   = (#e * x) * |/ x                    by associativity
519   = ( |/ ( |/ x) * |/ x) * x) * |/ x   by left inverse: #e = |/ Y * Y, where Y = |/ x
520   = ( |/ ( |/ x) * ( |/ x * x)) * |/ x by associativity
521   = ( |/ ( |/ x) * #e) * |/ x          by left inverse: |/ Y * Y = #e, where Y = |/ x
522   = |/ ( |/ x) * (#e * |/ x)           by associativity
523   = |/ ( |/ x) * ( |/ x)               by left identity: #e * Y = Y, where Y = |/ x
524   = #e                                 by left inverse: |/ Y * Y = #e, where Y = |/ x
525*)
526
527(* Just an exercise to show that right identity can be deduced from left identity for Group. *)
528
529(* Theorem: [Group right identity] x * #e = x *)
530(* Proof:
531     x * #e
532   = x * ( |/ x * x)    by left inverse: |/ Y * Y = #e, where Y = x
533   = (x * |/ x) * x     by associativity
534   = #e * x             by right inverse: Y * |/ Y = #e, where Y = x
535   = x                  by left identity: #e * Y = Y, where Y = x
536*)
537
538(* Theorem: [Left cancellation] x * y = x * z <=> y = z *)
539(* Proof:
540   (wrong proof: note the <=>)
541               x * y = x * z
542   <=> |/x * (x * y) = |/x * (x * z)    this asssume left-cancellation!
543   <=> ( |/x * x) * y = ( |/x * x) * z  by group_assoc
544   <=>        #e * y = #e * z           by group_linv
545   <=>             y = z                by group_lid
546   (correct proof: note the ==>)
547   If part: x * y = x * z ==> y = z
548               x * y = x * z
549   ==> |/x * (x * y) = |/x * (x * z)    by group_inv_element
550   ==> ( |/x * x) * y = ( |/x * x) * z  by group_assoc
551   ==>        #e * y = #e * z           by group_linv
552   ==>             y = z                by group_lid
553   Only-if part: true by substitution.
554*)
555Theorem group_lcancel:
556    !g:'a group. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * y = x * z) = (y = z))
557Proof
558  rw[EQ_IMP_THM] >>
559  `( |/x * x) * y = ( |/x * x) * z` by rw[group_assoc] >>
560  metis_tac[group_linv, group_lid]
561QED
562
563(* Theorem: [Right cancellation] y * x = z * x <=> y = z *)
564(* Proof:
565   If part: y * x = z * x ==> y = z
566       y * x = z * x
567   ==> y * x * |/x = z * x * |/x      by group_inv_element
568   ==> y * (x * |/x) = z * (x * |/x)  by group_assoc
569   ==>         y * #e = z * #e        by group_rinv
570   ==>              y = z             by group_rid
571   Only-if part: true by substitution.
572*)
573Theorem group_rcancel:
574    !g:'a group. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((y * x = z * x) = (y = z))
575Proof
576  rw[EQ_IMP_THM] >>
577  `y * (x * |/x) = z * (x * |/x)` by rw[GSYM group_assoc] >>
578  metis_tac[group_rinv, group_rid]
579QED
580
581(* ------------------------------------------------------------------------- *)
582(* Inverses with assocative law.                                             *)
583(* ------------------------------------------------------------------------- *)
584
585(* Theorem: y = x * ( |/ x * y) /\ y = |/x * (x * y) *)
586(* Proof: by group_assoc and group_linv or group_rinv. *)
587Theorem group_linv_assoc:
588    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> (y = x * ( |/ x * y)) /\ (y = |/x * (x * y))
589Proof
590  rw[GSYM group_assoc]
591QED
592
593(* Theorem: y = y * |/ x * x /\ y = y * x * |/x *)
594(* Proof: by group_assoc and group_linv or group_rinv. *)
595Theorem group_rinv_assoc:
596    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> (y = y * |/ x * x) /\ (y = y * x * |/x)
597Proof
598  rw[group_assoc]
599QED
600
601(* Theorem: [Solve left unknown] x * y = z <=> x = z * |/y *)
602(* Proof:
603   If part: x * y = z ==> x = z * |/y
604     z * |/y
605   = (x * y) * |/y   by substituting z
606   = x               by group_rinv_assoc
607   Only-if part: x = z * |/y ==> x * y = z
608     x * y
609   = (z * |/y) * y   by substituting x
610   = z               by group_rinv_assoc
611*)
612Theorem group_lsolve:
613    !g:'a group. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * y = z) = (x = z * |/y))
614Proof
615  rw[group_rinv_assoc, EQ_IMP_THM]
616QED
617
618(* Theorem: [Solve left unknown] x * y = z <=> x = z * |/y *)
619(* Another proof:
620   If part: x * y = z ==> x = z * |/y
621     x * y = z
622           = z * #e           by group_rid
623           = z * ( |/y * y)   by group_linv
624           = (z * |/y) * y    by group_assc
625     hence x = z * |/y        by group_rcancel
626   Only-if part: x = z * |/y ==> x * y = z
627     x * y = (z * |/y) * y    by substituting x
628           = z * ( |/y * y)   by group_assoc
629           = z * #e           by group_linv
630           = z                by group_rid
631*)
632(* still, the first proof is easier. *)
633
634(* Theorem: [Solve right unknown] x * y = z <=> y = |/x * z *)
635(* Proof:
636   If part: x * y = z ==> y = |/x * z
637      |/x * z
638    = |/x * (x * y)    by substituting z
639    = y                by group_linv_assoc
640   Only-if part: y = |/x * z ==> x * y = z
641      x * y
642    = x ( |/x * z)     by substituting y
643    = z                by group_linv_assoc
644*)
645Theorem group_rsolve:
646    !g:'a group. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * y = z) = (y = |/x * z))
647Proof
648  rw[group_linv_assoc, EQ_IMP_THM]
649QED
650
651(* Theorem: [Left identity unique] y * x = x <=> y = #e *)
652(* Proof:
653       y * x = x
654   <=> y = x * |/x   by group_lsolve
655         = #e        by group_rinv
656   Another proof:
657       y * x = x = #e * x    by group_lid
658           y = #e            by group_rcancel
659*)
660Theorem group_lid_unique:
661    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> ((y * x = x) = (y = #e))
662Proof
663  rw[group_lsolve]
664QED
665
666(* Theorem: [Right identity unique] x * y = x <=> y = #e *)
667(* Proof:
668       x * y = x
669   <=> y = |/x * x    by group_rsolve
670         = #e         by group_linv
671*)
672Theorem group_rid_unique:
673    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> ((x * y = x) = (y = #e))
674Proof
675  rw[group_rsolve]
676QED
677
678(* Theorem: Group identity is unique. *)
679(* Proof: from group_ild_unique and group_rid_unique. *)
680Theorem group_id_unique:
681    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> ((y * x = x) = (y = #e)) /\ ((x * y = x) = (y = #e))
682Proof
683  rw[group_lid_unique, group_rid_unique]
684QED
685
686(* Note: These are stronger claims than monoid_id_unique. *)
687
688(* Theorem: [Left inverse unique] x * y = #e <=> x = |/y *)
689(* Proof:
690       x * y = #e
691   <=> x = #e * |/y    by group_lsolve
692         = |/ y        by group_lid
693*)
694Theorem group_linv_unique:
695    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> ((x * y = #e) = (x = |/y))
696Proof
697  rw[group_lsolve]
698QED
699
700(* Theorem: [Right inverse unique] x * y = #e <=> y = |/x *)
701(* Proof:
702       x * y = #e
703   <=> y = |/x * #e    by group_rsolve
704         = |/x         by group_rid
705*)
706Theorem group_rinv_unique:
707    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> ((x * y = #e) = (y = |/x))
708Proof
709  rw[group_rsolve]
710QED
711
712(* Theorem: [Inverse of inverse] |/( |/ x) = x *)
713(* Proof:
714       x * |/x = #e      by group_rinv
715   <=> x = |/x ( |/x)    by group_linv_unique
716*)
717Theorem group_inv_inv[simp]:
718    !g:'a group. Group g ==> !x. x IN G ==> ( |/( |/x) = x)
719Proof
720  metis_tac[group_rinv, group_linv_unique, group_inv_element]
721QED
722
723
724(* Theorem: [Inverse equal] |/x = |/y <=> x = y *)
725(* Proof:
726   Only-if part is trivial.
727   For the if part: |/x = |/y ==> x = y
728            |/x = |/y
729   ==> |/( |/x) = |/( |/y)
730   ==>        x = y         by group_inv_inv
731*)
732Theorem group_inv_eq[simp]:
733    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> (( |/x = |/y) = (x = y))
734Proof
735  metis_tac[group_inv_inv]
736QED
737
738
739(* Theorem: [Inverse equality swap]: |/x = y <=> x = |/y *)
740(* Proof:
741            |/x = y
742   <=> |/( |/x) = |/y
743   <=>        x = |/y    by group_inv_inv
744*)
745Theorem group_inv_eq_swap[simp]:
746    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> (( |/x = y) = (x = |/y))
747Proof
748  metis_tac[group_inv_inv]
749QED
750
751
752(* Theorem: [Inverse of identity] |/#e = #e *)
753(* Proof:
754       #e * #e = #e    by group_id_id
755   <=>      #e = |/#e  by group_linv_unique
756*)
757Theorem group_inv_id[simp]:
758    !g:'a group. Group g ==> ( |/ #e = #e)
759Proof
760  metis_tac[group_lid, group_linv_unique, group_id_element]
761QED
762
763
764(* Theorem: [Inverse equal identity] |/x = #e <=> x = #e *)
765(* Proof:
766      |/x = #e = |/#e    by group_inv_id
767   <=>  x = #e           by group_inv_eq
768*)
769Theorem group_inv_eq_id:
770    !g:'a group. Group g ==> !x. x IN G ==> (( |/x = #e) = (x = #e))
771Proof
772  rw[]
773QED
774
775(* Theorem: [Inverse of product] |/(x * y) = |/y * |/x *)
776(* Proof:
777   First show this product:
778     (x * y) * ( |/y * |/x)
779   = ((x * y) * |/y) * |/x     by group_assoc
780   = (x * (y * |/y)) * |/x     by group_assoc
781   = (x * #e) * |/x            by group_rinv
782   = x * |/x                   by group_rid
783   = #e                        by group_rinv
784   Hence |/(x y) = |/y * |/x   by group_rinv_unique.
785*)
786Theorem group_inv_op:
787    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> ( |/(x * y) = |/y * |/x)
788Proof
789  rpt strip_tac >>
790  `(x * y) * ( |/y * |/x) = x * (y * |/y) * |/x` by rw[group_assoc] >>
791  `_ = #e` by rw_tac std_ss[group_rinv, group_rid] >>
792  pop_assum mp_tac >>
793  rw[group_rinv_unique]
794QED
795
796(* Theorem: [Pair Reduction] Group g ==> (x * z) * |/ (y * z) = x * |/ y *)
797(* Proof:
798     (x * z) * |/ (y * z)
799   = (x * z) * ( |/ z * |/ y)   by group_inv_op
800   = ((x * z) * |/ z) * |/ y    by group_assoc
801   = (x * (z * |/ z)) * |/ y    by group_assoc
802   = (x * #e) * |/ y            by group_rinv
803   = x * |/ y                   by group_rid
804*)
805Theorem group_pair_reduce:
806    !g:'a group. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * z) * |/ (y * z) = x * |/ y)
807Proof
808  rpt strip_tac >>
809  `!a. a IN G ==> |/ a IN G` by rw[] >>
810  `(x * z) * |/ (y * z) = (x * z) * ( |/ z * |/ y)` by rw_tac std_ss[group_inv_op] >>
811  `_ = (x * (z * |/ z)) * |/ y` by rw[group_assoc] >>
812  `_ = (x * #e) * |/ y` by rw_tac std_ss[group_rinv] >>
813  `_ = x * |/ y` by rw_tac std_ss[group_rid] >>
814  metis_tac[]
815QED
816
817(* Theorem: The identity is a fixed point: x * x = x ==> x = #e. *)
818(* Proof:
819   For the if part:
820       x * x = x
821   ==> x * x = #e * x     by group_lid
822   ==> x = #e             by group_rcancel
823   For the only-if part:
824       #e * #e = #e       by group_id_id
825*)
826Theorem group_id_fix:
827    !g:'a group. Group g ==> !x. x IN G ==> ((x * x = x) = (x = #e))
828Proof
829  metis_tac[group_lid, group_rcancel, group_id_element]
830QED
831
832(* Theorem: Group g ==> !x y. x IN G /\ y IN G ==> (( |/ x * y = #e) <=> (x = y)) *)
833(* Proof:
834   If part: |/ x * y = #e ==> x = y
835   Note |/ x IN G                by group_inv_element
836   Given  |/ x * y = #e
837                 y = |/ ( |/ x)  by group_rinv_unique
838                   = x           by group_inv_inv
839
840   Only-if part: x = y ==> |/ x * y = #e
841       True by group_linv.
842*)
843Theorem group_op_linv_eq_id:
844    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> (( |/ x * y = #e) <=> (x = y))
845Proof
846  rw[EQ_IMP_THM] >>
847  metis_tac[group_inv_element, group_rinv_unique, group_inv_inv]
848QED
849
850(* Theorem: Group g ==> !x y. x IN G /\ y IN G ==> ((x * |/ y = #e) <=> (x = y)) *)
851(* Proof:
852   If part: x * |/ y = #e ==> x = y
853   Note |/ x IN G                by group_inv_element
854   Given  x * |/ y = #e
855                 x = |/ ( |/ y)  by group_linv_unique
856                   = y           by group_inv_inv
857
858   Only-if part: x = y ==> x * |/ y = #e
859       True by group_rinv.
860*)
861Theorem group_op_rinv_eq_id:
862    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> ((x * |/ y = #e) <=> (x = y))
863Proof
864  rw[EQ_IMP_THM] >>
865  metis_tac[group_inv_element, group_linv_unique, group_inv_inv]
866QED
867
868(* Theorem: Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> (( |/ x * y = z) <=> (y = x * z)) *)
869(* Proof:
870   Note |/ x IN G                     by group_inv_element
871                |/ x * y = z
872   <=> x * (( |/ x) * y) = x * z      by group_lcancel
873   <=>    (x * |/ x) * y = x * z      by group_assoc
874   <=>            #e * y = x * z      by group_rinv
875   <=>                 y = x * z      by group_lid
876*)
877Theorem group_op_linv_eqn:
878    !g:'a group. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> (( |/ x * y = z) <=> (y = x * z))
879Proof
880  rpt strip_tac >>
881  `|/ x IN G` by rw[] >>
882  `( |/ x * y = z) <=> (x * ( |/ x * y) = x * z)` by rw[group_lcancel] >>
883  `_ = ((x * |/ x) * y = x * z)` by rw[group_assoc] >>
884  `_ = (y = x * z)` by rw[] >>
885  rw[]
886QED
887
888(* Theorem: Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * |/ y = z) <=> (x = z * y)) *)
889(* Proof:
890   Note |/ y IN G                     by group_inv_element
891                x * |/ y = z
892   <=>    (x * |/ y) * y = z * y      by group_rcancel
893   <=>   x * ( |/ y * y) = z * y      by group_assoc
894   <=>           x * #e  = z * y      by group_linv
895   <=>                 x = z * y      by group_rid
896*)
897Theorem group_op_rinv_eqn:
898    !g:'a group. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * |/ y = z) <=> (x = z * y))
899Proof
900  rpt strip_tac >>
901  `|/ y IN G` by rw[] >>
902  `(x * |/ y = z) <=> ((x * |/ y) * y = z * y)` by rw[group_rcancel] >>
903  `_ = (x * ( |/ y * y) = z * y)` by rw[group_assoc] >>
904  `_ = (x = z * y)` by rw[] >>
905  rw[]
906QED
907
908(* Theorem: Monoid g /\ x IN G* ==> ((Invertibles g).inv x = |/ x) *)
909(* Proof:
910   Note Group (Invertibles g)             by monoid_invertibles_is_group
911    and (Invertibles g).op = g.op         by Invertibles_property
912    and (Invertibles g).id = #e           by Invertibles_property
913    and (Invertibles g).carrier = G*      by Invertibles_carrier
914    Now ( |/ x) IN G*                     by monoid_inv_invertible
915    and x * ( |/ x) = #e                  by monoid_inv_def
916    ==> |/ x = (Invertibles g).inv x      by group_rinv_unique
917*)
918Theorem Invertibles_inv:
919    !(g:'a monoid) x. Monoid g /\ x IN G* ==> ((Invertibles g).inv x = |/ x)
920Proof
921  rpt strip_tac >>
922  `Group (Invertibles g)` by rw[monoid_invertibles_is_group] >>
923  `(Invertibles g).carrier = G*` by rw[Invertibles_carrier] >>
924  `( |/ x) IN G*` by rw[monoid_inv_invertible] >>
925  `x * ( |/ x) = #e` by rw[monoid_inv_def] >>
926  metis_tac[group_rinv_unique, Invertibles_property]
927QED
928
929(* Theorem: Monoid g ==> ( |/ #e = #e) *)
930(* Proof:
931   Note Group (Invertibles g)   by monoid_invertibles_is_group
932    and #e IN G*                by monoid_id_invertible
933   Thus |/ #e
934      = (Invertibles g).inv #e                 by Invertibles_inv
935      = (Invertibles g).inv (Invertibles g).id by Invertibles_property
936      = (Invertibles g).id                     by group_inv_id
937      = #e                                     by by Invertibles_property
938*)
939Theorem monoid_inv_id:
940    !g:'a monoid. Monoid g ==> ( |/ #e = #e)
941Proof
942  rpt strip_tac >>
943  `Group (Invertibles g)` by rw[monoid_invertibles_is_group] >>
944  `(Invertibles g).id = #e` by rw[Invertibles_property] >>
945  `#e IN G*` by rw[monoid_id_invertible] >>
946  metis_tac[group_inv_id, Invertibles_inv]
947QED
948
949(* ------------------------------------------------------------------------- *)
950(* Group Defintion without explicit mention of Monoid.                       *)
951(* ------------------------------------------------------------------------- *)
952
953(* Theorem: [Alternative Definition]
954      Group g <=> #e IN G /\
955               (!x y::(G). x * y IN G) /\
956               (!x::(G). |/x IN G) /\
957               (!x::(G). #e * x = x) /\
958               (!x::(G). |/x * x = #e) /\
959               (!x y z::(G). (x * y) * z = x * (y * z)) *)
960(* Proof:
961   Monoid needs the right identity:
962     x * #e
963   = (#e * x) * #e      by #e * x = x          left_identity
964   = (x''x')x(x'x)      by #e = x' x = x'' x'  left_inverse
965   = x''(x'x)(x'x)      by associativity
966   = x''(x'x)           by #e * (x'x) = x'x    left_identity
967   = (x''x')x           by associativity
968   = #e * x             by #e = x''x'          left_inverse
969   = x                  by #e * x = x          left_identity
970   monoid_invertibles need right inverse:
971     x * x'
972   = (#e * x) * x'      by #e * x = x          left_identity
973   = (x'' x')* x * x'   by #e = x''x'          left_inverse
974   = x'' (x' x) x'      by associativity
975   = x'' x'             by #e = x'x            left_inverse
976   = #e                 by #e = x''x'          left_inverse
977*)
978Theorem group_def_alt:
979    !g:'a group. Group g <=>
980        (!x y. x IN G /\ y IN G ==> x * y IN G) /\
981        (!x y z. x IN G /\ y IN G /\ z IN G ==> ((x * y) * z = x * (y * z))) /\
982         #e IN G /\
983        (!x. x IN G ==> (#e * x = x)) /\
984        (!x. x IN G ==> ?y. y IN G /\ (y * x = #e))
985Proof
986  rw[group_assoc, EQ_IMP_THM] >-
987  metis_tac[group_linv, group_inv_element] >>
988  rw_tac std_ss[Group_def, Monoid_def, monoid_invertibles_def, EXTENSION, EQ_IMP_THM, GSPECIFICATION] >| [
989    `?y. y IN G /\ (y * x = #e)` by metis_tac[] >>
990    `?z. z IN G /\ (z * y = #e)` by metis_tac[] >>
991    `z * y * x = z * (y * x)` by rw_tac std_ss[],
992    `?y. y IN G /\ (y * x = #e)` by metis_tac[] >>
993    `?z. z IN G /\ (z * y = #e)` by metis_tac[] >>
994    `z * y * x = z * (y * x)` by rw_tac std_ss[] >>
995    `z * #e * y = z * (#e * y)` by rw_tac std_ss[]
996  ] >> metis_tac[]
997QED
998
999(* Theorem: Group g <=> Monoid g /\ (!x. x IN G ==> ?y. y IN G /\ (y * x = #e)) *)
1000(* Proof:
1001   By Group_def and EXTENSION this is to show:
1002   (1) G* = G /\ x IN G ==> ?y. y IN G /\ (y * x = #e)
1003       Note x IN G ==> x IN G*          by G* = G
1004        ==> ?y. y IN G /\ (y * x = #e)  by monoid_invertibles_element
1005   (2) x IN G* ==> x IN G
1006       Note x IN G* ==> x IN G          by monoid_invertibles_element
1007   (3) (!x. x IN G ==> ?y. y IN G /\ (g.op y x = #e)) /\ x IN G ==> x IN G*
1008       Note ?y. y IN G /\ (y * x = #e)  by x IN G
1009         so ?z. z IN G /\ (z * y = #e)  by y IN G
1010            x
1011          = #e * x                      by monoid_lid
1012          = (z * y) * x                 by #e = z * y
1013          = z * (y * x)                 by monoid_assoc
1014          = z * #e                      by #e = y * x
1015          = z                           by monoid_rid
1016       Thus ?y. y * x = #e  /\ x * y = #e
1017         or x IN G*                     by monoid_invertibles_element
1018*)
1019Theorem group_def_by_inverse:
1020    !g:'a group. Group g <=> Monoid g /\ (!x. x IN G ==> ?y. y IN G /\ (y * x = #e))
1021Proof
1022  rw_tac std_ss[Group_def, EXTENSION, EQ_IMP_THM] >-
1023  metis_tac[monoid_invertibles_element] >-
1024  metis_tac[monoid_invertibles_element] >>
1025  `?y. y IN G /\ (y * x = #e)` by rw[] >>
1026  `?z. z IN G /\ (z * y = #e)` by rw[] >>
1027  `z * y * x = z * (y * x)` by rw_tac std_ss[monoid_assoc] >>
1028  `x = z` by metis_tac[monoid_lid, monoid_rid] >>
1029  metis_tac[monoid_invertibles_element]
1030QED
1031
1032(* Alternative concise definition of a group. *)
1033
1034(* Theorem: Group g <=>
1035            (!x y::G. x * y IN G) /\
1036            (!x y z::G. x * y * z = x * (y * z)) /\
1037             #e IN G /\ (!x::G. #e * x = x) /\
1038             !x::G. |/ x IN G /\ |/ x * x = #e *)
1039(* Proof: by group_def_alt, group_inv_element. *)
1040Theorem group_alt:
1041  !(g:'a group). Group g <=>
1042          (!x y::G. x * y IN G) /\ (* closure *)
1043          (!x y z::G. x * y * z = x * (y * z)) /\ (* associativity *)
1044          #e IN G /\ (!x::G. #e * x = x) /\ (* identity *)
1045          !x::G. |/ x IN G /\ |/ x * x = #e
1046Proof
1047  rw[group_def_alt, group_inv_element, EQ_IMP_THM] >>
1048  metis_tac[]
1049QED
1050
1051(* ------------------------------------------------------------------------- *)
1052(* Transformation of Group structure by modifying carrier.                   *)
1053(* Useful for Field and Field Instances, include or exclude zero.            *)
1054(* ------------------------------------------------------------------------- *)
1055
1056(* Include an element z (zero) for the carrier, usually putting group to monoid. *)
1057Definition including_def[nocompute]:
1058   including (g:'a group) (z:'a) :'a monoid =
1059      <| carrier := G UNION {z};
1060              op := g.op;
1061              id := g.id
1062       |>
1063End
1064val _ = set_fixity "including" (Infixl 600); (* like division / *)
1065(* > val including_def = |- !g z. including g z = <|carrier := G UNION {z}; op := $*; id := #e|> : thm *)
1066
1067(* Exclude an element z (zero) from the carrier, usually putting monoid to group. *)
1068Definition excluding_def[nocompute]:
1069   excluding (g:'a monoid) (z:'a) :'a group =
1070      <| carrier := G DIFF {z};
1071              op := g.op;
1072              id := g.id
1073       |>
1074End
1075val _ = set_fixity "excluding" (Infixl 600); (* like division / *)
1076(* > val excluding_def = |- !g z. excluding g z = <|carrier := G DIFF {z}; op := $*; id := #e|> : thm *)
1077(*
1078- type_of ``g including z``;
1079> val it = ``:'a group`` : hol_type
1080- type_of ``g excluding z``;
1081> val it = ``:'a group`` : hol_type
1082*)
1083
1084(* Theorem: (g including z).op = g.op /\ (g including z).id = g.id /\
1085            !x. x IN (g including z).carrier = x IN G \/ (x = z) *)
1086(* Proof: by IN_UNION, IN_SING. *)
1087Theorem group_including_property:
1088    !g:'a group. !z:'a. ((g including z).op = g.op) /\
1089                        ((g including z).id = g.id) /\
1090                        (!x. x IN (g including z).carrier ==> x IN G \/ (x = z))
1091Proof
1092  rw[including_def]
1093QED
1094
1095(* Theorem: (g excluding z).op = g.op /\ (g excluding z).id = g.id /\
1096            !x. x IN (g excluding z).carrier = x IN G /\ (x <> z) *)
1097(* Proof: by IN_DIFF, IN_SING. *)
1098Theorem group_excluding_property:
1099    !g:'a group. !z:'a. ((g excluding z).op = g.op) /\
1100                        ((g excluding z).id = g.id) /\
1101                        (!x. x IN (g excluding z).carrier ==> x IN G /\ (x <> z))
1102Proof
1103  rw[excluding_def]
1104QED
1105
1106(* Theorem: ((g including z) excluding z).op = g.op /\ ((g including z) excluding z).id = g.id /\
1107            If z NOTIN G, then ((g including z) excluding z).carrier = G. *)
1108(* Proof:
1109   If z NOTIN G,
1110   then G UNION {z} DIFF {z} = G    by IN_UNION, IN_DIFF, IN_SING.
1111*)
1112Theorem group_including_excluding_property:
1113    !g:'a group. !z:'a. (((g including z) excluding z).op = g.op) /\
1114                        (((g including z) excluding z).id = g.id) /\
1115                        (z NOTIN G ==> (((g including z) excluding z).carrier = G))
1116Proof
1117  rw_tac std_ss[including_def, excluding_def] >>
1118  rw[EXTENSION, EQ_IMP_THM] >>
1119  metis_tac[]
1120QED
1121
1122(* Theorem: If z NOTIN G, then Group g = Group ((g including z) excluding z). *)
1123(* Proof: by group_including_excluding_property. *)
1124Theorem group_including_excluding_group:
1125    !g:'a group. !z:'a. z NOTIN G ==> (Group g = Group ((g including z) excluding z))
1126Proof
1127  rw_tac std_ss[group_def_alt, group_including_excluding_property]
1128QED
1129
1130(* Theorem: If z NOTIN G, then AbelianGroup g = AbelianGroup ((g including z) excluding z). *)
1131(* Proof: by group_including_excluding_property. *)
1132Theorem group_including_excluding_abelian:
1133    !g:'a group. !z:'a. z NOTIN G ==> (AbelianGroup g = AbelianGroup ((g including z) excluding z))
1134Proof
1135  rw_tac std_ss[AbelianGroup_def, group_def_alt, group_including_excluding_property]
1136QED
1137
1138(* Theorem: g including z excluding z explicit expression. *)
1139(* Proof: by definition. *)
1140Theorem group_including_excluding_eqn:
1141    !g:'a group. !z:'a. g including z excluding z = if z IN G then <| carrier := G DELETE z; op := g.op; id := g.id |> else g
1142Proof
1143  rw[including_def, excluding_def] >| [
1144    rw[EXTENSION] >>
1145    metis_tac[],
1146    rw[monoid_component_equality] >>
1147    rw[EXTENSION] >>
1148    metis_tac[]
1149  ]
1150QED
1151(* better -- Michael's solution *)
1152Theorem group_including_excluding_eqn[allow_rebind]:
1153  !g:'a group. !z:'a. g including z excluding z =
1154                      if z IN G then <| carrier := G DELETE z;
1155                                        op := g.op;
1156                                        id := g.id |>
1157                      else g
1158Proof
1159  rw[including_def, excluding_def] >>
1160  rw[monoid_component_equality] >>
1161  rw[EXTENSION] >> metis_tac[]
1162QED
1163
1164(* Theorem: (g excluding z).op = g.op *)
1165(* Proof: by definition. *)
1166Theorem group_excluding_op[simp]:
1167    !g:'a group. !z:'a. (g excluding z).op = g.op
1168Proof
1169  rw_tac std_ss[excluding_def]
1170QED
1171
1172val _ = computeLib.add_persistent_funs ["group_excluding_op"];
1173
1174(* Theorem: (g excluding z).exp x n = x ** n *)
1175(* Proof:
1176   By induction on n.
1177   Base: (g excluding z).exp x 0 = x ** 0
1178           (g excluding z).exp x 0
1179         = (g excluding z).id            by group_exp_0
1180         = #e                            by group_excluding_property
1181         = x ** 0                        by group_exp_0
1182   Step: (g excluding z).exp x n = x ** n ==> (g excluding z).exp x (SUC n) = x ** SUC n
1183         (g excluding z).exp x (SUC n)
1184       = (g excluding z).op x (g excluding z).exp x n   by group_exp_SUC
1185       = (g excluding z).op x (x ** n)                  by induction hypothesis
1186       = x * (x ** n)                                   by group_excluding_property
1187       = x ** SUC n                                     by group_exp_SUC
1188*)
1189Theorem group_excluding_exp:
1190    !(g:'a group) z x n. (g excluding z).exp x n = x ** n
1191Proof
1192  rpt strip_tac >>
1193  Induct_on `n` >>
1194  rw[group_excluding_property]
1195QED
1196
1197(* Theorem: AbelianMonoid g ==>
1198           !z. z NOTIN G* ==> (monoid_invertibles (g excluding z) = G* ) *)
1199(* Proof:
1200   By monoid_invertibles_def, excluding_def, EXTENSION, this is to show:
1201   (1) x IN G /\ y IN G /\ y * x = #e ==> ?y. y IN G /\ (x * y = #e) /\ (y * x = #e)
1202       True by properties of AbelianMonoid g.
1203   (2) z NOTIN G* /\ x IN G /\ y IN G /\ x * y = #e /\ y * x = #e ==> x <> z
1204       Note x IN G*                   by monoid_invertibles_element
1205       But  z NOTIN G*, so x <> z.
1206   (3) x IN G /\ y IN G /\ x * y = #e /\ y * x = #e ==> ?y. (y IN G /\ y <> z) /\ (x * y = #e) /\ (y * x = #e)
1207       Take the same y, then y <> z   by monoid_invertibles_element
1208*)
1209Theorem abelian_monoid_invertible_excluding:
1210    !g:'a monoid. AbelianMonoid g ==>
1211   !z. z NOTIN G* ==> (monoid_invertibles (g excluding z) = G* )
1212Proof
1213  rw_tac std_ss[AbelianMonoid_def] >>
1214  rw[monoid_invertibles_def, excluding_def, EXTENSION] >>
1215  rw[EQ_IMP_THM] >-
1216  metis_tac[] >-
1217  metis_tac[monoid_invertibles_element] >>
1218  metis_tac[monoid_invertibles_element]
1219QED
1220
1221(* ------------------------------------------------------------------------- *)
1222(* Group Exponentiation with Inverses.                                       *)
1223(* ------------------------------------------------------------------------- *)
1224
1225(* Theorem: Inverse of exponential:  |/(x ** n) = ( |/x) ** n *)
1226(* Proof:
1227   By induction on n.
1228   Base case: |/ (x ** 0) = |/ x ** 0
1229     |/ (x ** 0)
1230   = |/ #e            by group_exp_zero
1231   = #e               by group_inv_id
1232   = ( |/ #e) ** 0    by group_exp_zero
1233   Step case: |/ (x ** n) = |/ x ** n ==> |/ (x ** SUC n) = |/ x ** SUC n
1234     |/ (x ** SUC n)
1235   = |/ (x * (x ** n))        by group_exp_SUC
1236   = ( |/ (x ** n)) * ( |/x)  by group_inv_op
1237   = ( |/x) ** n * ( |/x)     by inductive hypothesis
1238   = ( |/x) * ( |/x) ** n     by group_exp_comm
1239   = ( |/x) ** SUC n          by group_exp_SUC
1240*)
1241Theorem group_exp_inv:
1242    !g:'a group. Group g ==> !x. x IN G ==> !n. |/ (x ** n) = ( |/ x) ** n
1243Proof
1244  rpt strip_tac >>
1245  Induct_on `n` >-
1246  rw[] >>
1247  rw_tac std_ss[group_exp_SUC, group_inv_op, group_exp_comm, group_inv_element, group_exp_element]
1248QED
1249
1250(* Theorem: Exponential of Inverse:  ( |/x) ** n = |/(x ** n) *)
1251(* Proof: by group_exp_inv. *)
1252Theorem group_inv_exp:
1253    !g:'a group. Group g ==> !x. x IN G ==> !n. ( |/ x) ** n = |/ (x ** n)
1254Proof
1255  rw[group_exp_inv]
1256QED
1257
1258(* Theorem: For m < n, x ** m = x ** n ==> x ** (n-m) = #e *)
1259(* Proof:
1260     x ** (n-m) * x ** m
1261   = x ** ((n-m) + m)         by group_exp_add
1262   = x ** n                   by arithmetic, m < n
1263   = x ** m                   by given
1264   Hence x ** (n-m) = #e      by group_lid_unique
1265*)
1266Theorem group_exp_eq:
1267    !g:'a group. Group g ==> !x. x IN G ==> !m n. m < n /\ (x ** m = x ** n) ==> (x ** (n-m) = #e)
1268Proof
1269  rpt strip_tac >>
1270  `(n-m) + m = n` by decide_tac >>
1271  `x ** (n-m) * x ** m = x ** ((n-m) + m)` by rw_tac std_ss[group_exp_add] >>
1272  pop_assum mp_tac >>
1273  rw_tac std_ss[group_lid_unique, group_exp_element]
1274QED
1275
1276(* Theorem: Group g /\ x IN G ==> (x ** m) ** n = (x ** n) ** m *)
1277(* Proof:
1278     (x ** m) ** n
1279   = x ** (m * n)    by group_exp_mult
1280   = x ** (n * m)    by MULT_COMM
1281   = (x ** n) ** m   by group_exp_mult
1282*)
1283Theorem group_exp_mult_comm:
1284    !g:'a group. Group g ==> !x. x IN G ==> !m n. (x ** m) ** n = (x ** n) ** m
1285Proof
1286  metis_tac[group_exp_mult, MULT_COMM]
1287QED
1288
1289(* group_exp_mult is exported, never export a commutative version. *)
1290
1291(* Theorem: Group /\ x IN G /\ y IN G /\ x * y = y * x ==> (x ** n) * (y ** m) = (y ** m) * (x ** n) *)
1292(* Proof:
1293   By inducton on  m.
1294   Base case: x ** n * y ** 0 = y ** 0 * x ** n
1295   LHS = x ** n * y ** 0
1296       = x ** n * #e         by group_exp_0
1297       = x ** n              by group_rid
1298       = #e * x ** n         by group_lid
1299       = y ** 0 * x ** n     by group_exp_0
1300       = RHS
1301   Step case: x ** n * y ** m = y ** m * x ** n ==> x ** n * y ** SUC m = y ** SUC m * x ** n
1302   LHS = x ** n * y ** SUC m
1303       = x ** n * (y * y ** m)    by group_exp_SUC
1304       = (x ** n * y) * y ** m    by group_assoc
1305       = (y * x ** n) * y ** m    by group_comm_exp (with single y)
1306       = y * (x ** n * y ** m)    by group_assoc
1307       = y * (y ** m * x ** n)    by induction hypothesis
1308       = (y * y ** m) * x ** n    by group_assoc
1309       = y ** SUC m  * x ** n     by group_exp_SUC
1310       = RHS
1311*)
1312Theorem group_comm_exp_exp:
1313    !g:'a group. Group g ==> !x y. x IN G /\ y IN G /\ (x * y = y * x) ==> !n m. x ** n * y ** m = y ** m * x ** n
1314Proof
1315  rpt strip_tac >>
1316  Induct_on `m` >-
1317  rw[] >>
1318  `x ** n * y ** SUC m = x ** n * (y * y ** m)` by rw[] >>
1319  `_ = (x ** n * y) * y ** m` by rw[group_assoc] >>
1320  `_ = (y * x ** n) * y ** m` by metis_tac[group_comm_exp] >>
1321  `_ = y * (x ** n * y ** m)` by rw[group_assoc] >>
1322  `_ = y * (y ** m * x ** n)` by metis_tac[] >>
1323  rw[group_assoc]
1324QED
1325
1326(* ------------------------------------------------------------------------- *)
1327(* Group Maps Documentation                                                  *)
1328(* ------------------------------------------------------------------------- *)
1329(* Overloading:
1330   homo_group g f   = homo_monoid g f
1331*)
1332(* Definitions and Theorems (# are exported):
1333
1334   Homomorphisms, isomorphisms, endomorphisms, automorphisms and subgroups:
1335   GroupHomo_def   |- !f g h. GroupHomo f g h <=> (!x. x IN G ==> f x IN h.carrier) /\
1336                                                   !x y. x IN G /\ y IN G ==> (f (x * y) = h.op (f x) (f y))
1337   GroupIso_def    |- !f g h. GroupIso f g h <=> GroupHomo f g h /\ BIJ f G h.carrier
1338   GroupEndo_def   |- !f g. GroupEndo f g <=> GroupHomo f g g
1339   GroupAuto_def   |- !f g. GroupAuto f g <=> GroupIso f g g
1340   subgroup_def    |- !h g. subgroup h g <=> GroupHomo I h g
1341
1342   Group Homomorphisms:
1343   group_homo_id       |- !f g h. Group g /\ Group h /\ GroupHomo f g h ==> (f #e = h.id)
1344   group_homo_element  |- !f g h. GroupHomo f g h ==> !x. x IN G ==> f x IN h.carrier
1345   group_homo_inv      |- !f g h. Group g /\ Group h /\ GroupHomo f g h ==> !x. x IN G ==> (f ( |/ x) = h.inv (f x))
1346   group_homo_cong     |- !g h. Group g /\ Group h /\ (!x. x IN G ==> (f1 x = f2 x)) ==>
1347                                (GroupHomo f1 g h <=> GroupHomo f2 g h)
1348   group_homo_I_refl   |- !g. GroupHomo I g g
1349   group_homo_trans    |- !g h k f1 f2. GroupHomo f1 g h /\ GroupHomo f2 h k ==> GroupHomo (f2 o f1) g k
1350   group_homo_sym      |- !g h f. Group g /\ GroupHomo f g h /\ BIJ f G h.carrier ==> GroupHomo (LINV f G) h g
1351   group_homo_compose  |- !g h k f1 f2. GroupHomo f1 g h /\ GroupHomo f2 h k ==> GroupHomo (f2 o f1) g k
1352   group_homo_is_monoid_homo
1353                       |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==> MonoidHomo f g h
1354   group_homo_monoid_homo
1355                       |- !f g h. GroupHomo f g h /\ f #e = h.id <=> MonoidHomo f g h
1356   group_homo_exp      |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==>
1357                          !x. x IN G ==> !n. f (x ** n) = h.exp (f x) n
1358
1359   Group Isomorphisms:
1360   group_iso_property  |- !f g h. GroupIso f g h <=>
1361                                  GroupHomo f g h /\ !y. y IN h.carrier ==> ?!x. x IN G /\ (f x = y)
1362   group_iso_id        |- !f g h. Group g /\ Group h /\ GroupIso f g h ==> (f #e = h.id)
1363   group_iso_element   |- !f g h. GroupIso f g h ==> !x. x IN G ==> f x IN h.carrier
1364   group_iso_I_refl    |- !g. GroupIso I g g
1365   group_iso_trans     |- !g h k f1 f2. GroupIso f1 g h /\ GroupIso f2 h k ==> GroupIso (f2 o f1) g k
1366   group_iso_sym       |- !g h f. Group g /\ GroupIso f g h ==> GroupIso (LINV f G) h g
1367   group_iso_compose   |- !g h k f1 f2. GroupIso f1 g h /\ GroupIso f2 h k ==> GroupIso (f2 o f1) g k
1368   group_iso_is_monoid_iso
1369                       |- !g h f. Group g /\ Group h /\ GroupIso f g h ==> MonoidIso f g h
1370   group_iso_monoid_iso|- !f g h. GroupIso f g h /\ f #e = h.id <=> MonoidIso f g h
1371   group_iso_exp       |- !g h f. Group g /\ Group h /\ GroupIso f g h ==>
1372                          !x. x IN G ==> !n. f (x ** n) = h.exp (f x) n
1373   group_iso_order     |- !g h f. Group g /\ Group h /\ GroupIso f g h ==>
1374                          !x. x IN G ==> (order h (f x) = ord x)
1375   group_iso_linv_iso  |- !g h f. Group g /\ GroupIso f g h ==> GroupIso (LINV f G) h g
1376   group_iso_bij       |- !g h f. GroupIso f g h ==> BIJ f G h.carrier
1377   group_iso_group     |- !g h f. Group g /\ GroupIso f g h /\ (f #e = h.id) ==> Group h
1378   group_iso_card_eq   |- !g h f. GroupIso f g h /\ FINITE G ==> (CARD G = CARD h.carrier)
1379
1380   Group Automorphisms:
1381   group_auto_id       |- !f g. Group g /\ GroupAuto f g ==> (f #e = #e)
1382   group_auto_element  |- !f g. GroupAuto f g ==> !x. x IN G ==> f x IN G
1383   group_auto_compose  |- !g f1 f2. GroupAuto f1 g /\ GroupAuto f2 g ==> GroupAuto (f1 o f2) g
1384   group_auto_is_monoid_auto
1385                       |- !g f. Group g /\ GroupAuto f g ==> MonoidAuto f g
1386   group_auto_exp      |- !g f. Group g /\ GroupAuto f g ==>
1387                          !x. x IN G ==> !n. f (x ** n) = f x ** n
1388   group_auto_order    |- !g f. Group g /\ GroupAuto f g ==>
1389                          !x. x IN G ==> (ord (f x) = ord x)
1390   group_auto_I        |- !g. GroupAuto I g
1391   group_auto_linv_auto|- !g f. Group g /\ GroupAuto f g ==> GroupAuto (LINV f G) g
1392   group_auto_bij      |- !g f. GroupAuto f g ==> f PERMUTES G
1393
1394   Subgroups:
1395   subgroup_eqn             |- !g h. subgroup h g <=> H SUBSET G /\
1396                               !x y. x IN H /\ y IN H ==> (h.op x y = x * y)
1397   subgroup_subset          |- !g h. subgroup h g ==> H SUBSET G
1398   subgroup_homo_homo       |- !g h k f. subgroup h g /\ GroupHomo f g k ==> GroupHomo f h k
1399   subgroup_reflexive       |- !g. subgroup g g
1400   subgroup_transitive      |- !g h k. subgroup g h /\ subgroup h k ==> subgroup g k
1401   subgroup_I_antisym       |- !g h. subgroup h g /\ subgroup g h ==> GroupIso I h g
1402   subgroup_carrier_antisym |- !g h. subgroup h g /\ G SUBSET H ==> GroupIso I h g
1403   subgroup_is_submonoid    |- !g h. Group g /\ Group h /\ subgroup h g ==> submonoid h g
1404   subgroup_order_eqn       |- !g h. Group g /\ Group h /\ subgroup h g ==>
1405                               !x. x IN H ==> (order h x = ord x)
1406
1407   Homomorphic Image of a Group:
1408   homo_group_closure |- !g f. Group g /\ GroupHomo f g (homo_group g f) ==>
1409                         !x y. x IN fG /\ y IN fG ==> x o y IN fG
1410   homo_group_assoc   |- !g f. Group g /\ GroupHomo f g (homo_group g f) ==>
1411                         !x y z. x IN fG /\ y IN fG /\ z IN fG ==> ((x o y) o z = x o y o z)
1412   homo_group_id      |- !g f. Group g /\ GroupHomo f g (homo_group g f) ==> #i IN fG /\
1413                         !x. x IN fG ==> (#i o x = x) /\ (x o #i = x)
1414   homo_group_inv     |- !g f. Group g /\ GroupHomo f g (homo_group g f) ==>
1415                         !x. x IN fG ==> ?z. z IN fG /\ (z o x = #i)
1416   homo_group_group   |- !g f. Group g /\ GroupHomo f g (homo_group g f) ==> Group (homo_group g f)
1417   homo_group_comm    |- !g f. AbelianGroup g /\ GroupHomo f g (homo_group g f) ==>
1418                         !x y. x IN fG /\ y IN fG ==> (x o y = y o x)
1419   homo_group_abelian_group  |- !g f. AbelianGroup g /\ GroupHomo f g (homo_group g f) ==>
1420                                      AbelianGroup (homo_group g f)
1421   homo_group_by_inj         |- !g f. Group g /\ INJ f G univ(:'b) ==> GroupHomo f g (homo_group g f)
1422
1423   Injective Image of Group:
1424   group_inj_image_group           |- !g f. Group g /\ INJ f G univ(:'b) ==> Group (monoid_inj_image g f)
1425   group_inj_image_abelian_group   |- !g f. AbelianGroup g /\ INJ f G univ(:'b) ==> AbelianGroup (monoid_inj_image g f)
1426   group_inj_image_excluding_group
1427                               |- !g f e. Group (g excluding e) /\ INJ f G univ(:'b) /\ e IN G ==>
1428                                          Group (monoid_inj_image g f excluding f e)
1429   group_inj_image_excluding_abelian_group
1430                               |- !g f e. AbelianGroup (g excluding e) /\ INJ f G univ(:'b) /\ e IN G ==>
1431                                          AbelianGroup (monoid_inj_image g f excluding f e)
1432   group_inj_image_group_homo  |- !g f. INJ f G univ(:'b) ==> GroupHomo f g (monoid_inj_image g f)
1433*)
1434
1435(* ------------------------------------------------------------------------- *)
1436(* Homomorphisms, isomorphisms, endomorphisms, automorphisms and subgroups.  *)
1437(* ------------------------------------------------------------------------- *)
1438
1439(* A function f from g to h is a homomorphism if group properties are preserved. *)
1440(* For group, no need to ensure that identity is preserved, see group_homo_id.   *)
1441
1442Definition GroupHomo_def:
1443  GroupHomo (f:'a -> 'b) (g:'a group) (h:'b group) <=>
1444    (!x. x IN G ==> f x IN h.carrier) /\
1445    (!x y. x IN G /\ y IN G ==> (f (x * y) = h.op (f x) (f y)))
1446    (* no requirement for: f #e = h.id *)
1447End
1448
1449(* A function f from g to h is an isomorphism if f is a bijective homomorphism. *)
1450Definition GroupIso_def:
1451  GroupIso f g h <=> GroupHomo f g h /\ BIJ f G h.carrier
1452End
1453
1454(* A group homomorphism from g to g is an endomorphism. *)
1455Definition GroupEndo_def:   GroupEndo f g <=> GroupHomo f g g
1456End
1457
1458(* A group isomorphism from g to g is an automorphism. *)
1459Definition GroupAuto_def:   GroupAuto f g <=> GroupIso f g g
1460End
1461
1462(* A subgroup h of g if identity is a homomorphism from h to g *)
1463Definition subgroup_def:   subgroup h g <=> GroupHomo I h g
1464End
1465
1466(* ------------------------------------------------------------------------- *)
1467(* Group Homomorphisms                                                       *)
1468(* ------------------------------------------------------------------------- *)
1469
1470(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==> f #e = h.id *)
1471(* Proof:
1472   Since #e IN G                     by group_id_element,
1473   f (#e * #e) = h.op (f #e) (f #e)  by GroupHomo_def
1474   f #e = h.op (f #e) (f #e)         by group_id_id
1475   ==> f #e = h.id                   by group_id_fix
1476*)
1477Theorem group_homo_id:
1478    !f g h. Group g /\ Group h /\ GroupHomo f g h ==> (f #e = h.id)
1479Proof
1480  rw_tac std_ss[GroupHomo_def] >>
1481  `#e IN G` by rw[] >>
1482  metis_tac[group_id_fix, group_id_id]
1483QED
1484
1485(* Theorem: GroupHomo f g h ==> !x. x IN G ==> f x IN h.carrier *)
1486(* Proof: by GroupHomo_def *)
1487Theorem group_homo_element:
1488    !f g h. GroupHomo f g h ==> !x. x IN G ==> f x IN h.carrier
1489Proof
1490  rw_tac std_ss[GroupHomo_def]
1491QED
1492
1493(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==> f ( |/x) = h.inv (f x) *)
1494(* Proof:
1495   Since |/x IN G                      by group_inv_element
1496   f ( |/x * x) = h.op (f |/x) (f x)   by GroupHomo_def
1497   f (#e) = h.op (f |/x) (f x)         by group_linv
1498     h.id = h.op (f |/x) (f x)         by group_homo_id
1499   ==> f |/x = h.inv (f x)             by group_linv_unique
1500*)
1501Theorem group_homo_inv:
1502    !f g h. Group g /\ Group h /\ GroupHomo f g h ==> !x. x IN G ==> (f ( |/x) = h.inv (f x))
1503Proof
1504  rpt strip_tac >>
1505  `|/x IN G` by rw_tac std_ss[group_inv_element] >>
1506  `f x IN h.carrier /\ f ( |/x) IN h.carrier` by metis_tac[GroupHomo_def] >>
1507  `h.op (f ( |/x)) (f x) = f ( |/x * x)` by metis_tac[GroupHomo_def] >>
1508  metis_tac[group_linv_unique, group_homo_id, group_linv]
1509QED
1510
1511(* Theorem: Group g /\ Group h /\ (!x. x IN G ==> (f1 x = f2 x)) ==> (GroupHomo f1 g h = GroupHomo f2 g h) *)
1512(* Proof: by GroupHomo_def, group_op_element *)
1513Theorem group_homo_cong:
1514    !(g:'a group) (h:'b group) f1 f2. Group g /\ Group h /\ (!x. x IN G ==> (f1 x = f2 x)) ==>
1515          (GroupHomo f1 g h = GroupHomo f2 g h)
1516Proof
1517  rw_tac std_ss[GroupHomo_def, EQ_IMP_THM] >-
1518  metis_tac[group_op_element] >>
1519  metis_tac[group_op_element]
1520QED
1521
1522(* Theorem: GroupHomo I g g *)
1523(* Proof: by GroupHomo_def. *)
1524Theorem group_homo_I_refl:
1525    !g:'a group. GroupHomo I g g
1526Proof
1527  rw[GroupHomo_def]
1528QED
1529
1530(* Theorem: GroupHomo f1 g h /\ GroupHomo f2 h k ==> GroupHomo f2 o f1 g k *)
1531(* Proof: true by GroupHomo_def. *)
1532Theorem group_homo_trans:
1533    !(g:'a group) (h:'b group) (k:'c group).
1534    !f1 f2. GroupHomo f1 g h /\ GroupHomo f2 h k ==> GroupHomo (f2 o f1) g k
1535Proof
1536  rw[GroupHomo_def]
1537QED
1538
1539(* Theorem: Group g /\ GroupHomo f g h /\ BIJ f G h.carrier ==> GroupHomo (LINV f G) h g *)
1540(* Proof:
1541   Note BIJ f G h.carrier
1542    ==> BIJ (LINV f G) h.carrier G     by BIJ_LINV_BIJ
1543   By GroupHomo_def, this is to show:
1544   (1) x IN h.carrier ==> LINV f G x IN G
1545       With BIJ (LINV f G) h.carrier G
1546        ==> INJ (LINV f G) h.carrier G           by BIJ_DEF
1547        ==> x IN h.carrier ==> LINV f G x IN G   by INJ_DEF
1548   (2) x IN h.carrier /\ y IN h.carrier ==> LINV f G (h.op x y) = LINV f G x * LINV f G y
1549       With x IN h.carrier
1550        ==> ?x1. (x = f x1) /\ x1 IN G           by BIJ_DEF, SURJ_DEF
1551       With y IN h.carrier
1552        ==> ?y1. (y = f y1) /\ y1 IN G           by BIJ_DEF, SURJ_DEF
1553        and x1 * y1 IN G                         by group_op_element
1554            LINV f G (h.op x y)
1555          = LINV f G (f (x1 * y1))                  by GroupHomo_def
1556          = x1 * y1                                 by BIJ_LINV_THM, x1 * y1 IN G
1557          = (LINV f G (f x1)) * (LINV f G (f y1))   by BIJ_LINV_THM, x1 IN G, y1 IN G
1558          = (LINV f G x) * (LINV f G y)             by x = f x1, y = f y1.
1559*)
1560Theorem group_homo_sym:
1561    !(g:'a group) (h:'b group) f. Group g /\ GroupHomo f g h /\ BIJ f G h.carrier ==> GroupHomo (LINV f G) h g
1562Proof
1563  rpt strip_tac >>
1564  `BIJ (LINV f G) h.carrier G` by rw[BIJ_LINV_BIJ] >>
1565  fs[GroupHomo_def] >>
1566  rpt strip_tac >-
1567  metis_tac[BIJ_DEF, INJ_DEF] >>
1568  `?x1. (x = f x1) /\ x1 IN G` by metis_tac[BIJ_DEF, SURJ_DEF] >>
1569  `?y1. (y = f y1) /\ y1 IN G` by metis_tac[BIJ_DEF, SURJ_DEF] >>
1570  `g.op x1 y1 IN G` by rw[] >>
1571  metis_tac[BIJ_LINV_THM]
1572QED
1573
1574Theorem group_homo_sym_any:
1575  Group g /\ GroupHomo f g h /\
1576  (!x. x IN h.carrier ==> i x IN g.carrier /\ f (i x) = x) /\
1577  (!x. x IN g.carrier ==> i (f x) = x)
1578  ==>
1579  GroupHomo i h g
1580Proof
1581  rpt strip_tac \\ fs[GroupHomo_def]
1582  \\ rpt strip_tac
1583  \\ `h.op x y = f (g.op (i x) (i y))` by metis_tac[]
1584  \\ pop_assum SUBST1_TAC
1585  \\ first_assum irule
1586  \\ PROVE_TAC[group_def_alt]
1587QED
1588
1589(* Theorem: GroupHomo f1 g h /\ GroupHomo f2 h k ==> GroupHomo (f2 o f1) g k *)
1590(* Proof: by GroupHomo_def *)
1591Theorem group_homo_compose:
1592    !(g:'a group) (h:'b group) (k:'c group).
1593   !f1 f2. GroupHomo f1 g h /\ GroupHomo f2 h k ==> GroupHomo (f2 o f1) g k
1594Proof
1595  rw_tac std_ss[GroupHomo_def]
1596QED
1597(* This is the same as group_homo_trans. *)
1598
1599(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==> MonoidHomo f g h *)
1600(* Proof:
1601   By MonoidHomo_def, this is to show:
1602   (1) x IN G ==> f x IN h.carrier, true                           by GroupHomo_def
1603   (2) x IN G /\ y IN G ==> f (x * y) = h.op (f x) (f y), true     by GroupHomo_def
1604   (3) Group g /\ Group h /\ GroupHomo f g h ==> f #e = h.id, true by group_homo_id
1605*)
1606Theorem group_homo_is_monoid_homo:
1607    !g:'a group h f. Group g /\ Group h /\ GroupHomo f g h ==> MonoidHomo f g h
1608Proof
1609  rw[MonoidHomo_def] >-
1610  fs[GroupHomo_def] >-
1611  fs[GroupHomo_def] >>
1612  fs[group_homo_id]
1613QED
1614
1615(* Theorem: (GroupHomo f g h /\ f #e = h.id) <=> MonoidHomo f g h *)
1616(* Proof: by MonoidHomo_def, GroupHomo_def. *)
1617Theorem group_homo_monoid_homo:
1618  !f g h. (GroupHomo f g h /\ f #e = h.id) <=> MonoidHomo f g h
1619Proof
1620  simp[MonoidHomo_def, GroupHomo_def] >>
1621  rw[EQ_IMP_THM]
1622QED
1623
1624(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==> !x. x IN G ==> !n. f (x ** n) = h.exp (f x) n *)
1625(* Proof:
1626   Note Monoid g           by group_is_monoid
1627    and MonoidHomo f g h   by group_homo_is_monoid_homo
1628    The result follows     by monoid_homo_exp
1629*)
1630Theorem group_homo_exp:
1631    !g:'a group h:'b group f. Group g /\ Group h /\ GroupHomo f g h ==>
1632   !x. x IN G ==> !n. f (x ** n) = h.exp (f x) n
1633Proof
1634  rw[group_is_monoid, group_homo_is_monoid_homo, monoid_homo_exp]
1635QED
1636
1637(* ------------------------------------------------------------------------- *)
1638(* Group Isomorphisms                                                        *)
1639(* ------------------------------------------------------------------------- *)
1640
1641(* Theorem: GroupIso f g h <=> GroupIHomo f g h /\ (!y. y IN h.carrier ==> ?!x. x IN G /\ (f x = y)) *)
1642(* Proof:
1643   This is to prove:
1644   (1) BIJ f G H /\ y IN H ==> ?!x. x IN G /\ (f x = y)
1645       true by INJ_DEF and SURJ_DEF.
1646   (2) !y. y IN H /\ GroupHomo f g h ==> ?!x. x IN G /\ (f x = y) ==> BIJ f G H
1647       true by INJ_DEF and SURJ_DEF, and
1648       x IN G /\ GroupHomo f g h ==> f x IN H  by GroupHomo_def
1649*)
1650Theorem group_iso_property:
1651    !f g h. GroupIso f g h <=> GroupHomo f g h /\ (!y. y IN h.carrier ==> ?!x. x IN G /\ (f x = y))
1652Proof
1653  rw[GroupIso_def, EQ_IMP_THM] >-
1654  metis_tac[BIJ_THM] >>
1655  rw[BIJ_THM] >>
1656  metis_tac[GroupHomo_def]
1657QED
1658
1659(* Theorem: Group g /\ Group h /\ GroupIso f g h ==> f #e = h.id *)
1660(* Proof:
1661   Since Group g, Group h ==> Monoid g, Monoid h   by group_is_monoid
1662   and GroupIso = WeakIso, GroupHomo = WeakHomo,
1663   this follows by monoid_iso_id.
1664*)
1665Theorem group_iso_id:
1666    !f g h. Group g /\ Group h /\ GroupIso f g h ==> (f #e = h.id)
1667Proof
1668  rw[monoid_weak_iso_id, group_is_monoid, GroupIso_def, GroupHomo_def, WeakIso_def, WeakHomo_def]
1669QED
1670(* However,
1671   this result is worse than (proved earlier):
1672- group_homo_id;
1673> val it = |- !f g h. Group g /\ Group h /\ GroupHomo f g h ==> (f #e = h.id) : thm
1674*)
1675
1676(* Theorem: GroupIso f g h ==> !x. x IN G ==> f x IN h.carrier *)
1677(* Proof: by GroupIso_def, group_homo_element *)
1678Theorem group_iso_element:
1679    !f g h. GroupIso f g h ==> !x. x IN G ==> f x IN h.carrier
1680Proof
1681  metis_tac[GroupIso_def, group_homo_element]
1682QED
1683
1684(* Theorem: GroupIso I g g *)
1685(* Proof:
1686   By GroupIso_def, this is to show:
1687   (1) GroupHomo I g g, true by group_homo_I_refl
1688   (2) BIJ I R R, true by BIJ_I_SAME
1689*)
1690Theorem group_iso_I_refl:
1691    !g:'a group. GroupIso I g g
1692Proof
1693  rw[GroupIso_def, group_homo_I_refl, BIJ_I_SAME]
1694QED
1695
1696(* Theorem: GroupIso f1 g h /\ GroupIso f2 h k ==> GroupIso (f2 o f1) g k *)
1697(* Proof:
1698   By GroupIso_def, this is to show:
1699   (1) GroupHomo f1 g h /\ GroupHomo f2 h k ==> GroupHomo (f2 o f1) g
1700       True by group_homo_trans.
1701   (2) BIJ f1 G h.carrier /\ BIJ f2 h.carrier k.carrier ==> BIJ (f2 o f1) G k.carrier
1702       True by BIJ_COMPOSE.
1703*)
1704Theorem group_iso_trans:
1705    !(g:'a group) (h:'b group) (k:'c group).
1706    !f1 f2. GroupIso f1 g h /\ GroupIso f2 h k ==> GroupIso (f2 o f1) g k
1707Proof
1708  rw[GroupIso_def] >-
1709  metis_tac[group_homo_trans] >>
1710  metis_tac[BIJ_COMPOSE]
1711QED
1712
1713(* Theorem: Group g ==> !f. GroupIso f g h ==> GroupIso (LINV f G) h g *)
1714(* Proof:
1715   By GroupIso_def, this is to show:
1716   (1) GroupHomo f g h /\ BIJ f G h.carrier ==> GroupHomo (LINV f G) h g
1717       True by group_homo_sym.
1718   (2) BIJ f G h.carrier ==> BIJ (LINV f G) h.carrier G
1719       True by BIJ_LINV_BIJ
1720*)
1721Theorem group_iso_sym:
1722    !(g:'a group) (h:'b group) f. Group g /\ GroupIso f g h ==> GroupIso (LINV f G) h g
1723Proof
1724  rw[GroupIso_def, group_homo_sym, BIJ_LINV_BIJ]
1725QED
1726
1727(* Theorem: GroupIso f1 g h /\ GroupIso f2 h k ==> GroupIso (f2 o f1) g k *)
1728(* Proof:
1729   By GroupIso_def, this is to show:
1730   (1) GroupHomo f1 g h /\ GroupHomo f2 h k ==> GroupHomo (f2 o f1) g k
1731       True by group_homo_compose.
1732   (2) BIJ f1 G h.carrier /\ BIJ f2 h.carrier k.carrier ==> BIJ (f2 o f1) G k.carrier
1733       True by BIJ_COMPOSE
1734*)
1735Theorem group_iso_compose:
1736    !(g:'a group) (h:'b group) (k:'c group).
1737   !f1 f2. GroupIso f1 g h /\ GroupIso f2 h k ==> GroupIso (f2 o f1) g k
1738Proof
1739  rw_tac std_ss[GroupIso_def] >-
1740  metis_tac[group_homo_compose] >>
1741  metis_tac[BIJ_COMPOSE]
1742QED
1743(* This is the same as group_iso_trans. *)
1744
1745(* Theorem: Group g /\ Group h /\ GroupIso f g h ==> MonoidIso f g h *)
1746(* Proof: by GroupIso_def, MonoidIso_def, group_homo_is_monoid_homo *)
1747Theorem group_iso_is_monoid_iso:
1748    !(g:'a group) (h:'b group) f. Group g /\ Group h /\ GroupIso f g h ==> MonoidIso f g h
1749Proof
1750  rw[GroupIso_def, MonoidIso_def] >>
1751  rw[group_homo_is_monoid_homo]
1752QED
1753
1754(* Theorem: (GroupIso f g h /\ f #e = h.id) <=> MonoidIso f g h *)
1755(* Proof:
1756       MonioidIso f g h
1757   <=> MonoidHomo f g h /\ BIJ f G h.carrier                 by MonoidIso_def
1758   <=> GroupHomo f g h /\ f #e = h.id /\ BIJ f G h.carrier   by group_homo_monoid_homo
1759   <=> GroupIso f g h /\ f #e = h.id                         by GroupIso_def
1760*)
1761Theorem group_iso_monoid_iso:
1762  !f g h. (GroupIso f g h /\ f #e = h.id) <=> MonoidIso f g h
1763Proof
1764  simp[MonoidIso_def, GroupIso_def] >>
1765  metis_tac[group_homo_monoid_homo]
1766QED
1767
1768(* Theorem: Group g /\ Group h /\ GroupIso f g h ==> !x. x IN G ==> !n. f (x ** n) = h.exp (f x) n *)
1769(* Proof:
1770   Note Monoid g           by group_is_monoid
1771    and MonoidIso f g h    by group_iso_is_monoid_iso
1772    The result follows     by monoid_iso_exp
1773*)
1774Theorem group_iso_exp:
1775    !g:'a group h:'b group f. Group g /\ Group h /\ GroupIso f g h ==>
1776   !x. x IN G ==> !n. f (x ** n) = h.exp (f x) n
1777Proof
1778  rw[group_is_monoid, group_iso_is_monoid_iso, monoid_iso_exp]
1779QED
1780
1781(* Theorem: Group g /\ Group h /\ GroupIso f g h ==> !x. x IN G ==> (order h (f x) = ord x) *)
1782(* Proof:
1783   Note Monoid g /\ Monoid h                    by group_is_monoid
1784    and MonoidIso f h g                         by group_iso_is_monoid_iso
1785   Thus !x. x IN H ==> (order h (f x) = ord x)  by monoid_iso_order
1786*)
1787Theorem group_iso_order:
1788    !(g:'a group) (h:'b group) f. Group g /\ Group h /\ GroupIso f g h ==>
1789    !x. x IN G ==> (order h (f x) = ord x)
1790Proof
1791  rw[group_is_monoid, group_iso_is_monoid_iso, monoid_iso_order]
1792QED
1793
1794(* Theorem: Group g /\ GroupIso f g h ==> GroupIso (LINV f G) h g *)
1795(* Proof:
1796   By GroupIso_def, GroupHomo_def, this is to show:
1797   (1) BIJ f G h.carrier /\ x IN h.carrier ==> LINV f G x IN G
1798       True by BIJ_LINV_ELEMENT
1799   (2) BIJ f G h.carrier /\ x IN h.carrier /\ y IN h.carrier ==> LINV f G (h.op x y) = LINV f G x * LINV f G y
1800       Let x' = LINV f G x, y' = LINV f G y.
1801       Then x' IN G /\ y' IN G        by BIJ_LINV_ELEMENT
1802         so x' * y' IN G              by group_op_element
1803        ==> f (x' * y') = h.op (f x') (f y')    by GroupHomo_def
1804                        = h.op x y              by BIJ_LINV_THM
1805       Thus LINV f G (h.op x y)
1806          = LINV f G (f (x' * y'))    by above
1807          = x' * y'                   by BIJ_LINV_THM
1808   (3) BIJ f G h.carrier ==> BIJ (LINV f G) h.carrier G
1809       True by BIJ_LINV_BIJ
1810*)
1811Theorem group_iso_linv_iso:
1812    !(g:'a group) (h:'b group) f. Group g /\ GroupIso f g h ==> GroupIso (LINV f G) h g
1813Proof
1814  rw_tac std_ss[GroupIso_def, GroupHomo_def] >-
1815  metis_tac[BIJ_LINV_ELEMENT] >-
1816 (qabbrev_tac `x' = LINV f G x` >>
1817  qabbrev_tac `y' = LINV f G y` >>
1818  metis_tac[BIJ_LINV_THM, BIJ_LINV_ELEMENT, group_op_element]) >>
1819  rw_tac std_ss[BIJ_LINV_BIJ]
1820QED
1821(* This is the same as group_iso_sym. *)
1822
1823(* Theorem: GroupIso f g h ==> BIJ f G h.carrier *)
1824(* Proof: by GroupIso_def *)
1825Theorem group_iso_bij:
1826    !(g:'a group) (h:'b group) f. GroupIso f g h ==> BIJ f G h.carrier
1827Proof
1828  rw_tac std_ss[GroupIso_def]
1829QED
1830
1831(* Note: read the discussion in group_iso_id for the condition: f #e = h.id:
1832   group_iso_id  |- !f g h. Group g /\ Group h /\ GroupIso f g h ==> (f #e = h.id)
1833*)
1834(* Theorem: Group g /\ GroupIso f g h /\ f #e = h.id ==> Group h  *)
1835(* Proof:
1836   This is to show:
1837   (1) x IN h.carrier /\ y IN h.carrier ==> h.op x y IN h.carrier
1838       Group g ==> Monoid g               by group_is_monoid
1839       Since ?x'. x' IN G /\ (f x' = x)   by group_iso_property
1840             ?y'. y' IN G /\ (f y' = y)   by group_iso_property
1841             h.op x y = f (x' * y')       by GroupHomo_def
1842       As                  x' * y' IN G   by group_op_element
1843       hence f (x' * y') IN h.carrier     by GroupHomo_def
1844   (2) x IN h.carrier /\ y IN h.carrier /\ z IN h.carrier ==> h.op (h.op x y) z = h.op x (h.op y z)
1845       Since ?x'. x' IN G /\ (f x' = x)   by group_iso_property
1846             ?y'. y' IN G /\ (f y' = y)   by group_iso_property
1847             ?z'. z' IN G /\ (f z' = z)   by group_iso_property
1848       as     x' * y' IN G                by group_op_element
1849       and f (x' * y') IN h.carrier       by GroupHomo_def
1850       ?!t. t IN G /\ f t = f (x' * y')   by group_iso_property
1851       i.e.  t = x' * y'                  by uniqueness
1852       hence h.op (h.op x y) z = f (x' * y' * z')
1853                                          by GroupHomo_def
1854       Similary,
1855       as     y' * z' IN G                by group_op_element
1856       and f (y' * z') IN h.carrier       by GroupHomo_def
1857       ?!s. s IN G /\ f s = f (y' * z')   by group_iso_property
1858       i.e.  s = y' * z'                  by uniqueness
1859       and   h.op x (h.op y z) = f (x' * (y' * z'))
1860                                          by GroupHomo_def
1861       hence true                         by group_assoc.
1862   (3) h.id IN h.carrier
1863       Since #e IN G                      by group_id_element
1864            (f #e) = h.id IN h.carrier    by GroupHomo_def
1865   (4) x IN h.carrier ==> h.op h.id x = x
1866       Since ?x'. x' IN G /\ (f x' = x)   by group_iso_property
1867       h.id IN h.carrier                  by group_id_element
1868       ?!e. e IN G /\ f e = h.id = f #e   by group_iso_property
1869       i.e. e = #e                        by uniqueness
1870       hence h.op h.id x = f (e * x')     by GroupHomo_def
1871                         = f (#e * x')
1872                         = f x'           by group_lid
1873                         = x
1874   (5) x IN h.carrier ==> ?y. y IN h.carrier /\ (h.op y x = h.id)
1875       Since ?x'. x' IN G /\ (f x' = x)   by group_iso_property
1876       so      |/ x' IN G                 by group_inv_element
1877       and  f ( |/ x') IN h.carrier       by GroupHomo_def
1878       Let y = f ( |/ x')
1879       then h.op y x = f ( |/ x' * x')    by GroupHomo_def
1880                     = f #e               by group_linv
1881                     = h.id
1882*)
1883Theorem group_iso_group:
1884    !(g:'a group) (h:'b group) f. Group g /\ GroupIso f g h /\ (f #e = h.id) ==> Group h
1885Proof
1886  rw[group_iso_property] >>
1887  `(!x. x IN G ==> f x IN h.carrier) /\ !x y. x IN G /\ y IN G ==> (f (x * y) = h.op (f x) (f y))`
1888    by metis_tac[GroupHomo_def] >>
1889  rw[group_def_alt] >| [
1890    metis_tac[group_op_element],
1891    `?x'. x' IN G /\ (f x' = x)` by metis_tac[] >>
1892    `?y'. y' IN G /\ (f y' = y)` by metis_tac[] >>
1893    `?z'. z' IN G /\ (f z' = z)` by metis_tac[] >>
1894    `?t. t IN G /\ (t = x' * y')` by metis_tac[group_op_element] >>
1895    `h.op (h.op x y) z = f (x' * y' * z')` by metis_tac[] >>
1896    `?s. s IN G /\ (s = y' * z')` by metis_tac[group_op_element] >>
1897    `h.op x (h.op y z) = f (x' * (y' * z'))` by metis_tac[] >>
1898    `x' * y' * z' = x' * (y' * z')` by rw[group_assoc] >>
1899    metis_tac[],
1900    metis_tac[group_id_element, GroupHomo_def],
1901    metis_tac[group_lid, group_id_element],
1902    metis_tac[group_linv, group_inv_element]
1903  ]
1904QED
1905
1906(* Theorem: GroupIso f g h /\ FINITE G ==> (CARD G = CARD h.carrier) *)
1907(* Proof: by GroupIso_def, FINITE_BIJ_CARD. *)
1908Theorem group_iso_card_eq:
1909    !g:'a group h:'b group f. GroupIso f g h /\ FINITE G ==> (CARD G = CARD h.carrier)
1910Proof
1911  metis_tac[GroupIso_def, FINITE_BIJ_CARD]
1912QED
1913
1914(* ------------------------------------------------------------------------- *)
1915(* Group Automorphisms                                                       *)
1916(* ------------------------------------------------------------------------- *)
1917
1918(* Theorem: Group g /\ GroupAuto f g ==> (f #e = #e) *)
1919(* Proof: by GroupAuto_def, group_iso_id *)
1920Theorem group_auto_id:
1921    !f g. Group g /\ GroupAuto f g ==> (f #e = #e)
1922Proof
1923  rw_tac std_ss[GroupAuto_def, group_iso_id]
1924QED
1925
1926(* Theorem: GroupAuto f g ==> !x. x IN G ==> f x IN G *)
1927(* Proof: by GroupAuto_def, group_iso_element *)
1928Theorem group_auto_element:
1929    !f g. GroupAuto f g ==> !x. x IN G ==> f x IN G
1930Proof
1931  metis_tac[GroupAuto_def, group_iso_element]
1932QED
1933
1934(* Theorem: GroupAuto f1 g /\ GroupAuto f2 g ==> GroupAuto (f1 o f2) g *)
1935(* Proof: by GroupAuto_def, group_iso_compose *)
1936Theorem group_auto_compose:
1937    !(g:'a group). !f1 f2. GroupAuto f1 g /\ GroupAuto f2 g ==> GroupAuto (f1 o f2) g
1938Proof
1939  metis_tac[GroupAuto_def, group_iso_compose]
1940QED
1941
1942(* Theorem: Group g /\ GroupAuto f g ==> MonoidAuto f g *)
1943(* Proof: by GroupAuto_def, MonoidAuto_def, group_iso_is_monoid_iso *)
1944Theorem group_auto_is_monoid_auto:
1945    !(g:'a group) f. Group g /\ GroupAuto f g ==> MonoidAuto f g
1946Proof
1947  rw[GroupAuto_def, MonoidAuto_def] >>
1948  rw[group_iso_is_monoid_iso]
1949QED
1950
1951(* Theorem: Group g /\ GroupAuto f g ==> !x. x IN G ==> !n. f (x ** n) = (f x) ** n *)
1952(* Proof:
1953   Note Monoid g           by group_is_monoid
1954    and MonoidAuto f g     by group_auto_is_monoid_auto
1955    The result follows     by monoid_auto_exp
1956*)
1957Theorem group_auto_exp:
1958    !g:'a group f. Group g /\ GroupAuto f g ==>
1959   !x. x IN G ==> !n. f (x ** n) = (f x) ** n
1960Proof
1961  rw[group_is_monoid, group_auto_is_monoid_auto, monoid_auto_exp]
1962QED
1963
1964(* Theorem: Group g /\ GroupAuto f g ==> !x. x IN G ==> (order h (f x) = ord x) *)
1965(* Proof:
1966   Note Monoid g /\ Monoid h                  by group_is_monoid
1967    and MonoidAuto f h                        by group_auto_is_monoid_auto
1968   Thus !x. x IN H ==> (ord (f x) = ord x)    by monoid_auto_order
1969*)
1970Theorem group_auto_order:
1971    !(g:'a group) f. Group g /\ GroupAuto f g ==>
1972    !x. x IN G ==> (ord (f x) = ord x)
1973Proof
1974  rw[group_is_monoid, group_auto_is_monoid_auto, monoid_auto_order]
1975QED
1976
1977(* Theorem: GroupAuto I g *)
1978(* Proof:
1979       GroupAuto I g
1980   <=> GroupIso I g g                 by GroupAuto_def
1981   <=> GroupHomo I g g /\ BIJ f G G   by GroupIso_def
1982   <=> T /\ BIJ f G G                 by GroupHomo_def, I_THM
1983   <=> T /\ T                         by BIJ_I_SAME
1984*)
1985Theorem group_auto_I:
1986    !(g:'a group). GroupAuto I g
1987Proof
1988  rw_tac std_ss[GroupAuto_def, GroupIso_def, GroupHomo_def, BIJ_I_SAME]
1989QED
1990
1991(* Theorem: Group g /\ GroupAuto f g ==> GroupAuto (LINV f G) g *)
1992(* Proof:
1993       GroupAuto I g
1994   ==> GroupIso I g g                by GroupAuto_def
1995   ==> GroupIso (LINV f G) g         by group_iso_linv_iso
1996   ==> GroupAuto (LINV f G) g        by GroupAuto_def
1997*)
1998Theorem group_auto_linv_auto:
1999    !(g:'a group) f. Group g /\ GroupAuto f g ==> GroupAuto (LINV f G) g
2000Proof
2001  rw_tac std_ss[GroupAuto_def, group_iso_linv_iso]
2002QED
2003
2004(* Theorem: GroupAuto f g ==> f PERMUTES G *)
2005(* Proof: by GroupAuto_def, GroupIso_def *)
2006Theorem group_auto_bij:
2007    !g:'a group. !f. GroupAuto f g ==> f PERMUTES G
2008Proof
2009  rw_tac std_ss[GroupAuto_def, GroupIso_def]
2010QED
2011
2012(* ------------------------------------------------------------------------- *)
2013(* Subgroups                                                                 *)
2014(* ------------------------------------------------------------------------- *)
2015
2016(* Theorem: subgroup h g <=> H SUBSET G /\ (!x y. x IN H /\ y IN H ==> (h.op x y = x * y)) *)
2017(* Proof:
2018       subgroup h g
2019   <=> GroupHomo I h g                                              by subgroup_def
2020   <=> (!x. x IN H ==> I x IN G) /\
2021       (!x y. x IN H /\ y IN H ==> (I (h.op x y) = (I x) * (I y)))  by GroupHomo_def
2022   <=> (!x. x IN H ==> x IN G) /\
2023       (!x y. x IN H /\ y IN H ==> (h.op x y = x * y))              by I_THM
2024   <=> H SUBSET G
2025       (!x y. x IN H /\ y IN H ==> (h.op x y = x * y))              by SUBSET_DEF
2026*)
2027Theorem subgroup_eqn:
2028    !(g:'a group) (h:'a group). subgroup h g <=>
2029     H SUBSET G /\ (!x y. x IN H /\ y IN H ==> (h.op x y = x * y))
2030Proof
2031  rw_tac std_ss[subgroup_def, GroupHomo_def, SUBSET_DEF]
2032QED
2033
2034(* Theorem: subgroup h g ==> H SUBSET G *)
2035(* Proof: by subgroup_eqn *)
2036Theorem subgroup_subset:
2037    !(g:'a group) (h:'a group). subgroup h g ==> H SUBSET G
2038Proof
2039  rw_tac std_ss[subgroup_eqn]
2040QED
2041
2042(* Theorem: subgroup h g /\ GroupHomo f g k ==> GroupHomo f h k *)
2043(* Proof:
2044   Note H SUBSET G              by subgroup_subset
2045     or !x. x IN H ==> x IN G   by SUBSET_DEF
2046   By GroupHomo_def, this is to show:
2047   (1) x IN H ==> f x IN k.carrier
2048       True                     by GroupHomo_def, GroupHomo f g k
2049   (2) x IN H /\ y IN H /\ f (h.op x y) = k.op (f x) (f y)
2050       Note x IN H ==> x IN G   by above
2051        and y IN H ==> y IN G   by above
2052         f (h.op x y)
2053       = f (x * y)              by subgroup_eqn
2054       = k.op (f x) (f y)       by GroupHomo_def
2055*)
2056Theorem subgroup_homo_homo:
2057    !(g:'a group) (h:'a group) (k:'b group) f. subgroup h g /\ GroupHomo f g k ==> GroupHomo f h k
2058Proof
2059  rw_tac std_ss[subgroup_def, GroupHomo_def]
2060QED
2061
2062(* Theorem: subgroup g g *)
2063(* Proof:
2064   By subgroup_def, this is to show:
2065   GroupHomo I g g, true by group_homo_I_refl.
2066*)
2067Theorem subgroup_reflexive:
2068    !g:'a group. subgroup g g
2069Proof
2070  rw[subgroup_def, group_homo_I_refl]
2071QED
2072
2073(* Theorem: subgroup g h /\ subgroup h k ==> subgroup g k *)
2074(* Proof:
2075   By subgroup_def, this is to show:
2076   GroupHomo I g h /\ GroupHomo I h k ==> GroupHomo I g k
2077   Since I o I = I       by combinTheory.I_o_ID
2078   This is true          by group_homo_trans
2079*)
2080Theorem subgroup_transitive:
2081    !(g h k):'a group. subgroup g h /\ subgroup h k ==> subgroup g k
2082Proof
2083  prove_tac[subgroup_def, combinTheory.I_o_ID, group_homo_trans]
2084QED
2085
2086(* Theorem: subgroup h g /\ subgroup g h ==> GroupIso I h g *)
2087(* Proof:
2088   By subgroup_def, GroupIso_def, this is to show:
2089      GroupHomo I h g /\ GroupHomo I g h ==> BIJ I H G
2090   By BIJ_DEF, INJ_DEF, SURJ_DEF, this is to show:
2091   (1) x IN H ==> x IN G, true    by subgroup_subset, subgroup h g
2092   (2) x IN G ==> x IN H, true    by subgroup_subset, subgroup g h
2093*)
2094Theorem subgroup_I_antisym:
2095    !(g:'a monoid) h. subgroup h g /\ subgroup g h ==> GroupIso I h g
2096Proof
2097  rw_tac std_ss[subgroup_def, GroupIso_def] >>
2098  fs[GroupHomo_def] >>
2099  rw_tac std_ss[BIJ_DEF, INJ_DEF, SURJ_DEF]
2100QED
2101
2102(* Theorem: subgroup h g /\ G SUBSET H ==> GroupIso I h g *)
2103(* Proof:
2104   By subgroup_def, GroupIso_def, this is to show:
2105      GroupHomo I h g /\ G SUBSET H ==> BIJ I H G
2106   By BIJ_DEF, INJ_DEF, SURJ_DEF, this is to show:
2107   (1) x IN H ==> x IN G, true    by subgroup_subset, subgroup h g
2108   (2) x IN G ==> x IN H, true    by G SUBSET H, given
2109*)
2110Theorem subgroup_carrier_antisym:
2111    !(g:'a group) h. subgroup h g /\ G SUBSET H ==> GroupIso I h g
2112Proof
2113  rpt (stripDup[subgroup_def]) >>
2114  rw_tac std_ss[GroupIso_def] >>
2115  `H SUBSET G` by rw[subgroup_subset] >>
2116  fs[GroupHomo_def, SUBSET_DEF] >>
2117  rw_tac std_ss[BIJ_DEF, INJ_DEF, SURJ_DEF]
2118QED
2119
2120(* Theorem: Group g /\ Group h /\ subgroup h g ==> submonoid h g *)
2121(* Proof:
2122   By subgroup_def, submonoid_def, this is to show:
2123      Group g /\ Group h /\ GroupHomo I h g ==> MonoidHomo I h g
2124   This is true by group_homo_is_monoid_homo
2125*)
2126Theorem subgroup_is_submonoid0:
2127  !g:'a group h. Group g /\ Group h /\ subgroup h g ==> submonoid h g
2128Proof
2129  rw[subgroup_def, submonoid_def] >>
2130  rw[group_homo_is_monoid_homo]
2131QED
2132
2133(* Theorem: Group g /\ Group h /\ subgroup h g ==> !x. x IN H ==> (order h x = ord x) *)
2134(* Proof:
2135   Note Monoid g /\ Monoid h                  by group_is_monoid
2136    and submonoid h g                         by subgroup_is_submonoid0
2137   Thus !x. x IN H ==> (order h x = ord x)    by submonoid_order_eqn
2138*)
2139Theorem subgroup_order_eqn:
2140    !g:'a group h. Group g /\ Group h /\ subgroup h g ==>
2141   !x. x IN H ==> (order h x = ord x)
2142Proof
2143  rw[group_is_monoid, subgroup_is_submonoid0, submonoid_order_eqn]
2144QED
2145
2146(* ------------------------------------------------------------------------- *)
2147(* Homomorphic Image of a Group.                                             *)
2148(* ------------------------------------------------------------------------- *)
2149
2150(* For those same as monoids, use overloading  *)
2151Overload homo_group = ``homo_monoid``
2152
2153(* Theorem: [Closure] Group g /\ GroupHomo f g (homo_group g f) ==> x IN fG /\ y IN fG ==> x o y IN fG *)
2154(* Proof:
2155   x o y = f (CHOICE (preimage f G x) * CHOICE (preimage f G y))  by homo_monoid_property
2156   Since   CHOICE (preimage f G x) IN G    by preimage_choice_property
2157           CHOICE (preimage f G y) IN G    by preimage_choice_property
2158   hence   CHOICE (preimage f G x) * CHOICE (preimage f G y) IN G      by group_op_element
2159   so    f (CHOICE (preimage f G x) * CHOICE (preimage f G y)) IN fG   by GroupHomo_def
2160*)
2161Theorem homo_group_closure:
2162    !(g:'a group) (f:'a -> 'b). Group g /\ GroupHomo f g (homo_group g f) ==>
2163     !x y. x IN fG /\ y IN fG ==> x o y IN fG
2164Proof
2165  rw_tac std_ss[GroupHomo_def, homo_monoid_def, image_op_def] >>
2166  rw_tac std_ss[preimage_choice_property, group_op_element]
2167QED
2168
2169(* Theorem: [Associative] Group g /\ GroupHomo f g (homo_group g f) ==>
2170            x IN fG /\ y IN fG /\ z IN fG ==> (x o y) o z = x o (y o z) *)
2171(* Proof:
2172   By GroupHomo_def,
2173      !x. x IN G ==> f x IN fG
2174      !x y. x IN G /\ y IN G ==> (f (x * y) = f x o f y)
2175   Since   CHOICE (preimage f G x) IN G /\ x = f (CHOICE (preimage f G x))   by preimage_choice_property
2176           CHOICE (preimage f G y) IN G /\ y = f (CHOICE (preimage f G y))   by preimage_choice_property
2177           CHOICE (preimage f G z) IN G /\ z = f (CHOICE (preimage f G z))   by preimage_choice_property
2178     (x o y) o z
2179   = (f (CHOICE (preimage f G x)) o f (CHOICE (preimage f G y))) o f (CHOICE (preimage f G z))   by expanding x, y, z
2180   = f (CHOICE (preimage f G x) * CHOICE (preimage f G y)) o f (CHOICE (preimage f G z))         by homo_monoid_property
2181   = f (CHOICE (preimage f G x) * CHOICE (preimage f G y) * CHOICE (preimage f G z))             by homo_monoid_property
2182   = f (CHOICE (preimage f G x) * (CHOICE (preimage f G y) * CHOICE (preimage f G z)))           by group_assoc
2183   = f (CHOICE (preimage f G x)) o f (CHOICE (preimage f G y) * CHOICE (preimage f G z))         by homo_monoid_property
2184   = f (CHOICE (preimage f G x)) o (f (CHOICE (preimage f G y)) o f (CHOICE (preimage f G z)))   by homo_monoid_property
2185   = x o (y o z)                                                                                 by contracting x, y, z
2186*)
2187Theorem homo_group_assoc:
2188    !(g:'a group) (f:'a -> 'b). Group g /\ GroupHomo f g (homo_group g f) ==>
2189   !x y z. x IN fG /\ y IN fG /\ z IN fG ==> ((x o y) o z = x o (y o z))
2190Proof
2191  rw_tac std_ss[GroupHomo_def] >>
2192  `(fG = IMAGE f G) /\ !x y. x IN fG /\ y IN fG ==>
2193     (x o y = f (CHOICE (preimage f G x) * CHOICE (preimage f G y)))` by rw_tac std_ss[homo_monoid_property] >>
2194  `CHOICE (preimage f G x) IN G /\ (f (CHOICE (preimage f G x)) = x)` by metis_tac[preimage_choice_property] >>
2195  `CHOICE (preimage f G y) IN G /\ (f (CHOICE (preimage f G y)) = y)` by metis_tac[preimage_choice_property] >>
2196  `CHOICE (preimage f G z) IN G /\ (f (CHOICE (preimage f G z)) = z)` by metis_tac[preimage_choice_property] >>
2197  `CHOICE (preimage f G x) * CHOICE (preimage f G y) IN G` by rw[] >>
2198  `CHOICE (preimage f G y) * CHOICE (preimage f G z) IN G` by rw[] >>
2199  `CHOICE (preimage f G x) * CHOICE (preimage f G y) * CHOICE (preimage f G z) =
2200   CHOICE (preimage f G x) * (CHOICE (preimage f G y) * CHOICE (preimage f G z))` by rw[group_assoc] >>
2201  metis_tac[]
2202QED
2203
2204(* Theorem: [Identity] Group g /\ GroupHomo f g (homo_group g f) ==> #i IN fG /\ #i o x = x /\ x o #i = x. *)
2205(* Proof:
2206   By homo_monoid_property, #i = f #e, and #i IN fG.
2207   Since   CHOICE (preimage f G x) IN G /\ x = f (CHOICE (preimage f G x))   by preimage_choice_property
2208   hence  #i o x
2209        = (f #e) o  f (preimage f G x)
2210        = f (#e * preimage f G x)       by homo_group_property
2211        = f (preimage f G x)            by group_lid
2212        = x
2213   similarly for x o #i = x             by group_rid
2214*)
2215Theorem homo_group_id:
2216    !(g:'a group) (f:'a -> 'b). Group g /\ GroupHomo f g (homo_group g f) ==>
2217      #i IN fG /\ (!x. x IN fG ==> (#i o x = x) /\ (x o #i = x))
2218Proof
2219  rw_tac std_ss[GroupHomo_def, homo_monoid_property] >| [
2220    rw[],
2221    metis_tac[group_lid, group_id_element, preimage_choice_property],
2222    metis_tac[group_rid, group_id_element, preimage_choice_property]
2223  ]
2224QED
2225
2226(* Theorem: [Inverse] Group g /\ GroupHomo f g (homo_monoid g f) ==> x IN fG ==> ?z. z IN fG /\ z o x = #i. *)
2227(* Proof:
2228   x IN fG ==> CHOICE (preimage f G x) IN G /\ x = f (CHOICE (preimage f G x))   by preimage_choice_property
2229   Choose z = f ( |/ (preimage f G x)),
2230   then   z IN fG since |/ CHOICE (preimage f G x) IN G,
2231   and    z o x = f ( |/ (CHOICE (preimage f G x))) o f (CHOICE (preimage f G x))
2232                = f ( |/ (CHOICE (preimage f G x)) * CHOICE (preimage f G x))    by homo_monoid_property
2233                = f #e                                                           by group_lid
2234                = #i                                                             by homo_monoid_id
2235*)
2236Theorem homo_group_inv:
2237    !(g:'a group) (f:'a -> 'b). Group g /\ GroupHomo f g (homo_monoid g f) ==>
2238     !x. x IN fG ==> ?z. z IN fG /\ (z o x = #i)
2239Proof
2240  rw_tac std_ss[GroupHomo_def, homo_monoid_property] >>
2241  `CHOICE (preimage f G x) IN G /\ (f (CHOICE (preimage f G x)) = x)` by metis_tac[preimage_choice_property] >>
2242  `|/ (CHOICE (preimage f G x)) IN G /\ ( |/ (CHOICE (preimage f G x)) * CHOICE (preimage f G x) = #e)` by rw[] >>
2243  qexists_tac `f ( |/ (CHOICE (preimage f G x)))` >>
2244  metis_tac[]
2245QED
2246
2247(* Theorem: [Commutative] AbelianGroup g /\ GroupHomo f g (homo_group g f) ==>
2248            x IN fG /\ y IN fG ==> (x o y = y o x) *)
2249(* Proof:
2250   Note AbelianGroup g ==> Group g and
2251        !x y. x IN G /\ y IN G ==> (x * y = y * x)          by AbelianGroup_def
2252   By GroupHomo_def,
2253      !x. x IN G ==> f x IN fG
2254      !x y. x IN G /\ y IN G ==> (f (x * y) = f x o f y)
2255   Since   CHOICE (preimage f G x) IN G /\ x = f (CHOICE (preimage f G x))   by preimage_choice_property
2256           CHOICE (preimage f G y) IN G /\ y = f (CHOICE (preimage f G y))   by preimage_choice_property
2257     x o y
2258   = f (CHOICE (preimage f G x)) o f (CHOICE (preimage f G y))   by expanding x, y
2259   = f (CHOICE (preimage f G x) * CHOICE (preimage f G y))       by homo_monoid_property
2260   = f (CHOICE (preimage f G y) * CHOICE (preimage f G x))       by AbelianGroup_def, above
2261   = f (CHOICE (preimage f G y)) o f (CHOICE (preimage f G x))   by homo_monoid_property
2262   = y o x                                                       by contracting x, y
2263*)
2264Theorem homo_group_comm:
2265    !(g:'a group) (f:'a -> 'b). AbelianGroup g /\ GroupHomo f g (homo_group g f) ==>
2266   !x y. x IN fG /\ y IN fG ==> (x o y = y o x)
2267Proof
2268  rw_tac std_ss[AbelianGroup_def, GroupHomo_def] >>
2269  `(fG = IMAGE f G) /\ !x y. x IN fG /\ y IN fG ==> (x o y = f (CHOICE (preimage f G x) * CHOICE (preimage f G y)))` by rw[homo_monoid_property] >>
2270  `CHOICE (preimage f G x) IN G /\ (f (CHOICE (preimage f G x)) = x)` by metis_tac[preimage_choice_property] >>
2271  `CHOICE (preimage f G y) IN G /\ (f (CHOICE (preimage f G y)) = y)` by metis_tac[preimage_choice_property] >>
2272  `CHOICE (preimage f G x) * CHOICE (preimage f G y) = CHOICE (preimage f G y) * CHOICE (preimage f G x)` by rw[] >>
2273  metis_tac[]
2274QED
2275
2276(* Theorem: Homomorphic image of a group is a group.
2277            Group g /\ GroupHomo f g (homo_monoid g f) ==> Group (homo_monoid g f) *)
2278(* Proof:
2279   This is to show each of these:
2280   (1) x IN fG /\ y IN fG ==> x o y IN fG    true by homo_group_closure
2281   (2) x IN fG /\ y IN fG /\ z IN fG ==> (x o y) o z = (x o y) o z    true by homo_group_assoc
2282   (3) #i IN fG, true by homo_group_id
2283   (4) x IN fG ==> #i o x = x, true by homo_group_id
2284   (5) x IN fG ==> ?y. y IN fG /\ (y o x = #i), true by homo_group_inv
2285*)
2286Theorem homo_group_group:
2287    !(g:'a group) f. Group g /\ GroupHomo f g (homo_monoid g f) ==> Group (homo_monoid g f)
2288Proof
2289  rpt strip_tac >>
2290  rw[group_def_alt] >| [
2291    rw[homo_group_closure],
2292    rw[homo_group_assoc],
2293    rw[homo_group_id],
2294    rw[homo_group_id],
2295    rw[homo_group_inv]
2296  ]
2297QED
2298
2299(* Theorem: Homomorphic image of an Abelian group is an Abelian group.
2300            AbelianGroup g /\ GroupHomo f g (homo_group g f) ==> AbelianGroup (homo_monoid g f) *)
2301(* Proof:
2302   Note AbelianGroup g ==> Group g                  by AbelianGroup_def
2303   By AbelianGroup_def, this is to show:
2304   (1) Group (homo_group g f), true                 by homo_group_group, Group g
2305   (2) x IN fG /\ y IN fG ==> x o y = y o x, true   by homo_group_comm, AbelianGroup g
2306*)
2307Theorem homo_group_abelian_group:
2308    !(g:'a group) f. AbelianGroup g /\ GroupHomo f g (homo_group g f) ==> AbelianGroup (homo_monoid g f)
2309Proof
2310  metis_tac[homo_group_group, AbelianGroup_def, homo_group_comm]
2311QED
2312
2313(* Theorem: Group g /\ INJ f G UNIV ==> GroupHomo f g (homo_group g f) *)
2314(* Proof:
2315   By GroupHomo_def, homo_monoid_property, this is to show:
2316   (1) x IN G ==> f x IN IMAGE f G, true                 by IN_IMAGE
2317   (2) x IN G /\ y IN G ==> f (x * y) = f x o f y, true  by homo_monoid_op_inj
2318*)
2319Theorem homo_group_by_inj:
2320    !(g:'a group) (f:'a -> 'b). Group g /\ INJ f G UNIV ==> GroupHomo f g (homo_group g f)
2321Proof
2322  rw_tac std_ss[GroupHomo_def, homo_monoid_property] >-
2323  rw[] >>
2324  rw[homo_monoid_op_inj]
2325QED
2326
2327(* ------------------------------------------------------------------------- *)
2328(* Injective Image of Group.                                                 *)
2329(* ------------------------------------------------------------------------- *)
2330
2331(* Idea: Given a Group g, and an injective function f,
2332   then the image (f G) is a Group, with an induced binary operator:
2333        op := (\x y. f (f^-1 x * f^-1 y))  *)
2334
2335(* Define a group injective image for an injective f, with LINV f G. *)
2336(* Since a group is a monoid, group injective image = monoid injective image *)
2337
2338(* Theorem: Group g /\ INJ f G univ(:'b) ==> Group (monoid_inj_image g f) *)
2339(* Proof:
2340   By Group_def, this is to show:
2341   (1) Group g ==> Monoid (monoid_inj_image g f)
2342       Group g ==> Monoid g                            by group_is_monoid
2343               ==> Monoid (monoid_inj_image g f)       by monoid_inj_image_monoid
2344   (2) monoid_invertibles (monoid_inj_image g f) = (monoid_inj_image g f).carrier
2345       By monoid_invertibles_def, monoid_inj_image_def, this is to show:
2346       z IN G ==> ?y. (?x. (y = f x) /\ x IN G) /\
2347                  (f (t (f z) * t y) = f #e) /\ (f (t y * t (f z)) = f #e)
2348                                                       where t = LINV f G
2349      Note INJ f G univ(:'b) ==> BIJ f G (IMAGE f G)   by INJ_IMAGE_BIJ_ALT
2350        so !x. x IN G ==> t (f x) = x
2351       and !x. x IN (IMAGE f G) ==> f (t x) = x        by BIJ_LINV_THM
2352      Also z IN G ==> |/ z IN G                        by group_inv_element
2353       Put x = |/ z, and y = f x
2354      Then  f (t (f z) * t y)
2355          = f (t (f z) * t (f ( |/ z)))                by y = f ( |/ z)
2356          = f (z * |/ z)                               by !y. t (f y) = y
2357          = f #e                                       by group_inv_thm
2358        and f (t y * t (f z))
2359          = f (t (f ( |/ z)) * t (f z))                by y = f ( |/ z)
2360          = f ( |/ z * z)                              by !y. t (f y) = y
2361          = f #e                                       by group_inv_thm
2362*)
2363Theorem group_inj_image_group:
2364  !(g:'a group) (f:'a -> 'b). Group g /\ INJ f G univ(:'b) ==> Group (monoid_inj_image g f)
2365Proof
2366  rpt strip_tac >>
2367  rw_tac std_ss[Group_def] >-
2368  rw[monoid_inj_image_monoid] >>
2369  rw[monoid_invertibles_def, monoid_inj_image_def, EXTENSION, EQ_IMP_THM] >>
2370  `g.inv x' IN G` by rw[] >>
2371  qexists_tac `f (g.inv x')` >>
2372  `BIJ f G (IMAGE f G)` by rw[INJ_IMAGE_BIJ_ALT] >>
2373  imp_res_tac BIJ_LINV_THM >>
2374  metis_tac[group_inv_thm]
2375QED
2376
2377(* Theorem: AbelianGroup g /\ INJ f G univ(:'b) ==> AbelianGroup (monoid_inj_image g f) *)
2378(* Proof:
2379   By AbelianGroup_def, this is to show:
2380   (1) Group g ==> Group (monoid_inj_image g f)
2381       True by group_inj_image_group.
2382   (2) (monoid_inj_image g f).op x y = (monoid_inj_image g f).op y x
2383       By monoid_inj_image_def, this is to show:
2384       x' IN G /\ x'' IN G /\ !x y. x IN G /\ y IN G ==> (x * y = y * x)
2385       ==> f (t (f x') * t (f x'')) = f (t (f x'') * t (f x'))  where t = LINV f G
2386       Note INJ f G univ(:'b) ==> BIJ f G (IMAGE f G)  by INJ_IMAGE_BIJ_ALT
2387         so !x. x IN G ==> t (f x) = x
2388        and !x. x IN (IMAGE f G) ==> f (t x) = x       by BIJ_LINV_THM
2389         f (t (f x') * t (f x''))
2390       = f (x' * x'')                                  by !y. t (f y) = y
2391       = f (x'' * x')                                  by commutativity condition
2392       = f (t (f x'') * t (f x'))                      by !y. t (f y) = y
2393*)
2394Theorem group_inj_image_abelian_group:
2395  !(g:'a group) (f:'a -> 'b). AbelianGroup g /\ INJ f G univ(:'b) ==>
2396       AbelianGroup (monoid_inj_image g f)
2397Proof
2398  rw[AbelianGroup_def] >-
2399  rw[group_inj_image_group] >>
2400  pop_assum mp_tac >>
2401  pop_assum mp_tac >>
2402  rw[monoid_inj_image_def] >>
2403  metis_tac[INJ_IMAGE_BIJ_ALT, BIJ_LINV_THM]
2404QED
2405
2406(* Theorem: Group (g excluding e) /\ INJ f G univ(:'b) /\ e IN G
2407            ==> Group (monoid_inj_image g f excluding f e) *)
2408(* Proof:
2409   Let h = g excluding e.
2410   Then H = h.carrier = G DIFF {e}             by excluding_def
2411    and h.op = g.op /\ h.id = g.id             by excluding_def
2412    and IMAGE f H = IMAGE f G DIFF {f e}       by IMAGE_DIFF
2413    and H SUBSET G                             by DIFF_SUBSET
2414   Let t = LINV f G.
2415   Then !x. x IN H ==> t (f x) = x             by LINV_SUBSET
2416
2417   By group_def_alt, monoid_inj_image_def, excluding_def, this is to show:
2418   (1) x IN IMAGE f H /\ y IN IMAGE f H ==> f (t x * t y) IN IMAGE f H
2419       Note ?a. (x = f a) /\ a IN H            by IN_IMAGE
2420            ?b. (y = f b) /\ b IN H            by IN_IMAGE
2421       Hence  f (t x * t y)
2422            = f (t (f a) * t (f b))            by x = f a, y = f b
2423            = f (a * b)                        by !y. t (f y) = y
2424       Since a * b IN H                        by group_op_element
2425       hence f (a * b) IN IMAGE f H            by IN_IMAGE
2426   (2) x IN IMAGE f H /\ y IN IMAGE f H /\ z IN IMAGE f H ==> f (t x * t y * t z) = f (t x * (t y * t z))
2427       Note ?a. (x = f a) /\ a IN G            by IN_IMAGE
2428            ?b. (y = f b) /\ b IN G            by IN_IMAGE
2429            ?c. (z = f c) /\ c IN G            by IN_IMAGE
2430       Hence  (t x * t y) * t z
2431            = (t (f a) * t (f b)) * t (f c)    by x = f a, y = f b, z = f c
2432            = (a * b) * c                      by !y. t (f y) = y
2433            = a * (b * c)                      by group_assoc
2434            = t (f a) * (t (f b) * t (f c))    by !y. t (f y) = y
2435            = t x * (t y * t z)                by x = f a, y = f b, z = f c
2436       or   f ((t x * t y) * t z) = f (t x * (t y * t z))
2437   (3) f #e IN IMAGE f H
2438       Since #e IN H                           by group_id_element
2439       f #e IN IMAGE f H                       by IN_IMAGE
2440   (4) x IN IMAGE f H ==> f (t (f #e) * t x) = x
2441       Note #e IN H                            by group_id_element
2442        and ?a. (x = f a) /\ a IN H            by IN_IMAGE
2443       Hence f (t (f #e) * t x)
2444           = f (#e * t x)                      by !y. t (f y) = y
2445           = f (#e * t (f a))                  by x = f a
2446           = f (#e * a)                        by !y. t (f y) = y
2447           = f a                               by group_id
2448           = x                                 by x = f a
2449   (5) x IN IMAGE f H ==> ?y. y IN IMAGE f H /\ f (t y * t x) = f #e
2450       Note ?a. (x = f a) /\ a IN H            by IN_IMAGE
2451        and b = (h.inv a) IN H                 by group_inv_element
2452       Let y = f b.
2453       Then y IN IMAGE f H                     by IN_IMAGE
2454        and f (t y * t x)
2455          = f (t y * t (f a))                  by x = f a
2456          = f (t (f b)) * t (f a))             by y = f b
2457          = f (b * a)                          by !y. t (f y) = y
2458          = f #e                               by group_linv
2459*)
2460Theorem group_inj_image_excluding_group:
2461  !(g:'a group) (f:'a -> 'b) e.
2462      Group (g excluding e) /\ INJ f G univ(:'b) /\ e IN G ==>
2463      Group (monoid_inj_image g f excluding f e)
2464Proof
2465  rpt strip_tac >>
2466  qabbrev_tac `h = g excluding e` >>
2467  `h.carrier = G DIFF {e} /\ h.op = g.op /\ h.id = g.id` by rw[excluding_def, Abbr`h`] >>
2468  qabbrev_tac `Q = IMAGE f G DIFF {f e}` >>
2469  `H SUBSET G` by fs[] >>
2470  imp_res_tac LINV_SUBSET >>
2471  rw_tac std_ss[group_def_alt, monoid_inj_image_def, excluding_def] >| [
2472    `Q = IMAGE f H` by fs[IMAGE_DIFF, Abbr`Q`] >>
2473    metis_tac[group_op_element, IN_IMAGE],
2474    `Q = IMAGE f H` by fs[IMAGE_DIFF, Abbr`Q`] >>
2475    `?a. (x = f a) /\ a IN H` by rw[GSYM IN_IMAGE] >>
2476    `?b. (y = f b) /\ b IN H` by rw[GSYM IN_IMAGE] >>
2477    `?c. (z = f c) /\ c IN H` by rw[GSYM IN_IMAGE] >>
2478    metis_tac[group_assoc, group_op_element],
2479    `Q = IMAGE f H` by fs[IMAGE_DIFF, Abbr`Q`] >>
2480    metis_tac[group_id_element, IN_IMAGE],
2481    `Q = IMAGE f H` by fs[IMAGE_DIFF, Abbr`Q`] >>
2482    metis_tac[group_id_element, group_id, IN_IMAGE],
2483    `Q = IMAGE f H` by fs[IMAGE_DIFF, Abbr`Q`] >>
2484    `?a. (x = f a) /\ a IN H` by rw[GSYM IN_IMAGE] >>
2485    `h.inv a IN H` by rw[group_inv_element] >>
2486    `f (h.inv a) IN Q` by rw[] >>
2487    metis_tac[group_linv]
2488  ]
2489QED
2490
2491(* Theorem: AbelianGroup (g excluding e) /\ INJ f G univ(:'b) /\ e IN G ==>
2492            AbelianGroup (monoid_inj_image g f excluding f e) *)
2493(* Proof:
2494   By AbelianMonoid_def, this is to show:
2495   (1) Group (monoid_inj_image g f excluding f e)
2496       True by group_inj_image_excluding_group.
2497   (2) x IN IMAGE f H /\ y IN IMAGE f H ==> (monoid_inj_image g f).op x y = (monoid_inj_image g f).op y x
2498       where H = G DIFF {e}
2499       Note H SUBSET G                                     by DIFF_SUBSET
2500         so !x. x IN H ==> LINV f G (f x) = x              by LINV_SUBSET
2501        and (monoid_inj_image g f excluding f e).carrier
2502          = (IMAGE f G) DIFF {f e}                         by monoid_inj_image_def, excluding_def
2503          = IMAGE f (G DIFF {e})                           by IMAGE_DIFF
2504          = IMAGE f H                                      by notation
2505       By monoid_inj_image_def, excluding_def, this is to show:
2506          f (t x * t y) = f (t y * t x)                    where t = LINV f G
2507       Note ?a. x = f a /\ a IN H                          by IN_IMAGE
2508            ?b. y = f b /\ b IN H                          by IN_IMAGE
2509         f (t x * t y)
2510       = f (t (f a) * t (f b))                             by x = f a, y = f b
2511       = f (a * b)                                         by !y. t (f y) = y
2512       = f (b * a)                                         by commutativity condition
2513       = f (t (f b) * t (f a))                             by !y. t (f y) = y
2514       = f (t y * t x)                                     by y = f b, x = f a
2515*)
2516Theorem group_inj_image_excluding_abelian_group:
2517  !(g:'a group) (f:'a -> 'b) e.
2518      AbelianGroup (g excluding e) /\ INJ f G univ(:'b) /\ e IN G ==>
2519      AbelianGroup (monoid_inj_image g f excluding f e)
2520Proof
2521  rw[AbelianGroup_def] >-
2522  rw[group_inj_image_excluding_group] >>
2523  qabbrev_tac `h = g excluding e` >>
2524  `h.carrier = G DIFF {e} /\ h.op = g.op /\ h.id = g.id` by rw[excluding_def, Abbr`h`] >>
2525  `H SUBSET G` by fs[] >>
2526  imp_res_tac LINV_SUBSET >>
2527  `(monoid_inj_image g f excluding f e).carrier = IMAGE f G DIFF {f e}` by rw[monoid_inj_image_def, excluding_def] >>
2528  `_ = IMAGE f H` by rw[IMAGE_DIFF] >>
2529  simp[monoid_inj_image_def, excluding_def] >>
2530  metis_tac[IN_IMAGE]
2531QED
2532
2533(* Theorem: INJ f G univ(:'b) ==> GroupHomo f g (monoid_inj_image g f) *)
2534(* Proof:
2535   Let s = IMAGE f G.
2536   Then BIJ f G s                              by INJ_IMAGE_BIJ_ALT
2537     so INJ f G s                              by BIJ_DEF
2538
2539   By GroupHomo_def, monoid_inj_image_def, this is to show:
2540   (1) x IN G ==> f x IN IMAGE f G, true       by IN_IMAGE
2541   (2) x IN R /\ y IN R ==> f (x * y) = f (LINV f R (f x) * LINV f R (f y))
2542       Since LINV f R (f x) = x                by BIJ_LINV_THM
2543         and LINV f R (f y) = y                by BIJ_LINV_THM
2544       The result is true.
2545*)
2546Theorem group_inj_image_group_homo:
2547  !(g:'a group) f. INJ f G univ(:'b) ==> GroupHomo f g (monoid_inj_image g f)
2548Proof
2549  rw[GroupHomo_def, monoid_inj_image_def] >>
2550  qabbrev_tac `s = IMAGE f G` >>
2551  `BIJ f G s` by rw[INJ_IMAGE_BIJ_ALT, Abbr`s`] >>
2552  `INJ f G s` by metis_tac[BIJ_DEF] >>
2553  metis_tac[BIJ_LINV_THM]
2554QED
2555
2556(* ------------------------------------------------------------------------- *)
2557(* Subgroup Documentation                                                    *)
2558(* ------------------------------------------------------------------------- *)
2559(* Data type group:
2560   The generic symbol for group data is g.
2561   g.carrier = Carrier set of group, overloaded as G.
2562   g.op      = Binary operation of group, overloaded as *.
2563   g.id      = Identity element of group, overloaded as #e.
2564   g.exp     = Iteration of g.op (added by monoid)
2565   g.inv     = Inverse of g.op   (added by monoid)
2566
2567   The generic symbol for a subgroup is h, denoted by h <= g.
2568   h.carrier = Carrier set of subgroup, overloaded as H.
2569   h.op      = Binary operation of subgroup, same as g.op = *.
2570   h.id      = Identity element of subgroup, same as g.id = #e.
2571
2572   Overloading (# is temporary):
2573   h <= g       = Subgroup h g
2574   a * H        = coset g a H
2575   H * a        = right_coset g H a
2576#  K            = k.carrier
2577#  x o y        = h.op x y
2578   sgbINTER g   = subgroup_big_intersect g
2579*)
2580(* Definitions and Theorems (# are exported):
2581
2582   Subgroup of a Group:
2583   Subgroup_def       |- !h g.  h <= g <=> Group h /\ Group g /\ H SUBSET G /\ (h.op = $* )
2584   subgroup_property  |- !g h. h <= g ==> Group h /\ Group g /\ H SUBSET G /\
2585                        !x y. x IN H /\ y IN H ==> (h.op x y = x * y)
2586#  subgroup_element   |- !g h. h <= g ==> !z. z IN H ==> z IN G
2587   subgroup_homomorphism   |- !g h. h <= g ==> Group h /\ Group g /\ subgroup h g
2588   subgroup_carrier_subset |- !g h. h <= g ==> H SUBSET G
2589   subgroup_op        |- !g h. h <= g ==> (h.op = $* )
2590   subgroup_id        |- !g h. h <= g ==> (h.id = #e)
2591   subgroup_inv       |- !g h. h <= g ==> !x. x IN H ==> (h.inv x = |/ x)
2592   subgroup_has_groups|- !g h. h <= g ==> Group g /\ Group h
2593   subgroup_is_group  |- !g h. h <= g ==> Group h
2594   subgroup_is_submonoid   |- !g h. h <= g ==> h << g
2595   subgroup_exp       |- !g h. h <= g ==> !x. x IN H ==> !n. h.exp x n = x ** n
2596   subgroup_alt       |- !g. Group g ==> !h. h <= g <=> H <> {} /\ H SUBSET G /\
2597                            (h.op = $* ) /\ (h.id = #e) /\ !x y. x IN H /\ y IN H ==> x * |/ y IN H
2598   subgroup_thm       |- !g h. h <= g <=>
2599                               Group g /\ (h.op = $* ) /\ (h.id = #e) /\ H <> {} /\ H SUBSET G /\
2600                         !x y. x IN H /\ y IN H ==> x * |/ y IN H
2601   subgroup_order     |- !g h. h <= g ==> !x. x IN H ==> (order h x = ord x)
2602
2603   Subgroup Theorems:
2604   subgroup_refl      |- !g. Group g ==> g <= g
2605   subgroup_antisym   |- !g h. h <= g /\ g <= h ==> (h = g)
2606   subgroup_trans     |- !g h t. h <= t /\ t <= g ==> h <= g
2607
2608   finite_subgroup_carrier_finite  |- !g. FiniteGroup g ==> !h. h <= g ==> FINITE H
2609   finite_subgroup_finite_group    |- !g. FiniteGroup g ==> !h. h <= g ==> FiniteGroup h
2610   abelian_subgroup_abelian        |- !g h. AbelianGroup g /\ h <= g ==> AbelianGroup h
2611
2612   subgroup_groups            |- !g h. h <= g ==> Group h /\ Group g
2613   subgroup_property_all      |- !g h. h <= g ==>
2614                                       Group g /\ Group h /\ H <> {} /\ H SUBSET G /\
2615                                       (h.op = $* ) /\ (h.id = #e) /\
2616                                       (!x. x IN H ==> (h.inv x = |/ x)) /\
2617                                        !x y. x IN H /\ y IN H ==> x * |/ y IN H
2618   subgroup_inv_closure       |- !g h. h <= g ==> !x y. x IN H /\ y IN H ==> x * |/ y IN H
2619   subgroup_carrier_nonempty  |- !g h. h <= g ==> H <> {}
2620   subgroup_eq_carrier        |- !g h. h <= g /\ (H = G) ==> (h = g)
2621   subgroup_eq                |- !g h1 h2. h1 <= g /\ h2 <= g ==> ((h1 = h2) <=> (h1.carrier = h2.carrier))
2622
2623   Cosets, especially cosets of a subgroup:
2624   coset_def         |- !g X a. a * X = IMAGE (\z. a * z) X
2625   left_coset_def    |- !g X a. left_coset g X a = a * X
2626   right_coset_def   |- !g X a. X * a = IMAGE (\z. z * a) X
2627   coset_alt         |- !g a X. a * X = {a * z | z IN X}
2628   left_coset_alt    |- !g X a. left_coset g X a = {a * z | z IN X}
2629   right_coset_alt   |- !g X a. X * a = {z * a | z IN X}
2630   coset_property    |- !g a. Group g /\ a IN G ==> !X. X SUBSET G ==> a * X SUBSET G
2631   coset_empty       |- !g a. Group g /\ a IN G ==> (a * {} = {})
2632   coset_element     |- !g X a. a IN G ==> !x. x IN a * X <=> ?y. y IN X /\ (x = a * y)
2633   in_coset          |- !g X a. a IN G ==> !x. x IN a * X <=> ?y. y IN X /\ (x = a * y)
2634   group_coset_eq_itself      |- !g a. Group g /\ a IN G ==> (a * G = G)
2635   group_coset_is_permutation |- !g a. Group g /\ a IN G ==> (a * G = G)
2636   subgroup_coset_subset    |- !g h a x. h <= g /\ a IN G /\ x IN a * H ==> x IN G
2637   element_coset_property   |- !g X a. a IN G ==> !x. x IN X ==> a * x IN a * X
2638   subgroup_coset_nonempty  |- !h g. h <= g ==> !x. x IN G ==> x IN x * H
2639   subgroup_coset_eq        |- !g h. h <= g ==> !x y. x IN G /\ y IN G ==> ((x * H = y * H) <=> |/ y * x IN H)
2640   subgroup_to_coset_bij    |- !g h. h <= g ==> !a. a IN G ==> BIJ (\x. a * x) H (a * H)
2641   subgroup_coset_card      |- !g h. h <= g /\ FINITE H ==> !a. a IN G ==> (CARD (a * H) = CARD H)
2642
2643   Lagrange's Theorem by Subgroups and Cosets:
2644   inCoset_def               |- !g h a b. inCoset g h a b <=> b IN a * H
2645   inCoset_refl              |- !g h. h <= g ==> !a. a IN G ==> inCoset g h a a
2646   inCoset_sym               |- !g h. h <= g ==> !a b. a IN G /\ b IN G /\
2647                                      inCoset g h a b ==> inCoset g h b a
2648   inCoset_trans             |- !g h. h <= g ==> !a b c. a IN G /\ b IN G /\ c IN G /\
2649                                      inCoset g h a b /\ inCoset g h b c ==> inCoset g h a c
2650   inCoset_equiv_on_carrier  |- !g h. h <= g ==> inCoset g h equiv_on G
2651   CosetPartition_def        |- !g h. CosetPartition g h = partition (inCoset g h) G
2652   carrier_card_by_coset_partition  |- !g h.  h <= g /\ FINITE G ==> (CARD G = SIGMA CARD (CosetPartition g h))
2653   coset_partition_element   |- !g h. h <= g ==> (!e. e IN CosetPartition g h <=> ?a. a IN G /\ (e = a * H))
2654   coset_partition_element_card |- !g h. h <= g /\ FINITE G ==> !e. e IN CosetPartition g h ==> (CARD e = CARD H)
2655   Lagrange_identity         |- !g h. h <= g /\ FINITE G ==> (CARD G = CARD H * CARD (CosetPartition g h))
2656   coset_partition_card      |- !g h. h <= g /\ FINITE G ==> (CARD (CosetPartition g h) = CARD G DIV CARD H)
2657   Lagrange_thm              |- !g h. h <= g /\ FINITE G ==> (CARD H) divides (CARD G)
2658
2659   Alternate proof without using inCoset:
2660   subgroup_coset_sym        |- !g h. h <= g ==> !a b. a IN G /\ b IN G /\ b IN a * H ==> a IN b * H
2661   subgroup_coset_trans      |- !g h. h <= g ==> !a b c. a IN G /\ b IN G /\ c IN G /\
2662                                                    b IN a * H /\ c IN b * H ==> c IN a * H
2663   subgroup_incoset_equiv  |- !g h. h <= g ==> left_coset g H equiv_on G
2664   carrier_card_by_subgroup_coset_partition |- !g h. h <= g /\ FINITE G ==> (CARD G = SIGMA CARD (partition (left_coset g H) G))
2665   subgroup_coset_partition_element |- !g h. h <= g ==> (!e. e IN partition (left_coset g H) G <=> ?a. a IN G /\ (e = a * H))
2666   subgroup_coset_card_partition_element |- !g h. h <= g /\ FINITE G ==> !e. e IN partition (left_coset g H) G ==> (CARD e = CARD H)
2667   Lagrange_identity_alt   |- !g h. h <= g /\ FINITE G ==> (CARD G = CARD H * CARD (partition (left_coset g H) G))
2668
2669   Useful Coset theorems:
2670   subgroup_coset_in_partition     |- !g h. h <= g ==>
2671                                      !x. x IN IMAGE (left_coset g H) G <=> x IN CosetPartition g h
2672   coset_partition_eq_coset_image  |- !g h. h <= g ==> (CosetPartition g h = IMAGE (left_coset g H) G)
2673   coset_id_eq_subgroup            |- !g h. h <= g ==> (#e * H = H)
2674
2675   Conjugate of sets and subgroups:
2676   conjugate_def                   |- !g a s. conjugate g a s = {a * z * |/ a | z IN s}
2677   conjugate_subgroup_def          |- !h g a. conjugate_subgroup h g a =
2678                                              <|carrier := conjugate g a H; id := #e; op := $* |>
2679   conjugate_subgroup_group        |- !g h. h <= g ==> !a. a IN G ==> Group (conjugate_subgroup h g a)
2680   conjugate_subgroup_subgroup     |- !g h. h <= g ==> !a::(G). conjugate_subgroup h g a <= g
2681   subgroup_conjugate_subgroup_bij |- !g h. h <= g ==> !a. a IN G ==>
2682                                            BIJ (\z. a * z * |/ a) H (conjugate_subgroup h g a).carrier
2683
2684   Subgroup Intersection:
2685   subgroup_intersect_has_inv   |- !g h k. h <= g /\ k <= g ==> !x. x IN H INTER K ==> |/ x IN H INTER K
2686   subgroup_intersect_group     |- !g h k. h <= g /\ k <= g ==> Group (h mINTER k)
2687   subgroup_intersect_inv       |- !g h k. h <= g /\ k <= g ==>
2688                                           !x. x IN H INTER K ==> ((h mINTER k).inv x = |/ x)
2689   subgroup_intersect_property  |- !g h k. h <= g /\ k <= g ==>
2690                                           ((h mINTER k).carrier = H INTER K) /\
2691                                           (!x y. x IN H INTER K /\ y IN H INTER K ==>
2692                                            ((h mINTER k).op x y = x * y)) /\ ((h mINTER k).id = #e) /\
2693                                            !x. x IN H INTER K ==> ((h mINTER k).inv x = |/ x)
2694   subgroup_intersect_subgroup  |- !g h k. h <= g /\ k <= g ==> (h mINTER k) <= g
2695
2696   Subgroup Big Intersection:
2697   subgroup_big_intersect_def   |- !g. sgbINTER g =
2698                                       <|carrier := BIGINTER (IMAGE (\h. H) {h | h <= g}); op := $*; id := #e|>
2699   subgroup_big_intersect_property  |- !g. ((sgbINTER g).carrier = BIGINTER (IMAGE (\h. H) {h | h <= g})) /\
2700                                           (!x y. x IN (sgbINTER g).carrier /\ y IN (sgbINTER g).carrier ==>
2701                                           ((sgbINTER g).op x y = x * y)) /\ ((sgbINTER g).id = #e)
2702   subgroup_big_intersect_element    |- !g x. x IN (sgbINTER g).carrier <=> !h. h <= g ==> x IN H
2703   subgroup_big_intersect_op_element |- !g x y. x IN (sgbINTER g).carrier /\ y IN (sgbINTER g).carrier ==>
2704                                               (sgbINTER g).op x y IN (sgbINTER g).carrier
2705   subgroup_big_intersect_has_id     |- !g. (sgbINTER g).id IN (sgbINTER g).carrier
2706   subgroup_big_intersect_has_inv    |- !g x. x IN (sgbINTER g).carrier ==> |/ x IN (sgbINTER g).carrier
2707   subgroup_big_intersect_subset     |- !g. Group g ==> (sgbINTER g).carrier SUBSET G
2708   subgroup_big_intersect_group      |- !g. Group g ==> Group (sgbINTER g)
2709   subgroup_big_intersect_subgroup   |- !g. Group g ==> sgbINTER g <= g
2710
2711   Subset Group:
2712   subset_group_def        |- !g s. subset_group g s = <|carrier := s; op := $*; id := #e|>
2713   subset_group_property   |- !g s. ((subset_group g s).carrier = s) /\
2714                                    ((subset_group g s).op = $* ) /\
2715                                    ((subset_group g s).id = #e)
2716   subset_group_exp        |- !g s x. x IN s ==> !n. (subset_group g s).exp x n = x ** n
2717   subset_group_order      |- !g s x. x IN s ==> (order (subset_group g s) x = ord x)
2718   subset_group_submonoid  |- !g s. Monoid g /\ #e IN s /\ s SUBSET G /\
2719                                    (!x y. x IN s /\ y IN s ==> x * y IN s) ==>
2720                                    subset_group g s << g
2721   subset_group_subgroup   |- !g s. Group g /\ s <> {} /\ s SUBSET G /\
2722                                    (!x y. x IN s /\ y IN s ==> x * |/ y IN s) ==>
2723                                    subset_group g s <= g
2724*)
2725(* ------------------------------------------------------------------------- *)
2726(* Subgroup of a Group.                                                      *)
2727(* ------------------------------------------------------------------------- *)
2728
2729(* A Subgroup is a subset of a group that's a group itself, keeping op, id, inv. *)
2730Definition Subgroup_def:
2731  Subgroup (h:'a group) (g:'a group) <=>
2732    Group h /\ Group g /\
2733    H SUBSET G /\ (h.op = g.op)
2734End
2735
2736(* Overload Subgroup *)
2737Overload "<=" = ``Subgroup``
2738(* already an infix symbol *)
2739
2740(* Note: The requirement $o = $* is stronger than the following:
2741val _ = overload_on ("<<", ``\(h g):'a group. Group g /\ Group h /\ subgroup h g``);
2742Since subgroup h g is based on GroupHomo I g h, which only gives
2743!x y. x IN H /\ y IN H ==> (h.op x y = x * y))
2744
2745This is not enough to satisfy monoid_component_equality,
2746hence cannot prove: h << g /\ g << h ==> h = g
2747*)
2748
2749(*
2750val subgroup_property = save_thm(
2751  "subgroup_property",
2752  Subgroup_def
2753      |> SPEC_ALL
2754      |> REWRITE_RULE [ASSUME ``h:'a group <= g``]
2755      |> CONJUNCTS
2756      |> (fn thl => List.take(thl, 2) @ List.drop(thl, 3))
2757      |> LIST_CONJ
2758      |> DISCH_ALL
2759      |> Q.GEN `h` |> Q.GEN `g`);
2760val subgroup_property = |- !g h. h <= g ==> Group h /\ Group g /\ (h.op = $* )
2761*)
2762
2763(* Theorem: properties of subgroup *)
2764(* Proof: Assume h <= g, then derive all consequences of definition *)
2765Theorem subgroup_property:
2766    !(g:'a group) h. h <= g ==> Group h /\ Group g /\ (!x y. x IN H /\ y IN H ==> (h.op x y = x * y))
2767Proof
2768  rw_tac std_ss[Subgroup_def]
2769QED
2770
2771(* Theorem: elements in subgroup are also in group. *)
2772(* Proof: since subgroup carrier is a subset of group carrier. *)
2773Theorem subgroup_element:
2774    !(g:'a group) (h:'a group). h <= g ==> !z. z IN H ==> z IN G
2775Proof
2776  rw_tac std_ss[Subgroup_def, SUBSET_DEF]
2777QED
2778
2779(* Theorem: A subgroup h of g implies identity is a homomorphism from h to g.
2780        or  h <= g ==> Group h /\ Group g /\ GroupHomo I h g  *)
2781(* Proof: check definitions. *)
2782Theorem subgroup_homomorphism:
2783    !(g:'a group) h. h <= g ==> Group h /\ Group g /\ subgroup h g
2784Proof
2785  rw_tac std_ss[Subgroup_def, subgroup_def, GroupHomo_def, SUBSET_DEF]
2786QED
2787
2788(* original:
2789g `!(g:'a group) h. h <= g = Group h /\ Group g /\ subgroup h g`;
2790e (rw_tac std_ss[Subgroup_def, subgroup_def, GroupHomo_def, SUBSET_DEF, EQ_IMP_THM]);
2791
2792The only-if part (<==) cannot be proved:
2793Note Subgroup_def uses h.op = g.op,
2794but subgroup_def uses homomorphism I, and so cannot show this for any x y.
2795*)
2796
2797(* Theorem: h <= g ==> H SUBSET G *)
2798(* Proof: by Subgroup_def *)
2799Theorem subgroup_carrier_subset:
2800    !(g:'a group) h. h <= g ==> H SUBSET G
2801Proof
2802  rw[Subgroup_def]
2803QED
2804
2805(* Theorem: h <= g ==> (h.op = $* ) *)
2806(* Proof: by Subgroup_def *)
2807Theorem subgroup_op:
2808    !(g:'a group) h. h <= g ==> (h.op = g.op)
2809Proof
2810  rw[Subgroup_def]
2811QED
2812
2813(* Theorem: h <= g ==> h.id = #e *)
2814(* Proof:
2815   Since h.id IN H    by group_id_element
2816     h.id * h.id
2817   = h.op h.id h.id   by Subgroup_def
2818   = h.id             by group_id_id
2819   But h.id IN G      by SUBSET_DEF
2820   hence h.id = #e    by group_id_fix
2821   or
2822   by group_homo_id and subgroup_homomorphism.
2823*)
2824Theorem subgroup_id:
2825    !g h. h <= g ==> (h.id = #e)
2826Proof
2827  rpt strip_tac >>
2828  `!x. I x = x` by rw[] >>
2829  metis_tac[group_homo_id, subgroup_homomorphism, subgroup_def]
2830QED
2831
2832(* Theorem: h <= g ==> h.inv x = |/x *)
2833(* Proof: by group_homo_inv and subgroup_homomorphism. *)
2834Theorem subgroup_inv:
2835    !g h. h <= g ==> !x. x IN H ==> (h.inv x = |/ x)
2836Proof
2837  rpt strip_tac >>
2838  `!x. I x = x` by rw[] >>
2839  metis_tac[group_homo_inv, subgroup_homomorphism, subgroup_def]
2840QED
2841
2842(* Theorem: h <= g ==> Group g /\ Group h *)
2843(* Proof: by Subgroup_def *)
2844Theorem subgroup_has_groups:
2845    !g:'a group h. h <= g ==> Group g /\ Group h
2846Proof
2847  metis_tac[Subgroup_def]
2848QED
2849
2850(* Theorem: h <= g ==> Group h *)
2851(* Proof: by Subgroup_def *)
2852Theorem subgroup_is_group:
2853    !g:'a group h. h <= g ==> Group h
2854Proof
2855  metis_tac[Subgroup_def]
2856QED
2857
2858(* Theorem: h <= g ==> h << g *)
2859(* Proof:
2860   Since h <= g ==> Group h /\ Group g /\ H SUBSET G /\ (h.op = $* )  by Subgroup_def
2861   To satisfy Submonoid_def, need to show:
2862   (1) Group h ==> Monoid h, true by group_is_monoid
2863   (2) Group g ==> Monoid g, true by group_is_monoid
2864   (3) h <= g ==> h.id = #e, true by subgroup_id
2865*)
2866Theorem subgroup_is_submonoid:
2867  !(g:'a group) h. h <= g ==> h << g
2868Proof
2869  rpt strip_tac >>
2870  `Group h /\ Group g /\ H SUBSET G /\ (h.op = $* )` by metis_tac[Subgroup_def] >>
2871  rw_tac std_ss[Submonoid_def] >| [
2872    rw[],
2873    rw[],
2874    rw[subgroup_id]
2875  ]
2876QED
2877
2878(* Theorem: h <= g ==> !x. x IN H ==> !n. h.exp x n = x ** n *)
2879(* Proof: by subgroup_is_submonoid, submonoid_exp *)
2880Theorem subgroup_exp:
2881    !(g:'a group) h. h <= g ==> !x. x IN H ==> !n. h.exp x n = x ** n
2882Proof
2883  rw_tac std_ss[subgroup_is_submonoid, submonoid_exp]
2884QED
2885
2886(* Theorem: h <= g <=> H <> {} /\ H SUBSET G /\ h.op = g.op /\ h.id = #e /\ !x y IN H, x * |/ y IN H *)
2887(* Proof:
2888   By Subgroup_def, this is to show:
2889   (1) Group h ==> H <> {}
2890       True by group_id_element.
2891   (2) h <= g ==> h.id = #e
2892       True by subgroup_id.
2893   (3) Group h /\ x IN H /\ y IN H ==> x * |/ y IN H
2894       Since y IN H ==> |/ y IN H     by group_inv_element, subgroup_inv
2895       Hence x * |/ y IN H            by group_op_element
2896   (4) H SUBSET G /\ !x y. x IN H /\ y IN H ==> x * |/ y IN H ==> Group h
2897       Put y = x, x * |/ x = #e   IN H                  by group_rinv
2898       Put x = #e, y IN H ==> #e * |/ y = |/ y IN H     by group_lid
2899       x * y = x * |/ ( |/ y) IN H                      by group_inv_inv
2900       Verify by group_def_alt.
2901*)
2902Theorem subgroup_alt:
2903    !g:'a group. Group g ==>
2904      !h. h <= g <=> (H <> {} /\ H SUBSET G /\ (h.op = g.op) /\ (h.id = #e) /\
2905                      !x y. x IN H /\ y IN H ==> x * |/ y IN H)
2906Proof
2907  rw[Subgroup_def, EQ_IMP_THM] >-
2908  metis_tac[group_id_element, MEMBER_NOT_EMPTY] >-
2909  rw[subgroup_id, Subgroup_def] >-
2910  metis_tac[group_inv_element, group_op_element, subgroup_inv, Subgroup_def] >>
2911  `?x. x IN H` by rw[MEMBER_NOT_EMPTY] >>
2912  `!x. x IN H ==> x IN G` by metis_tac[SUBSET_DEF] >>
2913  `#e IN H` by metis_tac[group_rinv] >>
2914  `!y. y IN H ==> |/ y IN H` by metis_tac[group_lid, group_inv_element] >>
2915  `!x y. x IN H /\ y IN H ==> x * y IN H` by metis_tac[group_inv_inv] >>
2916  rw[group_def_alt] >-
2917  rw[group_assoc] >>
2918  metis_tac[group_linv]
2919QED
2920
2921(* Theorem: h <= g <=>
2922       (Group g /\  (h.op = g.op) /\ (h.id = #e) /\
2923        H <> {} /\ H SUBSET G /\ !x y. x IN H /\ y IN H ==> x * |/ y IN H) *)
2924(* Proof: by Subgroup_def, subgroup_alt *)
2925Theorem subgroup_thm:
2926    !g:'a group h. h <= g <=>
2927       (Group g /\  (h.op = g.op) /\ (h.id = #e) /\
2928        H <> {} /\ H SUBSET G /\ !x y. x IN H /\ y IN H ==> x * |/ y IN H)
2929Proof
2930  metis_tac[subgroup_alt, Subgroup_def]
2931QED
2932
2933(* Theorem: h <= g ==> !x. x IN H ==> (order h x = ord x) *)
2934(* Proof:
2935   Note Group g /\ Group h /\ subgroup h g    by subgroup_homomorphism, h <= g
2936   Thus !x. x IN H ==> (order h x = ord x)    by subgroup_order_eqn
2937*)
2938Theorem subgroup_order:
2939    !g:'a group h. h <= g ==> !x. x IN H ==> (order h x = ord x)
2940Proof
2941  metis_tac[subgroup_homomorphism, subgroup_order_eqn]
2942QED
2943
2944(* ------------------------------------------------------------------------- *)
2945(* Subgroup Theorems                                                         *)
2946(* ------------------------------------------------------------------------- *)
2947
2948(* Theorem: g <= g *)
2949(* Proof: by definition, this is to show:
2950   G SUBSET G, true by SUBSET_REFL.
2951*)
2952Theorem subgroup_refl:
2953    !g:'a group. Group g ==> g <= g
2954Proof
2955  rw[Subgroup_def]
2956QED
2957
2958(* Theorem: h <= g /\ g <= h ==> (h = g) *)
2959(* Proof:
2960   By monoid_component_equality, this is to show:
2961   (1) h <= g /\ g <= h ==> H = G
2962       By Subgroup_def, H SUBSET G /\ G SUBSET H,
2963       hence true by SUBSET_ANTISYM.
2964   (2) h <= g /\ g <= h ==> h.op = $*
2965       True by Subgroup_def.
2966   (3) h <= g /\ g <= h ==> h.id = #e
2967*)
2968Theorem subgroup_antisym:
2969    !(g:'a group) (h:'a group). h <= g /\ g <= h ==> (h = g)
2970Proof
2971  metis_tac[monoid_component_equality, Subgroup_def, SUBSET_ANTISYM, subgroup_id]
2972QED
2973
2974(* Theorem: h <= t /\ t <= g ==> h <= g *)
2975(* Proof: by definition, this is to show:
2976   H SUBSET t.carrier /\ t.carrier SUBSET G ==> H SUBSET G
2977   True by SUBSET_TRANS.
2978*)
2979Theorem subgroup_trans:
2980    !(g:'a group) (h:'a group) (t:'a group). h <= t /\ t <= g ==> h <= g
2981Proof
2982  rw[Subgroup_def] >>
2983  metis_tac[SUBSET_TRANS]
2984QED
2985
2986(* Theorem: FiniteGroup g ==> !h. h <= g ==> FINITE H *)
2987(* Proof:
2988   Since FiniteGroup g
2989     ==> Group g /\ FINITE G               by FiniteGroup_def
2990     and h <= g ==> Group h /\ H SUBSET G  by Subgroup_def
2991   Hence FINITE H                          by SUBSET_FINITE
2992*)
2993Theorem finite_subgroup_carrier_finite:
2994    !g:'a group. FiniteGroup g ==> !h. h <= g ==> FINITE H
2995Proof
2996  metis_tac[FiniteGroup_def, Subgroup_def, SUBSET_FINITE]
2997QED
2998
2999(* Theorem: FiniteGroup g ==> !h. h <= g ==> FiniteGroup h *)
3000(* Proof:
3001   Since FiniteGroup g
3002     ==> Group g /\ FINITE G               by FiniteGroup_def
3003     and h <= g ==> Group h /\ H SUBSET G  by Subgroup_def
3004   Hence FINITE H                          by SUBSET_FINITE
3005    thus FiniteGroup h                     by FiniteGroup_def
3006*)
3007Theorem finite_subgroup_finite_group:
3008    !g:'a group. FiniteGroup g ==> !h. h <= g ==> FiniteGroup h
3009Proof
3010  metis_tac[FiniteGroup_def, Subgroup_def, SUBSET_FINITE]
3011QED
3012
3013(* Theorem: AbelianGroup g /\ h <= g ==> AbelianGroup h *)
3014(* Proof:
3015   Note AbelianGroup g
3016    <=> Group g /\ !x y. x IN G /\ y IN G ==> (x * y = y * x)  by AbelianGroup_def
3017   Also h <= g
3018    <=> Group h /\ Group g /\ H SUBSET G /\ (h.op = $* )       by Subgroup_def
3019   With Group h              by above
3020    and !x y. x IN H /\ y IN H
3021    ==> x IN G /\ y IN G              by SUBSET_DEF
3022    ==> x * y = y * x                 by above, commutativity
3023    ==> h.op x y = h.op y x           by above, h.op = $*
3024   Thus AbelianGroup h                by AbelianGroup_def
3025*)
3026Theorem abelian_subgroup_abelian:
3027    !(g:'a group) h. AbelianGroup g /\ h <= g ==> AbelianGroup h
3028Proof
3029  rw_tac std_ss[AbelianGroup_def, Subgroup_def, SUBSET_DEF]
3030QED
3031
3032(* Theorem: h <= g ==> Group h /\ Group g *)
3033(* Proof: by subgroup_property *)
3034Theorem subgroup_groups:
3035    !(g:'a group) h. h <= g ==> Group h /\ Group g
3036Proof
3037  metis_tac[subgroup_property]
3038QED
3039
3040(* Theorem: h <= g ==> Group g /\ Group h /\ H <> {} /\ H SUBSET G /\ (h.op = $* ) /\ (h.id = #e) /\
3041                       (!x. x IN H ==> (h.inv x = |/ x)) /\
3042                       (!x y. x IN H /\ y IN H ==> x * ( |/ y) IN H) *)
3043(* Proof: by subgroup_property, subgroup_alt, subgroup_inv *)
3044Theorem subgroup_property_all:
3045    !(g:'a group) h. h <= g ==> Group g /\ Group h /\
3046    H <> {} /\ H SUBSET G /\ (h.op = g.op ) /\ (h.id = #e) /\
3047    (!x. x IN H ==> (h.inv x = |/ x)) /\
3048    (!x y. x IN H /\ y IN H ==> x * ( |/ y) IN H)
3049Proof
3050  metis_tac[subgroup_property, subgroup_inv, subgroup_alt]
3051QED
3052
3053(* Theorem: h <= g ==> !x y. x IN H /\ y IN H ==> x * |/ y IN H *)
3054(* Proof: by subgroup_property_all *)
3055Theorem subgroup_inv_closure:
3056    !(g:'a group) h. h <= g ==> !x y. x IN H /\ y IN H ==> x * ( |/ y) IN H
3057Proof
3058  rw[subgroup_property_all]
3059QED
3060
3061(* Theorem: h <= g ==> H <> {} *)
3062(* Proof: by subgroup_property_all, or
3063     h <= g ==> Group h     by Subgroup_def
3064            ==> H <> {}     by group_carrier_nonempty
3065*)
3066Theorem subgroup_carrier_nonempty:
3067    !(g:'a group) h. h <= g ==> H <> {}
3068Proof
3069  rw[Subgroup_def, group_carrier_nonempty]
3070QED
3071
3072(* Theorem: h <= g /\ (H = G) ==> (h = g) *)
3073(* Proof:
3074   By subgroup_antisym, this is to show:
3075   Note Group h /\ Group g         by subgroup_groups
3076   Note (1) G <> {}, true          by group_carrier_nonempty
3077        (2) $* = h.op, true        by subgroup_alt
3078        (3) #e = h.id, true        by subgroup_alt
3079        (4) x IN G /\ y IN G ==> h.op x (h.inv y) IN G,
3080            This is true           by subgroup_alt, subgroup_inv, group_op_element
3081   Thus g <= h.
3082   With given h <= g, h = g        by subgroup_antisym
3083*)
3084Theorem subgroup_eq_carrier:
3085    !(g:'a group) h. h <= g /\ (H = G) ==> (h = g)
3086Proof
3087  rpt strip_tac >>
3088  (irule subgroup_antisym >> rpt conj_tac) >| [
3089    `Group h /\ Group g` by metis_tac[subgroup_groups] >>
3090    rw[subgroup_alt] >-
3091    rw[group_carrier_nonempty] >-
3092    metis_tac[subgroup_alt] >-
3093    metis_tac[subgroup_alt] >>
3094    metis_tac[subgroup_alt, subgroup_inv, group_op_element],
3095    rw[]
3096  ]
3097QED
3098
3099(* Theorem: h1 <= g /\ h2 <= g ==> ((h1 = h2) <=> (h1.carrier = h2.carrier)) *)
3100(* Proof:
3101   Note h1 <= g ==> h1.op = g.op /\ h1.id = #e    by subgroup_op, subgroup_id
3102    and h2 <= g ==> h2.op = g.op /\ h2.id = #e    by subgroup_op, subgroup_id
3103   Thus (h1 = h2) <=> (h1.carrier = h2.carrier)   by monoid_component_equality
3104*)
3105Theorem subgroup_eq:
3106    !g:'a group. !h1 h2. h1 <= g /\ h2 <= g ==> ((h1 = h2) <=> (h1.carrier = h2.carrier))
3107Proof
3108  metis_tac[subgroup_op, subgroup_id, monoid_component_equality]
3109QED
3110
3111(* ------------------------------------------------------------------------- *)
3112(* Cosets, especially cosets of a subgroup.                                  *)
3113(* ------------------------------------------------------------------------- *)
3114
3115(* Define (left) coset of subgroup with an element a. *)
3116Definition coset_def:
3117  coset (g:'a group) a X = IMAGE (\z. a * z) X
3118End
3119
3120(* Define left coset of subgroup with an element a. *)
3121Definition left_coset_def:
3122  left_coset (g:'a group) X a = coset g a X
3123End
3124
3125(* Define right coset of subgroup with an element a. *)
3126Definition right_coset_def:
3127  right_coset (g:'a group) X a = IMAGE (\z. z * a) X
3128End
3129
3130(* set overloading after all above defintions. *)
3131Overload "*" = ``coset g``
3132Overload "*" = ``right_coset g``
3133
3134(* Derive theorems. *)
3135Theorem coset_alt =
3136    coset_def |> SIMP_RULE bool_ss [IMAGE_DEF];
3137(* val coset_alt = |- !g a X. a * X = {a * z | z IN X}: thm *)
3138
3139Theorem left_coset_alt =
3140    left_coset_def |> REWRITE_RULE [coset_alt];
3141(* val left_coset_alt = |- !g X a. left_coset g X a = {a * z | z IN X}: thm *)
3142
3143Theorem right_coset_alt =
3144    right_coset_def |> SIMP_RULE bool_ss [IMAGE_DEF];
3145(* val right_coset_alt = |- !g X a. X * a = {z * a | z IN X}: thm *)
3146
3147(* Theorem: a * X SUBSET G *)
3148(* Proof: by definition. *)
3149Theorem coset_property:
3150    !(g:'a group) a. Group g /\ a IN G ==> !X. X SUBSET G ==> a * X SUBSET G
3151Proof
3152  rw[coset_def, SUBSET_DEF] >>
3153  metis_tac[group_op_element]
3154QED
3155
3156(* Theorem: a * {} = {} *)
3157(* Proof: by definition. *)
3158Theorem coset_empty:
3159    !(g:'a group) a. Group g /\ a IN G ==> (a * {} = {})
3160Proof
3161  rw[coset_def]
3162QED
3163
3164(* Theorem: For x IN a * X <=> ?y IN X /\ x = a * y *)
3165(* Proof: by coset_def, x is IN IMAGE.
3166   Essentially this is to prove:
3167     z IN X <=> ?y. y IN X /\ (a * z = a * y)
3168   Take y = z.
3169*)
3170Theorem coset_element:
3171    !(g:'a group) X a. a IN G ==> !x. x IN a * X <=> ?y. y IN X /\ (x = a * y)
3172Proof
3173  rw[coset_def] >>
3174  metis_tac[]
3175QED
3176
3177(* Theorem alias *)
3178Theorem in_coset = coset_element;
3179(*
3180val in_coset = |- !g X a. a IN G ==> !x. x IN a * X <=> ?y. y IN X /\ (x = a * y): thm
3181*)
3182
3183(* Theorem: Group g, a IN G ==> a * G = G *)
3184(* Proof:
3185   By closure property of g.op.
3186   This is to prove:
3187   (1) a * z IN G, true by group_op_element.
3188   (2) ?z. (x = a * z) /\ z IN G, true by z = |/a * x, from group_rsolve.
3189*)
3190Theorem group_coset_eq_itself:
3191    !(g:'a group) a. Group g /\ a IN G ==> (a * G = G)
3192Proof
3193  rw[coset_def, EXTENSION, EQ_IMP_THM] >-
3194  rw[] >>
3195  qexists_tac `|/a * x` >>
3196  rw[group_linv_assoc]
3197QED
3198
3199(* Theorem: [Cosets of a group are permutations]
3200            (a * G) = G *)
3201(* Proof:
3202   Essentially this is to prove:
3203   (1) a IN G /\ x IN G ==> a*x IN G, true by group_op_element
3204   (2) a IN G /\ x IN G ==> ?z. (x = a * z) /\ z IN G, true by group_rsolve
3205*)
3206Theorem group_coset_is_permutation:
3207    !(g:'a group) a. Group g /\ a IN G ==> (a * G = G)
3208Proof
3209  rw[coset_def, EXTENSION, EQ_IMP_THM] >| [
3210    rw_tac std_ss[group_op_element] >>
3211    rw[],
3212    `|/ a * x IN G` by rw[] >>
3213    metis_tac[group_rsolve]
3214  ]
3215QED
3216
3217(* Theorem: Group g, h <= g, a IN G /\ x IN a * H ==> x IN G *)
3218(* Proof:
3219   Coset contains all  x = a*z  where a IN G and z IN H, so x IN G by group_op_element.
3220*)
3221Theorem subgroup_coset_subset:
3222    !(g:'a group) (h:'a group) a x. h <= g /\ a IN G /\ x IN a * H ==> x IN G
3223Proof
3224  rw_tac std_ss[coset_def, Subgroup_def, SUBSET_DEF, IMAGE_DEF, GSPECIFICATION] >>
3225  rw_tac std_ss[group_op_element]
3226QED
3227
3228(* Theorem: For all x IN H, a * x IN a * H. *)
3229(* Proof: by coset definition
3230   or to prove: ?z. (a * x = a * z) /\ z IN H. Take z = x.
3231*)
3232Theorem element_coset_property:
3233    !(g:'a group) X a. a IN G ==> !x. x IN X ==> a * x IN a * X
3234Proof
3235  rw[coset_def]
3236QED
3237
3238(* Theorem: For h <= g, x IN x * H *)
3239(* Proof:
3240   Since #e IN H   by subgroup_id
3241   and x * #e = x  by group_rid
3242   Essentially this is to prove:
3243   (1) ?z. (x = x * z) /\ z IN H, true by z = #e.
3244*)
3245Theorem subgroup_coset_nonempty:
3246    !(g:'a group) h. h <= g ==> !x. x IN G ==> x IN x * H
3247Proof
3248  rw[coset_def] >>
3249  metis_tac[subgroup_id, group_rid, group_id_element, Subgroup_def]
3250QED
3251
3252(* eliminate "group" from default simpset *)
3253(* val groupSS = diminish_srw_ss ["group"]; *)
3254(* val mySS = diminish_srw_ss ["subgroup"]; *)
3255
3256(* Theorem: For h <= g, y IN x * H ==> ?z IN H /\ x = y * z *)
3257(* Proof:
3258   This is to prove:
3259   x * z IN G /\ z IN H ==> ?z'. z' IN H /\ (x = x * z * z')
3260   Just take z' = |/z.
3261*)
3262Theorem subgroup_coset_relate[local]:
3263    !(g:'a group) h. h <= g ==> !x y. x IN G /\ y IN G /\ y IN x * H ==> ?z. z IN H /\ (x = y * z)
3264Proof
3265  rw[coset_def] >>
3266  metis_tac[subgroup_inv, group_rinv_assoc, subgroup_element, group_inv_element, Subgroup_def]
3267QED
3268
3269(* Theorem: For h <= g, |/y * x in H ==> x * H = y * H. *)
3270(* Proof:
3271   Essentially this is to prove:
3272   (1) |/ y * x IN H /\ z IN H ==> ?z'. (x * z = y * z') /\ z' IN H
3273       Solving, z' = |/y * (x * z) = ( |/y * x) * z, in H by group_op_element.
3274   (2) |/ y * x IN H /\ z IN H ==> ?z'. (y * z = x * z') /\ z' IN H
3275       Solving, z' = |/x * (y * z) = ( |/x * y) * z, and |/( |/y * x) = |/x * y IN H.
3276*)
3277Theorem subgroup_coset_eq1[local]:
3278    !(g:'a group) h. h <= g ==> !x y. x IN G /\ y IN G /\ ( |/y * x) IN H ==> (x * H = y * H)
3279Proof
3280  rpt strip_tac >>
3281  `Group h /\ Group g /\ !x y. x IN H /\ y IN H ==> (h.op x y = x * y)` by metis_tac[Subgroup_def] >>
3282  rw[coset_def, EXTENSION, EQ_IMP_THM] >| [
3283    `z IN G` by metis_tac[subgroup_element] >>
3284    `y * ( |/y * x * z) = x * z` by rw[group_assoc, group_linv_assoc] >>
3285    metis_tac[group_op_element],
3286    `z IN G` by metis_tac[subgroup_element] >>
3287    `x * ( |/x * y * z) = y * z` by rw[group_assoc, group_linv_assoc] >>
3288    `|/( |/y * x) = |/x * y` by rw[group_inv_op] >>
3289    metis_tac[subgroup_inv, group_inv_element, group_op_element]
3290  ]
3291QED
3292
3293(* Theorem: For h <= g, x * H = y * H ==> |/y * x in H. *)
3294(* Proof:   Since y IN y * H, always, by subgroup_coset_nonempty.
3295   we have y IN x * H, since the cosets are equal.
3296   hence ?z IN H /\  x = y * z  by subgroup_coset_relate.
3297   Solving, z = |/y * x, and z IN H.
3298*)
3299Theorem subgroup_coset_eq2[local]:
3300    !(g:'a group) h. h <= g ==> !x y. x IN G /\ y IN G /\ (x * H = y * H) ==> ( |/y * x) IN H
3301Proof
3302  rpt strip_tac >>
3303  `y IN x * H` by rw_tac std_ss[subgroup_coset_nonempty] >>
3304  `?z. z IN H /\ (x = y * z)` by rw_tac std_ss[subgroup_coset_relate] >>
3305  metis_tac[group_rsolve, Subgroup_def, subgroup_element]
3306QED
3307
3308(* Theorem: For h <= g, x * H = y * H iff |/y * x in H *)
3309(* Proof:
3310   By subgroup_coset_eq1 and subgroup_coset_eq2.
3311*)
3312Theorem subgroup_coset_eq:
3313    !(g:'a group) h. h <= g ==> !x y. x IN G /\ y IN G ==> ((x * H = y * H) <=> |/y * x IN H)
3314Proof
3315  metis_tac[subgroup_coset_eq1, subgroup_coset_eq2]
3316QED
3317
3318(* Theorem: There is a bijection between subgroup and its cosets. *)
3319(* Proof:
3320   Essentially this is to prove:
3321   (1) x IN H ==> a * x IN a * H
3322       True by element_coset_property.
3323   (2) x IN H /\ x' IN H /\ a * x = a * x' ==> x = x'
3324       True by group_lcancel.
3325   (3) same as (1)
3326   (4) x IN a * H ==> ?x'. x' IN H /\ (a * x' = x)
3327       True by coset_element.
3328*)
3329Theorem subgroup_to_coset_bij:
3330    !(g:'a group) h. h <= g ==> !a. a IN G ==> BIJ (\x. a * x) H (a * H)
3331Proof
3332  rw_tac std_ss[BIJ_DEF, SURJ_DEF, INJ_DEF, element_coset_property] >| [
3333    metis_tac[group_lcancel, subgroup_element, Subgroup_def],
3334    metis_tac[coset_element]
3335  ]
3336QED
3337
3338(* Theorem: All cosets of subgroup are of the same size as the subgroup *)
3339(* Proof:
3340   Due to BIJ (\x. a*x) H (a * H), and sets are FINITE.
3341*)
3342(* Note: An infinite group can have a finite subgroup, e.g. the units of complex multiplication. *)
3343Theorem subgroup_coset_card:
3344    !(g:'a group) h. h <= g /\ FINITE H  ==> !a. a IN G ==> (CARD (a * H) = CARD H)
3345Proof
3346  rpt strip_tac >>
3347  `BIJ (\x. a * x) H (a * H)` by rw_tac std_ss[subgroup_to_coset_bij] >>
3348  `FINITE (a * H)` by rw[coset_def] >>
3349  metis_tac[FINITE_BIJ_CARD_EQ]
3350QED
3351
3352(* ------------------------------------------------------------------------- *)
3353(* Lagrange's Theorem by Subgroups and Cosets                                *)
3354(* ------------------------------------------------------------------------- *)
3355
3356(* From subgroup_coset_card:
3357   `!g h a. Group g /\ h <= g /\ a IN G /\ FINITE H ==> (CARD (a * H) = CARD (H))`
3358
3359   This can be used directly to prove Lagrange's Theorem for subgroup.
3360*)
3361
3362(* Theorem: (Lagrange Theorem) For FINITE Group g, size of subgroup divides size of group. *)
3363(* Proof:
3364   For the action g.op h G
3365
3366     CARD G
3367   = SIGMA CARD (TargetPartition g.op h G)  by CARD_TARGET_BY_PARTITION
3368   = (CARD H) * CARD (TargetPartition g.op h G)
3369           by SIGMA_CARD_CONSTANT, and (CARD e = CARD H) from CARD_subgroup_partition
3370
3371   Hence (CARD H) divides (CARD G).
3372*)
3373
3374(* Define b ~ a  when  b IN (a * H) *)
3375Definition inCoset_def:
3376  inCoset (g:'a group) (h:'a group) a b <=> b IN (a * H)
3377End
3378
3379(* Theorem: inCoset is Reflexive:
3380            h <= g /\ a IN G ==> inCoset g h a a *)
3381(* Proof:
3382   Follows from subgroup_coset_nonempty.
3383*)
3384Theorem inCoset_refl:
3385    !(g:'a group) h. h <= g ==> !a. a IN G ==> inCoset g h a a
3386Proof
3387  rw_tac std_ss[inCoset_def, subgroup_coset_nonempty]
3388QED
3389
3390(* Theorem: inCoset is Symmetric:
3391            h <= g /\ a IN G /\ b IN G ==> (inCoset g h a b ==> inCoset g h b a) *)
3392(* Proof:
3393       inCoset g h a b
3394   ==> b IN (a * H)          by definition
3395   ==> ?z in H. b = a * z    by coset_element
3396   ==> |/z in H              by h <= g, group_inv_element
3397   ==> b * ( |/z) = (a * z) * ( |/z)
3398                  = a        by group_rinv_assoc
3399   The result follows        by element_coset_property:
3400   !x. x IN H ==> b * x IN b * H  -- take x = |/z.
3401*)
3402Theorem inCoset_sym:
3403    !(g:'a group) h. h <= g ==> !a b. a IN G /\ b IN G /\ inCoset g h a b ==> inCoset g h b a
3404Proof
3405  rw_tac std_ss[inCoset_def] >>
3406  `Group h/\ Group g /\ !x. x IN H ==> x IN G` by metis_tac[Subgroup_def, subgroup_element] >>
3407  `?z. z IN H /\ (b = a * z)` by rw_tac std_ss[GSYM coset_element] >>
3408  `|/z IN H` by metis_tac[subgroup_inv, group_inv_element] >>
3409  metis_tac[element_coset_property, group_rinv_assoc]
3410QED
3411
3412(* Theorem: inCoset is Transitive:
3413            h <= g /\ a IN G /\ b IN G /\ c IN G
3414            ==> (inCoset g h a b /\ inCoset g h b c ==> inCoset g h a c) *)
3415(* Proof:
3416       inCoset g h a b
3417   ==> b IN (a * H)          by definition
3418   ==> ?y in H. b = a * y    by coset_element
3419
3420       inCoset g h b c
3421   ==> c IN (b * H)          by definition
3422   ==> ?z in H. c = b * z    by coset_element
3423
3424   Hence  c = b * z
3425            = (a * y)* z
3426            = a * (y * z)    by group_assoc
3427   Since y * z in H          by group_op_element
3428   Hence  c IN (a * H), the result follows from element_coset_property.
3429*)
3430Theorem inCoset_trans:
3431    !(g:'a group) h. h <= g ==> !a b c. a IN G /\ b IN G /\ c IN G /\ inCoset g h a b /\ inCoset g h b c ==> inCoset g h a c
3432Proof
3433  rw_tac std_ss[inCoset_def] >>
3434  `Group h /\ Group g /\ !x. x IN H ==> x IN G` by metis_tac[Subgroup_def, subgroup_element] >>
3435  `?y. y IN H /\ (b = a * y) /\ ?z. z IN H /\ (c = b * z)` by rw_tac std_ss[GSYM coset_element] >>
3436  `c = a * (y * z)` by rw[group_assoc] >>
3437  metis_tac[element_coset_property, group_op_element, subgroup_property]
3438QED
3439
3440(* Theorem: inCoset is an equivalence relation.
3441            Group g /\ h <= g ==> (inCoset g h) is an equivalent relation on G. *)
3442(* Proof:
3443   By inCoset_refl, inCoset_sym, and inCoset_trans.
3444*)
3445Theorem inCoset_equiv_on_carrier:
3446    !(g:'a group) h. h <= g ==> inCoset g h equiv_on G
3447Proof
3448  rw_tac std_ss[equiv_on_def] >>
3449  metis_tac[inCoset_refl, inCoset_sym, inCoset_trans]
3450QED
3451
3452(* Define coset partitions of G by inCoset g h. *)
3453Definition CosetPartition_def:
3454  CosetPartition g h = partition (inCoset g h) G
3455End
3456
3457(* Theorem: For FINITE Group g, h <= g ==>
3458            CARD G = SUM of CARD partitions in (CosetPartition g h) *)
3459(* Proof:
3460   Apply partition_CARD
3461    |- !R s. R equiv_on s /\ FINITE s ==> (CARD s = SIGMA CARD (partition R s))
3462*)
3463Theorem carrier_card_by_coset_partition:
3464    !(g:'a group) h. h <= g /\ FINITE G ==> (CARD G = SIGMA CARD (CosetPartition g h))
3465Proof
3466  rw_tac std_ss[CosetPartition_def, inCoset_equiv_on_carrier, partition_CARD]
3467QED
3468
3469(* Theorem: Elements in CosetPartition are cosets of some a In G *)
3470(* Proof:
3471   By definition, this is to show:
3472   h <= g /\ x IN G ==> ?a. a IN G /\ ({y | y IN G /\ y IN x * H} = a * H)
3473   Let a = x, then need to show: {y | y IN G /\ y IN x * H} = x * H
3474   Since y IN x * H ==> ?z. z IN H /\ (y = x * z)
3475   so need to show: x IN G /\ z IN G ==> y IN G, which is true by group_op_element.
3476*)
3477Theorem coset_partition_element:
3478    !(g:'a group) h. h <= g ==> (!e. e IN CosetPartition g h <=> ?a. a IN G /\ (e = a * H))
3479Proof
3480  rpt strip_tac >>
3481  `!x z. x IN G /\ z IN H ==> x * z IN G` by metis_tac[group_op_element, Subgroup_def, subgroup_element] >>
3482  rw[CosetPartition_def, inCoset_def, partition_def, EQ_IMP_THM,
3483     coset_def, EXTENSION] >>
3484  metis_tac[]
3485QED
3486
3487(* Theorem: For FINITE group, CARD element in CosetPartiton = CARD subgroup. *)
3488(* Proof:
3489   By coset_partition_element and subgroup_coset_card
3490*)
3491Theorem coset_partition_element_card:
3492    !(g:'a group) h. h <= g /\ FINITE G ==> !e. e IN CosetPartition g h ==> (CARD e = CARD H)
3493Proof
3494  metis_tac[coset_partition_element, subgroup_coset_card, Subgroup_def, SUBSET_FINITE]
3495QED
3496
3497(* Theorem: (Lagrange Identity)
3498            For FINITE Group g and subgroup h,
3499            (size of group) = (size of subgroup) * (size of coset partition). *)
3500(* Proof:
3501   Since
3502   !e. e IN CosetPartition g h ==> (CARD e = CARD H)  by coset_partition_element_card
3503
3504   CARD G
3505   = SIGMA CARD (CosetPartition g h)     by carrier_card_by_coset_partition
3506   = CARD H * CARD (CosetPartition g h)  by SIGMA_CARD_CONSTANT
3507*)
3508Theorem Lagrange_identity:
3509    !(g:'a group) h. h <= g /\ FINITE G ==> (CARD G = CARD H * CARD (CosetPartition g h))
3510Proof
3511  rpt strip_tac >>
3512  `FINITE (CosetPartition g h)` by metis_tac[CosetPartition_def, inCoset_equiv_on_carrier, FINITE_partition] >>
3513  metis_tac[carrier_card_by_coset_partition, SIGMA_CARD_CONSTANT, coset_partition_element_card]
3514QED
3515
3516(* Theorem: (Coset Partition size)
3517            For FINITE Group g, size of coset partition = (size of group) div (size of subgroup). *)
3518(* Proof:
3519   By Lagrange_identity and MULT_DIV.
3520*)
3521Theorem coset_partition_card:
3522    !(g:'a group) h. h <= g /\ FINITE G ==> (CARD (CosetPartition g h) = CARD G DIV CARD H)
3523Proof
3524  rpt strip_tac >>
3525  `Group h /\ FINITE H` by metis_tac[Subgroup_def, SUBSET_FINITE] >>
3526  `0 < CARD H` by metis_tac[group_id_element, MEMBER_NOT_EMPTY, CARD_EQ_0, NOT_ZERO_LT_ZERO] >>
3527  metis_tac[Lagrange_identity, MULT_DIV, MULT_SYM]
3528QED
3529
3530(* Theorem: (Lagrange Theorem)
3531            For FINITE Group g, size of subgroup divides size of group. *)
3532(* Proof:
3533   By Lagrange_identity and divides_def.
3534*)
3535Theorem Lagrange_thm:
3536    !(g:'a group) h. h <= g /\ FINITE G ==> (CARD H) divides (CARD G)
3537Proof
3538  metis_tac[Lagrange_identity, MULT_SYM, dividesTheory.divides_def]
3539QED
3540
3541(* ------------------------------------------------------------------------- *)
3542(* Alternate proof without using inCoset.                                    *)
3543(* ------------------------------------------------------------------------- *)
3544
3545(* Theorem: Subgroup Coset membership is Symmetric:
3546            Group g /\ h <= g /\ a IN G /\ b IN G
3547            ==> b IN a * H ==> a IN b * H
3548   Proof:
3549       b IN (a * H)
3550   ==> ?z in H. b = a * z    by coset_element
3551   ==> |/z in H              by h <= g, group_inv_element
3552   ==> b * ( |/z) = (a * z) * ( |/z) = a
3553                             by group_rinv_assoc
3554   The result follows by element_coset_property:
3555   !x. x IN H ==> b * x IN b * H  -- take x = |/z.
3556*)
3557Theorem subgroup_coset_sym:
3558    !(g:'a group) h. h <= g ==> !a b. a IN G /\ b IN G /\ b IN (a * H) ==> a IN (b * H)
3559Proof
3560  rpt strip_tac >>
3561  `?z. z IN H /\ (b = a * z)` by rw_tac std_ss[GSYM coset_element] >>
3562  `Group g /\ Group h` by metis_tac[Subgroup_def] >>
3563  `|/ z IN H` by metis_tac[subgroup_inv, group_inv_element] >>
3564  `z IN G /\ |/ z IN G` by metis_tac[subgroup_element] >>
3565  `b * |/ z = a` by rw_tac std_ss[group_rinv_assoc] >>
3566  metis_tac[element_coset_property]
3567QED
3568
3569(* Theorem: Subgroup Coset membership is Transitive:
3570            Group g /\ h <= g /\ a IN G /\ b IN G /\ c IN G
3571            ==> b IN (a * H) /\ c IN (b * H) ==> c IN (a * H)
3572   Proof:
3573       b IN (a * H)          by definition
3574   ==> ?y in H. b = a * y    by coset_element
3575       c IN (b * H)          by definition
3576   ==> ?z in H. c = b * z    by coset_element
3577
3578   Hence  c = b * z
3579            = (a * y)* z
3580            = a * (y * z)    by group_assoc
3581   Since y * z in H          by group_op_element
3582   Hence  c IN (a * H), the result follows from element_coset_property.
3583*)
3584Theorem subgroup_coset_trans:
3585    !(g:'a group) h. h <= g ==> !a b c. a IN G /\ b IN G /\ c IN G /\ b IN (a * H) /\ c IN (b * H) ==> c IN (a * H)
3586Proof
3587  rpt strip_tac >>
3588  `?y. y IN H /\ (b = a * y) /\ ?z. z IN H /\ (c = b * z)` by rw_tac std_ss[GSYM coset_element] >>
3589  `Group g /\ Group h /\ (!x y. x IN H /\ y IN H ==> (h.op x y = x * y))` by metis_tac[subgroup_property] >>
3590  `y IN G /\ z IN G` by metis_tac[subgroup_element] >>
3591  `c = a * (y * z)` by rw_tac std_ss[group_assoc] >>
3592  `y * z IN H` by metis_tac[group_op_element] >>
3593  rw_tac std_ss[element_coset_property]
3594QED
3595
3596(* Theorem: inCoset is an equivalence relation.
3597            h <= g ==> (inCoset g h) is an equivalent relation on G. *)
3598(* Proof:
3599   By subgroup_coset_nonempty, subgroup_coset_sym, and subgroup_coset_trans.
3600*)
3601Theorem subgroup_incoset_equiv:
3602    !(g:'a group) h. h <= g ==> (left_coset g H) equiv_on G
3603Proof
3604  rw_tac std_ss[left_coset_def, equiv_on_def] >| [
3605    metis_tac[subgroup_coset_nonempty, SPECIFICATION],
3606    metis_tac[subgroup_coset_sym, SPECIFICATION],
3607    metis_tac[subgroup_coset_trans, SPECIFICATION]
3608  ]
3609QED
3610
3611(* Theorem: For FINITE Group g, h <= g ==>
3612            CARD G = SUM of CARD partitions by (left_coset g H) *)
3613(* Proof:
3614   Apply partition_CARD
3615    |- !R s. R equiv_on s /\ FINITE s ==> (CARD s = SIGMA CARD (partition R s))
3616*)
3617Theorem carrier_card_by_subgroup_coset_partition:
3618    !(g:'a group) h. h <= g /\ FINITE G ==> (CARD G = SIGMA CARD (partition (left_coset g H) G))
3619Proof
3620  rw_tac std_ss[subgroup_incoset_equiv, partition_CARD]
3621QED
3622
3623(* Theorem: Elements in coset partition are cosets of some a In G *)
3624(* Proof:
3625   If-part: h <= g /\ e IN partition (left_coset g H) G ==> ?a. a IN G /\ (e = a * H)
3626      Since there is x such that x IN G /\ e = {y | y IN G /\ x * H y}  by partition_def
3627      Let a = x, need to show x * H = {y | y IN G /\ x * H y}
3628      This is true by SPECIFICATION.
3629   Only-if part: case: h <= g /\ a IN G ==> a * H IN partition (left_coset g H) G
3630      This is to show: ?x. x IN G /\ (a * H = {y | y IN G /\ x * H y})
3631      Let x = a, need to show a * H = {y | y IN G /\ a * H y}
3632      This is true by SPECIFICATION.
3633*)
3634Theorem subgroup_coset_partition_element:
3635    !(g:'a group) h. h <= g ==> (!e. e IN (partition (left_coset g H) G) <=> ?a. a IN G /\ (e = a * H))
3636Proof
3637  rpt strip_tac >>
3638  `!x z. x IN G /\ z IN H ==> x * z IN G` by metis_tac[Subgroup_def, SUBSET_DEF, group_op_element] >>
3639  rw[partition_def, EQ_IMP_THM, left_coset_def, coset_def, EXTENSION] >>
3640  metis_tac[]
3641QED
3642
3643(* Theorem: For FINITE group, CARD element in subgroup coset partiton = CARD subgroup. *)
3644(* Proof:
3645   By subgroup_coset_partition_element and subgroup_coset_card
3646*)
3647Theorem subgroup_coset_card_partition_element:
3648    !(g:'a group) h. h <= g /\ FINITE G ==> !e. e IN (partition (left_coset g H) G) ==> (CARD e = CARD H)
3649Proof
3650  rpt strip_tac >>
3651  `?a. a IN G /\ (e = a * H)` by rw_tac std_ss[GSYM subgroup_coset_partition_element] >>
3652  `FINITE H` by metis_tac[Subgroup_def, SUBSET_FINITE] >>
3653  metis_tac[subgroup_coset_card]
3654QED
3655
3656(* Theorem: (Lagrange Identity)
3657            For FINITE Group g and subgroup h,
3658            (size of group) = (size of subgroup) * (size of coset partition). *)
3659(* Proof:
3660   Since
3661   !e. e IN coset partition g h ==> (CARD e = CARD H)  by subgroup_coset_card_partition_element
3662
3663   CARD G
3664   = SIGMA CARD (CosetPartition g h)   by carrier_card_by_subgroup_coset_partition
3665   = CARD H * CARD (CosetPartition g h)  by SIGMA_CARD_CONSTANT
3666*)
3667Theorem Lagrange_identity_alt:
3668    !(g:'a group) h. h <= g /\ FINITE G ==> (CARD G = CARD H * CARD (partition (left_coset g H) G))
3669Proof
3670  metis_tac[carrier_card_by_subgroup_coset_partition, subgroup_coset_card_partition_element,
3671             SIGMA_CARD_CONSTANT, FINITE_partition]
3672QED
3673
3674(* ------------------------------------------------------------------------- *)
3675(* Useful Coset theorems.                                                    *)
3676(* ------------------------------------------------------------------------- *)
3677
3678(* Theorem: h <= g /\ x IN IMAGE (left_coset g H) G <=> x IN CosetPartition g h *)
3679(* Proof:
3680       x IN IMAGE (left_coset g H) G
3681   <=> ?y. y IN G /\ y = (left_coset g H) x   by IN_IMAGE
3682   <=> ?y. y IN G /\ y = x * H                by left_coset_def
3683   <=> x IN CosetPartition g h                   by coset_partition_element
3684*)
3685Theorem subgroup_coset_in_partition:
3686    !g h:'a group. h <= g ==> !x. x IN IMAGE (left_coset g H) G <=> x IN CosetPartition g h
3687Proof
3688  rw_tac std_ss[IN_IMAGE, left_coset_def, coset_partition_element] >>
3689  metis_tac[]
3690QED
3691
3692(* Theorem: CosetPartition g h = IMAGE (left_coset g H) G *)
3693(* Proof:
3694      !e. e IN CosetPartition g h
3695   <=> ?a. a IN G /\ (e = a * H)      by coset_partition_element
3696   <=> e IN IMAGE (left_coset g H) G  by IN_IMAGE
3697*)
3698Theorem coset_partition_eq_coset_image:
3699    !(g:'a group) h. h <= g ==> (CosetPartition g h = IMAGE (left_coset g H) G)
3700Proof
3701  rw[Once EXTENSION] >>
3702  metis_tac[left_coset_def, coset_partition_element]
3703QED
3704
3705(* Theorem: #e * H = H *)
3706(* Proof:
3707     #e * H
3708   = IMAGE (\z. #e * z) H   by coset_def
3709   = IMAGE (\z. z) H        by group_lid, subgroup_id
3710   = H                      by IMAGE_ID
3711*)
3712Theorem coset_id_eq_subgroup:
3713  !(g:'a group) h. h <= g ==> (#e * H = H)
3714Proof
3715  rw[coset_def, EXTENSION] >>
3716  metis_tac[subgroup_property, subgroup_id, group_lid, group_id_element]
3717QED
3718
3719(* Michael's proof *)
3720Theorem IMAGE_ID_lemma[local]:
3721  (!x. x IN s ==> (f x = x)) ==> (IMAGE f s = s)
3722Proof rw[EXTENSION] >> metis_tac[]
3723QED
3724
3725Theorem coset_id_eq_subgroup[allow_rebind]:
3726  !(g:'a group) h. h <= g ==> (#e * H = H)
3727Proof
3728  srw_tac[SatisfySimps.SATISFY_ss]
3729         [subgroup_property, subgroup_element, IMAGE_ID_lemma, coset_def]
3730QED
3731
3732(* Rework of proof from outline:
3733   For the in-line IMAGE_ID', universally qualify all parameters :
3734   !f s. (!x. x IN s ==> (f x = x)) ==> (IMAGE f s = s)
3735*)
3736Theorem coset_id_eq_subgroup[allow_rebind]:
3737  !(g:'a group) h. h <= g ==> (#e * H = H)
3738Proof
3739  rpt strip_tac >>
3740  ‘!f s. (!x. x IN s ==> (f x = x)) ==> (IMAGE f s = s)’
3741    by (rw[EXTENSION] >> metis_tac[]) >>
3742  ‘!x. x IN H ==> ((\z. #e * z) x = x)’
3743    by metis_tac[subgroup_property, subgroup_element, group_lid] >>
3744  full_simp_tac (srw_ss() ++ SatisfySimps.SATISFY_ss)[coset_def]
3745QED
3746
3747(* ------------------------------------------------------------------------- *)
3748(* Conjugate of sets and subgroups                                           *)
3749(* ------------------------------------------------------------------------- *)
3750
3751(* Conjugate of a set s by a group element a in G is the set {a * z * |/a | z in s}. *)
3752Definition conjugate_def:
3753  conjugate (g:'a group) (a: 'a) (s: 'a -> bool) = { a * z * |/a | z IN s}
3754End
3755
3756(* Conjugate of subgroup h <= g by a in G is the set {a * z * |/a | z in H}. *)
3757Definition conjugate_subgroup_def:
3758  conjugate_subgroup (h:'a group) (g:'a group) a : 'a group =
3759      <| carrier := conjugate g a H;
3760              id := #e;
3761              op := g.op
3762       |>
3763End
3764(* > val conjugate_subgroup_def =
3765  |- !h g a. conjugate_subgroup h g a = <|carrier := conjugate g a H; id := #e; op := $* |> : thm
3766*)
3767
3768(*
3769- type_of ``conjugate_subgroup h g a``;
3770> val it = ``:'a group`` : hol_type
3771*)
3772
3773(* Theorem: Group g, h <= g, a in G ==> Group (conjugate_subgroup h g a) *)
3774(* Proof:
3775   Closure: (a * z * |/a) * (a * z' * |/ a)
3776          = a * z * ( |/ a * a) * z' * |/ a
3777          = a * (z * z') * |/ a, and z * z' IN H.
3778   Associativity: inherits from group associativity
3779   Identity: #e in (conjugate_subgroup h g a) since #e IN H and a * #e * |/ a = #e.
3780   Inverse: |/ (a * z * |/a)
3781          = |/( |/a) * ( |/ z) * |/a
3782          = a * ( |/z) * |/a, and |/z IN H.
3783*)
3784Theorem conjugate_subgroup_group:
3785    !(g:'a group) h. h <= g ==> !a. a IN G ==> Group (conjugate_subgroup h g a)
3786Proof
3787  rpt strip_tac >>
3788  `Group h /\ Group g /\ !z. z IN H ==> z IN G` by metis_tac[Subgroup_def, subgroup_element] >>
3789  `#e IN H` by metis_tac[subgroup_id, group_id_element] >>
3790  `|/a IN G` by rw_tac std_ss[group_inv_element] >>
3791  `!p q. p IN G /\ q IN G ==> (a * p * |/ a * (a * q * |/ a) = a * (p * q) * |/a)` by
3792  (rpt strip_tac >>
3793  `a * p IN G /\ q * |/a IN G` by rw_tac std_ss[group_op_element] >>
3794  `a * p * |/ a * (a * q * |/ a) = a * p * ( |/ a * a * (q * |/ a))` by rw_tac std_ss[group_assoc, group_op_element] >>
3795  `_ = a * p * (q * |/a)` by rw_tac std_ss[group_linv, group_lid] >>
3796  rw_tac std_ss[group_assoc, group_op_element]) >>
3797  rw_tac std_ss[conjugate_subgroup_def, conjugate_def, group_def_alt, RES_FORALL_THM, RES_EXISTS_THM, GSPECIFICATION] >| [
3798    `z * z' IN H` by metis_tac[group_op_element, subgroup_property] >>
3799    metis_tac[],
3800    `!x y. x IN H /\ y IN H ==> (h.op x y = x * y)` by metis_tac[group_op_element, subgroup_property] >>
3801    `a * z' * |/ a * (a * z'' * |/ a) * (a * z''' * |/ a) = a * (z' * z'') * |/ a * (a * z''' * |/ a)` by rw_tac std_ss[] >>
3802    `_ = a * ((z' * z'') * z''') * |/ a` by rw_tac std_ss[group_op_element] >>
3803    `_ = a * (z' * (z'' * z''')) * |/ a` by rw_tac std_ss[group_assoc] >>
3804    `_ = a * z' * |/ a * (a * (z'' * z''') * |/a)` by rw_tac std_ss[group_op_element] >>
3805    rw_tac std_ss[],
3806    metis_tac[group_rid, group_rinv],
3807    rw_tac std_ss[group_lid, group_op_element],
3808    `|/z IN H` by metis_tac[subgroup_inv, group_inv_element] >>
3809    metis_tac[group_linv, group_rid, group_rinv]
3810  ]
3811QED
3812
3813(* Theorem: Group g, h <= g, a in G ==> (conjugate_subgroup h g a) <= g *)
3814(* Proof:
3815   By conjugate_subgroup_group, and (conjugate_subgroup h g a).carrier SUBSET G.
3816*)
3817Theorem conjugate_subgroup_subgroup:
3818    !(g:'a group) h. h <= g ==> !a::G. (conjugate_subgroup h g a) <= g
3819Proof
3820  rw_tac std_ss[RES_FORALL_THM] >>
3821  `Group (conjugate_subgroup h g a)` by rw_tac std_ss[conjugate_subgroup_group] >>
3822  `Group g` by metis_tac[Subgroup_def] >>
3823  rw_tac std_ss[conjugate_subgroup_def, conjugate_def, Subgroup_def, SUBSET_DEF, GSPECIFICATION] >>
3824  metis_tac[group_inv_element, group_op_element, subgroup_element]
3825QED
3826
3827(* Theorem: [Bijection between subgroup and its conjugate]
3828            Group g, h <= g, a in G ==>
3829            BIJ (\z. a * z * |/ a) H (conjugate_subgroup h g a).carrier *)
3830(* Proof:
3831   Essentially this is to prove:
3832   (1) z IN H ==> ?z'. (a * z * |/ a = a * z' * |/ a) /\ z' IN H
3833       True by taking z' = z.
3834   (2) z IN H /\ z' IN H /\ a * z * |/ a = a * z' * |/ a ==> z = z'
3835       True by group left/right cancellations.
3836   (3) z IN H ==> ?z'. (a * z * |/ a = a * z' * |/ a) /\ z' IN H
3837       True by taking z' = z.
3838   (4) z IN H ==> ?z'. z' IN H /\ (a * z' * |/ a = a * z * |/ a)
3839       True by taking z' = z.
3840*)
3841Theorem subgroup_conjugate_subgroup_bij:
3842    !(g:'a group) h. h <= g ==> !a. a IN G ==> BIJ (\z. a * z * |/ a) H (conjugate_subgroup h g a).carrier
3843Proof
3844  rw_tac std_ss[conjugate_subgroup_def, conjugate_def, BIJ_DEF, INJ_DEF, SURJ_DEF, GSPECIFICATION] >| [
3845    metis_tac[],
3846    `Group g /\ z IN G /\ z' IN G` by metis_tac[subgroup_property, subgroup_element] >>
3847    `|/a IN G /\ a * z IN G /\ a * z' IN G` by rw_tac std_ss[group_inv_element, group_op_element] >>
3848    metis_tac[group_lcancel, group_rcancel],
3849    metis_tac[],
3850    metis_tac[]
3851  ]
3852QED
3853
3854(* ------------------------------------------------------------------------- *)
3855(* Subgroup Intersection                                                     *)
3856(* ------------------------------------------------------------------------- *)
3857
3858(* Use K to denote k.carrier *)
3859Overload K[local] = ``(k:'a group).carrier``
3860(* Use o to denote h.op *)
3861Overload o[local] = ``(h:'a group).op``
3862(* Use #i to denote h.id *)
3863Overload "#i"[local] = ``(h:'a monoid).id``
3864
3865(* Theorem: h <= g /\ k <= g ==> !x. x IN H INTER K ==> |/ x IN H INTER K *)
3866(* Proof:
3867   Since h <= g ==> Group h /\ Group g /\ h << g    by subgroup_homomorphism, subgroup_is_submonoid
3868     and k <= g ==> Group k /\ Group g /\ k << g    by subgroup_homomorphism, subgroup_is_submonoid
3869   x IN H INTER K ==> x IN H and x IN K             by IN_INTER
3870   Since x IN H, by h <= g, h.inv x = |/ x          by subgroup_inv
3871    also x IN K, by k <= g, k.inv x = |/ x          by subgroup_inv
3872    Therefore |/ x IN H INTER K                     by IN_INTER, group_inv_element
3873*)
3874Theorem subgroup_intersect_has_inv:
3875    !(g:'a group) h k. h <= g /\ k <= g ==> !x. x IN H INTER K ==> |/ x IN H INTER K
3876Proof
3877  rpt strip_tac >>
3878  `h << g /\ k << g` by rw[subgroup_is_submonoid] >>
3879  `x IN H /\ x IN K` by metis_tac[IN_INTER] >>
3880  `(h.inv x = |/ x) /\ (k.inv x = |/ x)` by rw[subgroup_inv] >>
3881  `Group h /\ Group k` by metis_tac[subgroup_homomorphism] >>
3882  metis_tac[IN_INTER, group_inv_element]
3883QED
3884
3885(* Theorem: h <= g /\ k <= g ==> Group (h mINTER k) *)
3886(* Proof:
3887   By Group_def, this is to show:
3888   (1) Monoid (h mINTER k)
3889       Since h <= g ==> h << g     by subgroup_is_submonoid
3890         and k <= g ==> k << g     by subgroup_is_submonoid
3891       Hence Monoid (h mINTER k)   by submonoid_intersect_monoid
3892   (2) monoid_invertibles (h mINTER k) = (h mINTER k).carrier
3893       By monoid_invertibles_def, this is to show:
3894       ?y. y IN (h mINTER k).carrier /\
3895        ((h mINTER k).op x y = (h mINTER k).id) /\ ((h mINTER k).op y x = (h mINTER k).id)
3896       Since h <= g ==> h << g     by subgroup_is_submonoid
3897         and k <= g ==> k << g     by subgroup_is_submonoid
3898       By submonoid_intersect_property, this is to show:
3899       ?y. y IN H INTER K /\ (x * y = #e) /\ (y * x = #e)
3900       Let y = |/ x.
3901       Then |/ x IN H INTER K            by subgroup_intersect_has_inv
3902       Since h <= g ==> Group g          by subgroup_homomorphism
3903         and x IN H and x IN K           by IN_INTER
3904             ==> x IN G                  by subgroup_element
3905       Hence x * y = #e and y * x = #e   by group_id
3906*)
3907Theorem subgroup_intersect_group:
3908    !(g:'a group) h k. h <= g /\ k <= g ==> Group (h mINTER k)
3909Proof
3910  rpt strip_tac >>
3911  `h << g /\ k << g` by rw[subgroup_is_submonoid] >>
3912  `Group h /\ Group k /\ Group g` by metis_tac[subgroup_homomorphism] >>
3913  rw[Group_def] >| [
3914    metis_tac[submonoid_intersect_monoid],
3915    rw[monoid_invertibles_def, EXTENSION, EQ_IMP_THM] >>
3916    pop_assum mp_tac >>
3917    `x IN H INTER K ==> ?y. y IN H INTER K /\ (x * y = #e) /\ (y * x = #e)` suffices_by metis_tac[submonoid_intersect_property] >>
3918    rpt strip_tac >>
3919    `|/ x IN H INTER K` by metis_tac[subgroup_intersect_has_inv] >>
3920    qexists_tac `|/ x` >>
3921    `x IN G` by metis_tac[IN_INTER, subgroup_element] >>
3922    rw[]
3923  ]
3924QED
3925
3926(* Theorem: h <= g /\ k <= g ==> !x. x IN H INTER K ==> ((h mINTER k).inv x = |/ x) *)
3927(* Proof:
3928   Since h <= g ==> Group h /\ Group g     by subgroup_homomorphism
3929     and h <= g ==> h << g                 by subgroup_is_submonoid
3930     and k <= g ==> k << g                 by subgroup_is_submonoid
3931   Hence by submonoid_intersect_property,
3932        (h mINTER k).carrier = H INTER K
3933        !x y. x IN H INTER K /\ y IN H INTER K ==> ((h mINTER k).op x y = x * y)
3934        (h mINTER k).id = #e
3935   Now, h <= g /\ k <= g ==> Group (h mINTER k)   by subgroup_intersect_group
3936   and  |/ x IN H INTER K                         by subgroup_intersect_has_inv
3937   also x IN G /\ |/ x IN G                       by IN_INTER, subgroup_element
3938   Therefore (h mINTER k).op ( |/ x) x = (h mINTER k).id     by group_linv
3939   Hence (h mINTER k).inv x = |/ x                by group_linv_unique
3940*)
3941Theorem subgroup_intersect_inv:
3942    !(g:'a group) h k. h <= g /\ k <= g ==> !x. x IN H INTER K ==> ((h mINTER k).inv x = |/ x)
3943Proof
3944  rpt strip_tac >>
3945  `Group g /\ Group h` by metis_tac[subgroup_homomorphism] >>
3946  `h << g /\ k << g` by rw[subgroup_is_submonoid] >>
3947  `(h mINTER k).carrier = H INTER K` by metis_tac[submonoid_intersect_property] >>
3948  `!x y. x IN H INTER K /\ y IN H INTER K ==> ((h mINTER k).op x y = x * y)` by metis_tac[submonoid_intersect_property] >>
3949  `(h mINTER k).id = #e` by metis_tac[submonoid_intersect_property] >>
3950  `Group (h mINTER k)` by metis_tac[subgroup_intersect_group] >>
3951  `|/ x IN H INTER K` by rw[subgroup_intersect_has_inv] >>
3952  `x IN G /\ |/ x IN G` by metis_tac[IN_INTER, subgroup_element] >>
3953  metis_tac[group_linv, group_linv_unique]
3954QED
3955
3956(* Theorem: properties of subgroup_intersect:
3957   h <= g /\ k <= g ==>
3958     ((h mINTER k).carrier = H INTER K) /\
3959     (!x y. x IN H INTER K /\ y IN H INTER K ==> ((h mINTER k).op x y = x * y)) /\
3960     ((h mINTER k).id = #e) /\
3961     (!x. x IN H INTER K ==> ((h mINTER k).inv x = |/ x)) *)
3962(* Proof: by subgroup_is_submonoid, submonoid_intersect_property, subgroup_intersect_inv. *)
3963Theorem subgroup_intersect_property:
3964    !(g:'a group) h k. h <= g /\ k <= g ==>
3965     ((h mINTER k).carrier = H INTER K) /\
3966     (!x y. x IN H INTER K /\ y IN H INTER K ==> ((h mINTER k).op x y = x * y)) /\
3967     ((h mINTER k).id = #e) /\
3968     (!x. x IN H INTER K ==> ((h mINTER k).inv x = |/ x))
3969Proof
3970  metis_tac[subgroup_is_submonoid, submonoid_intersect_property, subgroup_intersect_inv]
3971QED
3972
3973(* Theorem: h <= g /\ k <= g ==> (h mINTER k) <= g *)
3974(* Proof:
3975   By Subgroup_def, this is to show:
3976   (1) Group (h mINTER k), true by subgroup_intersect_group.
3977   (2) Group g, true by subgroup_homomorphism.
3978   (3) (h mINTER k).carrier SUBSET G
3979       Since (h mINTER k).carrier = H INTER K   by subgroup_intersect_property
3980         and (H INTER K) SUBSET H               by INTER_SUBSET
3981         and h <= g ==> H SUBSET G              by Subgroup_def
3982       Hence (h mINTER k).carrier SUBSET G      by SUBSET_TRANS
3983   (4) (h mINTER k).op = $*
3984       By monoid_intersect_def, this is to show: $o = $*
3985       which is true by Subgroup_def.
3986*)
3987Theorem subgroup_intersect_subgroup:
3988    !(g:'a group) h k. h <= g /\ k <= g ==> (h mINTER k) <= g
3989Proof
3990  rpt strip_tac >>
3991  rw[Subgroup_def] >| [
3992    metis_tac[subgroup_intersect_group],
3993    metis_tac[subgroup_homomorphism],
3994    `(h mINTER k).carrier = H INTER K` by metis_tac[subgroup_intersect_property] >>
3995    `(H INTER K) SUBSET H` by rw[INTER_SUBSET] >>
3996    `H SUBSET G` by metis_tac[Subgroup_def] >>
3997    metis_tac[SUBSET_TRANS],
3998    rw[monoid_intersect_def] >>
3999    metis_tac[Subgroup_def]
4000  ]
4001QED
4002
4003(* ------------------------------------------------------------------------- *)
4004(* Subgroup Big Intersection                                                 *)
4005(* ------------------------------------------------------------------------- *)
4006
4007(* Define intersection of subgroups of a group *)
4008Definition subgroup_big_intersect_def:
4009   subgroup_big_intersect (g:'a group) =
4010      <| carrier := BIGINTER (IMAGE (\h. H) {h | h <= g});
4011              op := $*; (* g.op *)
4012              id := #e  (* g.id *)
4013       |>
4014End
4015
4016Overload sgbINTER = ``subgroup_big_intersect``
4017(*
4018> subgroup_big_intersect_def;
4019val it = |- !g. sgbINTER g =
4020     <|carrier := BIGINTER (IMAGE (\h. H) {h | h <= g}); op := $*; id := #e|>: thm
4021*)
4022
4023(* Theorem: ((sgbINTER g).carrier = BIGINTER (IMAGE (\h. H) {h | h <= g})) /\
4024   (!x y. x IN (sgbINTER g).carrier /\ y IN (sgbINTER g).carrier ==> ((sgbINTER g).op x y = x * y)) /\
4025   ((sgbINTER g).id = #e) *)
4026(* Proof: by subgroup_big_intersect_def. *)
4027Theorem subgroup_big_intersect_property:
4028    !g:'a group. ((sgbINTER g).carrier = BIGINTER (IMAGE (\h. H) {h | h <= g})) /\
4029   (!x y. x IN (sgbINTER g).carrier /\ y IN (sgbINTER g).carrier ==> ((sgbINTER g).op x y = x * y)) /\
4030   ((sgbINTER g).id = #e)
4031Proof
4032  rw[subgroup_big_intersect_def]
4033QED
4034
4035(* Theorem: x IN (sgbINTER g).carrier <=> (!h. h <= g ==> x IN H) *)
4036(* Proof:
4037       x IN (sgbINTER g).carrier
4038   <=> x IN BIGINTER (IMAGE (\h. H) {h | h <= g})          by subgroup_big_intersect_def
4039   <=> !P. P IN (IMAGE (\h. H) {h | h <= g}) ==> x IN P    by IN_BIGINTER
4040   <=> !P. ?h. (P = H) /\ h IN {h | h <= g}) ==> x IN P    by IN_IMAGE
4041   <=> !P. ?h. (P = H) /\ h <= g) ==> x IN P               by GSPECIFICATION
4042   <=> !h. h <= g ==> x IN H
4043*)
4044Theorem subgroup_big_intersect_element:
4045    !g:'a group. !x. x IN (sgbINTER g).carrier <=> (!h. h <= g ==> x IN H)
4046Proof
4047  rw[subgroup_big_intersect_def] >>
4048  metis_tac[]
4049QED
4050
4051(* Theorem: x IN (sgbINTER g).carrier /\ y IN (sgbINTER g).carrier ==> (sgbINTER g).op x y IN (sgbINTER g).carrier *)
4052(* Proof:
4053   Since x IN (sgbINTER g).carrier, !h. h <= g ==> x IN H   by subgroup_big_intersect_element
4054    also y IN (sgbINTER g).carrier, !h. h <= g ==> y IN H   by subgroup_big_intersect_element
4055     Now !h. h <= g ==> x o y IN H                          by Subgroup_def, group_op_element
4056                    ==> x * y IN H                          by subgroup_property
4057     Now, (sgbINTER g).op x y = x * y                       by subgroup_big_intersect_property
4058     Hence (sgbINTER g).op x y IN (sgbINTER g).carrier      by subgroup_big_intersect_element
4059*)
4060Theorem subgroup_big_intersect_op_element:
4061    !g:'a group. !x y. x IN (sgbINTER g).carrier /\ y IN (sgbINTER g).carrier ==>
4062                     (sgbINTER g).op x y IN (sgbINTER g).carrier
4063Proof
4064  rpt strip_tac >>
4065  `!h. h <= g ==> x IN H /\ y IN H` by metis_tac[subgroup_big_intersect_element] >>
4066  `!h. h <= g ==> x * y IN H` by metis_tac[Subgroup_def, group_op_element, subgroup_property] >>
4067  `(sgbINTER g).op x y = x * y` by rw[subgroup_big_intersect_property] >>
4068  metis_tac[subgroup_big_intersect_element]
4069QED
4070
4071(* Theorem: (sgbINTER g).id IN (sgbINTER g).carrier *)
4072(* Proof:
4073   !h. h <= g ==> #i = #e                               by subgroup_id
4074   !h. h <= g ==> #i IN H                               by Subgroup_def, group_id_element
4075   Now (smbINTER g).id = #e                             by subgroup_big_intersect_property
4076   Hence !h. h <= g ==> (sgbINTER g).id IN H            by above
4077      or (sgbINTER g).id IN (sgbINTER g).carrier        by subgroup_big_intersect_element
4078*)
4079Theorem subgroup_big_intersect_has_id:
4080    !g:'a group. (sgbINTER g).id IN (sgbINTER g).carrier
4081Proof
4082  rpt strip_tac >>
4083  `!h. h <= g ==> (#i = #e)` by rw[subgroup_id] >>
4084  `!h. h <= g ==> #i IN H` by rw[Subgroup_def] >>
4085  `(sgbINTER g).id = #e` by metis_tac[subgroup_big_intersect_property] >>
4086  metis_tac[subgroup_big_intersect_element]
4087QED
4088
4089(* Theorem: !x. x IN (sgbINTER g).carrier ==> |/ x IN (sgbINTER g).carrier *)
4090(* Proof:
4091   Since x IN (sgbINTER g).carrier,
4092         !h. h <= g ==> x IN H             by subgroup_big_intersect_element
4093    also !h. h <= g ==> (h.inv x = |/ x)   by subgroup_inv, x IN H.
4094     Now !h. h <= g ==> Group h            by Subgroup_def
4095      so !h. h <= g ==> |/ x IN H          by group_inv_element
4096   Hence |/ x IN (sgbINTER g).carrier      by subgroup_big_intersect_element
4097*)
4098Theorem subgroup_big_intersect_has_inv:
4099    !g:'a group. !x. x IN (sgbINTER g).carrier ==> |/ x IN (sgbINTER g).carrier
4100Proof
4101  rpt strip_tac >>
4102  `!h. h <= g ==> x IN H` by metis_tac[subgroup_big_intersect_element] >>
4103  `!h. h <= g ==> (h.inv x = |/ x)` by rw[subgroup_inv] >>
4104  `!h. h <= g ==> Group h` by rw[Subgroup_def] >>
4105  `!h. h <= g ==> |/ x IN H` by metis_tac[group_inv_element] >>
4106  metis_tac[subgroup_big_intersect_element]
4107QED
4108
4109(* Theorem: Group g ==> (sgbINTER g).carrier SUBSET G *)
4110(* Proof:
4111   By subgroup_big_intersect_def, this is to show:
4112   Group g ==> BIGINTER (IMAGE (\h. H) {h | h <= g}) SUBSET G
4113   Let P = IMAGE (\h. H) {h | h <= g}.
4114   Since g <= g                    by subgroup_refl
4115      so G IN P                    by IN_IMAGE, definition of P.
4116    Thus P <> {}                   by MEMBER_NOT_EMPTY.
4117     Now h <= g ==> H SUBSET G     by Subgroup_def
4118   Hence P SUBSET G                by BIGINTER_SUBSET
4119*)
4120Theorem subgroup_big_intersect_subset:
4121    !g:'a group. Group g ==> (sgbINTER g).carrier SUBSET G
4122Proof
4123  rw[subgroup_big_intersect_def] >>
4124  qabbrev_tac `P = IMAGE (\h. H) {h | h <= g}` >>
4125  (`!x. x IN P <=> ?h. (H = x) /\ h <= g` by (rw[Abbr`P`] >> metis_tac[])) >>
4126  `g <= g` by rw[subgroup_refl] >>
4127  `P <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
4128  `!h:'a group. h <= g ==> H SUBSET G` by rw[Subgroup_def] >>
4129  metis_tac[BIGINTER_SUBSET]
4130QED
4131
4132(* Theorem: Group g ==> Group (smbINTER g) *)
4133(* Proof:
4134   Group g ==> (sgbINTER g).carrier SUBSET G                by subgroup_big_intersect_subset
4135   By Monoid_def, this is to show:
4136   (1) x IN (sgbINTER g).carrier /\ y IN (sgbINTER g).carrier ==> (sgbINTER g).op x y IN (sgbINTER g).carrier
4137       True by subgroup_big_intersect_op_element.
4138   (2) (sgbINTER g).op ((sgbINTER g).op x y) z = (sgbINTER g).op x ((sgbINTER g).op y z)
4139       Since (sgbINTER g).op x y IN (sgbINTER g).carrier    by subgroup_big_intersect_op_element
4140         and (sgbINTER g).op y z IN (sgbINTER g).carrier    by subgroup_big_intersect_op_element
4141       So this is to show: (x * y) * z = x * (y * z)        by subgroup_big_intersect_property
4142       Since x IN G, y IN G and z IN G                      by SUBSET_DEF
4143       This follows by group_assoc.
4144   (3) (sgbINTER g).id IN (sgbINTER g).carrier
4145       This is true by subgroup_big_intersect_has_id.
4146   (4) x IN (sgbINTER g).carrier ==> (sgbINTER g).op (sgbINTER g).id x = x
4147       Since (sgbINTER g).id IN (sgbINTER g).carrier   by subgroup_big_intersect_op_element
4148         and (sgbINTER g).id = #e                      by subgroup_big_intersect_property
4149        also x IN G                                    by SUBSET_DEF
4150         (sgbINTER g).op (sgbINTER g).id x
4151       = #e * x                                        by subgroup_big_intersect_property
4152       = x                                             by group_id
4153   (5) x IN (sgbINTER g).carrier ==>
4154       ?y. y IN (sgbINTER g).carrier /\ ((sgbINTER g).op y x = (sgbINTER g).id)
4155       Since |/ x IN (sgbINTER g).carrier              by subgroup_big_intersect_has_inv
4156         and (sgbINTER g).id IN (sgbINTER g).carrier   by subgroup_big_intersect_op_element
4157         and (sgbINTER g).id = #e                      by subgroup_big_intersect_property
4158        also x IN G                                    by SUBSET_DEF
4159        Let y = |/ x, then y IN (sgbINTER g).carrier,
4160         (sgbINTER g).op y x
4161       = |/ x * x                                      by subgroup_big_intersect_property
4162       = #e                                            by group_linv
4163*)
4164Theorem subgroup_big_intersect_group:
4165    !g:'a group. Group g ==> Group (sgbINTER g)
4166Proof
4167  rpt strip_tac >>
4168  `(sgbINTER g).carrier SUBSET G` by rw[subgroup_big_intersect_subset] >>
4169  rw_tac std_ss[group_def_alt] >| [
4170    metis_tac[subgroup_big_intersect_op_element],
4171    `(sgbINTER g).op x y IN (sgbINTER g).carrier` by metis_tac[subgroup_big_intersect_op_element] >>
4172    `(sgbINTER g).op y z IN (sgbINTER g).carrier` by metis_tac[subgroup_big_intersect_op_element] >>
4173    `(x * y) * z = x * (y * z)` suffices_by rw[subgroup_big_intersect_property] >>
4174    `x IN G /\ y IN G /\ z IN G` by metis_tac[SUBSET_DEF] >>
4175    rw[group_assoc],
4176    metis_tac[subgroup_big_intersect_has_id],
4177    `(sgbINTER g).id = #e` by rw[subgroup_big_intersect_property] >>
4178    `(sgbINTER g).id IN (sgbINTER g).carrier` by metis_tac[subgroup_big_intersect_has_id] >>
4179    `#e * x = x` suffices_by rw[subgroup_big_intersect_property] >>
4180    `x IN G` by metis_tac[SUBSET_DEF] >>
4181    rw[],
4182    `|/ x IN (sgbINTER g).carrier` by rw[subgroup_big_intersect_has_inv] >>
4183    `(sgbINTER g).id = #e` by rw[subgroup_big_intersect_property] >>
4184    `(sgbINTER g).id IN (sgbINTER g).carrier` by rw[subgroup_big_intersect_has_id] >>
4185    qexists_tac `|/ x` >>
4186    `|/ x * x = #e` suffices_by rw[subgroup_big_intersect_property] >>
4187    `x IN G` by metis_tac[SUBSET_DEF] >>
4188    rw[]
4189  ]
4190QED
4191
4192(* Theorem: Group g ==> (sgbINTER g) <= g *)
4193(* Proof:
4194   By Subgroup_def, this is to show:
4195   (1) Group (sgbINTER g)
4196       True by subgroup_big_intersect_group.
4197   (2) (sgbINTER g).carrier SUBSET G
4198       True by subgroup_big_intersect_subset.
4199   (3) (sgbINTER g).op = $*
4200       True by subgroup_big_intersect_def
4201*)
4202Theorem subgroup_big_intersect_subgroup:
4203    !g:'a group. Group g ==> (sgbINTER g) <= g
4204Proof
4205  rw_tac std_ss[Subgroup_def] >| [
4206    rw[subgroup_big_intersect_group],
4207    rw[subgroup_big_intersect_subset],
4208    rw[subgroup_big_intersect_def]
4209  ]
4210QED
4211
4212(* ------------------------------------------------------------------------- *)
4213(* Subset Group (to be subgroup)                                             *)
4214(* ------------------------------------------------------------------------- *)
4215
4216(* Define the subset group: takes a subset and gives a group candidate *)
4217Definition subset_group_def:
4218    subset_group (g:'a group) (s:'a -> bool) =
4219    <| carrier := s;
4220            op := g.op;
4221            id := g.id
4222     |>
4223End
4224(* val subset_group_def = |- !g s. subset_group g s = <|carrier := s; op := $*; id := #e|>: thm *)
4225
4226(* Theorem: properties of subset_group *)
4227(* Proof: by subset_group_def *)
4228Theorem subset_group_property:
4229    !(g:'a group) s.
4230     ((subset_group g s).carrier = s) /\
4231     ((subset_group g s).op = g.op) /\
4232     ((subset_group g s).id = #e)
4233Proof
4234  rw_tac std_ss[subset_group_def]
4235QED
4236
4237(* Theorem: x IN s ==> !n. (subset_group g s).exp x n = x ** n *)
4238(* Proof:
4239   By induction on n.
4240   Base: (subset_group g s).exp x 0 = x ** 0
4241          (subset_group g s).exp x 0
4242        = (subset_group g s).id        by group_exp_0
4243        = #0                           by subset_group_property
4244        = x ** 0                       by group_exp_0
4245   Step: x IN s /\ (subset_group g s).exp x n = x ** n ==>
4246         (subset_group g s).exp x (SUC n) = x ** SUC n
4247          (subset_group g s).exp x (SUC n)
4248        = (subset_group g s).op x ((subset_group g s).exp x n)   by group_exp_SUC
4249        = x * ((subset_group g s).exp x n)                       by subset_group_property
4250        = x * (x ** n)                 by induction hypothesis
4251        = x ** SUC n                   by group_exp_SUC
4252*)
4253Theorem subset_group_exp:
4254    !(g:'a group) s. !x. x IN s ==> !n. (subset_group g s).exp x n = x ** n
4255Proof
4256  rpt strip_tac >>
4257  Induct_on `n` >-
4258  rw[subset_group_property] >>
4259  rw[subset_group_property]
4260QED
4261
4262(* Theorem: x IN s ==> (order (subset_group g s) x = order g x) *)
4263(* Proof:
4264   Note (subset_group g s).exp x k = x ** k      by subset_group_exp
4265    and (subset_group g s).id = #e               by subset_group_property
4266   Thus order (subset_group g s) x = order g x   by order_def, period_def
4267*)
4268Theorem subset_group_order:
4269    !(g:'a group) s. !x. x IN s ==> (order (subset_group g s) x = order g x)
4270Proof
4271  rw[order_def, period_def, subset_group_property, subset_group_exp]
4272QED
4273
4274(* Theorem: Monoid g /\ #e IN s /\ (s SUBSET G) /\
4275           (!x y. x IN s /\ y IN s ==> x * y IN s)  ==> (subset_group g s) << g *)
4276(* Proof:
4277   Let h = subset_group g s
4278   Then H = s          by subset_group_property
4279   Thus h << g         by subset_group_property, submonoid_alt
4280*)
4281Theorem subset_group_submonoid:
4282    !(g:'a monoid) s. Monoid g /\ #e IN s /\ (s SUBSET G) /\
4283           (!x y. x IN s /\ y IN s ==> x * y IN s)  ==> (subset_group g s) << g
4284Proof
4285  rw[submonoid_alt, subset_group_property]
4286QED
4287
4288(* Theorem: Group g /\ s <> {} /\ (s SUBSET G) /\
4289            (!x y. x IN s /\ y IN s ==> x * ( |/ y) IN s) ==> (subset_group g s) <= g *)
4290(* Proof:
4291   Let h = subset_group g s
4292   Then H = s          by subset_group_property
4293   Thus h <= g         by subset_group_property, subgroup_alt
4294*)
4295Theorem subset_group_subgroup:
4296    !(g:'a group) s. Group g /\ s <> {} /\ (s SUBSET G) /\
4297   (!x y. x IN s /\ y IN s ==> x * |/ y IN s) ==> (subset_group g s) <= g
4298Proof
4299  rw[subgroup_alt, subset_group_property]
4300QED
4301
4302(* ------------------------------------------------------------------------- *)
4303(* Quotient Group Documentation                                              *)
4304(* ------------------------------------------------------------------------- *)
4305(* Overloads:
4306   x / y    = group_div g x y
4307   h << g   = normal_subgroup h g
4308   h == g   = group_equiv g h
4309   x o y    = coset_op g h x y
4310   g / h    = quotient_group g h
4311*)
4312(* Definitions and Theorems (# are exported):
4313
4314   Group element division:
4315#  group_div_def      |- !g x y. x / y = x * |/ y
4316#  group_div_element  |- !g. Group g ==> !x y. x IN G /\ y IN G ==> x / y IN G
4317#  group_div_cancel   |- !g. Group g ==> !x. x IN G ==> (x / x = #e)
4318   group_div_pair     |- !g. Group g ==> !x1 y1 x2 y2. x1 IN G /\ y1 IN G /\ x2 IN G /\ y2 IN G ==>
4319                         (x1 * y1 / (x2 * y2) = x1 * (y1 / y2) / x1 * (x1 / x2))
4320   group_div_lsame    |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> (z * x / (z * y) = z * (x / y) / z)
4321   group_div_rsame    |- !g. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> (x * z / (y * z) = x / y)
4322
4323   Normal Subgroup:
4324   normal_subgroup_def       |- !h g. h << g <=> h <= g /\ !a z. a IN G /\ z IN H ==> a * z / a IN H
4325   normal_subgroup_subgroup  |- !h g. h << g ==> h <= g
4326   normal_subgroup_property  |- !h g. h << g ==> !a z. a IN G /\ z IN H ==> a * z / a IN H
4327   normal_subgroup_groups    |- !g h. h << g ==> h <= g /\ Group h /\ Group g
4328   normal_subgroup_refl      |- !g. Group g ==> g << g
4329   normal_subgroup_antisym   |- !g h. h << g /\ g << h ==> (h = g)
4330   normal_subgroup_alt       |- !g h. h << g <=> h <= g /\ !a. a IN G ==> (a * H = H * a)
4331   normal_subgroup_coset_eq  |- !g h. h << g ==> !x y. x IN G /\ y IN G ==> ((x * H = y * H) <=> x / y IN H)
4332
4333   Equivalence induced by Normal Subgroup:
4334   group_equiv_def               |- !g h x y. x == y <=> x / y IN H
4335   group_normal_equiv_reflexive  |- !g h. h << g ==> !z. z IN G ==> z == z
4336   group_normal_equiv_symmetric  |- !g h. h << g ==> !x y. x IN G /\ y IN G ==> (x == y <=> y == x)
4337   group_normal_equiv_transitive |- !g h. h << g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> x == y /\ y == z ==> x == z
4338   group_normal_equiv            |- !g h. h << g ==> $== equiv_on G
4339   group_normal_equiv_property   |- !h g. h << g ==> !x y. x IN G /\ y IN G ==> (x == y <=> x IN y * H)
4340
4341   Binary operation for cosets:
4342   cogen_def       |- !g h e. h <= g /\ e IN CosetPartition g h ==> cogen g h e IN G /\ (e = cogen g h e * H)
4343   cogen_element   |- !h g e. h <= g /\ e IN CosetPartition g h ==> cogen g h e IN G
4344   coset_cogen_property   |- !h g e. h <= g /\ e IN CosetPartition g h ==> (e = cogen g h e * H)
4345   coset_op_def           |- !g h x y. x o y = cogen g h x * cogen g h y * H
4346   cogen_of_subgroup      |- !g h. h <= g ==> (cogen g h H * H = H
4347   cogen_coset_element    |- !g h. h <= g ==> !x. x IN G ==> cogen g h (x * H) IN G
4348   normal_cogen_property  |- !g h. h << g ==> !x. x IN G ==> x / cogen g h (x * H) IN H
4349   normal_coset_property1 |- !g h. h << g ==> !a b. a IN G /\ b IN G ==> (cogen g h (a * H) * b * H = a * b * H)
4350   normal_coset_property2 |- !g h. h << g ==> !a b. a IN G /\ b IN G ==> (a * cogen g h (b * H) * H = a * b * H)
4351   normal_coset_property  |- !g h. h << g ==> !a b. a IN G /\ b IN G ==> (cogen g h (a * H) * cogen g h (b * H) * H = a * b * H)
4352
4353   Quotient Group:
4354   quotient_group_def  |- !g h. g / h = <|carrier := CosetPartition g h; op := $o; id := H|>
4355   quotient_group_closure    |- !g h. h <= g ==>
4356      !x y. x IN CosetPartition g h /\ y IN CosetPartition g h ==> x o y IN CosetPartition g h
4357   quotient_group_assoc     |- !g h. h << g ==>
4358      !x y z. x IN CosetPartition g h /\ y IN CosetPartition g h /\ z IN CosetPartition g h ==> ((x o y) o z = x o y o z)
4359   quotient_group_id        |- !g h. h << g ==> H IN CosetPartition g h /\ !x. x IN CosetPartition g h ==> (H o x = x)
4360   quotient_group_inv       |- !g h. h << g ==> !x. x IN CosetPartition g h ==> ?y. y IN CosetPartition g h /\ (y o x = H)
4361   quotient_group_group     |- !g h. h << g ==> Group (g / h)
4362
4363   Group Homomorphism by left_coset via normal subgroup:
4364   normal_subgroup_coset_homo  |- !g h. h << g ==> GroupHomo (left_coset g H) g (g / h)
4365   normal_coset_op_property    |- !g h. h << g ==> !x y. x IN CosetPartition g h /\ y IN CosetPartition g h ==>
4366         (x o y = CHOICE (preimage (left_coset g H) G x) * CHOICE (preimage (left_coset g H) G y) * H)
4367   coset_homo_group_iso_quotient_group |- !g h. h << g ==> GroupIso I (homo_group g (left_coset g H)) (g / h)
4368
4369   Kernel Group of Group Homomorphism:
4370   kernel_def             |- !f g h. kernel f g h = preimage f G h.id
4371   kernel_group_def       |- !f g h. kernel_group f g h = <|carrier := kernel f g h; id := #e; op := $* |>
4372#  kernel_property        |- !g h f x. x IN kernel f g h <=> x IN G /\ (f x = h.id)
4373   kernel_element         |- !g h f x. x IN kernel f g h <=> x IN G /\ (f x = h.id)
4374   kernel_group_group     |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==> Group (kernel_group f g h)
4375   kernel_group_subgroup  |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==> kernel_group f g h <= g
4376   kernel_group_normal    |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==> kernel_group f g h << g
4377   kernel_quotient_group  |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==> Group (g / kernel_group f g h)
4378
4379   Homomorphic Image and Kernel:
4380   homo_image_def            |- !f g h. homo_image f g h = <|carrier := IMAGE f G; op := h.op; id := h.id|>
4381   homo_image_monoid         |- !g h f. Monoid g /\ Monoid h /\ MonoidHomo f g h ==> Monoid (homo_image f g h)
4382   homo_image_group          |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==> Group (homo_image f g h)
4383   homo_image_subgroup       |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==> homo_image f g h <= h
4384   group_homo_image_surj_property  |- !g h f. Group g /\ Group h /\
4385                                              SURJ f G h.carrier ==> GroupIso I h (homo_image f g h)
4386   monoid_homo_homo_image_monoid   |- !g h f. Monoid g /\ MonoidHomo f g h ==> Monoid (homo_image f g h)
4387   group_homo_homo_image_group     |- !g h f. Group g /\ MonoidHomo f g h ==> Group (homo_image f g h)
4388
4389   First Isomorphic Theorem for Group:
4390   homo_image_homo_quotient_kernel    |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==>
4391      GroupHomo (\z. CHOICE (preimage f G z) * kernel f g h) (homo_image f g h) (g / kernel_group f g h)
4392   homo_image_to_quotient_kernel_bij  |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==>
4393      BIJ (\z. CHOICE (preimage f G z) * kernel f g h) (homo_image f g h).carrier (g / kernel_group f g h).carrier
4394   homo_image_iso_quotient_kernel     |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==>
4395      GroupIso (\z. CHOICE (preimage f G z) * kernel f g h) (homo_image f g h) (g / kernel_group f g h)
4396   group_first_isomorphism_thm        |- !g h f. Group g /\ Group h /\ GroupHomo f g h ==>
4397      kernel_group f g h << g /\ homo_image f g h <= h /\
4398      GroupIso (\z. CHOICE (preimage f G z) * kernel f g h) (homo_image f g h) (g / kernel_group f g h) /\
4399      (SURJ f G h.carrier ==> GroupIso I h (homo_image f g h))
4400*)
4401
4402(* ------------------------------------------------------------------------- *)
4403(* Group element division.                                                   *)
4404(* ------------------------------------------------------------------------- *)
4405(* Define group division *)
4406Definition group_div_def[simp]:
4407  group_div (g:'a group) (x:'a) (y:'a)  = x * |/ y
4408End
4409
4410(* set overloading *)
4411Overload "/" = ``group_div g``
4412val _ = set_fixity "/" (Infixl 600); (* same as "*" in arithmeticScript.sml *)
4413
4414(* Theorem: x / y IN G *)
4415(* Proof:
4416   x / y = x * |/y  by group_div_def
4417   and |/y IN G     by group_inv_element
4418   hence true       by group_op_element
4419*)
4420Theorem group_div_element[simp]:
4421    !g:'a group. Group g ==> !x y. x IN G /\ y IN G ==> x / y IN G
4422Proof
4423  rw[group_div_def]
4424QED
4425
4426
4427(* Theorem: x / x = #e *)
4428(* Proof:
4429   x / x = x * |/x   by group_div_def
4430         = #e        by group_rinv
4431*)
4432Theorem group_div_cancel[simp]:
4433    !g:'a group. Group g ==> !x. x IN G ==> (x / x = #e)
4434Proof
4435  rw[group_div_def]
4436QED
4437
4438
4439(* Theorem: (x1 * y1) / (x2 * y2) = x1 * (y1 / y2) / x1 * (x1 / x2) *)
4440(* Proof:
4441     (x1 * y1) / (x2 * y2)
4442   = (x1 * y1) * |/ (x2 * y2)                    by group_div_def
4443   = (x1 * y1) * ( |/ y2 * |/ x2)                by group_inv_op
4444   = x1 * (y1 * ( |/ y2 * |/ x2))                by group_assoc
4445   = x1 * (y1 * |/ y2 * |/ x2)                   by group_assoc
4446   = x1 * (y1 * |/ y2 * ( |/ x1 * x1 * |/ x2))   by group_linv, group_lid
4447   = x1 * (y1 * |/ y2 * ( |/ x1 * (x1 * |/ x2))) by group_assoc
4448   = x1 * (y1 / y2) * |/ x1 * (x1 / x2)          by group_assoc
4449   = x1 * (y1 / y2) / x1 * (x1 / x2)             by group_div_def
4450*)
4451Theorem group_div_pair:
4452    !g:'a group. Group g ==> !x1 y1 x2 y2. x1 IN G /\ y1 IN G /\ x2 IN G /\ y2 IN G ==>
4453    ((x1 * y1) / (x2 * y2) = (x1 * (y1 / y2) / x1) * (x1 / x2))
4454Proof
4455  rw_tac std_ss[group_div_def] >>
4456  `|/ x1 IN G /\ |/ y1 IN G /\ |/ x2 IN G /\ |/ y2 IN G` by rw[group_assoc] >>
4457  `(x1 * y1) * |/ (x2 * y2) = x1 * y1 * ( |/ y2 * |/ x2)` by rw[group_inv_op] >>
4458  `_ = x1 * (y1 * |/ y2 * |/ x2)` by rw[group_assoc] >>
4459  `_ = x1 * (y1 * |/ y2 * ( |/ x1 * x1 * |/ x2))` by rw_tac std_ss[group_linv, group_lid] >>
4460  `_ = (x1 * (y1 * |/ y2) * |/ x1) * (x1 * |/ x2)` by rw[group_assoc] >>
4461  rw_tac std_ss[]
4462QED
4463
4464(* Theorem: (z * x) / (z * y) = z * (x / y) / z  *)
4465(* Proof:
4466     (z * x) / (z * y)
4467   = z * (x / y) / z * (z / z)    by group_div_pair
4468   = z * (x / y) / z * #e         by group_div_cancel
4469   = z * (x / y) / z              by group_rid
4470*)
4471Theorem group_div_lsame:
4472    !g:'a group. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((z * x) / (z * y) = z * (x / y) / z)
4473Proof
4474  rw[group_assoc, group_div_pair]
4475QED
4476
4477(* Theorem: (x * z) / (y * z) = x / y  *)
4478(* Proof:
4479     (x * z) / (y * z)
4480   = x * (z / z) / x * (x / y)   by group_div_pair
4481   = x * #e / x * (x / y)        by group_div_cancel
4482   = x / x * (x / y)             by group_rid
4483   = #e * (x / y)                by group_div_cancel
4484   = x / y                       by group_lid
4485*)
4486Theorem group_div_rsame:
4487    !g:'a group. Group g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> ((x * z) / (y * z) = x / y)
4488Proof
4489  rw[group_assoc, group_div_pair]
4490QED
4491
4492(* ------------------------------------------------------------------------- *)
4493(* Normal Subgroup                                                           *)
4494(* ------------------------------------------------------------------------- *)
4495
4496(* A Normal Subgroup: for all x IN H, for all a IN G, a * x / a IN H
4497   i.e. A subgroup, H, of a group, G, is called a normal subgroup if it is invariant under conjugation. *)
4498Definition normal_subgroup_def:
4499  normal_subgroup (h:'a group) (g:'a group) <=>
4500    h <= g /\ (!a z. a IN G /\ z IN H ==> a * z / a IN H)
4501End
4502
4503(* set overloading *)
4504Overload "<<" = ``normal_subgroup``
4505val _ = set_fixity "<<" (Infixl 650); (* higher than * or / *)
4506
4507(* Theorem: Normal subgroup is a subgroup. *)
4508Theorem normal_subgroup_subgroup =
4509    normal_subgroup_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH_ALL |> CONJUNCT1 |> DISCH_ALL |> GEN_ALL;
4510(* > val normal_subgroup_subgroup = |- !h g. h << g ==> h <= g : thm *)
4511
4512(* Theorem: Normal subgroup is invariant under conjugation. *)
4513Theorem normal_subgroup_property =
4514    normal_subgroup_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH_ALL |> CONJUNCT2 |> DISCH_ALL |> GEN_ALL;
4515(* > val normal_subgroup_property = |- !h g. h << g ==> !a z. a IN G /\ z IN H ==> a * z / a IN H : thm *)
4516
4517(* Theorem: h << g ==> h <= g /\ Group h /\ Group g *)
4518(* Proof: by normal_subgroup_def and subgroup_property. *)
4519Theorem normal_subgroup_groups:
4520    !g h:'a group. h << g ==> h <= g /\ Group h /\ Group g
4521Proof
4522  metis_tac[normal_subgroup_def, subgroup_property]
4523QED
4524
4525(* Theorem: g << g *)
4526(* Proof: by definition, this is to show:
4527   g <= g,
4528   True by subgroup_refl
4529*)
4530Theorem normal_subgroup_refl:
4531    !g:'a group. Group g ==> g << g
4532Proof
4533  rw[normal_subgroup_def, subgroup_refl]
4534QED
4535
4536(* Theorem: h << g /\ g << h ==> h = g *)
4537(* Proof: by definition, this is to show:
4538   h <= g /\ g <= h ==> h = g,
4539   True by subgroup_antisym.
4540*)
4541Theorem normal_subgroup_antisym:
4542    !(g:'a group) (h:'a group). h << g /\ g << h ==> (h = g)
4543Proof
4544  rw[normal_subgroup_def, subgroup_antisym]
4545QED
4546
4547(* Note: Subgroup normality is not transitive:
4548see: http://groupprops.subwiki.org/wiki/Normality_is_not_transitive
4549
4550D4 = <a, x | a^4 = x^2 = e, x a x = |/a >
4551Let H1 = <x>, H2 = <a^2 x>, K = <x, a^2>
4552Then H1 << K, H2 << K, K << D4, but neither H1 << D4 nor H2 << D4.
4553
4554i.e. <s> << <r^2, s> << <r, s>=D4, but <s> is not normal in D4.
4555
4556or
4557In S4 and its following subgroup A={(12)(34)} and B={(12)(34),(13)(42),(23)(41),e}
4558Try to show A is normal in B and B is normal in S4 but A is not normal in G.
4559
4560*)
4561
4562(* Property of Normal Subgroup: a subgroup with left coset = right coset. *)
4563(* Theorem: h << g <=> h <= g /\ aH = Ha  for all a in G. *)
4564(* Proof:
4565   If-part:
4566     h << g ==> !a. a IN G ==> (IMAGE (\z. z * a) H = IMAGE (\z. a * z) H)
4567   This essentially boils down to 2 cases:
4568   case 1. h <= g /\ a IN G /\ z IN H ==> ?z'. (z * a = a * z') /\ z' IN H
4569      By group property, z' = |/a * z * a, need to show that z' IN H
4570      This is because, a IN G ==> |/a IN G,
4571      hence |/a * z * |/( |/ a) IN H    by by conjugate property
4572         or |/a * z * a        IN H    by group_inv_inv
4573   case 2. h <= g /\ a IN G /\ z IN H ==> ?z'. (a * z = z' * a) /\ z' IN H
4574      By group property, z' = a * z / a, need to show z' IN H
4575      This is because a IN G, hence true by conjugate property.
4576   Only-if part:
4577      h <= g /\ !a. a IN G ==> (IMAGE (\z. z * a) H = IMAGE (\z. a * z) H) ==> a * z * |/ a IN H
4578      Since a * z IN right image, there is z' such that z' * a = a * z and z' IN H
4579      i.e. z' = a * z * |/a IN H,
4580              = a * z / a   IN H.
4581*)
4582Theorem normal_subgroup_alt:
4583    !g h:'a group. h << g <=> h <= g /\ (!a. a IN G ==> (a * H = H * a))
4584Proof
4585  rw_tac std_ss[normal_subgroup_def, coset_def, right_coset_def, EQ_IMP_THM] >| [
4586    rw[EXTENSION] >>
4587    `Group h /\ Group g` by metis_tac[subgroup_property] >>
4588    `|/a IN G` by rw[] >>
4589    rw_tac std_ss[EQ_IMP_THM] >| [
4590      qexists_tac `a * z / a` >>
4591      `z IN G` by metis_tac[subgroup_element] >>
4592      rw[group_rinv_assoc],
4593      qexists_tac `|/a * z * a` >>
4594      `z IN G` by metis_tac[subgroup_element] >>
4595      rw[group_assoc, group_linv_assoc] >>
4596      `|/ a * (z * a) = |/a * z * a` by rw[group_assoc] >>
4597      metis_tac[group_inv_inv, group_div_def]
4598    ],
4599    full_simp_tac std_ss [IMAGE_DEF, EXTENSION, GSPECIFICATION] >>
4600    `?z'. (a * z = z' * a) /\ z' IN H` by metis_tac[] >>
4601    metis_tac[group_rinv_assoc, group_div_def, Subgroup_def, SUBSET_DEF]
4602  ]
4603QED
4604
4605(* Theorem: x * H = y * H ==> x / y IN H  if  H is a normal subgroup *)
4606(* Proof:
4607   By subgroup_coset_eq, |/y * x IN H
4608   i.e. y * ( |/y * x) * |/ y    IN H  by normal_subgroup_property
4609     or x * |/ y                 IN H  by group_assoc, group_rinv, group_lid
4610     or x / y                    IN H  by group_div_def
4611*)
4612Theorem normal_subgroup_coset_eq:
4613    !g h:'a group. h << g ==> !x y. x IN G /\ y IN G ==> ((x * H = y * H) <=> x / y IN H)
4614Proof
4615  rw_tac std_ss[normal_subgroup_def, group_div_def] >>
4616  `|/y * x IN H <=> x * |/ y IN H` suffices_by rw_tac std_ss[subgroup_coset_eq] >>
4617  `Group h /\ Group g` by metis_tac[subgroup_property] >>
4618  `y * ( |/y * x) * |/ y = y * |/y * x * |/ y` by rw[group_assoc] >>
4619  `_ = x * |/ y` by rw_tac std_ss[group_rinv, group_lid] >>
4620  `|/ x * (x * |/ y) * x = |/ x * x * |/ y * x` by rw[group_assoc] >>
4621  `_ = |/ y * x` by rw_tac std_ss[group_linv, group_lid, group_inv_element] >>
4622  metis_tac[group_inv_element, group_inv_inv]
4623QED
4624
4625(* ------------------------------------------------------------------------- *)
4626(* Equivalence induced by Normal Subgroup                                    *)
4627(* ------------------------------------------------------------------------- *)
4628
4629(* Two group elements x y are equivalent if  x / y = x * |/y in normal subgroup. *)
4630
4631(* Define group element equivalence by normal subgroup. *)
4632Definition group_equiv_def:
4633  group_equiv (g:'a group) (h:'a group) x y  <=> x / y IN H
4634End
4635
4636(* set overloading *)
4637Overload "==" = ``group_equiv g h``
4638val _ = set_fixity "==" (Infix(NONASSOC, 450));
4639
4640(* Theorem: [== is reflexive] h << g ==> z == z   for z IN G. *)
4641(* Proof:
4642   z == z  iff z / z         IN H  by group_equiv_def
4643           iff z * |/z = #e  IN H  by group_div_def, group_rinv
4644   which is true since h <= g, and Group h.
4645   or: since h << g, h.id = #e     by subgroup_id
4646   hence   z * |/z = z * #e * |/z  IN H   by normal_subgroup_property.
4647*)
4648Theorem group_normal_equiv_reflexive:
4649    !g h:'a group. h << g ==> !z. z IN G ==> z == z
4650Proof
4651  rw_tac std_ss[normal_subgroup_def, group_equiv_def, group_div_def] >>
4652  metis_tac[group_id_element, subgroup_id, group_rid, Subgroup_def]
4653QED
4654
4655(* Theorem: [== is symmetric] h << g ==> x == y <=> y == x   for x, y IN G. *)
4656(* Proof:
4657   x == y  iff x / y         IN H    by group_equiv_def
4658           iff x * |/ y      IN H    by group_div_def
4659           iff |/ (x * |/ y) IN H    by group_inv_element
4660           iff y * |/ x      IN H    by group_inv_op, group_inv_inv
4661           if  y / x         IN H    by group_div_def
4662           iff y == x                by group_equiv_def
4663*)
4664Theorem group_normal_equiv_symmetric:
4665    !g h:'a group. h << g ==> !x y. x IN G /\ y IN G ==> (x == y <=> y == x)
4666Proof
4667  rw_tac std_ss[normal_subgroup_def, group_equiv_def, group_div_def] >>
4668  `Group h /\ Group g` by metis_tac[Subgroup_def] >>
4669  `|/ ( x * |/ y) = y * |/ x` by rw[group_inv_inv, group_inv_op] >>
4670  `|/ ( y * |/ x) = x * |/ y` by rw[group_inv_inv, group_inv_op] >>
4671  metis_tac[group_inv_element, subgroup_inv]
4672QED
4673
4674(* Theorem: [== is transitive] h << g ==> x == y /\ y == z ==> x == z   for x, y, z IN G. *)
4675(* Proof:
4676   x == y  iff x * |/ y  IN H        by group_equiv_def, group_div_def
4677   y == z  iff y * |/ z  IN H        by by group_equiv_def, group_div_def
4678   Together,
4679      (x * |/ y) * (y * |/ z) IN H   by group_op_element
4680   or  x * |/ z               IN H   by group_assoc, group_linv
4681   i..e. x == z                      by by group_equiv_def, group_div_def
4682*)
4683Theorem group_normal_equiv_transitive:
4684    !g h:'a group. h << g ==> !x y z. x IN G /\ y IN G /\ z IN G ==> (x == y /\ y == z ==> x == z)
4685Proof
4686  rw_tac std_ss[normal_subgroup_def, group_equiv_def, group_div_def] >>
4687  `Group h /\ Group g` by metis_tac[Subgroup_def] >>
4688  `(x * |/ y) * (y * |/ z) = (x * |/ y) * y * |/ z` by rw[group_assoc] >>
4689  `_ = x * |/ z` by rw_tac std_ss[group_linv, group_rid, group_assoc, group_inv_element] >>
4690  metis_tac[group_op_element, subgroup_property]
4691QED
4692
4693(* Theorem: [== is an equivalence relation] h << g ==> $== equiv_on G. *)
4694(* Proof: by group_normal_equiv_reflexive, group_normal_equiv_symmetric, group_normal_equiv_transitive. *)
4695Theorem group_normal_equiv:
4696    !g h:'a group. h << g ==> $== equiv_on G
4697Proof
4698  rw_tac std_ss[equiv_on_def] >| [
4699    rw_tac std_ss[group_normal_equiv_reflexive],
4700    rw_tac std_ss[group_normal_equiv_symmetric],
4701    metis_tac[group_normal_equiv_transitive]
4702  ]
4703QED
4704
4705(* ------------------------------------------------------------------------- *)
4706(* Normal Equivalence Classes are Cosets of Normal Subgroup.                 *)
4707(* ------------------------------------------------------------------------- *)
4708
4709(* Theorem: for x, y in G, x == y  iff x IN y * H, the coset of y with normal subgroup. *)
4710(* Proof:
4711   x == y  iff   x / y IN H                 by group_equiv_def
4712           iff   x * |/ y  IN H             by group_div_def
4713           iff   x * |/ y = z,  where z IN H
4714           iff   x = z * y
4715           iff   x IN IMAGE (\z. z * y) H   by IMAGE definition
4716           iff   x IN IMAGE (\z. y * z) H   by normal_subgroup_alt
4717           iff   x IN yH                    by coset definition
4718*)
4719Theorem group_normal_equiv_property:
4720    !h g:'a group. h << g ==> !x y. x IN G /\ y IN G ==> (x == y <=> x IN y * H)
4721Proof
4722  rw_tac std_ss[group_equiv_def] >>
4723  `x / y IN H <=> x IN H * y` suffices_by metis_tac[normal_subgroup_alt] >>
4724  rw_tac std_ss[group_div_def, right_coset_def, IN_IMAGE] >>
4725  `x * |/ y IN H <=> ?z. z IN H /\ (z = x * |/ y)` by rw_tac std_ss[] >>
4726  metis_tac[group_lsolve, normal_subgroup_subgroup, Subgroup_def, SUBSET_DEF]
4727QED
4728
4729(* ------------------------------------------------------------------------- *)
4730(* The map to set of costes and the induced binary operation.                *)
4731(* Aim: coset g H is a homomorphism: G -> Group of {a * H | a IN G}    *)
4732(* ------------------------------------------------------------------------- *)
4733
4734(* from subgroupTheory:
4735
4736- inCoset_def;
4737> val it = |- !g h a b. inCoset g h a b <=> b IN a * H : thm
4738
4739- inCoset_equiv_on_carrier;
4740> val it = |- !g h. h <= g ==> inCoset g h equiv_on G : thm
4741
4742- CosetPartition_def;
4743> val it = |- !g h. CosetPartition g h = partition (inCoset g h) G : thm
4744
4745- coset_partition_element;
4746> val it = |- !g h. h <= g ==> !e. e IN CosetPartition g h ==> ?a. a IN G /\ (e = a * H) : thm
4747
4748- GroupHomo_def;
4749> val it = |- !f g h. GroupHomo f g h <=> (!x. x IN G ==> f x IN H) /\
4750                                          !x y. x IN G /\ y IN G ==> (f (x * y) = h.op (f x) (f y)) : thm
4751- type_of ``a * H``;
4752> val it = ``:'a -> bool`` : hol_type
4753
4754*)
4755
4756(* Existence of coset generator: e IN CosetPartition g h ==> ?a. a IN G /\ (e = a * H) *)
4757Theorem lemma[local]:
4758    !g h e. ?a. h <= g /\ e IN CosetPartition g h ==> a IN G /\ (e = a * H)
4759Proof
4760  metis_tac[coset_partition_element]
4761QED
4762(*
4763- SKOLEM_THM;
4764> val it = |- !P. (!x. ?y. P x y) <=> ?f. !x. P x (f x) : thm
4765*)
4766(* Define coset generator *)
4767val cogen_def = new_specification(
4768    "cogen_def",
4769    ["cogen"],
4770    SIMP_RULE (srw_ss()) [SKOLEM_THM] lemma);
4771(* > val cogen_def = |- !g h e. h <= g /\ e IN CosetPartition g h ==> cogen g h e IN G /\ (e = (cogen g h e) * H) : thm *)
4772
4773(* Theorem: h <= g /\ e IN CosetPartition g h ==> cogen g h e IN G *)
4774Theorem cogen_element =
4775    cogen_def |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT1 |> DISCH_ALL |> GEN_ALL;
4776(* > val cogen_element = |- !h g e. h <= g /\ e IN CosetPartition g h ==> cogen g h e IN G : thm *)
4777
4778(* Theorem: h <= g /\ e IN CosetPartition g h ==> (cogen g h e) * H = e *)
4779Theorem coset_cogen_property =
4780    cogen_def |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT2 |> DISCH_ALL |> GEN_ALL;
4781(* > val coset_cogen_property = |- !h g e. h <= g /\ e IN CosetPartition g h ==> (e = (cogen g h e) * H) : thm *)
4782
4783(* Define coset multiplication *)
4784Definition coset_op_def:
4785  coset_op (g:'a group) (h:'a group) (x:'a -> bool) (y:'a -> bool) = ((cogen g h x) * (cogen g h y)) * H
4786End
4787
4788(* set overloading *)
4789Overload o = ``coset_op g h``
4790
4791(* Theorem: h <= g ==> cogen g h H * H = H *)
4792(* Proof:
4793   Since H = #e * H          by coset_id_eq_subgroup
4794   H IN CosetPartition g h   by coset_partition_element
4795   hence cogen g h H * H = H by cogen_def
4796*)
4797Theorem cogen_of_subgroup:
4798    !g h:'a group. h <= g ==> (cogen g h H * H = H)
4799Proof
4800  rpt strip_tac >>
4801  `#e * H = H` by rw_tac std_ss[coset_id_eq_subgroup] >>
4802  `Group g` by metis_tac[Subgroup_def] >>
4803  `H IN CosetPartition g h` by metis_tac[coset_partition_element, group_id_element] >>
4804  rw_tac std_ss[cogen_def]
4805QED
4806
4807(* Theorem: h <= g ==> !x. x IN G ==> cogen g h (x * H) IN G *)
4808(* Proof:
4809   Since x * H  IN CosetPartition g h   by coset_partition_element
4810   cogen g h (x * H) IN G               by cogen_def
4811*)
4812Theorem cogen_coset_element:
4813    !g h:'a group. h <= g ==> !x. x IN G ==> cogen g h (x * H) IN G
4814Proof
4815  metis_tac[cogen_def, coset_partition_element]
4816QED
4817
4818(* Theorem: x / cogen g h (x * H) IN H if H is a normal subgroup. *)
4819(* Proof:
4820   Since x * H IN CosetPartition g h  by coset_partition_element
4821         cogen g h (x * H) IN G /\
4822         ((cogen g h (x * H)) * H = x * H)  by cogen_def
4823   hence x / cogen g h (x * H) IN H   by normal_subgroup_coset_eq
4824*)
4825Theorem normal_cogen_property:
4826    !g h:'a group. h << g ==> !x. x IN G ==> x / cogen g h (x * H) IN H
4827Proof
4828  rpt strip_tac >>
4829  `h <= g` by rw_tac std_ss[normal_subgroup_subgroup] >>
4830  `x * H IN CosetPartition g h` by metis_tac[coset_partition_element] >>
4831  `cogen g h (x * H) IN G /\ ((cogen g h (x * H)) * H = x * H)` by rw_tac std_ss[cogen_def] >>
4832  metis_tac[normal_subgroup_coset_eq]
4833QED
4834
4835(* Theorem: h << g ==> cogen g h (a * H) * b * H = a * b * H  *)
4836(* Proof:
4837   By normal_subgroup_coset_eq, and reversing the equality,
4838   this is to show: (a * b) / (cogen g h (a * H) * b) IN H
4839   but  (a * b) / (cogen g h (a * H) * b) = a / cogen g h (a * H)  by group_div_rsame
4840   and  a / cogen g h (a * H) IN H    by normal_cogen_property.
4841*)
4842Theorem normal_coset_property1:
4843    !g h:'a group. h << g ==> !a b. a IN G /\ b IN G ==> (cogen g h (a * H) * b * H = a * b * H)
4844Proof
4845  rpt strip_tac >>
4846  `h <= g /\ Group g` by metis_tac[normal_subgroup_groups] >>
4847  `cogen g h (a * H) IN G` by rw_tac std_ss[cogen_coset_element] >>
4848  `a / cogen g h (a * H) IN H` by rw_tac std_ss[normal_cogen_property] >>
4849  `(a * b) / (cogen g h (a * H) * b) = a / cogen g h (a * H)` by rw_tac std_ss[group_div_rsame] >>
4850  metis_tac[normal_subgroup_coset_eq, group_op_element]
4851QED
4852
4853(* Theorem: h << g ==> a * cogen g h (b * H) * H = a * b * H  *)
4854(* Proof:
4855   By normal_subgroup_coset_eq, and reversing the equality,
4856   this is to show: (a * b) / (a * cogen g h (b * H)) IN H
4857   but (a * b) / (a * cogen g h (b * H)) = a * (b / cogen g h (b * H)) / a  by group_div_lsame
4858   and  b / cogen g h (b * H) IN H          by normal_cogen_property
4859   hence a * b / cogen g h (b * H) / a IN H by normal_subgroup_property
4860*)
4861Theorem normal_coset_property2:
4862    !g h:'a group. h << g ==> !a b. a IN G /\ b IN G ==> (a * cogen g h (b * H) * H = a * b * H)
4863Proof
4864  rpt strip_tac >>
4865  `h <= g /\ Group g` by metis_tac[normal_subgroup_groups] >>
4866  `cogen g h (b * H) IN G` by rw_tac std_ss[cogen_coset_element] >>
4867  `b / cogen g h (b * H) IN H` by rw_tac std_ss[normal_cogen_property] >>
4868  `a * b / (a * cogen g h (b * H)) = a * (b / cogen g h (b * H)) / a` by rw_tac std_ss[group_div_lsame] >>
4869  `a * b / (a * cogen g h (b * H)) IN H` by rw_tac std_ss[normal_subgroup_property] >>
4870  metis_tac[normal_subgroup_coset_eq, group_op_element]
4871QED
4872
4873(* Theorem: h << g ==> !a b. a IN G /\ b IN G ==> (cogen g h (a * H) * cogen g h (b * H) * H = a * b * H) *)
4874(* Proof:
4875   h << g ==> h <= g                  by normal_subgroup_subgroup
4876   a IN G ==> cogen g h (a * H) IN G  by cogen_coset_element, h <= g
4877   b IN G ==> cogen g h (b * H) IN G  by cogen_coset_element, h <= g
4878     cogen g h (a * H) * cogen g h (b * H) * H
4879   = a * cogen g h (b * H) * H        by normal_coset_property1, h << g
4880   = a * b * H                        by normal_coset_property2, h << g
4881*)
4882Theorem normal_coset_property:
4883    !g h:'a group. h << g ==> !a b. a IN G /\ b IN G ==> (cogen g h (a * H) * cogen g h (b * H) * H = a * b * H)
4884Proof
4885  rw_tac std_ss[normal_subgroup_subgroup, cogen_coset_element, normal_coset_property1, normal_coset_property2]
4886QED
4887
4888(* ------------------------------------------------------------------------- *)
4889(* Quotient Group                                                            *)
4890(* ------------------------------------------------------------------------- *)
4891(* Define the quotient group, the group divided by a normal subgroup. *)
4892Definition quotient_group_def:
4893  quotient_group (g:'a group) (h:'a group) =
4894    <| carrier := (CosetPartition g h);
4895            op := coset_op g h;
4896            id := H
4897     |>
4898End
4899
4900(* set overloading *)
4901Overload "/" = ``quotient_group``
4902val _ = set_fixity "/" (Infixl 600); (* same as "*" in arithmeticScript.sml *)
4903
4904(*
4905- type_of ``(g:'a group) / (h:'a group)``;
4906> val it = ``:('a -> bool) group`` : hol_type
4907- type_of ``coset g H``;
4908> val it = ``:'a -> 'a -> bool`` : hol_type
4909*)
4910
4911(* Theorem: [Quotient Group Closure]
4912   h << g ==> x IN CosetPartition g h /\ y IN CosetPartition g h ==> x o y IN CosetPartition g h *)
4913(* Proof:
4914   x o y = cogen g h x * cogen g h y * H    by coset_op_def
4915   Since cogen g h x IN G    by cogen_def
4916     and cogen g h y IN G    by cogen_def
4917   hence cogen g h x * cogen g h y IN G   by group_op_element
4918      or (cogen g h x * cogen g h y IN G) * H IN CosetPartition g h   by coset_partition_element.
4919
4920*)
4921Theorem quotient_group_closure:
4922    !g h:'a group. h <= g ==> !x y. x IN CosetPartition g h /\ y IN CosetPartition g h ==> x o y IN CosetPartition g h
4923Proof
4924  rw_tac std_ss[coset_op_def] >>
4925  `cogen g h x IN G /\ cogen g h y IN G` by rw_tac std_ss[cogen_def] >>
4926  metis_tac[group_op_element, coset_partition_element, Subgroup_def]
4927QED
4928
4929(* Theorem: [Quotient Group Associativity]
4930   h << g ==> x IN CosetPartition g h /\ y IN CosetPartition g h /\ z IN CosetPartition g h ==> (x o y) o z = x o (y o z)  *)
4931(* Proof:
4932   By coset_op_def,
4933     (x o y) o z
4934   = cogen g h (cogen g h x * cogen g h y * H) * cogen g h z * H     by coset_op_def
4935   = ((cogen g h x * cogen g h y) * cogen g h z) * H                 by normal_coset_property1
4936   = (cogen g h x * (cogen g h y * cogen g h z)) * H                 by group_assoc
4937   = cogen g h x * cogen g h (cogen g h y * cogen g h z * H) * H     by normal_coset_property2
4938   = x o (y o z)                                                     by coset_op_def
4939
4940   Since cogen g h x IN G    by cogen_def
4941     and cogen g h y IN G    by cogen_def
4942     and cogen g h z IN G    by cogen_def
4943   Let t = cogen g h x * cogen g h y  IN G
4944       t * H   IN CosetPartition g h
4945       cogen g h (t * H)  IN G /\ (cogen g h (t * H)) * H = t * H
4946   For h << g, this implies t / cogen g h (t * H)  IN H   by normal_cogen_property
4947
4948*)
4949Theorem quotient_group_assoc:
4950    !g h:'a group. h << g ==> !x y z. x IN CosetPartition g h /\ y IN CosetPartition g h /\ z IN CosetPartition g h
4951      ==> ((x o y) o z = x o (y o z))
4952Proof
4953  rw_tac std_ss[coset_op_def] >>
4954  `h <= g /\ Group g` by metis_tac[normal_subgroup_groups] >>
4955  rw[group_assoc, normal_coset_property1, normal_coset_property2, cogen_coset_element, cogen_def]
4956QED
4957
4958(* Theorem: [Quotient Group Identity]
4959   h << g ==> H IN CosetPartition g h /\ !x. x INCosetPartition g h ==> H o x = x *)
4960(* Proof:
4961   Since  #e * H = H                by coset_id_eq_subgroup
4962   hence  H IN CosetPartition g h   by coset_partition_element, group_id_element
4963   Since  cogen g h x IN G and x = cogen g h x * H     by cogen_def
4964   By normal_coset_property1,
4965       cogen g h (#e * H) * cogen g h x * H = #e * cogen g h x * H
4966   or  cogen g h H * cogen g h x * H = cogen g h x * H   by group_lid
4967   Hence
4968       H o x = cogen g h H * cogen g h x * H    by coset_op_def
4969             = cogen g h x * H                  by above
4970             = x
4971*)
4972Theorem quotient_group_id:
4973    !g h:'a group. h << g ==> H IN CosetPartition g h /\ !x. x IN CosetPartition g h ==> (H o x = x)
4974Proof
4975  ntac 3 strip_tac >>
4976  `h <= g /\ Group g` by metis_tac[normal_subgroup_def, Subgroup_def] >>
4977  `#e * H = H` by rw_tac std_ss[coset_id_eq_subgroup] >>
4978  `#e IN G` by rw_tac std_ss[group_id_element] >>
4979  rw_tac std_ss[coset_op_def] >| [
4980    metis_tac[coset_partition_element],
4981    `cogen g h x IN G /\ (cogen g h x * H = x)` by rw_tac std_ss[cogen_def] >>
4982    `cogen g h (#e * H) * cogen g h x * H = #e * cogen g h x * H` by rw_tac std_ss[normal_coset_property1] >>
4983    metis_tac[group_lid]
4984  ]
4985QED
4986
4987(* Theorem: [Quotient Group Inverse]
4988   h << g ==> x IN CosetPartition g h ==> ?y. y IN CosetPartition g h /\ (y o x = H) *)
4989(* Proof:
4990   Since x IN CosetPartition g h,
4991       cogen g h x IN G /\ (cogen g h x * H = x)                     by cogen_def
4992   and |/ (cogen g h x) IN G /\ |/ (cogen g h x) * cogen g h x = #e  by group_inv_element, group_linv
4993   hence  |/ (cogen g h x) * H IN CosetPartition g h                 by coset_partition_element
4994   Let y = |/ (cogen g h x) * H, then
4995   y o x = cogen g h ( |/ (cogen g h x) * H) * cogen g h x * H
4996         = |/ (cogen g h x) * H o cogen g h x * H                    by normal_coset_property1
4997         = ( |/ (cogen g h x) * cogen g h x) * H                     by coset_op_def
4998         = #e * H = H                                                by coset_id_eq_subgroup
4999*)
5000Theorem quotient_group_inv:
5001    !g h:'a group. h << g ==> !x. x IN CosetPartition g h ==> ?y. y IN CosetPartition g h /\ (y o x = H)
5002Proof
5003  rpt strip_tac >>
5004  `h <= g /\ Group g` by metis_tac[normal_subgroup_groups] >>
5005  `cogen g h x IN G /\ (cogen g h x * H = x)` by rw_tac std_ss[cogen_def] >>
5006  `|/ (cogen g h x) IN G /\ ( |/ (cogen g h x) * cogen g h x = #e)` by rw[] >>
5007  `|/ (cogen g h x) * H IN CosetPartition g h` by metis_tac[coset_partition_element] >>
5008  metis_tac[coset_op_def, normal_coset_property1, coset_id_eq_subgroup]
5009QED
5010
5011(* Theorem: quotient_group is a group for normal subgroup
5012   i.e. h << g ==> Group (quotient_group g h)               *)
5013(* Proof:
5014   This is to prove:
5015   (1) x IN CosetPartition g h /\ y IN CosetPartition g h ==> x o y IN CosetPartition g h
5016       true by quotient_group_closure.
5017   (2) x IN CosetPartition g h /\ y IN CosetPartition g h /\ z IN CosetPartition g h ==> (x o y) o z = x o y o z
5018       true by quotient_group_assoc.
5019   (3) H IN CosetPartition g h
5020       true by quotient_group_id.
5021   (4) x IN CosetPartition g h ==> H o x = x
5022       true by quotient_group_id.
5023   (5) x IN CosetPartition g h ==> ?y. y IN CosetPartition g h /\ (y o x = H)
5024       true by quotient_group_inv.
5025*)
5026Theorem quotient_group_group:
5027    !g h:'a group. h << g ==> Group (quotient_group g h)
5028Proof
5029  rpt strip_tac >>
5030  `h <= g /\ Group h /\ Group g` by metis_tac[normal_subgroup_groups] >>
5031  rw_tac std_ss[group_def_alt, quotient_group_def] >| [
5032    rw_tac std_ss[quotient_group_closure],
5033    rw_tac std_ss[quotient_group_assoc],
5034    rw_tac std_ss[quotient_group_id],
5035    rw_tac std_ss[quotient_group_id],
5036    rw_tac std_ss[quotient_group_inv]
5037  ]
5038QED
5039
5040(* ------------------------------------------------------------------------- *)
5041(* Group Homomorphism by left_coset via normal subgroup.                     *)
5042(* ------------------------------------------------------------------------- *)
5043
5044(* Theorem: A normal subgroup induces a natural homomorphism to its quotient group, i.e.
5045            h << g ==> GroupHomo (left_coset g H) g (g / h) *)
5046(* Proof:
5047   After expanding by quotient_group_def, this is to show 2 things:
5048   (1) h << g /\ x IN G ==> x * H IN CosetPartition g h
5049       This is true by coset_partition_element, and normal_subgroup_subgroup.
5050   (2) h << g /\ x IN G /\ y IN G ==> (x * y) * H = x * H o y * H
5051       This is to show:
5052       (x * y) * H = (cogen g h (x * H) * cogen g h (y * H)) * H
5053       Since x * H IN CosetPartition g h    by coset_partition_element
5054             y * H IN CosetPartition g h    by coset_partition_element
5055       hence cogen g h (x * H) IN G         by cogen_def
5056             cogen g h (y * H) IN G         by cogen_def
5057       By normal_subgroup_coset_eq, this is to show:
5058             (x * y) / (cogen g h (x * H) * cogen g h (y * H)) IN H
5059       But  (x * y) / (cogen g h (x * H) * cogen g h (y * H))
5060          = x * (y / cogen g h (y * H)) / x * (x / cogen g h (x * H)  by group_div_pair
5061
5062       Since      x / cogen g h (x * H) IN H    by normal_cogen_property
5063       and    z = y / cogen g h (y * H) IN H    by normal_cogen_property
5064       so     x * z * / x  IN H  since z IN H   by normal_subgroup_property
5065       hence their product is IN H              by group_op_element
5066*)
5067Theorem normal_subgroup_coset_homo:
5068    !g h:'a group. h << g ==> GroupHomo (left_coset g H) g (g / h)
5069Proof
5070  rw_tac std_ss[GroupHomo_def, quotient_group_def, left_coset_def] >-
5071  metis_tac[coset_partition_element, normal_subgroup_subgroup] >>
5072  rw_tac std_ss[coset_op_def] >>
5073  `h <= g /\ !a z. a IN G /\ z IN H ==> a * z / a IN H` by metis_tac[normal_subgroup_def] >>
5074  `Group h /\ Group g /\ !x y. x IN H /\ y IN H ==> (h.op x y = x * y)` by metis_tac[subgroup_property] >>
5075  `x * H IN CosetPartition g h /\ y * H IN CosetPartition g h` by metis_tac[coset_partition_element] >>
5076  `cogen g h (x * H) IN G /\ cogen g h (y * H) IN G` by rw_tac std_ss[cogen_def] >>
5077  `(x * y) / (cogen g h (x * H) * cogen g h (y * H)) IN H`
5078     suffices_by rw_tac std_ss[normal_subgroup_coset_eq, group_op_element] >>
5079  rw_tac std_ss[group_div_pair] >>
5080  `x / cogen g h (x * H) IN H /\ y / cogen g h (y * H) IN H` by rw_tac std_ss[normal_cogen_property] >>
5081  `x * (y / cogen g h (y * H)) / x IN H` by rw_tac std_ss[normal_subgroup_property] >>
5082  metis_tac[group_op_element]
5083QED
5084
5085(* Theorem: x o y = (CHOICE (preimage (left_coset g H) G x) * CHOICE (preimage (left_coset g H) G y)) * H *)
5086(* Proof:
5087   This is to show:
5088   cogen g h x * cogen g h y * H = CHOICE (preimage (left_coset g H) G x) * CHOICE (preimage (left_coset g H) G y) * H
5089   By normal_subgroup_coset_eq, need to show:
5090      (cogen g h x * cogen g h y) / (CHOICE (preimage (left_coset g H) G x) * CHOICE (preimage (left_coset g H) G y)) IN H
5091   i.e.  (cogen g h x) * ((cogen g h y) / CHOICE (preimage (left_coset g H) G y)) / (cogen g h x) *
5092         ((cogen g h x) / CHOICE (preimage (left_coset g H) G x))   IN H    by group_div_pair
5093   Since  x = (cogen g h x) * H                by cogen_def
5094          x = (CHOICE (preimage (left_coset g H) G x)) * H   by preimage_choice_property
5095          (cogen g h x) / (CHOICE (preimage (left_coset g H) G x)) IN H    by normal_subgroup_coset_eq
5096   Similarly,
5097          y = (cogen g h y) * H                by cogen_def
5098          y = (CHOICE (preimage (left_coset g H) G y)) * H   by preimage_def
5099          (cogen g h y) / (CHOICE (preimage (left_coset g H) G y)) IN H    by normal_subgroup_coset_eq
5100   Hence (cogen g h x) * ((cogen g h y) / (CHOICE (preimage (left_coset g H) G y))) / (cogen g h x)   by normal_subgroup_property
5101   and the whole product is thus in H                by group_op_element, as h <= g ==> Group h.
5102*)
5103Theorem normal_coset_op_property:
5104    !g h:'a group. h << g ==> !x y. x IN CosetPartition g h /\ y IN CosetPartition g h ==>
5105     (x o y = (CHOICE (preimage (left_coset g H) G x) * CHOICE (preimage (left_coset g H) G y)) * H)
5106Proof
5107  rw_tac std_ss[coset_op_def] >>
5108  `h <= g /\ Group g /\ !a z. a IN G /\ z IN H ==> a * z / a IN H` by metis_tac[normal_subgroup_def, subgroup_property] >>
5109  `cogen g h x IN G /\ ((cogen g h x) * H = x)` by rw_tac std_ss[cogen_def] >>
5110  `cogen g h y IN G /\ ((cogen g h y) * H = y)` by rw_tac std_ss[cogen_def] >>
5111  `x IN IMAGE (left_coset g H) G` by metis_tac[coset_partition_element, left_coset_def, IN_IMAGE] >>
5112  `y IN IMAGE (left_coset g H) G` by metis_tac[coset_partition_element, left_coset_def, IN_IMAGE] >>
5113  `CHOICE (preimage (left_coset g H) G x) IN G /\ (x = (CHOICE (preimage (left_coset g H) G x)) * H)` by metis_tac[preimage_choice_property, left_coset_def] >>
5114  `CHOICE (preimage (left_coset g H) G y) IN G /\ (y = (CHOICE (preimage (left_coset g H) G y)) * H)` by metis_tac[preimage_choice_property, left_coset_def] >>
5115  `(cogen g h x) / CHOICE (preimage (left_coset g H) G x) IN H` by metis_tac[normal_subgroup_coset_eq] >>
5116  `(cogen g h y) / CHOICE (preimage (left_coset g H) G y) IN H` by metis_tac[normal_subgroup_coset_eq] >>
5117  `(cogen g h x * cogen g h y) / (CHOICE (preimage (left_coset g H) G x) * CHOICE (preimage (left_coset g H) G y)) IN H` suffices_by rw_tac std_ss[normal_subgroup_coset_eq, group_op_element] >>
5118  rw_tac std_ss[group_div_pair] >>
5119  prove_tac[group_op_element, subgroup_property]
5120QED
5121(* This theorem does not help to prove identity below, but helps to prove isomorphism. *)
5122
5123(* Theorem: h << g ==> GroupIso I (homo_group g (left_coset g H)) (g / h)  *)
5124(* Proof:
5125   This is to show:
5126   (1) h << g ==> GroupHomo I (homo_group g (left_coset g H)) (g / h)
5127       This is to show:
5128       (1.1) x IN IMAGE (left_coset g H) G ==> x IN CosetPartition g h
5129             true by subgroup_coset_in_partition.
5130       (1.2) x IN IMAGE (left_coset g H) G /\ y IN IMAGE (left_coset g H) G ==> image_op g (left_coset g H) x y = x o y
5131             Since x IN CosetPartition g h    by subgroup_coset_in_partition
5132                   y IN CosetPartition g h    by subgroup_coset_in_partition
5133             hence true by normal_coset_op_property, image_op_def, left_coset_def.
5134   (2) h << g ==> BIJ I (homo_group g (left_coset g H)).carrier (g / h).carrier
5135       This is to show: BIJ I (IMAGE (left_coset g H) G) (CosetPartition g h)
5136       Since h <= g  by normal_subgroup_def
5137       this is true by BIJ and subgroup_coset_in_partition.
5138*)
5139Theorem coset_homo_group_iso_quotient_group:
5140    !g h:'a group. h << g ==> GroupIso I (homo_group g (left_coset g H)) (g / h)
5141Proof
5142  rw_tac std_ss[GroupIso_def] >| [
5143    `h <= g` by metis_tac[normal_subgroup_def] >>
5144    rw_tac std_ss[GroupHomo_def, homo_monoid_def, quotient_group_def] >| [
5145      rw_tac std_ss[GSYM subgroup_coset_in_partition],
5146      `x IN CosetPartition g h` by rw_tac std_ss[GSYM subgroup_coset_in_partition] >>
5147      `y IN CosetPartition g h` by rw_tac std_ss[GSYM subgroup_coset_in_partition] >>
5148      rw_tac std_ss[image_op_def, left_coset_def, normal_coset_op_property]
5149    ],
5150    `h <= g` by metis_tac[normal_subgroup_def] >>
5151    rw_tac std_ss[homo_monoid_def, quotient_group_def] >>
5152    rw_tac std_ss[BIJ_DEF, INJ_DEF, SURJ_DEF, subgroup_coset_in_partition]
5153  ]
5154QED
5155
5156(* ------------------------------------------------------------------------- *)
5157(* Kernel Group of Group Homomorphism.                                       *)
5158(* ------------------------------------------------------------------------- *)
5159
5160(* Define kernel of a mapping: the preimage of identity. *)
5161Definition kernel_def:
5162  kernel f (g:'a group) (h:'b group) = preimage f G h.id
5163End
5164
5165(* Convert kernel to a group structure *)
5166Definition kernel_group_def:
5167  kernel_group f (g:'a group) (h:'b group) =
5168    <| carrier := kernel f g h;
5169            id := g.id;
5170            op := g.op
5171     |>
5172End
5173
5174(* Theorem: !x. x IN kernel f g h <=> x IN G /\ f x = h.id *)
5175(* Proof: by definition. *)
5176Theorem kernel_property[simp]:
5177    !(g:'a group) (h:'b group). !f x. x IN kernel f g h <=> x IN G /\ (f x = h.id)
5178Proof
5179  simp_tac std_ss [kernel_def, preimage_def] >>
5180  rw[]
5181QED
5182
5183
5184(* Theorem alias *)
5185Theorem kernel_element = kernel_property;
5186(*
5187val kernel_element = |- !g h f x. x IN kernel f g h <=> x IN G /\ (f x = h.id): thm
5188*)
5189
5190(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==> Group (kernel_group f g h) *)
5191(* Proof:
5192   This is to show:
5193   (1) x IN kernel f g h /\ y IN kernel f g h ==> x * y IN kernel f g h
5194   By kernel property, x IN G and y IN G.
5195   f (x * y) = (f x) o (f y)      by GroupHomo_def
5196             = h.id o h.id        by kernel_property
5197             = h.id               by group_id_id
5198   Since x * y IN G               by group_op_element
5199   Hence x * y IN kernel f g h    by preimage_of_image
5200   (2) x IN kernel f g h /\ y IN kernel f g h /\ z IN kernel f g h ==> x * y * z = x * (y * z)
5201   By kernel_property, x IN G, y IN G and z IN G,
5202   Hence x * y * z = x * (y * z)  by group_assoc
5203   (3) #e IN kernel f g h
5204   Since #e IN G                  by group_id_element
5205   and f #e = h.id                by group_homo_id
5206   Hence #e IN kernel f g h       by preimage_of_image
5207   (4) x IN kernel f g h ==> #e * x = x
5208   By kernel property, x IN G.
5209   Hence #e * x = x               by group_lid
5210   (5) x IN kernel f g h ==> ?y. y IN kernel f g h /\ (y * x = #e)
5211   By kernel property, x IN G.
5212   Also, |/ x IN G                by group_inv_element
5213   Let y = |/ x, then y * x = #e  by group_linv
5214   Now f ( |/ x) = h.inv (f x))   by group_homo_inv
5215                = h.inv (h.id)    by kernel_property
5216                = h.id            by group_inv_id
5217   Hence |/ x IN kernel f g h     by preimage_of_image
5218*)
5219Theorem kernel_group_group:
5220    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\ GroupHomo f g h ==> Group (kernel_group f g h)
5221Proof
5222  rw_tac std_ss[GroupHomo_def] >>
5223  rw_tac std_ss[group_def_alt, kernel_group_def] >| [
5224    `x IN G /\ y IN G` by metis_tac[kernel_property] >>
5225    `x * y IN G` by rw[] >>
5226    `f (x * y) = h.id` by metis_tac[kernel_property, group_id_id] >>
5227    metis_tac[kernel_def, preimage_of_image],
5228    `x IN G /\ y IN G /\ z IN G` by metis_tac[kernel_property] >>
5229    rw[group_assoc],
5230    `#e IN G` by rw[] >>
5231    `f #e = h.id` by rw_tac std_ss[group_homo_id, GroupHomo_def] >>
5232    metis_tac[kernel_def, preimage_of_image],
5233    `x IN G` by metis_tac[kernel_property] >>
5234    rw[],
5235    `x IN G` by metis_tac[kernel_property] >>
5236    qexists_tac `|/ x` >>
5237    rw[] >>
5238    `|/x IN G` by rw[] >>
5239    `f ( |/ x) = h.inv (f x)` by rw_tac std_ss[group_homo_inv, GroupHomo_def] >>
5240    `_ = h.inv h.id` by metis_tac[kernel_property] >>
5241    `_ = h.id` by rw[] >>
5242    metis_tac[kernel_def, preimage_of_image]
5243  ]
5244QED
5245
5246(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==> (kernel_group f g h) <= g *)
5247(* Proof: by Subgroup_def.
5248   (1) Group (kernel_group f g h)
5249   True by kernel_group_group.
5250   (2) (kernel_group f g h).carrier SUBSET G
5251   True by kernel_group_def, kernel_def, preimage_subset.
5252   (3) x IN (kernel_group f g h).carrier /\ y IN (kernel_group f g h).carrier ==> (kernel_group f g h).op x y = x * y
5253   True by kernel_group_def.
5254*)
5255Theorem kernel_group_subgroup:
5256    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\ GroupHomo f g h ==> (kernel_group f g h) <= g
5257Proof
5258  rw_tac std_ss[Subgroup_def] >| [
5259    rw_tac std_ss[kernel_group_group],
5260    rw[kernel_group_def, kernel_def, preimage_subset],
5261    full_simp_tac (srw_ss()) [kernel_group_def]
5262  ]
5263QED
5264
5265(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==> (kernel_group f g h) << g *)
5266(* Proof: by normal_subgroup_def.
5267   With kernel_group_subgroup, it needs to show further:
5268   a IN G /\ z IN kernel f g h ==> a * z * |/ a IN kernel f g h
5269   By kernel_property, z IN G /\ f z = h.id
5270   Hence a * z * |/ a IN G              by group_op_element, group_inv_element.
5271     f (a * z * |/ a)
5272   = h.op (f (a * z)) f ( |/ a)         by GroupHomo_def
5273   = h.op (h.op (f a) (f z)) f ( |/ a)  by GroupHomo_def
5274   = h.op (h.op (f a) h.id) (h.inv f a) by group_homo_inv
5275   = h.op (f a) (h.inv f a)             by group_rid
5276   = h.id                               by group_rinv
5277   Hence a * z * |/ a IN kernel f g h   by preimage_of_image
5278*)
5279Theorem kernel_group_normal:
5280    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\ GroupHomo f g h ==> (kernel_group f g h) << g
5281Proof
5282  rw_tac std_ss[normal_subgroup_def, kernel_group_subgroup, kernel_group_def] >>
5283  `z IN G /\ (f z = h.id)` by metis_tac[kernel_property] >>
5284  `|/ a IN G /\ a * z IN G /\ a * z * |/ a IN G` by rw[] >>
5285  `f (a * z * |/ a) = h.id` by metis_tac[group_rid, group_rinv, group_homo_inv, GroupHomo_def] >>
5286  metis_tac[kernel_property, group_div_def]
5287QED
5288
5289(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==> Group (g / (kernel_group f g h)) *)
5290(* Proof:
5291   By kernel_group_normal, kernel_group f g h << g.
5292   By quotient_group_group, Group (g / (kernel_group f g h))
5293*)
5294Theorem kernel_quotient_group:
5295    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\ GroupHomo f g h ==> Group (g / kernel_group f g h)
5296Proof
5297  rw[kernel_group_normal, quotient_group_group]
5298QED
5299
5300(* ------------------------------------------------------------------------- *)
5301(* Homomorphic Image and Kernel.                                             *)
5302(* ------------------------------------------------------------------------- *)
5303
5304(* Proved in groupTheory,
5305- group_homo_group;
5306> val it = |- !g f. Group g /\ GroupHomo f g (homo_group g f) ==> Group (homo_group g f) : thm
5307- homo_monoid_def;
5308> val it = |- !g f. homo_group g f = <|carrier := IMAGE f G; op := image_op g f; id := f #e|> : thm
5309*)
5310
5311(* Define the homomorphic image of a group via homomorphism. *)
5312Definition homo_image_def:
5313  homo_image f (g:'a group) (h:'b group) =
5314    <| carrier := IMAGE f G;
5315            op := h.op;
5316            id := h.id
5317     |>
5318End
5319
5320(* Theorem: Monoid g /\ Monoid h /\ MonoidHomo f g h ==> Monoid (homo_image f g h) *)
5321(* Proof: by definition.
5322   (1) x IN IMAGE f G /\ y IN IMAGE f G ==> h.op x y IN IMAGE f G
5323   By IN_IMAGE, there are a IN G with f a = x, and b IN G with f b = y.
5324   Then h.op x y = h.op (f a) (f b) = f (a * b)                        by GroupHomo_def
5325   Since a * b IN G  by group_op_element, hence f (a * b) IN IMAGE f G by IN_IMAGE.
5326   (2) x IN IMAGE f G /\ y IN IMAGE f G /\ z IN IMAGE f G ==> h.op (h.op x y) z = h.op x (h.op y z)
5327   By IN_IMAGE, there are a IN G with f a = x, b IN G with f b = y, and c IN G with f c = z.
5328   Hence x, y, z IN h.carrier      by MonoidHomo_def, thus true by monoid_assoc.
5329   (3) h.id IN IMAGE f G
5330   Since #e IN G               by monoid_id_element
5331   and f #e = h.id             by MonoidHomo_def
5332   Hence h.id IN IMAGE f G     by IN_IMAGE
5333   (4) h.op h.id x = x
5334   By IN_IMAGE, there are a IN G with f a = x.
5335   Hence x IN h.carrier        by MonoidHomo_def
5336   Hence h.op h.id x = x       by monoid_lid
5337   (5) h.op x h.id = x
5338   By IN_IMAGE, there are a IN G with f a = x.
5339   Hence x IN h.carrier        by MonoidHomo_def
5340   Hence h.op x h.id = x      by monoid_rid
5341*)
5342Theorem homo_image_monoid:
5343    !(g:'a monoid) (h:'b monoid). !f. Monoid g /\ Monoid h /\ MonoidHomo f g h ==> Monoid (homo_image f g h)
5344Proof
5345  rw_tac std_ss[MonoidHomo_def] >>
5346  `!x. x IN IMAGE f G ==> ?a. a IN G /\ (f a = x)` by metis_tac[IN_IMAGE] >>
5347  rw_tac std_ss[homo_image_def, Monoid_def] >| [
5348    `?a. a IN G /\ (f a = x)` by rw_tac std_ss[] >>
5349    `?b. b IN G /\ (f b = y)` by rw_tac std_ss[] >>
5350    `a * b IN G` by rw[] >>
5351    `h.op x y = f (a * b)` by rw_tac std_ss[] >>
5352    metis_tac[IN_IMAGE],
5353    `x IN h.carrier` by metis_tac[] >>
5354    `y IN h.carrier` by metis_tac[] >>
5355    `z IN h.carrier` by metis_tac[] >>
5356    rw[monoid_assoc],
5357    metis_tac[monoid_id_element, IN_IMAGE],
5358    `x IN h.carrier` by metis_tac[] >>
5359    rw[],
5360    `x IN h.carrier` by metis_tac[] >>
5361    rw[]
5362  ]
5363QED
5364
5365(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==> Group (homo_image f g h) *)
5366(* Proof: by definition.
5367   (1) x IN IMAGE f G /\ y IN IMAGE f G ==> h.op x y IN IMAGE f G
5368   By IN_IMAGE, there are a IN G with f a = x, and b IN G with f b = y.
5369   Then h.op x y = h.op (f a) (f b) = f (a * b)   by GroupHomo_def
5370   Since a * b IN G  by group_op_element, hence f (a * b) IN IMAGE f G by IN_IMAGE.
5371   (2) x IN IMAGE f G /\ y IN IMAGE f G /\ z IN IMAGE f G ==> h.op (h.op x y) z = h.op x (h.op y z)
5372   By IN_IMAGE, there are a IN G with f a = x, b IN G with f b = y, and c IN G with f c = z.
5373   Hence x, y, z IN h.carrier  by GroupHomo_def, thus true by group_assoc.
5374   (3) h.id IN IMAGE f G
5375   Since #e IN G               by group_id_element
5376   and f #e = h.id             by group_homo_id
5377   Hence h.id IN IMAGE f G     by IN_IMAGE
5378   (4) h.op h.id x = x
5379   By IN_IMAGE, there are a IN G with f a = x.
5380   Hence x IN h.carrier        by GroupHomo_def
5381   Hence h.op h.id x = x       by group_lid
5382
5383   Since GroupHomo f g h /\           by given
5384         f #e = h.id                  by group_homo_id
5385     ==> MonoidHomo h g h             by GroupHomo_def, MonoidHomo_def
5386   Hence Monoid (homo_image f g h)    by homo_image_monoid
5387   With Group_def and other definitions, this is to show:
5388         x IN IMAGE f G ==> ?y. y IN IMAGE f G /\ (h.op y x = h.id)
5389   By IN_IMAGE, there is a IN G with f a = x.
5390   Hence |/ a IN G                    by group_inv_element
5391   Let y = f ( |/ a), y IN IMAGE f G  by IN_IMAGE
5392   h.op y x = h.op (f ( |/ a)) (f a)
5393            = f ( |/a * a)            by GroupHomo_def
5394            = f #e                    by group_linv
5395            = h.id                    by group_homo_id
5396   h.op x y = h.op (f a) (f ( |/ a))
5397            = f (a * |/a )            by GroupHomo_def
5398            = f #e                    by group_rinv
5399            = h.id                    by group_homo_id
5400*)
5401Theorem homo_image_group:
5402    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\ GroupHomo f g h ==> Group (homo_image f g h)
5403Proof
5404  rpt strip_tac >>
5405  `f #e = h.id` by rw_tac std_ss[group_homo_id] >>
5406  `MonoidHomo f g h` by prove_tac[GroupHomo_def, MonoidHomo_def] >>
5407  `Monoid (homo_image f g h)` by rw[homo_image_monoid] >>
5408  rw_tac std_ss[Group_def, monoid_invertibles_def, homo_image_def, GSPECIFICATION, EXTENSION, EQ_IMP_THM] >>
5409  `?a. a IN G /\ (f a = x)` by metis_tac[IN_IMAGE] >>
5410  `|/ a IN G` by rw[] >>
5411  `( |/ a * a = #e) /\ (a * |/ a = #e)` by rw[] >>
5412  `f ( |/ a) IN IMAGE f G` by metis_tac[GroupHomo_def, IN_IMAGE] >>
5413  metis_tac[GroupHomo_def]
5414QED
5415
5416(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==> (homo_image f g h) <= h *)
5417(* Proof: by Subgroup_def.
5418   (1) Group (homo_image f g h)
5419   True by homo_image_group.
5420   (2) (homo_image f g h).carrier SUBSET h.carrier
5421   (homo_image f g h).carrier = IMAGE f G    by homo_image_def
5422   For all x IN IMAGE f G, ?a. a IN G /\ (f a = x)   by IN_IMAGE
5423   Hence x IN h.carrier by GroupHomo_def, hence true by SUBSET_DEF.
5424   (3) x IN (homo_image f g h).carrier /\ y IN (homo_image f g h).carrier ==> (homo_image f g h).op x y = h.op x y
5425   True by homo_image_def.
5426*)
5427Theorem homo_image_subgroup:
5428    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\ GroupHomo f g h ==> (homo_image f g h) <= h
5429Proof
5430  rw_tac std_ss[Subgroup_def] >| [
5431    rw_tac std_ss[homo_image_group],
5432    rw[homo_image_def, SUBSET_DEF] >>
5433    metis_tac[GroupHomo_def],
5434    rw_tac std_ss[homo_image_def]
5435  ]
5436QED
5437
5438(* Theorem: Group g /\ Group h /\ SURJ f G h.carrier ==> GroupIso I h (homo_image f g h) *)
5439(* Proof:
5440   After expanding by GroupIso_def, GroupHomo_def, and homo_image_def, this is to show:
5441   (1) x IN h.carrier ==> x IN IMAGE f G
5442       Note x IN h.carrier ==> ?z. z IN G /\ f z = x    by SURJ_DEF
5443        and z IN G ==> f z = x IN IMAGE f G             by IN_IMAGE
5444   (2) x IN IMAGE f G ==> x IN h.carrier
5445       Note x IN IMAGE f G ==> ?z. z IN G /\ f z = x    by IN_IMAGE
5446        and z IN G ==> f z = x IN h.carrier             by SURJ_DEF
5447*)
5448Theorem group_homo_image_surj_property:
5449    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\
5450     SURJ f G h.carrier ==> GroupIso I h (homo_image f g h)
5451Proof
5452  rw_tac std_ss[BIJ_DEF, SURJ_DEF, INJ_DEF, GroupIso_def, GroupHomo_def, homo_image_def] >>
5453  metis_tac[IN_IMAGE]
5454QED
5455
5456(* Theorem: Monoid g /\ MonoidHomo f g h ==> Monoid (homo_image f g h) *)
5457(* Proof:
5458   Note MonoidHomo f g h
5459    ==> !x. x IN G ==> f x IN h.carrier                             by MonoidHomo_def
5460    and !x y. x IN G /\ y IN G ==> (f (x * y) = h.op (f x) (f y))   by MonoidHomo_def
5461    and f #e = h.id                                                 by MonoidHomo_def
5462   Also !x. x IN IMAGE f G ==> ?a. a IN G /\ (f a = x)              by IN_IMAGE
5463
5464   Expand by homo_image_def, Monoid_def, this is to show:
5465   (1) x IN IMAGE f G /\ y IN IMAGE f G ==> h.op x y IN IMAGE f G
5466       Note ?a. a IN G /\ (f a = x)             by x IN IMAGE f G
5467        and ?b. b IN G /\ (f b = y)             by y IN IMAGE f G
5468       also a * b IN G                          by monoid_op_element
5469        Now h.op x y = f (a * b)                by above
5470         so h.op x y IN IMAGE f G               by IN_IMAGE
5471   (2) x IN IMAGE f G /\ y IN IMAGE f G /\ z IN IMAGE f G ==> h.op (h.op x y) z = h.op x (h.op y z)
5472       Note ?a. a IN G /\ (f a = x)             by x IN IMAGE f G
5473        and ?b. b IN G /\ (f b = y)             by y IN IMAGE f G
5474        and ?c. c IN G /\ (f c = z)             by z IN IMAGE f G
5475        Now h.op (h.op x y) z = f ((a * b) * c) by a * b IN G, and above
5476        and h.op x (h.op y z) = f (a * (b * c)) by b * c IN G, and above
5477      Since a * b * c = a * (b * c)             by monoid_assoc
5478       thus h.op (h.op x y) z = h.op x (h.op y z)
5479   (3) h.id IN IMAGE f G
5480       Note h.id = f #e                         by above
5481        Now #e IN G                             by monoid_id_element
5482         so h.id IN IMAGE f G                   by IN_IMAGE
5483   (4) x IN IMAGE f G ==> h.op h.id x = x
5484       Note ?a. a IN G /\ (f a = x)             by x IN IMAGE f G
5485            h.op h.id x
5486          = f (#e * a)                          by monoid_id_element, and above
5487          = f a                                 by monoid_lid
5488          = x
5489   (5) x IN IMAGE f G ==> h.op x h.id = x
5490       Note ?a. a IN G /\ (f a = x)             by x IN IMAGE f G
5491            h.op x h.id
5492          = f (a * #e)                          by monoid_id_element, and above
5493          = f a                                 by monoid_rid
5494          = x
5495*)
5496Theorem monoid_homo_homo_image_monoid:
5497    !(g:'a monoid) (h:'b monoid) f. Monoid g /\ MonoidHomo f g h ==> Monoid (homo_image f g h)
5498Proof
5499  rw_tac std_ss[MonoidHomo_def] >>
5500  `!x. x IN IMAGE f G ==> ?a. a IN G /\ (f a = x)` by metis_tac[IN_IMAGE] >>
5501  rw_tac std_ss[homo_image_def, Monoid_def] >| [
5502    `?a. a IN G /\ (f a = x)` by rw_tac std_ss[] >>
5503    `?b. b IN G /\ (f b = y)` by rw_tac std_ss[] >>
5504    `a * b IN G` by rw[] >>
5505    `h.op x y = f (a * b)` by rw_tac std_ss[] >>
5506    metis_tac[IN_IMAGE],
5507    `?a. a IN G /\ (f a = x)` by rw_tac std_ss[] >>
5508    `?b. b IN G /\ (f b = y)` by rw_tac std_ss[] >>
5509    `?c. c IN G /\ (f c = z)` by rw_tac std_ss[] >>
5510    `h.op x y = f (a * b)` by rw_tac std_ss[] >>
5511    `h.op y z = f (b * c)` by rw_tac std_ss[] >>
5512    `a * b IN G /\ b * c IN G` by rw[] >>
5513    `h.op (h.op x y) z = f ((a * b) * c)` by metis_tac[] >>
5514    `h.op x (h.op y z) = f (a * (b * c))` by metis_tac[] >>
5515    `a * b * c = a * (b * c)` by rw[monoid_assoc] >>
5516    metis_tac[],
5517    metis_tac[monoid_id_element, IN_IMAGE],
5518    `?a. a IN G /\ (f a = x)` by rw_tac std_ss[] >>
5519    `h.op h.id x = f (#e * a)` by rw_tac std_ss[monoid_id_element] >>
5520    metis_tac[monoid_lid],
5521    `x IN h.carrier` by metis_tac[] >>
5522    `?a. a IN G /\ (f a = x)` by rw_tac std_ss[] >>
5523    `h.op x h.id = f (a * #e)` by rw_tac std_ss[monoid_id_element] >>
5524    metis_tac[monoid_rid]
5525  ]
5526QED
5527
5528(*
5529GroupHomo_def is weaker than MonoidHomo_def.
5530May need to define  GroupHomo = MonoidHomo, making f #e = h.id mandatory.
5531Better keep GroupHomo, just use MonoidHomo if necessary.
5532*)
5533
5534(* Theorem: Group g /\ MonoidHomo f g h ==> Group (homo_image f g h) *)
5535(* Proof:
5536   By Group_def, this is to show:
5537   (1) Monoid (homo_image f g h), true   by monoid_homo_homo_image_monoid
5538   (2) monoid_invertibles (homo_image f g h) = (homo_image f g h).carrier
5539       By monoid_invertibles_def, homo_image_def, this is to show:
5540       x IN IMAGE f G ==> ?y. y IN IMAGE f G /\ (h.op x y = h.id) /\ (h.op y x = h.id)
5541
5542       Note ?a. a IN G /\ (f a = x)      by x IN IMAGE f G
5543      Hence |/ a IN G                    by group_inv_element
5544        Let y = f ( |/ a).
5545       Then y IN IMAGE f G               by IN_IMAGE
5546            h.op y x
5547          = h.op (f ( |/ a)) (f a)
5548          = f ( |/a * a)                 by MonoidHomo_def
5549          = f #e                         by group_linv
5550          = h.id                         by MonoidHomo_def
5551            h.op x y
5552          = h.op (f a) (f ( |/ a))
5553          = f (a * |/a )                 by MonoidHomo_def
5554          = f #e                         by group_rinv
5555          = h.id                         by MonoidHomo_def
5556*)
5557Theorem group_homo_homo_image_group:
5558    !(g:'a group) (h:'b group) f. Group g /\ MonoidHomo f g h ==> Group (homo_image f g h)
5559Proof
5560  rpt strip_tac >>
5561  `Monoid (homo_image f g h)` by rw[monoid_homo_homo_image_monoid] >>
5562  rw_tac std_ss[Group_def, monoid_invertibles_def, homo_image_def, GSPECIFICATION, EXTENSION, EQ_IMP_THM] >>
5563  `?a. a IN G /\ (f a = x)` by metis_tac[IN_IMAGE] >>
5564  `|/ a IN G` by rw[] >>
5565  `( |/ a * a = #e) /\ (a * |/ a = #e)` by rw[] >>
5566  `f ( |/ a) IN IMAGE f G` by metis_tac[IN_IMAGE] >>
5567  metis_tac[MonoidHomo_def]
5568QED
5569
5570(* ------------------------------------------------------------------------- *)
5571(* First Isomorphic Theorem for Group.                                       *)
5572(* ------------------------------------------------------------------------- *)
5573
5574(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==>
5575            GroupHomo (\z. (CHOICE (preimage f G z)) * (kernel f g h) ) (homo_image f g h) (g / (kernel_group f g h)) *)
5576(* Proof: by GroupHomo_def, homo_image_def and quotient_group_def.
5577   This is to show:
5578   (1) !z. z IN IMAGE f G ==> CHOICE (preimage f G z) * kernel f g h IN CosetPartition g (kernel_group f g h)
5579   z IN IMAGE f G ==> CHOICE (preimage f G z) IN G   by preimage_choice_property
5580   Since (kernel_group f g h) <= g  by kernel_group_subgroup
5581   Hence CHOICE (preimage f G z) * kernel f g h IN CosetPartition g (kernel_group f g h) by coset_partition_element
5582   and
5583   (2) !z. z IN IMAGE f G /\ z' IN IMAGE f G ==>
5584   CHOICE (preimage f G (h.op z z')) * kernel f g h =
5585   coset_op g (kernel_group f g h) (CHOICE (preimage f G z) * kernel f g h) (CHOICE (preimage f G z') * kernel f g h)
5586   z IN IMAGE f G ==> CHOICE (preimage f G z) IN G   by preimage_choice_property
5587   z IN IMAGE f G ==> CHOICE (preimage f G z) IN G   by preimage_choice_property
5588   After expanding by coset_op_def, this is to show:
5589   CHOICE (preimage f G (h.op z z')) * kernel f g h =
5590   cogen g (kernel_group f g h) (CHOICE (preimage f G z) * kernel f g h) *
5591   cogen g (kernel_group f g h) (CHOICE (preimage f G z') * kernel f g h) * kernel f g h
5592   Now, (kernel_group f g h) << g    by kernel_group_normal
5593   Let x = CHOICE (preimage f G z
5594       x' = CHOICE (preimage f G z'
5595       y = CHOICE (preimage f G (h.op z z'))
5596       k = kernel_group f g h
5597       s = kernel f g h
5598   This is to show: y * s = cogen g k (x * s) * cogen g k (x' * s) * s
5599   This can be done via normal_coset_property, but first:
5600   x IN G /\ x' IN G /\ (f x = z) /\ (f x' = z')   by preimage_choice_property
5601   x * s IN CosetPartition g k    by coset_partition_element
5602   x' * s IN CosetPartition g k   by coset_partition_element
5603   Hence
5604   cogen g k (x * s) * cogen g k (x' * s) * s = x * x' * s  by normal_coset_property
5605   It remains to show: y * s = x * x' * s
5606   i.e. to show: y / (x * x') IN s   since k << g  if we know y IN G and x * x' IN G
5607   But h.op z z' = f (x * x')    by GroupHomo_def
5608   Hence x * x' IN G /\ f (x * x') IN IMAGE f G   by group_op_element, IN_IMAGE
5609   and f y = h.op z z' = f (x * x') by preimage_choice_property
5610   Hence we just need to show: y / (x * x') IN s  where s = kernel f g h
5611   An element is in kernel if it maps to h.id, so compute:
5612     f (y / (x * x'))
5613   = f (y * |/ (x * x'))          by group_div_def
5614   = h.op (f y) f ( |/ (x * x'))   by GroupHomo_def
5615   = h.op (f y) h.inv f (x * x')  by group_homo_inv
5616   = h.op (f y) h.inv (f y)       by above
5617   = h.id                         by group_rinv
5618*)
5619Theorem homo_image_homo_quotient_kernel:
5620    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\ GroupHomo f g h ==>
5621            GroupHomo (\z. (CHOICE (preimage f G z)) * (kernel f g h) )
5622                     (homo_image f g h) (g / (kernel_group f g h))
5623Proof
5624  rw_tac std_ss[homo_image_def, quotient_group_def] >>
5625  `(kernel_group f g h).carrier = kernel f g h` by rw_tac std_ss[kernel_group_def] >>
5626  rw_tac std_ss[GroupHomo_def] >| [
5627    metis_tac[preimage_choice_property, kernel_group_subgroup, coset_partition_element],
5628    rw_tac std_ss[coset_op_def] >>
5629    `(kernel_group f g h) << g /\ (kernel_group f g h) <= g` by rw_tac std_ss[kernel_group_normal, normal_subgroup_subgroup] >>
5630    qabbrev_tac `x = CHOICE (preimage f G z)` >>
5631    qabbrev_tac `x' = CHOICE (preimage f G z')` >>
5632    qabbrev_tac `y = CHOICE (preimage f G (h.op z z'))` >>
5633    qabbrev_tac `k = kernel_group f g h` >>
5634    qabbrev_tac `s = kernel f g h` >>
5635    `x IN G /\ x' IN G /\ (f x = z) /\ (f x' = z')` by rw_tac std_ss[preimage_choice_property, Abbr`x`, Abbr`x'`] >>
5636    `x * s IN CosetPartition g k /\ x' * s IN CosetPartition g k` by metis_tac[coset_partition_element] >>
5637    `cogen g k (x * s) * cogen g k (x' * s) * s = x * x' * s` by rw_tac std_ss[normal_coset_property] >>
5638    full_simp_tac std_ss [] >>
5639    `h.op z z' = f (x * x')` by metis_tac[GroupHomo_def] >>
5640    `x * x' IN G /\ f (x * x') IN IMAGE f G` by rw[] >>
5641    `y IN G /\ (f y = h.op z z')` by metis_tac[preimage_choice_property] >>
5642    `y / (x * x') IN s` suffices_by rw_tac std_ss[normal_subgroup_coset_eq] >>
5643    `|/ (x * x') IN G` by rw[] >>
5644    `f y IN h.carrier` by metis_tac[GroupHomo_def] >>
5645    `f (y / (x * x')) = f (y * |/ (x * x'))` by rw_tac std_ss[group_div_def] >>
5646    `_ = h.op (f y) (f ( |/ (x * x')))` by metis_tac[GroupHomo_def] >>
5647    `_ = h.op (f y) (h.inv (h.op z z'))` by metis_tac[group_homo_inv] >>
5648    `_ = h.id` by metis_tac[group_rinv] >>
5649    metis_tac[kernel_property, group_div_element]
5650  ]
5651QED
5652
5653(* Theorem:  BIJ (\z. CHOICE (preimage f G z) * kernel f g h)
5654             (homo_image f g h).carrier (g / kernel_group f g h).carrier *)
5655(* Proof:
5656   This is to prove:
5657   (1) z IN IMAGE f G ==> CHOICE (preimage f G z) * kernel f g h IN CosetPartition g (kernel_group f g h)
5658   z IN IMAGE f G ==> CHOICE (preimage f G z) IN G   by preimage_choice_property
5659   Since (kernel_group f g h) <= g  by kernel_group_subgroup
5660   Hence CHOICE (preimage f G z) * kernel f g h IN CosetPartition g (kernel_group f g h) by coset_partition_element
5661   (2) z IN IMAGE f G /\ z' IN IMAGE f G /\ CHOICE (preimage f G z) * kernel f g h = CHOICE (preimage f G z') * kernel f g h ==> z = z'
5662   Let x = CHOICE (preimage f G z)
5663       x' = CHOICE (preimage f G z'), then
5664   z IN IMAGE f G ==> x IN G /\ f x = z  by preimage_choice_property
5665   z' IN IMAGE f G ==> x' IN G /\ f x' = z'  by preimage_choice_property
5666   x IN G ==> z = f x IN H, x' IN G ==> z' = f x' IN H   by GroupHomo_def
5667   Given  x * kernel f g h = x' * kernel f g h
5668   Since (kernel_group f g h) << g      by kernel_group_normal
5669   this gives  x / x' IN kernel f g h   by normal_subgroup_coset_eq
5670   Hence    f (x / x') = h.id           by kernel_property
5671   i.e. h.id = f (x / x')
5672             = f (x * |/ x')            by group_div_def
5673             = h.op (f x) (f ( |/ x'))   by GroupHomo_def
5674             = h.op (f x) h.inv (f x')  by group_homo_inv
5675             = h.op z h.inv z'          by above
5676   Hence z = z'  by group_linv_unique, group_inv_inv
5677   (3) same as (1).
5678   (4) x IN CosetPartition g (kernel_group f g h) ==> ?z. z IN IMAGE f G /\ (CHOICE (preimage f G z) * kernel f g h = x)
5679   Note (kernel_group f g h) << g          by kernel_group_normal
5680   and (kernel_group f g h) <= g           by normal_subgroup_subgroup
5681   Since x IN CosetPartition g (kernel_group f g h),
5682   ?a. a IN G /\ (x = a * kernel f g h)    by coset_partition_element
5683   Let z = f a, then z IN IMAGE f G    by IN_IMAGE,
5684   and CHOICE (preimage f G z) IN G /\ (f (CHOICE (preimage f G z)) = z)  by preimage_choice_property
5685   Thus, this is to prove:
5686   CHOICE (preimage f G z) * kernel f g h = x = a * kernel f g h
5687   Since kernel f g h << g, this is true if  CHOICE (preimage f G z) / a IN kernel f g h
5688   or need to show: f (CHOICE (preimage f G z) / a) = h.id  by normal_subgroup_coset_eq
5689   By computation,
5690     f (CHOICE (preimage f G z) / a)
5691   = f (CHOICE (preimage f G z) * |/ a)             by group_div_def
5692   = h.op (f (CHOICE (preimage f G z)) (f ( |/ a))   by GroupHomo_def
5693   = h.op z (h.inv z)                               by group_homo_inv
5694   = h.id                                           by group_linv
5695*)
5696Theorem homo_image_to_quotient_kernel_bij:
5697    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\ GroupHomo f g h ==>
5698            BIJ (\z. (CHOICE (preimage f G z)) * (kernel f g h) )
5699                     (homo_image f g h).carrier (g / (kernel_group f g h)).carrier
5700Proof
5701  rw_tac std_ss[homo_image_def, quotient_group_def] >>
5702  `(kernel_group f g h).carrier = kernel f g h` by rw_tac std_ss[kernel_group_def] >>
5703  rw_tac std_ss[BIJ_DEF, SURJ_DEF, INJ_DEF] >| [
5704    metis_tac[preimage_choice_property, kernel_group_subgroup, coset_partition_element],
5705    `CHOICE (preimage f G z) IN G /\ (f (CHOICE (preimage f G z)) = z)` by rw_tac std_ss[preimage_choice_property] >>
5706    `CHOICE (preimage f G z') IN G /\ (f (CHOICE (preimage f G z')) = z')` by rw_tac std_ss[preimage_choice_property] >>
5707    `(kernel_group f g h) << g` by rw_tac std_ss[kernel_group_normal] >>
5708    qabbrev_tac `x = CHOICE (preimage f G z)` >>
5709    qabbrev_tac `x' = CHOICE (preimage f G z')` >>
5710    qabbrev_tac `k = kernel_group f g h` >>
5711    qabbrev_tac `s = kernel f g h` >>
5712    `|/ x' IN G` by rw[] >>
5713    `f ( |/ x') = h.inv z'` by rw_tac std_ss[group_homo_inv] >>
5714    `z IN h.carrier /\ z' IN h.carrier /\ h.inv z' IN h.carrier` by metis_tac[GroupHomo_def] >>
5715    `x / x' IN s` by metis_tac[normal_subgroup_coset_eq] >>
5716    `h.id = f (x / x')` by metis_tac[kernel_property] >>
5717    `_ = f (x * |/ x')` by rw_tac std_ss[group_div_def] >>
5718    `_ = h.op (f x) (h.inv (f x'))` by metis_tac[GroupHomo_def] >>
5719    metis_tac[group_linv_unique, group_inv_inv],
5720    metis_tac[preimage_choice_property, kernel_group_subgroup, coset_partition_element],
5721    `(kernel_group f g h) << g /\ (kernel_group f g h) <= g` by rw_tac std_ss[kernel_group_normal, normal_subgroup_subgroup] >>
5722    `?a. a IN G /\ (x = a * kernel f g h)` by metis_tac[coset_partition_element] >>
5723    qexists_tac `f a` >>
5724    rw[] >>
5725    qabbrev_tac `z = f a` >>
5726    qabbrev_tac `x = CHOICE (preimage f G z)` >>
5727    qabbrev_tac `k = kernel_group f g h` >>
5728    qabbrev_tac `s = kernel f g h` >>
5729    `x IN G /\ (f x = z) /\ z IN h.carrier` by metis_tac[preimage_choice_property, IN_IMAGE, GroupHomo_def] >>
5730    `x / a IN s` suffices_by metis_tac[normal_subgroup_coset_eq] >>
5731    `|/a IN G` by rw[] >>
5732    `f (x * |/ a) = h.op (f x) (f ( |/ a))` by metis_tac[GroupHomo_def] >>
5733    `_ = h.op z (h.inv z)` by metis_tac[group_homo_inv] >>
5734    `_ = h.id` by metis_tac[group_rinv] >>
5735    metis_tac[kernel_property, group_div_def, group_div_element]
5736  ]
5737QED
5738
5739(* Theorem: Group g /\ Group h /\ GroupHomo f g h ==>
5740            GroupIso (\z. (CHOICE (preimage f G z)) * (kernel f g h) ) (homo_image f g h) (g / (kernel_group f g h)) *)
5741(* Proof: by GroupIso_def.
5742   (1) GroupHomo (\z. CHOICE (preimage f G z) * kernel f g h) (homo_image f g h) (g / kernel_group f g h)
5743   True by homo_image_homo_quotient_kernel.
5744   (2) BIJ (\z. CHOICE (preimage f G z) * kernel f g h) (homo_image f g h).carrier (g / kernel_group f g h).carrier
5745   True by homo_image_to_quotient_kernel_bij.
5746*)
5747Theorem homo_image_iso_quotient_kernel:
5748    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\ GroupHomo f g h ==>
5749            GroupIso (\z. (CHOICE (preimage f G z)) * (kernel f g h) )
5750                     (homo_image f g h) (g / (kernel_group f g h))
5751Proof
5752  rw[GroupIso_def, homo_image_homo_quotient_kernel, homo_image_to_quotient_kernel_bij]
5753QED
5754
5755(* Theorem [First Isomorphism Theorem for Groups]
5756   Let G and H be groups, and let f: G -> H be a homomorphism. Then:
5757   (a) The kernel of f is a normal subgroup of G,
5758   (b) The image of f is a subgroup of H, and
5759   (c) The image of f is isomorphic to the quotient group G / ker(f).
5760   In particular, (d) if f is surjective then H is isomorphic to G / ker(f).
5761*)
5762(* Proof:
5763   (a) by kernel_group_normal
5764   (b) by homo_image_subgroup
5765   (c) by homo_image_iso_quotient_kernel
5766   (d) by group_homo_image_surj_property
5767*)
5768Theorem group_first_isomorphism_thm:
5769    !(g:'a group) (h:'b group). !f. Group g /\ Group h /\ GroupHomo f g h ==>
5770      (kernel_group f g h) << g /\
5771      (homo_image f g h) <= h /\
5772      GroupIso (\z. (CHOICE (preimage f G z)) * (kernel f g h) )
5773                    (homo_image f g h) (g / (kernel_group f g h)) /\
5774      (SURJ f G h.carrier ==> GroupIso I h (homo_image f g h))
5775Proof
5776  rw[kernel_group_normal, homo_image_subgroup, homo_image_iso_quotient_kernel, group_homo_image_surj_property]
5777QED
5778
5779(* ------------------------------------------------------------------------- *)
5780(* Iterated Product Documentation                                            *)
5781(* ------------------------------------------------------------------------- *)
5782(* Overloading (# is temporary):
5783   FUN_COMM op f  = !x y z. op (f x) (op (f y) z) = op (f y) (op (f x) z)
5784#  GPI f s        = GROUP_IMAGE g f s
5785#  gfun f         = group_fun g f
5786*)
5787(* Definitions and Theorems (# are exported):
5788
5789   Fermat's Little Theorem of Abelian Groups:
5790   GPROD_SET_IMAGE            |- !g a. Group g /\ a IN G ==> (GPROD_SET g (a * G) = GPROD_SET g G)
5791   GPROD_SET_REDUCTION_INSERT |- !g s. FiniteAbelianGroup g /\ s SUBSET G ==>
5792                                 !a x::(G). x NOTIN s ==>
5793                          (a * x * GPROD_SET g (a * (G DIFF (x INSERT s))) = GPROD_SET g (a * (G DIFF s)))
5794   GPROD_SET_REDUCTION        |- !g s. FiniteAbelianGroup g /\ s SUBSET G ==>
5795                       !a::(G). a ** CARD s * GPROD_SET g s * GPROD_SET g (a * (G DIFF s)) = GPROD_SET g G
5796
5797   Group Factorial:
5798   GFACT_def              |- !g. GFACT g = GPROD_SET g G
5799   GFACT_element          |- !g. FiniteAbelianMonoid g ==> GFACT g IN G
5800   GFACT_identity         |- !g a. FiniteAbelianGroup g /\ a IN G ==> (GFACT g = a ** CARD G * GFACT g)
5801   finite_abelian_Fermat  |- !g a. FiniteAbelianGroup g /\ a IN G ==> (a ** CARD G = #e)
5802
5803   Group Iterated Product over a function:
5804   OP_IMAGE_DEF    |- !op id f s. OP_IMAGE op id f s = ITSET (\e acc. op (f e) acc) s id
5805   OP_IMAGE_EMPTY  |- !op id f. OP_IMAGE op id f {} = id
5806   OP_IMAGE_SING   |- !op id f x. OP_IMAGE op id f {x} = op (f x) id
5807   OP_IMAGE_THM    |- !op id f. (OP_IMAGE op id f {} = id) /\
5808                                (FUN_COMM op f ==> !s. FINITE s ==>
5809                      !e. OP_IMAGE op id f (e INSERT s) = op (f e) (OP_IMAGE op id f (s DELETE e)))
5810
5811   GROUP_IMAGE_DEF          |- !g f s. GPI f s = ITSET (\e acc. f e * acc) s #e
5812   group_image_as_op_image  |- !g. GPI = OP_IMAGE $* #e
5813   sum_image_as_op_image    |- SIGMA = OP_IMAGE (\x y. x + y) 0
5814   prod_image_as_op_image   |- PI = OP_IMAGE (\x y. x * y) 1
5815   GITSET_AS_ITSET          |- !g. (\s b. GITSET g s b) = ITSET (\e acc. e * acc)
5816   GPROD_SET_AS_GROUP_IMAGE |- !g. GPROD_SET g = GPI I
5817   group_image_empty        |- !g f. GPI f {} = #e
5818   group_fun_def            |- !g f. gfun f <=> !x. x IN G ==> f x IN G
5819   group_image_sing         |- !g. Monoid g ==> !f. gfun f ==> !x. x IN G ==> (GPI f {x} = f x)
5820
5821*)
5822
5823
5824(* ------------------------------------------------------------------------- *)
5825(* Fermat's Little Theorem of Abelian Groups.                                *)
5826(* ------------------------------------------------------------------------- *)
5827
5828(* Theorem: For Group g, a IN G ==> GPROD_SET g a * G = GPROD_SET g G *)
5829(* Proof:
5830   This is trivial by group_coset_eq_itself.
5831*)
5832Theorem GPROD_SET_IMAGE:
5833    !g a. Group g /\ a IN G ==> (GPROD_SET g (a * G) = GPROD_SET g G)
5834Proof
5835  rw[group_coset_eq_itself]
5836QED
5837
5838(* ------------------------------------------------------------------------- *)
5839(* An Invariant Property when reducing GPROD_SET g (IMAGE (\z. a*z) G):
5840     GPROD_SET g (IMAGE (\z. a*z) G)
5841   = (a*z) * GPROD_SET g ((IMAGE (\z. a*z) G) DELETE (a*z))
5842   = a * (GPROD_SET g (z INSERT {})) * GPROD_SET g (IMAGE (\z. a*z) (G DELETE z))
5843   = a * <building up a GPROD_SET> * <reducing down a GPROD_SET>
5844   = a*a * <building one more> * <reducing one more>
5845   = a*a*a * <building one more> * <reducing one more>
5846   = a**(CARD G) * GPROD_SET g G * GPROD_SET g {}
5847   = a**(CARD G) * GPROD_SET g G * #e
5848   = a**(CARD G) * GPROD_SET g G
5849*)
5850(* ------------------------------------------------------------------------- *)
5851
5852(* Theorem: [INSERT for GPROD_SET_REDUCTION]
5853            (a*x)* GPROD_SET g (coset g (G DIFF (x INSERT t)))
5854            = GPROD_SET g (coset g (G DIFF t)) *)
5855(* Proof:
5856   Essentially this is to prove:
5857   a * x * GPROD_SET g {a * z | z | z IN G /\ z <> x /\ z NOTIN s} =
5858           GPROD_SET g {a * z | z | z IN G /\ z NOTIN s}
5859   Let q = {a * z | z | z IN G /\ z <> x /\ z NOTIN s}
5860       p = {a * z | z | z IN G /\ z NOTIN s}
5861   Since p = (a*x) INSERT q   by EXTENSION,
5862     and (a*x) NOTIN q        by group_lcancel, a NOTIN s.
5863     and (a*x) IN G           by group_op_element
5864   RHS = GPROD_SET g p
5865       = GPROD_SET g ((a*x) INSERT q)            by p = (a*x) INSERT q
5866       = (a*x) * GPROD_SET g (q DELETE (a*x))    by GPROD_SET_THM
5867       = (a*x) * GPROD_SET g q                   by DELETE_NON_ELEMENT, (a*x) NOTIN q.
5868       = LHS
5869*)
5870Theorem GPROD_SET_REDUCTION_INSERT:
5871    !g s. FiniteAbelianGroup g /\ s SUBSET G ==>
5872   !a x::(G). x NOTIN s ==>
5873   (a * x * GPROD_SET g (a * (G DIFF (x INSERT s))) = GPROD_SET g (a * (G DIFF s)))
5874Proof
5875  rw[coset_def, IMAGE_DEF, EXTENSION, RES_FORALL_THM] >>
5876  qabbrev_tac `p = {a * z | z | z IN G /\ z NOTIN s}` >>
5877  qabbrev_tac `q = {a * z | z | z IN G /\ z <> x /\ z NOTIN s}` >>
5878  (`p = (a * x) INSERT q` by (rw[EXTENSION, EQ_IMP_THM, Abbr`p`, Abbr`q`] >> metis_tac[])) >>
5879  `AbelianGroup g /\ Group g /\ FINITE G` by metis_tac[FiniteAbelianGroup_def, AbelianGroup_def] >>
5880  `!z. z IN G /\ (a * z = a * x) <=> (z = x)` by metis_tac[group_lcancel] >>
5881  (`(a * x) NOTIN q` by (rw[Abbr`q`] >> metis_tac[])) >>
5882  (`q SUBSET G` by (rw[EXTENSION, SUBSET_DEF, Abbr`q`] >> rw[])) >>
5883  `a * x IN G` by rw[] >>
5884  `AbelianMonoid g` by rw[abelian_group_is_abelian_monoid] >>
5885  `FINITE q` by metis_tac[SUBSET_FINITE] >>
5886  metis_tac[GPROD_SET_THM, DELETE_NON_ELEMENT]
5887QED
5888
5889(* Theorem: (a ** n) * <building n-steps GPROD_SET> * <reducing n-steps GPROD_SET> = GPROD_SET g G *)
5890(* Proof:
5891   By complete induction on CARD s.
5892   Case s = {},
5893     LHS = a ** (CARD s) * (GPROD_SET g s) * GPROD_SET g (a * (G DIFF s))
5894         = a ** 0 * (GPROD_SET g {}) * GPROD_SET g (a * (G DIFF {}))        by CARD_EMPTY
5895         = #e * #e * GPROD_SET g (a * G)      by group_exp_0, DIFF_EMPTY, GPROD_SET_EMPTY.
5896         = GPROD_SET g (a * G)                by group_lid
5897         = GPROD_SET g G                      by GPROD_SET_IMAGE
5898         = RHS
5899   Case s <> {},
5900     Let x = CHOICE s, t = REST s, so s = x INSERT t, x NOTIN t.
5901     LHS = a ** (CARD s) * (GPROD_SET g s) * GPROD_SET g (a * (G DIFF s))
5902         = a ** SUC(CARD t) *
5903           (GPROD_SET g (x INSERT t)) *
5904           GPROD_SET g (a * (G DIFF (x INSERT t)))   by CARD s = SUC(CARD t), s = x INSERT t.
5905         = a ** SUC(CARD t) *
5906           (x * GPROD_SET g (t DELETE x)) *
5907           GPROD_SET g (a * (G DIFF (x INSERT t)))   by GPROD_SET_THM
5908         = a ** SUC(CARD t) *
5909           (x * GPROD_SET g t) *
5910           GPROD_SET g (a * (G DIFF (x INSERT t)))   by DELETE_NON_ELEMENT, x NOTIN t.
5911         = a*a ** (CARD t) *
5912           x * GPROD_SET g t *
5913           GPROD_SET g (a * (G DIFF (x INSERT t)))   by group_exp_SUC
5914         = a ** (CARD t) *
5915           GPROD_SET g t *
5916           (a * x) * GPROD_SET g (a * (G DIFF (x INSERT t)))  by Abelian group commuting
5917         = a ** (CARD t) *
5918           GPROD_SET g t *
5919           GPROD_SET g (a * (G DIFF t))   by GPROD_SET_REDUCTION_INSERT
5920         = RHS                            by induction
5921*)
5922Theorem GPROD_SET_REDUCTION:
5923    !g s. FiniteAbelianGroup g /\ s SUBSET G ==>
5924   !a::(G). a ** (CARD s) * (GPROD_SET g s) * GPROD_SET g (a * (G DIFF s)) = GPROD_SET g G
5925Proof
5926  completeInduct_on `CARD s` >>
5927  pop_assum (assume_tac o SIMP_RULE bool_ss[GSYM RIGHT_FORALL_IMP_THM, AND_IMP_INTRO]) >>
5928  rw[RES_FORALL_THM] >>
5929  `AbelianGroup g /\ Group g /\ FINITE G` by metis_tac[FiniteAbelianGroup_def, AbelianGroup_def, FiniteGroup_def] >>
5930  `AbelianMonoid g` by rw[abelian_group_is_abelian_monoid] >>
5931  Cases_on `s = {}` >| [
5932    rw[GPROD_SET_EMPTY] >>
5933    `GPROD_SET g G IN G` by rw[GPROD_SET_PROPERTY] >>
5934    rw[GPROD_SET_IMAGE],
5935    `?x t. (x = CHOICE s) /\ (t = REST s) /\ (s = x INSERT t)` by rw[CHOICE_INSERT_REST] >>
5936    `x IN G` by metis_tac[CHOICE_DEF, SUBSET_DEF] >>
5937    `t SUBSET G /\ FINITE t` by metis_tac[REST_SUBSET, SUBSET_TRANS, SUBSET_FINITE] >>
5938    `x NOTIN t` by metis_tac[CHOICE_NOT_IN_REST] >>
5939    `(CARD s = SUC(CARD t)) /\ CARD t < CARD s` by rw[CARD_INSERT] >>
5940    `GPROD_SET g t IN G` by rw[GPROD_SET_PROPERTY] >>
5941    `GPROD_SET g (a * (G DIFF (x INSERT t))) IN G` by metis_tac[coset_property, DIFF_SUBSET, SUBSET_FINITE, GPROD_SET_PROPERTY] >>
5942    qabbrev_tac `t' = a * (G DIFF (x INSERT t))` >>
5943    `a ** CARD s * GPROD_SET g s * GPROD_SET g (a * (G DIFF s)) =
5944    a ** SUC(CARD t) * GPROD_SET g (x INSERT t) * GPROD_SET g t'` by rw[Abbr`t'`] >>
5945    `_ = a ** SUC(CARD t) * (x * GPROD_SET g (t DELETE x)) * GPROD_SET g t'` by rw[GPROD_SET_THM] >>
5946    `_ = a ** SUC(CARD t) * (x * GPROD_SET g t) * GPROD_SET g t'` by metis_tac[DELETE_NON_ELEMENT] >>
5947    `_ = (a * a ** (CARD t)) * (x * GPROD_SET g t) * GPROD_SET g t'` by rw[group_exp_SUC] >>
5948    `_ = (a ** (CARD t) * a) * (x * GPROD_SET g t) * GPROD_SET g t'` by metis_tac[AbelianGroup_def, group_exp_element] >>
5949    `_ = a ** (CARD t) * (a * (x * GPROD_SET g t)) * GPROD_SET g t'` by rw[group_assoc] >>
5950    `_ = a ** (CARD t) * ((a * x) * GPROD_SET g t) * GPROD_SET g t'` by rw[group_assoc] >>
5951    `_ = a ** (CARD t) * (GPROD_SET g t * (a * x)) * GPROD_SET g t'` by metis_tac[AbelianGroup_def, group_op_element] >>
5952    `_ = (a ** (CARD t) * GPROD_SET g t) * (a * x) * GPROD_SET g t'` by rw[group_assoc] >>
5953    `_ = a ** (CARD t) * GPROD_SET g t * ((a * x) * GPROD_SET g t')` by rw[group_assoc] >>
5954    `_ = a ** (CARD t) * GPROD_SET g t * GPROD_SET g (a * (G DIFF t))` by metis_tac[GPROD_SET_REDUCTION_INSERT] >>
5955    rw[]
5956  ]
5957QED
5958
5959(* Define Group Factorial *)
5960Definition GFACT_def:
5961  GFACT g = GPROD_SET g G
5962End
5963
5964(* Theorem: GFACT g is an element in Group g. *)
5965(* Proof:
5966   Since G SUBSET G     by SUBSET_REFL
5967   This is true by GPROD_SET_PROPERTY:
5968   !g s. FiniteAbelianMonoid g /\ s SUBSET G ==> GPROD_SET g s IN G : thm
5969*)
5970Theorem GFACT_element:
5971    !g. FiniteAbelianMonoid g ==> GFACT g IN G
5972Proof
5973  rw_tac std_ss[FiniteAbelianMonoid_def, GFACT_def, GPROD_SET_PROPERTY, SUBSET_REFL]
5974QED
5975
5976(* Theorem: For FiniteAbelian Group g, a IN G ==> GFACT g = a ** (CARD g) * GFACT g *)
5977(* Proof:
5978   Since G SUBSET G  by SUBSET_REFL,
5979   and G DIFF G = {},
5980   Put s = G in GPROD_SET_REDUCTION:
5981       a ** (CARD G) * GPROD_SET g G * GPROD_SET g (a * (G DIFF G)) = GPROD_SET g G
5982   ==> a ** (CARD G) * GPROD_SET g G * GPROD_SET g (a * {}) = GPROD_SET g G
5983   ==> a ** (CARD G) * GPROD_SET g G * GPROD_SET g {} = GPROD_SET g G  by coset_empty.
5984   ==> a ** (CARD G) * GPROD_SET g G * #e = GPROD_SET g G              by GPROD_SET_EMPTY.
5985   ==> a ** (CARD G) * GPROD_SET g G = GPROD_SET g G                   by group_assoc and group_rid
5986*)
5987Theorem GFACT_identity:
5988    !(g:'a group) a. FiniteAbelianGroup g /\ a IN G ==> (GFACT g = a ** (CARD G) * GFACT g)
5989Proof
5990  rw[GFACT_def] >>
5991  `G SUBSET G` by rw[] >>
5992  `G DIFF G = {}` by rw[] >>
5993  `AbelianGroup g /\ Group g /\ FINITE G` by metis_tac[FiniteAbelianGroup_def, AbelianGroup_def, FiniteGroup_def] >>
5994  `AbelianMonoid g` by rw[abelian_group_is_abelian_monoid] >>
5995  `GPROD_SET g G IN G` by rw[GPROD_SET_PROPERTY] >>
5996  `GPROD_SET g G = a ** (CARD G) * GPROD_SET g G * GPROD_SET g (a * (G DIFF G))` by rw[GPROD_SET_REDUCTION] >>
5997  `_ = a ** (CARD G) * GPROD_SET g G * GPROD_SET g (a * {})` by rw[] >>
5998  `_ = a ** (CARD G) * GPROD_SET g G * GPROD_SET g {}` by rw[coset_empty] >>
5999  `_ = a ** (CARD G) * GPROD_SET g G * #e` by metis_tac[GPROD_SET_EMPTY] >>
6000  `_ = a ** (CARD G) * GPROD_SET g G` by rw[] >>
6001  rw[]
6002QED
6003
6004(* Theorem: For FiniteAbelian Group g, a IN G ==> a ** (CARD g) = #e *)
6005(* Proof:
6006   Since  a ** (CARD G) * GFACT g = GFACT g    by GFACT_identity
6007   Hence  a ** (CARD G) = #e                   by group_lid_unique
6008*)
6009Theorem finite_abelian_Fermat:
6010    !(g:'a group) a. FiniteAbelianGroup g /\ a IN G ==> (a ** (CARD G) = #e)
6011Proof
6012  rpt strip_tac >>
6013  `AbelianGroup g /\ Group g /\ FINITE G` by metis_tac[FiniteAbelianGroup_def, AbelianGroup_def, FiniteGroup_def] >>
6014  `AbelianMonoid g` by rw[abelian_group_is_abelian_monoid] >>
6015  `GFACT g IN G` by rw[GFACT_element] >>
6016  `a ** (CARD G) * GFACT g = GFACT g` by rw[GFACT_identity] >>
6017  metis_tac[group_exp_element, group_lid_unique]
6018QED
6019
6020
6021(* ------------------------------------------------------------------------- *)
6022(* Group Iterated Product over a function.                                   *)
6023(* ------------------------------------------------------------------------- *)
6024
6025(*
6026> show_types := true; ITSET_def; show_types := false;
6027val it = |- !(s :'a -> bool) (f :'a -> 'b -> 'b) (b :'b).
6028    ITSET f s b = if FINITE s then if s = ({} :'a -> bool) then b
6029                                   else ITSET f (REST s) (f (CHOICE s) b)
6030                  else (ARB :'b): thm
6031
6032> show_types := true; SUM_IMAGE_DEF; show_types := false;
6033val it = |- !(f :'a -> num) (s :'a -> bool).
6034    SIGMA f s = ITSET (\(e :'a) (acc :num). f e + acc) s (0 :num): thm
6035
6036> ITSET_def |> ISPEC ``s:'b -> bool`` |> ISPEC ``(f:'b -> 'a)`` |> ISPEC ``b:'a``;
6037val it = |- GITSET g s b = if FINITE s then if s = {} then b else GITSET g (REST s) (CHOICE s * b)
6038                           else ARB: thm
6039*)
6040
6041(* A general iterator for operation (op:'a -> 'a -> 'a) and (id:'a) *)
6042Definition OP_IMAGE_DEF:
6043    OP_IMAGE (op:'a -> 'a -> 'a) (id:'a) (f:'b -> 'a) (s:'b -> bool) = ITSET (\e acc. op (f e) acc) s id
6044End
6045
6046(* Theorem: OP_IMAGE op id f {} = id *)
6047(* Proof:
6048     OP_IMAGE op id f {}
6049   = ITSET (\e acc. op (f e) acc) {} id    by OP_IMAGE_DEF
6050   = id                                    by ITSET_EMPTY
6051*)
6052Theorem OP_IMAGE_EMPTY:
6053    !op id f. OP_IMAGE op id f {} = id
6054Proof
6055  rw[OP_IMAGE_DEF, ITSET_EMPTY]
6056QED
6057
6058(* Theorem: OP_IMAGE op id f {x} = op (f x) id *)
6059(* Proof:
6060     OP_IMAGE op id f {x}
6061   = ITSET (\e acc. op (f e) acc) {x} id    by OP_IMAGE_DEF
6062   = (\e acc. op (f e) acc) x id            by ITSET_SING
6063   = op (f x) id                            by application
6064*)
6065Theorem OP_IMAGE_SING:
6066    !op id f x. OP_IMAGE op id f {x} = op (f x) id
6067Proof
6068  rw[OP_IMAGE_DEF, ITSET_SING]
6069QED
6070
6071(*
6072Now the hard part: show (\e acc. op (f e) acc) is an accumulative function for ITSET.
6073
6074val SUM_IMAGE_THM = store_thm(
6075  "SUM_IMAGE_THM",
6076  ``!f. (SUM_IMAGE f {} = 0) /\
6077        (!e s. FINITE s ==>
6078               (SUM_IMAGE f (e INSERT s) =
6079                f e + SUM_IMAGE f (s DELETE e)))``,
6080  REPEAT STRIP_TAC THENL [
6081    SIMP_TAC (srw_ss()) [ITSET_THM, SUM_IMAGE_DEF],
6082    SIMP_TAC (srw_ss()) [SUM_IMAGE_DEF] THEN
6083    Q.ABBREV_TAC `g = \e acc. f e + acc` THEN
6084    Q_TAC SUFF_TAC `ITSET g (e INSERT s) 0 =
6085                    g e (ITSET g (s DELETE e) 0)` THEN1
6086       SRW_TAC [][Abbr`g`] THEN
6087    MATCH_MP_TAC COMMUTING_ITSET_RECURSES THEN
6088    SRW_TAC [ARITH_ss][Abbr`g`]
6089  ]);
6090
6091val PROD_IMAGE_THM = store_thm(
6092  "PROD_IMAGE_THM",
6093  ``!f. (PROD_IMAGE f {} = 1) /\
6094        (!e s. FINITE s ==>
6095          (PROD_IMAGE f (e INSERT s) = f e * PROD_IMAGE f (s DELETE e)))``,
6096  REPEAT STRIP_TAC THEN1
6097    SIMP_TAC (srw_ss()) [ITSET_THM, PROD_IMAGE_DEF] THEN
6098  SIMP_TAC (srw_ss()) [PROD_IMAGE_DEF] THEN
6099  Q.ABBREV_TAC `g = \e acc. f e * acc` THEN
6100  Q_TAC SUFF_TAC `ITSET g (e INSERT s) 1 =
6101                  g e (ITSET g (s DELETE e) 1)` THEN1 SRW_TAC [][Abbr`g`] THEN
6102  MATCH_MP_TAC COMMUTING_ITSET_RECURSES THEN
6103  SRW_TAC [ARITH_ss][Abbr`g`]);
6104
6105*)
6106
6107(* Overload a communtative operation *)
6108Overload FUN_COMM = ``\op f. !x y z. op (f x) (op (f y) z) = op (f y) (op (f x) z)``
6109
6110(* Theorem: (OP_IMAGE op id f {} = id)  /\
6111            (FUN_COMM op f ==> !s. FINITE s ==>
6112             !e. OP_IMAGE op id f (e INSERT s) = op (f e) (OP_IMAGE op id f (s DELETE e))) *)
6113(* Proof:
6114   First goal: P_IMAGE op id f {} = id
6115      True by OP_IMAGE_EMPTY.
6116   Second goal: OP_IMAGE op id f (e INSERT s) = op (f e) (OP_IMAGE op id f (s DELETE e)))
6117      Let g = \e acc. op (f e) acc,
6118      Then by OP_IMAGE_DEF, the goal is:
6119      to show: ITSET g (e INSERT s) id = op (f e) (ITSET g (s DELETE e) id)
6120      or show: ITSET g (e INSERT s) id = g e (ITSET g (s DELETE e) id)
6121      Given FUN_COMM op f, the is true by COMMUTING_ITSET_RECURSES.
6122*)
6123Theorem OP_IMAGE_THM:
6124    !op id f. (OP_IMAGE op id f {} = id)  /\
6125   (FUN_COMM op f ==> !s. FINITE s ==>
6126    !e. OP_IMAGE op id f (e INSERT s) = op (f e) (OP_IMAGE op id f (s DELETE e)))
6127Proof
6128  rpt strip_tac >-
6129  rw[OP_IMAGE_EMPTY] >>
6130  rw[OP_IMAGE_DEF] >>
6131  qabbrev_tac `g = \e acc. op (f e) acc` >>
6132  rw[] >>
6133  rw[COMMUTING_ITSET_RECURSES, Abbr`g`]
6134QED
6135
6136(* A better iterator for group operation over (f:'b -> 'a) *)
6137Definition GROUP_IMAGE_DEF:
6138    GROUP_IMAGE (g:'a group) (f:'b -> 'a) (s:'b -> bool) = ITSET (\e acc. (f e) * acc) s #e
6139End
6140
6141(* overload GROUP_IMAGE *)
6142Overload GPI[local] = ``GROUP_IMAGE g``
6143
6144(*
6145> GROUP_IMAGE_DEF;
6146val it = |- !g f s. GPI f s = ITSET (\e acc. f e * acc) s #e: thm
6147*)
6148
6149(* Theorem: GPI = OP_IMAGE (g.op) (g.id) *)
6150(* Proof: by GROUP_IMAGE_DEF, OP_IMAGE_DEF, FUN_EQ_THM *)
6151Theorem group_image_as_op_image:
6152    !g:'a group. GPI = OP_IMAGE (g.op) (g.id)
6153Proof
6154  rw[GROUP_IMAGE_DEF, OP_IMAGE_DEF, FUN_EQ_THM]
6155QED
6156
6157(* Theorem: SUM_IMAGE = OP_IMAGE (\(x y):num. x + y) 0 *)
6158(* Proof: by SUM_IMAGE_DEF, OP_IMAGE_DEF, FUN_EQ_THM *)
6159Theorem sum_image_as_op_image:
6160    SIGMA = OP_IMAGE (\(x y):num. x + y) 0
6161Proof
6162  rw[SUM_IMAGE_DEF, OP_IMAGE_DEF, FUN_EQ_THM]
6163QED
6164
6165(* Theorem: PROD_IMAGE = OP_IMAGE (\(x y):num. x * y) 1 *)
6166(* Proof: by PROD_IMAGE_DEF, OP_IMAGE_DEF, FUN_EQ_THM *)
6167Theorem prod_image_as_op_image:
6168    PI = OP_IMAGE (\(x y):num. x * y) 1
6169Proof
6170  rw[PROD_IMAGE_DEF, OP_IMAGE_DEF, FUN_EQ_THM]
6171QED
6172
6173(*
6174val _ = clear_overloads_on("GITSET");
6175val _ = clear_overloads_on("GPI");
6176val _ = overload_on("GITSET", ``\g s b. ITSET g.op s b``);
6177val _ = overload_on("GPI", ``GROUP_IMAGE g``);
6178*)
6179
6180(* val _ = overload_on("GITSET", ``\g s b. ITSET g.op s b``); *)
6181
6182(* Theorem: GITSET g = ITSET (\e acc. g.op e acc) *)
6183(* Proof:
6184   Note g.op = (\e acc. e * acc)   by FUN_EQ_THM
6185
6186     GITSET g s b
6187   = ITSET g.op s b                by notation
6188   = ITSET (\e acc. e * acc) s b   by ITSET_CONG
6189
6190   Hence GITSET g = ITSET (\e acc. g.op e acc)  by FUN_EQ_THM
6191*)
6192Theorem GITSET_AS_ITSET:
6193    !g:'a group. GITSET g = ITSET (\e acc. g.op e acc)
6194Proof
6195  rw[FUN_EQ_THM] >>
6196  `g.op = (\e acc. e * acc)` by rw[FUN_EQ_THM] >>
6197  `ITSET g.op = ITSET (\e acc. e * acc)` by rw[ITSET_CONG] >>
6198  rw[]
6199QED
6200
6201(*
6202> ITSET_def |> ISPEC ``s:'b -> bool`` |> ISPEC ``(g:'a group).op`` |> ISPEC ``b:'a``;
6203val it = |- GITSET g s b = if FINITE s then if s = {} then b else GITSET g (REST s) (CHOICE s * b)
6204                           else ARB: thm
6205*)
6206
6207(* Theorem: GPROD_SET g = GPI I *)
6208(* Proof:
6209   Note g.op = (\e acc. e * acc)    by FUN_EQ_THM
6210
6211     GPROD_SET g x
6212   = GITSET g x #e                  by GPROD_SET_def
6213   = ITSET g.op x #e                by notation
6214   = ITSET (\e acc. e * acc) x #e   by above
6215   = GPI I x                        by GROUP_IMAGE_DEF
6216   Hence GPROD_SET g = GPI I        by FUN_EQ_THM
6217*)
6218Theorem GPROD_SET_AS_GROUP_IMAGE:
6219    !g:'a group. GPROD_SET g = GPI I
6220Proof
6221  rw[FUN_EQ_THM] >>
6222  `g.op = (\e acc. e * acc)` by rw[FUN_EQ_THM] >>
6223  `ITSET g.op = ITSET (\e acc. e * acc)` by rw[ITSET_CONG] >>
6224  `GPROD_SET g x = GITSET g x #e` by rw[GPROD_SET_def] >>
6225  `_ = ITSET (\e acc. e * acc) x #e` by rw[] >>
6226  `_ = GPI I x` by rw[GROUP_IMAGE_DEF] >>
6227  rw[]
6228QED
6229
6230(* Theorem: GPI f {} = #e *)
6231(* Proof
6232     GPI f {}
6233   = GROUP_IMAGE g f {}               by notation
6234   = ITSET (\e acc. f e * acc) {} #e  by GROUP_IMAGE_DEF
6235   = #e                               by ITSET_EMPTY
6236*)
6237Theorem group_image_empty:
6238    !g:'a group. !f. GPI f {} = #e
6239Proof
6240  rw[GROUP_IMAGE_DEF, ITSET_EMPTY]
6241QED
6242
6243(* Define a group function *)
6244Definition group_fun_def:
6245    group_fun (g:'a group) f = !x. x IN G ==> f x IN G
6246End
6247
6248(* overload on group function *)
6249Overload gfun[local] = ``group_fun g``
6250
6251(* Theorem: Monoid g ==> !f. gfun f ==> !x. x IN G ==> (GPI f {x} = f x) *)
6252(* Proof:
6253   Note x IN G ==> f x IN G            by group_fun_def
6254     GPI f {x}
6255   = GROUP_IMAGE g f {x}               by notation
6256   = ITSET (\e acc. f e * acc) {x} #e  by GROUP_IMAGE_DEF
6257   = f x * #e                          by ITSET_SING
6258   = f x                               by monoid_rid
6259*)
6260Theorem group_image_sing:
6261    !g:'a group. Monoid g ==> !f. gfun f ==> !x. x IN G ==> (GPI f {x} = f x)
6262Proof
6263  rw[GROUP_IMAGE_DEF, group_fun_def, ITSET_SING]
6264QED
6265
6266(* ------------------------------------------------------------------------- *)
6267(* Finite Group Order Documentation                                          *)
6268(* ------------------------------------------------------------------------- *)
6269(* Overloads:
6270   gen a     = Generated g a
6271   Gen a     = (Generated g a).carrier
6272   uroots n  = roots_of_unity g n
6273   gen_set s = Generated_subset g s
6274*)
6275(* Definitions and Theorems (# are exported):
6276
6277   Finite Group:
6278   finite_group_card_pos  |- !g. FiniteGroup g ==> 0 < CARD G
6279   finite_group_exp_not_distinct
6280                          |- !g. FiniteGroup g ==> !x. x IN G ==> ?h k. (x ** h = x ** k) /\ h <> k
6281   finite_group_exp_period_exists
6282                          |- !g. FiniteGroup g ==> !x. x IN G ==> ?k. 0 < k /\ (x ** k = #e)
6283
6284   Finite Group Order:
6285   group_order_nonzero    |- !g. FiniteGroup g ==> !x. x IN G ==> ord x <> 0
6286   group_order_pos        |- !g. FiniteGroup g ==> !x. x IN G ==> 0 < ord x
6287   group_order_property   |- !g. FiniteGroup g ==> !x. x IN G ==> 0 < ord x /\ (x ** ord x = #e)
6288   group_order_inv        |- !g. Group g ==> !x. x IN G /\ 0 < ord x ==> ( |/ x = x ** (ord x - 1))
6289   group_exp_mod          |- !g. Group g ==> !x. x IN G /\ 0 < ord x ==> !n. x ** n = x ** (n MOD ord x)
6290
6291   Characterization of Group Order:
6292   group_order_thm        |- !g n. 0 < n ==>
6293                             !x. (ord x = n) <=> (x ** n = #e) /\ !m. 0 < m /\ m < n ==> x ** m <> #e
6294   group_order_unique     |- !g. Group g ==> !x. x IN G ==>
6295                             !m n. m < ord x /\ n < ord x ==> (x ** m = x ** n) ==> (m = n)
6296   group_exp_equal        |- !g x. Group g /\ x IN G ==>
6297                             !n m. n < ord x /\ m < ord x /\ (x ** n = x ** m) ==> (n = m)
6298   finite_group_order     |- !g. FiniteGroup g ==> !x. x IN G ==>
6299                             !n. (ord x = n) ==>
6300                                 0 < n /\ (x ** n = #e) /\ !m. 0 < m /\ m < n ==> x ** m <> #e
6301   finite_group_primitive_property
6302                          |- !g. FiniteGroup g ==> !z. z IN G /\ (ord z = CARD G) ==>
6303                                                   !x. x IN G ==> ?n. x = z ** n
6304
6305   Lifting Theorems from Monoid Order:
6306#  group_order_id         |- !g. Group g ==> (ord #e = 1)
6307   group_order_eq_1       |- !g. Group g ==> !x. x IN G ==> ((ord x = 1) <=> (x = #e))
6308   group_order_condition  |- !g. Group g ==> !x. x IN G ==> !m. (x ** m = #e) <=> (ord x) divides m
6309   group_order_power_eq_0 |- !g. Group g ==> !x. x IN G ==> !k. (ord (x ** k) = 0) <=> 0 < k /\ (ord x = 0)
6310   group_order_power      |- !g. Group g ==> !x. x IN G ==> !k. ord (x ** k) * gcd (ord x) k = ord x
6311   group_order_power_eqn  |- !g. Group g ==> !x k. x IN G /\ 0 < k ==> (ord (x ** k) = ord x DIV gcd k (ord x))
6312   group_order_power_coprime
6313                          |- !g. Group g ==> !x. x IN G ==>
6314                                             !n. coprime n (ord x) ==> (ord (x ** n) = ord x)
6315   group_order_cofactor   |- !g. Group g ==> !x n. x IN G /\ 0 < ord x /\ n divides ord x ==>
6316                                                   (ord (x ** (ord x DIV n)) = n)
6317   group_order_divisor    |- !g. Group g ==>!x m. x IN G /\ 0 < ord x /\ m divides ord x ==>
6318                                            ?y. y IN G /\ (ord y = m)
6319   group_order_common     |- !g. Group g ==> !x y. x IN G /\ y IN G /\ (x * y = y * x) ==>
6320                                 ?z. z IN G /\ (ord z * gcd (ord x) (ord y) = lcm (ord x) (ord y))
6321   group_order_common_coprime
6322                          |- !g. Group g ==> !x y. x IN G /\ y IN G /\ (x * y = y * x) /\
6323                                 coprime (ord x) (ord y) ==> ?z. z IN G /\ (ord z = ord x * ord y)
6324   group_orders_eq_1      |- !g. Group g ==> (orders g 1 = {#e})
6325   group_order_divides_exp     |- !g x. Group g /\ x IN G ==> !n. (x ** n = #e) <=> ord x divides n
6326   group_exp_mod_order         |- !g. Group g ==> !x. x IN G /\ 0 < ord x ==> !n. x ** n = x ** (n MOD ord x)
6327   group_order_divides_maximal |- !g. FiniteAbelianGroup g ==>  !x. x IN G ==> (ord x) divides (maximal_order g)
6328   abelian_group_order_common  |- !g. AbelianGroup g ==> !x y. x IN G /\ y IN G ==>
6329                                      ?z. z IN G /\ (ord z * gcd (ord x) (ord y) = lcm (ord x) (ord y))
6330   abelian_group_order_common_coprime
6331                               |- !g. AbelianGroup g ==> !x y. x IN G /\ y IN G /\
6332                                      coprime (ord x) (ord y) ==> ?z. z IN G /\ (ord z = ord x * ord y)
6333
6334   Order of Inverse:
6335   group_inv_order           |- !g x. Group g /\ x IN G ==> (ord ( |/ x) = ord x)
6336   monoid_inv_order_property |- !g. FiniteMonoid g ==> !x. x IN G* ==> 0 < ord x /\ (x ** ord x = #e)
6337   monoid_inv_order          |- !g x. Monoid g /\ x IN G* ==> (ord ( |/ x) = ord x)
6338
6339   The generated subgroup by a group element:
6340   Generated_def          |- !g a. gen a = <|carrier := {x | ?k. x = a ** k}; op := $*; id := #e|>
6341   generated_element      |- !g a x. x IN Gen a <=> ?n. x = a ** n
6342   generated_property     |- !g a. ((gen a).op = $* ) /\ ((gen a).id = #e)
6343   generated_carrier      |- !g a. a IN G ==> (Gen a = IMAGE ($** a) univ(:num))
6344   generated_gen_element  |- !g. Group g ==> !x. x IN G ==> x IN (Gen x)
6345   generated_carrier_has_id    |- !g a. #e IN Gen a
6346   generated_id_carrier   |- !g. Group g ==> (Gen #e = {#e})
6347   generated_id_subgroup  |- !g. Group g ==> gen #e <= g
6348   generated_group        |- !g a. FiniteGroup g /\ a IN G ==> Group (gen a)
6349   generated_subset       |- !g a. Group g /\ a IN G ==> Gen a SUBSET G
6350   generated_subgroup     |- !g a. FiniteGroup g /\ a IN G ==> gen a <= g
6351   generated_group_finite |- !g a. FiniteGroup g /\ a IN G ==> FINITE (Gen a)
6352   generated_finite_group |- !g a. FiniteGroup g /\ a IN G ==> FiniteGroup (gen a)
6353   generated_exp          |- !g a z. a IN G /\ z IN Gen a ==> !n. (gen a).exp z n = z ** n
6354   group_order_to_generated_bij
6355                          |- !g a. Group g /\ a IN G /\ 0 < ord a ==>
6356                                   BIJ (\n. a ** n) (count (ord a)) (Gen a)
6357   generated_group_card   |- !g a. Group g /\ a IN G /\ 0 < ord a ==> (CARD (Gen a) = ord a)
6358   generated_carrier_as_image  |- !g. Group g ==> !a. a IN G /\ 0 < ord a ==>
6359                                       (Gen a = IMAGE (\j. a ** j) (count (ord a)))
6360
6361   Group Order and Divisibility:
6362   group_order_divides    |- !g. FiniteGroup g ==> !x. x IN G ==> (ord x) divides (CARD G)
6363   finite_group_Fermat    |- !g a. FiniteGroup g /\ a IN G ==> (a ** CARD G = #e)
6364   generated_Fermat       |- !g a. FiniteGroup g /\ a IN G ==>
6365                             !x. x IN (Gen a) ==> (x ** CARD (Gen a) = #e)
6366   group_exp_eq_condition |- !g x. Group g /\ x IN G /\ 0 < ord x ==>
6367                             !n m. (x ** n = x ** m) <=> (n MOD ord x = m MOD ord x)
6368   group_order_power_eq_order  |- !g x. Group g /\ x IN G /\ 0 < ord x ==>
6369                                  !k. (ord (x ** k) = ord x) <=> coprime k (ord x)
6370   group_order_exp_cofactor    |- !g x n. Group g /\ x IN G /\ 0 < ord x /\ n divides ord x ==>
6371                                          (ord (x ** (ord x DIV n)) = n)
6372
6373   Roots of Unity form a Subgroup:
6374   roots_of_unity_def     |- !g n. uroots n =
6375                                   <|carrier := {x | x IN G /\ (x ** n = #e)}; op := $*; id := #e|>
6376   roots_of_unity_element |- !g n x. x IN (uroots n).carrier <=> x IN G /\ (x ** n = #e)
6377   roots_of_unity_subset  |- !g n. (uroots n).carrier SUBSET G
6378   roots_of_unity_0       |- !g. (uroots 0).carrier = G
6379   group_uroots_has_id    |- !g. Group g ==> !n. #e IN (uroots n).carrier
6380   group_uroots_subgroup  |- !g. AbelianGroup g ==> !n. uroots n <= g
6381   group_uroots_group     |- !g. AbelianGroup g ==> !n. Group (uroots n)
6382
6383   Subgroup generated by a subset of a Group:
6384   Generated_subset_def      |- !g s. gen_set s =
6385                                    <|carrier := BIGINTER (IMAGE (\h. H) {h | h <= g /\ s SUBSET H});
6386                                      op := $*; id := #e|>
6387   Generated_subset_property |- !g s.
6388        ((gen_set s).carrier = BIGINTER (IMAGE (\h. H) {h | h <= g /\ s SUBSET H})) /\
6389        ((gen_set s).op = $* ) /\ ((gen_set s).id = #e)
6390   Generated_subset_has_set  |- !g s. s SUBSET (gen_set s).carrier
6391   Generated_subset_subset   |- !g s. Group g /\ s SUBSET G ==> (gen_set s).carrier SUBSET G
6392   Generated_subset_group    |- !g s. Group g /\ SUBSET G ==> Group (gen_set s)
6393   Generated_subset_subgroup |- !g s. Group g /\ s SUBSET G ==> gen_set s <= g
6394   Generated_subset_exp      |- !g s. (gen_set s).exp = $**
6395   Generated_subset_gen      |- !g a. FiniteGroup g /\ a IN G ==> (gen_set (Gen a) = gen a)
6396*)
6397
6398(* ------------------------------------------------------------------------- *)
6399(* Finite Group.                                                             *)
6400(* ------------------------------------------------------------------------- *)
6401
6402(* Theorem: FiniteGroup g ==> 0 < CARD G *)
6403(* Proof:
6404   Since FiniteGroup g
6405     ==> Group g /\ FINITE G      by FiniteGroup_def
6406      so G <> {}                  by group_carrier_nonempty
6407    thus CARD G <> 0              by CARD_EQ_0, FINITE G
6408      or 0 < CARD G               by NOT_ZERO_LT_ZERO
6409*)
6410Theorem finite_group_card_pos:
6411    !g:'a group. FiniteGroup g ==> 0 < CARD G
6412Proof
6413  metis_tac[FiniteGroup_def, group_carrier_nonempty, CARD_EQ_0, NOT_ZERO_LT_ZERO]
6414QED
6415
6416(* Theorem: For FINITE Group g and x IN G, x ** n cannot be all distinct. *)
6417(* Proof: by finite_monoid_exp_not_distinct. *)
6418Theorem finite_group_exp_not_distinct:
6419    !g:'a group. FiniteGroup g ==> !x. x IN G ==> ?h k. (x ** h = x ** k) /\ h <> k
6420Proof
6421  rw[finite_monoid_exp_not_distinct, finite_group_is_finite_monoid]
6422QED
6423
6424(* Theorem: For FINITE Group g and x IN G, there is k > 0 such that x ** k = #e. *)
6425(* Proof:
6426   Since G is FINITE,
6427   ?m n. m <> n and x ** m = x ** n      by finite_group_exp_not_distinct
6428   Assume m < n, then x ** (n-m) = #e    by group_exp_eq
6429   The case m > n is symmetric.
6430
6431   Note: Probably can be improved to bound k <= CARD G.
6432*)
6433Theorem finite_group_exp_period_exists:
6434    !g:'a group. FiniteGroup g ==> !x. x IN G ==> ?k. 0 < k /\ (x ** k = #e)
6435Proof
6436  rpt strip_tac >>
6437  `?m n. m <> n /\ (x ** m = x ** n)` by metis_tac[finite_group_exp_not_distinct] >>
6438  Cases_on `m < n` >| [
6439    `0 < n-m` by decide_tac,
6440    `n < m /\ 0 < m-n` by decide_tac
6441  ] >> metis_tac[group_exp_eq, FiniteGroup_def]
6442QED
6443
6444(* ------------------------------------------------------------------------- *)
6445(* Finite Group Order                                                        *)
6446(* ------------------------------------------------------------------------- *)
6447
6448(* Note:
6449
6450(Z, $+ ) and (Z, $* ) are examples of infinite group with non-identity elements of order 0.
6451(Power set of an infinite set, symmetric difference) is an example of an infinite group with non-identity elements of order 2.
6452
6453Although FiniteGroup g implies 0 < ord x
6454group_order_nonzero |- !g. FiniteGroup g ==> !x. x IN G ==> 0 < ord x
6455even infinite groups can have 0 < ord x.
6456
6457Thus if the theorem only needs 0 < ord x, there is no need for FiniteGroup g.
6458*)
6459
6460(* Theorem: FiniteGroup g ==> !x. x IN G ==> ord x <> 0 *)
6461(* Proof:
6462   By contradiction. Suppose ord x = 0.
6463   Then !n. 0 < n ==> x ** n <> #e    by order_eq_0
6464    But ?k. 0 < k /\ (x ** k = #e)    by finite_group_exp_period_exists
6465   Hence a contradiction.
6466*)
6467Theorem group_order_nonzero:
6468    !g:'a group. FiniteGroup g ==> !x. x IN G ==> ord x <> 0
6469Proof
6470  spose_not_then strip_assume_tac >>
6471  `ord x = 0` by decide_tac >>
6472  metis_tac[order_eq_0, finite_group_exp_period_exists]
6473QED
6474
6475(* Theorem: FiniteGroup g ==> !x. x IN G ==> 0 < ord x *)
6476(* Proof: by group_order_nonzero *)
6477Theorem group_order_pos:
6478    !g:'a group. FiniteGroup g ==> !x. x IN G ==> 0 < ord x
6479Proof
6480  metis_tac[group_order_nonzero, NOT_ZERO_LT_ZERO]
6481QED
6482
6483(* Theorem: The finite group element order m satisfies: 0 < m and x ** m = #e. *)
6484(* Proof: by group_order_pos, order_property. *)
6485Theorem group_order_property:
6486    !g:'a group. FiniteGroup g ==> !x. x IN G ==> 0 < ord x /\ (x ** ord x = #e)
6487Proof
6488  rw[group_order_pos, order_property]
6489QED
6490
6491(* Theorem: For Group g, if 0 < m, |/ x = x ** (m-1) where m = ord x *)
6492(* Proof:
6493   Let y = x ** ((ord x) - 1).
6494   x * y = x ** (SUC (ord x - 1))   by group_exp_SUC
6495         = x ** ord x               by 0 < ord x
6496         = #e                       by order_property
6497   Thus |/ x = y                    by group_rinv_unique
6498*)
6499Theorem group_order_inv:
6500    !g:'a group. Group g ==> !x. x IN G /\ 0 < ord x ==> ( |/x = x ** ((ord x)-1))
6501Proof
6502  rpt strip_tac >>
6503  qabbrev_tac `y = x ** ((ord x) - 1)` >>
6504  `y IN G` by rw[Abbr`y`] >>
6505  `SUC ((ord x) - 1) = ord x` by decide_tac >>
6506  `x * y = x ** (ord x)` by metis_tac[group_exp_SUC] >>
6507  metis_tac[group_rinv_unique, order_property]
6508QED
6509
6510(* Theorem: For Group g, if 0 < m, x ** n = x ** (n mod m), where m = ord x *)
6511(* Proof:
6512   Let m = ord x.
6513     x ** n
6514   = x ** (m * q + r)            by division: n = q * m + r
6515   = x ** (m * q) * (x ** r)     by group_exp_add
6516   = ((x ** m) ** q) * (x ** r)  by group_exp_mult
6517   = (#e ** q) * (x ** r)        by order_property
6518   = #e * (x ** r)               by group_id_exp
6519   = x ** r                      by group_lid
6520*)
6521Theorem group_exp_mod:
6522    !g:'a group. Group g ==> !x. x IN G /\ 0 < ord x ==> !n. x ** n = x ** (n MOD ord x)
6523Proof
6524  rpt strip_tac >>
6525  qabbrev_tac `m = ord x` >>
6526  `x ** m = #e` by rw[order_property, Abbr`m`] >>
6527  `n = (n DIV m) * m + (n MOD m)` by rw[DIVISION] >>
6528  `_ = m * (n DIV m) + (n MOD m)` by decide_tac >>
6529  metis_tac[group_exp_add, group_exp_mult, group_id_exp, group_lid, group_exp_element]
6530QED
6531
6532(* ------------------------------------------------------------------------- *)
6533(* Characterization of Group Order                                           *)
6534(* ------------------------------------------------------------------------- *)
6535
6536(* A characterization of group order without reference to period. *)
6537
6538(* Theorem: If 0 < n, ord x = n iff x ** n = #e with 0 < n, and !m < n, x ** m <> #e. *)
6539(* Proof: true by order_thm. *)
6540Theorem group_order_thm:
6541    !g:'a group. !n. 0 < n ==>
6542   !x. (ord x = n) <=> (x ** n = #e) /\ (!m. 0 < m /\ m < n ==> (x ** m) <> #e)
6543Proof
6544  rw[order_thm]
6545QED
6546
6547(* Theorem: For Group g, m, n < (ord x), x ** m = x ** n ==> m = n *)
6548(* Proof:
6549   Otherwise x ** (m-n) = #e by group_exp_eq,
6550   contradicting minimal nature of element order.
6551*)
6552Theorem group_order_unique:
6553    !g:'a group. Group g ==> !x. x IN G ==>
6554   !m n. m < ord x /\ n < ord x /\ (x ** m = x ** n) ==> (m = n)
6555Proof
6556  spose_not_then strip_assume_tac >>
6557  Cases_on `m < n` >| [
6558    `0 < n-m /\ n-m < ord x` by decide_tac,
6559    `n < m /\ 0 < m-n /\ m-n < ord x` by decide_tac
6560  ] >>
6561  metis_tac[group_exp_eq, order_minimal]
6562QED
6563
6564(* Theorem: Group g /\ x IN G ==> !n m. n < ord x /\ m < ord x /\ (x ** n = x ** m) ==> (n = m) *)
6565(* Proof: by group_order_unique *)
6566Theorem group_exp_equal:
6567    !(g:'a group) x. Group g /\ x IN G ==>
6568   !n m. n < ord x /\ m < ord x /\ (x ** n = x ** m) ==> (n = m)
6569Proof
6570  metis_tac[group_order_unique]
6571QED
6572
6573(* Theorem: [property of finite group order]
6574   For x IN G, if (ord x = n), 0 < n /\ (x ** n = #e) /\ (!m. 0 < m /\ m < n ==> (x ** m) <> #e
6575*)
6576(* Proof:
6577   ord x = n ==> 0 < n /\ x ** n = #e                  by group_order_property
6578   ord x = n ==> !m. 0 < m /\ m < n ==> x ** m <> #e   by order_minimal
6579*)
6580Theorem finite_group_order:
6581    !g:'a group. FiniteGroup g ==> !x. x IN G ==>
6582      !n. (ord x = n) ==> (0 < n /\ (x ** n = #e) /\ (!m. 0 < m /\ m < n ==> (x ** m) <> #e))
6583Proof
6584  metis_tac[group_order_property, order_minimal]
6585QED
6586
6587(* Theorem: FiniteGroup g /\ !z. z IN G /\ (ord z = CARD G) ==>
6588            !x. x IN G ==> ?n. n < CARD G /\ (x = z ** n) *)
6589(* Proof:
6590   By order g z = CARD G, all powers of z are distinct.
6591   By FiniteGroup g, all powers of z = permutation of element.
6592   Hence each element is some power of z.
6593   Or,
6594   Let f = \n. z ** n
6595   Then INJ f (count (CARD G)) G         by INJ_DEF, group_order_unique
6596   Now  FINITE (count (CARD G))          by FINITE_COUNT
6597        CARD (count (CARD G)) = CARD G   by CARD_COUNT
6598    so  SURJ f (count (CARD G)) G        by FINITE_INJ_AS_SURJ, FINITE G
6599   i.e. IMAGE f (count (CARD G)) = G     by IMAGE_SURJ
6600   Hence ?n. n < CARD G /\ x = z ** n    by IN_IMAGE, IN_COUNT
6601*)
6602Theorem finite_group_primitive_property:
6603    !g:'a group. FiniteGroup g ==> !z. z IN G /\ (ord z = CARD G) ==>
6604   (!x. x IN G ==> ?n. n < CARD G /\ (x = z ** n))
6605Proof
6606  rpt (stripDup[FiniteGroup_def]) >>
6607  qabbrev_tac `f = \n. z ** n` >>
6608  `INJ f (count (CARD G)) G` by
6609  (rw[INJ_DEF, Abbr`f`] >>
6610  metis_tac[group_order_unique]) >>
6611  `FINITE (count (CARD G))` by rw[] >>
6612  `CARD (count (CARD G)) = CARD G` by rw[] >>
6613  `SURJ f (count (CARD G)) G` by rw[FINITE_INJ_AS_SURJ] >>
6614  `IMAGE f (count (CARD G)) = G` by rw[GSYM IMAGE_SURJ] >>
6615  metis_tac[IN_IMAGE, IN_COUNT]
6616QED
6617
6618(* ------------------------------------------------------------------------- *)
6619(* Lifting Theorems from Monoid Order                                        *)
6620(* ------------------------------------------------------------------------- *)
6621
6622(* Lifting Monoid Order theorem for Group Order.
6623   from: !g:'a monoid. Monoid g ==> ....
6624     to: !g:'a group.  Group g ==> ....
6625    via: !g:'a group.  Group g ==> Monoid g
6626*)
6627local
6628val gim = group_is_monoid |> SPEC_ALL |> UNDISCH
6629in
6630fun lift_monoid_order_thm suffix = let
6631   val mth = DB.fetch "monoid" ("monoid_order_" ^ suffix)
6632   val mth' = mth |> SPEC_ALL
6633in
6634   save_thm("group_order_" ^ suffix, gim |> MP mth' |> DISCH_ALL |> GEN_ALL)
6635end
6636end; (* local *)
6637
6638(* Theorem: ord #e = 1 *)
6639val group_order_id = lift_monoid_order_thm "id";
6640(* > val group_order_id = |- !g. Group g ==> (ord #e = 1): thm *)
6641
6642(* export simple result *)
6643val _ = export_rewrites ["group_order_id"];
6644
6645(* Theorem: x IN G ==> ord x = 1 <=> x = #e *)
6646val group_order_eq_1 = lift_monoid_order_thm "eq_1";
6647(* > val group_order_eq_1 = |- !g. Group g ==> !x. x IN G ==> ((ord x = 1) <=> (x = #e)): thm *)
6648
6649(* Theorem: x IN G ==> !m. (x ** m = #e) <=> (ord x) divides m *)
6650val group_order_condition = lift_monoid_order_thm "condition";
6651(* > val group_order_condition = |- !g. Group g ==> !x. x IN G ==> !m. (x ** m = #e) <=> ord x divides m: thm *)
6652
6653(* Theorem: x IN G ==> !k. (ord (x ** k) = 0) <=> 0 < k /\ (ord x = 0) *)
6654val group_order_power_eq_0 = lift_monoid_order_thm "power_eq_0";
6655(* > val group_order_power_eq_0 = |- !g. Group g ==>
6656     !x. x IN G ==> !k. (ord (x ** k) = 0) <=> 0 < k /\ (ord x = 0): thm *)
6657
6658(* Theorem: x IN G ==> !k. ord (x ** k) = ord x / gcd(ord x, k) *)
6659val group_order_power = lift_monoid_order_thm "power";
6660(* > val group_order_power = |- !g. Group g ==> !x. x IN G ==> !k. ord (x ** k) * gcd (ord x) k = ord x: thm *)
6661
6662(* Theorem: x IN G ==> !k. ord (x ** k) = ord x / gcd(ord x, k) *)
6663val group_order_power_eqn = lift_monoid_order_thm "power_eqn";
6664(* > val group_order_power_eqn = |- !g. Group g ==> !x k. x IN G /\ 0 < k ==> (ord (x ** k) = ord x DIV (gcd k (ord x))): thm *)
6665
6666(* Theorem: x IN G ==> !k. ord (x ** k) = ord x / gcd(ord x, k) *)
6667val group_order_power_coprime = lift_monoid_order_thm "power_coprime";
6668(* > val group_order_power_coprime =
6669   |- !g. Group g ==> !x. x IN G ==> !n. coprime n (ord x) ==> (ord (x ** n) = ord x): thm *)
6670
6671(* Theorem: x IN G ==> !k. ord (x ** k) = ord x / gcd(ord x, k) *)
6672val group_order_cofactor = lift_monoid_order_thm "cofactor";
6673(* > val group_order_cofactor = |- !g. Group g ==> !x n. x IN G /\ 0 < ord x /\ n divides ord x ==>
6674        (ord (x ** (ord x DIV n)) = n): thm *)
6675
6676(* Theorem: If x IN G with ord x = n, and m divides n, then G contains an element of order m. *)
6677val group_order_divisor = lift_monoid_order_thm "divisor";
6678(* > val group_order_divisor = |- !g. Group g ==>
6679     !x m. x IN G /\ 0 < ord x /\ m divides ord x ==> ?y. y IN G /\ (ord y = m): thm *)
6680
6681(* Theorem: If x * y = y * x, and n = ord x, m = ord y,
6682            then there exists z IN G such that ord z = (lcm n m) / (gcd n m) *)
6683val group_order_common = lift_monoid_order_thm "common";
6684(* > val group_order_common = |- !g. Group g ==>
6685         !x y. x IN G /\ y IN G /\ (x * y = y * x) ==>
6686         ?z. z IN G /\ (ord z * gcd (ord x) (ord y) = lcm (ord x) (ord y)): thm *)
6687(* Note:
6688   This is interesting, but this z has a 'smaller' order: (lcm n m) / (gcd n m).
6689
6690   The theorem that is desired is:
6691   Theorem: If x * y = y * x, and n = ord x, m = ord y, then there exists z IN G such that ord z = (lcm n m)
6692
6693   But this needs another method.
6694   However, a restricted form of this theorem is still useful.
6695*)
6696
6697(* Theorem: If x * y = y * x, and n = ord x, m = ord y, and gcd n m = 1,
6698            then there exists z IN G with ord z = (lcm n m) *)
6699val group_order_common_coprime = lift_monoid_order_thm "common_coprime";
6700(* > val group_order_common_coprime = |- !g. Group g ==>
6701         !x y. x IN G /\ y IN G /\ (x * y = y * x) /\ coprime (ord x) (ord y) ==>
6702         ?z. z IN G /\ (ord z = ord x * ord y): thm *)
6703
6704(* Theorem: Group g ==> (orders g 1 = {#e}) *)
6705(* Proof: by group_is_monoid, orders_eq_1 *)
6706Theorem group_orders_eq_1:
6707    !g:'a group. Group g ==> (orders g 1 = {#e})
6708Proof
6709  rw[group_is_monoid, orders_eq_1]
6710QED
6711
6712(* Theorem: Group g /\ x IN G ==> !n. (x ** n = #e) <=> (ord x) divides n *)
6713(* Proof: by group_order_condition *)
6714Theorem group_order_divides_exp:
6715    !(g:'a group) x. Group g /\ x IN G ==> !n. (x ** n = #e) <=> (ord x) divides n
6716Proof
6717  rw[group_order_condition]
6718QED
6719
6720(* Another proof of subgroup_order in subgroupTheory. *)
6721
6722(* Theorem: h <= g ==> !x. x IN H ==> (order h x = ord x) *)
6723(* Proof:
6724   h <= g means Group g /\ Group h /\ H SUBSET G   by Subgroup_def
6725   Let x IN H, then x IN G                         by SUBSET_DEF
6726   x ** (order h x) = #e /\ x ** (ord x) = #e      by order_property
6727   Therefore
6728   (ord x) (order h x) divides           by group_order_condition, 1st one
6729   (order h x) divides (ord x)           by group_order_condition, 2nd one
6730   Hence order h x = ord x               by DIVIDES_ANTISYM
6731*)
6732(* keep subgroupTheory.subgroup_order *)
6733Theorem subgroup_order[local]:
6734    !g h:'a group. h <= g ==> !x. x IN H ==> (order h x = ord x)
6735Proof
6736  rpt strip_tac >>
6737  `Group g /\ Group h /\ H SUBSET G /\ (h.op = g.op) /\ (h.id = #e)` by metis_tac[Subgroup_def, subgroup_id] >>
6738  `!x. x IN H ==> x IN G` by metis_tac[SUBSET_DEF] >>
6739  `!x. x IN H ==> !n. h.exp x n = x ** n` by metis_tac[subgroup_exp] >>
6740  metis_tac[order_property, group_order_condition, DIVIDES_ANTISYM]
6741QED
6742
6743(* Theorem: Group g ==> !x. x IN G /\ 0 < ord x ==> !n. x ** n = x ** (n MOD (ord x)) *)
6744(* Proof: by monoid_exp_mod_order, group_is_monoid *)
6745Theorem group_exp_mod_order:
6746    !g:'a group. Group g ==> !x. x IN G /\ 0 < ord x ==> !n. x ** n = x ** (n MOD (ord x))
6747Proof
6748  metis_tac[monoid_exp_mod_order, group_is_monoid]
6749QED
6750
6751(* Theorem: In a Finite Abelian Group, every order divides the maximal order.
6752            FiniteAbelianGroup g ==> !x. x IN G ==> ord x divides maximal_order g *)
6753(* Proof:
6754   Since 0 < ord x     by group_order_pos
6755   The result is true  by monoid_order_divides_maximal
6756*)
6757Theorem group_order_divides_maximal:
6758    !g:'a group. FiniteAbelianGroup g ==> !x. x IN G ==> (ord x) divides (maximal_order g)
6759Proof
6760  metis_tac[monoid_order_divides_maximal, group_order_pos, finite_group_is_finite_monoid,
6761             FiniteAbelianGroup_def_alt, FiniteAbelianMonoid_def_alt]
6762QED
6763
6764(* Theorem: AbelianGroup g ==> !x y. x IN G /\ y IN G ==>
6765            ?z. z IN G /\ (ord z * gcd (ord x) (ord y) = lcm (ord x) (ord y)) *)
6766(* Proof: by AbelianGroup_def, group_order_common *)
6767Theorem abelian_group_order_common:
6768    !g:'a group. AbelianGroup g ==> !x y. x IN G /\ y IN G ==>
6769   ?z. z IN G /\ (ord z * gcd (ord x) (ord y) = lcm (ord x) (ord y))
6770Proof
6771  rw[AbelianGroup_def, group_order_common]
6772QED
6773
6774(* Theorem: AbelianGroup g ==> !x y. x IN G /\ y IN G /\ coprime (ord x) (ord y) ==>
6775            ?z. z IN G /\ (ord z = ord x * ord y) *)
6776(* Proof: by AbelianGroup_def, group_order_common_coprime *)
6777Theorem abelian_group_order_common_coprime:
6778    !g:'a group. AbelianGroup g ==> !x y. x IN G /\ y IN G /\ coprime (ord x) (ord y) ==>
6779   ?z. z IN G /\ (ord z = ord x * ord y)
6780Proof
6781  rw[AbelianGroup_def, group_order_common_coprime]
6782QED
6783
6784(* ------------------------------------------------------------------------- *)
6785(* Order of Inverse                                                          *)
6786(* ------------------------------------------------------------------------- *)
6787
6788(*
6789group_order_inv
6790|- !g. Group g ==> !x. x IN G /\ 0 < ord x ==> ( |/ x = x ** (ord x - 1))
6791*)
6792
6793(* Theorem: Group g /\ x IN G ==> (ord ( |/ x) = ord x) *)
6794(* Proof:
6795   Let n = ord x.
6796   If n = 0,
6797      Let m = ord ( |/ x).
6798      By contradiction, suppose m <> 0.
6799      Then #e = ( |/ x) ** m               by order_property
6800              = |/ (x ** m)                by group_inv_exp
6801      Thus x ** m = |/ #e                  by group_inv_inv
6802                  = #e                     by group_inv_id
6803      This contradicts ord x = n = 0       by order_eq_0, 0 < m
6804
6805   Otherwise n <> 0, or 0 < n              by NOT_ZERO_LT_ZERO
6806     ord ( |/ x)
6807   = ord ( |/ x) * 1                       by MULT_RIGHT_1
6808   = ord ( |/ x) * gcd n (n - 1)           by coprime_PRE, 0 < n
6809   = ord (x ** (n - 1)) * gcd n (n - 1)    by group_order_inv
6810   = n                                     by group_order_power
6811*)
6812Theorem group_inv_order:
6813    !(g:'a group) x. Group g /\ x IN G ==> (ord ( |/ x) = ord x)
6814Proof
6815  rpt strip_tac >>
6816  qabbrev_tac `n = ord x` >>
6817  Cases_on `n = 0` >| [
6818    simp[] >>
6819    spose_not_then strip_assume_tac >>
6820    qabbrev_tac `m = ord ( |/ x)` >>
6821    `#e = ( |/ x) ** m` by rw[order_property, Abbr`m`] >>
6822    `_ = |/ (x ** m)` by rw[group_inv_exp] >>
6823    `x ** m = #e` by metis_tac[group_inv_inv, group_inv_id, group_exp_element] >>
6824    `0 < m` by decide_tac >>
6825    metis_tac[order_eq_0],
6826    `0 < n` by decide_tac >>
6827    metis_tac[MULT_RIGHT_1, coprime_PRE, group_order_inv, group_order_power]
6828  ]
6829QED
6830
6831(*
6832> group_order_property |> ISPEC ``Invertibles g``;
6833val it = |- FiniteGroup (Invertibles g) ==> !x. x IN (Invertibles g).carrier ==>
6834     0 < order (Invertibles g) x /\
6835     ((Invertibles g).exp x (order (Invertibles g) x) = (Invertibles g).id): thm
6836*)
6837
6838(* Theorem: FiniteMonoid g ==> !x. x IN G* ==> 0 < ord x /\ (x ** ord x = #e) *)
6839(* Proof:
6840   Note FiniteGroup (Invertibles g)        by finite_monoid_invertibles_is_finite_group
6841    and (Invertibles g).carrier = G*       by Invertibles_carrier
6842    ==> 0 < order (Invertibles g) x  /\
6843        (Invertibles g).exp x (order (Invertibles g) x) =
6844         (Invertibles g).id                by group_order_property
6845    But order (Invertibles g) x = ord x    by Invertibles_order
6846    and (Invertibles g).id = #e            by Invertibles_property
6847    and (Invertibles g).exp = $**          by Invertibles_property
6848    ==> 0 < ord x /\ x ** ord x = #e       by above
6849*)
6850Theorem monoid_inv_order_property:
6851    !g:'a monoid. FiniteMonoid g ==> !x. x IN G* ==> 0 < ord x /\ (x ** ord x = #e)
6852Proof
6853  ntac 4 strip_tac >>
6854  `FiniteGroup (Invertibles g)` by rw[finite_monoid_invertibles_is_finite_group] >>
6855  metis_tac[group_order_property, Invertibles_order, Invertibles_property]
6856QED
6857
6858(*
6859This proof is quite complicated:
6860* The invertibles of monoid form a group.
6861* For a finite group, finite_group_Fermat |- !g a. FiniteGroup g /\ a IN G ==> (a ** CARD G = #e)
6862* Thus   a ** (CARD G - 1) = |/ a
6863*    ord ( |/ a) = ord (a ** (CARD G - 1)) * gcd (ord a) (CARD G - 1) = ord a
6864* because (ord a) divides (CARD G), gcd (ord a) (CARD G - 1) = 1, and ord ( |/ a) = ord a.
6865*)
6866
6867(*
6868> group_inv_order |> ISPEC ``Invertibles g``;
6869val it = |- FiniteGroup (Invertibles g) ==> !x. x IN (Invertibles g).carrier ==>
6870     (order (Invertibles g) ((Invertibles g).inv x) = order (Invertibles g) x): thm
6871*)
6872
6873(* Theorem: Monoid g /\ x IN G* ==> (ord ( |/ x) = ord x) *)
6874(* Proof:
6875   Note Group (Invertibles g)                  by monoid_invertibles_is_group
6876    and (Invertibles g).carrier = G*           by Invertibles_carrier
6877    ==> order (Invertibles g) ((Invertibles g).inv x)
6878      = order (Invertibles g) x                by group_inv_order
6879    But !x. order (Invertibles g) x = ord x    by Invertibles_order
6880    and (Invertibles g).inv x = |/ x           by Invertibles_inv
6881    ==> ord ( |/ x) = ord x                    by above
6882*)
6883Theorem monoid_inv_order:
6884    !(g:'a monoid) x. Monoid g /\ x IN G* ==> (ord ( |/ x) = ord x)
6885Proof
6886  rpt strip_tac >>
6887  `Group (Invertibles g)` by rw[monoid_invertibles_is_group] >>
6888  `(Invertibles g).carrier = G*` by rw[Invertibles_carrier] >>
6889  `(Invertibles g).inv x = |/ x` by metis_tac[Invertibles_inv] >>
6890  metis_tac[group_inv_order, Invertibles_order]
6891QED
6892
6893(* ------------------------------------------------------------------------- *)
6894(* Application of Finite Group element order:                                *)
6895(* The generated subgroup by a group element.                                *)
6896(* ------------------------------------------------------------------------- *)
6897
6898(* ------------------------------------------------------------------------- *)
6899(* The Subgroup <a> of any element a of Group g.                             *)
6900(* ------------------------------------------------------------------------- *)
6901
6902(* Define the generator group, the exponential group of an element a of group g *)
6903Definition Generated_def:
6904  Generated g a : 'a group =
6905    <| carrier := {x | ?k. x = a ** k };
6906            op := g.op;
6907            id := g.id
6908     |>
6909End
6910(*
6911- type_of ``Generated g a``;
6912> val it = ``:'a group`` : hol_type
6913*)
6914
6915
6916(* overload on generated group and its carrier *)
6917Overload gen = ``Generated g``
6918Overload Gen = ``\a. (Generated g a).carrier``
6919
6920(* Theorem: x IN Gen a <=> ?n. x = a ** n *)
6921(* Proof: by Generated_def *)
6922Theorem generated_element:
6923    !g:'a group. !a x. x IN Gen a <=> ?n. x = a ** n
6924Proof
6925  rw[Generated_def]
6926QED
6927
6928(* Theorem: ((gen a).op = g.op) /\ ((gen a).id = #e) *)
6929(* Proof: by Generated_def. *)
6930Theorem generated_property:
6931    !(g:'a group) a. ((gen a).op = g.op) /\ ((gen a).id = #e)
6932Proof
6933  rw[Generated_def]
6934QED
6935
6936(* Theorem: !a. a IN G ==> (Gen a = IMAGE (g.exp a) univ(:num)) *)
6937(* Proof: by Generated_def, EXTENSION *)
6938Theorem generated_carrier:
6939    !(g:'a group) a. a IN G ==> (Gen a = IMAGE (g.exp a) univ(:num))
6940Proof
6941  rw[Generated_def, EXTENSION]
6942QED
6943
6944(* Theorem: Group g ==> !x. x IN G ==> x IN (Gen x) *)
6945(* Proof: by Generated_def, group_exp_1 *)
6946Theorem generated_gen_element:
6947    !g:'a group. Group g ==> !x. x IN G ==> x IN (Gen x)
6948Proof
6949  rw[Generated_def] >>
6950  metis_tac[group_exp_1]
6951QED
6952
6953(* Theorem: #e IN (Gen a) *)
6954(* Proof:
6955   Note a ** 0 = #e    by group_exp_0
6956    ==> #e IN (Gen a)  by generated_element
6957*)
6958Theorem generated_carrier_has_id:
6959    !g:'a group. !a. #e IN (Gen a)
6960Proof
6961  metis_tac[generated_element, group_exp_0]
6962QED
6963
6964(* Theorem: Group g ==> (Gen #e = {#e}) *)
6965(* Proof:
6966     Gen #e
6967   = {x | ?k. x = #e ** k}     by Generated_def
6968   = {x | x = #e}              by group_id_exp, Group g
6969   = {#e}                      by EXTENSION
6970*)
6971Theorem generated_id_carrier:
6972    !g:'a group. Group g ==> (Gen #e = {#e})
6973Proof
6974  rw[Generated_def, EXTENSION]
6975QED
6976
6977(* Theorem: Group g ==> gen #e <= g *)
6978(* Proof:
6979   Note Gen #e = {#e}            by generated_id_carrier, Group g
6980   By subgroup_alt, this is to show:
6981   (1) Gen #e <> {}, true        by NOT_SING_EMPTY
6982   (2) (Gen #e) SUBSET G, true   by group_id_element, SUBSET_DEF
6983   (3) (gen #e).op = $*, true    by generated_property
6984   (4) (gen #e).id = #e, true    by generated_property
6985   (5) x IN (Gen #e) /\ y IN (Gen #e) ==> x * |/ y IN (Gen #e)
6986       Note x = #e /\ y = #e     by IN_SING
6987         so x * |/ y = #e        by group_inv_id, group_id_id
6988         or x * |/ y IN (Gen #e) by IN_SING
6989*)
6990Theorem generated_id_subgroup:
6991    !g:'a group. Group g ==> gen #e <= g
6992Proof
6993  rw[generated_id_carrier, subgroup_alt, generated_property]
6994QED
6995
6996(* Note for the next theorem:
6997   FINITE is required to have the order m, giving the inverse.
6998   INFINITE would require two generators: a and |/ a.
6999   For example, (Z, $+) is a group, but (gen 1 = naturals) is not a group.
7000   Also (gen 2 = multples of 2) is not a group, but (gen 2 -2) is a group.
7001   Indeed, Z = gen 1 -1, but our generated_def has only one generator.
7002
7003   Can define |/a = a ** -1, but that would require exponents to be :int, not :num
7004*)
7005
7006(* Theorem: For a FINITE group g, the generated group of a in G is a group *)
7007(* Proof:
7008   This is to show:
7009   (1) ?k''. a ** k * a ** k' = a ** k''   by group_exp_add
7010   (2) a ** k * a ** k' * a ** k'' = a ** k * (a ** k' * a ** k'')  by group_assoc
7011   (3) ?k. #e = a ** k                     by group_exp_0, a ** 0 = #e.
7012   (4) #e * a ** k = a ** k                by group_lid
7013   (5) ?y. (?k'. y = a ** k') /\ (y * a ** k = #e)
7014       There is m = ord a with the property 0 < m
7015                                           by group_order_pos
7016          |/ (a ** k)
7017        = ( |/a) ** k                      by group_exp_inv
7018        = (a ** (m-1)) ** k                by group_order_inv
7019        = a ** ((m-1) * k)                 by group_exp_mult
7020        Pick k' = (m-1) * k, and y = a ** k' = |/ (a ** k).
7021*)
7022Theorem generated_group:
7023    !(g:'a group) a. FiniteGroup g /\ a IN G ==> Group (gen a)
7024Proof
7025  rpt (stripDup[FiniteGroup_def]) >>
7026  rw_tac std_ss[group_def_alt, Generated_def, RES_FORALL_THM, GSPECIFICATION] >-
7027  metis_tac[group_exp_add] >-
7028  rw_tac std_ss[group_assoc, group_exp_element] >-
7029  metis_tac[group_exp_0] >-
7030  rw_tac std_ss[group_lid, group_exp_element] >>
7031  `0 < ord a` by rw[group_order_pos] >>
7032  metis_tac[group_order_inv, group_exp_inv, group_exp_mult, group_linv, group_exp_element]
7033QED
7034
7035(* Theorem: Group g /\ a IN G ==> (Gen a) SUBSET G *)
7036(* Proof:
7037   x IN (Gen a) ==> ?n. x = a ** n          by Generated_def
7038   a IN G ==> a ** n IN G                   by group_exp_element
7039   Hence (Gen a) SUBSET G                   by SUBSET_DEF
7040*)
7041Theorem generated_subset:
7042    !(g:'a group) a. Group g /\ a IN G ==> (Gen a) SUBSET G
7043Proof
7044  rw[Generated_def, SUBSET_DEF] >>
7045  rw[]
7046QED
7047
7048(* Theorem: The generated group <a> for a IN G is subgroup of G. *)
7049(* Proof:
7050   Essentially this is to prove:
7051   (1) Group (gen a)              true by generated_group.
7052   (2) (Gen a) SUBSET G           true by generated_subset
7053   (3) gen a).op x y = x * y      true by Generated_def.
7054*)
7055Theorem generated_subgroup:
7056    !(g:'a group) a. FiniteGroup g /\ a IN G ==> Subgroup (gen a) g
7057Proof
7058  rpt (stripDup[FiniteGroup_def]) >>
7059  rw_tac std_ss[Subgroup_def, SUBSET_DEF, GSPECIFICATION] >-
7060  rw_tac std_ss[generated_group] >-
7061  metis_tac[generated_subset, SUBSET_DEF] >>
7062  rw_tac std_ss[Generated_def]
7063QED
7064
7065(* Theorem: FiniteGroup g /\ a IN G ==> FINITE (Gen a) *)
7066(* Proof:
7067   FiniteGroup g ==> Group g /\ FINITE G  by FiniteGroup_def
7068   Group g ==> (Gen a) SUBSET G           by generated_subset
7069   Hence FINITE (Gen a)                   by SUBSET_FINITE
7070*)
7071Theorem generated_group_finite:
7072    !(g:'a group) a. FiniteGroup g /\ a IN G ==> FINITE (Gen a)
7073Proof
7074  metis_tac[FiniteGroup_def, generated_subset, SUBSET_FINITE]
7075QED
7076
7077(* Theorem: FiniteGroup g /\ a IN G ==> FiniteGroup (gen a) *)
7078(* Proof:
7079   FiniteGroup g ==> FINITE (Gen a)   by generated_group_finite
7080   FiniteGroup g ==> Group (gen a)    by generated_group
7081   and FiniteGroup (gen a)            by FiniteGroup_def
7082*)
7083Theorem generated_finite_group:
7084    !(g:'a group) a. FiniteGroup g /\ a IN G ==> FiniteGroup (gen a)
7085Proof
7086  rw[FiniteGroup_def, generated_group, generated_group_finite]
7087QED
7088
7089(* Theorem: a IN G /\ z IN (Gen a) ==> !n. (gen a).exp z n = z ** n *)
7090(* Proof:
7091     (gen a).exp z n
7092   = FUNPOW ((gen a).op z) n (gen a).id    by monoid_exp_def
7093   = FUNPOW (g.op z) n (g.id)              by Generated_def
7094   = g.exp z n                             by monoid_exp_def
7095   = z ** n                                by notation
7096*)
7097Theorem generated_exp:
7098    !g:'a group. !a z. a IN G /\ z IN (Gen a) ==> !n. (gen a).exp z n = z ** n
7099Proof
7100  rw[Generated_def, monoid_exp_def]
7101QED
7102
7103(* Theorem: There is a bijection from (count m) to (gen a), where m = ord x and 0 < m *)
7104(* Proof:
7105   The map (\n. a ** n) from (count m) to (gen a) is bijective:
7106   (1) surjective because x in (gen a) means ?k. x = a ** k = a ** (k mod m), so take n = k mod m.
7107       This is group_exp_mod.
7108   (2) injective because a ** m = a ** n ==> m = n,
7109       otherwise a ** (m-n) = #e, contradicting minimal nature of m.
7110       This is group_order_unique.
7111
7112   Essentially this is to prove:
7113   (1) a IN G /\ n < ord a ==> ?k. a ** n = a ** k,             just take k = n.
7114   (2) n < ord a /\ n' < ord a /\ a ** n = a ** n' ==> n = n',  true by group_order_unique
7115   (3) same as (1)
7116   (4) a IN G ==> ?n. n < ord a /\ (a ** n = a ** k),           true by group_exp_mod, n = k mod order.
7117*)
7118Theorem group_order_to_generated_bij:
7119    !(g:'a group) a. Group g /\ a IN G /\ 0 < ord a ==> BIJ (\n. a ** n) (count (ord a)) (Gen a)
7120Proof
7121  rpt strip_tac >>
7122  rw[BIJ_DEF, SURJ_DEF, INJ_DEF, Generated_def] >-
7123  metis_tac[] >-
7124  metis_tac[group_order_unique] >-
7125  metis_tac[] >>
7126  metis_tac[group_exp_mod, MOD_LESS]
7127QED
7128
7129(* Theorem: The order of the generated_subgroup is the order of its element *)
7130(* Proof:
7131   Note BIJ (\n. a**n) (count (ord a)) (Gen a)  by group_order_to_generated_bij
7132    and FINITE (count (ord a))                  by FINITE_COUNT
7133    and CARD (count (ord a)) = ord a            by CARD_COUNT
7134   Thus CARD (Gen a) = ord a                    by FINITE_BIJ
7135*)
7136Theorem generated_group_card:
7137    !(g:'a group) a. Group g /\ a IN G /\ 0 < ord a ==> (CARD (Gen a) = ord a)
7138Proof
7139  metis_tac[group_order_to_generated_bij, FINITE_BIJ, FINITE_COUNT, CARD_COUNT]
7140QED
7141
7142(* Theorem: Group g ==> !a. a IN G /\ 0 < ord a ==> (Gen a = IMAGE (\j. a ** j) (count (ord a))) *)
7143(* Proof:
7144   By generated_carrier, IN_IMAGE and IN_COUNT, this is to show:
7145   (1) a IN G /\ 0 < ord a ==> ?j. (a ** x' = a ** j) /\ j < ord a
7146       Take j = x' MOD (ord a).
7147       Then j < ord a                by MOD_LESS
7148        and a ** x' = a ** j         by group_exp_mod
7149   (2) ?x'. a ** j = a ** x'
7150       Take x' = j.
7151*)
7152Theorem generated_carrier_as_image:
7153    !g:'a group. Group g ==> !a. a IN G /\ 0 < ord a ==>
7154               (Gen a = IMAGE (\j. a ** j) (count (ord a)))
7155Proof
7156  rw[generated_carrier, EXTENSION, EQ_IMP_THM] >-
7157  metis_tac[group_exp_mod, MOD_LESS] >>
7158  metis_tac[]
7159QED
7160
7161(* ------------------------------------------------------------------------- *)
7162(* Group Order and Divisibility                                              *)
7163(* ------------------------------------------------------------------------- *)
7164
7165(* Theorem: For FiniteGroup g g, if x IN G, (ord x) divides (CARD G) *)
7166(* Proof:
7167   By applying Lagrange theorem to the generated subgroup of the element x:
7168   Note gen x <= g              by generated_subgroup
7169   Thus CARD (Gen x)) (CARD G)  by Lagrange_thm
7170    Now 0 < ord x               by group_order_pos
7171    and CARD (Gen x)) = ord x   by generated_group_card
7172   The result follows.
7173*)
7174Theorem group_order_divides:
7175    !g:'a group. FiniteGroup g ==> !x. x IN G ==> (ord x) divides (CARD G)
7176Proof
7177  rpt (stripDup[FiniteGroup_def]) >>
7178  `gen x <= g` by rw[generated_subgroup] >>
7179  `(CARD (Gen x)) divides (CARD G)` by rw[Lagrange_thm] >>
7180  metis_tac[generated_group_card, group_order_pos]
7181QED
7182
7183(* Theorem: For FiniteGroup g, a IN G ==> a ** (CARD g) = #e *)
7184(* Proof:
7185   Note (ord a) divides (CARD G)     by group_order_divides
7186     or ?k. CARD G = (ord a) * k     by divides_def, MULT_COMM
7187
7188     a ** (CARD G)
7189   = a ** ((ord a) * k)         by above
7190   = (a ** (ord a)) ** k        by group_exp_mult
7191   = (#e) ** k                  by order_property
7192   = #e                         by group_id_exp
7193*)
7194Theorem finite_group_Fermat:
7195    !(g:'a group) a. FiniteGroup g /\ a IN G ==> (a ** (CARD G) = #e)
7196Proof
7197  rpt (stripDup[FiniteGroup_def]) >>
7198  `(ord a) divides (CARD G)` by rw[group_order_divides] >>
7199  `?k. CARD G = (ord a) * k` by rw[GSYM divides_def] >>
7200  metis_tac[group_exp_mult, group_id_exp, order_property]
7201QED
7202
7203(* Theorem: x IN (Gen a) ==> (x ** (CARD (Gen a)) = #e) *)
7204(* Proof:
7205   Given FiniteGroup g /\ a IN G
7206      so FiniteGroup (gen a)             by generated_finite_group
7207     ==> (gen a).exp x (CARD (Gen a)) = (gen a).id
7208                                         by finite_group_Fermat
7209     Now (gen a).id = #e                 by generated_property
7210     and !n. (gen a).exp x n = x ** n    by generated_exp
7211   The result follows.
7212*)
7213Theorem generated_Fermat:
7214    !(g:'a group) a. FiniteGroup g /\ a IN G ==>
7215   !x. x IN (Gen a) ==> (x ** (CARD (Gen a)) = #e)
7216Proof
7217  rpt strip_tac >>
7218  `FiniteGroup (gen a)` by rw[generated_finite_group] >>
7219  `(gen a).id = #e` by rw[generated_property] >>
7220  `!n. (gen a).exp x n = x ** n` by rw[generated_exp] >>
7221  metis_tac[finite_group_Fermat]
7222QED
7223
7224(* Theorem: Group g /\ x IN G /\ 0 < ord x ==>
7225           !n m. (x ** n = x ** m) <=> (n MOD (ord x) = m MOD (ord x)) *)
7226(* Proof:
7227   Note x ** n = x ** (n MOD (ord x))    by group_exp_mod
7228    and x ** m = x ** (m MOD (ord x))    by group_exp_mod
7229   If part: x ** n = x ** m ==> n MOD ord x = m MOD ord x
7230      Since n MOD ord x < ord x          by MOD_LESS
7231        and m MOD ord x < ord x          by MOD_LESS
7232        ==> n MOD ord x = m MOD ord x    by group_exp_equal
7233   Only-if part: trivially true.
7234*)
7235Theorem group_exp_eq_condition:
7236    !(g:'a group) x. Group g /\ x IN G /\ 0 < ord x ==>
7237     !n m. (x ** n = x ** m) <=> (n MOD (ord x) = m MOD (ord x))
7238Proof
7239  metis_tac[group_exp_mod, group_exp_equal, MOD_LESS]
7240QED
7241
7242(* ------------------------------------------------------------------------- *)
7243(* Finite Group Order                                                        *)
7244(* ------------------------------------------------------------------------- *)
7245
7246(* Theorem: Group g /\ x IN G /\ 0 < ord x ==>
7247            !k. (ord (x ** k) = ord x) <=> coprime k (ord x) *)
7248(* Proof:
7249   If part: ord (x ** k) = ord x ==> coprime k (ord x)
7250       Note ord (x ** k) * gcd k (ord x) = ord x       by group_order_power, GCD_SYM
7251         or      (ord x) * gcd k (ord x) = ord x       by ord (x ** k) = ord x
7252         or      (ord x) * gcd k (ord x) = ord x * 1   by MULT_RIGHT_1
7253        Therefore gcd k (ord x) = 1                    by MULT_RIGHT_ID
7254               or coprime k (ord x)                    by notation
7255   Only-if part: coprime k (ord x) ==> ord (x ** k) = ord x
7256       Note ord (x ** k) * gcd k (ord x) = ord x       by group_order_power, GCD_SYM
7257        but coprime k (ord x) means gcd k (ord x) = 1  by notation
7258      Hence ord (x ** k) = ord x                       by MULT_RIGHT_1
7259*)
7260Theorem group_order_power_eq_order:
7261    !(g:'a group) x. Group g /\ x IN G /\ 0 < ord x ==>
7262   !k. (ord (x ** k) = ord x) <=> coprime k (ord x)
7263Proof
7264  rpt strip_tac >>
7265  `ord (x ** k) * gcd k (ord x) = ord x` by metis_tac[group_order_power, GCD_SYM] >>
7266  rw[EQ_IMP_THM] >-
7267  metis_tac[MULT_RIGHT_ID] >>
7268  fs[]
7269QED
7270
7271(* Theorem: Group g /\ x IN G /\ 0 < ord x /\ n divides (ord x) ==>
7272            (ord (x ** ((ord x) DIV n)) = n) *)
7273(* Proof:
7274   Let m = ord x, k = m DIV n.
7275   Note n divides m ==> 0 < n        by ZERO_DIVIDES, m <> 0
7276    and n divides m ==> m = k * n    by DIVIDES_EQN, 0 < n
7277   thus k <> 0                       by MULT_0, m <> 0
7278    Now ord (x ** k) * gcd m k = m   by group_order_power
7279    but m = n * k                    by MULT_COMM
7280     so gcd m k = k                  by GCD_MULTIPLE_ALT
7281  Hence ord (x ** k) = n             by EQ_MULT_RCANCEL
7282*)
7283Theorem group_order_exp_cofactor:
7284    !(g:'a group) x n. Group g /\ x IN G /\ 0 < ord x /\ n divides (ord x) ==>
7285        (ord (x ** ((ord x) DIV n)) = n)
7286Proof
7287  rpt strip_tac >>
7288  qabbrev_tac `m = ord x` >>
7289  qabbrev_tac `k = m DIV n` >>
7290  `ord (x ** k) * gcd m k = m` by rw[group_order_power, Abbr`m`] >>
7291  `m <> 0` by decide_tac >>
7292  `n <> 0` by metis_tac[ZERO_DIVIDES] >>
7293  `m = k * n` by rw[GSYM DIVIDES_EQN, Abbr`k`] >>
7294  `_ = n * k` by rw[MULT_COMM] >>
7295  `k <> 0` by metis_tac[MULT_0] >>
7296  metis_tac[GCD_MULTIPLE_ALT, EQ_MULT_RCANCEL]
7297QED
7298
7299(* ------------------------------------------------------------------------- *)
7300(* Roots of Unity form a Subgroup                                            *)
7301(* ------------------------------------------------------------------------- *)
7302
7303(* Define n-th roots of unity *)
7304Definition roots_of_unity_def:
7305  roots_of_unity (g:'a group) (n:num):'a group =
7306     <| carrier := {x | x IN G /\ (x ** n = #e)};
7307             op := g.op;
7308             id := #e
7309      |>
7310End
7311(* Overload root of unity *)
7312Overload uroots = ``roots_of_unity g``
7313
7314(*
7315> roots_of_unity_def;
7316val it = |- !g n. uroots n = <|carrier := {x | x IN G /\ (x ** n = #e)}; op := $*; id := #e|>: thm
7317*)
7318
7319(* Theorem: x IN (uroots n).carrier <=> x IN G /\ (x ** n = #e) *)
7320(* Proof: by roots_of_unity_def *)
7321Theorem roots_of_unity_element:
7322    !g:'a group. !n x. x IN (uroots n).carrier <=> x IN G /\ (x ** n = #e)
7323Proof
7324  rw[roots_of_unity_def]
7325QED
7326
7327(* Theorem: (uroots n).carrier SUBSET G *)
7328(* Proof: by roots_of_unity_element, SUBSET_DEF. *)
7329Theorem roots_of_unity_subset:
7330    !g:'a group. !n. (uroots n).carrier SUBSET G
7331Proof
7332  rw[roots_of_unity_element, SUBSET_DEF]
7333QED
7334
7335(* Theorem: (uroots 0).carrier = G *)
7336(* Proof:
7337   (uroots 0).carrier = {x | x IN G /\ (x ** 0 = #e)}   by roots_of_unity_def
7338   Since   x ** 0 = #e                                  by group_exp_0
7339   (uroots 0).carrier = {x | x IN G /\ T} = G           by EXTENSION
7340*)
7341Theorem roots_of_unity_0:
7342    !g:'a group. (uroots 0).carrier = G
7343Proof
7344  rw[roots_of_unity_def]
7345QED
7346
7347(* Theorem: #e IN (uroots n).carrier *)
7348(* Proof: by group_id_exp. *)
7349Theorem group_uroots_has_id:
7350    !g:'a group. Group g ==> !n. #e IN (uroots n).carrier
7351Proof
7352  rw[roots_of_unity_def]
7353QED
7354
7355(* Theorem: AbelianGroup g ==> uroots n <= g *)
7356(* Proof:
7357   By subgroup_alt, roots_of_unity_def, this is to show:
7358   (1) ?x. x IN G /\ (x ** n = #e)
7359       Since #e IN G   by group_id_element
7360       This is true    by group_id_exp
7361   (2) x ** n = #e /\ y ** n = #e ==> (x * |/ y) ** n = #e
7362         (x * |/ y) ** n
7363       = (x ** n) * ( |/ y) ** n   by group_comm_op_exp
7364       = (x ** n) * |/ (y ** n)    by group_inv_exp
7365       = #e * |/ #e                by x, y IN uroots n
7366       = #e * #e                   by group_inv_exp
7367       = #e                        by group_id_id
7368*)
7369Theorem group_uroots_subgroup:
7370    !g:'a group. AbelianGroup g ==> !n. uroots n <= g
7371Proof
7372  rw[AbelianGroup_def] >>
7373  rw[subgroup_alt, roots_of_unity_def, EXTENSION, SUBSET_DEF] >-
7374  metis_tac[group_id_element, group_id_exp] >>
7375  rw[group_inv_exp, group_inv_id, group_comm_op_exp]
7376QED
7377
7378(* Theorem: AbelianGroup g ==> !n. Group (uroots n) *)
7379(* Proof: by group_uroots_subgroup, Subgroup_def *)
7380Theorem group_uroots_group:
7381  !g:'a group. AbelianGroup g ==> !n. Group (uroots n)
7382Proof
7383  metis_tac[group_uroots_subgroup, Subgroup_def]
7384QED
7385
7386(* Is this true: Group g ==> !n. Group (uroots n) *)
7387(* No? *)
7388
7389(* Theorem: AbelianGroup g ==> !n. Group (uroots n) *)
7390(* Proof:
7391   By roots_of_unity_def, group_def_alt, this is to show:
7392   (1) x ** n = #e /\ y ** n = #e ==> (x * y) ** n = #e,  true by group_comm_op_exp
7393   (2) z * (x * y) = x * (y * z)
7394         z * (x * y)
7395       = (z * x) * y            by group_assoc
7396       = (x * z) * y            by commutativity condition
7397       = x * (z * y)            by group_assoc
7398       = x * (y * z)            by commutativity condition
7399   (3) x ** n = #e ==> ?y. (y IN G /\ (y ** n = #e)) /\ (y * x = #e)
7400       Let m = ord x.
7401       Then m divides n         by group_order_divides_exp
7402       Note ord ( |/ x) = m     by group_inv_order
7403       Thus ( |/ x) ** n = #e   by group_order_divides_exp
7404       Take y = |/ x, then true by group_linv
7405*)
7406Theorem group_uroots_group[allow_rebind]:
7407  !g:'a group. AbelianGroup g ==> !n. Group (uroots n)
7408Proof
7409  rw[AbelianGroup_def] >>
7410  rw[roots_of_unity_def, group_def_alt]
7411  >- rw[group_comm_op_exp]
7412  >- metis_tac[group_assoc] >>
7413  metis_tac[group_order_divides_exp, group_inv_order, group_linv,
7414            group_inv_element]
7415QED
7416
7417(* ------------------------------------------------------------------------- *)
7418(* Subgroup generated by a subset of a Group.                                *)
7419(* ------------------------------------------------------------------------- *)
7420
7421(* Define the group generated by a subset of the group carrier *)
7422Definition Generated_subset_def:
7423    Generated_subset (g:'a group) (s:'a -> bool) =
7424        <|carrier := BIGINTER (IMAGE (\h. H) {h | h <= g /\ s SUBSET H}); op := g.op; id := #e|>
7425End
7426(* Note: this is the minimal subgroup containing the subset. *)
7427(* Similar to subgroup_big_intersect_def in subgroup theory. *)
7428Overload gen_set = ``Generated_subset (g:'a group)``
7429
7430(* Theorem: ((gen_set s).carrier = BIGINTER (IMAGE (\h. H) {h | h <= g /\ s SUBSET H})) /\
7431            ((gen_set s).op = g.op) /\ ((gen_set s).id = #e) *)
7432(* Proof: by Generated_subset_def *)
7433Theorem Generated_subset_property:
7434    !(g:'a group) s. ((gen_set s).carrier = BIGINTER (IMAGE (\h. H) {h | h <= g /\ s SUBSET H})) /\
7435                    ((gen_set s).op = g.op) /\ ((gen_set s).id = #e)
7436Proof
7437  rw[Generated_subset_def]
7438QED
7439
7440(* Theorem: s SUBSET (gen_set s).carrier *)
7441(* Proof: by Generated_subset_def, SUBSET_DEF *)
7442Theorem Generated_subset_has_set:
7443    !(g:'a group) s. s SUBSET (gen_set s).carrier
7444Proof
7445  rw[Generated_subset_def, SUBSET_DEF] >>
7446  simp[]
7447QED
7448
7449(* Theorem: Group g /\ s SUBSET G ==> (gen_set s).carrier SUBSET G *)
7450(* Proof:
7451   By Generated_subset_def, this is to show:
7452      BIGINTER (IMAGE (\h. H) {h | h <= g /\ s SUBSET H}) SUBSET G
7453   By BIGINTER_SUBSET, this is to show:
7454      ?t. t IN IMAGE (\h. H) {h | h <= g /\ s SUBSET H} /\ t SUBSET G
7455   By IN_IMAGE, this is,
7456      ?t. (?h. t = H /\ h <= g /\ s SUBSET H) /\ t SUBSET G
7457   or ?h. h <= g /\ s SUBSET H     by subgroup_carrier_subset
7458   Take h = g,
7459   Then g <= g                     by subgroup_refl
7460    and s SUBSET G                 by given
7461*)
7462Theorem Generated_subset_subset:
7463  !(g:'a group) s. Group g /\ s SUBSET G ==> (gen_set s).carrier SUBSET G
7464Proof
7465  rw[Generated_subset_def] >>
7466  irule BIGINTER_SUBSET >>
7467  csimp[subgroup_carrier_subset, PULL_EXISTS] >>
7468  metis_tac[subgroup_refl]
7469QED
7470
7471(* Theorem: Group g /\ s SUBSET G ==> Group (gen_set s) *)
7472(* Proof:
7473   Let t = {h | h <= g /\ s SUBSET H}.
7474   By group_def_alt, Generated_subset_def, this is to show:
7475   (1) h IN t ==> x * y IN H
7476       Note h <= g                by definition of t
7477       Thus x IN H /\ y IN H      by implication
7478        ==> h.op x y IN H         by subgroup_property, group_op_element
7479         or x * y IN H            by subgroup_property
7480   (2) x * y * z = x * (y * z)
7481       Note g <= g                       by subgroup_refl
7482         so g IN t                       by definition of t
7483       Thus x IN G /\ y IN G /\ z IN G   by implication
7484       The result follows                by group_assoc
7485   (3) h IN t ==> #e IN H
7486       Note h <= g                by definition of t
7487        ==> h.id IN H             by subgroup_property, group_id_element
7488         or #e IN H               by subgroup_id
7489   (4) #e * x = x
7490       Note g <= g                by subgroup_refl
7491         so g IN t                by definition of t
7492       Thus x IN G                by implication
7493       The result follows         by group_id
7494   (5) ?y. (!P. (?h. (P = H) /\ h IN {h | h <= g /\ s SUBSET H}) ==> y IN P) /\ (y * x = #e)
7495       Note g <= g                by subgroup_refl
7496         so g IN t                by definition of t
7497       Thus x IN G                by implication
7498        ==> |/ x IN G             by group_inv_element
7499        and ( |/ x) * x = #e      by group_linv
7500       Let y = |/ x.
7501       Need to show: h IN t ==> y IN H.
7502       But h IN t ==> h <= g      by definition of t
7503       Thus x IN H                by implication
7504         so h.inv x IN H          by subgroup_property, group_inv_element
7505         or |/ x = y IN H         by subgroup_inv
7506*)
7507Theorem Generated_subset_group:
7508    !(g:'a group) s. Group g /\ s SUBSET G ==> Group (gen_set s)
7509Proof
7510  rpt strip_tac >>
7511  rw_tac std_ss[group_def_alt, Generated_subset_def, IN_BIGINTER, IN_IMAGE] >| [
7512    `h <= g` by fs[] >>
7513    `x IN H /\ y IN H` by metis_tac[] >>
7514    metis_tac[subgroup_property, group_op_element],
7515    `g <= g` by rw[subgroup_refl] >>
7516    `g IN {h | h <= g /\ s SUBSET H}` by rw[] >>
7517    `x IN G /\ y IN G /\ z IN G` by metis_tac[] >>
7518    rw[group_assoc],
7519    `h <= g` by fs[] >>
7520    metis_tac[subgroup_property, subgroup_id, group_id_element],
7521    `g <= g` by rw[subgroup_refl] >>
7522    `g IN {h | h <= g /\ s SUBSET H}` by rw[] >>
7523    `x IN G` by metis_tac[] >>
7524    rw[],
7525    `g <= g` by rw[subgroup_refl] >>
7526    `g IN {h | h <= g /\ s SUBSET H}` by rw[] >>
7527    `x IN G` by metis_tac[] >>
7528    `|/ x IN G` by rw[] >>
7529    `( |/ x) * x = #e` by rw[] >>
7530    qexists_tac `|/ x` >>
7531    rw[] >>
7532    `h IN {h | h <= g /\ s SUBSET H}` by rw[] >>
7533    `x IN H` by metis_tac[] >>
7534    metis_tac[subgroup_property, subgroup_inv, group_inv_element]
7535  ]
7536QED
7537
7538(* Theorem: Group g /\ s SUBSET G ==> (gen_set s) <= g *)
7539(* Proof:
7540   By Subgroup_def, this is to show:
7541   (1) Group (gen_set s), true              by Generated_subset_group
7542   (2) (gen_set s).carrier SUBSET G, true   by Generated_subset_subset
7543   (3) (gen_set s).op = $*, true            by Generated_subset_property
7544*)
7545Theorem Generated_subset_subgroup:
7546    !(g:'a group) s. Group g /\ s SUBSET G ==> (gen_set s) <= g
7547Proof
7548  rw[Subgroup_def] >-
7549  rw[Generated_subset_group] >-
7550  rw[Generated_subset_subset] >>
7551  rw[Generated_subset_property]
7552QED
7553
7554(* Theorem: Group g /\ s SUBSET G ==> (gen_set s) <= g *)
7555(* Proof: by Generated_subset_def, monoid_exp_def, FUN_EQ_THM *)
7556Theorem Generated_subset_exp:
7557    !(g:'a group) s. (gen_set s).exp = g.exp
7558Proof
7559  rw[Generated_subset_def, monoid_exp_def, FUN_EQ_THM]
7560QED
7561
7562(* Theorem: FiniteGroup g /\ a IN G ==> (gen_set (Gen a) = gen a) *)
7563(* Proof:
7564   By Generated_def, Generated_subset_def, SUBSET_DEF, EXTENSION,
7565   this is to show:
7566   (1) a IN G /\
7567       !P. (?h. (!x. (x IN P ==> x IN H) /\ (x IN H ==> x IN P)) /\
7568                h <= g /\ !x. (?k. x = a ** k) ==> x IN H) ==> x IN P
7569       ==> ?k. x = a ** k
7570       Take P = Gen a, and h = gen a.
7571       Note h <= g             by generated_subgroup
7572        and ?k. x = a ** k     by generated_element
7573       Take this k, the result follows.
7574   (2) a IN G /\ !x. (?k. x = a ** k) ==> x IN H /\
7575                 !x'. (x' IN P ==> x' IN H) /\ (x' IN H ==> x' IN P)
7576       ==> a ** k IN P
7577       Let x = a ** k.
7578       Note x IN H       by the first implication,
7579       Thus x IN P       by the second implication.
7580*)
7581Theorem Generated_subset_gen:
7582    !(g:'a group) a. FiniteGroup g /\ a IN G ==> (gen_set (Gen a) = gen a)
7583Proof
7584  rpt (stripDup[FiniteGroup_def]) >>
7585  rw[Generated_def, Generated_subset_def, SUBSET_DEF, EXTENSION] >>
7586  rw[EQ_IMP_THM] >| [
7587    last_x_assum (qspecl_then [`Gen a`] strip_assume_tac) >>
7588    `gen a <= g` by rw[generated_subgroup] >>
7589    metis_tac[generated_element],
7590    metis_tac[]
7591  ]
7592QED
7593
7594(* ------------------------------------------------------------------------- *)
7595(* Finite Group Theory Documentation                                         *)
7596(* ------------------------------------------------------------------------- *)
7597(* Overloading (# is temporary):
7598   s1 o s2             = subset_cross (g:'a group) s1 s2
7599   h1 o h2             = subgroup_cross (g:'a group) h1 h2
7600   left z              = subset_cross_left g s1 s2 z
7601   right z             = subset_cross_right g s1 s2 z
7602   independent g a b   = (Gen a) INTER (Gen b) = {#e}
7603   sgbcross B          = subgroup_big_cross (g:'a group) B
7604   ssbcross B          = subset_big_cross (g:'a group) B
7605*)
7606(* Definitions and Theorems (# are exported):
7607
7608   Helper Theorems:
7609
7610   Cross Product of Subset and Subgroup:
7611   make_group_def         |- !g s. make_group g s = <|carrier := s; op := $*; id := #e|>
7612   make_group_property    |- !g s. ((make_group g s).carrier = s) /\
7613                                   ((make_group g s).op = $* ) /\
7614                                   ((make_group g s).id = #e)
7615
7616   subset_cross_def          |- !g s1 s2. s1 o s2 = {x * y | x IN s1 /\ y IN s2}
7617   subset_cross_element      |- !g s1 s2 x y. x IN s1 /\ y IN s2 ==> x * y IN s1 o s2
7618   subset_cross_element_iff  |- !g s1 s2 z. z IN s1 o s2 <=> ?x y. x IN s1 /\ y IN s2 /\ (z = x * y)
7619   subset_cross_alt          |- !g s1 s2. s1 o s2 = IMAGE (\(x,y). x * y) (s1 CROSS s2)
7620
7621   subgroup_cross_def        |- !g h1 h2. h1 o h2 = make_group g (h1.carrier o h2.carrier)
7622   subgroup_cross_property   |- !g h1 h2. ((h1 o h2).carrier = h1.carrier o h2.carrier) /\
7623                                          ((h1 o h2).op = $* ) /\ ((h1 o h2).id = #e)
7624   subgroup_test_by_cross    |- !g. Group g ==> !h. h <= g <=>
7625                                    H <> {} /\ H SUBSET G /\ (h o h = h) /\ (IMAGE |/ H = H)
7626
7627   Subset Cross Properties:
7628   subset_cross_assoc      |- !g. Group g ==>
7629                              !s1 s2 s3. s1 SUBSET G /\ s2 SUBSET G /\ s3 SUBSET G ==>
7630                                         ((s1 o s2) o s3 = s1 o s2 o s3)
7631   subset_cross_self       |- !g h. h <= g ==> (H o H = H)
7632   subset_cross_comm       |- !g. AbelianGroup g ==> !s1 s2. s1 SUBSET G /\ s2 SUBSET G ==> (s1 o s2 = s2 o s1)
7633   subset_cross_subset     |- !g. Group g ==> !s1 s2. s1 SUBSET G /\ s2 SUBSET G ==> s1 o s2 SUBSET G
7634   subset_cross_inv        |- !g. Group g ==> !s1 s2. s1 SUBSET G /\ s2 SUBSET G ==>
7635                                              (IMAGE |/ (s1 o s2) = IMAGE |/ s2 o IMAGE |/ s1)
7636   subset_cross_finite     |- !g s1 s2. FINITE s1 /\ FINITE s2 ==> FINITE (s1 o s2)
7637
7638   Subgroup Cross Properties:
7639   subgroup_cross_assoc    |- !g h1 h2 h3. h1 <= g /\ h2 <= g /\ h3 <= g ==> ((h1 o h2) o h3 = h1 o h2 o h3)
7640   subgroup_cross_self     |- !g h. h <= g ==> (h o h = h)
7641   subgroup_cross_comm     |- !g. AbelianGroup g ==> !h1 h2. h1 <= g /\ h2 <= g ==> (h1 o h2 = h2 o h1)
7642   subgroup_cross_subgroup |- !g h1 h2. h1 <= g /\ h2 <= g /\ (h1 o h2 = h2 o h1) ==> h1 o h2 <= g
7643   subgroup_cross_group    |- !g h1 h2. h1 <= g /\ h2 <= g /\ (h1 o h2 = h2 o h1) ==> Group (h1 o h2)
7644   abelian_subgroup_cross_subgroup   |- !g. AbelianGroup g ==> !h1 h2. h1 <= g /\ h2 <= g ==> h1 o h2 <= g
7645   subgroup_cross_finite   |- !g h1 h2. h1 <= g /\ h2 <= g /\ (h1 o h2 = h2 o h1) /\ FiniteGroup h1 /\
7646                              FiniteGroup h2 ==> FiniteGroup (h1 o h2)
7647   abelian_subgroup_cross_finite     |- !g. AbelianGroup g ==>
7648                                        !h1 h2. h1 <= g /\ h2 <= g /\ FiniteGroup h1 /\ FiniteGroup h2 ==>
7649                                        FiniteGroup (h1 o h2)
7650
7651   Subgroup Cross Cardinality:
7652   subset_cross_left_right_def         |- !g s1 s2 z. z IN s1 o s2 ==>
7653                                          left z IN s1 /\ right z IN s2 /\ (z = left z * right z)
7654   subset_cross_to_preimage_cross_bij  |- !g h1 h2. h1 <= g /\ h2 <= g ==>
7655                                          (let s1 = h1.carrier in let s2 = h2.carrier in
7656                                           let f (x,y) = x * y in
7657                                          !z. z IN s1 o s2 ==>
7658                                              BIJ (\d. (left z * d,|/ d * right z)) (s1 INTER s2)
7659                                                                    (preimage f (s1 CROSS s2) z))
7660   subset_cross_partition_property     |- !g h1 h2. h1 <= g /\ h2 <= g /\ FINITE G ==>
7661                                             (let s1 = h1.carrier in let s2 = h2.carrier in
7662                                              let f (x,y) = x * y in
7663                                          !t. t IN partition (feq f) (s1 CROSS s2) ==>
7664                                              (CARD t = CARD (s1 INTER s2)))
7665   subset_cross_element_preimage_card  |- !g h1 h2. h1 <= g /\ h2 <= g /\ FINITE G ==>
7666                                          (let s1 = h1.carrier in let s2 = h2.carrier in
7667                                           let f (x,y) = x * y in
7668                                          !z. z IN s1 o s2 ==>
7669                                          (CARD (preimage f (s1 CROSS s2) z) = CARD (s1 INTER s2)))
7670   subset_cross_preimage_inj   |- !g s1 s2. INJ (preimage (\(x,y). x * y) (s1 CROSS s2)) (s1 o s2)
7671                                                                            univ(:'a # 'a -> bool)
7672   subgroup_cross_card_eqn     |- !g h1 h2. h1 <= g /\ h2 <= g /\ FINITE G ==>
7673                                  (let s1 = h1.carrier in let s2 = h2.carrier in
7674                                   CARD (h1 o h2).carrier * CARD (s1 INTER s2) = CARD s1 * CARD s2)
7675   subgroup_cross_card         |- !g h1 h2. h1 <= g /\ h2 <= g /\ FINITE G ==>
7676                                  (let s1 = h1.carrier in let s2 = h2.carrier in
7677                                   CARD (h1 o h2).carrier = CARD s1 * CARD s2 DIV CARD (s1 INTER s2))
7678
7679   Finite Group Generators:
7680   independent_sym                 |- !g a b. independent g a b <=> independent g b a
7681   independent_generated_eq        |- !g. Group g ==> !a b. a IN G /\ b IN G /\ independent g a b ==>
7682                                                      ((gen a = gen b) <=> (a = b))
7683   independent_generator_2_card    |- !g. FiniteGroup g ==> !a b. a IN G /\ b IN G /\ independent g a b ==>
7684                                          (CARD (gen a o gen b).carrier = ord a * ord b)
7685
7686   all_subgroups_def          |- !g. all_subgroups g = {h | h <= g}
7687   all_subgroups_element      |- !g h. h IN all_subgroups g <=> h <= g
7688   all_subgroups_subset       |- !g. Group g ==> IMAGE (\h. H) (all_subgroups g) SUBSET POW G
7689   all_subgroups_has_gen_id   |- !g. Group g ==> gen #e IN all_subgroups g
7690   all_subgroups_finite       |- !g. FiniteGroup g ==> FINITE (all_subgroups g)
7691   generated_image_subset_all_subgroups    |- !g. FiniteGroup g ==>
7692                                              !s. s SUBSET G ==> IMAGE gen s SUBSET all_subgroups g
7693   generated_image_subset_power_set       |- !g. Group g ==> !s. s SUBSET G ==> IMAGE (\a. Gen a) s SUBSET POW G
7694
7695   subset_cross_closure_comm_assoc_fun    |- !g. AbelianGroup g ==> closure_comm_assoc_fun $o (POW G)
7696   subgroup_cross_closure_comm_assoc_fun  |- !g. AbelianGroup g ==> closure_comm_assoc_fun $o (all_subgroups g)
7697
7698   Big Cross of Subsets:
7699   subset_big_cross_def         |- !g B. ssbcross B = ITSET $o B {#e}
7700   subset_big_cross_empty       |- !g. ssbcross {} = {#e}
7701   subset_big_cross_thm         |- !g. FiniteAbelianGroup g ==> !B. B SUBSET POW G ==>
7702                                   !s. s SUBSET G ==> (ssbcross (s INSERT B) = s o ssbcross (B DELETE s))
7703   subset_big_cross_insert      |- !g. FiniteAbelianGroup g ==> !B. B SUBSET POW G ==>
7704                                   !s. s SUBSET G /\ s NOTIN B ==> (ssbcross (s INSERT B) = s o ssbcross B)
7705
7706   Big Cross of Subgroups:
7707   subgroup_big_cross_def       |- !g B. sgbcross B = ITSET $o B (gen #e)
7708   subgroup_big_cross_empty     |- !g. sgbcross {} = gen #e
7709   subgroup_big_cross_thm       |- !g. FiniteAbelianGroup g ==> !B. B SUBSET all_subgroups g ==>
7710                                   !h. h IN all_subgroups g ==> (sgbcross (h INSERT B) = h o sgbcross (B DELETE h))
7711   subgroup_big_cross_insert    |- !g. FiniteAbelianGroup g ==> !B. B SUBSET all_subgroups g ==>
7712                                   !h. h IN all_subgroups g /\ h NOTIN B ==> (sgbcross (h INSERT B) = h o sgbcross B)
7713
7714*)
7715
7716(* ------------------------------------------------------------------------- *)
7717(* Helper Theorems                                                           *)
7718(* ------------------------------------------------------------------------- *)
7719
7720(* ------------------------------------------------------------------------- *)
7721(* Cross Product of Subset and Subgroup                                      *)
7722(* ------------------------------------------------------------------------- *)
7723
7724(* Given a Group g, and a subset s, make a group by inheriting op and id. *)
7725Definition make_group_def:
7726    make_group (g:'a group) (s:'a -> bool) =
7727       <| carrier := s;
7728               op := g.op;
7729               id := g.id
7730        |>
7731End
7732
7733(* Theorem: Properties of make_group g s *)
7734(* Proof: by make_group_def *)
7735Theorem make_group_property:
7736    !(g:'a group) s. ((make_group g s).carrier = s) /\
7737                    ((make_group g s).op = g.op) /\
7738                    ((make_group g s).id = g.id)
7739Proof
7740  rw[make_group_def]
7741QED
7742
7743(* Given two subsets, define their cross-product, or direct product *)
7744Definition subset_cross_def:
7745    subset_cross (g:'a group) (s1:'a -> bool) (s2:'a -> bool) =
7746       {x * y | x IN s1 /\ y IN s2}
7747End
7748
7749(* Overload subset cross product *)
7750Overload o = ``subset_cross (g:'a group)``
7751(*
7752> subset_cross_def;
7753val it = |- !g s1 s2. s1 o s2 = {x * y | x IN s1 /\ y IN s2}: thm
7754*)
7755
7756(* Theorem: x IN s1 /\ y IN s2 ==> x * y IN s1 o s2 *)
7757(* Proof: by subset_cross_def *)
7758Theorem subset_cross_element:
7759    !g:'a group. !s1 s2. !x y. x IN s1 /\ y IN s2 ==> x * y IN s1 o s2
7760Proof
7761  rw[subset_cross_def] >>
7762  metis_tac[]
7763QED
7764
7765(* Theorem: z IN s1 o s2 <=> ?x y. x IN s1 /\ y IN s2 /\ (z = x * y) *)
7766(* Proof:
7767   By subset_cross_def, this ius to show:
7768      (?x y. (z = x * y) /\ x IN s1 /\ y IN s2) <=> ?x y. x IN s1 /\ y IN s2 /\ (z = x * y)
7769   The candidates are just the x, y themselves.
7770*)
7771Theorem subset_cross_element_iff:
7772    !g:'a group. !s1 s2 z. z IN s1 o s2 <=> ?x y. x IN s1 /\ y IN s2 /\ (z = x * y)
7773Proof
7774  rw[subset_cross_def] >>
7775  metis_tac[]
7776QED
7777
7778(* Theorem: s1 o s2 = IMAGE (\(x, y). x * y) (s1 CROSS s2) *)
7779(* Proof:
7780   By subset_cross_def, EXTENSION, this is to show:
7781   (1) x IN s1 /\ y IN s2 ==> ?x'. (x * y = (\(x,y). x * y) x') /\ FST x' IN s1 /\ SND x' IN s2
7782       Take x' = (x, y), this is true by function application.
7783   (2) FST x' IN s1 /\ SND x' IN s2 ==> ?x y. ((\(x,y). x * y) x' = x * y) /\ x IN s1 /\ y IN s2
7784       Let x = FST x', y = SND x', this is true y UNCURRY.
7785*)
7786Theorem subset_cross_alt:
7787    !(g:'a group) s1 s2. s1 o s2 = IMAGE (\(x, y). x * y) (s1 CROSS s2)
7788Proof
7789  rw[subset_cross_def, EXTENSION, EQ_IMP_THM] >| [
7790    qexists_tac `(x', y)` >>
7791    simp[],
7792    qexists_tac `FST x'` >>
7793    qexists_tac `SND x'` >>
7794    simp[pairTheory.UNCURRY]
7795  ]
7796QED
7797
7798(* Given two subgroups, define their cross-product, or direct product *)
7799Definition subgroup_cross_def:
7800    subgroup_cross (g:'a group) (h1:'a group) (h2:'a group) =
7801       make_group g (h1.carrier o h2.carrier)
7802End
7803
7804(* Overload subgroup cross product *)
7805Overload o = ``subgroup_cross (g:'a group)``
7806(*
7807> subgroup_cross_def;
7808val it = |- !g h1 h2. h1 o h2 = make_group g (h1.carrier o h2.carrier): thm
7809*)
7810
7811(* Theorem: ((h1 o h2).carrier = h1.carrier o h2.carrier) /\ ((h1 o h2).op = g.op) /\ ((h1 o h2).id = #e) *)
7812(* Proof: by subgroup_cross_def, make_group_def *)
7813Theorem subgroup_cross_property:
7814    !(g h1 h2):'a group. ((h1 o h2).carrier = h1.carrier o h2.carrier) /\
7815                        ((h1 o h2).op = g.op) /\ ((h1 o h2).id = #e)
7816Proof
7817  rw[subgroup_cross_def, make_group_def]
7818QED
7819
7820(* The following is a reformulation of:
7821subgroup_alt
7822|- !g. Group g ==> !h. h <= g <=>
7823                   H <> {} /\ H SUBSET G /\ (h.op = $* ) /\ (h.id = #e) /\
7824                   !x y. x IN H /\ y IN H ==> x * |/ y IN H: thm
7825*)
7826
7827(* Theorem: Group g ==>
7828            !h. h <= g <=> H <> {} /\ H SUBSET G /\ (h o h = h) /\ (IMAGE ( |/) H = H) *)
7829(* Proof:
7830   If part: h <= g ==> H <> {} /\ H SUBSET G /\ (h o h = h) /\ (IMAGE ( |/) H = H)
7831      This is to show:
7832      (1) h <= g ==> H <> {}, true          by subgroup_carrier_nonempty
7833      (2) h <= g ==> H SUBSET G, true       by subgroup_carrier_subset
7834      (3) h <= g ==> h o h = h
7835          Note (h o h).op = $* = h.op       by subgroup_cross_property, Subgroup_def
7836           and (h o h).id = #e = h.id       by subgroup_cross_property, subgroup_id
7837          Need only to show: H o H = H      by monoid_component_equality
7838          By EXTENSION, this is to show:
7839          (3.1) x IN H /\ y IN H ==> x * y IN H
7840                Note x * y = h.op x y       by subgroup_property
7841                 and h.op x y IN H          by group_op_element
7842          (3.2) z IN H ==> ?x y. z = x * y /\ x IN H /\ y IN H
7843                Note h.id IN H              by group_id_element
7844                Take x = h.id, y = z
7845                Then x * y
7846                   = h.op (h.id) z          by subgroup_property
7847                   = z                      by group_id
7848      (4) h <= g ==> IMAGE ( |/) H = H
7849          By IN_IMAGE, EXTENSION, this is to show:
7850          (4.1) x IN H ==> |/ x IN H
7851                Note |/ x = h.inv x         by subgroup_inv
7852                 and (h.inv x) IN H         by group_inv_element
7853          (4.2) z IN H ==> ?x. (z = |/ x) /\ x IN H
7854                Take x = h.inv z
7855                Then x = h.inv z IN H       by group_inv_element
7856                     |/ x
7857                   = |/ (h.inv z)           by above
7858                   = h.inv (h.inv z)        by subgroup_inv
7859                   = z                      by group_inv_inv
7860
7861   Only-if part: H <> {} /\ H SUBSET G /\ (h o h = h) /\ (IMAGE ( |/) H = H) ==> h <= g
7862      By subgroup_alt, this is to show:
7863      (1) h o h = h ==> h.op = $*
7864            h.op
7865          = (h o h).op                      by monoid_component_equality
7866          = $*                              by subgroup_cross_property
7867      (2) h o h = h ==> h.id = #e
7868            h.id
7869          = (h o h).id                      by monoid_component_equality
7870          = #e                              by subgroup_cross_property
7871      (3) h o h = h /\ IMAGE |/ H = H /\ x IN H /\ y IN H ==> x * |/ y IN H
7872          Note |/ y IN IMAGE |/ H           by IN_IMAGE
7873            or |/ y IN H                    by H = IMAGE |/ H
7874            so x * |/ y IN H o H            by subset_cross_element
7875            or x * |/ y IN H                by subgroup_cross_property
7876*)
7877Theorem subgroup_test_by_cross:
7878    !g:'a group. Group g ==>
7879   !h. h <= g <=> H <> {} /\ H SUBSET G /\ (h o h = h) /\ (IMAGE ( |/) H = H)
7880Proof
7881  rw[EQ_IMP_THM] >-
7882  metis_tac[subgroup_carrier_nonempty] >-
7883  rw[subgroup_carrier_subset] >-
7884 (pop_assum mp_tac >>
7885  stripDup[Subgroup_def] >>
7886  `h.id = #e` by rw[subgroup_id] >>
7887  rw[subgroup_cross_property, subset_cross_def, monoid_component_equality, EXTENSION, EQ_IMP_THM] >-
7888  metis_tac[subgroup_property, group_op_element] >>
7889  metis_tac[subgroup_property, group_id_element, group_id]) >-
7890 (pop_assum mp_tac >>
7891  stripDup[Subgroup_def] >>
7892  `h.id = #e` by rw[subgroup_id] >>
7893  rw[EXTENSION, EQ_IMP_THM] >-
7894  metis_tac[subgroup_inv, group_inv_element] >>
7895  metis_tac[subgroup_inv, group_inv_element, group_inv_inv]) >>
7896  rw[subgroup_alt] >-
7897  fs[subgroup_cross_property, monoid_component_equality] >-
7898  fs[subgroup_cross_property, monoid_component_equality] >>
7899  prove_tac[subgroup_cross_property, subset_cross_element, IN_IMAGE]
7900QED
7901
7902(* ------------------------------------------------------------------------- *)
7903(* Subset Cross Properties                                                   *)
7904(* ------------------------------------------------------------------------- *)
7905
7906(* Theorem: Group g ==> !s1 s2 s3. s1 SUBSET G /\ s2 SUBSET G /\ s3 SUBSET G ==>
7907                        ((s1 o s2) o s3 = s1 o (s2 o s3)) *)
7908(* Proof:
7909   By subset_cross_def, EXTENSION this is to show:
7910   (?x' y. (x = x' * y) /\ (?x'' y. (x' = x'' * y) /\ x'' IN s1 /\ y IN s2) /\ y IN s3) <=>
7911    ?x' y. (x = x' * y) /\ x' IN s1 /\ ?x y'. (y = x * y') /\ x IN s2 /\ y' IN s3
7912   By SUBSET_DEF, the candidates are readily chosen, with equations valid by group_assoc.
7913*)
7914Theorem subset_cross_assoc:
7915    !g:'a group. Group g ==> !s1 s2 s3. s1 SUBSET G /\ s2 SUBSET G /\ s3 SUBSET G ==>
7916       ((s1 o s2) o s3 = s1 o (s2 o s3))
7917Proof
7918  rw[subset_cross_def, EXTENSION] >>
7919  prove_tac[group_assoc, SUBSET_DEF]
7920QED
7921
7922(* Theorem: h <= g ==> (h o h = h) *)
7923(* Proof:
7924   Note Group g /\ Group h         by subgroup_property
7925   By subset_cross_element_iff, EXTENSION, this is to show:
7926   (1) h <= g /\ x IN H /\ y IN H ==> x * y IN H
7927       Note x * y = h.op x y       by subgroup_op
7928        and h.op x y IN H          by group_op_element
7929   (2) z IN H ==> ?x y. x IN H /\ y IN H /\ (z = x * y)
7930       Let x = h.id, y = z.
7931       Then x IN H                 by group_id_element
7932       and x * y = h.op x y        by subgroup_op
7933                 = y               by group_id
7934                 = z               by above
7935*)
7936Theorem subset_cross_self:
7937    !(g h):'a group. h <= g ==> (H o H = H)
7938Proof
7939  rpt strip_tac >>
7940  `Group g /\ Group h` by metis_tac[subgroup_property] >>
7941  rw[subset_cross_element_iff, EXTENSION, EQ_IMP_THM] >-
7942  metis_tac[subgroup_op, group_op_element] >>
7943  metis_tac[subgroup_id, subgroup_op, group_id_element, group_id]
7944QED
7945
7946(* Theorem: AbelianGroup g ==> !s1 s2. s1 SUBSET G /\ s2 SUBSET G ==> (s1 o s2 = s2 o s1) *)
7947(* Proof:
7948   Note Group g                     by AbelianGroup_def
7949    and !x y. x IN G /\ y IN G
7950        ==> (x * y = y * x)         by AbelianGroup_def
7951    s1 o s2
7952  = {x * y | x IN s1 /\ y IN s2}    by subset_cross_def
7953  = {y * x | y IN s2 /\ x IN s1}    by above, SUBSET_DEF
7954  = s2 o s1                         by subset_cross_def
7955*)
7956Theorem subset_cross_comm:
7957    !g:'a group. AbelianGroup g ==> !s1 s2. s1 SUBSET G /\ s2 SUBSET G ==> (s1 o s2 = s2 o s1)
7958Proof
7959  rw[AbelianGroup_def] >>
7960  rw[subset_cross_def, EXTENSION] >>
7961  metis_tac[SUBSET_DEF]
7962QED
7963
7964(* Theorem: Group g ==> !s1 s2. s1 SUBSET G /\ s2 SUBSET G ==> (s1 o s2) SUBSET G *)
7965(* Proof:
7966   By subset_cross_def, SUBSET_DEF, this is to show:
7967       x IN s1 /\ y IN s2 ==> x * y IN G
7968   But x IN s1 ==> x IN G       by SUBSET_DEF, s1 SUBSET G
7969   and y IN s2 ==> y IN G       by SUBSET_DEF, s2 SUBSET G
7970   ==> x * y IN G               by group_op_element
7971*)
7972Theorem subset_cross_subset:
7973    !g:'a group. Group g ==> !s1 s2. s1 SUBSET G /\ s2 SUBSET G ==> (s1 o s2) SUBSET G
7974Proof
7975  rw[subset_cross_def, SUBSET_DEF, pairTheory.EXISTS_PROD] >>
7976  rw[]
7977QED
7978
7979(* Theorem: Group g ==> !s1 s2. s1 SUBSET G /\ s2 SUBSET G ==>
7980            (IMAGE ( |/) (s1 o s2) = (IMAGE ( |/) s2) o (IMAGE ( |/) s1)) *)
7981(* Proof:
7982   By subset_cross_def, SUBSET_DEF, this is to show:
7983      (?x'. (x = |/ x') /\ ?x y. (x' = x * y) /\ x IN s1 /\ y IN s2) <=>
7984      ?x' y. (x = x' * y) /\ (?x''. (x' = |/ x'') /\ x'' IN s2) /\ ?x. (y = |/ x) /\ x IN s1
7985   Both directions are satisfied by group_inv_op:
7986      |- !g. Group g ==> !x y. x IN G /\ y IN G ==> ( |/ (x * y) = |/ y * |/ x)
7987*)
7988Theorem subset_cross_inv:
7989    !g:'a group. Group g ==> !s1 s2. s1 SUBSET G /\ s2 SUBSET G ==>
7990         (IMAGE ( |/) (s1 o s2) = (IMAGE ( |/) s2) o (IMAGE ( |/) s1))
7991Proof
7992  rw[subset_cross_def, SUBSET_DEF, pairTheory.EXISTS_PROD, EXTENSION] >>
7993  metis_tac[group_inv_op]
7994QED
7995
7996(* Theorem: FINITE s1 /\ FINITE s2 ==> FINITE (s1 o s2) *)
7997(* Proof:
7998   Note s1 o s2 = IMAGE (\(x,y). x * y) (s1 CROSS s2)    by subset_cross_alt
7999    and FINITE (s1 CROSS s2)                             by FINITE_CROSS
8000   Thus FINITE (s1 o s2)                                 by IMAGE_FINITE
8001*)
8002Theorem subset_cross_finite:
8003    !g:'a group. !s1 s2. FINITE s1 /\ FINITE s2 ==> FINITE (s1 o s2)
8004Proof
8005  rw[subset_cross_alt]
8006QED
8007
8008(* ------------------------------------------------------------------------- *)
8009(* Subgroup Cross Properties                                                 *)
8010(* ------------------------------------------------------------------------- *)
8011
8012(* Theorem: h1 <= g /\ h2 <= g /\ h3 <= g ==> ((h1 o h2) o h3 = h1 o (h2 o h3)) *)
8013(* Proof:
8014   Note Group g              by subgroup_property
8015    and h1.carrier SUBSET G  by subgroup_carrier_subset, h1 <= g
8016    and h2.carrier SUBSET G  by subgroup_carrier_subset, h2 <= g
8017    and h3.carrier SUBSET G  by subgroup_carrier_subset, h3 <= g
8018   By subgroup_cross_property, monoid_component_equality, this is to show:
8019      (h1.carrier o h2.carrier) o h3.carrier = h1.carrier o (h2.carrier o h3.carrier)
8020   This is true by subset_cross_assoc.
8021*)
8022Theorem subgroup_cross_assoc:
8023    !g:'a group. !h1 h2 h3. h1 <= g /\ h2 <= g /\ h3 <= g ==>
8024       ((h1 o h2) o h3 = h1 o (h2 o h3))
8025Proof
8026  rpt strip_tac >>
8027  `Group g` by metis_tac[subgroup_property] >>
8028  rw[subgroup_cross_property, monoid_component_equality, subgroup_carrier_subset, subset_cross_assoc]
8029QED
8030
8031(* Theorem: h <= g ==> (h o h = h) *)
8032(* Proof:
8033   By subgroup_cross_property, monoid_component_equality, this is to show:
8034   (1) h <= g ==>  H o H = H, true    by subset_cross_self
8035   (2) h <= g ==> $* = h.op, true     by subgroup_op
8036   (3) h <= g ==> #e = h.id, true     by subgroup_id
8037*)
8038Theorem subgroup_cross_self:
8039    !(g h):'a group. h <= g ==> (h o h = h)
8040Proof
8041  rw[subgroup_cross_property, monoid_component_equality] >-
8042  rw[subset_cross_self] >-
8043  rw[subgroup_op] >>
8044  rw[subgroup_id]
8045QED
8046
8047(* Theorem: AbelianGroup g ==> !h1 h2. h1 <= g /\ h2 <= g ==> (h1 o h2 = h2 o h1) *)
8048(* Proof:
8049   Note Group g             by AbelianGroup_def
8050   Let s1 = h1.carrier, s2 = h2.carrier.
8051   By subgroup_cross_property, monoid_component_equality,
8052   this is to show: s1 o s2 = s2 o s1
8053   But s1 SUBSET G          by subgroup_carrier_subset
8054   and s2 SUBSET G          by subgroup_carrier_subset
8055   so s1 o s2 = s2 o s1     by subset_cross_comm
8056*)
8057Theorem subgroup_cross_comm:
8058    !g:'a group. AbelianGroup g ==> !h1 h2. h1 <= g /\ h2 <= g ==> (h1 o h2 = h2 o h1)
8059Proof
8060  rw[AbelianGroup_def, subgroup_cross_property,
8061     monoid_component_equality, subset_cross_comm, subgroup_carrier_subset]
8062QED
8063
8064(* Theorem: h1 <= g /\ h2 <= g /\ (h1 o h2 = h2 o h1) ==> (h1 o h2) <= g *)
8065(* Proof:
8066   Note Group g                   by subgroup_property
8067    and Group h1 /\ Group h2      by subgroup_property
8068   By subgroup_test_by_cross, this is to show:
8069   (1) h1 <= g /\ h2 <= g ==> (h1 o h2).carrier <> {}
8070       Note h1.id IN h1.carrier                        by group_id_element
8071        and h2.id IN h2.carrier                        by group_id_element
8072       Thus h1.id * h2.id IN (h1.carrier o h2.carrier) by subset_cross_element
8073         or h1.id * h2.id IN (h1 o h2).carrier         by subgroup_cross_property
8074         or (h1 o h2).carrier <> {}                    by MEMBER_NOT_EMPTY
8075   (2) h1 <= g /\ h2 <= g ==> (h1 o h2).carrier SUBSET G
8076       Let z IN (h1 o h2).carrier
8077       Then ?x y. x IN h1.carrier /\ y IN h2.carrier
8078       giving z = x * y                                by subgroup_cross_property, subset_cross_element_iff
8079       But x IN G                                      by subgroup_carrier_subset, SUBSET_DEF, h1 <= g
8080       and y IN G                                      by subgroup_carrier_subset, SUBSET_DEF, h2 <= g
8081       ==> x * y IN G or z IN G                        by group_op_element
8082       Thus (h1 o h2).carrier SUBSET G                 by SUBSET_DEF
8083   (3) h1 <= g /\ h2 <= g ==> (h1 o h2) o (h1 o h2) = h1 o h2
8084       Let H = h1.carrier, K = h2.carrier.
8085       Note ((h1 o h2) o (h1 o h2)).op = (h1 o h2).op             by subgroup_cross_property
8086        and ((h1 o h2) o (h1 o h2)).id = (h1 o h2).id             by subgroup_cross_property
8087       Thus by monoid_component_equality, this is
8088            to show:
8089            ((h1 o h2) o (h1 o h2)).carrier = (h1 o h2).carrier   by subgroup_cross_property
8090         or to show: (H o K) o (H o K) = H o K                    by subgroup_cross_property
8091       Note H SUBSET G /\ K SUBSET G      by subgroup_carrier_subset
8092        and H o K = K o H                 by subgroup_cross_property, monoid_component_equality, h1 o h2 = h2 o h1
8093       Also (H o K) SUBSET G              by subset_cross_subset, H SUBSET G, K SUBSET G
8094
8095            (H o K) o (H o K)
8096          = ((H o K) o H) o K             by subset_cross_assoc, (H o K) SUBSET G
8097          = (H o (K o H)) o K             by subset_cross_assoc
8098          = (H o (H o K)) o K             by above
8099          = ((H o H) o K) o K             by subset_cross_assoc
8100          = (H o K) o K                   by subset_cross_self, h1 <= g
8101          = H o (K o K)                   by subset_cross_assoc
8102          = H o K                         by subset_cross_self, h2 <= g
8103   (4) h1 <= g /\ h2 <= g ==> IMAGE |/ (h1 o h2).carrier = (h1 o h2).carrier
8104       Let H = h1.carrier, K = h2.carrier.
8105       Note H SUBSET G /\ K SUBSET G      by subgroup_carrier_subset
8106        and h1 <= g ==> IMAGE |/ H = H    by subgroup_test_by_cross
8107        and h2 <= g ==> IMAGE |/ K = K    by subgroup_test_by_cross
8108
8109         IMAGE |/ (h1 o h2).carrier
8110       = IMAGE |/ (H o K)                 by subgroup_cross_property
8111       = (IMAGE |/ K) o (IMAGE |/ H)      by subset_cross_inv
8112       = K o H                            by above
8113       = H o K                            by subgroup_cross_property, monoid_component_equality, h1 o h2 = h2 o h1
8114       = (h1 o h2).carrier                by subgroup_cross_property
8115*)
8116Theorem subgroup_cross_subgroup:
8117    !(g h1 h2):'a group. h1 <= g /\ h2 <= g /\ (h1 o h2 = h2 o h1) ==> (h1 o h2) <= g
8118Proof
8119  rpt strip_tac >>
8120  `Group g /\ Group h1 /\ Group h2` by metis_tac[subgroup_property] >>
8121  rw[subgroup_test_by_cross] >-
8122  metis_tac[group_id_element, subgroup_cross_property, subset_cross_element, MEMBER_NOT_EMPTY] >-
8123 (rw[SUBSET_DEF] >>
8124  `?y z. y IN h1.carrier /\ z IN h2.carrier /\ (x = y * z)` by metis_tac[subgroup_cross_property, subset_cross_element_iff] >>
8125  `y IN G /\ z IN G` by metis_tac[subgroup_carrier_subset, SUBSET_DEF] >>
8126  rw[]) >-
8127 (qabbrev_tac `h = h1.carrier` >>
8128  qabbrev_tac `k = h2.carrier` >>
8129  `(h o k) o (h o k) = h o k` suffices_by rw[monoid_component_equality, subgroup_cross_property] >>
8130  `h SUBSET G /\ k SUBSET G` by rw[subgroup_carrier_subset, Abbr`h`, Abbr`k`] >>
8131  `h o k = k o h` by fs[subgroup_cross_property, monoid_component_equality, Abbr`h`, Abbr`k`] >>
8132  `(h o k) SUBSET G` by rw[subset_cross_subset] >>
8133  `(h o k) o (h o k) = ((h o k) o h) o k` by rw[subset_cross_assoc] >>
8134  `_ = (h o (k o h)) o k` by rw[GSYM subset_cross_assoc] >>
8135  `_ = (h o (h o k)) o k` by metis_tac[] >>
8136  `_ = ((h o h) o k) o k` by rw[subset_cross_assoc] >>
8137  `_ = (h o k) o k` by metis_tac[subset_cross_self] >>
8138  `_ = h o (k o k)` by rw[subset_cross_assoc] >>
8139  `_ = h o k` by metis_tac[subset_cross_self] >>
8140  rw[]) >>
8141  qabbrev_tac `h = h1.carrier` >>
8142  qabbrev_tac `k = h2.carrier` >>
8143  `h SUBSET G /\ k SUBSET G` by rw[subgroup_carrier_subset, Abbr`h`, Abbr`k`] >>
8144  `IMAGE |/ (h1 o h2).carrier = IMAGE |/ (h o k)` by rw[subgroup_cross_property, Abbr`h`, Abbr`k`] >>
8145  `_ = (IMAGE |/ k) o (IMAGE |/ h)` by rw[subset_cross_inv] >>
8146  `_ = k o h` by metis_tac[subgroup_test_by_cross] >>
8147  `_ = h o k` by metis_tac[subgroup_cross_property, monoid_component_equality] >>
8148  `_ = (h1 o h2).carrier` by rw[subgroup_cross_property, Abbr`h`, Abbr`k`] >>
8149  rw[]
8150QED
8151
8152(* This is a milestone theorem for me! *)
8153(* This is just Lemma X.1 in Appendix of "Finite Group Theory" by Irving Martin Isaacs. *)
8154
8155(* Theorem: h1 <= g /\ h2 <= g /\ (h1 o h2 = h2 o h1) ==> Group (h1 o h2) *)
8156(* Proof: by subgroup_cross_subgroup, subgroup_property *)
8157Theorem subgroup_cross_group:
8158    !(g h1 h2):'a group. h1 <= g /\ h2 <= g /\ (h1 o h2 = h2 o h1) ==> Group (h1 o h2)
8159Proof
8160  metis_tac[subgroup_cross_subgroup, subgroup_property]
8161QED
8162
8163(* Theorem: AbelianGroup g ==> !h1 h2. h1 <= g /\ h2 <= g ==> (h1 o h2) <= g *)
8164(* Proof: by subgroup_cross_comm, subgroup_cross_subgroup *)
8165Theorem abelian_subgroup_cross_subgroup:
8166    !g:'a group. AbelianGroup g ==> !h1 h2. h1 <= g /\ h2 <= g ==> (h1 o h2) <= g
8167Proof
8168  rw[subgroup_cross_comm, subgroup_cross_subgroup]
8169QED
8170
8171(* Theorem: h1 <= g /\ h2 <= g /\ (h1 o h2 = h2 o h1) /\
8172            FiniteGroup h1 /\ FiniteGroup h2 ==> FiniteGroup (h1 o h2) *)
8173(* Proof:
8174   Note Group (h1 o h2)                           by subgroup_cross_group
8175    and FiniteGroup h1 ==> FINITE (h1.carrier)    by FiniteGroup_def
8176    and FiniteGroup h2 ==> FINITE (h2.carrier)    by FiniteGroup_def
8177    ==> FINITE (h1.carrier o h2.carrier)          by subset_cross_finite
8178     or FINITE (h1 o h2).carrier                  by subgroup_cross_property
8179*)
8180Theorem subgroup_cross_finite:
8181    !g:'a group. !h1 h2. h1 <= g /\ h2 <= g /\ (h1 o h2 = h2 o h1) /\
8182                FiniteGroup h1 /\ FiniteGroup h2 ==> FiniteGroup (h1 o h2)
8183Proof
8184  metis_tac[FiniteGroup_def, subgroup_cross_group, subset_cross_finite, subgroup_cross_property]
8185QED
8186
8187(* Theorem: AbelianGroup g ==> !h1 h2. h1 <= g /\ h2 <= g /\
8188            FiniteGroup h1 /\ FiniteGroup h2 ==> FiniteGroup (h1 o h2) *)
8189(* Proof: by subgroup_cross_finite, subgroup_cross_comm. *)
8190Theorem abelian_subgroup_cross_finite:
8191    !g:'a group. AbelianGroup g ==> !h1 h2. h1 <= g /\ h2 <= g /\
8192                FiniteGroup h1 /\ FiniteGroup h2 ==> FiniteGroup (h1 o h2)
8193Proof
8194  rw[subgroup_cross_finite, subgroup_cross_comm]
8195QED
8196
8197(* ------------------------------------------------------------------------- *)
8198(* Subgroup Cross Cardinality                                                *)
8199(* ------------------------------------------------------------------------- *)
8200
8201(* Split element of (s1 o s2) into a left-right pair *)
8202
8203(*
8204subset_cross_element_iff
8205|- !g s1 s2 z. z IN s1 o s2 <=> ?x y. x IN s1 /\ y IN s2 /\ (z = x * y)
8206*)
8207Theorem lemma[local]:
8208    !g:'a group. !(s1 s2):'a -> bool. !z. ?x y. z IN (s1 o s2) ==> x IN s1 /\ y IN s2 /\ (z = x * y)
8209Proof
8210  metis_tac[subset_cross_element_iff]
8211QED
8212
8213(* 2. Apply Skolemization *)
8214val subset_cross_left_right_def = new_specification(
8215   "subset_cross_left_right_def",
8216  ["subset_cross_left", "subset_cross_right"],
8217  SIMP_RULE bool_ss [SKOLEM_THM] lemma);
8218
8219(* overload subset_cross_left and subset_cross_right *)
8220Overload left = ``subset_cross_left (g:'a group) (s1:'a -> bool) (s2:'a -> bool)``
8221Overload right = ``subset_cross_right (g:'a group) (s1:'a -> bool) (s2:'a -> bool)``
8222
8223(*
8224> subset_cross_left_right_def;
8225val it = |- !g s1 s2 z. z IN s1 o s2 ==> left z IN s1 /\ right z IN s2 /\ (z = left z * right z): thm
8226*)
8227
8228(* Picture of BIJECTION:
8229(s1 INTER s2) <-> (preimage f s z)
8230    #e        <-> (left z, right z)
8231    d         <-> ((left z) * d, ( |/ d) * (right z)))
8232*)
8233
8234(* Theorem: h1 <= g /\ h2 <= g ==>
8235            let (s1 = h1.carrier) in let (s2 = h2.carrier) in let (f = (\(x, y). x * y)) in
8236            !z. z IN (s1 o s2) ==>
8237            BIJ (\d. ((left z) * d, ( |/ d) * (right z))) (s1 INTER s2) (preimage f (s1 CROSS s2) z) *)
8238(* Proof:
8239   Let s = s1 CROSS s2.
8240   Note Group g /\ Group h1 /\ Group h2     by subgroup_property
8241    and s1 SUBSET G /\ s2 SUBSET G          by subgroup_carrier_subset
8242    and left z IN s1 /\ right z IN s2       by subset_cross_left_right_def
8243    and !x. x IN s1 ==> x IN G              by SUBSET_DEF, s1 SUBSET G
8244    and !x. x IN s2 ==> x IN G              by SUBSET_DEF, s2 SUBSET G
8245   By BIJ_DEF, INJ_DEF, SURJ_DEF, this is to show:
8246   (1) d IN s1 /\ d IN s2 ==> (left z * d,|/ d * mright z) IN preimage f s z
8247       By in_preimage, IN_CROSS, this is to show:
8248       (1.1) left z * d IN s1
8249             Note (left z) * d
8250                = h.op (left z) d           by subgroup_op
8251             and  h.op (left z) d IN s1     by group_op_element, Group h1
8252       (1.2) |/ d * right z IN s2
8253             With         d IN s2           by given
8254              ==> (h.inv d) IN s2           by group_inv_element, Group h2
8255               or      |/ d IN s2           by subgroup_inv, h2 <= g
8256             Note |/ d * (right z)
8257                = h.op ( |/ d) (right z)                  by subgroup_op
8258             and  h.op ( |/ d) (right z) IN s2            by group_op_element, Group h2
8259       (1.3) left z * d * ( |/ d * right z) = z
8260             Note |/ d IN G                               by group_inv_element
8261                  (left z * d) * ( |/ d * right z)
8262                = ((left z * d) * |/ d) * right z         by group_assoc
8263                = (left z * (d * |/ d)) * right z         by group_assoc
8264                = left z * #e * right z                   by group_rinv
8265                = left z * right z                        by group_rid
8266                = z                                       by subset_cross_left_right_def
8267   (2) d IN s1, s2 /\ d' IN s1, s2 /\ left z * d = left z * d' ==> d = d'
8268       Note left z IN G /\ d IN G /\ d' IN G              by elements in s1 or s2
8269       Thus left z * d = left z * d' ==> d = d'           by group_lcancel
8270   (3) d IN s1 /\ d IN s2 ==> (left z * d,|/ d * mright z) IN preimage f s z, same as (1).
8271   (4) x IN preimage f s z ==> ?d. (d IN s1 /\ d IN s2) /\ ((left z * d,|/ d * right z) = x)
8272       The idea is:
8273       To get:  x = (FST x, SND x) = (left z * d, |/ d * right z)
8274       Use this to solve for d: d = |/ (left z) * FST x
8275
8276       Note (left z) * (right z) = z      by subset_cross_left_right_def
8277        and x IN s /\ (f x = z)           by in_preimage
8278       Let x1 = FST x, x2 = SND x.
8279       Then x = (x1, x2)                  by PAIR
8280        and f x = x1 * x2 = z             by function application
8281        and x1 IN s1 /\ x2 IN s2          by IN_CROSS
8282
8283       To produce an intersection element,
8284       Note z = (left z) * (right z) = x1 * x2
8285        ==>     left z = z * ( |/ (right z))            by group_lsolve
8286         or     left z = x1 * (x2 * ( |/ (right z)))    by group_assoc, z = x1 * x2
8287        ==> ( |/ x1) * (left z) = x2 * ( |/ (right z))  by group_rsolve, group_op_element, [1]
8288       Thus the common element is both IN s1 and IN s2.
8289
8290       Let d = ( |/ (left z)) * x1, the inverse of common element
8291       To compute |/ d,
8292       Note |/ (left z) IN s1             by subgroup_inv, group_inv_element, h1 <= g
8293        and |/ (right z) IN s2            by subgroup_inv, group_inv_element, h2 <= g
8294            |/ d
8295          = |/ (( |/ (left z)) * x1)      by above
8296          = |/ x1 * (left z)              by group_inv_op, group_inv_inv
8297          = x2 * ( |/ (right z))          by above identity [1]
8298
8299       Note d IN s1                       by subgroup_op, group_op_element, d = ( |/ (left z)) * x1
8300        and |/ d IN s2                    by subgroup_op, group_op_element, |/ d = x2 * ( |/ (right z))
8301        ==> |/ ( |/ d) = d IN s2          by subgroup_inv, group_inv_element, group_inv_inv
8302
8303            (left z) * d
8304          = (left z) * ( |/ (left z)) * x1   by group_assoc
8305          = x1                               by group_rinv, group_lid
8306            ( |/ d) * right z
8307          = x2 * ( |/ (right z) * right z)   by group_assoc
8308          = x2                               by group_linv, group_rid
8309       Take this d, and the result follows.
8310*)
8311Theorem subset_cross_to_preimage_cross_bij:
8312    !(g h1 h2):'a group. h1 <= g /\ h2 <= g ==>
8313   let (s1 = h1.carrier) in let (s2 = h2.carrier) in let (f = (\(x, y). x * y)) in
8314   !z. z IN (s1 o s2) ==>
8315       BIJ (\d. ((left z) * d, ( |/ d) * (right z))) (s1 INTER s2) (preimage f (s1 CROSS s2) z)
8316Proof
8317  rw_tac std_ss[] >>
8318  qabbrev_tac `s = s1 CROSS s2` >>
8319  `Group g /\ Group h1 /\ Group h2` by metis_tac[subgroup_property] >>
8320  `s1 SUBSET G /\ s2 SUBSET G` by rw[subgroup_carrier_subset, Abbr`s1`, Abbr`s2`] >>
8321  `left z IN s1 /\ right z IN s2` by metis_tac[subset_cross_left_right_def] >>
8322  `!x. x IN s1 ==> x IN G` by metis_tac[SUBSET_DEF] >>
8323  `!x. x IN s2 ==> x IN G` by metis_tac[SUBSET_DEF] >>
8324  `!d. d IN s1 /\ d IN s2 ==> (left z * d, |/ d * right z) IN preimage f s z` by
8325  (rw[in_preimage, IN_CROSS, Abbr`s`, Abbr`f`] >-
8326  metis_tac[group_op_element, subgroup_op] >-
8327  metis_tac[group_inv_element, group_op_element, subgroup_inv, subgroup_op] >>
8328  `(left z * d) * ( |/ d * right z) = ((left z * d) * |/ d) * right z` by rw[group_assoc] >>
8329  `_ = (left z * (d * |/ d)) * right z` by rw[GSYM group_assoc] >>
8330  `_ = z` by rw[subset_cross_left_right_def] >>
8331  rw[]
8332  ) >>
8333  rw[BIJ_DEF, INJ_DEF, SURJ_DEF] >-
8334  metis_tac[group_lcancel] >>
8335  `(left z) * (right z) = z` by rw[subset_cross_left_right_def, Abbr`s`, Abbr`f`] >>
8336  `x IN s /\ (f x = z)` by metis_tac[in_preimage] >>
8337  qabbrev_tac `x1 = FST x` >>
8338  qabbrev_tac `x2 = SND x` >>
8339  `x = (x1, x2)` by rw[pairTheory.PAIR, Abbr`x1`, Abbr`x2`] >>
8340  `x1 * x2 = z` by rw[Abbr`f`] >>
8341  `x1 IN s1 /\ x2 IN s2` by metis_tac[IN_CROSS] >>
8342  `z IN G /\ |/ (left z) IN G /\ |/ (right z) IN G` by rw[] >>
8343  `left z = z * ( |/ (right z))` by rw[GSYM group_lsolve] >>
8344  `_ = x1 * (x2 * ( |/ (right z)))` by rw[GSYM group_assoc] >>
8345  `( |/ x1) * (left z) = x2 * ( |/ (right z))` by metis_tac[group_rsolve, group_op_element] >>
8346  qabbrev_tac `d = ( |/ (left z)) * x1` >>
8347  `|/ (left z) IN s1` by metis_tac[subgroup_inv, group_inv_element] >>
8348  `|/ (right z) IN s2` by metis_tac[subgroup_inv, group_inv_element] >>
8349  `|/ d = |/ x1 * (left z)` by rw[group_inv_op, group_inv_inv, Abbr`d`] >>
8350  `_ = x2 * ( |/ (right z))` by rw[] >>
8351  `d IN s1` by metis_tac[subgroup_op, group_op_element] >>
8352  `|/ d IN s2` by metis_tac[subgroup_op, group_op_element] >>
8353  `d IN s2` by metis_tac[subgroup_inv, group_inv_element, group_inv_inv] >>
8354  `(left z) * d = x1` by rw[GSYM group_assoc, Abbr`d`] >>
8355  `( |/ d) * right z = x2` by rw[group_assoc] >>
8356  metis_tac[]
8357QED
8358
8359(* Theorem: h1 <= g /\ h2 <= g /\ FINITE G ==>
8360            let (s1 = h1.carrier) in let (s2 = h2.carrier) in let (f = (\(x, y). x * y)) in
8361            !t. t IN partition (feq f) (s1 CROSS s2) ==> (CARD t = CARD (s1 INTER s2)) *)
8362(* Proof:
8363   Let s = s1 CROSS s2.
8364   Note partition (feq f) s
8365      = IMAGE ((preimage f s) o f) s       by feq_partition
8366      = IMAGE (preimage f s) (IMAGE f s)   by IMAGE_COMPOSE
8367      = IMAGE (preimage f s) (s1 o s2)     by subset_cross_alt
8368   With t IN partition (feq f) s           by given
8369    ==> ?z. z IN (IMAGE f s) /\
8370            (preimage f s z = t)           by IN_IMAGE
8371    ==> ?m. BIJ m (s1 INTER s2) t          by subset_cross_to_preimage_cross_bij
8372   Note s1 SUBSET G /\ s2 SUBSET G         by subgroup_carrier_subset
8373     so FINITE s1 /\ FINITE s2             by SUBSET_FINITE, FINITE G
8374    ==> FINITE (s1 INTER s2)               by FINITE_INTER
8375   Thus CARD t = CARD (s1 INTER s2)        by FINITE_BIJ
8376*)
8377Theorem subset_cross_partition_property:
8378    !(g h1 h2):'a group. h1 <= g /\ h2 <= g /\ FINITE G ==>
8379   let (s1 = h1.carrier) in let (s2 = h2.carrier) in let (f = (\(x, y). x * y)) in
8380   !t. t IN partition (feq f) (s1 CROSS s2) ==> (CARD t = CARD (s1 INTER s2))
8381Proof
8382  rw_tac std_ss[] >>
8383  qabbrev_tac `s = s1 CROSS s2` >>
8384  `partition (feq f) s = IMAGE (preimage f s) (IMAGE f s)` by rw[feq_partition, IMAGE_COMPOSE] >>
8385  `_ = IMAGE (preimage f s) (s1 o s2)` by rw[subset_cross_alt, Abbr`s`] >>
8386  `?z. z IN (s1 o s2) /\ (preimage f s z = t)` by metis_tac[IN_IMAGE] >>
8387  `?m. BIJ m (s1 INTER s2) t` by metis_tac[subset_cross_to_preimage_cross_bij] >>
8388  `FINITE s1 /\ FINITE s2` by metis_tac[subgroup_carrier_subset, SUBSET_FINITE] >>
8389  `FINITE (s1 INTER s2)` by rw[] >>
8390  metis_tac[FINITE_BIJ]
8391QED
8392
8393(* Theorem: h1 <= g /\ h2 <= g /\ FINITE G ==>
8394            let (s1 = h1.carrier) in let (s2 = h2.carrier) in let (f = (\(x, y). x * y)) in
8395            !z. z IN (s1 o s2) ==> (CARD (preimage f (s1 CROSS s2) z) = CARD (s1 INTER s2)) *)
8396(* Proof:
8397   Let s = s1 CROSS s2.
8398   Then ?m. BIJ m (s1 INTER s2) (preimage f s z)     by subset_cross_to_preimage_cross_bij
8399   Note s1 SUBSET G /\ s2 SUBSET G                   by subgroup_carrier_subset
8400     so FINITE s1 /\ FINITE s2                       by SUBSET_FINITE, FINITE G
8401    ==> FINITE (s1 INTER s2)                         by FINITE_INTER
8402   Thus CARD (preimage f s z) = CARD (s1 INTER s2)   by FINITE_BIJ
8403*)
8404Theorem subset_cross_element_preimage_card:
8405    !(g h1 h2):'a group. h1 <= g /\ h2 <= g /\ FINITE G ==>
8406   let (s1 = h1.carrier) in let (s2 = h2.carrier) in let (f = (\(x, y). x * y)) in
8407   !z. z IN (s1 o s2) ==> (CARD (preimage f (s1 CROSS s2) z) = CARD (s1 INTER s2))
8408Proof
8409  metis_tac[subset_cross_to_preimage_cross_bij, subgroup_carrier_subset,
8410             SUBSET_FINITE, FINITE_INTER, FINITE_BIJ]
8411QED
8412
8413(* Theorem: INJ (preimage (\(x, y). x * y) (s1 CROSS s2)) (s1 o s2) univ(:('a # 'a -> bool)) *)
8414(* Proof:
8415   By INJ_DEF, this is to show:
8416   (1) x IN s1 o s2 ==> preimage (\(x,y). x * y) (s1 CROSS s2) x IN univ(:'a reln)
8417       Since type_of ``preimage (\(x,y). x * y) (s1 CROSS s2) x`` is :'a reln,
8418       This is true by IN_UNIV
8419   (2) x IN s1 o s2 /\ y IN s1 o s2 /\
8420       preimage (\(x,y). x * y) (s1 CROSS s2) x = preimage (\(x,y). x * y) (s1 CROSS s2) y ==> x = y
8421       Expand by preimage_def, pairTheory.FORALL_PROD, EXTENSION, this is to show:
8422       !p_1 p_2. (p_1 IN s1 /\ p_2 IN s2) /\ (p_1 * p_2 = x) <=>
8423                 (p_1 IN s1 /\ p_2 IN s2) /\ (p_1 * p_2 = y) ==> x = y
8424       Note ?x1 x2. x1 IN s1 /\ x2 IN s2 /\ (x = x1 * x2)   by subset_cross_element_iff
8425        ==> y = x1 * x2                                     by implication
8426         or x = y
8427*)
8428Theorem subset_cross_preimage_inj:
8429    !g:'a group. !(s1 s2):'a -> bool.
8430     INJ (preimage (\(x, y). x * y) (s1 CROSS s2)) (s1 o s2) univ(:('a # 'a -> bool))
8431Proof
8432  rw[INJ_DEF] >>
8433  fs[preimage_def, pairTheory.FORALL_PROD, EXTENSION] >>
8434  metis_tac[subset_cross_element_iff]
8435QED
8436
8437(* Theorem: h1 <= g /\ h2 <= g /\ FINITE G ==>
8438            let (s1 = h1.carrier) in let (s2 = h2.carrier) in
8439                (CARD (h1 o h2).carrier * CARD (s1 INTER s2) = (CARD s1) * (CARD s2)) *)
8440(* Proof:
8441   Let s = s1 CROSS s2, f = f = (\(x, y). x * y).
8442   Note s1 SUBSET G /\ s2 SUBSET G         by subgroup_carrier_subset
8443     so FINITE s1 /\ FINITE s2             by SUBSET_FINITE, FINITE G
8444     so FINITE s                           by FINITE_CROSS
8445    ==> FINITE (partition (feq f) s)       by FINITE_partition
8446
8447   Claim: CARD (partition (feq f) s) = CARD (s1 o s2)
8448   Proof:   partition (feq f) s
8449          = IMAGE (preimage f s o f) s                         by feq_partition
8450          = IMAGE (preimage f s) (IMAGE f s)                   by IMAGE_COMPOSE
8451          = IMAGE (preimage f s) (s1 o s2)                     by subset_cross_alt
8452          Note INJ (preimage f s) (s1 o s2) univ(:('a reln))   by subset_cross_preimage_inj
8453           and FINITE (s1 o s2)                                by subset_cross_finite
8454           ==> CARD (partition (feq f) s) = CARD (s1 o s2)     by INJ_CARD_IMAGE
8455
8456   Note !t. t IN partition (feq f) s ==>
8457            (CARD t = CARD (s1 INTER s2))  by subset_cross_partition_property
8458
8459      CARD s1 * CARD s2
8460    = CARD (s1 CROSS s2)                               by CARD_CROSS
8461    = CARD s                                           by notation
8462    = SIGMA CARD (partition (feq f) s)                 by finite_card_by_feq_partition
8463    = CARD (s1 INTER s2) * CARD (partition (feq f) s)  by SIGMA_CARD_CONSTANT
8464    = CARD (s1 INTER s2) * CARD (s1 o s2)              by Claim
8465    = CARD (s1 o s2) * CARD (s1 INTER s2)              by MULT_COMM
8466    = CARD (h1 o h2).carrier * CARD (s1 INTER s2)      by subgroup_cross_property
8467*)
8468Theorem subgroup_cross_card_eqn:
8469    !(g h1 h2):'a group. h1 <= g /\ h2 <= g /\ FINITE G ==>
8470   let (s1 = h1.carrier) in let (s2 = h2.carrier) in
8471    (CARD (h1 o h2).carrier * CARD (s1 INTER s2) = (CARD s1) * (CARD s2))
8472Proof
8473  rw_tac std_ss[] >>
8474  qabbrev_tac `s = s1 CROSS s2` >>
8475  `s1 SUBSET G /\ s2 SUBSET G` by rw[subgroup_carrier_subset, Abbr`s1`, Abbr`s2`] >>
8476  `FINITE s1 /\ FINITE s2` by metis_tac[SUBSET_FINITE] >>
8477  `FINITE s` by rw[Abbr`s`] >>
8478  qabbrev_tac `f = (\(x:'a, y:'a). x * y)` >>
8479  `CARD (partition (feq f) s) = CARD (s1 o s2)` by
8480  (`partition (feq f) s = IMAGE (preimage f s) (IMAGE f s)` by rw[feq_partition, IMAGE_COMPOSE] >>
8481  `_ = IMAGE (preimage f s) (s1 o s2)` by rw[subset_cross_alt, Abbr`s`] >>
8482  metis_tac[subset_cross_finite, subset_cross_preimage_inj, INJ_CARD_IMAGE]) >>
8483  `FINITE (partition (feq f) s)` by rw[FINITE_partition] >>
8484  `CARD s1 * CARD s2 = CARD (s1 CROSS s2)` by rw[CARD_CROSS] >>
8485  `_ = SIGMA CARD (partition (feq f) s)` by rw[finite_card_by_feq_partition, Abbr`s`] >>
8486  `_ = CARD (s1 INTER s2) * CARD (s1 o s2)` by metis_tac[SIGMA_CARD_CONSTANT, subset_cross_partition_property] >>
8487  rw[subgroup_cross_property, Abbr`s1`, Abbr`s2`]
8488QED
8489
8490(* Another proof of the same theorem *)
8491
8492(* Theorem: h1 <= g /\ h2 <= g /\ FINITE G ==>
8493            let (s1 = h1.carrier) in let (s2 = h2.carrier) in
8494            (CARD (h1 o h2).carrier * CARD (s1 INTER s2) = (CARD s1) * (CARD s2)) *)
8495(* Proof:
8496   Let s = s1 CROSS s2.
8497   Then s1 SUBSET G /\ s2 SUBSET G     by subgroup_carrier_subset
8498    ==> FINITE s1 /\ FINITE s2         by SUBSET_FINITE, FINITE G
8499   Thus FINITE s                       by FINITE_CROSS
8500    and FINITE (s1 o s2)               by subset_cross_finite
8501
8502   Let f = (\(x:'a, y:'a). x * y),
8503   Note !z. z IN (s1 o s2) ==>
8504        ((CARD o t) z = CARD (s1 INTER s2))            by subset_cross_element_preimage_card, [1]
8505
8506      CARD s1 * CARD s2
8507    = CARD s                                           by CARD_CROSS
8508    = SIGMA CARD (IMAGE (preimage f s o f) s)          by finite_card_by_image_preimage, FINITE s
8509    = SIGMA CARD (IMAGE (preimage f s) (IMAGE f s))    by IMAGE_COMPOSE
8510    = SIGMA CARD (IMAGE (preimage f s) (s1 o s2))      by subset_cross_alt
8511    = SIGMA (CARD o preimage f s) (s1 o s2)            by SUM_IMAGE_INJ_o, subset_cross_preimage_inj, FINITE (s1 o s2)
8512    = SIGMA (\z. CARD (s1 INTER s2)) (s1 o s2)         by SUM_IMAGE_CONG, [1]
8513    = CARD (s1 INTER s2) * CARD (s1 o s2)              by SIGMA_CONSTANT
8514    = CARD (s1 o s2) * CARD (s1 INTER s2)              by MULT_COMM
8515    = CARD (h1 o h2).carrier * CARD (s1 INTER s2)      by subgroup_cross_property
8516*)
8517Theorem subgroup_cross_card_eqn[allow_rebind]:
8518  !(g h1 h2):'a group. h1 <= g /\ h2 <= g /\ FINITE G ==>
8519   let (s1 = h1.carrier) in let (s2 = h2.carrier) in
8520    (CARD (h1 o h2).carrier * CARD (s1 INTER s2) = (CARD s1) * (CARD s2))
8521Proof
8522  rw_tac std_ss[] >>
8523  qabbrev_tac `s = s1 CROSS s2` >>
8524  `FINITE s1 /\ FINITE s2` by metis_tac[subgroup_carrier_subset, SUBSET_FINITE] >>
8525  `FINITE s` by rw[Abbr`s`] >>
8526  `FINITE (s1 o s2)` by rw[subset_cross_finite] >>
8527  qabbrev_tac `f = (\(x:'a, y:'a). x * y)` >>
8528  qabbrev_tac `t = preimage f s` >>
8529  (`!z. z IN (s1 o s2) ==> ((CARD o t) z = CARD (s1 INTER s2))` by (rw[] >> metis_tac[subset_cross_element_preimage_card])) >>
8530  `CARD s1 * CARD s2 = CARD s` by rw[CARD_CROSS, Abbr`s`] >>
8531  `_ = SIGMA CARD (IMAGE (t o f) s)` by rw[finite_card_by_image_preimage, Abbr`t`] >>
8532  `_ = SIGMA CARD (IMAGE t (IMAGE f s))` by rw[IMAGE_COMPOSE] >>
8533  `_ = SIGMA CARD (IMAGE t (s1 o s2))` by rw[subset_cross_alt] >>
8534  `_ = SIGMA (CARD o t) (s1 o s2)` by metis_tac[SUM_IMAGE_INJ_o, subset_cross_preimage_inj] >>
8535  `_ = SIGMA (\z. CARD (s1 INTER s2)) (s1 o s2)` by rw[SUM_IMAGE_CONG] >>
8536  `_ = CARD (s1 INTER s2) * CARD (s1 o s2)` by rw[SIGMA_CONSTANT] >>
8537  rw[subgroup_cross_property]
8538QED
8539
8540(* Theorem: h1 <= g /\ h2 <= g /\ FINITE G ==>
8541            let (s1 = h1.carrier) in let (s2 = h2.carrier) in
8542                (CARD (h1 o h2).carrier = ((CARD s1) * (CARD s2)) DIV (CARD (s1 INTER s2))) *)
8543(* Proof:
8544   Note Group h1 /\ Group h2        by subgroup_property
8545    and s1 SUBSET G /\ s2 SUBSET G  by subgroup_carrier_subset
8546    ==> FINITE s1 /\ FINITE s2      by SUBSET_FINITE
8547   Note #e IN s1 /\ #e IN s2        by subgroup_id, group_id_element
8548   Thus #e IN s1 INTER s2           by IN_INTER
8549    and FINITE (s1 INTER s2)        by FINITE_INTER
8550    ==> s1 INTER s2 <> {}           by MEMBER_NOT_EMPTY
8551     or CARD (s1 INTER s2) <> 0     by CARD_EQ_0
8552     or 0 < CARD (s1 INTER s2)      by NOT_ZERO_LT_ZERO
8553     By subgroup_cross_card_eqn,
8554        CARD (h1 o h2).carrier * CARD (s1 INTER s2) = (CARD s1) * (CARD s2)
8555    Thus the result follows         by DIV_SOLVE, 0 < CARD (s1 INTER s2)
8556*)
8557Theorem subgroup_cross_card:
8558    !(g h1 h2):'a group. h1 <= g /\ h2 <= g /\ FINITE G ==>
8559   let (s1 = h1.carrier) in let (s2 = h2.carrier) in
8560       (CARD (h1 o h2).carrier = ((CARD s1) * (CARD s2)) DIV (CARD (s1 INTER s2)))
8561Proof
8562  rw_tac std_ss[] >>
8563  `Group h1 /\ Group h2` by metis_tac[subgroup_property] >>
8564  `FINITE s1 /\ FINITE s2` by metis_tac[subgroup_carrier_subset, SUBSET_FINITE] >>
8565  `#e IN s1 /\ #e IN s2` by metis_tac[subgroup_id, group_id_element] >>
8566  `#e IN s1 INTER s2` by rw[] >>
8567  `FINITE (s1 INTER s2)` by rw[] >>
8568  `CARD (s1 INTER s2) <> 0` by metis_tac[CARD_EQ_0, MEMBER_NOT_EMPTY] >>
8569  metis_tac[subgroup_cross_card_eqn, DIV_SOLVE, NOT_ZERO_LT_ZERO]
8570QED
8571
8572(* Another milestone theorem for me! *)
8573(* This is just Lemma X.2 in Appendix of "Finite Group Theory" by Irving Martin Isaacs. *)
8574
8575(* ------------------------------------------------------------------------- *)
8576(* Finite Group Generators                                                   *)
8577(* ------------------------------------------------------------------------- *)
8578
8579(*
8580I thought that, given a IN G /\ b IN G, if a <> b, then (Gen a) INTER (Gen b) = {#e}.
8581However, a proof of this turns out to be elusive.
8582This comes down to showing:   a ** n = b ** m  is impossible for n < ord a, m < ord b.
8583But even for the case n = m, a = b is hard to conclude.
8584Eventually I realize that, (gen (a * a)) is a subgroup of (gen a), and a * a <> a!.
8585This gives (Gen (a * a)) SUBSET (Gen a), so (Gen (a * a)) INTER (Gen a) = (Gen (a * a)) <> {#e}.
8586Thus (Gen a) INTER (Gen b) = {#e} is a condition in elements a, b, called these independence.
8587*)
8588
8589(* Overload the notion of independent group elements *)
8590Overload independent =
8591        ``\(g:'a group) a b. (Gen a) INTER (Gen b) = {#e}``
8592
8593(* Theorem: independent g a b = independent g b a *)
8594(* Proof:
8595       independent g a b
8596   <=> (Gen a) INTER (Gen b) = {#e}     by notation
8597   <=> (Gen b) INTER (Gen a) = {#e}     by INTER_COMM
8598   <=> independent g b a                by notation
8599*)
8600Theorem independent_sym:
8601    !g:'a group. !a b. independent g a b = independent g b a
8602Proof
8603  rw[INTER_COMM]
8604QED
8605
8606(* Theorem: Group g ==>
8607            !a b. a IN G /\ b IN G /\ independent g a b ==> ((gen a = gen b) <=> (a = b)) *)
8608(* Proof:
8609   If part: gen a = gen b ==> a = b
8610      Note Gen a = Gen b                  by Generated_def, monoid_component_equality
8611       and a IN (Gen a) /\ b IN (Gen b)   by generated_gen_element, Group g
8612      Note (Gen a) INTER (Gen b) = {#e}   by notation
8613       ==> a IN {#e} /\ b IN {#e}         by IN_INTER
8614        or a = #e /\ b = #e               by IN_SING
8615      Thus a = b.
8616
8617   Only-if part: a = b ==> gen a = gen b, true trivially.
8618*)
8619Theorem independent_generated_eq:
8620    !g:'a group. Group g ==>
8621   !a b. a IN G /\ b IN G /\ independent g a b ==> ((gen a = gen b) <=> (a = b))
8622Proof
8623  rw[EQ_IMP_THM] >>
8624  `Gen a = Gen b` by rw[Generated_def, monoid_component_equality] >>
8625  metis_tac[generated_gen_element, IN_INTER, IN_SING]
8626QED
8627
8628(* Theorem: FiniteGroup g ==> !a b. a IN G /\ b IN G /\ independent g a b ==>
8629                (CARD ((gen a) o (gen b)).carrier = (ord a) * (ord b)) *)
8630(* Proof:
8631   Note (gen a) <= g /\ (gen b) <= g     by generated_subgroup
8632    and CARD (Gen a) = ord a             by generated_group_card, group_order_pos
8633    and CARD (Gen b) = ord b             by generated_group_card, group_order_pos
8634    Now (Gen a) INTER (Gen b) = {#e}     by independent a b
8635    and CARD {#e} = 1                    by CARD_SING
8636
8637        CARD ((gen a) o (gen b)).carrier
8638      = ((CARD (Gen a)) * (CARD (Gen b))) DIV (CARD ((Gen a) INTER (Gen b)))   by subgroup_cross_card
8639      = ((ord a) * (ord b)) DIV 1        by above
8640      = (ord a) * (ord b)                by DIV_1
8641*)
8642Theorem independent_generator_2_card:
8643    !g:'a group. FiniteGroup g ==> !a b. a IN G /\ b IN G /\ independent g a b ==>
8644                (CARD ((gen a) o (gen b)).carrier = (ord a) * (ord b))
8645Proof
8646  rpt (stripDup[FiniteGroup_def]) >>
8647  `(gen a) <= g /\ (gen b) <= g` by rw[generated_subgroup] >>
8648  `CARD {#e} = 1` by rw[] >>
8649  metis_tac[subgroup_cross_card, generated_group_card, group_order_pos, DIV_1]
8650QED
8651
8652(* Define the set of all subgroups of a group. *)
8653Definition all_subgroups_def:
8654    all_subgroups (g:'a group) = {h | h <= g}
8655End
8656
8657(* Theorem: h IN all_subgroups g <=> h <= g *)
8658(* Proof: by all_subgroups_def *)
8659Theorem all_subgroups_element:
8660    !g:'a group. !h. h IN all_subgroups g <=> h <= g
8661Proof
8662  rw[all_subgroups_def]
8663QED
8664
8665(* Theorem: Group g ==> (IMAGE (\h:'a group. H) (all_subgroups g)) SUBSET (POW G) *)
8666(* Proof:
8667   Let s IN IMAGE (\h:'a group. H) (all_subgroups g)
8668   Then ?h. h IN (all_subgroups g) /\ (H = s)   by IN_IMAGE
8669     or ?h. h <= g  /\ (H = s)                  by all_subgroups_element
8670     or ?h. h <= g  /\ (H = s) /\ (H SUBSET G)  by subgroup_carrier_subset
8671     or s IN (POW G)                            by IN_POW
8672   The result follows                           by SUBSET_DEF
8673*)
8674Theorem all_subgroups_subset:
8675    !g:'a group. Group g ==> (IMAGE (\h:'a group. H) (all_subgroups g)) SUBSET (POW G)
8676Proof
8677  rw[all_subgroups_element, SUBSET_DEF, IN_POW] >>
8678  metis_tac[subgroup_carrier_subset, SUBSET_DEF]
8679QED
8680
8681(* Theorem: Group g ==> (gen #e) IN (all_subgroups g) *)
8682(* Proof:
8683   Note #e IN G                        by group_id_element, Group g
8684    and (gen #e) <= g                  by generated_id_subgroup, Group g
8685    ==> (gen #e) IN (all_subgroups g)  by all_subgroups_element
8686*)
8687Theorem all_subgroups_has_gen_id:
8688    !g:'a group. Group g ==> (gen #e) IN (all_subgroups g)
8689Proof
8690  rw[generated_id_subgroup, all_subgroups_element]
8691QED
8692
8693(* Theorem: FiniteGroup g ==> FINITE (all_subgroups g) *)
8694(* Proof:
8695   Note Group g /\ FINITE G      by FiniteGroup_def
8696   Let f = \h:'a group. H, s = all_subgroups g
8697   Then (IMAGE f s) SUBSET (POW G)     by all_subgroups_subset, Group g
8698    and FINITE (POW G)                 by FINITE_POW, FINITE G
8699    ==> FINITE (IMAGE f s)             by SUBSET_FINITE
8700   Claim: INJ f s (IMAGE f s)
8701   Proof: By INJ_DEF, this is to show:
8702          !h1 h2. h1 IN s /\ h2 IN s /\ (h1.carrier = h2.carrier) ==> h1 = h2.
8703          or      h1 <= g /\ h2 <= g /\ (h1.carrier = h2.carrier) ==> h1 = h2   by all_subgroups_element
8704          This is true                 by subgroup_eq
8705
8706   With INJ f s (IMAGE f s)            by Claim
8707    and FINITE (IMAGE f s)             by above
8708    ==> FINITE s                       by FINITE_INJ
8709*)
8710Theorem all_subgroups_finite:
8711    !g:'a group. FiniteGroup g ==> FINITE (all_subgroups g)
8712Proof
8713  rw[FiniteGroup_def] >>
8714  qabbrev_tac `f = \h:'a group. H` >>
8715  qabbrev_tac `s = all_subgroups g` >>
8716  `(IMAGE f s) SUBSET (POW G)` by rw[all_subgroups_subset, Abbr`f`, Abbr`s`] >>
8717  `FINITE (POW G)` by rw[FINITE_POW] >>
8718  `FINITE (IMAGE f s)` by metis_tac[SUBSET_FINITE] >>
8719  (`INJ f s (IMAGE f s)` by (rw[INJ_DEF, all_subgroups_element, Abbr`f`, Abbr`s`] >> metis_tac[subgroup_eq])) >>
8720  metis_tac[FINITE_INJ]
8721QED
8722
8723(* Theorem: FiniteGroup g ==> !s. s SUBSET G ==> (IMAGE gen s) SUBSET all_subgroups g *)
8724(* Proof:
8725   Let h IN (IMAGE gen s)
8726   Then ?x. x IN s /\ (h = gen x)   by IN_IMAGE
8727     or ?x. x IN G /\ (h = gen x)   by SUBSET_DEF, s SUBSET G
8728     or h <= g                      by generated_subgroup, FiniteGroup g
8729   Thus h IN all_subgroups g        by all_subgroups_element
8730   The result follows               by SUBSET_DEF
8731*)
8732Theorem generated_image_subset_all_subgroups:
8733    !g:'a group. FiniteGroup g ==> !s. s SUBSET G ==> (IMAGE gen s) SUBSET all_subgroups g
8734Proof
8735  metis_tac[generated_subgroup, SUBSET_DEF, all_subgroups_element, IN_IMAGE]
8736QED
8737
8738(* Theorem: Group g ==> !s. s SUBSET G ==> (IMAGE Gen s) SUBSET (POW G) *)
8739(* Proof:
8740   Let z IN (IMAGE Gen s)
8741   Then ?x. x IN s /\ (z = Gen x)   by IN_IMAGE
8742     or ?x. x IN G /\ (z = Gen x)   by SUBSET_DEF, s SUBSET G
8743     or z SUBSET G                  by generated_subset, FiniteGroup g
8744   Thus z IN POW G                  by IN_POW
8745   The result follows               by SUBSET_DEF
8746*)
8747Theorem generated_image_subset_power_set:
8748    !g:'a group. Group g ==> !s. s SUBSET G ==> (IMAGE Gen s) SUBSET (POW G)
8749Proof
8750  rw[IN_POW, SUBSET_DEF] >>
8751  metis_tac[generated_subset, SUBSET_DEF]
8752QED
8753
8754(* Theorem: AbelianGroup g ==> closure_comm_assoc_fun (subset_cross g) (POW G) *)
8755(* Proof:
8756   Note Group g              by AbelianGroup_def
8757   By closure_comm_assoc_fun_def, IN_POW, this is to show:
8758   (1) x SUBSET G /\ y SUBSET G ==> x o y SUBSET G
8759       This is true          by subset_cross_subset, Group g
8760   (2) x SUBSET G /\ y SUBSET G /\ z SUBSET G ==> x o (y o z) = y o (x o z)
8761         x o (y o z)
8762       = (x o y) o z         by subset_cross_assoc, Group g
8763       = (y o x) o z         by subset_cross_comm, AbelianGroup g
8764       = y o (x o z)         by subset_cross_assoc, Group g
8765*)
8766Theorem subset_cross_closure_comm_assoc_fun:
8767    !g:'a group. AbelianGroup g ==> closure_comm_assoc_fun (subset_cross g) (POW G)
8768Proof
8769  rpt strip_tac >>
8770  `Group g` by metis_tac[AbelianGroup_def] >>
8771  rw[closure_comm_assoc_fun_def, IN_POW] >-
8772  rw[subset_cross_subset] >>
8773  `x o (y o z) = (x o y) o z` by rw[subset_cross_assoc] >>
8774  `_ = (y o x) o z` by rw[subset_cross_comm] >>
8775  rw[subset_cross_assoc]
8776QED
8777
8778(* Theorem: AbelianGroup g ==> closure_comm_assoc_fun (subgroup_cross g) (all_subgroups g) *)
8779(* Proof:
8780   Note Group g              by AbelianGroup_def
8781   By closure_comm_assoc_fun_def, all_subgroups_element, this is to show:
8782   (1) x <= g /\ y <= g ==> x o y <= g
8783       This is true          by abelian_subgroup_cross_subgroup, AbelianGroup g
8784   (2) x <= g /\ y <= g /\ z <= g ==> x o (y o z) = y o (x o z)
8785         x o (y o z)
8786       = (x o y) o z         by subgroup_cross_assoc
8787       = (y o x) o z         by subgroup_cross_comm, AbelianGroup g
8788       = y o (x o z)         by subgroup_cross_assoc
8789*)
8790Theorem subgroup_cross_closure_comm_assoc_fun:
8791    !g:'a group. AbelianGroup g ==> closure_comm_assoc_fun (subgroup_cross g) (all_subgroups g)
8792Proof
8793  rpt strip_tac >>
8794  `Group g` by metis_tac[AbelianGroup_def] >>
8795  rw[closure_comm_assoc_fun_def, all_subgroups_element] >-
8796  rw[abelian_subgroup_cross_subgroup] >>
8797  `x o (y o z) = (x o y) o z` by rw[subgroup_cross_assoc] >>
8798  `_ = (y o x) o z` by rw[subgroup_cross_comm] >>
8799  rw[subgroup_cross_assoc]
8800QED
8801
8802(* ------------------------------------------------------------------------- *)
8803(* Big Cross of Subsets.                                                     *)
8804(* ------------------------------------------------------------------------- *)
8805
8806(* Define big cross product of subsets. *)
8807Definition subset_big_cross_def:
8808    subset_big_cross (g:'a group) (B:('a -> bool) -> bool) = ITSET (subset_cross g) B {#e}
8809End
8810(* overload big cross product of subsets. *)
8811Overload ssbcross = ``subset_big_cross (g:'a group)``
8812
8813(*
8814> subset_big_cross_def;
8815val it = |- !g B. ssbcross B = ITSET $o B {#e}: thm
8816*)
8817
8818(* Theorem: ssbcross {} = {#e} *)
8819(* Proof:
8820     ssbcross {}
8821   = ITSET $o {} {#e}    by subset_big_cross_def
8822   = {#e}                by ITSET_EMPTY
8823*)
8824Theorem subset_big_cross_empty:
8825    !g:'a group. ssbcross {} = {#e}
8826Proof
8827  rw[subset_big_cross_def, ITSET_EMPTY]
8828QED
8829
8830(* Theorem: FiniteAbelianGroup g ==> !B. B SUBSET (POW G) ==>
8831            !s. s SUBSET G ==> (ssbcross (s INSERT B) = s o ssbcross (B DELETE s)) *)
8832(* Proof:
8833   Note AbelianGroup g /\ FINITE G      by FiniteAbelianGroup_def
8834    ==> Group g                         by AbelianGroup_def
8835   Note closure_comm_assoc_fun (subset_cross g) (POW G)
8836                                        by subset_cross_closure_comm_assoc_fun
8837    Now FINITE (POW G)                  by FINITE_POW
8838     so FINITE B                        by SUBSET_FINITE
8839   Also {#e} SUBSET G                   by group_id_element, SUBSET_DEF
8840     so {#e} IN (POW G)                 by IN_POW
8841    and s IN (POW G)                    by IN_POW, s SUBSET G
8842
8843     (ssbcross (s INSERT B)
8844   = ITSET $o (s INSERT B) {#e}         by subset_big_cross_def
8845   = s o ITSET $o (B DELETE s) {#e}     by SUBSET_COMMUTING_ITSET_RECURSES
8846   = s o ssbcross (B DELETE s))         by subset_big_cross_def
8847*)
8848Theorem subset_big_cross_thm:
8849    !g:'a group. FiniteAbelianGroup g ==> !B. B SUBSET (POW G) ==>
8850   !s. s SUBSET G ==> (ssbcross (s INSERT B) = s o ssbcross (B DELETE s))
8851Proof
8852  rw[FiniteAbelianGroup_def] >>
8853  `Group g` by metis_tac[AbelianGroup_def] >>
8854  `closure_comm_assoc_fun (subset_cross g) (POW G)` by rw[subset_cross_closure_comm_assoc_fun] >>
8855  `FINITE B` by metis_tac[FINITE_POW, SUBSET_FINITE] >>
8856  `s IN (POW G)` by rw[IN_POW] >>
8857  `{#e} IN (POW G)` by rw[IN_POW] >>
8858  metis_tac[subset_big_cross_def, SUBSET_COMMUTING_ITSET_RECURSES]
8859QED
8860
8861(* Theorem: FiniteAbelianGroup g ==> !B. B SUBSET (POW G) ==>
8862            !s. s SUBSET G /\ s NOTIN B ==> (ssbcross (s INSERT B) = s o ssbcross B) *)
8863(* Proof: by subset_big_cross_thm, DELETE_NON_ELEMENT *)
8864Theorem subset_big_cross_insert:
8865    !g:'a group. FiniteAbelianGroup g ==> !B. B SUBSET (POW G) ==>
8866   !s. s SUBSET G /\ s NOTIN B ==> (ssbcross (s INSERT B) = s o ssbcross B)
8867Proof
8868  rw[subset_big_cross_thm, DELETE_NON_ELEMENT]
8869QED
8870
8871(* ------------------------------------------------------------------------- *)
8872(* Big Cross of Subgroups.                                                   *)
8873(* ------------------------------------------------------------------------- *)
8874
8875(* Define big cross product of subgroups. *)
8876Definition subgroup_big_cross_def:
8877    subgroup_big_cross (g:'a group) (B:('a group) -> bool) = ITSET (subgroup_cross g) B (gen #e)
8878End
8879(* overload big cross product of subgroups. *)
8880Overload sgbcross = ``subgroup_big_cross (g:'a group)``
8881
8882(*
8883> subgroup_big_cross_def;
8884val it = |- !g B. sgbcross B = ITSET $o B (gen #e): thm
8885*)
8886
8887(* Theorem: sgbcross {} = gen #e *)
8888(* Proof:
8889     sgbcross {}
8890   = ITSET $o {} (gen #e)    by subgroup_big_cross_def
8891   = gen #e                  by ITSET_EMPTY
8892*)
8893Theorem subgroup_big_cross_empty:
8894    !g:'a group. sgbcross {} = gen #e
8895Proof
8896  rw[subgroup_big_cross_def, ITSET_EMPTY]
8897QED
8898
8899(* Theorem: FiniteAbelianGroup g ==> !B. B SUBSET (all_subgroups g) ==>
8900            !h. h IN (all_subgroups g) ==> (sgbcross (h INSERT B) = h o sgbcross (B DELETE h)) *)
8901(* Proof:
8902   Note AbelianGroup g /\ FINITE G      by FiniteAbelianGroup_def
8903    ==> Group g                         by AbelianGroup_def
8904    and FiniteGroup g                   by FiniteGroup_def
8905   Note closure_comm_assoc_fun (subgroup_cross g) (all_subgroups g)
8906                                        by subgroup_cross_closure_comm_assoc_fun
8907    Now FINITE (all_subgroups g)        by all_subgroups_finite
8908     so FINITE B                        by SUBSET_FINITE
8909    and (gen #e) IN (all_subgroups g)   by all_subgroups_has_gen_id
8910
8911     (sgbcross (h INSERT B)
8912   = ITSET $o (h INSERT B) (gen #e)     by subgroup_big_cross_def
8913   = h o ITSET $o (B DELETE h) (gen #e) by SUBSET_COMMUTING_ITSET_RECURSES
8914   = h o sgbcross (B DELETE h))         by subgroup_big_cross_def
8915*)
8916Theorem subgroup_big_cross_thm:
8917    !g:'a group. FiniteAbelianGroup g ==> !B. B SUBSET (all_subgroups g) ==>
8918   !h. h IN (all_subgroups g) ==> (sgbcross (h INSERT B) = h o sgbcross (B DELETE h))
8919Proof
8920  rw[FiniteAbelianGroup_def] >>
8921  `Group g /\ FiniteGroup g` by metis_tac[AbelianGroup_def, FiniteGroup_def] >>
8922  `closure_comm_assoc_fun (subgroup_cross g) (all_subgroups g)`
8923     by rw[subgroup_cross_closure_comm_assoc_fun] >>
8924  `FINITE B` by metis_tac[all_subgroups_finite, SUBSET_FINITE] >>
8925  `(gen #e) IN (all_subgroups g)` by rw[all_subgroups_has_gen_id] >>
8926  metis_tac[subgroup_big_cross_def, SUBSET_COMMUTING_ITSET_RECURSES]
8927QED
8928
8929(* Theorem: FiniteAbelianGroup g ==> !B. B SUBSET (all_subgroups g) ==>
8930            !h. h IN (all_subgroups g) /\ h NOTIN B ==> (sgbcross (h INSERT B) = h o sgbcross B) *)
8931(* Proof: by subgroup_big_cross_thm, DELETE_NON_ELEMENT *)
8932Theorem subgroup_big_cross_insert:
8933    !g:'a group. FiniteAbelianGroup g ==> !B. B SUBSET (all_subgroups g) ==>
8934   !h. h IN (all_subgroups g) /\ h NOTIN B ==> (sgbcross (h INSERT B) = h o sgbcross B)
8935Proof
8936  rw[subgroup_big_cross_thm, DELETE_NON_ELEMENT]
8937QED
8938
8939(*
8940
8941Group Instances
8942===============
8943The important ones:
8944
8945 Zn -- Addition Modulo n, n > 0.
8946Z*p -- Multiplication Modulo p, p a prime.
8947E*n -- Multiplication Modulo n, of order phi(n).
8948
8949*)
8950(* ------------------------------------------------------------------------- *)
8951(* Group Instances Documentation                                             *)
8952(* ------------------------------------------------------------------------- *)
8953(* Group Data type:
8954   The generic symbol for group data is g.
8955   g.carrier = Carrier set of group
8956   g.op      = Binary operation of group
8957   g.id      = Identity element of group
8958   g.inv     = Inverse operation of group (as monoid_inv g)
8959*)
8960(* Overloading (# are temporary):
8961   Z n       = Zadd n
8962   Z* n      = Zstar n
8963*)
8964(* Definitions and Theorems (# are exported, ! are in computeLib):
8965
8966   The Group Zn = Addition Modulo n (n > 0):
8967   Zadd_def      |- !n. Z n = <|carrier := count n; id := 0; op := (\i j. (i + j) MOD n)|>
8968   Zadd_element  |- !n x. x IN (Z n).carrier <=> x < n
8969   Zadd_property |- !n. (!x. x IN (Z n).carrier <=> x < n) /\ ((Z n).id = 0) /\
8970                      (!x y. (Z n).op x y = (x + y) MOD n) /\
8971                      FINITE (Z n).carrier /\ (CARD (Z n).carrier = n)
8972   Zadd_carrier  |- !n. (Z n).carrier = count n
8973   Zadd_carrier_alt  |- !n. (Z n).carrier = {i | i < n}
8974   Zadd_id       |- !n. (Z n).id = 0
8975   Zadd_finite   |- !n. FINITE (Z n).carrier
8976   Zadd_card     |- !n. CARD (Z n).carrier = n
8977   Zadd_group    |- !n. 0 < n ==> Group (Z n)
8978   Zadd_finite_group          |- !n. 0 < n ==> FiniteGroup (Z n)
8979   Zadd_finite_abelian_group  |- !n. 0 < n ==> FiniteAbelianGroup (Z n)
8980   Zadd_exp      |- !n. 0 < n ==> !x m. (Z n).exp x m = (x * m) MOD n
8981#! Zadd_eval     |- !n. ((Z n).carrier = count n) /\ (!x y. (Z n).op x y = (x + y) MOD n) /\ ((Z n).id = 0)
8982#  Zadd_inv      |- !n. 0 < n ==> !x. x < n ==> ((Z n).inv x = (n - x) MOD n)
8983!  Zadd_inv_compute |- !n x. (Z n).inv x = if 0 < n /\ x < n then (n - x) MOD n else FAIL ((Z n).inv x) bad_element
8984
8985   The Group Z*p = Multiplication Modulo p (prime p):
8986   Zstar_def       |- !p. Z* p = <|carrier := residue p; id := 1; op := (\i j. (i * j) MOD p)|>
8987   Zstar_element   |- !p x. x IN (Z* p).carrier <=> 0 < x /\ x < p
8988   Zstar_property  |- !p. ((Z* p).carrier = residue p) /\ ((Z* p).id = 1) /\
8989                          (!x y. (Z* p).op x y = (x * y) MOD p) /\
8990                          FINITE (Z* p).carrier /\ (0 < p ==> (CARD (Z* p).carrier = p - 1))
8991   Zstar_carrier   |- !p. (Z* p).carrier = residue p
8992   Zstar_carrier_alt |- !p. (Z* p).carrier = {i | i <> 0 /\ i < p}
8993   Zstar_id        |- !p. (Z* p).id = 1
8994   Zstar_finite    |- !p. FINITE (Z* p).carrier
8995   Zstar_card      |- !p. 0 < p ==> (CARD (Z* p).carrier = p - 1)
8996   Zstar_group     |- !p. prime p ==> Group (Z* p)
8997   Zstar_finite_group         |- !p. prime p ==> FiniteGroup (Z* p)
8998   Zstar_finite_abelian_group |- !p. prime p ==> FiniteAbelianGroup (Z* p)
8999   Zstar_exp       |- !p a. prime p /\ a IN (Z* p).carrier ==> !n. (Z* p).exp a n = a ** n MOD p
9000!  Zstar_eval      |- !p. ((Z* p).carrier = residue p) /\
9001                          (!x y. (Z* p).op x y = (x * y) MOD p) /\ ((Z* p).id = 1)
9002!  Zstar_inv       |- !p. prime p ==> !x. 0 < x /\ x < p ==>
9003                     ((Z* p).inv x = (Z* p).exp x (order (Z* p) x - 1))
9004   Zstar_inv_compute |- !p x. (Z* p).inv x = if prime p /\ 0 < x /\ x < p
9005                                            then (Z* p).exp x (order (Z* p) x - 1)
9006                                            else FAIL ((Z* p).inv x) bad_element
9007
9008   Euler's generalization of Modulo Multiplicative Group (any modulo n):
9009   Estar_def       |- !n. Estar n = <|carrier := Euler n; id := 1; op := (\i j. (i * j) MOD n)|>
9010   Estar_alt       |- !n. Estar n =
9011                            <|carrier := {i | 0 < i /\ i < n /\ coprime n i}; id := 1;
9012                                   op := (\i j. (i * j) MOD n)|>
9013!  Estar_eval      |- !n. (Estar n).carrier = Euler n /\
9014                          (!x y. (Estar n).op x y = (x * y) MOD n) /\ ((Estar n).id = 1)
9015   Estar_element   |- !n x. x IN (Estar n).carrier <=> 0 < x /\ x < n /\ coprime n x
9016   Estar_property  |- !n. ((Estar n).carrier = Euler n) /\ ((Estar n).id = 1) /\
9017                          (!x y. (Estar n).op x y = (x * y) MOD n) /\
9018                          FINITE (Estar n).carrier /\ (CARD (Estar n).carrier = totient n)
9019   Estar_carrier   |- !n. (Estar n).carrier = Euler n
9020   Estar_carrier_alt |- !n. (Estar n).carrier = {i | 0 < i /\ i < n /\ coprime n i}
9021   Estar_id        |- !n. (Estar n).id = 1
9022   Estar_finite    |- !n. FINITE (Estar n).carrier
9023   Estar_card      |- !n. CARD (Estar n).carrier = totient n
9024   Estar_card_alt  |- !n. 1 < n ==> (CARD (Estar n).carrier = phi n)
9025   Estar_group         |- !n. 1 < n ==> Group (Estar n)
9026   Estar_finite_group  |- !n. 1 < n ==> FiniteGroup (Estar n)
9027   Estar_finite_abelian_group |- !n. 1 < n ==> FiniteAbelianGroup (Estar n)
9028   Estar_exp       |- !n a. 1 < n /\ a IN (Estar n).carrier ==> !k. (Estar n).exp a k = a ** k MOD n
9029
9030   Euler-Fermat Theorem:
9031   Euler_Fermat_eqn     |- !n a. 1 < n /\ a < n /\ coprime n a ==> (a ** totient n MOD n = 1)
9032   Euler_Fermat_thm     |- !n a. 1 < n /\ coprime n a ==> (a ** totient n MOD n = 1)
9033   Euler_Fermat_alt     |- !n a. 1 < n /\ coprime a n ==> a ** totient n MOD n = 1
9034   Fermat_little_thm    |- !p a. prime p /\ 0 < a /\ a < p ==> (a ** (p - 1) MOD p = 1)
9035   Fermat_little_eqn    |- !p a. prime p ==> a ** p MOD p = a MOD p
9036   Estar_inv            |- !n a. 1 < n /\ a < n /\ coprime n a ==>
9037                                 (Estar n).inv a = a ** (totient n - 1) MOD n
9038!  Estar_inv_compute    |- !n a. (Estar n).inv a =
9039                                 if 1 < n /\ a < n /\ coprime n a
9040                                 then a ** (totient n - 1) MOD n
9041                                 else FAIL ((Estar n).inv a) bad_element
9042
9043   The Trivial Group:
9044   trivial_group_def |- !e. trivial_group e = <|carrier := {e}; id := e; op := (\x y. e)|>
9045   trivial_group_carrier
9046                     |- !e. (trivial_group e).carrier = {e}
9047   trivial_group_id  |- !e. (trivial_group e).id = e
9048   trivial_group     |- !e. FiniteAbelianGroup (trivial_group e)
9049
9050   The Function Cyclic Group:
9051   fn_cyclic_group_def  |- !e f. fn_cyclic_group e f =
9052         <|carrier := {x | ?n. FUNPOW f n e = x};
9053                id := e;
9054                op := (\x y. @z. !xi yi. (FUNPOW f xi e = x) /\ (FUNPOW f yi e = y) ==> (FUNPOW f (xi + yi) e = z))|>
9055   fn_cyclic_group_alt  |- !e f n. (?k. k <> 0 /\ (FUNPOW f k e = e)) /\
9056      (n = LEAST k. k <> 0 /\ (FUNPOW f k e = e)) ==>
9057         ((fn_cyclic_group e f).carrier = {FUNPOW f k e | k < n}) /\
9058         ((fn_cyclic_group e f).id = e) /\
9059         !i j. (fn_cyclic_group e f).op (FUNPOW f i e) (FUNPOW f j e) = FUNPOW f ((i + j) MOD n) e
9060   fn_cyclic_group_carrier              |- !e f. (fn_cyclic_group e f).carrier = { x | ?n. FUNPOW f n e = x }
9061   fn_cyclic_group_id                   |- !e f. (fn_cyclic_group e f).id = e
9062   fn_cyclic_group_group                |- !e f. (?n. n <> 0 /\ (FUNPOW f n e = e)) ==> Group (fn_cyclic_group e f)
9063   fn_cyclic_group_finite_abelian_group |- !e f. (?n. n <> 0 /\ (FUNPOW f n e = e)) ==> FiniteAbelianGroup (fn_cyclic_group e f)
9064   fn_cyclic_group_finite_group         |- !e f. (?n. n <> 0 /\ (FUNPOW f n e = e)) ==> FiniteGroup (fn_cyclic_group e f)
9065
9066   The Group of Addition Modulo n:
9067   add_mod_def      |- !n. add_mod n = <|carrier := {i | i < n}; id := 0; op := (\i j. (i + j) MOD n)|>
9068   add_mod_element  |- !n x. x IN (add_mod n).carrier <=> x < n
9069   add_mod_property |- !n. (!x. x IN (add_mod n).carrier <=> x < n) /\
9070                           ((add_mod n).id = 0) /\
9071                           (!x y. (add_mod n).op x y = (x + y) MOD n) /\
9072                           FINITE (add_mod n).carrier /\ (CARD (add_mod n).carrier = n)
9073   add_mod_carrier  |- !n. (add_mod n).carrier = { i | i < n }
9074   add_mod_carrier_alt    |- !n. (add_mod n).carrier = count n
9075   add_mod_id       |- !n. (add_mod n).id = 0
9076   add_mod_finite   |- !n. FINITE (add_mod n).carrier
9077   add_mod_card     |- !n. CARD (add_mod n).carrier = n
9078   add_mod_group    |- !n. 0 < n ==> Group (add_mod n)
9079   add_mod_abelian_group  |- !n. 0 < n ==> AbelianGroup (add_mod n)
9080   add_mod_finite_group   |- !n. 0 < n ==> FiniteGroup (add_mod n)
9081   add_mod_finite_abelian_group |- !n. 0 < n ==> FiniteAbelianGroup (add_mod n)
9082   add_mod_exp            |- !n. 0 < n ==> !x m. (add_mod n).exp x m = (x * m) MOD n
9083#! add_mod_eval     |- !n. ((add_mod n).carrier = {i | i < n}) /\
9084                           (!x y. (add_mod n).op x y = (x + y) MOD n) /\ ((add_mod n).id = 0)
9085#  add_mod_inv      |- !n. 0 < n ==> !x. x < n ==> ((add_mod n).inv x = (n - x) MOD n)
9086!  add_mod_inv_compute |- !n x. (add_mod n).inv x = if 0 < n /\ x < n then (n - x) MOD n else FAIL ((add_mod n).inv x) bad_element
9087
9088   The Group of Multiplication Modulo prime p:
9089   mult_mod_def     |- !p. mult_mod p = <|carrier := {i | i <> 0 /\ i < p}; id := 1; op := (\i j. (i * j) MOD p)|>
9090   mult_mod_element      |- !p x. x IN (mult_mod p).carrier <=> x <> 0 /\ x < p
9091   mult_mod_element_alt  |- !p x. x IN (mult_mod p).carrier <=> 0 < x /\ x < p
9092   mult_mod_property     |- !p. (!x. x IN (mult_mod p).carrier ==> x <> 0) /\
9093                                (!x. x IN (mult_mod p).carrier <=> 0 < x /\ x < p) /\
9094                                ((mult_mod p).id = 1) /\
9095                                (!x y. (mult_mod p).op x y = (x * y) MOD p) /\
9096                                FINITE (mult_mod p).carrier /\ (0 < p ==> (CARD (mult_mod p).carrier = p - 1))
9097   mult_mod_carrier |- !p. (mult_mod p).carrier = { i | i <> 0 /\ i < p }
9098   mult_mod_carrier_alt    |- !p. (mult_mod p).carrier = residue p
9099   mult_mod_id      |- !p. (mult_mod p).id = 1
9100   mult_mod_finite  |- !p. FINITE (mult_mod p).carrier
9101   mult_mod_card    |- !p. 0 < p ==> (CARD (mult_mod p).carrier = p - 1)
9102   mult_mod_group   |- !p. prime p ==> Group (mult_mod p)
9103   mult_mod_abelian_group  |- !p. prime p ==> AbelianGroup (mult_mod p)
9104   mult_mod_finite_group   |- !p. prime p ==> FiniteGroup (mult_mod p)
9105   mult_mod_finite_abelian_group  |- !p. prime p ==> FiniteAbelianGroup (mult_mod p)
9106   mult_mod_exp     |- !p a. prime p /\ a IN (mult_mod p).carrier ==> !n. (mult_mod p).exp a n = a ** n MOD p
9107#! mult_mod_eval    |- !p. ((mult_mod p).carrier = {i | i <> 0 /\ i < p}) /\
9108                           (!x y. (mult_mod p).op x y = (x * y) MOD p) /\ ((mult_mod p).id = 1)
9109#  mult_mod_inv     |- !p. prime p ==> !x. 0 < x /\ x < p ==>
9110                           ((mult_mod p).inv x = (mult_mod p).exp x (order (mult_mod p) x - 1))
9111!  mult_mod_inv_compute |- !p x. (mult_mod p).inv x = if prime p /\ 0 < x /\ x < p
9112                                                 then (mult_mod p).exp x (order (mult_mod p) x - 1)
9113                                                 else FAIL ((mult_mod p).inv x) bad_element
9114
9115   ElGamal encryption and decryption -- purely group-theoretic:
9116   ElGamal_encrypt_def  |- !g y h m k. ElGamal_encrypt g y h m k = (y ** k,h ** k * m)
9117   ElGamal_decrypt_def  |- !g x a b. ElGamal_decrypt g x (a,b) = |/ (a ** x) * b
9118   ElGamal_correctness  |- !g. Group g ==> !(y::G) (h::G) (m::G) k x. (h = y ** x) ==>
9119                               (ElGamal_decrypt g x (ElGamal_encrypt g y h m k) = m)
9120*)
9121(* ------------------------------------------------------------------------- *)
9122(* The Group Zn = Addition Modulo n, for n > 0.                              *)
9123(* ------------------------------------------------------------------------- *)
9124
9125(* Define (Zadd n) = Addition Modulo n Group *)
9126Definition Zadd_def[nocompute]:
9127  Zadd n : num group =
9128    <| carrier := count n;
9129            id := 0;
9130       (*  inv := (\i. (n - i) MOD n);  -- so that inv 0 = 0 *)
9131            op := (\i j. (i + j) MOD n)
9132     |>
9133End
9134(* Use of zDefine to avoid incorporating into computeLib, by default. *)
9135(* This is the same as add_mod below, using {i | i < n} as carrier. *)
9136
9137(* Overload Zadd n *)
9138Overload Z[local] = ``Zadd``
9139
9140(*
9141- type_of ``Z n``;
9142> val it = ``:num group`` : hol_type
9143> EVAL ``(Z 7).op 5 6``;
9144val it = |- (Z 7).op 5 6 = (Z 7).op 5 6: thm
9145
9146Here, we are putting a finer control on evaluation.
9147If we had use Define instead of zDefine, this would work.
9148However, because (Zadd n).inv is an add-on field, that would not work.
9149We define Zadd_eval and Zadd_inv below, and put them into computeLib.
9150*)
9151
9152(* Theorem: Evaluation of Zadd for each record field. *)
9153(* Proof: by Zadd_def. *)
9154Theorem Zadd_eval[simp]:
9155    !n. ((Z n).carrier = count n) /\
9156       (!x y. (Z n).op x y = (x + y) MOD n) /\
9157       ((Z n).id = 0)
9158Proof
9159  rw_tac std_ss[Zadd_def]
9160QED
9161(* This is later exported to computeLib, with Zadd_inv_compute. *)
9162
9163(* Theorem: x IN (Z n).carrier <=> x < n *)
9164(* Proof: by definition, IN_COUNT. *)
9165Theorem Zadd_element:
9166    !n x. x IN (Z n).carrier <=> x < n
9167Proof
9168  rw[Zadd_def]
9169QED(* by IN_COUNT *)
9170
9171(* Theorem: properties of Zn. *)
9172(* Proof: by definition. *)
9173Theorem Zadd_property:
9174    !n. (!x. x IN (Z n).carrier <=> x < n) /\
9175       ((Z n).id = 0) /\
9176       (!x y. (Z n).op x y = (x + y) MOD n) /\
9177       FINITE (Z n).carrier /\
9178       (CARD (Z n).carrier = n)
9179Proof
9180  rw_tac std_ss[Zadd_def, IN_COUNT, FINITE_COUNT, CARD_COUNT]
9181QED
9182
9183(* Theorem: (Z n).carrier = count n *)
9184(* Proof: by Zadd_def. *)
9185Theorem Zadd_carrier:
9186  !n. (Z n).carrier = count n
9187Proof
9188  simp[Zadd_def]
9189QED
9190
9191(* Theorem: (Z n).carrier = {i | i < n} *)
9192(* Proof: by Zadd_carrier. *)
9193Theorem Zadd_carrier_alt:
9194  !n. (Z n).carrier = {i | i < n}
9195Proof
9196  simp[Zadd_carrier, EXTENSION]
9197QED
9198
9199(* Theorem: (Z n).id = 0 *)
9200(* Proof: by Zadd_def. *)
9201Theorem Zadd_id:
9202  !n. (Z n).id = 0
9203Proof
9204  simp[Zadd_def]
9205QED
9206
9207(* Theorem: FINITE (Z n).carrier *)
9208(* Proof: by Zadd_property *)
9209Theorem Zadd_finite:
9210    !n. FINITE (Z n).carrier
9211Proof
9212  rw[Zadd_property]
9213QED
9214
9215(* Theorem: CARD (Z n).carrier = n *)
9216(* Proof: by Zadd_property *)
9217Theorem Zadd_card:
9218    !n. CARD (Z n).carrier = n
9219Proof
9220  rw[Zadd_property]
9221QED
9222
9223(* Theorem: Zn is a group if n > 0. *)
9224(* Proof: by definitions:
9225   Associativity: ((x + y) MOD n + z) MOD n = (x + (y + z) MOD n) MOD n
9226      true by MOD_ADD_ASSOC.
9227   Inverse: ?y. y < n /\ ((y + x) MOD n = 0)
9228      If x = 0, let y = 0, true by ZERO_MOD.
9229      If x <> 0, let y = n - x, true by DIVMOD_ID.
9230*)
9231Theorem Zadd_group:
9232    !n. 0 < n ==> Group (Z n)
9233Proof
9234  rw_tac std_ss[group_def_alt, Zadd_property] >| [
9235    rw_tac std_ss[MOD_ADD_ASSOC],
9236    Cases_on `x = 0` >| [
9237      metis_tac[ZERO_MOD, ADD],
9238      `n - x < n /\ ((n - x) + x = n)` by decide_tac >>
9239      metis_tac[DIVMOD_ID]
9240    ]
9241  ]
9242QED
9243
9244(* Theorem: Zn is a FiniteGroup if n > 0. *)
9245(* Proof: by Zadd_group and FINITE_Zadd_carrier. *)
9246Theorem Zadd_finite_group:
9247    !n. 0 < n ==> FiniteGroup (Z n)
9248Proof
9249  rw_tac std_ss[FiniteGroup_def, Zadd_group, Zadd_property]
9250QED
9251
9252(* Theorem: Zn is a finite Abelian group if n > 0. *)
9253(* Proof: by Zadd_finite_group and arithmetic. *)
9254Theorem Zadd_finite_abelian_group:
9255    !n. 0 < n ==> FiniteAbelianGroup (Z n)
9256Proof
9257  rw_tac std_ss[FiniteAbelianGroup_def, AbelianGroup_def, Zadd_property] >-
9258  rw_tac std_ss[Zadd_group] >>
9259  rw_tac arith_ss [Zadd_def]
9260QED
9261
9262(* Theorem: 0 < n ==> !x m. (Z n).exp x m = (x * m) MOD n *)
9263(* Proof:
9264   Note Group (Z n)        by Zadd_group
9265   By induction on m.
9266   Base case: (Z n).exp x 0 = (x * 0) MOD n
9267        (Z n).exp x 0
9268      = (Z n).id           by group_exp_0
9269      = 0                  by Zadd_property
9270      = (x * 0) MOD n      by MULT
9271   Step case: (Z n).exp x m = (x * m) MOD n ==>
9272              (Z n).exp x (SUC m) = (x * SUC m) MOD n
9273        (Z n).exp x (SUC m)
9274      = (Z n).op m (Z n).exp x m       by group_exp_SUC
9275      = (m + (Z n).exp x m) MOD n      by Zadd_property
9276      = (m + (x * m) MOD n) MOD n      by induction hypothesis
9277      = (m + x * m) MOD n              by MOD_PLUS, MOD_MOD
9278      = (x * SUC m) MOD n              by MULT_SUC
9279*)
9280Theorem Zadd_exp:
9281    !n. 0 < n ==> !x m. (Z n).exp x m = (x * m) MOD n
9282Proof
9283  rpt strip_tac >>
9284  `Group (Z n)` by rw[Zadd_group] >>
9285  Induct_on `m` >-
9286  rw[group_exp_0, Zadd_property] >>
9287  rw_tac std_ss[group_exp_SUC, Zadd_property] >>
9288  metis_tac[MOD_PLUS, MOD_MOD, MULT_SUC]
9289QED
9290
9291(* Theorem: (Z n).inv x = (n - x) MOD n *)
9292(* Proof: by MOD_ADD_INV and group_linv_unique. *)
9293Theorem Zadd_inv[simp]:
9294    !n x. 0 < n /\ x < n ==> ((Z n).inv x = (n - x) MOD n)
9295Proof
9296  rpt strip_tac >>
9297  `x IN (Z n).carrier /\ (n - x) MOD n IN (Z n).carrier` by rw_tac std_ss[Zadd_property] >>
9298  `((n - x) MOD n + x) MOD n = 0` by rw_tac std_ss[MOD_ADD_INV] >>
9299  metis_tac[Zadd_group, group_linv_unique, Zadd_property]
9300QED
9301
9302(*
9303- SIMP_CONV (srw_ss()) [] ``(Z 5).op 3 4``;
9304> val it = |- (Z 5).op 3 4 = 2 : thm
9305- SIMP_CONV (srw_ss()) [] ``(Z 5).inv 3``;
9306> val it = |- (Z 5).inv 3 = 2 : thm
9307*)
9308
9309(* Now put these to computeLib *)
9310val _ = computeLib.add_persistent_funs ["Zadd_eval"];
9311(*
9312- EVAL ``(Z 5).op 3 4``;
9313> val it = |- (Z 5).op 3 4 = 2 : thm
9314- EVAL ``(Z 5).op 6 8``;
9315> val it = |- (Z 5).op 6 8 = 4 : thm
9316*)
9317(* val _ = computeLib.add_persistent_funs ["Zadd_inv"]; -- cannot put a non-function. *)
9318
9319(* Theorem: As function, (Z n).inv x = (n - x) MOD n *)
9320(* Proof: by Zadd_inv. *)
9321Theorem Zadd_inv_compute:
9322    !n x. (Z n).inv x = if 0 < n /\ x < n then (n - x) MOD n else FAIL ((Z n).inv x) bad_element
9323Proof
9324  rw_tac std_ss[Zadd_inv, combinTheory.FAIL_DEF]
9325QED
9326
9327val _ = computeLib.add_persistent_funs ["Zadd_inv_compute"];
9328val _ = computeLib.set_EVAL_skip ``combin$FAIL`` (SOME 0);
9329
9330(*
9331- EVAL ``(Z 5).inv 2``;
9332> val it = |- (Z 5).inv 2 = 3 : thm
9333- EVAL ``(Z 5).inv 3``;
9334> val it = |- (Z 5).inv 3 = 2 : thm
9335- EVAL ``(Z 5).inv 6``;
9336> val it = |- (Z 5).inv 6 = FAIL ((Z 5).inv 6) bad_element : thm
9337*)
9338
9339
9340(* ------------------------------------------------------------------------- *)
9341(* The Group Z*p = Multiplication Modulo p, for prime p.                     *)
9342(* ------------------------------------------------------------------------- *)
9343
9344(* Define Multiplicative Modulo p Group *)
9345Definition Zstar_def[nocompute]:
9346  Zstar p : num group =
9347   <| carrier := residue p;
9348           id := 1;
9349       (* inv := MOD_MULT_INV p; *)
9350           op := (\i j. (i * j) MOD p)
9351    |>
9352End
9353(* Use of zDefine to avoid incorporating into computeLib, by default. *)
9354(* This is the same as mult_mod below, using { i | i <> 0 /\ i < p } as carrier. *)
9355
9356(* Overload Zstar n *)
9357Overload "Z*"[local] = ``Zstar``
9358
9359(*
9360- type_of ``Z* p``;
9361> val it = ``:num group`` : hol_type
9362*)
9363
9364(* Theorem: Evaluation of Zstar for each record field. *)
9365(* Proof: by Zstar_def. *)
9366Theorem Zstar_eval[simp]:
9367    !p. ((Z* p).carrier = residue p) /\
9368       (!x y. (Z* p).op x y = (x * y) MOD p) /\
9369       ((Z* p).id = 1)
9370Proof
9371  rw_tac std_ss[Zstar_def]
9372QED
9373(* This is put to computeLib later, together with Zstar_inv_compute. *)
9374
9375(* Theorem: x IN (Z* p).carrier ==> 0 < x /\ x < p *)
9376(* Proof: by definition. *)
9377Theorem Zstar_element:
9378    !p x. x IN (Z* p).carrier <=> 0 < x /\ x < p
9379Proof
9380  rw[Zstar_def, residue_def]
9381QED
9382
9383(* Theorem: properties of Z* p. *)
9384(* Proof: by definition. *)
9385Theorem Zstar_property:
9386    !p. ((Z* p).carrier = residue p) /\
9387       ((Z* p).id = 1) /\
9388       (!x y. (Z* p).op x y = (x * y) MOD p) /\
9389       FINITE (Z* p).carrier /\
9390       (0 < p ==> (CARD (Z* p).carrier = p - 1))
9391Proof
9392  rw[Zstar_def, residue_finite, residue_card]
9393QED
9394
9395(* Theorem: (Z* p).carrier = residue p *)
9396(* Proof: by Zstar_def. *)
9397Theorem Zstar_carrier:
9398  !p. (Z* p).carrier = residue p
9399Proof
9400  simp[Zstar_def]
9401QED
9402
9403(* Theorem: (Z* p).carrier = {i | 0 < i /\ i < p} *)
9404(* Proof: by Zstar_carrier, residue_def. *)
9405Theorem Zstar_carrier_alt:
9406  !p. (Z* p).carrier = {i | 0 < i /\ i < p}
9407Proof
9408  simp[Zstar_carrier, residue_def, EXTENSION]
9409QED
9410
9411(* Theorem: (Z* p).id = 1 *)
9412(* Proof: by Zstar_def. *)
9413Theorem Zstar_id:
9414  !p. (Z* p).id = 1
9415Proof
9416  simp[Zstar_def]
9417QED
9418
9419(* Theorem: FINITE (Z* p).carrier *)
9420(* Proof: by Zstar_property *)
9421Theorem Zstar_finite:
9422    !p. FINITE (Z* p).carrier
9423Proof
9424  rw[Zstar_property]
9425QED
9426
9427(* Theorem: 0 < p ==> (CARD (Z* p).carrier = p - 1) *)
9428(* Proof: by Zstar_property *)
9429Theorem Zstar_card:
9430    !p. 0 < p ==> (CARD (Z* p).carrier = p - 1)
9431Proof
9432  rw[Zstar_property]
9433QED
9434
9435(* Theorem: Z* p is a Group for prime p. *)
9436(* Proof: check definitions.
9437   Closure: 0 < (x * y) MOD p < p
9438      true by EUCLID_LEMMA and MOD_LESS.
9439   Associativity: ((x * y) MOD p * z) MOD p = (x * (y * z) MOD p) MOD p
9440      true by MOD_MULT_ASSOC.
9441   Inverse: ?y. (0 < y /\ y < p) /\ ((y * x) MOD p = 1)
9442      true by MOD_MULT_INV_DEF.
9443*)
9444Theorem Zstar_group:
9445    !p. prime p ==> Group (Z* p)
9446Proof
9447  rw_tac std_ss[group_def_alt, Zstar_property, residue_def, GSPECIFICATION, ONE_LT_PRIME] >| [
9448    `x MOD p <> 0 /\ y MOD p <> 0` by rw_tac arith_ss[] >>
9449    `(x * y) MOD p <> 0` by metis_tac[EUCLID_LEMMA] >>
9450    decide_tac,
9451    rw_tac arith_ss[],
9452    rw_tac std_ss[PRIME_POS, MOD_MULT_ASSOC],
9453    metis_tac[MOD_MULT_INV_DEF]
9454  ]
9455QED
9456
9457(* Theorem: If p is prime, Z*p is a Finite Group. *)
9458(* Proof: by Zstar_group, FINITE (Z* p).carrier *)
9459Theorem Zstar_finite_group:
9460    !p. prime p ==> FiniteGroup (Z* p)
9461Proof
9462  rw[FiniteGroup_def, Zstar_group, Zstar_property]
9463QED
9464
9465(* Theorem: If p is prime, Z*p is a Finite Abelian Group. *)
9466(* Proof:
9467   Verify all finite Abelian group axioms for Z*p.
9468*)
9469Theorem Zstar_finite_abelian_group:
9470    !p. prime p ==> FiniteAbelianGroup (Z* p)
9471Proof
9472  rw_tac std_ss[FiniteAbelianGroup_def, AbelianGroup_def, Zstar_property, residue_def, GSPECIFICATION] >-
9473  rw_tac std_ss[Zstar_group] >>
9474  rw_tac arith_ss[]
9475QED
9476
9477(* Theorem: (Z* p).exp a n = a ** n MOD p *)
9478(* Proof:
9479   By induction on n.
9480   Base case: (Z* p).exp a 0 = a ** 0 MOD p
9481      (Z* p).exp a 0
9482    = (Z* p).id                   by group_exp_0
9483    = 1                           by Zstar_def
9484    = 1 MOD 1                     by DIVMOD_ID, 0 < 1
9485    = a ** 0 MOD p                by EXP
9486   Step case:  (Z* p).exp a n = a ** n MOD p ==> (Z* p).exp a (SUC n) = a ** SUC n MOD p
9487      (Z* p).exp a (SUC n)
9488    = a * ((Z* p).exp a n)     by group_exp_SUC
9489    = a * ((a ** n) MOD p)        by inductive hypothesis
9490    = (a MOD p) * ((a**n) MOD p)  by a < p, MOD_LESS
9491    = (a*(a**n)) MOD p            by MOD_TIMES2
9492    = (a**(SUC n) MOD p           by EXP
9493*)
9494Theorem Zstar_exp:
9495    !p a. prime p /\ a IN (Z* p).carrier ==> !n. (Z* p).exp a n = (a ** n) MOD p
9496Proof
9497  rw[Zstar_def, monoid_exp_def, residue_def] >>
9498  `0 < p /\ 1 < p` by rw_tac std_ss[PRIME_POS, ONE_LT_PRIME] >>
9499  Induct_on `n` >-
9500  rw_tac std_ss[FUNPOW_0, EXP, ONE_MOD] >>
9501  rw_tac std_ss[FUNPOW_SUC, EXP] >>
9502  `a MOD p = a` by rw_tac arith_ss[] >>
9503  metis_tac[MOD_TIMES2]
9504QED
9505
9506(*
9507- group_order_property |> ISPEC ``(Z* p)``;
9508> val it = |- FiniteGroup (Z* p) ==> !x. x IN (Z* p).carrier ==>
9509         0 < order (Z* p) x /\  ((Z* p).exp x (order (Z* p) x) = (Z* p).id) : thm
9510- EVAL ``order (Z* 5) 1``;
9511> val it = |- order (Z* 5) 1 = 1 : thm
9512- EVAL ``order (Z* 5) 2``;
9513> val it = |- order (Z* 5) 2 = 4 : thm
9514- EVAL ``order (Z* 5) 3``;
9515> val it = |- order (Z* 5) 3 = 4 : thm
9516- EVAL ``order (Z* 5) 4``;
9517> val it = |- order (Z* 5) 4 = 2 : thm
9518*)
9519
9520(* Theorem: (Z* p).inv x = x ** (order (Z* p) x - 1) *)
9521(* Proof: by group_order_property and group_rinv_unique. *)
9522Theorem Zstar_inv[simp]:
9523    !p. prime p ==> !x. 0 < x /\ x < p ==> ((Z* p).inv x = (Z* p).exp x (order (Z* p) x - 1))
9524Proof
9525  rpt strip_tac >>
9526  `x IN residue p` by rw_tac std_ss[residue_def, GSPECIFICATION] >>
9527  `x IN (Z* p).carrier /\ ((Z* p).id = 1)` by rw_tac std_ss[Zstar_property] >>
9528  `Group (Z* p)` by rw_tac std_ss[Zstar_group] >>
9529  `FiniteGroup (Z* p)` by rw_tac std_ss[FiniteGroup_def, Zstar_property] >>
9530  `0 < order (Z* p) x /\ ((Z* p).exp x (order (Z* p) x) = 1)` by rw_tac std_ss[group_order_property] >>
9531  `SUC ((order (Z* p) x) - 1) = order (Z* p) x` by rw_tac arith_ss[] >>
9532  metis_tac[group_rinv_unique, group_exp_SUC, group_exp_element]
9533QED
9534
9535(* val _ = computeLib.add_persistent_funs ["Zstar_inv"]; -- cannot put a non-function. *)
9536
9537(* Theorem: As function, (Z* p).inv x = x ** (order (Z* p) x - 1) *)
9538(* Proof: by Zstar_inv. *)
9539Theorem Zstar_inv_compute:
9540    !p x. (Z* p).inv x = if prime p /\ 0 < x /\ x < p then (Z* p).exp x (order (Z* p) x - 1)
9541                           else FAIL ((Z* p).inv x) bad_element
9542Proof
9543  rw_tac std_ss[Zstar_inv, combinTheory.FAIL_DEF]
9544QED
9545
9546(* Now put thse input computeLib for EVAL *)
9547val _ = computeLib.add_persistent_funs ["Zstar_eval"];
9548val _ = computeLib.add_persistent_funs ["Zstar_inv_compute"];
9549val _ = computeLib.set_EVAL_skip ``combin$FAIL`` (SOME 0);
9550
9551(*
9552- EVAL ``(Z* 5).op 3 2``;
9553> val it = |- (Z* 5).op 3 2 = 1 : thm
9554- EVAL ``(Z* 5).id``;
9555> val it = |- (Z* 5).id = 1 : thm
9556- EVAL ``(Z* 5).inv 2``;
9557> val it = |- (Z* 5).inv 2 = if prime 5 then 3 else FAIL ((Z* 5).inv 2) bad_element : thm
9558- EVAL ``prime 5``;
9559> val it = |- prime 5 <=> prime 5 : thm
9560*)
9561
9562(*
9563- SIMP_CONV (srw_ss()) [] ``(Z* 5).op 3 2``;
9564> val it = |- (Z* 5).op 3 2 = 1 : thm
9565- SIMP_CONV (srw_ss()) [] ``(Z* 5).id``;
9566> val it = |- (Z* 5).id = 1 : thm
9567- SIMP_CONV (srw_ss()) [] ``(Z* 5).inv 2``;
9568! Uncaught exception:
9569! UNCHANGED
9570*)
9571
9572(* ------------------------------------------------------------------------- *)
9573(* Euler's generalization of Modulo Multiplicative Group for any modulo n.   *)
9574(* ------------------------------------------------------------------------- *)
9575
9576(* Define Multiplicative Modulo n Group *)
9577Definition Estar_def[nocompute]:
9578  Estar n : num group =
9579   <| carrier := Euler n;
9580           id := 1;
9581      (*  inv := GCD_MOD_MULT_INV n; *)
9582           op := (\i j. (i * j) MOD n)
9583    |>
9584End
9585
9586(*
9587- type_of ``Estar n``;
9588> val it = ``:num group`` : hol_type
9589*)
9590
9591(* Theorem: Estar n =
9592       <|carrier := {i | 0 < i /\ i < n /\ coprime n i} ; id := 1; op := (\i j. (i * j) MOD n)|>*)
9593(* Proof: by Estar_def, Euler_def *)
9594Theorem Estar_alt:
9595    !n. Estar n =
9596       <|carrier := {i | 0 < i /\ i < n /\ coprime n i} ; id := 1; op := (\i j. (i * j) MOD n)|>
9597Proof
9598  rw[Estar_def, Euler_def]
9599QED
9600
9601(* Theorem: Evaluation of Zstar for each record field. *)
9602(* Proof: by Etar_def. *)
9603Theorem Estar_eval[compute]:
9604    !n. ((Estar n).carrier = Euler n) /\
9605       (!x y. (Estar n).op x y = (x * y) MOD n) /\
9606       ((Estar n).id = 1)
9607Proof
9608  rw_tac std_ss[Estar_def]
9609QED
9610(* This is put to computeLib, later also Estar_inv_compute. *)
9611
9612(* Theorem: x IN (Estar n).carrier <=> 0 < x /\ x < n /\ coprime n x *)
9613(* Proof: by Estar_def, Euler_def *)
9614Theorem Estar_element:
9615    !n x. x IN (Estar n).carrier <=> 0 < x /\ x < n /\ coprime n x
9616Proof
9617  rw[Estar_def, Euler_def]
9618QED
9619
9620(* Theorem: properties of (Estar n). *)
9621(* Proof: by definition. *)
9622Theorem Estar_property:
9623    !n. ((Estar n).carrier = Euler n) /\
9624       ((Estar n).id = 1) /\
9625       (!x y. (Estar n).op x y = (x * y) MOD n) /\
9626       FINITE (Estar n).carrier /\
9627       (CARD (Estar n).carrier = totient n)
9628Proof
9629  rw_tac std_ss[Estar_def, totient_def] >>
9630  rw_tac std_ss[Euler_def] >>
9631  `{i | 0 < i /\ i < n /\ coprime n i} SUBSET count n` by rw[SUBSET_DEF] >>
9632  metis_tac[FINITE_COUNT, SUBSET_FINITE]
9633QED
9634
9635(* Theorem: (Estar n).carrier = Euler n *)
9636(* Proof: by Estar_def. *)
9637Theorem Estar_carrier:
9638  !n. (Estar n).carrier = Euler n
9639Proof
9640  simp[Estar_def]
9641QED
9642
9643(* Theorem: (Estar n).carrier = {i | 0 < i /\ i < n /\ coprime n i } *)
9644(* Proof: by Estar_carrier, Euler_def. *)
9645Theorem Estar_carrier_alt:
9646  !n. (Estar n).carrier = {i | 0 < i /\ i < n /\ coprime n i }
9647Proof
9648  simp[Estar_carrier, Euler_def, EXTENSION]
9649QED
9650
9651(* Theorem: (Estar n).id = 1 *)
9652(* Proof: by Estar_def. *)
9653Theorem Estar_id:
9654  !n. (Estar n).id = 1
9655Proof
9656  simp[Estar_def]
9657QED
9658
9659(* Theorem: FINITE (Estar n).carrier *)
9660(* Proof: by Estar_property *)
9661Theorem Estar_finite:
9662    !n. FINITE (Estar n).carrier
9663Proof
9664  rw[Estar_property]
9665QED
9666
9667(* Theorem: CARD (Estar n).carrier = totient n *)
9668(* Proof: by Estar_property *)
9669Theorem Estar_card:
9670    !n. CARD (Estar n).carrier = totient n
9671Proof
9672  rw[Estar_property]
9673QED
9674
9675(* Theorem: CARD (Estar n).carrier = totient n *)
9676(* Proof: by Estar_card, phi_eq_totient *)
9677Theorem Estar_card_alt:
9678    !n. 1 < n ==> (CARD (Estar n).carrier = phi n)
9679Proof
9680  rw[Estar_card, phi_eq_totient]
9681QED
9682
9683(* Theorem: Estar is a Group *)
9684(* Proof: check definitions.
9685   Closure: 1 < n /\ coprime n x /\ coprime n y ==> 0 < (x * y) MOD n < n
9686      true by MOD_NONZERO_WHEN_GCD_ONE, PRODUCT_WITH_GCD_ONE, MOD_LESS.
9687   Closure: 1 < n /\ coprime n x /\ coprime n y ==> coprime n ((x * y) MOD n
9688      true by MOD_WITH_GCD_ONE, PRODUCT_WITH_GCD_ONE.
9689   Associativity: ((x * y) MOD n * z) MOD n = (x * (y * z) MOD n) MOD n
9690      true by MOD_MULT_ASSOC.
9691   Inverse: 1 < n /\ coprime n x ==> ?y. (0 < y /\ y < n /\ coprime n y) /\ ((y * x) MOD n = 1)
9692      true by GEN_MULT_INV_DEF.
9693*)
9694Theorem Estar_group:
9695    !n. 1 < n ==> Group (Estar n)
9696Proof
9697  rw_tac std_ss[group_def_alt, Estar_property, Euler_def, GSPECIFICATION, GCD_1] >-
9698  rw_tac std_ss[MOD_NONZERO_WHEN_GCD_ONE, PRODUCT_WITH_GCD_ONE] >-
9699  rw_tac arith_ss[] >-
9700  rw_tac std_ss[MOD_WITH_GCD_ONE, PRODUCT_WITH_GCD_ONE, ONE_LT_POS] >-
9701  rw_tac std_ss[MOD_MULT_ASSOC, ONE_LT_POS] >>
9702  metis_tac[GEN_MULT_INV_DEF]
9703QED
9704
9705(* Theorem: Estar is a Finite Group *)
9706(* Proof: by Estar_group, FINITE (Estar n).carrier. *)
9707Theorem Estar_finite_group:
9708    !n. 1 < n ==> FiniteGroup (Estar n)
9709Proof
9710  rw[FiniteGroup_def, Estar_group, Estar_property]
9711QED
9712
9713(* Theorem: Estar is a Finite Abelian Group *)
9714(* Proof: by checking definitions. *)
9715Theorem Estar_finite_abelian_group:
9716    !n. 1 < n ==> FiniteAbelianGroup (Estar n)
9717Proof
9718  rw_tac arith_ss [FiniteAbelianGroup_def, AbelianGroup_def, Estar_group, Estar_property]
9719QED
9720
9721(* Theorem: (Estar n).exp a k = a ** k MOD n *)
9722(* Proof:
9723   By induction on k.
9724   Base case: (Estar n).exp a 0 = a ** 0 MOD n
9725     (Estar n).exp a 0
9726   = (Estar n).id                   by group_exp_0
9727   = 1                              by Estar_def
9728   = 1 MOD n                        by ONE_MOD
9729   = a ** 0 MOD n                   by EXP
9730   Step case: (Estar n).exp a k = a ** k MOD n ==> (Estar n).exp a (SUC k) = a ** SUC k MOD n
9731     (Estar n).exp a (SUC k)
9732   = a * (group_exp (Estar n) a k)  by group_exp_SUC
9733   = a * ((a ** k) MOD n)           by inductive hypothesis
9734   = (a MOD n) * ((a ** k) MOD n)   by a < n, MOD_LESS
9735   = (a * (a ** k)) MOD n           by MOD_TIMES2
9736   = (a ** (SUC k) MOD n            by EXP
9737*)
9738Theorem Estar_exp:
9739    !n a. 1 < n /\ a IN (Estar n).carrier ==> !k. (Estar n).exp a k = (a ** k) MOD n
9740Proof
9741  rpt strip_tac >>
9742  `Group (Estar n)` by rw_tac std_ss[Estar_group] >>
9743  `0 < n` by decide_tac >>
9744  Induct_on `k` >| [
9745    rw_tac std_ss[group_exp_0, EXP, Estar_def],
9746    rw_tac std_ss[group_exp_SUC, EXP, Estar_def] >>
9747    `!x. x IN (Estar n).carrier ==> (x MOD n = x)` by rw[Estar_def, Euler_def, residue_def] >>
9748    metis_tac[MOD_TIMES2]
9749  ]
9750QED
9751
9752(* ------------------------------------------------------------------------- *)
9753(* Euler-Fermat Theorem.                                                     *)
9754(* ------------------------------------------------------------------------- *)
9755
9756(* Theorem: For all a in Estar n, a ** (totient n) MOD n = 1 *)
9757(* Proof:
9758   Since FiniteAbelianGroup (Estar n)        by Estar_finite_abelian_group, 1 < n
9759     and a IN (Estar n).carrier              by Estar_property, Euler_element
9760     and (Estar n).id = 1                    by Estar_property
9761     and CARD (Estar n).carrier = totient n  by Estar_property
9762     and !k. (Estar n).exp k = a ** k MOD n  by Estar_exp
9763   Hence a ** (totient n) MOD n = 1          by finite_abelian_Fermat
9764*)
9765Theorem Euler_Fermat_eqn:
9766    !n a. 1 < n /\ a < n /\ coprime n a ==> (a ** (totient n) MOD n = 1)
9767Proof
9768  rpt strip_tac >>
9769  `0 < a` by metis_tac[GCD_0, NOT_ZERO, LESS_NOT_EQ] >>
9770  metis_tac[Estar_finite_abelian_group, Euler_element, Estar_property, finite_abelian_Fermat, Estar_exp]
9771QED
9772
9773(* Theorem: 1 < n /\ coprime n a ==> (a ** (totient n) MOD n = 1) *)
9774(* Proof:
9775   Let b = a MOD n.
9776   Then b < n            by MOD_LESS, 0 < n
9777    and coprime n b      by coprime_mod, 0 < n
9778        a ** totient n MOD n
9779      = b ** totient n MOD n   by MOD_EXP
9780      = 1                      by Euler_Fermat_eqn
9781*)
9782Theorem Euler_Fermat_thm:
9783    !n a. 1 < n /\ coprime n a ==> (a ** (totient n) MOD n = 1)
9784Proof
9785  rpt strip_tac >>
9786  qabbrev_tac `b = a MOD n` >>
9787  `b < n` by rw[Abbr`b`] >>
9788  `coprime n b` by rw[coprime_mod, Abbr`b`] >>
9789  `a ** totient n MOD n = b ** totient n MOD n` by rw[MOD_EXP, Abbr`b`] >>
9790  metis_tac[Euler_Fermat_eqn]
9791QED
9792
9793(* Theorem: 1 < n /\ coprime a n ==> (a ** (totient n) MOD n = 1) *)
9794(* Proof: by Euler_Fermat_thm, GCD_SYM *)
9795Theorem Euler_Fermat_alt:
9796    !n a. 1 < n /\ coprime a n ==> (a ** (totient n) MOD n = 1)
9797Proof
9798  rw[Euler_Fermat_thm, GCD_SYM]
9799QED
9800
9801(* Theorem: For prime p, 0 < a < p ==> a ** (p - 1) MOD p = 1 *)
9802(* Proof
9803   Using Z* p:
9804   Given prime p, 0 < p                      by PRIME_POS
9805     ==> FiniteAbelianGroup (Z* p)           by Zstar_finite_abelian_group
9806     and 0 < a < p ==> a IN (Z* p).carrier   by Zstar_def, residue_def
9807     and CARD (Z* p).carrier = (p - 1)       by Zstar_property
9808     and !n. (Z* p).exp a n = a ** n MOD p   by Zstar_exp
9809   Hence a ** (p - 1) MOD p = 1              by finite_abelian_Fermat
9810
9811   Using Euler_Fermat_thm:
9812   For prime p,  1 < p                   by ONE_LT_PRIME
9813       and  gcd p a = 1                  by prime_coprime_all_lt
9814   Hence  (a ** (totient p) MOD p = 1)   by Euler_Fermat_eqn, 1 < p
9815   or      a ** (p-1) MOD p = 1          by Euler_card_prime
9816*)
9817Theorem Fermat_little_thm:
9818    !p a. prime p /\ 0 < a /\ a < p ==> (a ** (p - 1) MOD p = 1)
9819Proof
9820  rw[ONE_LT_PRIME, prime_coprime_all_lt, Euler_Fermat_eqn, GSYM Euler_card_prime]
9821QED
9822
9823(* Theorem: prime p ==> (a ** p MOD p = a MOD p) *)
9824(* Proof:
9825   Note 0 < p             by PRIME_POS
9826     so p = SUC (p - 1)   by arithmetic
9827   Let b = a MOD p.
9828   Then b ** p MOD p = a ** p MOD p    by MOD_EXP, 0 < p
9829   Thus the goal is: b ** p MOD p = b.
9830   If b = 0,
9831        0 ** p MOD p
9832      = 0 MOD p                        by ZERO_EXP
9833      = 0                              by ZERO_MOD
9834   If b <> 0,
9835      Then 0 < b /\ b < p              by MOD_LESS, 0 < p
9836        b ** p MOD p
9837      = (b ** (SUC (p - 1))) MOD p     by above
9838      = (b * b ** (p - 1)) MOD p       by EXP
9839      = ((b MOD p) * (b ** (p - 1) MOD p)) MOD p
9840                                       by MOD_TIMES2
9841      = ((b MOD p) * 1) MOD p          by Fermat_little_thm
9842      = b MOD p MOD p                  by MULT_RIGHT_1
9843      = b MOD p                        by MOD_MOD
9844      = a MOD p                        by MOD_MOD
9845      = b                              by notation
9846*)
9847Theorem Fermat_little_eqn:
9848    !p a. prime p ==> (a ** p MOD p = a MOD p)
9849Proof
9850  rpt strip_tac >>
9851  `0 < p` by rw[PRIME_POS] >>
9852  qabbrev_tac `b = a MOD p` >>
9853  `b < p` by rw[Abbr`b`] >>
9854  `b ** p MOD p = b` suffices_by rw[MOD_EXP, Abbr`b`] >>
9855  Cases_on `b = 0` >-
9856  metis_tac[ZERO_EXP, ZERO_MOD, NOT_ZERO_LT_ZERO] >>
9857  `0 < b` by decide_tac >>
9858  `b ** (p - 1) MOD p = 1` by rw[Fermat_little_thm] >>
9859  `p = SUC (p - 1)` by decide_tac >>
9860  metis_tac[EXP, MOD_TIMES2, MOD_MOD, MULT_RIGHT_1]
9861QED
9862
9863(* Theorem: 1 < n /\ a < n /\ coprime n a ==>
9864           ((Estar n).inv a = a ** ((totient n) - 1) MOD n) *)
9865(* Proof:
9866   Note Group (Estar n)            by Estar_group, 1 < n
9867    and 0 < a                      by GCD_0, n <> 1
9868    and a IN (Estar n).carrier     by Estar_element
9869   Let b = a ** ((totient n) - 1) MOD n.
9870   The goal becomes: (Estar n).inv a = b.
9871
9872   Note b = (Estar n).exp a ((totient n) - 1)      by Estar_exp
9873   Thus b IN (Estar n).carrier                     by group_exp_element
9874        (Estar n).op a b
9875      = (a * a ** ((totient n) - 1) MOD n) MOD n   by Estar_property
9876      = (a * a ** (totient n - 1)) MOD n           by LESS_MOD, MOD_TIMES2, 0 < n
9877      = (a ** SUC (totient n - 1)) MOD n           by EXP
9878      = (a ** totient n) MOD n                     by 0 < totient n from Euler_card_bounds
9879      = 1                                          by Euler_Fermat_eqn
9880      = (Estar n).id                               by Estar_property
9881   Therefore b = (Estar n).inv a                   by group_rinv_unique
9882*)
9883Theorem Estar_inv:
9884    !n a. 1 < n /\ a < n /\ coprime n a ==>
9885      ((Estar n).inv a = a ** ((totient n) - 1) MOD n)
9886Proof
9887  rpt strip_tac >>
9888  `Group (Estar n)` by rw_tac std_ss[Estar_group] >>
9889  `0 < a` by metis_tac[GCD_0, NOT_ZERO, LESS_NOT_EQ] >>
9890  `a IN (Estar n).carrier` by rw_tac std_ss[Estar_element] >>
9891  qabbrev_tac `b = a ** ((totient n) - 1) MOD n` >>
9892  `b = (Estar n).exp a ((totient n) - 1)` by rw[Estar_exp, Abbr`b`] >>
9893  `b IN (Estar n).carrier` by rw[] >>
9894  `(Estar n).op a b = (Estar n).id` by
9895  (`(Estar n).id = 1` by rw[Estar_property] >>
9896  `(Estar n).op a b = (a * (a ** ((totient n) - 1) MOD n)) MOD n`
9897     by rw[Estar_property, Abbr`b`] >>
9898  `_ = (a * a ** (totient n - 1)) MOD n` by metis_tac[LESS_MOD, MOD_TIMES2, ONE_LT_POS] >>
9899  `_ = (a ** SUC (totient n - 1)) MOD n` by rw[EXP] >>
9900  `0 < totient n` by rw[Euler_card_bounds] >>
9901  `SUC (totient n - 1) = totient n` by decide_tac >>
9902  rw[Euler_Fermat_eqn]) >>
9903  metis_tac[group_rinv_unique]
9904QED
9905
9906(* Theorem: As function, (Estar n).inv a = a ** (totient n - 1) MOD n) *)
9907(* Proof: by Estar_inv. *)
9908Theorem Estar_inv_compute[compute]:
9909    !n a. (Estar n).inv a = if 1 < n /\ a < n /\ coprime n a
9910                           then a ** ((totient n) - 1) MOD n
9911                           else FAIL ((Estar n).inv a) bad_element
9912Proof
9913  rw_tac std_ss[Estar_inv, combinTheory.FAIL_DEF]
9914QED
9915(* put in computeLib for Estar inverse computation *)
9916
9917(*
9918> EVAL ``(Estar 10).inv 3``;
9919val it = |- (Estar 10).inv 3 = 7: thm
9920*)
9921
9922(* ------------------------------------------------------------------------- *)
9923(* The following is a rework from Hol/examples/elliptic/groupScript.sml      *)
9924(* ------------------------------------------------------------------------- *)
9925
9926(* ------------------------------------------------------------------------- *)
9927(* The Trivial Group.                                                        *)
9928(* ------------------------------------------------------------------------- *)
9929
9930(* The trivial group: {#e} *)
9931Definition trivial_group_def[nocompute]:
9932  trivial_group e : 'a group =
9933   <| carrier := {e};
9934           id := e;
9935       (* inv := (\x. e);  *)
9936           op := (\x y. e)
9937    |>
9938End
9939
9940(*
9941- type_of ``trivial_group e``;
9942> val it = ``:'a group`` : hol_type
9943*)
9944
9945(* Theorem: (trivial_group e).carrier = {e} *)
9946(* Proof: by trivial_group_def. *)
9947Theorem trivial_group_carrier:
9948  !e. (trivial_group e).carrier = {e}
9949Proof
9950  simp[trivial_group_def]
9951QED
9952
9953(* Theorem: (trivial_group e).id = e *)
9954(* Proof: by trivial_group_def. *)
9955Theorem trivial_group_id:
9956  !e. (trivial_group e).id = e
9957Proof
9958  simp[trivial_group_def]
9959QED
9960
9961(* Theorem: {#e} is indeed a group *)
9962(* Proof: check by definition. *)
9963Theorem trivial_group:
9964    !e. FiniteAbelianGroup (trivial_group e)
9965Proof
9966  rw_tac std_ss[trivial_group_def, FiniteAbelianGroup_def, FiniteGroup_def, AbelianGroup_def, group_def_alt, IN_SING, FINITE_SING, GSPECIFICATION]
9967QED
9968
9969(* ------------------------------------------------------------------------- *)
9970(* The Function Cyclic Group.                                                *)
9971(* ------------------------------------------------------------------------- *)
9972
9973(* Cyclic group of f and e
9974   = all FUNPOW f by a generator e
9975   = {e, f e, f f e, f f f e, ... }
9976*)
9977
9978Definition fn_cyclic_group_def[nocompute]:
9979    fn_cyclic_group e f : 'a group =
9980   <| carrier := { x | ?n. FUNPOW f n e = x };
9981           id := e; (* Note: next comment must be in one line *)
9982      (*  inv := (\x. @y. ?yi. (FUNPOW f yi e = y) /\ (!xi. (FUNPOW f xi e = x) ==> (FUNPOW f (xi + yi) e = e)));  *)
9983           op := (\x y. @z. !xi yi.
9984                   (FUNPOW f xi e = x) /\ (FUNPOW f yi e = y) ==>
9985                   (FUNPOW f (xi + yi) e = z))
9986    |>
9987End
9988
9989(*
9990- type_of ``fn_cyclic_group e f``;
9991> val it = ``:'a group`` : hol_type
9992*)
9993
9994(* Original:
9995
9996val fn_cyclic_group_def = Define
9997  `fn_cyclic_group e f : 'a group =
9998   <| carrier := { x | ?n. FUNPOW f n e = x };
9999      id := e;
10000      inv := (\x. @y. ?yi. !xi.
10001                (FUNPOW f yi e = y) /\
10002                ((FUNPOW f xi e = x) ==> (FUNPOW f (xi + yi) e = e)));
10003      mult := (\x y. @z. !xi yi.
10004                (FUNPOW f xi e = x) /\ (FUNPOW f yi e = y) ==>
10005                (FUNPOW f (xi + yi) e = z)) |>`;
10006
10007*)
10008
10009(* Theorem: alternative characterization of cyclic group:
10010   If there exists a period k: k <> 0 /\ FUNPOW f k e = e
10011   Let order n = LEAST such k, then:
10012   (1) (fn_cyclic_group e f).carrier = { FUNPOW f k e | k < n }
10013   (2) (fn_cyclic_group e f).id = e)
10014   (3) !i. (fn_cyclic_group e f).inv (FUNPOW f i e) = FUNPOW f ((n - i MOD n) MOD n) e
10015   (4) !i j. (fn_cyclic_group e f).op (FUNPOW f i e) (FUNPOW f j e) = FUNPOW f ((i + j) MOD n) e
10016*)
10017(* Proof:
10018   Expand by fn_cyclic_group_def, this is to show:
10019   (1) 0 < h /\ FUNPOW f h e = e ==> ?k. (FUNPOW f n e = FUNPOW f k e) /\ k < h
10020       Since (n MOD h) < h                         by MOD_LESS
10021         and FUNPOW f n e = FUNPOW f (n MOD h) e   by FUNPOW_MOD, 0 < h
10022       So take k = n MOD h will satisfy the requirements.
10023   (2) ?n. FUNPOW f n e = FUNPOW f k e
10024       Just take n = k.
10025   (3) (@z. !xi yi. (FUNPOW f xi e = FUNPOW f i e) /\ (FUNPOW f yi e = FUNPOW f j e) ==>
10026                    (FUNPOW f (xi + yi) e = z)) = FUNPOW f ((i + j) MOD h) e
10027       This comes down to show:
10028       (1) ?z. !xi yi. (FUNPOW f xi e = FUNPOW f i e) /\ (FUNPOW f yi e = FUNPOW f j e) ==>
10029                       (FUNPOW f (xi + yi) e = z)
10030           Let z = FUNPOW f (i + j) e,
10031           the goal simplifies to: FUNPOW f (xi + yi) e = FUNPOW f (i + j) e
10032             FUNPOW f (xi + yi) e
10033           = FUNPOW f xi (FUNPOW f yi e)     by FUNPOW_ADD
10034           = FUNPOW f xi (FUNPOW f j e)      by given
10035           = FUNPOW f (xi + j) e             by FUNPOW_ADD
10036           = FUNPOW f (j + xi) e             by ADD_COMM
10037           = FUNPOW f j (FUNPOW f xi e)      by FUNPOW_ADD
10038           = FUNPOW f j (FUNPOW f i e)       by given
10039           = FUNPOW f (j + i) e              by FUNPOW_ADD
10040           = FUNPOW f (i + j) e              by ADD_COMM
10041       (2) z = FUNPOW f ((i + j) MOD h) e
10042           That is, FUNPOW f (i + j) e = FUNPOW f ((i + j) MOD h) e
10043           which is true by FUNPOW_MOD
10044*)
10045Theorem fn_cyclic_group_alt:
10046    !e f n.
10047     (?k. k <> 0 /\ (FUNPOW f k e = e)) /\
10048     (n = LEAST k. k <> 0 /\ (FUNPOW f k e = e)) ==>
10049     ((fn_cyclic_group e f).carrier = { FUNPOW f k e | k < n }) /\
10050     ((fn_cyclic_group e f).id = e) /\
10051  (* (!i. (fn_cyclic_group e f).inv (FUNPOW f i e) = FUNPOW f ((n - i MOD n) MOD n) e) /\ *)
10052     (!i j. (fn_cyclic_group e f).op (FUNPOW f i e) (FUNPOW f j e) = FUNPOW f ((i + j) MOD n) e)
10053Proof
10054  rpt gen_tac >>
10055  simp_tac std_ss [WhileTheory.LEAST_EXISTS] >>
10056  Q.SPEC_TAC (`LEAST k. k <> 0 /\ (FUNPOW f k e = e)`,`h`) >>
10057  gen_tac >>
10058  strip_tac >>
10059  `0 < h` by decide_tac >>
10060  rw[fn_cyclic_group_def, EXTENSION, EQ_IMP_THM] >-
10061  metis_tac[FUNPOW_MOD, MOD_LESS] >-
10062  metis_tac[] >>
10063  normalForms.SELECT_TAC >>
10064  match_mp_tac (PROVE [] ``a /\ (b ==> c) ==> ((a ==> b) ==> c)``) >>
10065  conj_tac >| [
10066    qexists_tac `FUNPOW f (i + j) e` >>
10067    rw[] >>
10068    metis_tac[FUNPOW_ADD, ADD_COMM],
10069    rw[] >>
10070    metis_tac[FUNPOW_MOD]
10071  ]
10072QED
10073
10074(* Theorem: (fn_cyclic_group e f).carrier = { x | ?n. FUNPOW f n e = x } *)
10075(* Proof: by fn_cyclic_group_def. *)
10076Theorem fn_cyclic_group_carrier:
10077  !e f. (fn_cyclic_group e f).carrier = { x | ?n. FUNPOW f n e = x }
10078Proof
10079  simp[fn_cyclic_group_def]
10080QED
10081
10082(* Theorem: (fn_cyclic_group e f).id = e *)
10083(* Proof: by fn_cyclic_group_def. *)
10084Theorem fn_cyclic_group_id:
10085  !e f. (fn_cyclic_group e f).id = e
10086Proof
10087  simp[fn_cyclic_group_def]
10088QED
10089
10090(* Theorem: Group (fn_cyclic_group e f) *)
10091(* Proof:
10092   By fn_cyclic_group_alt and group_def_alt.
10093   This comes down to 2 goals:
10094   (1) ?n. n <> 0 /\ (FUNPOW f n e = e) ==>
10095       (?k. k <> 0 /\ (FUNPOW f k e = e)) /\ ((LEAST n. n <> 0 /\ (FUNPOW f n e = e)) =
10096       LEAST k. k <> 0 /\ (FUNPOW f k e = e))
10097       This is trivially true.
10098   (2) Group (fn_cyclic_group e f)
10099       By group_def_alt, this is to show:
10100       (1) ?k''. (FUNPOW f ((k + k') MOD h) e = FUNPOW f k'' e) /\ k'' < h
10101           Let k'' = (k + k') MOD h, this is true by MOD_LESS
10102       (2) FUNPOW f (((k + k') MOD h + k'') MOD h) e = FUNPOW f ((k + (k' + k'') MOD h) MOD h) e
10103             ((k + k') MOD h + k'') MOD h
10104           = ((k + k') MOD h + k'' MOD h) MOD h   by LESS_MOD
10105           = (k + k' + k'') MOD h                 by MOD_PLUS
10106           = (k + (k' + k'')) MOD h               by ADD_ASSOC
10107           = (k MOD h + (k' + k'') MOD h) MOD h   by MOD_PLUS
10108           = (k + (k' + k'') MOD h) MOD h         by LESS_MOD
10109       (3) ?k. (e = FUNPOW f k e) /\ k < h
10110           Take k = 0, then FUNPOW f 0 e = e      by FUNPOW_0
10111       (4) (fn_cyclic_group e f).op e (FUNPOW f k e) = FUNPOW f k e
10112           With FUNPOW f 0 e = e                  by FUNPOW_0
10113            and the given, this is to show:
10114            FUNPOW f ((0 + k) MOD h) e = FUNPOW f k e
10115            But (0 + k) MOD h = k MOD h = k       by LESS_MOD
10116       (5) ?y. (?k. (y = FUNPOW f k e) /\ k < h) /\ ((fn_cyclic_group e f).op y (FUNPOW f k e) = e)
10117           Let y = FUNPOW f ((h - k) MOD h) e. This is to show:
10118           (1) ?k'. (FUNPOW f ((h - k) MOD h) e = FUNPOW f k' e) /\ k' < h
10119               Take k' = (h - k) MOD h < h        by MOD_LESS
10120           (2) FUNPOW f (((h - k) MOD h + k) MOD h) e = e
10121                 ((h - k) MOD h + k) MOD h
10122               = ((h - k) MOD h + (k MOD h)) MOD h   by LESS_MOD
10123               = (h - k + k) MOD h                   by MOD_PLUS
10124               = h MOD h                             by arithmetic
10125               = 0                                   by DIVMOD_ID
10126               Thus true since FUNPOW f 0 e = e      by FUNPOW_0
10127*)
10128Theorem fn_cyclic_group_group:
10129    !e f. (?n. n <> 0 /\ (FUNPOW f n e = e)) ==> Group (fn_cyclic_group e f)
10130Proof
10131  rpt gen_tac >>
10132  disch_then assume_tac >>
10133  mp_tac (Q.SPECL [`e`,`f`,`LEAST n. n <> 0 /\ (FUNPOW f n e = e)`] fn_cyclic_group_alt) >>
10134  match_mp_tac (PROVE [] ``a /\ (b ==> c) ==> ((a ==> b) ==> c)``) >>
10135  conj_tac >-
10136  rw[] >>
10137  pop_assum mp_tac >>
10138  simp_tac std_ss [WhileTheory.LEAST_EXISTS] >>
10139  qspec_tac (`LEAST n. n <> 0 /\ (FUNPOW f n e = e)`,`h`) >>
10140  gen_tac >>
10141  rpt strip_tac >>
10142  `0 < h` by decide_tac >>
10143  rw[group_def_alt] >| [
10144    rw_tac std_ss[] >>
10145    qexists_tac `(k + k') MOD h` >>
10146    metis_tac[MOD_LESS],
10147    rw_tac std_ss[] >>
10148    metis_tac[ADD_ASSOC, MOD_PLUS, LESS_MOD],
10149    metis_tac[FUNPOW_0],
10150    metis_tac[FUNPOW_0, ADD_CLAUSES, LESS_MOD],
10151    qexists_tac `FUNPOW f ((h - k) MOD h) e` >>
10152    rw_tac std_ss[] >-
10153    metis_tac[MOD_LESS] >>
10154    metis_tac[LESS_MOD, MOD_PLUS, SUB_ADD, LESS_IMP_LESS_OR_EQ, DIVMOD_ID, FUNPOW_0]
10155  ]
10156QED
10157
10158(* Theorem: FiniteAbelianGroup (fn_cyclic_group e f) *)
10159(* Proof:
10160   Use fn_cyclic_group_alt due to assumption: (?n. n <> 0 /\ (FUNPOW f n e = e))
10161   By fn_cyclic_group_alt, this comes down to 2 goals:
10162   (1) ?n. n <> 0 /\ (FUNPOW f n e = e) ==>
10163       (?k. k <> 0 /\ (FUNPOW f k e = e)) /\ ((LEAST n. n <> 0 /\ (FUNPOW f n e = e)) =
10164       LEAST k. k <> 0 /\ (FUNPOW f k e = e))
10165       This is trivially true.
10166   (2) expand by FiniteAbelianGroup_def, AbelianGroup_def, the goals are:
10167       (1) Group (fn_cyclic_group e f), true by fn_cyclic_group_group.
10168       (2) FUNPOW f ((k + k') MOD h) e = FUNPOW f ((k' + k) MOD h) e, true by ADD_COMM
10169       (3) FINITE {FUNPOW f k e | k < h}, true by FINITE_COUNT_IMAGE
10170*)
10171Theorem fn_cyclic_group_finite_abelian_group:
10172    !e f. (?n. n <> 0 /\ (FUNPOW f n e = e)) ==> FiniteAbelianGroup (fn_cyclic_group e f)
10173Proof
10174  rpt gen_tac >>
10175  (disch_then assume_tac) >>
10176  mp_tac (Q.SPECL [`e`,`f`,`LEAST n. n <> 0 /\ (FUNPOW f n e = e)`] fn_cyclic_group_alt) >>
10177  match_mp_tac (PROVE [] ``a /\ (b ==> c) ==> ((a ==> b) ==> c)``) >>
10178  conj_tac >| [
10179    rw[],
10180    pop_assum mp_tac >>
10181    simp_tac std_ss [WhileTheory.LEAST_EXISTS] >>
10182    Q.SPEC_TAC (`LEAST n. n <> 0 /\ (FUNPOW f n e = e)`,`h`) >>
10183    gen_tac >>
10184    strip_tac >>
10185    `0 < h` by decide_tac >>
10186    strip_tac >>
10187    rw[FiniteAbelianGroup_def, AbelianGroup_def] >| [
10188      metis_tac[fn_cyclic_group_group],
10189      rw_tac std_ss[ADD_COMM],
10190      rw_tac std_ss[FINITE_COUNT_IMAGE]
10191    ]
10192  ]
10193QED
10194
10195(* Theorem: FiniteGroup (fn_cyclic_group e f) *)
10196(* Proof: by fn_cyclic_group_finite_abelian_group. *)
10197Theorem fn_cyclic_group_finite_group:
10198    !e f. (?n. n <> 0 /\ (FUNPOW f n e = e)) ==> FiniteGroup (fn_cyclic_group e f)
10199Proof
10200  metis_tac[fn_cyclic_group_finite_abelian_group, FiniteAbelianGroup_def, AbelianGroup_def, FiniteGroup_def]
10201QED
10202
10203(* ------------------------------------------------------------------------- *)
10204(* The Group of Addition Modulo n.                                           *)
10205(* ------------------------------------------------------------------------- *)
10206
10207(* Additive Modulo Group *)
10208Definition add_mod_def[nocompute]:
10209  add_mod n : num group =
10210   <| carrier := { i | i < n };
10211           id := 0;
10212       (* inv := (\i. (n - i) MOD n); *)
10213           op := (\i j. (i + j) MOD n)
10214    |>
10215End
10216(* This group, with modulus n, is taken as the additive group in ZN ring later. *)
10217(* Evaluation is given later in add_mod_eval and add_mod_inv. *)
10218
10219(*
10220- type_of ``add_mod n``;
10221> val it = ``:num group`` : hol_type
10222*)
10223
10224(* Theorem: add_mod evaluation. *)
10225(* Proof: by add_mod_def. *)
10226Theorem add_mod_eval[simp]:
10227    !n. ((add_mod n).carrier = {i | i < n}) /\
10228       (!x y. (add_mod n).op x y = (x + y) MOD n) /\
10229       ((add_mod n).id = 0)
10230Proof
10231  rw_tac std_ss[add_mod_def]
10232QED
10233
10234(* Now put these to computeLib *)
10235val _ = computeLib.add_persistent_funs ["add_mod_eval"];
10236(*
10237- EVAL ``(add_mod 5).id``;
10238> val it = |- (add_mod 5).id = 0 : thm
10239- EVAL ``(add_mod 5).op 3 4``;
10240> val it = |- (add_mod 5).op 3 4 = 2 : thm
10241- EVAL ``(add_mod 5).op 6 8``;
10242> val it = |- (add_mod 5).op 6 8 = 4 : thm
10243*)
10244(* Later put add_mod_inv_compute in computeLib. *)
10245
10246(* Theorem: x IN (add_mod n).carrier <=> x < n *)
10247(* Proof: by add_mod_def *)
10248Theorem add_mod_element:
10249    !n x. x IN (add_mod n).carrier <=> x < n
10250Proof
10251  rw[add_mod_def]
10252QED
10253
10254(* Theorem: properties of (add_mod n) *)
10255(* Proof: by definition. *)
10256Theorem add_mod_property:
10257    !n. (!x. x IN (add_mod n).carrier <=> x < n) /\
10258       ((add_mod n).id = 0) /\
10259       (!x y. (add_mod n).op x y = (x + y) MOD n) /\
10260       FINITE (add_mod n).carrier /\
10261       (CARD (add_mod n).carrier = n)
10262Proof
10263  rw_tac std_ss[add_mod_def, GSYM count_def, FINITE_COUNT, CARD_COUNT, IN_COUNT]
10264QED
10265
10266(* Theorem: (add_mod n).carrier = { i | i < n } *)
10267(* Proof: by add_mod_def. *)
10268Theorem add_mod_carrier:
10269  !n. (add_mod n).carrier = { i | i < n }
10270Proof
10271  simp[add_mod_def]
10272QED
10273
10274(* Theorem: (add_mod n).carrier = count n *)
10275(* Proof: by add_mod_def. *)
10276Theorem add_mod_carrier_alt:
10277  !n. (add_mod n).carrier = count n
10278Proof
10279  simp[add_mod_def, EXTENSION]
10280QED
10281
10282(* Theorem: (add_mod n).id = 0 *)
10283(* Proof: by add_mod_def. *)
10284Theorem add_mod_id:
10285  !n. (add_mod n).id = 0
10286Proof
10287  simp[add_mod_def]
10288QED
10289
10290(* Theorem: FINITE (add_mod n).carrier *)
10291(* Proof: by add_mod_property *)
10292Theorem add_mod_finite:
10293    !n. FINITE (add_mod n).carrier
10294Proof
10295  rw[add_mod_property]
10296QED
10297
10298(* Theorem: CARD (add_mod n).carrier = n *)
10299(* Proof: by add_mod_property *)
10300Theorem add_mod_card:
10301    !n. CARD (add_mod n).carrier = n
10302Proof
10303  rw[add_mod_property]
10304QED
10305
10306(* Theorem: Additive Modulo Group is a group. *)
10307(* Proof: check group definitions.
10308   For associativity,
10309   to show: x < n /\ y < n /\ z < n ==> ((x + y) MOD n + z) MOD n = (x + (y + z) MOD n) MOD n
10310   LHS = ((x + y) MOD n + z) MOD n
10311       = ((x + y) MOD n + z MOD n) MOD n    by LESS_MOD
10312       = (x + y + z) MOD n                  by MOD_PLUS
10313       = (x + (y + z)) MOD n                by ADD_ASSOC
10314       = (x MOD n + (y + z) MOD n) MOD n    by MOD_PLUS
10315       = (x + (y + z) MOD n) MOD n          by LESS_MOD
10316       = RHS
10317   For additive inverse,
10318   to show: x < n ==> ?y. y < n /\ ((y + x) MOD n = 0)
10319   If x = 0, take y = 0.        (0 + 0) MOD n = 0 MOD n = 0  by ZERO_MOD
10320   If x <> 0, take y = n-x. (n - x + x) MOD n = n MOD n = 0  by DIVMOD_ID
10321*)
10322Theorem add_mod_group:
10323    !n. 0 < n ==> Group (add_mod n)
10324Proof
10325  rw_tac std_ss[group_def_alt, add_mod_property] >| [
10326    metis_tac[LESS_MOD, MOD_PLUS, ADD_ASSOC],
10327    Cases_on `x = 0` >| [
10328      metis_tac[ZERO_MOD, ADD],
10329      metis_tac[DIVMOD_ID, DECIDE ``x <> 0 /\ x < n ==> n - x < n /\ (n - x + x = n)``]
10330    ]
10331  ]
10332QED
10333
10334(* Theorem: Additive Modulo Group is an Abelian group. *)
10335(* Proof: by add_mod_group and ADD_COMM. *)
10336Theorem add_mod_abelian_group:
10337    !n. 0 < n ==> AbelianGroup (add_mod n)
10338Proof
10339  rw_tac std_ss[AbelianGroup_def, add_mod_group, add_mod_property, ADD_COMM]
10340QED
10341
10342(* Theorem: Additive Modulo Group is a Finite Group. *)
10343(* Proof: by add_mod_group and add_mod_property. *)
10344Theorem add_mod_finite_group:
10345    !n. 0 < n ==> FiniteGroup (add_mod n)
10346Proof
10347  rw_tac std_ss[FiniteGroup_def, add_mod_group, add_mod_property]
10348QED
10349
10350(* Theorem: Additive Modulo Group is a Finite Abelian Group. *)
10351(* Proof: by add_mod_abelian_group and add_mod_property. *)
10352Theorem add_mod_finite_abelian_group:
10353    !n. 0 < n ==> FiniteAbelianGroup (add_mod n)
10354Proof
10355  rw_tac std_ss[FiniteAbelianGroup_def, add_mod_abelian_group, add_mod_property]
10356QED
10357
10358(* Theorem: 0 < n ==> !x m. (add_mod n).exp x m = (x * m) MOD n *)
10359(* Proof:
10360   By induction on m:
10361   Base case: (add_mod n).exp x 0 = (x * 0) MOD n
10362         (add_mod n).exp x 0
10363       = (add_mod n).id            by group_exp_0
10364       = 0                         by add_mod_property
10365       = 0 MOD n                   by ZERO_MOD, 0 < n
10366       = (x * 0) MOD n             by MULT_0
10367   Step case: (add_mod n).exp x m = (x * m) MOD n ==>
10368              (add_mod n).exp x (SUC m) = (x * SUC m) MOD n
10369         (add_mod n).exp x (SUC m)
10370       = (add_mod n).op x ((add_mod n).exp x m)   by group_exp_SUC
10371       = (add_mod n).op x ((x * m) MOD n)         by induction hypothesis
10372       = (x + ((x * m) MOD n)) MOD n              by add_mod_property
10373       = (x + x * m) MOD n                        by MOD_PLUS, MOD_MOD
10374       = (x * SUC m) MOD n                        by MULT_SUC
10375*)
10376Theorem add_mod_exp:
10377    !n. 0 < n ==> !x m. (add_mod n).exp x m = (x * m) MOD n
10378Proof
10379  rpt strip_tac >>
10380  Induct_on `m` >-
10381  rw[add_mod_property] >>
10382  rw_tac std_ss[group_exp_SUC, add_mod_property] >>
10383  metis_tac[MOD_PLUS, MOD_MOD, MULT_SUC]
10384QED
10385
10386(* Theorem: (add_mod n).inv x = (n - x) MOD n *)
10387(* Proof: by MOD_ADD_INV and group_linv_unique. *)
10388Theorem add_mod_inv[simp]:
10389    !n x. 0 < n /\ x < n ==> ((add_mod n).inv x = (n - x) MOD n)
10390Proof
10391  rpt strip_tac >>
10392  `x IN (add_mod n).carrier /\ (n - x) MOD n IN (add_mod n).carrier` by rw_tac std_ss[add_mod_property] >>
10393  `((n - x) MOD n + x) MOD n = 0` by rw_tac std_ss[MOD_ADD_INV] >>
10394  metis_tac[add_mod_group, group_linv_unique, add_mod_property]
10395QED
10396
10397(* Theorem: (add_mod n).inv x = (n - x) MOD n as function *)
10398(* Proof: by add_mod_inv. *)
10399Theorem add_mod_inv_compute:
10400    !n x. (add_mod n).inv x = if 0 < n /\ x < n then (n - x) MOD n else FAIL ((add_mod n).inv x) bad_element
10401Proof
10402  rw_tac std_ss[add_mod_inv, combinTheory.FAIL_DEF]
10403QED
10404
10405(* val _ = computeLib.add_persistent_funs ["add_mod_inv"]; -- cannot put a non-function. *)
10406
10407(* Function can be put to computeLib *)
10408val _ = computeLib.add_persistent_funs ["add_mod_inv_compute"];
10409(* val _ = computeLib.set_EVAL_skip ``combin$FAIL`` (SOME 0); *)
10410
10411(*
10412- EVAL ``(add_mod 5).inv 3``;
10413> val it = |- (add_mod 5).inv 3 = 2 : thm
10414- EVAL ``(add_mod 5).inv 7``;
10415> val it = |- (add_mod 5).inv 7 = FAIL ((add_mod 5).inv 7) bad_element : thm
10416*)
10417
10418(*
10419- SIMP_CONV (srw_ss()) [] ``(add_mod 5).op 3 4``;
10420> val it = |- (add_mod 5).op 3 4 = 2 : thm
10421- SIMP_CONV (srw_ss()) [] ``(add_mod 5).id``;
10422> val it = |- (add_mod 5).id = 0 : thm
10423- SIMP_CONV (srw_ss()) [] ``(add_mod 5).inv 2``;
10424> val it = |- (add_mod 5).inv 2 = 3 : thm
10425*)
10426
10427(* ------------------------------------------------------------------------- *)
10428(* The Group of Multiplication Modulo prime p.                               *)
10429(* ------------------------------------------------------------------------- *)
10430
10431(* Multiplicative Modulo Group *)
10432(* This version relies on fermat_little from pure Number Theory! *)
10433(*
10434val mult_mod_def = zDefine
10435  `mult_mod p =
10436   <| carrier := { i | i <> 0 /\ i < p };
10437           id := 1;
10438          inv := (\i. i ** (p - 2) MOD p);
10439         mult := (\i j. (i * j) MOD p)
10440    |>`;
10441*)
10442
10443(* This version relies on MOD_MULT_INV, using LINEAR_GCD. *)
10444Definition mult_mod_def[nocompute]:
10445  mult_mod p : num group =
10446   <| carrier := { i | i <> 0 /\ i < p };
10447           id := 1;
10448       (* inv := (\i. MOD_MULT_INV p i); *)
10449           op := (\i j. (i * j) MOD p)
10450    |>
10451End
10452(* This group, with prime modulus, is not used in ZN ring later. *)
10453(* Evaluation is given later in mult_mod_eval and mult_mod_inv. *)
10454
10455(*
10456- type_of ``mult_mod p``;
10457> val it = ``:num group`` : hol_type
10458*)
10459
10460(* Theorem: x IN (mult_mod p).carrier <=> x <> 0 /\ x < p *)
10461(* Proof: by mult_mod_def *)
10462Theorem mult_mod_element:
10463    !p x. x IN (mult_mod p).carrier <=> x <> 0 /\ x < p
10464Proof
10465  rw[mult_mod_def]
10466QED
10467
10468(* Theorem: x IN (mult_mod p).carrier <=> 0 < x /\ x < p *)
10469(* Proof: by mult_mod_def *)
10470Theorem mult_mod_element_alt:
10471    !p x. x IN (mult_mod p).carrier <=> 0 < x /\ x < p
10472Proof
10473  rw[mult_mod_def]
10474QED
10475
10476(* Theorem: properties of (mult_mod p) *)
10477(* Proof: by definition. *)
10478Theorem mult_mod_property:
10479    !p. (!x. x IN (mult_mod p).carrier ==> x <> 0) /\
10480       (!x. x IN (mult_mod p).carrier <=> 0 < x /\ x < p) /\
10481       ((mult_mod p).id = 1) /\
10482       (!x y. (mult_mod p).op x y = (x * y) MOD p) /\
10483       FINITE (mult_mod p).carrier /\
10484       (0 < p ==> (CARD (mult_mod p).carrier = p - 1))
10485Proof
10486  rw_tac std_ss[mult_mod_def, GSPECIFICATION, NOT_ZERO_LT_ZERO] >-
10487  metis_tac[residue_def, residue_finite] >>
10488  metis_tac[residue_def, residue_card]
10489QED
10490
10491(* Theorem: (mult_mod p).carrier = { i | i <> 0 /\ i < p } *)
10492(* Proof: by mult_mod_def. *)
10493Theorem mult_mod_carrier:
10494  !p. (mult_mod p).carrier = { i | i <> 0 /\ i < p }
10495Proof
10496  simp[mult_mod_def]
10497QED
10498
10499(* Theorem: (mult_mod p).carrier = residue p *)
10500(* Proof: by mult_mod_def, residue_def. *)
10501Theorem mult_mod_carrier_alt:
10502  !p. (mult_mod p).carrier = residue p
10503Proof
10504  simp[mult_mod_def, residue_def, EXTENSION]
10505QED
10506
10507(* Theorem: (mult_mod p).id = 1 *)
10508(* Proof: by mult_mod_def. *)
10509Theorem mult_mod_id:
10510  !p. (mult_mod p).id = 1
10511Proof
10512  simp[mult_mod_def]
10513QED
10514
10515(* Theorem: FINITE (mult_mod p).carrier *)
10516(* Proof: by mult_mod_property *)
10517Theorem mult_mod_finite:
10518    !p. FINITE (mult_mod p).carrier
10519Proof
10520  rw[mult_mod_property]
10521QED
10522
10523(* Theorem: 0 < p ==> (CARD (mult_mod p).carrier = p - 1) *)
10524(* Proof: by mult_mod_property *)
10525Theorem mult_mod_card:
10526    !p. 0 < p ==> (CARD (mult_mod p).carrier = p - 1)
10527Proof
10528  rw[mult_mod_property]
10529QED
10530
10531(* Theorem: Multiplicative Modulo Group is a group for prime p. *)
10532(* Proof: check group definitions.
10533   (1) Closure: prime p /\ x <> 0 /\ x < p /\ y <> 0 /\ y < p ==> (x * y) MOD p <> 0
10534       By contradiction. Suppose (x * y) MOD p = 0
10535       Then  x MOD p = 0  or y MOD p = 0   by EUCLID_LEMMA
10536       i.e         x = 0  or       y = 0   by LESS_MOD
10537       contradicting x <> 0 and y <> 0.
10538   (2) Associativity: x < p /\ y < p /\ z < p ==> ((x * y) MOD p * z) MOD p = (x * (y * z) MOD p) MOD p
10539       True by MOD_MULT_ASSOC, or
10540       LHS = ((x * y) MOD p * z) MOD p
10541           = ((x * y) MOD p * z MOD p) MOD p         by MOD_LESS
10542           = (x * y * z) MOD p                       by MOD_TIMES2
10543           = (x * (y * z)) MOD p                     by MULT_ASSOC
10544           = (x MOD p * (y * z) MOD p) MOD p         by MOD_TIMES2
10545           = (x * (y * z) MOD p) MOD p               by MOD_LESS
10546           = RHS
10547   (3) Identity: prime p ==> 1 < p
10548       True by ONE_LT_PRIME.
10549   (4) Multiplicative inverse: prime p /\ x <> 0 /\ x < p ==> ?y. (y <> 0 /\ y < p) /\ ((y * x) MOD p = 1)
10550       True by MOD_MULT_INV_DEF.
10551*)
10552Theorem mult_mod_group:
10553    !p. prime p ==> Group (mult_mod p)
10554Proof
10555  rpt strip_tac >>
10556  `0 < p` by rw_tac std_ss[PRIME_POS] >>
10557  rw_tac std_ss[group_def_alt, mult_mod_property] >| [
10558    metis_tac[EUCLID_LEMMA, LESS_MOD, NOT_ZERO_LT_ZERO],
10559    rw_tac std_ss[MOD_MULT_ASSOC],
10560    rw_tac std_ss[ONE_LT_PRIME],
10561    metis_tac[MOD_MULT_INV_DEF, NOT_ZERO_LT_ZERO]
10562  ]
10563QED
10564
10565(* Theorem: Multiplicative Modulo Group is an Abelian group for prime p. *)
10566(* Proof: by mult_mod_group and MULT_COMM. *)
10567Theorem mult_mod_abelian_group:
10568    !p. prime p ==> AbelianGroup (mult_mod p)
10569Proof
10570  rw_tac std_ss[AbelianGroup_def, mult_mod_group, mult_mod_property, MULT_COMM, PRIME_POS]
10571QED
10572
10573(* Theorem: Multiplicative Modulo Group is a Finite Abelian Group for prime p. *)
10574(* Proof: by mult_mod_group and mult_mod_property. *)
10575Theorem mult_mod_finite_group:
10576    !p. prime p ==> FiniteGroup (mult_mod p)
10577Proof
10578  rw_tac std_ss[FiniteGroup_def, mult_mod_group, mult_mod_property]
10579QED
10580
10581(* Theorem: Multiplicative Modulo Group is a Finite Abelian Group for prime p. *)
10582(* Proof: by mult_mod_abelian_group and mult_mod_property. *)
10583Theorem mult_mod_finite_abelian_group:
10584    !p. prime p ==> FiniteAbelianGroup (mult_mod p)
10585Proof
10586  rw_tac std_ss[FiniteAbelianGroup_def, mult_mod_abelian_group, mult_mod_property]
10587QED
10588
10589(* Theorem: (mult_mod p).exp a n = a ** n MOD p *)
10590(* Proof:
10591   By induction on n.
10592   Base case: (mult_mod p).exp a 0 = a ** 0 MOD p
10593      (mult_mod p).exp a 0
10594    = (mult_mod p).id                by group_exp_0
10595    = 1                              by mult_mod_def
10596    = 1 MOD 1                        by DIVMOD_ID, 0 < 1
10597    = a ** 0 MOD p                   by EXP
10598   Step case:  (mult_mod p).exp a n = a ** n MOD p ==> (mult_mod p).exp a (SUC n) = a ** SUC n MOD p
10599      (mult_mod p).exp a (SUC n)
10600    = a * ((mult_mod p).exp a n)     by group_exp_SUC
10601    = a * ((a ** n) MOD p)           by inductive hypothesis
10602    = (a MOD p) * ((a ** n) MOD p)   by a < p, MOD_LESS
10603    = (a * (a ** n)) MOD p           by MOD_TIMES2
10604    = (a ** (SUC n) MOD p            by EXP
10605*)
10606Theorem mult_mod_exp:
10607    !p a. prime p /\ a IN (mult_mod p).carrier ==> !n. (mult_mod p).exp a n = (a ** n) MOD p
10608Proof
10609  rw[mult_mod_def, monoid_exp_def, residue_def] >>
10610  `0 < p /\ 1 < p` by rw_tac std_ss[PRIME_POS, ONE_LT_PRIME] >>
10611  Induct_on `n` >-
10612  rw_tac std_ss[FUNPOW_0, EXP, ONE_MOD] >>
10613  rw_tac std_ss[FUNPOW_SUC, EXP] >>
10614  `a MOD p = a` by rw_tac arith_ss[] >>
10615  metis_tac[MOD_TIMES2]
10616QED
10617
10618(* Theorem: due to zDefine before, now export the Define to computeLib. *)
10619(* Proof: by mult_mod_def. *)
10620Theorem mult_mod_eval[simp]:
10621    !p. ((mult_mod p).carrier = { i | i <> 0 /\ i < p }) /\
10622       (!x y. (mult_mod p).op x y = (x * y) MOD p) /\
10623       ((mult_mod p).id = 1)
10624Proof
10625  rw_tac std_ss[mult_mod_def]
10626QED
10627
10628(*
10629- group_order_property |> ISPEC ``(mult_mod p)``;
10630> val it = |- FiniteGroup (mult_mod p) ==> !x. x IN (mult_mod p).carrier ==>
10631         0 < order (mult_mod p) x /\ ((mult_mod p).exp x (order (mult_mod p) x) = (mult_mod p).id) : thm
10632- EVAL ``order (mult_mod 5) 1``;
10633> val it = |- order (mult_mod 5) 1 = 1 : thm
10634- EVAL ``order (mult_mod 5) 2``;
10635> val it = |- order (mult_mod 5) 2 = 4 : thm
10636- EVAL ``order (mult_mod 5) 3``;
10637> val it = |- order (mult_mod 5) 3 = 4 : thm
10638- EVAL ``order (mult_mod 5) 4``;
10639> val it = |- order (mult_mod 5) 4 = 2 : thm
10640*)
10641
10642(* Theorem: (mult_mod p).inv x = x ** (order (mult_mod p) x - 1) *)
10643(* Proof: by group_order_property and group_rinv_unique. *)
10644Theorem mult_mod_inv[simp]:
10645    !p. prime p ==> !x. 0 < x /\ x < p ==> ((mult_mod p).inv x = (mult_mod p).exp x (order (mult_mod p) x - 1))
10646Proof
10647  rpt strip_tac >>
10648  `x IN (mult_mod p).carrier /\ ((mult_mod p).id = 1)` by rw_tac std_ss[mult_mod_property] >>
10649  `Group (mult_mod p)` by rw_tac std_ss[mult_mod_group] >>
10650  `FiniteGroup (mult_mod p)` by rw_tac std_ss[FiniteGroup_def, mult_mod_property] >>
10651  `0 < order (mult_mod p) x /\ ((mult_mod p).exp x (order (mult_mod p) x) = 1)` by rw_tac std_ss[group_order_property] >>
10652  `SUC ((order (mult_mod p) x) - 1) = order (mult_mod p) x` by rw_tac arith_ss[] >>
10653  metis_tac[group_rinv_unique, group_exp_SUC, group_exp_element]
10654QED
10655
10656(* val _ = computeLib.add_persistent_funs ["mult_mod_inv"]; -- cannot put a non-function. *)
10657
10658(* Theorem: As function, (mult_mod p).inv x = x ** (order (mult_mod p) x - 1) *)
10659(* Proof: by mult_mod_inv. *)
10660Theorem mult_mod_inv_compute:
10661    !p x. (mult_mod p).inv x = if prime p /\ 0 < x /\ x < p
10662                            then (mult_mod p).exp x (order (mult_mod p) x - 1)
10663                            else FAIL ((mult_mod p).inv x) bad_element
10664Proof
10665  rw_tac std_ss[mult_mod_inv, combinTheory.FAIL_DEF]
10666QED
10667
10668(* Now put thse input computeLib for EVAL *)
10669val _ = computeLib.add_persistent_funs ["mult_mod_eval"];
10670val _ = computeLib.add_persistent_funs ["mult_mod_inv_compute"];
10671(* val _ = computeLib.set_EVAL_skip ``combin$FAIL`` (SOME 0); *)
10672
10673(*
10674- EVAL ``(mult_mod 5).id``;
10675> val it = |- (mult_mod 5).id = 1 : thm
10676- EVAL ``(mult_mod 5).op 3 2``;
10677> val it = |- (mult_mod 5).op 3 2 = 1 : thm
10678- EVAL ``(mult_mod 5).inv 2``;
10679> val it = |- (mult_mod 5).inv 2 = if prime 5 then 3 else FAIL ((mult_mod 5).inv 2) bad_element : thm
10680- EVAL ``prime 5``;
10681> val it = |- prime 5 <=> prime 5 : thm
10682
10683- val _ = computeLib.add_persistent_funs ["PRIME_5"];
10684- EVAL ``prime 5``;
10685> val it = |- prime 5 <=> T : thm
10686- EVAL ``(Z* 5).inv 2``;
10687> val it = |- (mult_mod 5).inv 2 = 3 : thm
10688*)
10689
10690(*
10691- SIMP_CONV (srw_ss()) [] ``(mult_mod 5).id``;
10692> val it = |- (mult_mod 5).id = 1 : thm
10693- SIMP_CONV (srw_ss()) [] ``(mult_mod 5).op 3 2``;
10694> val it = |- (mult_mod 5).op 3 2 = 1 : thm
10695- SIMP_CONV (srw_ss()) [] ``(mult_mod 5).inv 2``;
10696! Uncaught exception:
10697! UNCHANGED
10698*)
10699
10700(* ========================================================================= *)
10701(* Cryptography based on groups                                              *)
10702(* ========================================================================= *)
10703
10704(* ------------------------------------------------------------------------- *)
10705(* ElGamal encryption and decryption -- purely group-theoretic.              *)
10706(* ------------------------------------------------------------------------- *)
10707
10708(* Define encryption and decryption of ElGamal scheme. *)
10709Definition ElGamal_encrypt_def:
10710  ElGamal_encrypt (g:'a group) (y:'a) (h:'a) (m:'a) (k:num) = (y ** k, (h ** k) * m)
10711End
10712
10713Definition ElGamal_decrypt_def:
10714  ElGamal_decrypt (g:'a group) (x:num) (a:'a, b:'a) = ( |/ (a ** x)) * b
10715End
10716
10717(* Theorem: ElGamal decypt can undo ElGamal encrypt. *)
10718(* Proof:
10719   This is to show
10720   ElGamal_decrypt g x (ElGamal_encrypt g y h m k)  = m
10721   or:     |/ ((y ** k) ** x) * ((y ** x) ** k * m) = m
10722
10723   |/ ((y ** k) ** x) * ((y ** x) ** k * m)
10724 = |/ (y ** (k*x)) * (y ** (x*k) * m)      by group_exp_mult
10725 = ( |/ y) ** (k*x) * (y ** (x*k) * m)     by group_exp_inv
10726 = ( |/ y) ** (k*x) * (y ** (k*x) * m)     by MULT_COMM (the x*k is not g.op, in exp)
10727 = (( |/ y) ** (k*x) * y ** (k*x)) * m     by group_assoc
10728 = ( |/y * y) ** (k*x) * m                 by group_mult_exp
10729 = #e ** (k*x) * m                         by group_linv, group_rinv
10730 = #e * m                                  by group_id_exp
10731 = m                                       by group_lid
10732*)
10733Theorem ElGamal_correctness:
10734    !g:'a group. Group g ==> !y h m::G. !k x. (h = y ** x) ==> (ElGamal_decrypt g x (ElGamal_encrypt g y h m k) = m)
10735Proof
10736  rw_tac std_ss[ElGamal_encrypt_def, ElGamal_decrypt_def, RES_FORALL_THM] >>
10737  `|/ ((y ** k) ** x) * ((y ** x) ** k * m) = |/ (y ** (k*x)) * (y ** (x*k) * m)` by rw_tac std_ss[group_exp_mult] >>
10738  `_ = ( |/ y)**(k*x) * (y**(x*k) * m)` by rw_tac std_ss[group_exp_inv] >>
10739  `_ = ( |/ y)**(k*x) * (y**(k*x) * m)` by rw_tac std_ss[MULT_COMM] >>
10740  `_ = (( |/ y)**(k*x) * y**(k*x)) * m` by rw_tac std_ss[group_assoc, group_inv_element, group_exp_element] >>
10741  `_ = ( |/y * y)**(k*x) * m` by rw_tac std_ss[group_linv, group_rinv, group_comm_op_exp, group_inv_element] >>
10742  rw_tac std_ss[group_linv, group_id_exp, group_lid]
10743QED
10744
10745(* ------------------------------------------------------------------------- *)
10746(* A Group from Sets.                                                        *)
10747(* ------------------------------------------------------------------------- *)
10748
10749(* Define symmetric difference for two sets. *)
10750Definition symdiff_def:  symdiff s1 s2 = (s1 UNION s2) DIFF (s1 INTER s2)
10751End
10752
10753(* The Group of set symmetric difference *)
10754Definition symdiff_set_def:
10755  symdiff_set = <| carrier := UNIV;
10756                       id := EMPTY;
10757                       op := symdiff |>
10758End
10759
10760(*
10761> EVAL ``symdiff_set.id``;
10762val it = |- symdiff_set.id = {}: thm
10763> EVAL ``symdiff_set.op {1;2;3;4} {1;4;5;6}``;
10764val it = |- symdiff_set.op {1; 2; 3; 4} {1; 4; 5; 6} = {2; 3; 5; 6}: thm
10765*)
10766
10767
10768(* Theorem: symdiff_set is a Group. *)
10769(* Proof: check definitions. *)
10770Theorem symdiff_set_group[simp]:
10771    Group symdiff_set
10772Proof
10773  rw[group_def_alt, symdiff_set_def] >| [
10774    rw[EXTENSION, symdiff_def] >> metis_tac[],
10775    rw[EXTENSION, symdiff_def],
10776    qexists_tac `x` >> rw[EXTENSION, symdiff_def]
10777  ]
10778QED
10779
10780
10781(* Theorem: symdiff_set is an abelian Group. *)
10782(* Proof: check definitions. *)
10783Theorem symdiff_set_abelian_group[simp]:
10784    AbelianGroup symdiff_set
10785Proof
10786  rw[AbelianGroup_def, symdiff_set_def] >>
10787  rw[symdiff_def, EXTENSION] >>
10788  metis_tac[]
10789QED
10790
10791
10792(* ------------------------------------------------------------------------- *)
10793(* Cyclic Group Documentation                                                *)
10794(* ------------------------------------------------------------------------- *)
10795(* Overloads:
10796*)
10797(* Definitions and Theorems (# are exported):
10798
10799   Helper Theroems:
10800
10801   Cyclic Group has a generator:
10802   cyclic_def              |- !g. cyclic g <=> Group g /\ ?z. z IN G /\ !x. x IN G ==> ?n. x = z ** n
10803   cyclic_gen_def          |- !g. cyclic g ==> cyclic_gen g IN G /\
10804                                           !x. x IN G ==> ?n. x = cyclic_gen g ** n
10805#  cyclic_group            |- !g. cyclic g ==> Group g
10806   cyclic_element          |- !g. cyclic g ==> !x. x IN G ==> ?n. x = cyclic_gen g ** n
10807   cyclic_gen_element      |- !g. cyclic g ==> cyclic_gen g IN G
10808   cyclic_generated_group  |- !g. FiniteGroup g ==> !x. x IN G ==> cyclic (gen x)
10809   cyclic_gen_order        |- !g. cyclic g /\ FINITE G ==> (ord (cyclic_gen g) = CARD G)
10810   cyclic_gen_power_order  |- !g. cyclic g /\ FINITE G ==> !n. 0 < n /\ (CARD G MOD n = 0) ==>
10811                                              (ord (cyclic_gen g ** (CARD G DIV n)) = n)
10812
10813   cyclic_generated_by_gen         |- !g. cyclic g /\ FINITE G ==> (g = gen (cyclic_gen g))
10814   cyclic_element_by_gen           |- !g. cyclic g /\ FINITE G ==>
10815                                      !x. x IN G ==> ?n. n < CARD G /\ (x = cyclic_gen g ** n)
10816   cyclic_element_in_generated     |- !g. cyclic g /\ FINITE G ==>
10817                                      !x. x IN G ==> x IN (Gen (cyclic_gen g ** (CARD G DIV ord x)))
10818   cyclic_finite_has_order_divisor |- !g. cyclic g /\ FINITE G ==>
10819                                      !n. n divides CARD G ==> ?x. x IN G /\ (ord x = n)
10820
10821   Cyclic Group Properties:
10822   cyclic_finite_alt           |- !g. FiniteGroup g ==> (cyclic g <=> ?z. z IN G /\ (ord z = CARD G))
10823   cyclic_group_comm           |- !g. cyclic g ==> !x y. x IN G /\ y IN G ==> (x * y = y * x)
10824   cyclic_group_abelian        |- !g. cyclic g ==> AbelianGroup g
10825
10826   Cyclic Subgroups:
10827   cyclic_subgroup_cyclic      |- !g h. cyclic g /\ h <= g ==> cyclic h
10828   cyclic_subgroup_condition   |- !g. cyclic g /\ FINITE G ==>
10829                                  !n. (?h. h <= g /\ (CARD H = n)) <=> n divides CARD G
10830
10831   Cyclic Group Examples:
10832   cyclic_uroots_has_primitive |- !g. FINITE G /\ cyclic g ==>
10833                                  !n. ?z. z IN (uroots n).carrier /\ (ord z = CARD (uroots n).carrier)
10834   cyclic_uroots_cyclic        |- !g. cyclic g ==> !n. cyclic (uroots n)
10835   add_mod_order_1             |- !n. 1 < n ==> (order (add_mod n) 1 = n)
10836   add_mod_cylic               |- !n. 0 < n ==> cyclic (add_mod n)
10837
10838   Cyclic Generators:
10839   cyclic_generators_def       |- !g. cyclic_generators g = {z | z IN G /\ (ord z = CARD G)}
10840   cyclic_generators_element   |- !g z. z IN cyclic_generators g <=> z IN G /\ (ord z = CARD G)
10841   cyclic_generators_subset    |- !g. cyclic_generators g SUBSET G
10842   cyclic_generators_finite    |- !g. FINITE G ==> FINITE (cyclic_generators g)
10843   cyclic_generators_nonempty  |- !g. cyclic g /\ FINITE G ==> cyclic_generators g <> {}
10844   cyclic_generators_coprimes_bij |- !g. cyclic g /\ FINITE G ==>
10845                          BIJ (\j. cyclic_gen g ** j) (coprimes (CARD G)) (cyclic_generators g)
10846   cyclic_generators_card      |- !g. cyclic g /\ FINITE G ==> (CARD (cyclic_generators g) = phi (CARD G))
10847   cyclic_generators_gen_cofactor_eq_orders  |- !g. cyclic g /\ FINITE G ==> !n. n divides CARD G ==>
10848                          (cyclic_generators (Generated g (cyclic_gen g ** (CARD G DIV n))) = orders g n)
10849   cyclic_orders_card          |- !g. cyclic g /\ FINITE G ==>
10850                                  !n. CARD (orders g n) = if n divides CARD G then phi n else 0
10851
10852   Partition by order equality:
10853   eq_order_def            |- !g x y. eq_order g x y <=> (ord x = ord y)
10854   eq_order_equiv          |- !g. eq_order g equiv_on G
10855   cyclic_orders_nonempty  |- !g. cyclic g /\ FINITE G ==> !n. n divides CARD G ==> orders g n <> {}
10856   cyclic_eq_order_partition         |- !g. cyclic g /\ FINITE G ==>
10857                                        (partition (eq_order g) G = {orders g n | n | n divides CARD G})
10858   cyclic_eq_order_partition_alt     |- !g. cyclic g /\ FINITE G ==>
10859                                        (partition (eq_order g) G = {orders g n | n | n IN divisors (CARD G)})
10860   cyclic_eq_order_partition_by_card |- !g. cyclic g /\ FINITE G ==>
10861                                        (IMAGE CARD (partition (eq_order g) G) = IMAGE phi (divisors (CARD G)))
10862
10863   eq_order_is_feq_order           |- !g. eq_order g = feq ord
10864   orders_is_feq_class_order       |- !g. orders g = feq_class ord G
10865   cyclic_image_ord_is_divisors    |- !g. cyclic g /\ FINITE G ==> (IMAGE ord G = divisors (CARD G))
10866   cyclic_orders_partition         |- !g. cyclic g /\ FINITE G ==>
10867                                          (partition (eq_order g) G = IMAGE (orders g) (divisors (CARD G)))
10868
10869   Finite Cyclic Group Existence:
10870   finite_cyclic_group_existence   |- !n. 0 < n ==> ?g. cyclic g /\ (CARD g.carrier = n)
10871
10872   Cyclic Group index relative to a generator:
10873   cyclic_index_exists             |- !g x. cyclic g /\ x IN G ==>
10874                                      ?n. (x = cyclic_gen g ** n) /\ (FINITE G ==> n < CARD G)
10875   cyclic_index_def                |- !g x. cyclic g /\ x IN G ==>
10876                                      (x = cyclic_gen g ** cyclic_index g x) /\
10877                                      (FINITE G ==> cyclic_index g x < CARD G)
10878   finite_cyclic_index_property    |- !g. cyclic g /\ FINITE G ==>
10879                                      !n. n < CARD G ==> (cyclic_index g (cyclic_gen g ** n) = n)
10880   finite_cyclic_index_unique      |- !g x. cyclic g /\ FINITE G /\ x IN G ==>
10881                                      !n. n < CARD G ==> ((x = cyclic_gen g ** n) <=> (n = cyclic_index g x))
10882   finite_cyclic_index_add         |- !g x y. cyclic g /\ FINITE G /\ x IN G /\ y IN G ==>
10883                                      (cyclic_index g (x * y) =
10884                                         (cyclic_index g x + cyclic_index g y) MOD CARD G)
10885
10886   Finite Cyclic Group Uniqueness:
10887   finite_cyclic_group_homo          |- !g1 g2. cyclic g1 /\ cyclic g2 /\
10888      FINITE g1.carrier /\ FINITE g2.carrier /\ (CARD g1.carrier = CARD g2.carrier) ==>
10889      GroupHomo (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1 g2
10890   finite_cyclic_group_bij           |- !g1 g2. cyclic g1 /\ cyclic g2 /\
10891      FINITE g1.carrier /\ FINITE g2.carrier /\ (CARD g1.carrier = CARD g2.carrier) ==>
10892      BIJ (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1.carrier g2.carrier
10893   finite_cyclic_group_iso           |- !g1 g2. cyclic g1 /\ cyclic g2 /\
10894      FINITE g1.carrier /\ FINITE g2.carrier /\ (CARD g1.carrier = CARD g2.carrier) ==>
10895      GroupIso (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1 g2
10896   finite_cyclic_group_uniqueness    |- !g1 g2. cyclic g1 /\ cyclic g2 /\
10897      FINITE g1.carrier /\ FINITE g2.carrier /\ (CARD g1.carrier = CARD g2.carrier) ==>
10898      ?f. GroupIso f g1 g2
10899   finite_cyclic_group_add_mod_homo  |- !g. cyclic g /\ FINITE G ==>
10900      GroupHomo (\n. cyclic_gen g ** n) (add_mod (CARD G)) g
10901   finite_cyclic_group_add_mod_bij   |- !g. cyclic g /\ FINITE G ==>
10902      BIJ (\n. cyclic_gen g ** n) (add_mod (CARD G)).carrier G
10903   finite_cyclic_group_add_mod_iso   |- !g. cyclic g /\ FINITE G ==>
10904      GroupIso (\n. cyclic_gen g ** n) (add_mod (CARD G)) g
10905
10906   Isomorphism between Cyclic Groups:
10907   cyclic_iso_gen     |- !g h f. cyclic g /\ cyclic h /\ FINITE G /\ GroupIso f g h ==>
10908                                 f (cyclic_gen g) IN cyclic_generators h
10909*)
10910
10911(* ------------------------------------------------------------------------- *)
10912(* Cyclic Group has a generator.                                             *)
10913(* ------------------------------------------------------------------------- *)
10914
10915(* Define Cyclic Group *)
10916Definition cyclic_def:
10917  cyclic (g:'a group) <=> Group g /\ ?z. z IN G /\ (!x. x IN G ==> ?n. x = z ** n)
10918End
10919
10920(* Apply Skolemization *)
10921Theorem lemma[local]:
10922    !(g:'a group). ?z. cyclic g ==> z IN G /\ !x. x IN G ==> ?n. x = z ** n
10923Proof
10924  metis_tac[cyclic_def]
10925QED
10926(*
10927- SKOLEM_THM;
10928> val it = |- !P. (!x. ?y. P x y) <=> ?f. !x. P x (f x) : thm
10929*)
10930(* Define cyclic generator *)
10931(*
10932- SIMP_RULE bool_ss [SKOLEM_THM] lemma;
10933> val it = |- ?f. !g. cyclic g ==> f g IN G /\ !x. x IN G ==> ?n. x = f g ** n: thm
10934*)
10935val cyclic_gen_def = new_specification(
10936    "cyclic_gen_def",
10937    ["cyclic_gen"],
10938    SIMP_RULE bool_ss [SKOLEM_THM] lemma);
10939(*
10940> val cyclic_gen_def = |-
10941  !g. cyclic g ==> cyclic_gen g IN G /\ !x. x IN G ==> ?n. x = cyclic_gen g ** n: thm
10942*)
10943
10944(* Theorem: cyclic g ==> Group g *)
10945(* Proof: by cyclic_def *)
10946Theorem cyclic_group[simp]:
10947    !g:'a group. cyclic g ==> Group g
10948Proof
10949  rw[cyclic_def]
10950QED
10951
10952
10953(* Theorem: cyclic g ==> !x. x IN G ==> ?n. x = (cyclic_gen g) ** n *)
10954(* Proof: by cyclic_gen_def. *)
10955Theorem cyclic_element:
10956    !g:'a group. cyclic g ==> (!x. x IN G ==> ?n. x = (cyclic_gen g) ** n)
10957Proof
10958  rw[cyclic_gen_def]
10959QED
10960
10961(* Theorem cyclic g ==> (cyclic_gen g) IN G *)
10962(* Proof: by cyclic_gen_def. *)
10963Theorem cyclic_gen_element:
10964    !g:'a group. cyclic g ==> (cyclic_gen g) IN G
10965Proof
10966  rw[cyclic_gen_def]
10967QED
10968
10969(* Theorem: FiniteGroup g ==> !x. x IN G ==> cyclic (gen x) *)
10970(* Proof:
10971   By cyclic_def, this is to show:
10972   (1) x IN G ==> Group (gen x)
10973       True by generated_group.
10974   (2) ?z. z IN (Gen x) /\ !x'. x' IN (Gen x) ==> ?n. x' = (gen x).exp z n
10975       x IN (Gen x)   by generated_gen_element
10976       Let z = x, the assertion is true by generated_element
10977*)
10978Theorem cyclic_generated_group:
10979    !g:'a group. FiniteGroup g ==> !x. x IN G ==> cyclic (gen x)
10980Proof
10981  rpt strip_tac >>
10982  `Group g /\ FINITE G` by metis_tac[FiniteGroup_def] >>
10983  rw[cyclic_def] >-
10984  rw[generated_group] >>
10985  `x IN (Gen x)` by rw[generated_gen_element] >>
10986  metis_tac[generated_subgroup, generated_element, subgroup_exp, subgroup_element]
10987QED
10988
10989(* Theorem: cyclic g /\ FINITE G ==> ord (cyclic_gen g) = CARD G *)
10990(* Proof:
10991   Let z = cyclic_gen g.
10992   !x. x IN G ==> ?n. x = z ** n     by cyclic_element
10993              ==> x IN (Gen z)       by generated_element
10994   Hence G SUBSET (Gen z)            by SUBSET_DEF
10995   But (gen z) <= g                  by generated_subgroup
10996   So  (Gen z) SUBSET G              by Subgroup_def
10997   Hence (Gen z) = G                 by SUBSET_ANTISYM
10998   or ord z = CARD (Gen z)           by generated_group_card, group_order_pos
10999            = CARD G                 by above
11000*)
11001Theorem cyclic_gen_order:
11002    !g:'a group. cyclic g /\ FINITE G ==> (ord (cyclic_gen g) = CARD G)
11003Proof
11004  rpt strip_tac >>
11005  `Group g /\ cyclic_gen g IN G /\ !x. x IN G ==> ?n. x = cyclic_gen g ** n` by rw[cyclic_gen_def] >>
11006  `FiniteGroup g` by rw[FiniteGroup_def] >>
11007  `G SUBSET (Gen (cyclic_gen g))` by rw[generated_element, SUBSET_DEF] >>
11008  `(Gen (cyclic_gen g)) SUBSET G` by metis_tac[generated_subgroup, Subgroup_def] >>
11009  metis_tac[generated_group_card, group_order_pos, SUBSET_ANTISYM]
11010QED
11011
11012(* Theorem: cyclic g /\ FINITE G ==>
11013           !n. 0 < n /\ ((CARD G) MOD n = 0) ==> (ord (cyclic_gen g ** (CARD G DIV n)) = n) *)
11014(* Proof:
11015   First, Group g                           by cyclic_group
11016   Therefore  FiniteGroup g                 by FiniteGroup_def
11017   Let t = (cyclic_gen g) ** m, where m = (CARD G) DIV n.
11018   Since (cyclic_gen g) IN G                by cyclic_gen_element
11019      so t IN G                             by group_exp_element
11020   Since ord (cyclic_gen g) = CARD G        by cyclic_gen_order
11021      so ord t * gcd (CARD G) m = CARD G    by group_order_power
11022
11023     But CARD G
11024       = m * n + ((CARD G) MOD n)           by DIVISION
11025       = m * n                              since (CARD G) MOD n = 0
11026       = n * m                              by MULT_COMM
11027      so gcd (CARD G) m = m                 by GCD_MULTIPLE_ALT
11028
11029     But CARD G <> 0                        by group_carrier_nonempty, CARD_EQ_0
11030      so m = (CARD G) DIV n <> 0            by GCD_EQ_0
11031   Therefore  ord t * m = n * m
11032          or  ord t = n                     by MULT_RIGHT_CANCEL
11033*)
11034Theorem cyclic_gen_power_order:
11035    !g:'a group. cyclic g /\ FINITE G ==>
11036   !n. 0 < n /\ ((CARD G) MOD n = 0) ==> (ord (cyclic_gen g ** (CARD G DIV n)) = n)
11037Proof
11038  rpt strip_tac >>
11039  `Group g` by rw[] >>
11040  `FiniteGroup g` by rw[FiniteGroup_def] >>
11041  qabbrev_tac `m = (CARD G) DIV n` >>
11042  qabbrev_tac `t = (cyclic_gen g) ** m` >>
11043  `(cyclic_gen g) IN G` by rw[cyclic_gen_element] >>
11044  `t IN G` by rw[Abbr`t`] >>
11045  `ord (cyclic_gen g) = CARD G` by rw[cyclic_gen_order] >>
11046  `ord t * gcd (CARD G) m = CARD G` by metis_tac[group_order_power] >>
11047  `CARD G = m * n + ((CARD G) MOD n)` by rw[DIVISION, Abbr`m`] >>
11048  `_ = n * m` by rw[MULT_COMM] >>
11049  `gcd (CARD G) m = m` by metis_tac[GCD_MULTIPLE_ALT] >>
11050  `m <> 0` by metis_tac[group_carrier_nonempty, CARD_EQ_0, GCD_EQ_0] >>
11051  metis_tac[MULT_RIGHT_CANCEL]
11052QED
11053
11054(* Theorem: cyclic g ==> (g = (gen (cyclic_gen g))) *)
11055(* Proof:
11056   Since cyclic g ==> Group g     by cyclic_group
11057   Let z = cyclic_gen g.
11058   Then z IN G                    by cyclic_gen_element
11059    and (Gen z) SUBSET G          by generated_subset
11060   Now, show: G SUBSET (Gen z)
11061     or show: x IN G ==> x IN (Gen z)   by SUBSET_DEF
11062       Since cyclic g and x IN G,
11063             ?j. x = z ** j       by cyclic_gen_def
11064       hence x IN x IN (Gen z)    by generated_element
11065
11066   Thus (Gen z) SUBSET G
11067    and G SUBSET (Gen z)
11068    ==> G = Gen z                 by SUBSET_ANTISYM
11069   also (gen z).op = $*
11070    and (gen z).id = #e           by generated_property
11071   Therefore g = (gen z)          by monoid_component_equality
11072*)
11073Theorem cyclic_generated_by_gen:
11074    !g:'a group. cyclic g ==> (g = (gen (cyclic_gen g)))
11075Proof
11076  rpt strip_tac >>
11077  `Group g` by rw[] >>
11078  qabbrev_tac `z = cyclic_gen g` >>
11079  `z IN G` by rw[cyclic_gen_element, Abbr`z`] >>
11080  `(Gen z) SUBSET G` by rw[generated_subset] >>
11081  `G SUBSET (Gen z)` by metis_tac[SUBSET_DEF, cyclic_gen_def, generated_element] >>
11082  `G = Gen z` by rw[SUBSET_ANTISYM] >>
11083  metis_tac[monoid_component_equality, generated_property]
11084QED
11085
11086(* Theorem: cyclic g /\ FINITE G ==> !x. x IN G ==>
11087            ?n. n < CARD G /\ (x = (cyclic_gen g) ** n) *)
11088(* Proof:
11089   Since cyclic g ==> Group g    by cyclic_group
11090      so FiniteGroup g           by FiniteGroup_def
11091   Let z = cyclic_gen g, m = CARD G.
11092   Then z IN G                   by cyclic_gen_element
11093    and 0 < m                    by finite_group_card_pos
11094   also ord z = m                by cyclic_gen_order
11095    Now ?k. x = z ** k           by cyclic_element
11096   Since k MOD m < m             by MOD_LESS
11097     and z ** k = z (k MOD m)    by group_exp_mod, 0 < m
11098   Just take n = k MOD m.
11099*)
11100Theorem cyclic_element_by_gen:
11101    !g:'a group. cyclic g /\ FINITE G ==> !x. x IN G ==>
11102     ?n. n < CARD G /\ (x = (cyclic_gen g) ** n)
11103Proof
11104  rpt strip_tac >>
11105  `Group g` by rw[] >>
11106  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11107  qabbrev_tac `z = cyclic_gen g` >>
11108  qabbrev_tac `m = CARD G` >>
11109  `z IN G` by rw[cyclic_gen_element, Abbr`z`] >>
11110  `0 < m` by rw[finite_group_card_pos, Abbr`m`] >>
11111  `ord z = m` by rw[cyclic_gen_order, Abbr`z`, Abbr`m`] >>
11112  `?k. x = z ** k` by rw[cyclic_element, Abbr`z`] >>
11113  qexists_tac `k MOD m` >>
11114  metis_tac[group_exp_mod, MOD_LESS]
11115QED
11116
11117(* Theorem: cyclic g /\ FINITE G ==> !x. x IN G ==>
11118            x IN (Gen ((cyclic_gen g) ** ((CARD G) DIV (ord x)))) *)
11119(* Proof:
11120   Since cyclic g ==> Group g     by cyclic_group
11121      so FiniteGroup g            by FiniteGroup_def, FINITE G
11122   Let z = cyclic_gen g, m = CARD G.
11123   Then z IN G                    by cyclic_gen_element
11124    and ord z = m                 by cyclic_gen_order
11125    and 0 < m                     by finite_group_card_pos
11126   Let n = ord x, k = m DIV n, y = z ** k.
11127   To show: x IN (Gen y)
11128   Note n divides m               by group_order_divides
11129   Since x IN G,
11130         ?t. x = z ** t           by cyclic_element
11131     But x ** n = #e              by order_property
11132      or (z ** t) ** n = #e       by x = z ** t
11133      or  z ** (t * n) = #e       by group_exp_mult
11134    Thus m divides (t * n)        by group_order_divides_exp, m = ord z
11135      so k divides t              by dividend_divides_divisor_multiple, n divides m
11136   Hence ?s. t = s * k            by divides_def
11137     and x = z ** t
11138           = z ** (s * k)         by t = s * k
11139           = z ** (k * s)         by MULT_COMM
11140           = (z ** k) ** s        by group_exp_mult
11141           = y ** s               by y = z ** k
11142   Therefore x IN (Gen y)         by generated_element
11143*)
11144Theorem cyclic_element_in_generated:
11145    !g:'a group. cyclic g /\ FINITE G ==> !x. x IN G ==>
11146        x IN (Gen ((cyclic_gen g) ** ((CARD G) DIV (ord x))))
11147Proof
11148  rpt strip_tac >>
11149  `Group g ` by rw[] >>
11150  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11151  qabbrev_tac `m = CARD G` >>
11152  qabbrev_tac `z = cyclic_gen g` >>
11153  `0 < m` by rw[finite_group_card_pos, Abbr`m`] >>
11154  `z IN G /\ (ord z = m)` by rw[GSYM cyclic_gen_element, cyclic_gen_order, Abbr`z`, Abbr`m`] >>
11155  qabbrev_tac `n = ord x` >>
11156  qabbrev_tac `k = m DIV n` >>
11157  qabbrev_tac `y = z ** k` >>
11158  `n divides m` by rw[group_order_divides, Abbr`n`, Abbr`m`] >>
11159  `?t. x = z ** t` by rw[cyclic_element, Abbr`z`] >>
11160  `x ** n = #e` by rw[order_property, Abbr`n`] >>
11161  `z ** (t * n) = #e` by rw[group_exp_mult] >>
11162  `m divides (t * n)` by rw[GSYM group_order_divides_exp] >>
11163  `k divides t` by rw[GSYM dividend_divides_divisor_multiple, Abbr`k`] >>
11164  `?s. t = s * k` by rw[GSYM divides_def] >>
11165  `x = y ** s` by metis_tac[group_exp_mult, MULT_COMM] >>
11166  metis_tac[generated_element]
11167QED
11168
11169(* Theorem: cyclic g /\ FINITE G ==> !n. n divides CARD G ==> ?x. x IN G /\ (ord x = n) *)
11170(* Proof:
11171   Note cyclic g ==> Group g                    by cyclic_group
11172    and Group g /\ FINITE G ==> FiniteGroup g   by FiniteGroup_def
11173      Let z = cyclic_gen g, m = CARD G.
11174      Note 0 < m                                by finite_group_card_pos
11175      Then z IN G                               by cyclic_gen_element
11176       and ord z = m                            by cyclic_gen_order
11177      Let x = z ** (m DIV n),
11178      Then x IN G                               by group_exp_element
11179       and ord x = n                            by group_order_exp_cofactor, 0 < m
11180*)
11181Theorem cyclic_finite_has_order_divisor:
11182    !g:'a group. cyclic g /\ FINITE G ==> !n. n divides CARD G ==> ?x. x IN G /\ (ord x = n)
11183Proof
11184  rpt strip_tac >>
11185  `Group g` by rw[] >>
11186  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11187  qabbrev_tac `z = cyclic_gen g` >>
11188  qabbrev_tac `m = CARD G` >>
11189  `z IN G /\ (ord z = m)` by rw[cyclic_gen_element, cyclic_gen_order, Abbr`z`, Abbr`m`] >>
11190  `0 < m` by rw[finite_group_card_pos, Abbr`m`] >>
11191  qabbrev_tac `x = z ** (m DIV n)` >>
11192  metis_tac[group_order_exp_cofactor, group_exp_element]
11193QED
11194
11195(* ------------------------------------------------------------------------- *)
11196(* Cyclic Group Properties                                                   *)
11197(* ------------------------------------------------------------------------- *)
11198
11199(* Theorem: FiniteGroup g ==> cyclic g <=> ?z. z IN G /\ (ord z = CARD G) *)
11200(* Proof:
11201   If part: cyclic g ==> ?z. z IN G /\ (ord z = CARD G)
11202     Let z = cyclic_gen g.
11203     cyclic g ==> z IN G                          by cyclic_gen_element
11204     cyclic g /\ FINITE G ==>  (ord z = CARD G)   by cyclic_gen_order
11205   Only-if part: ?z. z IN G /\ (ord z = CARD G) ==> cyclic g
11206     Note 0 < CARD G                      by finite_group_card_pos
11207     (Gen z) SUBSET G                     by generated_subset
11208     CARD (Gen z) = ord z                 by generated_group_card
11209     (Gen z) = G                          by SUBSET_EQ_CARD
11210     Thus !x. x IN G ==> ?n. x = z ** n   by generated_element
11211*)
11212Theorem cyclic_finite_alt:
11213    !g:'a group. FiniteGroup g ==> (cyclic g <=> (?z. z IN G /\ (ord z = CARD G)))
11214Proof
11215  rpt strip_tac >>
11216  `Group g /\ FINITE G` by metis_tac[FiniteGroup_def] >>
11217  rw[EQ_IMP_THM] >-
11218  metis_tac[cyclic_gen_element, cyclic_gen_order] >>
11219  rw[cyclic_def] >>
11220  qexists_tac `z` >>
11221  rw[] >>
11222  `(Gen z) SUBSET G` by metis_tac[generated_subset] >>
11223  `CARD (Gen z) = ord z` by rw[generated_group_card, finite_group_card_pos] >>
11224  `Gen z = G` by metis_tac[SUBSET_EQ_CARD, SUBSET_FINITE] >>
11225  metis_tac[generated_element]
11226QED
11227
11228(* Theorem: cyclic g ==> !x y. x IN G /\ y IN G ==> (x * y = y * x) *)
11229(* Proof:
11230   Let z = cyclic_gen g.
11231   x IN G ==> ?n. x = z ** n     by cyclic_element
11232   y IN G ==> ?m. y = z ** m     by cyclic_element
11233     x * y
11234   = (z ** n) * (z ** m)
11235   = z ** (n + m)                by group_exp_add
11236   = z ** (m + n)                by ADD_COMM
11237   = (z ** m) * (z ** n)         by group_exp_add
11238   = y * x
11239*)
11240Theorem cyclic_group_comm:
11241    !g:'a group. cyclic g ==> !x y. x IN G /\ y IN G ==> (x * y = y * x)
11242Proof
11243  metis_tac[cyclic_group, cyclic_gen_def, cyclic_element, group_exp_add, ADD_COMM]
11244QED
11245
11246(* Theorem: cyclic g ==> AbelianGroup g *)
11247(* Proof: by cyclic_group_comm, cyclic_group, AbelianGroup_def *)
11248Theorem cyclic_group_abelian:
11249    !g:'a group. cyclic g ==> AbelianGroup g
11250Proof
11251  rw[cyclic_group_comm, AbelianGroup_def]
11252QED
11253
11254(* ------------------------------------------------------------------------- *)
11255(* Cyclic Subgroups                                                          *)
11256(* ------------------------------------------------------------------------- *)
11257
11258(* Theorem: cyclic g /\ h <= g ==> cyclic h *)
11259(* Proof:
11260   Let z = cyclic_gen g.
11261   h <= g <=> Group h /\ Group g /\ H SUBSET G     by Subgroup_def
11262   Hence H <> {}                                   by group_carrier_nonempty
11263   and #e IN H                                     by group_id_element, subgroup_id
11264   If H = {#e},
11265      !x. x IN H ==> x = #e, #e ** 1 = #e          by group_exp_1, IN_SING
11266      Hence cyclic h                               by cyclic_def
11267   If H <> {#e}, there is an x IN H and x <> #e    by ONE_ELEMENT_SING
11268   !x. x IN H ==> x IN G                           by SUBSET_DEF
11269              ==> ?n. x = z ** n                   by cyclic_element
11270   Let m = MIN_SET {n | 0 < n /\ z ** n IN H}
11271   Let s = z ** m, s IN H                          by group_exp_element
11272   Then for any x IN H, ?n. x = z ** n             by above
11273   Now n = q * m + r                               by DIVISION
11274   x = z ** n
11275     = z ** (q * m + r)
11276     = z ** q * m  * z ** r                        by group_comm_op_exp
11277     = (z ** m) ** q * z ** r                      by group_exp_mult, MULT_COMM
11278     = s ** q * z ** r
11279   Hence z ** r = |/ (s ** q) * x                  by group_rsolve
11280   or z ** r IN H                                  by group_op_element, group_exp_element
11281   But 0 <= r < m, and m is minimum.
11282   Hence r = 0, or z ** r = #e                     by group_exp_0
11283   Therefore for any x IN H, ?q. x = s ** q.
11284   Result follows by cyclic_def.
11285*)
11286Theorem cyclic_subgroup_cyclic:
11287    !g h:'a group. cyclic g /\ h <= g ==> cyclic h
11288Proof
11289  rpt strip_tac >>
11290  `Group g /\ (cyclic_gen g) IN G` by rw[cyclic_gen_def] >>
11291  `Group h /\ (h.op = g.op) /\ !x. x IN H ==> x IN G` by metis_tac[Subgroup_def, SUBSET_DEF] >>
11292  qabbrev_tac `z = cyclic_gen g` >>
11293  `H <> {}` by rw[group_carrier_nonempty] >>
11294  `#e IN H` by metis_tac[subgroup_id, group_id_element] >>
11295  `!x. x IN H ==> ?n. x = z ** n` by rw[cyclic_element, Abbr`z`] >>
11296  `!x. x IN H ==> !n. h.exp x n = x ** n` by rw[subgroup_exp] >>
11297  `!x. x IN H ==> (h.inv x = |/ x)` by rw[subgroup_inv] >>
11298  rw[cyclic_def] >>
11299  Cases_on `H = {#e}` >-
11300  rw[] >>
11301  `?x. x IN H /\ x <> #e` by metis_tac[ONE_ELEMENT_SING] >>
11302  `?n. x = z ** n` by rw[] >>
11303  `n <> 0` by metis_tac[group_exp_0] >>
11304  `0 < n` by decide_tac >>
11305  qabbrev_tac `s = {n | 0 < n /\ z ** n IN H}` >>
11306  `n IN s` by rw[Abbr`s`] >>
11307  `s <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
11308  `MIN_SET s IN s /\ !n. n IN s ==> MIN_SET s <= n` by metis_tac[MIN_SET_LEM] >>
11309  qabbrev_tac `m = MIN_SET s` >>
11310  `!n. n IN s <=> 0 < n /\ z ** n IN H` by rw[Abbr`s`] >>
11311  `0 < m /\ z ** m IN H` by metis_tac[] >>
11312  qexists_tac `z ** m` >>
11313  rw[] >>
11314  `?n'. x' = z ** n'` by rw[] >>
11315  `?q r. ?r q. (n' = q * m + r) /\ r < m` by rw[DA] >>
11316  `x' = z ** (q * m + r)` by rw[] >>
11317  `_ = z ** (q * m) * z ** r` by rw[group_exp_add] >>
11318  `_ = z ** (m * q) * z ** r` by metis_tac[MULT_COMM] >>
11319  `_ = (z ** m) ** q * z ** r` by metis_tac[group_exp_mult] >>
11320  `(z ** m) ** q IN H` by metis_tac[group_exp_element] >>
11321  Cases_on `r = 0` >-
11322  metis_tac[group_exp_0, group_rid] >>
11323  `0 < r` by decide_tac >>
11324  `|/ ((z ** m) ** q) IN H` by metis_tac[group_inv_element] >>
11325  `z ** r IN H` by metis_tac[group_rsolve, group_exp_element, group_op_element] >>
11326  `m <= r` by metis_tac[] >>
11327  `~(r < m)` by decide_tac
11328QED
11329
11330(* Theorem: cyclic g /\ FINITE G ==> !n. (?h. h <= g /\ (CARD H = n)) <=> (n divides (CARD G)) *)
11331(* Proof:
11332   If part: h <= g ==> CARD H divides CARD G
11333      True by Lagrange_thm.
11334   Only-if part: n divides CARD G ==> ?h. h <= g /\ (CARD H = n)
11335      Let z = cyclic_gen g, m = CARD G.
11336      Then z IN G          by cyclic_gen_element
11337       and (ord z = m)     by cyclic_gen_order
11338      Since n divides m,
11339            ?k. m = k * n  by divides_def
11340       Thus k divides m    by divides_def, MULT_COMM
11341        and gcd k m = k    by divides_iff_gcd_fix
11342       Note Group g        by cyclic_group
11343        and FiniteGroup g  by FiniteGroup_def, FINITE G.
11344       Let x = z ** k,
11345       Then x IN G                    by group_exp_element
11346        and n * k
11347          = m                         by MULT_COMM, m = k * n
11348          = ord (z ** k) * gcd m k    by group_order_power
11349          = ord x * gcd k m           by GCD_SYM
11350          = ord x * k                 by above
11351       Since 0 < m, m <> 0            by finite_group_card_pos
11352          so k <> 0 and n <> 0        by MULT_EQ_0
11353        thus ord x = n                by EQ_MULT_RCANCEL, k <> 0
11354        Take h = gen x,
11355        then h <= g                   by generated_subgroup
11356         and CARD (Gen x)
11357           = ord x = n                by generated_group_card
11358*)
11359Theorem cyclic_subgroup_condition:
11360    !g:'a group. cyclic g /\ FINITE G ==> !n. (?h. h <= g /\ (CARD H = n)) <=> (n divides (CARD G))
11361Proof
11362  rw[EQ_IMP_THM] >-
11363  rw[Lagrange_thm] >>
11364  qabbrev_tac `z = cyclic_gen g` >>
11365  qabbrev_tac `m = CARD G` >>
11366  `z IN G /\ (ord z = m)` by rw[cyclic_gen_element, cyclic_gen_order, Abbr`z`, Abbr`m`] >>
11367  `?k. m = k * n` by rw[GSYM divides_def] >>
11368  `k divides m` by metis_tac[divides_def, MULT_COMM] >>
11369  `gcd k m = k` by rw[GSYM divides_iff_gcd_fix] >>
11370  qabbrev_tac `x = z ** k` >>
11371  `Group g ` by rw[] >>
11372  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11373  `ord x * k = n * k` by metis_tac[group_order_power, GCD_SYM, MULT_COMM] >>
11374  `0 < m` by rw[finite_group_card_pos, Abbr`m`] >>
11375  `m <> 0` by decide_tac >>
11376  `k <> 0 /\ n <> 0` by metis_tac[MULT_EQ_0] >>
11377  `ord x = n` by metis_tac[EQ_MULT_RCANCEL] >>
11378  `x IN G` by rw[Abbr`x`] >>
11379  qexists_tac `gen x` >>
11380  metis_tac[generated_subgroup, generated_group_card, NOT_ZERO_LT_ZERO]
11381QED
11382
11383(* ------------------------------------------------------------------------- *)
11384(* Cyclic Group Examples                                                     *)
11385(* ------------------------------------------------------------------------- *)
11386
11387(* Theorem: FINITE G /\ cyclic g ==>
11388            !n. ?z. z IN (uroots n).carrier /\ (ord z = CARD (uroots n).carrier)  *)
11389(* Proof:
11390       cyclic g
11391   ==> AbelianGroup g       by cyclic_group_abelian
11392   ==> (uroots n) <= g      by group_uroots_subgroup
11393   ==> cyclic (uroots n)    by cyclic_subgroup_cyclic
11394   ==> (cyclic_gen (uroots n)) IN (uroots n).carrier
11395                            by cyclic_gen_element
11396   ==> ord (cyclic_gen (uroots n)) = CARD (uroots n)
11397                            by cyclic_gen_order, subgroup_order
11398*)
11399Theorem cyclic_uroots_has_primitive:
11400    !g:'a group. FINITE G /\ cyclic g ==>
11401     !n. ?z. z IN (uroots n).carrier /\ (ord z = CARD (uroots n).carrier)
11402Proof
11403  rpt strip_tac >>
11404  `Group g` by rw[] >>
11405  `AbelianGroup g` by rw[cyclic_group_abelian] >>
11406  `(uroots n) <= g` by rw[group_uroots_subgroup] >>
11407  `cyclic (uroots n)` by metis_tac[cyclic_subgroup_cyclic] >>
11408  `(cyclic_gen (uroots n)) IN (uroots n).carrier` by rw[cyclic_gen_element] >>
11409  metis_tac[cyclic_gen_order, subgroup_order, Subgroup_def, SUBSET_FINITE]
11410QED
11411
11412(* This cyclic_uroots_has_primitive, originally for the next one, is not used. *)
11413
11414(* Theorem: cyclic g ==> cyclic (uroots n) *)
11415(* Proof:
11416   Note AbelianGroup g           by cyclic_group_abelian
11417    and (uroots n) <= g          by group_uroots_subgroup
11418   Thus cyclic (uroots n)        by cyclic_subgroup_cyclic
11419*)
11420Theorem cyclic_uroots_cyclic:
11421    !g:'a group. cyclic g ==> !n. cyclic (uroots n)
11422Proof
11423  rpt strip_tac >>
11424  `AbelianGroup g` by rw[cyclic_group_abelian] >>
11425  `(uroots n) <= g` by rw[group_uroots_subgroup] >>
11426  metis_tac[cyclic_subgroup_cyclic]
11427QED
11428
11429(* Theorem: 1 < n ==> (order (add_mod n) 1 = n) *)
11430(* Proof:
11431   Since 1 IN (add_mod n).carrier             by add_mod_element, 1 < n
11432     and !m. (add_mod n).exp 1 m = m MOD n    by add_mod_exp, 0 < n
11433   Therefore,
11434         (add_mod n).exp 1 n = n MOD n = 0    by DIVMOD_ID, 0 < n
11435     and !m. 0 < m /\ m < n,
11436         (add_mod n).exp 1 m = m <> 0         by NOT_ZERO_LT_ZERO, 0 < n
11437     Now (add_mod n).id = 0                   by add_mod_property
11438      so order (add_mod n) 1 = n              by group_order_thm
11439*)
11440Theorem add_mod_order_1:
11441    !n. 1 < n ==> (order (add_mod n) 1 = n)
11442Proof
11443  rpt strip_tac >>
11444  `0 < n` by decide_tac >>
11445  `!m. (add_mod n).exp 1 m = m MOD n` by rw[add_mod_exp] >>
11446  `1 IN (add_mod n).carrier` by rw[add_mod_element] >>
11447  `(add_mod n).exp 1 n = 0` by rw[] >>
11448  `!m. 0 < m /\ m < n ==> (add_mod n).exp 1 m <> 0` by rw[NOT_ZERO_LT_ZERO] >>
11449  metis_tac[group_order_thm, add_mod_property]
11450QED
11451
11452(* Theorem: 0 < n ==> cyclic (add_mod n) *)
11453(* Proof:
11454   Note Group (add_mod n)                  by add_mod_group
11455    and FiniteGroup (add_mod n)            by add_mod_finite_group
11456    and (add_mod n).id = 0                 by add_mod_property
11457    and CARD (add_mod n).carrier = n       by add_mod_property
11458   If n = 1,
11459      Since order (add_mod 1) 0 = 1        by group_order_id
11460        and 0 IN (add_mod 1).carrier       by group_id_element
11461        and CARD (add_mod 1).carrier = 1   by above
11462       Thus cyclic (add_mod 1)             by cyclic_finite_alt
11463   If n <> 1, 1 < n.
11464      Since 1 IN (add_mod n).carrier       by add_mod_element, 1 < n
11465        and order (add_mod n) 1 = n        by add_mod_order_1, 1 < n
11466       Thus cyclic (add_mod n)             by cyclic_finite_alt
11467*)
11468Theorem add_mod_cylic:
11469    !n. 0 < n ==> cyclic (add_mod n)
11470Proof
11471  rpt strip_tac >>
11472  `Group (add_mod n)` by rw[add_mod_group] >>
11473  `FiniteGroup (add_mod n)` by rw[add_mod_finite_group] >>
11474  `((add_mod n).id = 0) /\ (CARD (add_mod n).carrier = n)` by rw[add_mod_property] >>
11475  Cases_on `n = 1` >-
11476  metis_tac[cyclic_finite_alt, group_order_id, group_id_element] >>
11477  `1 < n` by decide_tac >>
11478  metis_tac[cyclic_finite_alt, add_mod_order_1, add_mod_element]
11479QED
11480
11481(* ------------------------------------------------------------------------- *)
11482(* Order of elements in a Cyclic Group                                       *)
11483(* ------------------------------------------------------------------------- *)
11484
11485(*
11486From FiniteField theory, knowing that F* is cyclic, we can prove stronger results:
11487(1) Let G be cyclic with |G| = n, so it has a generator z with (order z = n).
11488(2) All elements in G are known: 1, g, g^2, ...., g^(n-1).
11489(3) Thus all their orders are known: n/gcd(0,n), n/gcd(1,n), n/gcd(2,n), ..., n/gcd(n-1,n).
11490(4) Counting, CARD (order_eq k) = phi k.
11491(5) As a result, n = SUM (phi k), over k | n.
11492*)
11493
11494(* ------------------------------------------------------------------------- *)
11495(* Cyclic Generators                                                         *)
11496(* ------------------------------------------------------------------------- *)
11497
11498(* Define the set of generators for cyclic group *)
11499Definition cyclic_generators_def:
11500    cyclic_generators (g:'a group) = {z | z IN G /\ (ord z = CARD G)}
11501End
11502
11503(* Theorem: z IN cyclic_generators g <=> z IN G /\ (ord z = CARD G) *)
11504(* Proof: by cyclic_generators_def *)
11505Theorem cyclic_generators_element:
11506    !g:'a group. !z. z IN cyclic_generators g <=> z IN G /\ (ord z = CARD G)
11507Proof
11508  rw[cyclic_generators_def]
11509QED
11510
11511(* Theorem: (cyclic_generators g) SUBSET G *)
11512(* Proof: by cyclic_generators_def, SUBSET_DEF *)
11513Theorem cyclic_generators_subset:
11514    !g:'a group. (cyclic_generators g) SUBSET G
11515Proof
11516  rw[cyclic_generators_def, SUBSET_DEF]
11517QED
11518
11519(* Theorem: FINITE G ==> FINITE (cyclic_generators g) *)
11520(* Proof: by cyclic_generators_subset, SUBSET_FINITE *)
11521Theorem cyclic_generators_finite:
11522    !g:'a group. FINITE G ==> FINITE (cyclic_generators g)
11523Proof
11524  metis_tac[cyclic_generators_subset, SUBSET_FINITE]
11525QED
11526
11527(* Theorem: cyclic g /\ FINITE G ==> (cyclic_generators g) <> {} *)
11528(* Proof:
11529   Let z = cyclic_gen g, m = CARD G.
11530    Then z IN G                        by cyclic_gen_element
11531     and ord z = m                     by cyclic_gen_order, FINITE G
11532   Hence z IN cyclic_generators g      by cyclic_generators_element
11533      or (cyclic_generators g) <> {}   by MEMBER_NOT_EMPTY
11534*)
11535Theorem cyclic_generators_nonempty:
11536    !g:'a group. cyclic g /\ FINITE G ==> (cyclic_generators g) <> {}
11537Proof
11538  metis_tac[cyclic_generators_element, cyclic_gen_element, cyclic_gen_order, MEMBER_NOT_EMPTY]
11539QED
11540
11541(* Theorem: cyclic g /\ FINITE G ==>
11542            BIJ (\j. (cyclic_gen g) ** j) (coprimes (CARD G)) (cyclic_generators g) *)
11543(* Proof:
11544   Since cyclic g ==> Group g     by cyclic_group
11545      so FiniteGroup g            by FiniteGroup_def, FINITE G
11546   Let z = cyclic_gen g, m = CARD G.
11547   Then z IN G                    by cyclic_gen_element
11548    and ord z = m                 by cyclic_gen_order
11549    and 0 < m                     by finite_group_card_pos
11550   Expanding by BIJ_DEF, INJ_DEF, and SURJ_DEF, this is to show:
11551   (1) z IN G /\ (ord z = m) /\ j IN coprimes m ==> z ** j IN cyclic_generators g
11552       Since z ** j IN G                    by group_exp_element
11553         and coprime j m                    by coprimes_element
11554          so ord (z ** j) = m               by group_order_power_eq_order
11555       Hence z ** j IN cyclic_generators g  by cyclic_generators_element
11556   (2) z IN G /\ (ord z = m) /\ j IN coprimes m /\ j' IN coprimes m /\ z ** j = z ** j' ==> j = j'
11557       If m = 1,
11558          then coprimes 1 = {1}                  by coprimes_1
11559          hence j = 1 = j'                       by IN_SING
11560       If m <> 1, 1 < m.
11561          then j IN coprimes m ==> j < m         by coprimes_element_less
11562           and j' IN coprimes m ==> j' < m       by coprimes_element_less
11563          Therefore j = j'                       by group_exp_equal
11564   (3) same as (1)
11565   (4) z IN G /\ (ord z = m) /\ x IN cyclic_generators g ==> ?j. j IN coprimes m /\ (z ** j = x)
11566       Since x IN cyclic_generators g
11567         ==> x IN G /\ (ord x = m)               by cyclic_generators_element
11568        Also ?k. k < m /\ (x = z ** k)           by cyclic_element_by_gen
11569        If m = 1,
11570           then ord x = 1 ==> x = #e             by group_order_eq_1
11571           then ord z = 1 ==> z = #e             by group_order_eq_1
11572           Take j = 1,
11573           and 1 IN (coprimes 1)                 by coprimes_1, IN_SING
11574           with z ** 1 = x                       by group_exp_1
11575        If m <> 1,
11576           then x <> #e                          by group_order_eq_1
11577           thus k <> 0                           by group_exp_0
11578             so 0 < k, and k < m ==> k <= m      by LESS_IMP_LESS_OR_EQ
11579           Also ord (z ** k) = m ==> coprime k m by group_order_power_eq_order
11580           Take j = k, and j IN coprimes m       by coprimes_element
11581*)
11582Theorem cyclic_generators_coprimes_bij:
11583    !g:'a group. cyclic g /\ FINITE G ==>
11584      BIJ (\j. (cyclic_gen g) ** j) (coprimes (CARD G)) (cyclic_generators g)
11585Proof
11586  rpt strip_tac >>
11587  `Group g ` by rw[] >>
11588  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11589  qabbrev_tac `z = cyclic_gen g` >>
11590  qabbrev_tac `m = CARD G` >>
11591  `z IN G /\ (ord z = m)` by rw[cyclic_gen_element, cyclic_gen_order, Abbr`z`, Abbr`m`] >>
11592  `0 < m` by rw[finite_group_card_pos, Abbr`m`] >>
11593  rw[BIJ_DEF, INJ_DEF, SURJ_DEF] >| [
11594    qabbrev_tac `m = ord z` >>
11595    `coprime j m` by metis_tac[coprimes_element] >>
11596    `z ** j IN G` by rw[] >>
11597    `ord (z ** j) = m` by metis_tac[group_order_power_eq_order] >>
11598    metis_tac[cyclic_generators_element],
11599    qabbrev_tac `m = ord z` >>
11600    Cases_on `m = 1` >-
11601    metis_tac[coprimes_1, IN_SING] >>
11602    `1 < m` by decide_tac >>
11603    metis_tac[coprimes_element_less, group_exp_equal],
11604    qabbrev_tac `m = ord z` >>
11605    `coprime j m` by metis_tac[coprimes_element] >>
11606    `z ** j IN G` by rw[] >>
11607    `ord (z ** j) = m` by metis_tac[group_order_power_eq_order] >>
11608    metis_tac[cyclic_generators_element],
11609    qabbrev_tac `m = ord z` >>
11610    `x IN G /\ (ord x = m)` by metis_tac[cyclic_generators_element] >>
11611    `?k. k < m /\ (x = z ** k)` by metis_tac[cyclic_element_by_gen] >>
11612    Cases_on `m = 1` >-
11613    metis_tac[group_order_eq_1, coprimes_1, IN_SING, group_exp_1] >>
11614    `x <> #e` by metis_tac[group_order_eq_1] >>
11615    `k <> 0` by metis_tac[group_exp_0] >>
11616    `0 < k /\ k <= m` by decide_tac >>
11617    metis_tac[group_order_power_eq_order, coprimes_element]
11618  ]
11619QED
11620
11621(* Theorem: cyclic g /\ FINITE G ==> (CARD (cyclic_generators g) = phi (CARD G)) *)
11622(* Proof:
11623   Let z = cyclic_gen g, m = CARD G.
11624    Then z IN G                        by cyclic_gen_element
11625     and ord z = m                     by cyclic_gen_order
11626     Now BIJ (\j. z ** j) (coprimes m) (cyclic_generators g)   by cyclic_generators_coprimes_bij
11627   Since FINITE (coprimes m)           by coprimes_finite
11628     and FINITE (cyclic_generators g)  by cyclic_generators_finite
11629   Hence CARD (cyclic_generators g)
11630       = CARD (coprimes m)             by FINITE_BIJ_CARD_EQ
11631       = phi m                         by phi_def
11632*)
11633Theorem cyclic_generators_card:
11634    !g:'a group. cyclic g /\ FINITE G ==> (CARD (cyclic_generators g) = phi (CARD G))
11635Proof
11636  rpt strip_tac >>
11637  qabbrev_tac `z = cyclic_gen g` >>
11638  qabbrev_tac `m = CARD G` >>
11639  `z IN G /\ (ord z = m)` by rw[cyclic_gen_element, cyclic_gen_order, Abbr`z`, Abbr`m`] >>
11640  `BIJ (\j. z ** j) (coprimes m) (cyclic_generators g)` by rw[cyclic_generators_coprimes_bij, Abbr`z`, Abbr`m`] >>
11641  `FINITE (coprimes m)` by rw[coprimes_finite] >>
11642  `FINITE (cyclic_generators g)` by rw[cyclic_generators_finite] >>
11643  metis_tac[phi_def, FINITE_BIJ_CARD_EQ]
11644QED
11645
11646(*
11647Goolge: order of elements in a cyclic group.
11648
11649Pattern of orders of elements in a cyclic group
11650http://math.stackexchange.com/questions/158281/pattern-of-orders-of-elements-in-a-cyclic-group
11651
11652The number of elements of order d, where d is a divisor of n, is 'v(d).
11653
11654Let G be a cyclic group of order n, and let a in G be a generator. Let d be a divisor of n.
11655
11656Certainly, a^{n/d} is an element of G of order d (in other words, <a^{n/d}> is a subgroup of G of order d).
11657If a^{t} in G is an element of order d, then (a^{t})^{d} = e, hence n | td, and thus (n/d) | t.
11658This shows that a^{t} in <a^{n/d}>, and thus <a^{t}> = <a^{n/d}> (since they are both subgroups of order d).
11659Thus, there is exactly one subgroup, let's call it H_{d}, of G of order d, for each divisor d of n,
11660and all of these subgroups are themselves cyclic.
11661
11662Any cyclic group of order d has phi(d) generators, i.e. there are phi(d) elements of order d in H_{d},
11663and hence there are phi(d) elements of order d in G. Here, phi is Euler's phi function.
11664
11665This can be checked to make sense via the identity: n = SUM phi(d), over d | n.
11666*)
11667
11668(* Theorem: cyclic g /\ FINITE G ==> !n. n divides (CARD G) ==>
11669            (cyclic_generators (Generated g ((cyclic_gen g) ** ((CARD G) DIV n))) = orders g n) *)
11670(* Proof:
11671   Since cyclic g ==> Group g     by cyclic_group
11672      so FiniteGroup g            by FiniteGroup_def, FINITE G
11673   Let z = cyclic_gen g, m = CARD G.
11674   Then z IN G                    by cyclic_gen_element
11675    and ord z = m                 by cyclic_gen_order
11676    and 0 < m                     by finite_group_card_pos
11677
11678   Let k = m DIV n, y = z ** k, h = Generated g y.
11679   Then y IN G                    by group_exp_element
11680    and h <= g                    by generated_subgroup, y IN G
11681
11682   Expanding by cyclic_generators_def, orders_def, this is to show:
11683   (1) h <= g /\ x IN H ==> x IN G
11684       True by Subgroup_def, SUBSET_DEF.
11685   (2) h <= g /\ order h x = CARD H ==> ord x = n
11686       Note ord x = CARD H      by subgroup_order
11687                  = ord y       by generated_group_card, group_order_pos
11688                  = n           by group_order_exp_cofactor
11689   (3) h <= g /\ x IN G /\ (ord x) divides m ==> x IN H
11690       True by cyclic_element_in_generated.
11691   (4) h <= g /\ x IN G ==> order h x = CARD H
11692       Note x IN H              by cyclic_element_in_generated
11693        and (ord x) divides m   by group_order_divides
11694            order h x
11695          = ord x               by subgroup_order, x IN H
11696          = ord (z ** k)        by group_order_exp_cofactor, (ord x) divides m = ord z
11697          = ord y               by y = z ** k
11698          = CARD H              by generated_group_card, group_order_pos
11699*)
11700Theorem cyclic_generators_gen_cofactor_eq_orders:
11701    !g:'a group. cyclic g /\ FINITE G ==> !n. n divides (CARD G) ==>
11702   (cyclic_generators (Generated g ((cyclic_gen g) ** ((CARD G) DIV n))) = orders g n)
11703Proof
11704  rpt strip_tac >>
11705  `Group g ` by rw[] >>
11706  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11707  qabbrev_tac `m = CARD G` >>
11708  qabbrev_tac `z = cyclic_gen g` >>
11709  `z IN G` by rw[cyclic_gen_element, Abbr`z`] >>
11710  `0 < m` by rw[finite_group_card_pos, Abbr`m`] >>
11711  `ord z = m` by rw[cyclic_gen_order, Abbr`z`, Abbr`m`] >>
11712  qabbrev_tac `k = m DIV n` >>
11713  qabbrev_tac `y = z ** k` >>
11714  qabbrev_tac `h = Generated g y` >>
11715  `y IN G` by rw[Abbr`y`, Abbr`z`] >>
11716  `h <= g` by rw[generated_subgroup, Abbr`h`] >>
11717  rw[cyclic_generators_def, orders_def, EXTENSION, EQ_IMP_THM] >-
11718  metis_tac[Subgroup_def, SUBSET_DEF] >-
11719  metis_tac[subgroup_order, generated_group_card, group_order_exp_cofactor, group_order_pos] >-
11720  metis_tac[cyclic_element_in_generated] >>
11721  qabbrev_tac `m = ord z` >>
11722  qabbrev_tac `n = ord x` >>
11723  `x IN H` by metis_tac[cyclic_element_in_generated] >>
11724  `order h x = n` by rw[subgroup_order, Abbr`n`] >>
11725  `ord y = n` by rw[group_order_exp_cofactor, Abbr`m`, Abbr`y`, Abbr`k`] >>
11726  `CARD H = ord y` by rw[generated_group_card, group_order_pos, Abbr`h`] >>
11727  decide_tac
11728QED
11729
11730(* Theorem: cyclic g /\ FINITE G ==>
11731            !n. CARD (orders g n) = if (n divides CARD G) then phi n else 0 *)
11732(* Proof:
11733   Let m = CARD G.
11734   Note 0 < m                     by finite_group_card_pos
11735   Since cyclic g ==> Group g     by cyclic_group
11736      so FiniteGroup g            by FiniteGroup_def, FINITE G
11737   Let z = cyclic_gen g, m = CARD G.
11738   Then z IN G                    by cyclic_gen_element
11739    and ord z = m                 by cyclic_gen_order
11740   If n divides m, to show: CARD (orders g n) = phi n
11741      Let k = m DIV n, y = z ** k, h = Generated g y.
11742      Then y IN G                 by group_exp_element
11743       and ord y = n              by group_order_exp_cofactor
11744      also h <= g                 by generated_subgroup
11745       and CARD H = n             by generated_group_card, group_order_pos
11746      Also cyclic h               by cyclic_subgroup_cyclic
11747       and FINITE H               by finite_subgroup_carrier_finite
11748      Hence CARD (orders g n)
11749          = CARD (cyclic_generators h)  by cyclic_generators_gen_cofactor_eq_orders
11750          = phi n                       by cyclic_generators_card, FINITE H
11751
11752   If ~(n divides m), to show: CARD (orders g n) = 0
11753      By contradiction, suppose CARD (orders g n) <> 0.
11754      Since FINITE (orders g n)       by orders_finite
11755         so orders g n <> {}          by CARD_EQ_0
11756       Thus ?x. x IN orders g n       by MEMBER_NOT_EMPTY
11757         or x IN G /\ (ord x = n)     by orders_element
11758        Now (ord x) divides m         by group_order_divides
11759        which contradicts ~(n divides m).
11760*)
11761Theorem cyclic_orders_card:
11762    !g:'a group. cyclic g /\ FINITE G ==>
11763   !n. CARD (orders g n) = if (n divides CARD G) then phi n else 0
11764Proof
11765  rpt strip_tac >>
11766  `Group g ` by rw[] >>
11767  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11768  qabbrev_tac `z = cyclic_gen g` >>
11769  qabbrev_tac `m = CARD G` >>
11770  `0 < m` by rw[finite_group_card_pos, Abbr`m`] >>
11771  `z IN G` by rw[cyclic_gen_element, Abbr`z`] >>
11772  `ord z = m` by rw[cyclic_gen_order, Abbr`z`, Abbr`m`] >>
11773  Cases_on `n divides m` >| [
11774    simp[] >>
11775    qabbrev_tac `k = m DIV n` >>
11776    qabbrev_tac `y = z ** k` >>
11777    qabbrev_tac `h = Generated g y` >>
11778    `y IN G` by rw[Abbr`y`] >>
11779    `ord y = n` by metis_tac[group_order_exp_cofactor] >>
11780    `h <= g` by rw[generated_subgroup, Abbr`h`] >>
11781    `CARD H = n` by rw[generated_group_card, group_order_pos, Abbr`h`] >>
11782    `cyclic h` by metis_tac[cyclic_subgroup_cyclic] >>
11783    `FINITE H` by metis_tac[finite_subgroup_carrier_finite] >>
11784    metis_tac[cyclic_generators_gen_cofactor_eq_orders, cyclic_generators_card],
11785    simp[] >>
11786    spose_not_then strip_assume_tac >>
11787    `FINITE (orders g n)` by rw[orders_finite] >>
11788    `orders g n <> {}` by rw[GSYM CARD_EQ_0] >>
11789    metis_tac[MEMBER_NOT_EMPTY, orders_element, group_order_divides]
11790  ]
11791QED
11792
11793(* ------------------------------------------------------------------------- *)
11794(* Partition by order equality                                               *)
11795(* ------------------------------------------------------------------------- *)
11796
11797(* Define a relation: eq_order *)
11798Definition eq_order_def:
11799    eq_order (g:'a group) x y <=> (ord x = ord y)
11800End
11801
11802(* Theorem: (eq_order g) equiv_on G *)
11803(* Proof: by eq_order_def, equiv_on_def *)
11804Theorem eq_order_equiv:
11805    !g:'a group. (eq_order g) equiv_on G
11806Proof
11807  rw[eq_order_def, equiv_on_def]
11808QED
11809
11810(* Theorem: cyclic g /\ FINITE G ==> !n. n divides CARD G ==> orders g n <> {} *)
11811(* Proof:
11812   Let z = cyclic_gen g, m = CARD G.
11813   Note 0 < m               by finite_group_card_pos
11814   Then z IN G              by cyclic_gen_element
11815    and ord z = m           by cyclic_gen_order
11816   Let x = z ** (m DIV n)
11817   Then x IN G              by group_exp_element
11818    and ord x = n           by group_order_exp_cofactor
11819     so x IN (orders g n)   by orders_element
11820   Thus orders g n <> {}    by MEMBER_NOT_EMPTY
11821*)
11822Theorem cyclic_orders_nonempty:
11823    !g:'a group. cyclic g /\ FINITE G ==> !n. n divides CARD G ==> orders g n <> {}
11824Proof
11825  rpt strip_tac >>
11826  `Group g ` by rw[] >>
11827  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11828  qabbrev_tac `z = cyclic_gen g` >>
11829  qabbrev_tac `m = CARD G` >>
11830  `0 < m` by rw[finite_group_card_pos, Abbr`m`] >>
11831  `z IN G` by rw[cyclic_gen_element, Abbr`z`] >>
11832  `ord z = m` by rw[cyclic_gen_order, Abbr`z`, Abbr`m`] >>
11833  qabbrev_tac `x = z ** (m DIV n)` >>
11834  `x IN G` by rw[Abbr`x`] >>
11835  `ord x = n` by metis_tac[group_order_exp_cofactor] >>
11836  metis_tac[orders_element, MEMBER_NOT_EMPTY]
11837QED
11838
11839(* Theorem: cyclic g /\ FINITE G ==>
11840            (partition (eq_order g) G = {orders g n | n | n divides (CARD G)}) *)
11841(* Proof:
11842   Expanding by partition_def, eq_order_def, orders_def, this is to show:
11843   (1) x' IN G /\ ... ==> ?n. ... (ord x' = n) ... /\ n divides CARD G
11844       Let n = ord x',
11845       Result is true since n divides CARD G   by group_order_divides
11846   (2) n divides CARD G /\ ... (ord x'' = n) ... ==> ?x'. x' IN G /\ ... (ord x' = ord x'') ...
11847       Since n divides CARD G
11848         ==> (orders g n) <> {}            by cyclic_orders_nonempty
11849         ==> ?z. z IN G /\ (ord z = n)     by orders_element, , MEMBER_NOT_EMPTY
11850       Let x' = z, then the result follows.
11851*)
11852Theorem cyclic_eq_order_partition:
11853    !g:'a group. cyclic g /\ FINITE G ==>
11854     (partition (eq_order g) G = {orders g n | n | n divides (CARD G)})
11855Proof
11856  rpt strip_tac >>
11857  `Group g ` by rw[] >>
11858  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11859  rw[partition_def, eq_order_def, orders_def, EXTENSION, EQ_IMP_THM] >-
11860  metis_tac[group_order_divides] >>
11861  metis_tac[orders_element, cyclic_orders_nonempty, MEMBER_NOT_EMPTY]
11862QED
11863
11864(* Theorem: cyclic g /\ FINITE G ==>
11865            (partition (eq_order g) G = {orders g n | n | n IN divisors (CARD G)}) *)
11866(* Proof:
11867   Note Group g            by cyclic_group
11868     so FiniteGroup g      by FiniteGroup_def
11869    ==> 0 < CARD G         by finite_group_card_pos, FiniteGroup g
11870        partition (eq_order g) G
11871      = {orders g n | n | n divides (CARD G)}      by cyclic_eq_order_partition
11872      = {orders g n | n | n IN divisors (CARD G)}  by divisors_element_alt, 0 < CARD G
11873*)
11874Theorem cyclic_eq_order_partition_alt:
11875    !g:'a group. cyclic g /\ FINITE G ==>
11876                (partition (eq_order g) G = {orders g n | n | n IN divisors (CARD G)})
11877Proof
11878  rpt strip_tac >>
11879  `0 < CARD G` by metis_tac[finite_group_card_pos, cyclic_group, FiniteGroup_def] >>
11880  rw[cyclic_eq_order_partition, divisors_element_alt]
11881QED
11882
11883(* We have shown: in a finite cyclic group G,
11884   For each divisor d | |G|, there are phi(d) elements of order d.
11885   Since each element must have some order in a finite group,
11886   the sum of phi(d) over all divisors d will count all elements in the group,
11887   that is,  n = SUM phi(d), over d | n.
11888*)
11889
11890(* Theorem: cyclic g /\ FINITE G ==>
11891            (IMAGE CARD (partition (eq_order g) g.carrier) = IMAGE phi (divisors (CARD G))) *)
11892(* Proof:
11893   Since cyclic g ==> Group g       by cyclic_group
11894      so FiniteGroup g              by FiniteGroup_def
11895   Let z = cyclic_gen g, m = CARD G.
11896   Then z IN G                      by cyclic_gen_element
11897    and ord z = m                   by cyclic_gen_order
11898    and 0 < m                       by finite_group_card_pos
11899
11900   Apply partition_def, eq_order_def, to show:
11901   (1) ?x''. (CARD s = phi x'') /\ x'' IN divisors m
11902       Note s = orders g n         by orders_def
11903       Let n = ord x'', y = z ** (m DIV n).
11904       Then n divides m             by group_order_divides
11905        and y IN G                  by group_exp_element
11906        and ord y = n               by group_order_exp_cofactor
11907       Since 0 < m, n IN divisors m by divisors_element_alt
11908       hence CARD s = phi n         by cyclic_orders_card
11909       So take x'' = n.
11910   (2) x' IN divisors m ==> ?x''. (phi x' = CARD x'') /\ ?x. x IN orders g x'
11911       Let n = x', y = z ** (m DIV n).
11912       Since n IN divisors m,
11913         ==> n <= m /\ n divides m  by divisors_element
11914         Let s = orders g n,
11915        Then CARD s = phi n         by cyclic_orders_card
11916         and y IN G                 by group_exp_element
11917         and ord y = n              by group_order_exp_cofactor
11918          so y IN orders g n        by orders_element
11919       So take x'' = y.
11920*)
11921Theorem cyclic_eq_order_partition_by_card:
11922    !g:'a group. cyclic g /\ FINITE G ==>
11923      (IMAGE CARD (partition (eq_order g) g.carrier) = IMAGE phi (divisors (CARD G)))
11924Proof
11925  rpt strip_tac >>
11926  `Group g` by rw[] >>
11927  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11928  qabbrev_tac `m = CARD G` >>
11929  qabbrev_tac `z = cyclic_gen g` >>
11930  `z IN G /\ (ord z = m)` by rw[cyclic_gen_element, cyclic_gen_order, Abbr`z`, Abbr`m`] >>
11931  `0 < m` by rw[finite_group_card_pos, Abbr`m`] >>
11932  rw[partition_def, eq_order_def, EXTENSION, EQ_IMP_THM] >| [
11933    qabbrev_tac `m = ord z` >>
11934    qabbrev_tac `n = ord x''` >>
11935    (`x' = orders g n` by (rw[orders_def, EXTENSION] >> metis_tac[])) >>
11936    qabbrev_tac `y = z ** (m DIV n)` >>
11937    `n divides m` by metis_tac[group_order_divides] >>
11938    `y IN G` by rw[Abbr`y`] >>
11939    `ord y = n` by rw[group_order_exp_cofactor, Abbr`y`, Abbr`m`] >>
11940    metis_tac[cyclic_orders_card, divisors_element_alt],
11941    qabbrev_tac `m = ord z` >>
11942    qabbrev_tac `n = x'` >>
11943    qabbrev_tac `y = z ** (m DIV n)` >>
11944    `n <= m /\ n divides m` by metis_tac[divisors_element] >>
11945    `y IN G` by rw[Abbr`y`] >>
11946    `ord y = n` by rw[group_order_exp_cofactor, Abbr`y`, Abbr`m`] >>
11947    metis_tac[cyclic_orders_card, orders_element]
11948  ]
11949QED
11950
11951(* Theorem: eq_order g = feq ord *)
11952(* Proof:
11953       eq_order g x y
11954   <=> ord x = ord y   by eq_order_def
11955   <=> feq ord x y     by feq_def
11956   Hence true by FUN_EQ_THM.
11957*)
11958Theorem eq_order_is_feq_order:
11959    !g:'a group. eq_order g = feq ord
11960Proof
11961  rw[eq_order_def, FUN_EQ_THM, fequiv_def]
11962QED
11963
11964(* Theorem: orders g = feq_class ord G *)
11965(* Proof:
11966     orders g n
11967   = {x | x IN G /\ (ord x = n)}   by orders_def
11968   = feq_class ord G n             by feq_class_def
11969   Hence true by FUN_EQ_THM.
11970*)
11971Theorem orders_is_feq_class_order:
11972  !g:'a group. orders g = feq_class ord G
11973Proof
11974  rw[orders_def, in_preimage, EXTENSION, Once FUN_EQ_THM]
11975QED
11976
11977(* Theorem: cyclic g /\ FINITE G ==> (IMAGE ord G = divisors (CARD G)) *)
11978(* Proof:
11979   Note cyclic g ==> Group g                    by cyclic_group
11980    and Group g /\ FINITE G ==> FiniteGroup g   by FiniteGroup_def
11981   If part: x IN G ==> ord x <= CARD G /\ (ord x) divides (CARD G)
11982      Since FiniteGroup g ==> 0 < CARD G        by finite_group_card_pos
11983       also ==> (ord x) divides (CARD G)        by group_order_divides
11984      Hence ord x IN divisors (CARD G)          by divisors_element_alt, 0 < CARD G
11985   Only-if part: n <= CARD G /\ n divides CARD G ==> ?x. x IN G /\ (ord x = n)
11986      True by cyclic_finite_has_order_divisor.
11987*)
11988Theorem cyclic_image_ord_is_divisors:
11989  !g:'a group. cyclic g /\ FINITE G ==> (IMAGE ord G = divisors (CARD G))
11990Proof
11991  rpt strip_tac >>
11992  `Group g` by rw[] >>
11993  `FiniteGroup g` by metis_tac[FiniteGroup_def] >>
11994  `0 < CARD G` by simp[finite_group_card_pos] >>
11995  rw[EXTENSION, divisors_element_alt, EQ_IMP_THM] >-
11996  rw[group_order_divides] >>
11997  metis_tac[cyclic_finite_has_order_divisor]
11998QED
11999
12000(* Theorem: cyclic g /\ FINITE G ==> (partition (eq_order g) G = IMAGE (orders g) (divisors (CARD G))) *)
12001(* Proof:
12002   Since cyclic g /\ FINITE G
12003     ==> FiniteGroup g              by FiniteGroup_def, cyclic_group
12004      so 0 < CARD G                 by finite_group_card_pos
12005    Then partition (eq_order g) G
12006       = {orders g n | n | n divides CARD G}  by cyclic_eq_order_partition
12007       = IMAGE (orders g) (divisors (CARD G)) by divisors_element_alt, 0 < CARD G
12008*)
12009Theorem cyclic_orders_partition:
12010  !g:'a group. cyclic g /\ FINITE G ==>
12011       (partition (eq_order g) G = IMAGE (orders g) (divisors (CARD G)))
12012Proof
12013  rpt strip_tac >>
12014  `FiniteGroup g` by metis_tac[FiniteGroup_def, cyclic_group] >>
12015  `0 < CARD G` by rw[finite_group_card_pos] >>
12016  `partition (eq_order g) G = {orders g n | n | n divides CARD G}` by rw[cyclic_eq_order_partition] >>
12017  rw[divisors_element_alt, EXTENSION]
12018QED
12019
12020(* ------------------------------------------------------------------------- *)
12021(* Finite Cyclic Group Existence.                                            *)
12022(* ------------------------------------------------------------------------- *)
12023
12024(* Theorem: 0 < n ==> ?g:num group. cyclic g /\ (CARD g.carrier = n)  *)
12025(* Proof:
12026   Let g = add_mod n.
12027   Then cyclic (add_mod n)        by add_mod_cylic
12028    and CARD g.carrier = n        by add_mod_card
12029*)
12030Theorem finite_cyclic_group_existence:
12031    !n. 0 < n ==> ?g:num group. cyclic g /\ (CARD g.carrier = n)
12032Proof
12033  rpt strip_tac >>
12034  qexists_tac `add_mod n` >>
12035  rpt strip_tac >-
12036  rw[add_mod_cylic] >>
12037  rw[add_mod_card]
12038QED
12039
12040(* ------------------------------------------------------------------------- *)
12041(* Cyclic Group index relative to a generator.                               *)
12042(* ------------------------------------------------------------------------- *)
12043
12044(* Extract cyclic index w.r.t a generator *)
12045
12046(* Theorem: cyclic g /\ x IN G ==> ?n. (x = (cyclic_gen g) ** n) /\ (FINITE G ==> n < CARD G) *)
12047(* Proof:
12048   Note Group g                          by cyclic_def
12049    and cyclic_gen g IN G /\
12050        ?k. x = (cyclic_gen g) ** k      by cyclic_gen_def
12051   If FINITE G,
12052      Then FiniteGroup g                 by FiniteGroup_def
12053        so 0 < CARD G                    by finite_group_card_pos
12054       and ord (cyclic_gen g) = CARD G   by cyclic_gen_order
12055      Take n = k MOD (CARD G).
12056      Then (cyclic_gen g) ** n
12057         = (cyclic_gen g) ** k           by group_exp_mod, 0 < CARD G
12058         = x                             by above
12059       and n < CARD G                    by MOD_LESS, 0 < CARD G
12060   If INFINITE G,
12061      Take n = k, the result follows.
12062*)
12063Theorem cyclic_index_exists:
12064    !(g:'a group) x. cyclic g /\ x IN G ==> ?n. (x = (cyclic_gen g) ** n) /\ (FINITE G ==> n < CARD G)
12065Proof
12066  rpt strip_tac >>
12067  `Group g` by rw[] >>
12068  `cyclic_gen g IN G /\ ?n. x = (cyclic_gen g) ** n` by rw[cyclic_gen_def] >>
12069  Cases_on `FINITE G` >| [
12070    rw[] >>
12071    `FiniteGroup g` by rw[FiniteGroup_def] >>
12072    `0 < CARD G` by rw[finite_group_card_pos] >>
12073    `ord (cyclic_gen g) = CARD G` by rw[cyclic_gen_order] >>
12074    qexists_tac `n MOD (CARD G)` >>
12075    rw[Once group_exp_mod],
12076    metis_tac[]
12077  ]
12078QED
12079
12080(* Apply Skolemization *)
12081Theorem lemma[local]:
12082    !(g:'a group) x. ?n. cyclic g /\ x IN G ==> (x = (cyclic_gen g) ** n) /\ (FINITE G ==> n < CARD G)
12083Proof
12084  metis_tac[cyclic_index_exists]
12085QED
12086(*
12087- SKOLEM_THM;
12088> val it = |- !P. (!x. ?y. P x y) <=> ?f. !x. P x (f x) : thm
12089*)
12090(* Define cyclic generator *)
12091(*
12092- SIMP_RULE (bool_ss) [SKOLEM_THM] lemma;
12093> val it =
12094   |- ?f. !g x. cyclic g /\ x IN G ==> x = cyclic_gen g ** f g x /\ (FINITE G ==> f g x < CARD G): thm
12095*)
12096val cyclic_index_def = new_specification(
12097    "cyclic_index_def",
12098    ["cyclic_index"],
12099    SIMP_RULE bool_ss [SKOLEM_THM] lemma);
12100(*
12101val cyclic_index_def =
12102   |- !g x. cyclic g /\ x IN G ==> x = cyclic_gen g ** cyclic_index g x /\
12103            (FINITE G ==> cyclic_index g x < CARD G): thm
12104*)
12105
12106(* Theorem: cyclic g /\ FINITE G ==>
12107            !n. n < CARD G ==> (cyclic_index g (cyclic_gen g ** n) = n) *)
12108(* Proof:
12109   Note Group g                           by cyclic_group
12110    ==> FiniteGroup g                     by FiniteGroup_def
12111    Let x = (cyclic_gen g) ** n.
12112   Note cyclic_gen g IN G                 by cyclic_gen_def
12113   Then x IN G                            by group_exp_element
12114   Thus (x = (cyclic_gen g) ** (cyclic_index g x)) /\
12115        cyclic_index g x < CARD G         by cyclic_index_def
12116    Now ord (cyclic_gen g) = CARD G       by cyclic_gen_order
12117    and 0 < CARD G                        by finite_group_card_pos
12118   Thus n = cyclic_index g x              by group_exp_equal
12119*)
12120Theorem finite_cyclic_index_property:
12121    !g:'a group. cyclic g /\ FINITE G ==>
12122   !n. n < CARD G ==> (cyclic_index g ((cyclic_gen g) ** n) = n)
12123Proof
12124  rpt strip_tac >>
12125  `Group g` by rw[] >>
12126  `FiniteGroup g` by rw[FiniteGroup_def] >>
12127  qabbrev_tac `x = (cyclic_gen g) ** n` >>
12128  `cyclic_gen g IN G` by rw[cyclic_gen_def] >>
12129  `x IN G` by rw[Abbr`x`] >>
12130  `(x = (cyclic_gen g) ** (cyclic_index g x)) /\ cyclic_index g x < CARD G` by fs[cyclic_index_def] >>
12131  `ord (cyclic_gen g) = CARD G` by rw[cyclic_gen_order] >>
12132  metis_tac[group_exp_equal, finite_group_card_pos]
12133QED
12134
12135(* Theorem: cyclic g /\ FINITE G /\ x IN G ==>
12136            !n. n < CARD G ==> ((x = (cyclic_gen g) ** n) <=> (n = cyclic_index g x)) *)
12137(* Proof:
12138   If part: (x = (cyclic_gen g) ** n) ==> (n = cyclic_index g x)
12139      This is true by finite_cyclic_index_property.
12140   Only-if part: (n = cyclic_index g x) ==> (x = (cyclic_gen g) ** n)
12141      This is true by cyclic_index_def
12142*)
12143Theorem finite_cyclic_index_unique:
12144    !g:'a group x. cyclic g /\ FINITE G /\ x IN G ==>
12145   !n. n < CARD G ==> ((x = (cyclic_gen g) ** n) <=> (n = cyclic_index g x))
12146Proof
12147  rpt strip_tac >>
12148  `Group g` by rw[] >>
12149  rw[cyclic_index_def, EQ_IMP_THM] >>
12150  rw[finite_cyclic_index_property]
12151QED
12152
12153(* Theorem: cyclic g /\ FINITE G /\ x IN G /\ y IN G ==>
12154            (cyclic_index g (x * y) = ((cyclic_index g x) + (cyclic_index g y)) MOD (CARD G)) *)
12155(* Proof:
12156   Note Group g                 by cyclic_group
12157     so FiniteGroup g           by FiniteGroup_def
12158    and x * y IN G              by group_op_element
12159   Let z = cyclic_gen g.
12160   Then z IN G                  by cyclic_gen_def
12161    and ord z = CARD G          by cyclic_gen_order
12162   Note 0 < CARD G              by finite_group_card_pos
12163   Let h = cyclic_index g x, k = cyclic_index g y.
12164       z ** ((h + k) MOD CARD G)
12165     = z ** (h + k)             by group_exp_mod
12166     = (z ** h) * (z ** k)      by group_exp_add
12167     = x * y                    by cyclic_index_def
12168   Note (h + k) MOD (CARD G) < CARD G                   by MOD_LESS
12169   Thus (h + k) MOD (CARD G) = cyclic_index g (x * y)   by finite_cyclic_index_unique
12170*)
12171Theorem finite_cyclic_index_add:
12172    !g:'a group x y. cyclic g /\ FINITE G /\ x IN G /\ y IN G ==>
12173    (cyclic_index g (x * y) = ((cyclic_index g x) + (cyclic_index g y)) MOD (CARD G))
12174Proof
12175  rpt strip_tac >>
12176  `Group g` by rw[] >>
12177  `FiniteGroup g` by rw[FiniteGroup_def] >>
12178  `x * y IN G` by rw[] >>
12179  qabbrev_tac `z = cyclic_gen g` >>
12180  `z IN G` by rw[cyclic_gen_def, Abbr`z`] >>
12181  `ord z = CARD G` by rw[cyclic_gen_order, Abbr`z`] >>
12182  `0 < CARD G` by rw[finite_group_card_pos] >>
12183  qabbrev_tac `h = cyclic_index g x` >>
12184  qabbrev_tac `k = cyclic_index g y` >>
12185  `z ** ((h + k) MOD CARD G) = z ** (h + k)` by metis_tac[group_exp_mod] >>
12186  `_ = (z ** h) * (z ** k)` by rw[] >>
12187  `_ = x * y` by metis_tac[cyclic_index_def] >>
12188  `0 < CARD G` by rw[finite_group_card_pos] >>
12189  `(h + k) MOD (CARD G) < CARD G` by rw[] >>
12190  metis_tac[finite_cyclic_index_unique]
12191QED
12192
12193(* ------------------------------------------------------------------------- *)
12194(* Finite Cyclic Group Uniqueness.                                           *)
12195(* ------------------------------------------------------------------------- *)
12196
12197(* Theorem: cyclic g1 /\ cyclic g2 /\
12198   FINITE g1.carrier /\ FINITE g2.carrier /\ (CARD g1.carrier = CARD g2.carrier) ==>
12199      GroupHomo (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1 g2 *)
12200(* Proof:
12201   Note Group g2                                     by cyclic_group
12202    and FiniteGroup g2                               by FiniteGroup_def
12203   Note cyclic_gen g2 IN g2.carrier                  by cyclic_gen_def
12204    and order g2 (cyclic_gen g2) = CARD g2.carrier   by cyclic_gen_order
12205
12206   By GroupHomo_def, this is to show:
12207   (1) x IN g1.carrier ==> g2.exp (cyclic_gen g2) (cyclic_index g1 x) IN g2.carrier
12208       This is true           by group_exp_element
12209   (2) x IN g1.carrier /\ x' IN g1.carrier ==>
12210         g2.exp (cyclic_gen g2) (cyclic_index g1 (g1.op x x')) =
12211         g2.op (g2.exp (cyclic_gen g2) (cyclic_index g1 x)) (g2.exp (cyclic_gen g2) (cyclic_index g1 x'))
12212
12213         g2.exp (cyclic_gen g2) (cyclic_index g1 (g1.op x x'))
12214       = g2.exp (cyclic_gen g2) (((cyclic_index g1 x) +
12215                                  (cyclic_index g1 x')) MOD (CARD g1.carrier)) by finite_cyclic_index_add
12216       = g2.exp (cyclic_gen g2) ((cyclic_index g1 x) + (cyclic_index g1 x'))   by group_exp_mod, group_order_pos
12217       = g2.op (g2.exp (cyclic_gen g2) (cyclic_index g1 x))
12218               (g2.exp (cyclic_gen g2) (cyclic_index g1 x'))                   by group_exp_add
12219*)
12220Theorem finite_cyclic_group_homo:
12221    !g1:'a group g2:'b group. cyclic g1 /\ cyclic g2 /\
12222   FINITE g1.carrier /\ FINITE g2.carrier /\ (CARD g1.carrier = CARD g2.carrier) ==>
12223      GroupHomo (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1 g2
12224Proof
12225  rpt strip_tac >>
12226  `Group g2 /\ FiniteGroup g2` by rw[FiniteGroup_def, cyclic_group] >>
12227  `cyclic_gen g2 IN g2.carrier` by rw[cyclic_gen_def] >>
12228  `order g2 (cyclic_gen g2) = CARD g2.carrier` by rw[cyclic_gen_order] >>
12229  rw[GroupHomo_def] >>
12230  `g2.exp (cyclic_gen g2) (cyclic_index g1 (g1.op x x')) =
12231    g2.exp (cyclic_gen g2) (((cyclic_index g1 x) + (cyclic_index g1 x')) MOD (CARD g1.carrier))` by rw[finite_cyclic_index_add] >>
12232  `_ = g2.exp (cyclic_gen g2) ((cyclic_index g1 x) + (cyclic_index g1 x'))` by metis_tac[group_exp_mod, group_order_pos] >>
12233  rw[group_exp_add]
12234QED
12235
12236(* Theorem: cyclic g1 /\ cyclic g2 /\
12237   FINITE g1.carrier /\ FINITE g2.carrier /\ (CARD g1.carrier = CARD g2.carrier) ==>
12238      BIJ (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1.carrier g2.carrier *)
12239(* Proof:
12240   Note Group g2                                     by cyclic_group
12241    and FiniteGroup g2                               by FiniteGroup_def
12242   Note cyclic_gen g2 IN g2.carrier                  by cyclic_gen_def
12243    and order g2 (cyclic_gen g2) = CARD g2.carrier   by cyclic_gen_order
12244
12245   By BIJ_DEF, INJ_DEF, SURJ_DEF, this is to show:
12246   (1) x IN g1.carrier ==> g2.exp (cyclic_gen g2) (cyclic_index g1 x) IN g2.carrier
12247       This is true           by group_exp_element
12248   (2) x IN g1.carrier /\ x' IN g1.carrier /\
12249       g2.exp (cyclic_gen g2) (cyclic_index g1 x) = g2.exp (cyclic_gen g2) (cyclic_index g1 x') ==> x = x'
12250       Note cyclic_index g1 x < CARD g2.carrier           by cyclic_index_def
12251        and cyclic_index g1 x' < CARD g2.carrier          by cyclic_index_def
12252       Thus cyclic_index g1 x = cyclic_index g1 x'        by group_exp_equal, group_order_ps
12253            x
12254          = g1.exp (cyclic_gen g1) (cyclic_index g1 x)    by finite_cyclic_index_unique
12255          = g1.exp (cyclic_gen g1) (cyclic_index g1 x')   by above
12256          = x'                                            by finite_cyclic_index_unique
12257   (3) x IN g2.carrier ==> ?x'. x' IN g1.carrier /\ g2.exp (cyclic_gen g2) (cyclic_index g1 x') = x
12258       Note Group g1                                      by cyclic_group
12259        and FiniteGroup g1                                by FiniteGroup_def
12260       Note cyclic_gen g1 IN g2.carrier                   by cyclic_gen_def
12261        and order g1 (cyclic_gen g1) = CARD g1.carrier    by cyclic_gen_order
12262        and cyclic_index g2 x < CARD g2.carrier           by cyclic_index_def
12263
12264        Let x' = g1.exp (cyclic_gen g1) (cyclic_index g2 x).
12265       Then g1.exp (cyclic_gen g1) (cyclic_index g2 x) IN g1.carrier    by group_exp_element
12266        and g2.exp (cyclic_gen g2) (cyclic_index g1 (g1.exp (cyclic_gen g1) (cyclic_index g2 x)))
12267           = g2.exp (cyclic_gen g2) (cyclic_index g2 x)    by finite_cyclic_index_property
12268           = x                                             by cyclic_index_def
12269*)
12270Theorem finite_cyclic_group_bij:
12271    !g1:'a group g2:'b group. cyclic g1 /\ cyclic g2 /\
12272   FINITE g1.carrier /\ FINITE g2.carrier /\ (CARD g1.carrier = CARD g2.carrier) ==>
12273      BIJ (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1.carrier g2.carrier
12274Proof
12275  rpt strip_tac >>
12276  `Group g2 /\ FiniteGroup g2` by rw[FiniteGroup_def, cyclic_group] >>
12277  `cyclic_gen g2 IN g2.carrier` by rw[cyclic_gen_def] >>
12278  `order g2 (cyclic_gen g2) = CARD g2.carrier` by rw[cyclic_gen_order] >>
12279  rw[BIJ_DEF, INJ_DEF, SURJ_DEF] >| [
12280    `cyclic_index g1 x < CARD g2.carrier /\ cyclic_index g1 x' < CARD g2.carrier` by metis_tac[cyclic_index_def] >>
12281    `cyclic_index g1 x = cyclic_index g1 x'` by metis_tac[group_exp_equal, group_order_pos] >>
12282    metis_tac[finite_cyclic_index_unique],
12283    `Group g1 /\ FiniteGroup g1` by rw[FiniteGroup_def, cyclic_group] >>
12284    `cyclic_gen g1 IN g1.carrier` by rw[cyclic_gen_def] >>
12285    `order g1 (cyclic_gen g1) = CARD g1.carrier` by rw[cyclic_gen_order] >>
12286    qexists_tac `g1.exp (cyclic_gen g1) (cyclic_index g2 x)` >>
12287    rw[] >>
12288    `cyclic_index g2 x < CARD g2.carrier` by rw[cyclic_index_def] >>
12289    `cyclic_index g1 (g1.exp (cyclic_gen g1) (cyclic_index g2 x)) = cyclic_index g2 x` by fs[finite_cyclic_index_property] >>
12290    rw[cyclic_index_def]
12291  ]
12292QED
12293
12294(* Theorem: cyclic g1 /\ cyclic g2 /\
12295   FINITE g1.carrier /\ FINITE g2.carrier /\ (CARD g1.carrier = CARD g2.carrier) ==>
12296      GroupIso (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1 g2 *)
12297(* Proof:
12298   By GroupIso_def, this is to show:
12299   (1) GroupHomo (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1 g2
12300       This is true by finite_cyclic_group_homo
12301   (2) BIJ (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1.carrier g2.carrier
12302       This is true by finite_cyclic_group_bij
12303*)
12304Theorem finite_cyclic_group_iso:
12305    !g1:'a group g2:'b group. cyclic g1 /\ cyclic g2 /\
12306   FINITE g1.carrier /\ FINITE g2.carrier /\ (CARD g1.carrier = CARD g2.carrier) ==>
12307      GroupIso (\x. g2.exp (cyclic_gen g2) (cyclic_index g1 x)) g1 g2
12308Proof
12309  rw[GroupIso_def] >-
12310  rw[finite_cyclic_group_homo] >>
12311  rw[finite_cyclic_group_bij]
12312QED
12313
12314(* Theorem: cyclic g1 /\ cyclic g2 /\ FINITE g1.carrier /\ FINITE g2.carrier /\
12315            (CARD g1.carrier = CARD g2.carrier) ==> ?f. GroupIso f g1 g2 *)
12316(* Proof:
12317   Let f = \x. g2.exp (cyclic_gen g2) (cyclic_index g1 x).
12318   The result follows by finite_cyclic_group_iso
12319*)
12320Theorem finite_cyclic_group_uniqueness:
12321    !g1:'a group g2:'b group. cyclic g1 /\ cyclic g2 /\ FINITE g1.carrier /\ FINITE g2.carrier /\
12322        (CARD g1.carrier = CARD g2.carrier) ==> ?f. GroupIso f g1 g2
12323Proof
12324  metis_tac[finite_cyclic_group_iso]
12325QED
12326
12327(* This completes the classification of finite cyclic groups. *)
12328
12329(* Another proof of uniqueness *)
12330
12331(* Theorem: cyclic g /\ FINITE G ==> GroupHomo (\n. (cyclic_gen g) ** n) (add_mod (CARD G)) g *)
12332(* Proof:
12333   Note Group g                             by cyclic_group
12334    and FiniteGroup g                       by FiniteGroup_def
12335    and cyclic_gen g IN G                   by cyclic_gen_def
12336    and order g (cyclic_gen g) = CARD G     by cyclic_gen_order
12337   By GroupHomo_def, this is to show:
12338   (1) (cyclic_gen g) ** n IN G, true       by group_exp_element
12339   (2) n < CARD G /\ n' < CARD G ==>
12340       cyclic_gen g ** ((n + n') MOD CARD G) = cyclic_gen g ** n * cyclic_gen g ** n'
12341       Note cyclic_gen g ** ((n + n') MOD CARD G)
12342          = cyclic_gen g ** (n + n')                 by group_exp_mod, 0 < CARD G
12343          = cyclic_gen g ** n * cyclic_gen g ** n'   by group_exp_add
12344*)
12345Theorem finite_cyclic_group_add_mod_homo:
12346    !g:'a group. cyclic g /\ FINITE G ==> GroupHomo (\n. (cyclic_gen g) ** n) (add_mod (CARD G)) g
12347Proof
12348  rpt strip_tac >>
12349  `Group g /\ FiniteGroup g` by rw[FiniteGroup_def, cyclic_group] >>
12350  `cyclic_gen g IN G` by rw[cyclic_gen_def] >>
12351  `order g (cyclic_gen g) = CARD G` by rw[cyclic_gen_order] >>
12352  rw[GroupHomo_def] >>
12353  `0 < CARD G` by decide_tac >>
12354  `cyclic_gen g ** ((n + n') MOD CARD G) = cyclic_gen g ** (n + n')` by metis_tac[group_exp_mod] >>
12355  rw[]
12356QED
12357
12358(* Theorem: cyclic g /\ FINITE G ==> BIJ (\n. (cyclic_gen g) ** n) (add_mod (CARD G)).carrier G *)
12359(* Proof:
12360   Note Group g                             by cyclic_group
12361    and FiniteGroup g                       by FiniteGroup_def
12362    and cyclic_gen g IN G                   by cyclic_gen_def
12363    and order g (cyclic_gen g) = CARD G     by cyclic_gen_order
12364   By BIJ_DEF, INJ_DEF, SURJ_DEF, this is to show:
12365   (1) (cyclic_gen g) ** n IN G, true       by group_exp_element
12366   (2) n < CARD G /\ n' < CARD G /\ cyclic_gen g ** n = cyclic_gen g ** n' ==> n = n'
12367       This is true                         by finite_cyclic_index_property
12368   (3) x IN G ==> ?n. n < CARD G /\ (cyclic_gen g ** n = x)
12369       This is true                         by cyclic_index_def
12370*)
12371Theorem finite_cyclic_group_add_mod_bij:
12372    !g:'a group. cyclic g /\ FINITE G ==> BIJ (\n. (cyclic_gen g) ** n) (add_mod (CARD G)).carrier G
12373Proof
12374  rpt strip_tac >>
12375  `Group g /\ FiniteGroup g` by rw[FiniteGroup_def, cyclic_group] >>
12376  `cyclic_gen g IN G` by rw[cyclic_gen_def] >>
12377  `order g (cyclic_gen g) = CARD G` by rw[cyclic_gen_order] >>
12378  rw[BIJ_DEF, INJ_DEF, SURJ_DEF] >-
12379  metis_tac[finite_cyclic_index_property] >>
12380  metis_tac[cyclic_index_def]
12381QED
12382
12383(* Theorem: cyclic g /\ FINITE G ==> GroupIso (\n. (cyclic_gen g) ** n) (add_mod (CARD G)) g *)
12384(* Proof:
12385   By GroupIso_def, this is to show:
12386   (1) GroupHomo (\n. cyclic_gen g ** n) (add_mod (CARD G)) g
12387       This is true by finite_cyclic_group_add_mod_homo
12388   (2) BIJ (\n. cyclic_gen g ** n) (add_mod (CARD G)).carrier G
12389       This is true by finite_cyclic_group_add_mod_bij
12390*)
12391Theorem finite_cyclic_group_add_mod_iso:
12392    !g:'a group. cyclic g /\ FINITE G ==> GroupIso (\n. (cyclic_gen g) ** n) (add_mod (CARD G)) g
12393Proof
12394  rw_tac std_ss[GroupIso_def] >-
12395  rw[finite_cyclic_group_add_mod_homo] >>
12396  rw[finite_cyclic_group_add_mod_bij]
12397QED
12398
12399(* Theorem: cyclic g1 /\ cyclic g2 /\ FINITE g1.carrier /\ FINITE g2.carrier /\
12400            (CARD g1.carrier = CARD g2.carrier) ==> ?f. GroupIso f g1 g2 *)
12401(* Proof:
12402   Note Group g1                             by cyclic_group
12403     so FiniteGroup g1                       by FiniteGroup_def
12404    ==> 0 < CARD g1.carrier                  by finite_group_card_pos
12405   Thus Group (add_mod (CARD g1.carrier))    by add_mod_group, 0 < CARD g1.carrier
12406   Let f1 = (\n. g1.exp (cyclic_gen g1) n),
12407       f2 = (\n. g2.exp (cyclic_gen g2) n).
12408    Now GroupIso f1 (add_mod (CARD g1.carrier)) g1    by finite_cyclic_group_add_mod_iso
12409    and GroupIso f2 (add_mod (CARD g2.carrier)) g2    by finite_cyclic_group_add_mod_iso
12410   Thus GroupIso (LINV f1 (add_mod (CARD g1.carrier)).carrier) g1 (add_mod (CARD g1.carrier))
12411                                                      by group_iso_sym
12412     or ?f. GroupIso f g1 g2                          by group_iso_trans
12413*)
12414Theorem finite_cyclic_group_uniqueness[allow_rebind]:
12415  !g1:'a group g2:'b group.
12416    cyclic g1 /\ cyclic g2 /\ FINITE g1.carrier /\ FINITE g2.carrier /\
12417    (CARD g1.carrier = CARD g2.carrier) ==>
12418    ?f. GroupIso f g1 g2
12419Proof
12420  rpt strip_tac >>
12421  ‘Group g1 /\ FiniteGroup g1’ by rw[cyclic_group, FiniteGroup_def] >>
12422  ‘0 < CARD g1.carrier’ by rw[finite_group_card_pos] >>
12423  ‘Group (add_mod (CARD g1.carrier))’ by rw[add_mod_group] >>
12424  ‘GroupIso (\n. g1.exp (cyclic_gen g1) n) (add_mod (CARD g1.carrier)) g1’ by rw[finite_cyclic_group_add_mod_iso] >>
12425  ‘GroupIso (\n. g2.exp (cyclic_gen g2) n) (add_mod (CARD g2.carrier)) g2’ by rw[finite_cyclic_group_add_mod_iso] >>
12426  metis_tac[group_iso_sym, group_iso_trans]
12427QED
12428
12429(* ------------------------------------------------------------------------- *)
12430(* Isomorphism between Cyclic Groups                                         *)
12431(* ------------------------------------------------------------------------- *)
12432
12433(* Theorem: cyclic g /\ cyclic h /\ FINITE G /\
12434            GroupIso f g h ==> f (cyclic_gen g) IN (cyclic_generators h) *)
12435(* Proof:
12436   Note Group g /\ Group h          by cyclic_group
12437    and cyclic_gen g IN G           by cyclic_gen_element
12438   By cyclic_generators_element, this is to show:
12439   (1) f (cyclic_gen g) IN h.carrier, true by group_iso_element
12440   (2) order h (f (cyclic_gen g)) = CARD h.carrier
12441        order h (f (cyclic_gen g))
12442      = ord (cyclic_gen g)          by group_iso_order
12443      = CARD G                      by cyclic_gen_order, FINITE G
12444      = CARD h.carrier              by group_iso_card_eq
12445*)
12446Theorem cyclic_iso_gen:
12447    !(g:'a group) (h:'b group) f. cyclic g /\ cyclic h /\ FINITE G /\
12448        GroupIso f g h ==> f (cyclic_gen g) IN (cyclic_generators h)
12449Proof
12450  rpt strip_tac >>
12451  `Group g /\ Group h` by rw[] >>
12452  `cyclic_gen g IN G` by rw[cyclic_gen_element] >>
12453  rw[cyclic_generators_element] >-
12454  metis_tac[group_iso_element] >>
12455  `order h (f (cyclic_gen g)) = ord (cyclic_gen g)` by rw[group_iso_order] >>
12456  `_ = CARD G` by rw[cyclic_gen_order] >>
12457  metis_tac[group_iso_card_eq]
12458QED
12459
12460(*===========================================================================*)
12461
12462(*
12463
12464Group action
12465============
12466. action f is a map from Group g to target set X, satisfying some conditions.
12467. The action induces an equivalence relation "reach" on target set X.
12468. The equivalent classes of "reach" on A are called orbits.
12469. Due to this partition, CARD X = SIGMA CARD orbits.
12470. As equivalent classes are non-empty, minimum CARD orbit = 1.
12471. These singleton orbits have a 1-1 correspondence with a special set on A:
12472  the fixed_points. The main result is:
12473  CARD X = CARD fixed_points + SIGMA (CARD non-singleton orbits).
12474
12475  When group action is applied to necklaces, Z[n] enters into the picture.
12476  The cyclic Z[n] of modular addition is the group for necklaces of n beads.
12477
12478Rework
12479======
12480. name target set Xs X, with points x, y, use a, b as group elements.
12481. keep x, y as group elements, a, b as set A elements.
12482. orbit is defined as image, with one less parameter.
12483. orbits is named, replacing TargetPartition.
12484
12485*)
12486
12487(*===========================================================================*)
12488
12489(* ------------------------------------------------------------------------- *)
12490(* Group Action Documentation                                                *)
12491(* ------------------------------------------------------------------------- *)
12492(* Overloading:
12493   (g act X) f    = action f g X
12494   (x ~~ y) f g   = reach f g x y
12495*)
12496(* Definitions and Theorems (# are exported):
12497
12498   Helper Theorems:
12499
12500   Group action:
12501   action_def       |- !f g X. (g act X) f <=> !x. x IN X ==>
12502                               (!a. a IN G ==> f a x IN X) /\ f #e x = x /\
12503                                !a b. a IN G /\ b IN G ==> f a (f b x) = f (a * b) x
12504   action_closure   |- !f g X. (g act X) f ==> !a x. a IN G /\ x IN X ==> f a x IN X
12505   action_compose   |- !f g X. (g act X) f ==>
12506                       !a b x. a IN G /\ b IN G /\ x IN X ==> f a (f b x) = f (a * b) x
12507   action_id        |- !f g X. (g act X) f ==> !x. x IN X ==> f #e x = x
12508   action_reverse   |- !f g X. Group g /\ (g act X) f ==>
12509                       !a x y. a IN G /\ x IN X /\ y IN X /\ f a x = y ==> f ( |/ a) y = x
12510   action_trans     |- !f g X. (g act X) f ==> !a b x y z. a IN G /\ b IN G /\
12511                       x IN X /\ y IN X /\ z IN X /\ f a x = y /\ f b y = z ==> f (b * a) x = z
12512
12513   Group action induces an equivalence relation:
12514   reach_def    |- !f g x y. (x ~~ y) f g <=> ?a. a IN G /\ f a x = b
12515   reach_refl   |- !f g X x. Group g /\ (g act X) f /\ x IN X ==> (x ~~ x) f g
12516   reach_sym    |- !f g X x y. Group g /\ (g act X) f /\ x IN X /\ y IN X /\ (x ~~ y) f g ==> (y ~~ x) f g
12517   reach_trans  |- !f g X x y z. Group g /\ (g act X) f /\ x IN X /\ y IN X /\ z IN X /\
12518                                 (x ~~ y) f g /\ (y ~~ z) f g ==> (x ~~ z) f g
12519   reach_equiv  xx|- !f g X. Group g /\ (g act X) f ==> reach f g equiv_on X
12520
12521   Orbits as equivalence classes of Group action:
12522   orbit_def           |- !f g x. orbit f g x = IMAGE (\a. f a x) G
12523   orbit_alt           |- !f g x. orbit f g x = {f a x | a IN G}
12524   orbit_element       |- !f g x y. y IN orbit f g x <=> (x ~~ y) f g
12525   orbit_has_action_element
12526                       |- !f g x a. a IN G ==> f a x IN orbit f g x
12527   orbit_has_self      |- !f g X x. Group g /\ (g act X) f /\ x IN X ==> x IN orbit f g x
12528   orbit_subset_target |- !f g X x. (g act X) f /\ x IN X ==> orbit f g x SUBSET X
12529   orbit_element_in_target
12530                       |- !f g X x y. (g act X) f /\ x IN X /\ y IN orbit f g x ==> y IN X
12531   orbit_finite        |- !f g X. FINITE G ==> FINITE (orbit f g x)
12532   orbit_finite_by_target
12533                       |- !f g X x. (g act X) f /\ x IN X /\ FINITE X ==> FINITE (orbit f g x)
12534   orbit_eq_equiv_class|- !f g X x. (g act X) f /\ x IN X ==>
12535                                    orbit f g x = equiv_class (reach f g) X x
12536   orbit_eq_orbit      |- !f g X x y. Group g /\ (g act X) f /\ x IN X /\ y IN X ==>
12537                                     (orbit f g x = orbit f g y <=> (x ~~ y) f g)
12538
12539   Partition by Group action:
12540   orbits_def          |- !f g X. orbits f g X = IMAGE (orbit f g) X
12541   orbits_alt          |- !f g X. orbits f g X = {orbit f g x | x IN X}
12542   orbits_element      |- !f g X e. e IN orbits f g X <=> ?x. x IN X /\ e = orbit f g x
12543   orbits_eq_partition |- !f g X. (g act X) f ==> orbits f g X = partition (reach f g) X
12544   orbits_finite       |- !f g X. FINITE X ==> FINITE (orbits f g X)
12545   orbits_element_finite   |- !f g X. (g act X) f /\ FINITE X ==> EVERY_FINITE (orbits f g X)
12546   orbits_element_nonempty |- !f g X. Group g /\ (g act X) f ==> !e. e IN orbits f g X ==> e <> {}
12547   orbits_element_subset   |- !f g X e. (g act X) f /\ e IN orbits f g X ==> e SUBSET X
12548   orbits_element_element  |- !f g X e x. (g act X) f /\ e IN orbits f g X /\ x IN e ==> x IN X
12549   orbit_is_orbits_element |- !f g X x. x IN X ==> orbit f g x IN orbits f g X
12550   orbits_element_is_orbit |- !f g X e x. Group g /\ (g act X) f /\ e IN orbits f g X /\ x IN e ==>
12551                                          e = orbit f g x
12552
12553   Target size and orbit size:
12554   action_to_orbit_surj        |- !f g X x. (g act X) f /\ x IN X ==> SURJ (\a. f a x) G (orbit f g x)
12555   orbit_finite_inj_card_eq    |- !f g X x. (g act X) f /\ x IN X /\ FINITE X /\
12556                                            INJ (\a. f a x) G (orbit f g x) ==>
12557                                            CARD (orbit f g x) = CARD G
12558   target_card_by_partition    |- !f g X. Group g /\ (g act X) f /\ FINITE X ==>
12559                                          CARD X = SIGMA CARD (orbits f g X)
12560   orbits_equal_size_partition_equal_size
12561                               |- !f g X n. Group g /\ (g act X) f /\ FINITE X /\
12562                                           (!x. x IN X ==> CARD (orbit f g x) = n) ==>
12563                                            !e. e IN orbits f g X ==> CARD e = n
12564   orbits_equal_size_property  |- !f g X n. Group g /\ (g act X) f /\ FINITE X /\
12565                                           (!x. x IN X ==> CARD (orbit f g x) = n) ==>
12566                                            n divides CARD X
12567   orbits_size_factor_partition_factor
12568                               |- !f g X n. Group g /\ (g act X) f /\ FINITE X /\
12569                                           (!x. x IN X ==> n divides CARD (orbit f g x)) ==>
12570                                            !e. e IN orbits f g X ==> n divides CARD e
12571   orbits_size_factor_property |- !f g X n. Group g /\ (g act X) f /\ FINITE X /\
12572                                           (!x. x IN X ==> n divides CARD (orbit f g x)) ==>
12573                                            n divides CARD X
12574
12575   Stabilizer as invariant:
12576   stabilizer_def        |- !f g x. stabilizer f g x = {a | a IN G /\ f a x = x}
12577   stabilizer_element    |- !f g x a. a IN stabilizer f g x <=> a IN G /\ f a x = x
12578   stabilizer_subset     |- !f g x. stabilizer f g x SUBSET G
12579   stabilizer_has_id     |- !f g X x. Group g /\ (g act X) f /\ x IN X ==> #e IN stabilizer f g x
12580   stabilizer_nonempty   |- !f g X x. Group g /\ (g act X) f /\ x IN X ==> stabilizer f g x <> {}
12581   stabilizer_as_image   |- !f g X x. Group g /\ (g act X) f /\ x IN X ==>
12582                                      stabilizer f g x = IMAGE (\x. if f a x = x then a else #e) G
12583
12584   Stabilizer subgroup:
12585   StabilizerGroup_def            |- !f g x. StabilizerGroup f g x =
12586                                             <|carrier := stabilizer f g x; op := $*; id := #e|>
12587   stabilizer_group_property      |- !f g X. ((StabilizerGroup f g x).carrier = stabilizer f g x) /\
12588                                             ((StabilizerGroup f g x).op = $* ) /\
12589                                             ((StabilizerGroup f g x).id = #e)
12590   stabilizer_group_carrier       |- !f g X. (StabilizerGroup f g x).carrier = stabilizer f g x
12591   stabilizer_group_id            |- !f g X. (StabilizerGroup f g x).id = #e
12592   stabilizer_group_group         |- !f g X x. Group g /\ (g act X) f /\ x IN X ==>
12593                                               Group (StabilizerGroup f g x)
12594   stabilizer_group_subgroup      |- !f g X x. Group g /\ (g act X) f /\ x IN X ==>
12595                                               StabilizerGroup f g x <= g
12596   stabilizer_group_finite_group  |- !f g X x. FiniteGroup g /\ (g act X) f /\ x IN X ==>
12597                                               FiniteGroup (StabilizerGroup f g x)
12598   stabilizer_group_card_divides  |- !f g X x. FiniteGroup g /\ (g act X) f /\ x IN X ==>
12599                                               CARD (stabilizer f g x) divides CARD G
12600
12601   Orbit-Stabilizer Theorem:
12602   orbit_stabilizer_map_good |- !f g X x. Group g /\ (g act X) f /\ x IN X ==>
12603                                !a b. a IN G /\ b IN G /\ f a x = f b x ==>
12604                                      (a * stabilizer f g x = b * stabilizer f g x)
12605   orbit_stabilizer_map_inj  |- !f g X x. Group g /\ (g act X) f /\ x IN X ==>
12606                                !a b. a IN G /\ b IN G /\ (a * stabilizer f g x = b * stabilizer f g x) ==>
12607                                      f a x = f b x
12608   action_match_condition    |- !f g X x. Group g /\ (g act X) f /\ x IN X ==>
12609                                !a b. a IN G /\ b IN G ==> (f a x = f b x <=> |/ x * y IN stabilizer f g x)
12610   action_match_condition_alt|- !f g X x. Group g /\ (g act X) f /\ x IN X ==>
12611                                !x y::G. f a x = f b x <=> |/ x * y IN stabilizer f g x
12612   stabilizer_conjugate      |- !f g X x a. Group g /\ (g act X) f /\ x IN X /\ a IN G ==>
12613                                            (conjugate g a (stabilizer f g x) = stabilizer f g (f a x))
12614   act_by_def                |- !f g x y. (x ~~ y) f g ==> act_by f g x y IN G /\ f (act_by f g x y) x = y
12615   action_reachable_coset    |- !f g X x y. Group g /\ (g act X) f /\ x IN X /\ y IN orbit f g x ==>
12616                                (act_by f g x y * stabilizer f g x = {a | a IN G /\ f a x = y})
12617   action_reachable_coset_alt|- !f g X x y. Group g /\ (g act X) f /\ x IN X /\ y IN orbit f g x ==>
12618                                !a. a IN G /\ f a x = y ==> a * stabilizer f g x = {b | b IN G /\ f b x = y}
12619   orbit_stabilizer_cosets_bij     |- !f g X x. Group g /\ (g act X) f /\ x IN X ==>
12620                                      BIJ (\y. act_by f g x y * stabilizer f g x)
12621                                          (orbit f g x)
12622                                          {a * stabilizer f g x | a | a IN G}
12623   orbit_stabilizer_cosets_bij_alt |- !f g X x. Group g /\ (g act X) f /\ x IN X ==>
12624                                      BIJ (\y. act_by f g x y * stabilizer f g x)
12625                                          (orbit f g x)
12626                                          (CosetPartition g (StabilizerGroup f g x))
12627   orbit_stabilizer_thm      |- !f g X x. FiniteGroup g /\ (g act X) f /\ x IN X /\ FINITE X ==>
12628                                          (CARD G = CARD (orbit f g x) * CARD (stabilizer f g x))
12629   orbit_card_divides_target_card
12630                             |- !f g X x. FiniteGroup g /\ (g act X) f /\ x IN X /\ FINITE X ==>
12631                                          CARD (orbit f g x) divides CARD G
12632
12633   Fixed Points of action:
12634   fixed_points_def          |- !f g X. fixed_points f g X = {x | x IN X /\ !a. a IN G ==> f a x = x}
12635   fixed_points_element      |- !f g X x. x IN fixed_points f g X <=>
12636                                          x IN X /\ !a. a IN G ==> f a x = x
12637   fixed_points_subset       |- !f g X. fixed_points f g X SUBSET X
12638   fixed_points_finite       |- !f g X. FINITE X ==> FINITE (fixed_points f g X)
12639   fixed_points_element_element
12640                             |- !f g X x. x IN fixed_points f g X ==> x IN X
12641   fixed_points_orbit_sing   |- !f g X. Group g /\ (g act X) f ==>
12642                                !x. x IN fixed_points f g X <=> <=> x IN X /\ orbit f g x = {x}
12643   orbit_sing_fixed_points   |- !f g X. (g act X) f ==>
12644                                !x. x IN X /\ orbit f g x = {x} ==> x IN fixed_points f g X
12645   fixed_points_orbit_iff_sing
12646                             |- !f g X. Group g /\ (g act X) f ==>
12647                                !x. x IN X ==> (x IN fixed_points f g X <=> SING (orbit f g x))
12648   non_fixed_points_orbit_not_sing
12649                             |- !f g X. Group g /\ (g act X) f ==>
12650                                !x. x IN X DIFF fixed_points f g X <=> x IN X /\ ~SING (orbit f g x)
12651   non_fixed_points_card     |- !f g X. FINITE X ==>
12652                                CARD (X DIFF fixed_points f g X) = CARD X - CARD (fixed_points f g X)
12653
12654   Target Partition by orbits:
12655   sing_orbits_def                  |- !f g X. sing_orbits f g X = {e | e IN orbits f g X /\ SING e}
12656   multi_orbits_def                 |- !f g X. multi_orbits f g X = {e | e IN orbits f g X /\ ~SING e}
12657   sing_orbits_element              |- !f g X e. e IN sing_orbits f g X <=> e IN orbits f g X /\ SING e
12658   sing_orbits_subset               |- !f g X. sing_orbits f g X SUBSET orbits f g X
12659   sing_orbits_finite               |- !f g X. FINITE X ==> FINITE (sing_orbits f g X)
12660   sing_orbits_element_subset       |- !f g X e. (g act X) f /\ e IN sing_orbits f g X ==> e SUBSET X
12661   sing_orbits_element_finite       |- !f g X e. e IN sing_orbits f g X ==> FINITE e
12662   sing_orbits_element_card         |- !f g X e. e IN sing_orbits f g X ==> CARD e = 1
12663   sing_orbits_element_choice       |- !f g X. Group g /\ (g act X) f ==>
12664                                       !e. e IN sing_orbits f g X ==> CHOICE e IN fixed_points f g X
12665   multi_orbits_element             |- !f g X e. e IN multi_orbits f g X <=> e IN orbits f g X /\ ~SING e
12666   multi_orbits_subset              |- !f g X. multi_orbits f g X SUBSET orbits f g X
12667   multi_orbits_finite              |- !f g X. FINITE X ==> FINITE (multi_orbits f g X)
12668   multi_orbits_element_subset      |- !f g X e. (g act X) f /\ e IN multi_orbits f g X ==> e SUBSET X
12669   multi_orbits_element_finite      |- !f g X e. (g act X) f /\ FINITE X /\ e IN multi_orbits f g X ==> FINITE e
12670   target_orbits_disjoint           |- !f g X. DISJOINT (sing_orbits f g X) (multi_orbits f g X)
12671   target_orbits_union              |- !f g X. orbits f g X = sing_orbits f g X UNION multi_orbits f g X
12672   target_card_by_orbit_types       |- !f g X. Group g /\ (g act X) f /\ FINITE X ==>
12673                                       (CARD X = CARD (sing_orbits f g X) + SIGMA CARD (multi_orbits f g X))
12674   sing_orbits_to_fixed_points_inj  |- !f g X. Group g /\ (g act X) f ==>
12675                                               INJ (\e. CHOICE e) (sing_orbits f g X) (fixed_points f g X)
12676   sing_orbits_to_fixed_points_surj |- !f g X. Group g /\ (g act X) f ==>
12677                                               SURJ (\e. CHOICE e) (sing_orbits f g X) (fixed_points f g
12678   sing_orbits_to_fixed_points_bij  |- !f g X. Group g /\ (g act X) f ==>
12679                                               BIJ (\e. CHOICE e) (sing_orbits f g X) (fixed_points f g X)
12680   sing_orbits_card_eqn             |- !f g X. Group g /\ (g act X) f /\ FINITE X ==>
12681                                               (CARD (sing_orbits f g X) = CARD (fixed_points f g X))
12682   target_card_by_fixed_points      |- !f g X. Group g /\ (g act X) f /\ FINITE X ==>
12683                                              (CARD X = CARD (fixed_points f g X) +
12684                                                        SIGMA CARD (multi_orbits f g X))
12685   target_card_and_fixed_points_congruence
12686                                    |- !f g X n. Group g /\ (g act X) f /\ FINITE X /\ 0 < n /\
12687                                                (!e. e IN multi_orbits f g X ==> CARD e = n) ==>
12688                                                 CARD X MOD n = CARD (fixed_points f g X) MOD n
12689*)
12690
12691(* ------------------------------------------------------------------------- *)
12692(* Group action                                                              *)
12693(* ------------------------------------------------------------------------- *)
12694
12695(* An action from group g to a set X is a map f: G x X -> X such that
12696   (0)   [is a map] f (a IN G)(x IN X) in X
12697   (1)  [id action] f (e in G)(x IN X) = x
12698   (2) [composable] f (a IN G)(f (b in G)(x IN X)) =
12699                    f (g.op (a IN G)(b in G))(x IN X)
12700*)
12701Definition action_def:
12702    action f (g:'a group) (X:'b -> bool) =
12703       !x. x IN X ==> (!a. a IN G ==> f a x IN X) /\
12704                      f #e x = x /\
12705                      (!a b. a IN G /\ b IN G ==> f a (f b x) = f (a * b) x)
12706End
12707
12708(* Overload on action *)
12709Overload act = ``\(g:'a group) (X:'b -> bool) f. action f g X``
12710val _ = set_fixity "act" (Infix(NONASSOC, 450)); (* same as relation *)
12711
12712(*
12713> action_def;
12714val it = |- !(f :'a -> 'b -> 'b) (g :'a group) (X :'b -> bool).
12715     (g act X) f <=> !(x :'b). x IN X ==>
12716       (!(a :'a). a IN G ==> f a x IN X) /\ f #e x = x /\
12717       !(a :'a) (b :'a). a IN G /\ b IN G ==> (f a (f b x) = f ((a * b) :'a) x): thm
12718> action_def |> ISPEC ``$o``;
12719val it = |- !g' X. (g' act A) $o <=>
12720            !x. x IN X ==>
12721              (!a. a IN g'.carrier ==> a o x IN X) /\ g'.id o x = x /\
12722               !a b. a IN g'.carrier /\ b IN g'.carrier ==> a o b o x = g'.op a b o x: thm
12723*)
12724
12725(* ------------------------------------------------------------------------- *)
12726(* Action Properties                                                         *)
12727(* ------------------------------------------------------------------------- *)
12728
12729(* Theorem: [Closure]
12730            (g act X) f ==> !a x. a IN G /\ x IN X ==> f a x IN X *)
12731(* Proof: by action_def. *)
12732Theorem action_closure:
12733  !f g X. (g act X) f ==> !a x. a IN G /\ x IN X ==> f a x IN X
12734Proof
12735  rw[action_def]
12736QED
12737
12738(* Theorem: [Compose]
12739            (g act X) f ==> !a b x. a IN G /\ b IN G /\ x IN X ==> f a (f b x) = f (a * b) x *)
12740(* Proof: by action_def. *)
12741Theorem action_compose:
12742  !f g X. (g act X) f ==> !a b x. a IN G /\ b IN G /\ x IN X ==> f a (f b x) = f (a * b) x
12743Proof
12744  rw[action_def]
12745QED
12746
12747(* Theorem: [Identity]
12748            (g act X) f ==> !x. x IN X ==> f #e x = x *)
12749(* Proof: by action_def. *)
12750Theorem action_id:
12751  !f g X. (g act X) f ==> !x. x IN X ==> f #e x = x
12752Proof
12753  rw[action_def]
12754QED
12755(* This is essentially reach_refl *)
12756
12757(* Theorem: Group g /\ (g act X) f ==>
12758            !a x y. a IN G /\ x IN X /\ y IN X /\ f a x = y ==> f ( |/ a) y = x *)
12759(* Proof:
12760   Note |/ a IN G        by group_inv_element
12761     f ( |/ a) y
12762   = f ( |/ a) (f a x)   by y = f a x
12763   = f ( |/ a * a) x     by action_compose
12764   = f #e x              by group_linv
12765   = x                   by action_id
12766*)
12767Theorem action_reverse:
12768  !f g X. Group g /\ (g act X) f ==>
12769          !a x y. a IN G /\ x IN X /\ y IN X /\ f a x = y ==> f ( |/ a) y = x
12770Proof
12771  rw[action_def]
12772QED
12773(* This is essentially reach_sym *)
12774
12775(* Theorem: (g act X) f ==> !a b x y z. a IN G /\ b IN G /\
12776            x IN X /\ y IN X /\ z IN X /\ f a x = y /\ f b y = z ==> f (b * a) x = z *)
12777(* Proof:
12778     f (b * a) x
12779   = f b (f a x)     by action_compose
12780   = f b y           by y = f a x
12781   = z               by z = f b y
12782*)
12783Theorem action_trans:
12784  !f g X. (g act X) f ==> !a b x y z. a IN G /\ b IN G /\
12785          x IN X /\ y IN X /\ z IN X /\ f a x = y /\ f b y = z ==> f (b * a) x = z
12786Proof
12787  rw[action_def]
12788QED
12789(* This is essentially reach_trans *)
12790
12791(* ------------------------------------------------------------------------- *)
12792(* Group action induces an equivalence relation.                             *)
12793(* ------------------------------------------------------------------------- *)
12794
12795(* Define reach to relate two action points a and y IN X *)
12796Definition reach_def[nocompute]:
12797    reach f (g:'a group) (x:'b) (y:'b) = ?a. a IN G /\ f a x = y
12798End
12799(* Note: use zDefine as this is not effective. *)
12800
12801(* Overload reach relation *)
12802Overload "~~"[local] = ``\(x:'b) (y:'b) f (g:'a group). reach f g x y``
12803(* Make reach an infix. *)
12804val _ = set_fixity "~~" (Infix(NONASSOC, 450)); (* same as relation *)
12805
12806(*
12807> reach_def;
12808val it = |- !f g x y. (x ~~ y) f g <=> ?a. a IN G /\ f a x = y
12809*)
12810
12811(* Theorem: [Reach is Reflexive]
12812            Group g /\ (g act X) f /\ x IN X ==> (x ~~ x) f g  *)
12813(* Proof:
12814   Note f #e x = x         by action_id
12815    and #e in G            by group_id_element
12816   Thus (x ~~ x) f g       by reach_def, take x = #e.
12817*)
12818Theorem reach_refl:
12819  !f g X x. Group g /\ (g act X) f /\ x IN X ==> (x ~~ x) f g
12820Proof
12821  metis_tac[reach_def, action_id, group_id_element]
12822QED
12823
12824(* Theorem: [Reach is Symmetric]
12825            Group g /\ (g act X) f /\ x IN X /\ y IN X /\ (x ~~ y) f g ==> (y ~~ x) f g *)
12826(* Proof:
12827   Note ?a. a IN G /\ f a x = y     by reach_def, (x ~~ y) f g
12828    ==> f ( |/ a) y = x             by action_reverse
12829    and |/ a IN G                   by group_inv_element
12830   Thus (y ~~ x) f g                by reach_def
12831*)
12832Theorem reach_sym:
12833  !f g X x y. Group g /\ (g act X) f /\ x IN X /\ y IN X /\ (x ~~ y) f g ==> (y ~~ x) f g
12834Proof
12835  metis_tac[reach_def, action_reverse, group_inv_element]
12836QED
12837
12838(* Theorem: [Reach is Transitive]
12839            Group g /\ (g act X) f /\ x IN X /\ y IN X /\ z IN X /\
12840            (x ~~ y) f g /\ (y ~~ z) f g ==> (x ~~ z) f g *)
12841(* Proof:
12842   Note ?a. a IN G /\ f a x = y       by reach_def, (x ~~ y) f g
12843    and ?b. b IN G /\ f b y = z       by reach_def, (y ~~ z) f g
12844   Thus f (b * a) x = z               by action_trans
12845    and b * a IN G                    by group_op_element
12846    ==> (x ~~ z) f g                  by reach_def
12847*)
12848Theorem reach_trans:
12849  !f g X x y z. Group g /\ (g act X) f /\ x IN X /\ y IN X /\ z IN X /\
12850                (x ~~ y) f g /\ (y ~~ z) f g ==> (x ~~ z) f g
12851Proof
12852  rw[reach_def] >>
12853  metis_tac[action_trans, group_op_element]
12854QED
12855
12856(* Theorem: Reach is an equivalence relation on target set X.
12857            Group g /\ (g act X) f ==> (reach f g) equiv_on X *)
12858(* Proof:
12859   By Reach being Reflexive, Symmetric and Transitive.
12860*)
12861Theorem reach_equiv:
12862  !f g X. Group g /\ (g act X) f ==> (reach f g) equiv_on X
12863Proof
12864  rw_tac std_ss[equiv_on_def] >-
12865  metis_tac[reach_refl] >-
12866  metis_tac[reach_sym] >>
12867  metis_tac[reach_trans]
12868QED
12869
12870(* ------------------------------------------------------------------------- *)
12871(* Orbits as equivalence classes.                                            *)
12872(* ------------------------------------------------------------------------- *)
12873
12874(* Orbit of action for a: those that can be reached by taking a IN G. *)
12875Definition orbit_def:
12876   orbit (f:'a -> 'b -> 'b) (g:'a group) (x:'b) = IMAGE (\a. f a x) G
12877End
12878(* Note: define as IMAGE for evaluation when f and g are concrete. *)
12879(*
12880> orbit_def |> ISPEC ``$o``;
12881val it = |- !g' x. orbit $o g' x = IMAGE (\a. a o x) g'.carrier: thm
12882*)
12883
12884(* Theorem: orbit f g x = {f a x | a IN G} *)
12885(* Proof: by orbit_def, EXTENSION. *)
12886Theorem orbit_alt:
12887  !f g x. orbit f g x = {f a x | a IN G}
12888Proof
12889  simp[orbit_def, EXTENSION]
12890QED
12891
12892(* Theorem: y IN orbit f g x <=> (x ~~ y) f g *)
12893(* Proof:
12894       y IN orbit f g x
12895   <=> ?a. a IN G /\ (y = f a x)   by orbit_def, IN_IMAGE
12896   <=> (x ~~ y) f g                by reach_def
12897*)
12898Theorem orbit_element:
12899  !f g x y. y IN orbit f g x <=> (x ~~ y) f g
12900Proof
12901  simp[orbit_def, reach_def] >>
12902  metis_tac[]
12903QED
12904
12905(* Theorem: a IN G ==> f a x IN (orbit f g x) *)
12906(* Proof: by orbit_def *)
12907Theorem orbit_has_action_element:
12908  !f g x a. a IN G ==> f a x IN (orbit f g x)
12909Proof
12910  simp[orbit_def] >>
12911  metis_tac[]
12912QED
12913
12914(* Theorem: Group g /\ (g act X) f /\ x IN X ==> x IN orbit f g x *)
12915(* Proof:
12916   Let b = orbit f g x.
12917   Note #e IN G            by group_id_element
12918     so #e o x IN b        by orbit_has_action_element
12919    and #e o x = x         by action_id, x IN X
12920   thus x IN b             by above
12921*)
12922Theorem orbit_has_self:
12923  !f g X x. Group g /\ (g act X) f /\ x IN X ==> x IN orbit f g x
12924Proof
12925  metis_tac[orbit_has_action_element, group_id_element, action_id]
12926QED
12927
12928(* Theorem: orbits are subsets of the target set.
12929            (g act X) f /\ x IN X ==> (orbit f g x) SUBSET X *)
12930(* Proof: orbit_def, SUBSET_DEF, action_closure. *)
12931Theorem orbit_subset_target:
12932  !f g X x. (g act X) f /\ x IN X ==> (orbit f g x) SUBSET X
12933Proof
12934  rw[orbit_def, SUBSET_DEF] >>
12935  metis_tac[action_closure]
12936QED
12937
12938(* Theorem: orbits elements are in the target set.
12939            (g act X) f /\ x IN X /\ y IN (orbit f g x) ==> y IN X *)
12940(* Proof: orbit_subset_target, SUBSET_DEF. *)
12941Theorem orbit_element_in_target:
12942  !f g X x y. (g act X) f /\ x IN X /\ y IN (orbit f g x) ==> y IN X
12943Proof
12944  metis_tac[orbit_subset_target, SUBSET_DEF]
12945QED
12946
12947(* Theorem: FINITE G ==> FINITE (orbit f g x) *)
12948(* Proof: by orbit_def, IMAGE_FINITE. *)
12949Theorem orbit_finite:
12950  !f (g:'a group) x. FINITE G ==> FINITE (orbit f g x)
12951Proof
12952  simp[orbit_def]
12953QED
12954
12955(* Theorem: (g act X) f /\ x IN X /\ FINITE X ==> FINITE (orbit f g x) *)
12956(* Proof: by orbit_subset_target, SUBSET_FINITE. *)
12957Theorem orbit_finite_by_target:
12958  !f g X x. (g act X) f /\ x IN X /\ FINITE X ==> FINITE (orbit f g x)
12959Proof
12960  metis_tac[orbit_subset_target, SUBSET_FINITE]
12961QED
12962
12963(* Theorem: (g act X) f /\ x IN X ==> orbit f g x = equiv_class (reach f g) X x *)
12964(* Proof: by orbit_def, reach_def, action_closure. *)
12965Theorem orbit_eq_equiv_class:
12966  !f g X x. (g act X) f /\ x IN X ==> orbit f g x = equiv_class (reach f g) X x
12967Proof
12968  simp[orbit_def, reach_def, EXTENSION] >>
12969  metis_tac[action_closure]
12970QED
12971
12972(* Theorem: Group g /\ (g act X) f /\ x IN X /\ y IN X ==>
12973            (orbit f g x = orbit f g y <=> (x ~~ y) f g) *)
12974(* Proof: by orbit_eq_equiv_class, reach_equiv, equiv_class_eq. *)
12975Theorem orbit_eq_orbit:
12976  !f g X x y. Group g /\ (g act X) f /\ x IN X /\ y IN X ==>
12977              (orbit f g x = orbit f g y <=> (x ~~ y) f g)
12978Proof
12979  metis_tac[orbit_eq_equiv_class, reach_equiv, equiv_class_eq]
12980QED
12981
12982(* ------------------------------------------------------------------------- *)
12983(* Partition by Group action.                                                *)
12984(* ------------------------------------------------------------------------- *)
12985
12986(* The collection of orbits of target points. *)
12987Definition orbits_def:
12988   orbits f (g:'a group) X = IMAGE (orbit f g) X
12989End
12990(* Note: define as IMAGE for evaluation when f and g are concrete. *)
12991(*
12992> orbits_def |> ISPEC ``$o``;
12993val it = |- !g' X. orbits $o g' X = IMAGE (orbit $o g') X: thm
12994*)
12995
12996(* Theorem: orbits f g X = {orbit f g x | x | x IN X} *)
12997(* Proof: by orbits_def, EXTENSION. *)
12998Theorem orbits_alt:
12999  !f g X. orbits f g X = {orbit f g x | x | x IN X}
13000Proof
13001  simp[orbits_def, EXTENSION]
13002QED
13003
13004(* Theorem: e IN orbits f g X <=> ?x. x IN X /\ e = orbit f g x *)
13005(* Proof: by orbits_def, IN_IMAGE. *)
13006Theorem orbits_element:
13007  !f g X e. e IN orbits f g X <=> ?x. x IN X /\ e = orbit f g x
13008Proof
13009  simp[orbits_def] >>
13010  metis_tac[]
13011QED
13012
13013(* Theorem: (g act X) f ==> orbits f g X = partition (reach f g) X *)
13014(* Proof:
13015   By EXTENSION,
13016       e IN orbits f g X
13017   <=> ?x. x IN X /\ e = orbit f g x     by orbits_element
13018   <=> ?x. x IN X /\ e = equiv_class (reach f g) X x
13019                                         by orbit_eq_equiv_class, (g act X) f
13020   <=> e IN partition (reach f g) X)     by partition_element
13021*)
13022Theorem orbits_eq_partition:
13023  !f g X. (g act X) f ==> orbits f g X = partition (reach f g) X
13024Proof
13025  rw[EXTENSION] >>
13026  metis_tac[orbits_element, orbit_eq_equiv_class, partition_element]
13027QED
13028
13029(* Theorem: orbits = target partition is FINITE.
13030            FINITE X ==> FINITE (orbits f g X) *)
13031(* Proof: by orbits_def, IMAGE_FINITE *)
13032Theorem orbits_finite:
13033  !f g X. FINITE X ==> FINITE (orbits f g X)
13034Proof
13035  simp[orbits_def]
13036QED
13037
13038(* Theorem: For e IN (orbits f g X), FINITE X ==> FINITE e
13039            (g act X) f /\ FINITE X ==> EVERY_FINITE (orbits f g X) *)
13040(* Proof: by orbits_eq_partition, FINITE_partition. *)
13041Theorem orbits_element_finite:
13042  !f g X. (g act X) f /\ FINITE X ==> EVERY_FINITE (orbits f g X)
13043Proof
13044  metis_tac[orbits_eq_partition, FINITE_partition]
13045QED
13046(*
13047orbit_finite_by_target;
13048|- !f g X x. (g act X) f /\ x IN X /\ FINITE X ==> FINITE (orbit f g x): thm
13049*)
13050
13051(* Theorem: For e IN (orbits f g X), e <> EMPTY
13052            Group g /\ (g act X) f ==> !e. e IN orbits f g X ==> e <> EMPTY *)
13053(* Proof: by orbits_eq_partition, reach_equiv, EMPTY_NOT_IN_partition. *)
13054Theorem orbits_element_nonempty:
13055  !f g X. Group g /\ (g act X) f ==> !e. e IN orbits f g X ==> e <> EMPTY
13056Proof
13057  simp[orbits_eq_partition, reach_equiv, EMPTY_NOT_IN_partition]
13058QED
13059(*
13060orbit_has_self;
13061|- !f g X x. Group g /\ (g act X) f /\ x IN X ==> x IN orbit f g x: thm
13062*)
13063
13064(* Theorem: orbits elements are subset of target.
13065            (g act X) f /\ e IN orbits f g X ==> e SUBSET X *)
13066(* Proof: by orbits_eq_partition, partition_SUBSET. *)
13067Theorem orbits_element_subset:
13068  !f g X e. (g act X) f /\ e IN orbits f g X ==> e SUBSET X
13069Proof
13070  metis_tac[orbits_eq_partition, partition_SUBSET]
13071QED
13072(*
13073orbit_subset_target;
13074|- !f g X x. (g act X) f /\ x IN X ==> orbit f g x SUBSET X: thm
13075*)
13076
13077(* Theorem: Elements in element of orbits are also in target.
13078            (g act X) f /\ e IN orbits f g X /\ x IN e ==> x IN X *)
13079(* Proof: by orbits_element_subset, SUBSET_DEF *)
13080Theorem orbits_element_element:
13081  !f g X e x. (g act X) f /\ e IN orbits f g X /\ x IN e ==> x IN X
13082Proof
13083  metis_tac[orbits_element_subset, SUBSET_DEF]
13084QED
13085(*
13086orbit_element_in_target;
13087|- !f g X x y. (g act X) f /\ x IN X /\ y IN orbit f g x ==> y IN X: thm
13088*)
13089
13090(* Theorem: x IN X ==> (orbit f g x) IN (orbits f g X) *)
13091(* Proof: by orbits_def, IN_IMAGE. *)
13092Theorem orbit_is_orbits_element:
13093  !f g X x. x IN X ==> (orbit f g x) IN (orbits f g X)
13094Proof
13095  simp[orbits_def]
13096QED
13097
13098(* Theorem: Elements of orbits are orbits of its own element.
13099            Group g /\ (g act X) f /\ e IN orbits f g X /\ x IN e ==> e = orbit f g x *)
13100(* Proof:
13101   By orbits_def, this is to show:
13102   x IN X /\ y IN orbit f g x ==> orbit f g x = orbit f g y
13103
13104   Note y IN X                       by orbit_element_in_target
13105    and (x ~~ y) f g                 by orbit_element
13106    ==> orbit f g x = orbit f g y    by orbit_eq_orbit
13107*)
13108Theorem orbits_element_is_orbit:
13109  !f g X e x. Group g /\ (g act X) f /\ e IN orbits f g X /\
13110              x IN e ==> e = orbit f g x
13111Proof
13112  rw[orbits_def] >>
13113  metis_tac[orbit_element_in_target, orbit_element, orbit_eq_orbit]
13114QED
13115(*
13116orbits_element;
13117|- !f g X e. e IN orbits f g X <=> ?x. x IN X /\ e = orbit f g x: thm
13118*)
13119
13120(* ------------------------------------------------------------------------- *)
13121(* Target size and orbit size.                                               *)
13122(* ------------------------------------------------------------------------- *)
13123
13124(* Theorem: For action f g X, all a in G are reachable, belong to some orbit,
13125            (g act X) f /\ x IN X ==> SURJ (\a. f a x) G (orbit f g x). *)
13126(* Proof:
13127   This should follow from the fact that reach induces a partition, and
13128   the partition elements are orbits (orbit_is_orbits_element).
13129
13130   By action_def, orbit_def, SURJ_DEF, this is to show:
13131   (1) x IN X /\ a IN G ==> ?b. f a x = f b x /\ b IN G
13132       True by taking b = a.
13133   (2) x IN X /\ a IN G ==> ?b. b IN G /\ f b x = f a x
13134       True by taking b = a.
13135*)
13136Theorem action_to_orbit_surj:
13137  !f g X x. (g act X) f /\ x IN X ==> SURJ (\a. f a x) G (orbit f g x)
13138Proof
13139  rw[action_def, orbit_def, SURJ_DEF] >> metis_tac[]
13140QED
13141
13142(* Theorem: If (\a. f a x) is INJ into orbit for action,
13143            then orbit is same size as the group.
13144            (g act X) f /\ FINITE X /\ x IN X /\
13145            INJ (\a. f a x) G (orbit f g x) ==> CARD (orbit f g x) = CARD G *)
13146(* Proof:
13147   Note SURJ (\a. f a x) G (orbit f g x)     by action_to_orbit_surj
13148   With INJ (\a. f a x) G (orbit f g x)      by given
13149    ==> BIJ (\a. f a x) G (orbit f g x)      by BIJ_DEF
13150    Now (orbit f g x) SUBSET X               by orbit_subset_target
13151     so FINITE (orbit f g x)                 by SUBSET_FINITE, FINITE X
13152    ==> FINITE G                             by FINITE_INJ
13153   Thus CARD (orbit f g x) = CARD G          by FINITE_BIJ_CARD_EQ
13154*)
13155Theorem orbit_finite_inj_card_eq:
13156  !f g X x. (g act X) f /\ x IN X /\ FINITE X /\
13157            INJ (\a. f a x) G (orbit f g x) ==> CARD (orbit f g x) = CARD G
13158Proof
13159  metis_tac[action_to_orbit_surj, BIJ_DEF,
13160            orbit_subset_target, SUBSET_FINITE, FINITE_INJ, FINITE_BIJ_CARD_EQ]
13161QED
13162
13163(* Theorem: For FINITE X, CARD X = SUM of CARD partitions in (orbits f g X).
13164            Group g /\ (g act X) f /\ FINITE X ==>
13165            CARD X = SIGMA CARD (orbits f g X) *)
13166(* Proof:
13167   With orbits_eq_partition, reach_equiv, apply
13168   partition_CARD
13169   |- !R s. R equiv_on s /\ FINITE s ==> CARD s = SIGMA CARD (partition R s)
13170*)
13171Theorem target_card_by_partition:
13172  !f g X. Group g /\ (g act X) f /\ FINITE X ==>
13173          CARD X = SIGMA CARD (orbits f g X)
13174Proof
13175  metis_tac[orbits_eq_partition, reach_equiv, partition_CARD]
13176QED
13177
13178(* Theorem: If for all x IN X, CARD (orbit f g x) = n,
13179            then (orbits f g X) has pieces with equal size of n.
13180            Group g /\ (g act X) f /\ FINITE X /\
13181            (!x. x IN X ==> CARD (orbit f g x) = n) ==>
13182            (!e. e IN orbits f g X ==> CARD e = n) *)
13183(* Proof:
13184   Note !x. x IN e ==> (e = orbit f g x)     by orbits_element_is_orbit
13185   Thus ?y. y IN e                           by orbits_element_nonempty, MEMBER_NOT_EMPTY
13186    But y IN X                               by orbits_element_element
13187     so CARD e = n                           by given implication.
13188*)
13189Theorem orbits_equal_size_partition_equal_size:
13190  !f g X n. Group g /\ (g act X) f /\ FINITE X /\
13191            (!x. x IN X ==> CARD (orbit f g x) = n) ==>
13192            (!e. e IN orbits f g X ==> CARD e = n)
13193Proof
13194  metis_tac[orbits_element_is_orbit, orbits_element_nonempty,
13195            MEMBER_NOT_EMPTY, orbits_element_element]
13196QED
13197
13198(* Theorem: If for all x IN X, CARD (orbit f g x) = n, then n divides CARD X.
13199            Group g /\ (g act X) f /\ FINITE X /\
13200            (!x. x IN X ==> CARD (orbit f g x) = n) ==> n divides (CARD X) *)
13201(* Proof:
13202   Let R = reach f g.
13203   Note !e. e IN orbits f g X ==> CARD e = n by orbits_equal_size_partition_equal_size
13204    and R equiv_on X                  by reach_equiv
13205    and orbits f g X = partition R X  by orbits_eq_partition
13206   Thus n divides CARD X
13207      = n * CARD (partition R X)      by equal_partition_card
13208      = CARD (partition R X) * n      by MULT_SYM
13209     so n divides (CARD X)            by divides_def
13210   The last part is simplified by:
13211
13212equal_partition_factor;
13213|- !R s n. FINITE s /\ R equiv_on s /\ (!e. e IN partition R s ==> CARD e = n) ==>
13214          n divides CARD s
13215*)
13216Theorem orbits_equal_size_property:
13217  !f g X n. Group g /\ (g act X) f /\ FINITE X /\
13218            (!x. x IN X ==> (CARD (orbit f g x) = n)) ==> n divides (CARD X)
13219Proof
13220  rpt strip_tac >>
13221  imp_res_tac orbits_equal_size_partition_equal_size >>
13222  metis_tac[orbits_eq_partition, reach_equiv, equal_partition_factor]
13223QED
13224
13225(* Theorem: If for all x IN X, n divides CARD (orbit f g x),
13226            then n divides size of elements in orbits f g X.
13227            Group g /\ (g act X) f /\ FINITE X /\
13228            (!x. x IN X ==> n divides (CARD (orbit f g x))) ==>
13229            (!e. e IN orbits f g X ==> n divides (CARD e)) *)
13230(* Proof:
13231   Note !x. x IN e ==> (e = orbit f g x) by orbits_element_is_orbit
13232   Thus ?y. y IN e                       by orbits_element_nonempty, MEMBER_NOT_EMPTY
13233    But y IN X                           by orbits_element_element
13234     so n divides (CARD e)               by given implication.
13235*)
13236Theorem orbits_size_factor_partition_factor:
13237  !f g X n. Group g /\ (g act X) f /\ FINITE X /\
13238            (!x. x IN X ==> n divides (CARD (orbit f g x))) ==>
13239            (!e. e IN orbits f g X ==> n divides (CARD e))
13240Proof
13241  metis_tac[orbits_element_is_orbit, orbits_element_nonempty,
13242            MEMBER_NOT_EMPTY, orbits_element_element]
13243QED
13244
13245(* Theorem: If for all x IN X, n divides (orbit f g x), then n divides CARD X.
13246            Group g /\ (g act X) f /\ FINITE X /\
13247            (!x. x IN X ==> n divides (CARD (orbit f g x))) ==> n divides (CARD X) *)
13248(* Proof:
13249   Note !e. e IN orbits f g X ==> n divides (CARD e)
13250                                   by orbits_size_factor_partition_factor
13251    and reach f g equiv_on X       by reach_equiv
13252   Thus n divides (CARD X)         by orbits_eq_partition, factor_partition_card
13253*)
13254Theorem orbits_size_factor_property:
13255  !f g X n. Group g /\ (g act X) f /\ FINITE X /\
13256            (!x. x IN X ==> n divides (CARD (orbit f g x))) ==> n divides (CARD X)
13257Proof
13258  metis_tac[orbits_size_factor_partition_factor,
13259            orbits_eq_partition, reach_equiv, factor_partition_card]
13260QED
13261
13262(* ------------------------------------------------------------------------- *)
13263(* Stabilizer as invariant.                                                  *)
13264(* ------------------------------------------------------------------------- *)
13265
13266(* Stabilizer of action: for x IN X, the group elements that fixes x. *)
13267Definition stabilizer_def[nocompute]:
13268    stabilizer f (g:'a group) (x:'b) = {a | a IN G /\ f a x = x }
13269End
13270(* Note: use zDefine as this is not effective for computation. *)
13271(*
13272> stabilizer_def |> ISPEC ``$o``;
13273val it = |- !g' x. stabilizer $o g' x = {a | a IN G'.carrier /\ a o x = x}: thm
13274*)
13275
13276(* Theorem: a IN stabilizer f g x ==> a IN G /\ f a x = x *)
13277(* Proof: by stabilizer_def *)
13278Theorem stabilizer_element:
13279  !f g x a. a IN stabilizer f g x <=> a IN G /\ f a x = x
13280Proof
13281  simp[stabilizer_def]
13282QED
13283
13284(* Theorem: The (stabilizer f g x) is a subset of G. *)
13285(* Proof: by stabilizer_element, SUBSET_DEF *)
13286Theorem stabilizer_subset:
13287  !f g x. (stabilizer f g x) SUBSET G
13288Proof
13289  simp[stabilizer_element, SUBSET_DEF]
13290QED
13291
13292(* Theorem: (stabilizer f g x) has #e.
13293            Group g /\ (g act X) f /\ x IN X ==> #e IN stabilizer f g x *)
13294(* Proof:
13295   Note #e IN G                   by group_id_element
13296    and f #e x = x                by action_id
13297     so #e IN stabilizer f g x    by stabilizer_element
13298*)
13299Theorem stabilizer_has_id:
13300  !f g X x. Group g /\ (g act X) f /\ x IN X ==> #e IN stabilizer f g x
13301Proof
13302  metis_tac[stabilizer_element, action_id, group_id_element]
13303QED
13304(* This means (stabilizer f g x) is non-empty *)
13305
13306(* Theorem: (stabilizer f g x) is nonempty.
13307            Group g /\ (g act X) f /\ x IN X ==> stabilizer f g x <> EMPTY *)
13308(* Proof: by stabilizer_has_id, MEMBER_NOT_EMPTY. *)
13309Theorem stabilizer_nonempty:
13310  !f g X x. Group g /\ (g act X) f /\ x IN X ==> stabilizer f g x <> EMPTY
13311Proof
13312  metis_tac[stabilizer_has_id, MEMBER_NOT_EMPTY]
13313QED
13314
13315(* Theorem: Group g /\ (g act X) f /\ x IN X ==>
13316            stabilizer f g x = IMAGE (\a. if f a x = x then a else #e) G *)
13317(* Proof:
13318   By stabilizer_def, EXTENSION, this is to show:
13319   (1) a IN G /\ f a x = x ==> ?b. a = (if f b x = x then b else #e) /\ b IN G
13320       This is true by taking b = a.
13321   (2) a IN G ==> (if f a x = x then a else #e) IN G, true   by group_id_element
13322   (3) f (if f a x = x then a else #e) x = x, true           by action_id
13323*)
13324Theorem stabilizer_as_image:
13325  !f g X x. Group g /\ (g act X) f /\ x IN X ==>
13326            stabilizer f g x = IMAGE (\a. if f a x = x then a else #e) G
13327Proof
13328  (rw[stabilizer_def, EXTENSION] >> metis_tac[group_id_element, action_id])
13329QED
13330
13331(* ------------------------------------------------------------------------- *)
13332(* Application:                                                              *)
13333(* Stabilizer subgroup.                                                      *)
13334(* ------------------------------------------------------------------------- *)
13335
13336(* Define the stabilizer group, the restriction of group G to stabilizer. *)
13337Definition StabilizerGroup_def:
13338    StabilizerGroup f (g:'a group) (x:'b) =
13339      <| carrier := stabilizer f g x;
13340              op := g.op;
13341              id := #e
13342       |>
13343End
13344
13345(* Theorem: StabilizerGroup properties. *)
13346(* Proof: by StabilizerGroup_def. *)
13347Theorem stabilizer_group_property:
13348  !f g x. (StabilizerGroup f g x).carrier = stabilizer f g x /\
13349          (StabilizerGroup f g x).op = g.op /\
13350          (StabilizerGroup f g x).id = #e
13351Proof
13352  simp[StabilizerGroup_def]
13353QED
13354
13355(* Theorem: StabilizerGroup carrier. *)
13356(* Proof: by StabilizerGroup_def. *)
13357Theorem stabilizer_group_carrier:
13358  !f g x. (StabilizerGroup f g x).carrier = stabilizer f g x
13359Proof
13360  simp[StabilizerGroup_def]
13361QED
13362
13363(* Theorem: StabilizerGroup identity. *)
13364(* Proof: by StabilizerGroup_def. *)
13365Theorem stabilizer_group_id:
13366  !f g x. (StabilizerGroup f g x).id = g.id
13367Proof
13368  simp[StabilizerGroup_def]
13369QED
13370
13371(* Theorem: If g is a Group, f g X is an action, StabilizerGroup f g x is a Group.
13372            Group g /\ (g act X) f /\ x IN X ==> Group (StabilizerGroup f g x) *)
13373(* Proof:
13374   By group_def_alt, StabilizerGroup_def, stabilizer_def, action_def, this is to show:
13375   (1) a IN G /\ b IN G /\ f a x = x /\ f b x = x ==> f (a * b) x = x
13376         f (a * b) x
13377       = f a (f b x)         by action_compose
13378       = f a x               by f b x = x
13379       = a                   by f a x = x
13380   (2) a IN G /\ f a x = x ==> ?b. b IN G /\ f b x = x /\ b * a = #e
13381       Let b = |/ a.
13382       Then b * a = #e       by group_linv
13383         f ( |/x) a
13384       = f ( |/x) (f a x)    by f a x = x
13385       = f ( |/x * x) a      by action_def
13386       = f (#e) a            by group_linv
13387       = a                   by action_def
13388*)
13389Theorem stabilizer_group_group:
13390  !f g X x. Group g /\ (g act X) f /\ x IN X ==> Group (StabilizerGroup f g x)
13391Proof
13392  rw_tac std_ss[group_def_alt, StabilizerGroup_def, stabilizer_def,
13393                action_def, GSPECIFICATION] >> prove_tac[]
13394QED
13395
13396(* Theorem: If g is Group, f g X is an action, then StabilizerGroup f g x is a subgroup of g.
13397            Group g /\ (g act X) f /\ x IN X ==> (StabilizerGroup f g x) <= g *)
13398(* Proof:
13399   By Subgroup_def, stabilizer_group_property, this is to show:
13400   (1) x IN X ==> Group (StabilizerGroup f g x), true by stabilizer_group_group
13401   (2) stabilizer f g x SUBSET G, true                by stabilizer_subset
13402*)
13403Theorem stabilizer_group_subgroup:
13404  !f g X x. Group g /\ (g act X) f /\ x IN X ==> (StabilizerGroup f g x) <= g
13405Proof
13406  metis_tac[Subgroup_def, stabilizer_group_property, stabilizer_group_group, stabilizer_subset]
13407QED
13408
13409(* Theorem: If g is FINITE Group, StabilizerGroup f g x is a FINITE Group.
13410            FiniteGroup g /\ (g act X) f /\ x IN X ==> FiniteGroup (StabilizerGroup f g x) *)
13411(* Proof:
13412   By FiniteGroup_def, stabilizer_group_property, this is to show:
13413   (1) x IN X ==> Group (StabilizerGroup f g x), true          by stabilizer_group_group
13414   (2) FINITE G /\ x IN X ==> FINITE (stabilizer f g x), true  by stabilizer_SUBSET, SUBSET_FINITE
13415*)
13416Theorem stabilizer_group_finite_group:
13417  !f g X x. FiniteGroup g /\ (g act X) f /\ x IN X ==>
13418            FiniteGroup (StabilizerGroup f g x)
13419Proof
13420  rw_tac std_ss[FiniteGroup_def, stabilizer_group_property] >-
13421  metis_tac[stabilizer_group_group] >>
13422  metis_tac[stabilizer_subset, SUBSET_FINITE]
13423QED
13424
13425(* Theorem: If g is FINITE Group, CARD (stabilizer f g x) divides CARD G.
13426            FiniteGroup g /\ (g act X) f /\ x IN X ==>
13427            CARD (stabilizer f g x) divides (CARD G) *)
13428(* Proof:
13429   By Lagrange's Theorem, and (StabilizerGroup f g x) is a subgroup of g.
13430
13431   Note (StabilizerGroup f g x) <= g                         by stabilizer_group_subgroup
13432    and (StabilizerGroup f g x).carrier = stabilizer f g x   by stabilizer_group_property
13433    but (stabilizer f g x) SUBSET G                          by stabilizer_subset
13434  Thus CARD (stabilizer f g x) divides (CARD G)              by Lagrange_thm
13435*)
13436Theorem stabilizer_group_card_divides:
13437  !f (g:'a group) X x. FiniteGroup g /\ (g act X) f /\ x IN X ==>
13438                       CARD (stabilizer f g x) divides (CARD G)
13439Proof
13440  rpt (stripDup[FiniteGroup_def]) >>
13441  `(StabilizerGroup f g x) <= g` by metis_tac[stabilizer_group_subgroup] >>
13442  `(StabilizerGroup f g x).carrier = stabilizer f g x` by rw[stabilizer_group_property] >>
13443  metis_tac[stabilizer_subset, Lagrange_thm]
13444QED
13445
13446(* ------------------------------------------------------------------------- *)
13447(* Orbit-Stabilizer Theorem.                                                 *)
13448(* ------------------------------------------------------------------------- *)
13449
13450(* Theorem: The map from orbit to coset of stabilizer is well-defined.
13451            Group g /\ (g act X) f /\ x IN X ==>
13452            !a b. a IN G /\ b IN G /\ f a x = f b x ==>
13453                  a * (stabilizer f g x) = b * (stabilizer f g x) *)
13454(* Proof:
13455   Note StabilizerGroup f g x <= g         by stabilizer_group_subgroup
13456    and (StabilizerGroup f g x).carrier
13457      = stabilizer f g x                   by stabilizer_group_property
13458   By subgroup_coset_eq, this is to show:
13459      ( |/b * a) IN (stabilizer f g x)
13460
13461   Note ( |/b * a) IN G        by group_inv_element, group_op_element
13462        f ( |/b * a) x
13463      = f ( |/b) (f a x)       by action_compose
13464      = f ( |/b) (f b x)       by given
13465      = f ( |/b * b) x         by action_compose
13466      = f #e x                 by group_linv
13467      = x                      by action_id
13468   Hence  ( |/b * a) IN (stabilizer f g x)
13469                               by stabilizer_element
13470*)
13471Theorem orbit_stabilizer_map_good:
13472  !f g X x. Group g /\ (g act X) f /\ x IN X ==>
13473            !a b. a IN G /\ b IN G /\ f a x = f b x ==>
13474                  a * (stabilizer f g x) = b * (stabilizer f g x)
13475Proof
13476  rpt strip_tac >>
13477  `StabilizerGroup f g x <= g` by metis_tac[stabilizer_group_subgroup] >>
13478  `(StabilizerGroup f g x).carrier = stabilizer f g x` by rw[stabilizer_group_property] >>
13479  fs[action_def] >>
13480  `( |/b * a) IN (stabilizer f g x)` suffices_by metis_tac[subgroup_coset_eq] >>
13481  `f ( |/b * a) x = f ( |/b) (f a x)` by rw[action_compose] >>
13482  `_ = f ( |/b) (f b x)` by asm_rewrite_tac[] >>
13483  `_ = f ( |/b * b) x` by rw[] >>
13484  `_ = f #e x` by rw[] >>
13485  `_ = x` by rw[] >>
13486  rw[stabilizer_element]
13487QED
13488
13489(* Theorem: The map from orbit to coset of stabilizer is injective.
13490            Group g /\ (g act X) f /\ x IN X ==>
13491            !a b. a IN G /\ b IN G /\
13492                  a * (stabilizer f g x) = b * (stabilizer f g x) ==> f a x = f b x *)
13493(* Proof:
13494   Note a * (stabilizer f g x) = b * (stabilizer f g x)
13495    ==> ( |/b * a) IN (stabilizer f g x)   by subgroup_coset_eq
13496    ==> f ( |/b * a) x = x                 by stabilizer_element
13497       f a x
13498     = f (#e * x) a            by group_lid
13499     = f ((b * |/ b) * a) x    by group_rinv
13500     = f (b * ( |/b * a)) x    by group_assoc
13501     = f b (f ( |/b * a) x)    by action_compose
13502     = f b x                   by above, x = f ( |/b * a) x
13503*)
13504Theorem orbit_stabilizer_map_inj:
13505  !f g X x. Group g /\ (g act X) f /\ x IN X ==>
13506            !a b. a IN G /\ b IN G /\
13507                  a * (stabilizer f g x) = b * (stabilizer f g x) ==>
13508                  f a x = f b x
13509Proof
13510  rpt strip_tac >>
13511  `StabilizerGroup f g x <= g` by metis_tac[stabilizer_group_subgroup] >>
13512  `(StabilizerGroup f g x).carrier = stabilizer f g x` by rw[stabilizer_group_property] >>
13513  `( |/b * a) IN (stabilizer f g x)` by metis_tac[subgroup_coset_eq] >>
13514  `f ( |/b * a) x = x` by fs[stabilizer_element] >>
13515  `|/b * a IN G` by rw[] >>
13516  `f a x = f (#e * a) x` by rw[] >>
13517  `_ = f ((b * |/ b) * a) x` by rw_tac std_ss[group_rinv] >>
13518  `_ = f (b * ( |/ b * a)) x` by rw[group_assoc] >>
13519  `_ = f b (f ( |/ b * a) x)` by metis_tac[action_compose] >>
13520  metis_tac[]
13521QED
13522
13523(* Theorem: For action f g X /\ x IN X,
13524            if x, y IN G, f a x = f b x <=> 1/a * b IN (stabilizer f g x).
13525            Group g /\ (g act X) f /\ x IN X ==>
13526            !a b. a IN G /\ b IN G ==>
13527                 (f a x = f b x <=> ( |/ a * b) IN (stabilizer f g x))  *)
13528(* Proof:
13529   If part: f a x = f b x ==> ( |/ a * b) IN (stabilizer f g x)
13530      Let y = f b x, so f a x = y.
13531      then y IN X                   by action_closure
13532       and f ( |/ a) y = x          by action_reverse [1]
13533      Note |/ a IN G                by group_inv_element
13534       and |/ a * b IN G            by group_op_element
13535           f ( |/ a * b) x
13536         = f ( |/ a) (f b x)        by action_compose
13537         = x                        by [1] above
13538      Thus ( |/ a * b) IN (stabilizer f g x)
13539                                    by stabilizer_element
13540   Only-if part: ( |/ a * b) IN (stabilizer f g x) ==> f a x = f b x
13541      Note ( |/ a * b) IN G /\
13542           f ( |/ a * b) x = x      by stabilizer_element
13543           f a x
13544         = f a (f ( |/a * b) x)     by above
13545         = f (a * ( |/ a * b)) x    by action_compose
13546         = f ((a * |/ a) * b) x     by group_assoc, group_inv_element
13547         = f (#e * b) x             by group_rinv
13548         = f b x                    by group_lid
13549*)
13550Theorem action_match_condition:
13551  !f g X x. Group g /\ (g act X) f /\ x IN X ==>
13552            !a b. a IN G /\ b IN G ==>
13553                  (f a x = f b x <=> ( |/ a * b) IN (stabilizer f g x))
13554Proof
13555  rw[EQ_IMP_THM] >| [
13556    `|/ a IN G /\ |/ a * b IN G` by rw[] >>
13557    `f ( |/ a * b) x = f ( |/ a) (f b x)` by metis_tac[action_compose] >>
13558    `_ = x` by metis_tac[action_closure, action_reverse] >>
13559    rw[stabilizer_element],
13560    `( |/ a * b) IN G /\ f ( |/ a * b) x = x` by metis_tac[stabilizer_element] >>
13561    `f a x = f a (f ( |/a * b) x)` by rw[] >>
13562    `_ = f (a * ( |/ a * b)) x` by metis_tac[action_compose] >>
13563    `_ = f ((a * |/ a) * b) x` by rw[group_assoc] >>
13564    rw[]
13565  ]
13566QED
13567
13568(* Alternative form of the same theorem. *)
13569Theorem action_match_condition_alt:
13570  !f g X x. Group g /\ (g act X) f /\ x IN X ==>
13571            !a b::G. f a x = f b x <=> ( |/ a * b) IN (stabilizer f g x)
13572Proof
13573  metis_tac[action_match_condition]
13574QED
13575
13576(* Theorem: stabilizers of points in same orbit:
13577            a * (stabilizer f g x) * 1/a = stabilizer f g (f a x).
13578            Group g /\ (g act X) f /\ x IN X /\ a IN G ==>
13579            conjugate g a (stabilizer f g x) = stabilizer f g (f a x) *)
13580(* Proof:
13581   In Section 1.12 of Volume I of [Jacobson] N.Jacobson, Basic Algebra, 1980.
13582   [Artin] E. Artin, Galois Theory 1942.
13583
13584   By conjugate_def, stabilizer_def, this is to show:
13585   (1) z IN G /\ f z x = x ==> a * z * |/ a IN G
13586       Note |/ a   IN G                  by group_inv_element
13587       Thus a * z * |/ a IN G            by group_op_element
13588   (2) z IN G /\ f z x = x ==> f (a * z * |/ a) (f a x) = f a x
13589       Note a * z * |/ a IN G            by group_inv_element
13590         f (a * z * |/ a) (f a x)
13591       = f (a * z * |/ a * a) x          by action_compose
13592       = f ((a * z) * ( |/ a * a)) x     by group_assoc
13593       = f ((a * z) * #e) x              by group_linv
13594       = f (a * z) x                     by group_rid
13595       = f a (f z x)                     by action_compose
13596       = f a x                           by x = f z x
13597   (3) b IN G /\ f b (f a x) = f a x ==> ?z. b = a * z * |/ a /\ z IN G /\ f z x = x
13598       Let z = |/ a * b * a.
13599       Note |/ a IN G                    by group_inv_element
13600         so z IN G                       by group_op_element
13601         a * z * |/ a
13602       = a * ( |/ a * b * a) * |/ a      by notation
13603       = (a * ( |/ a)) * b * a * |/ a    by group_assoc
13604       = (a * ( |/ a)) * (b * a * |/ a)  by group_assoc
13605       = (a * |/ a) * b * (a * |/ a)     by group_assoc
13606       = #e * b * #e                     by group_rinv
13607       = b                               by group_lid, group_rid
13608         f z x
13609       = f ( |/ a * b * a) x             by notation
13610       = f ( |/ a * (b * a)) x           by group_assoc
13611       = f ( |/ a) (f (b * a) x)         by action_compose
13612       = f ( |/ a) (f b (f a x))         by action_compose
13613       = f ( |/ a) (f a x)               by given f b (f a x) = f a x
13614       = f ( |/ a * a) x                 by action_compose
13615       = f #e x                          by group_linv
13616       = x                               by action_id
13617*)
13618Theorem stabilizer_conjugate:
13619  !f g X x a. Group g /\ (g act X) f /\ x IN X /\ a IN G ==>
13620              conjugate g a (stabilizer f g x) = stabilizer f g (f a x)
13621Proof
13622  rw[conjugate_def, stabilizer_def, EXTENSION, EQ_IMP_THM] >-
13623  rw[] >-
13624 (`a * z * |/ a IN G` by rw[] >>
13625  `f (a * z * |/ a) (f a x) = f (a * z * |/ a * a) x` by metis_tac[action_compose] >>
13626  `_ = f ((a * z) * ( |/ a * a)) x` by rw[group_assoc] >>
13627  `_ = f (a * z) x` by rw[] >>
13628  metis_tac[action_compose]) >>
13629  qexists_tac `|/a * x' * a` >>
13630  rw[] >| [
13631    `a * ( |/ a * x' * a) * |/ a = (a * |/ a) * x' * (a * |/ a)` by rw[group_assoc] >>
13632    rw[],
13633    `|/ a IN G /\ x' * a IN G` by rw[] >>
13634    `f ( |/ a * x' * a) x = f ( |/ a * (x' * a)) x` by rw[group_assoc] >>
13635    metis_tac[action_compose, group_linv, action_id]
13636  ]
13637QED
13638
13639(* This is a major result. *)
13640
13641(* Extract the existence element of reach *)
13642(* - reach_def;
13643> val it = |- !f g x y. (x ~~ y) f g <=> ?a. a IN G /\ f a x = y:  thm
13644*)
13645
13646(* Existence of act_by: the x in reach f g X b, such that a IN G /\ f a x = b. *)
13647Theorem lemma[local]:
13648    !f (g:'a group) (x:'b) (y:'b). ?a. reach f g x y ==> a IN G /\ f a x = y
13649Proof
13650  metis_tac[reach_def]
13651QED
13652(*
13653- SKOLEM_THM;
13654> val it = |- !P. (!x. ?y. P x y) <=> ?f. !x. P x (f x) : thm
13655*)
13656val act_by_def = new_specification(
13657    "act_by_def",
13658    ["act_by"],
13659    lemma |> SIMP_RULE bool_ss [SKOLEM_THM]
13660          |> CONV_RULE (RENAME_VARS_CONV ["t"] (* to allow rename of f' back to f *)
13661             THENC BINDER_CONV (RENAME_VARS_CONV ["f", "g", "x", "y"])));
13662(*
13663val act_by_def = |- !f g x y.
13664          (x ~~ y) f g ==> act_by f g x y IN G /\ f (act_by f g x y) x = y: thm
13665*)
13666
13667(* Theorem: The reachable set from a to b is the coset act_by b of (stabilizer a).
13668            Group g /\ (g act X) f /\ x IN X /\ y IN orbit f g x ==>
13669            (act_by f g x y) * (stabilizer f g x) = {a | a IN G /\ f a x = y} *)
13670(* Proof:
13671   By orbit_element, coset_def, this is to show:
13672   (1) z IN stabilizer f g x ==> act_by f g x y * z IN G
13673       Note act_by f g x y IN G          by act_by_def
13674        and z IN G                       by stabilizer_element
13675         so act_by f g x y * z IN G      by group_op_element
13676   (2) z IN stabilizer f g x ==> f (act_by f g x y * z) x = y
13677       Note act_by f g x y IN G          by act_by_def
13678        and z IN G                       by stabilizer_element
13679         f (act_by f g x y * z) x
13680       = f (act_by f g x y) (f z x)      by action_compose
13681       = f (act_by f g x y) x            by stabilizer_element
13682       = y                               by act_by_def
13683   (3) (x ~~ f a x) f g /\ a IN G ==> ?z. a = act_by f g x (f a x) * z /\ z IN stabilizer f g x
13684       Let b = act_by f g x (f a x)
13685       Then b IN G /\ (f b x = f a x)       by act_by_def
13686        and |/ b * a IN (stabilizer f g x)  by action_match_condition
13687        Let z = |/ b * a, to show: a = b * z.
13688           b * z
13689         = b * ( |/ b * a)        by notation
13690         = (b * |/ b) * a         by group_assoc
13691         = #e * a                 by group_rinv
13692         = a                      by group_lid
13693*)
13694Theorem action_reachable_coset:
13695  !f g X x y. Group g /\ (g act X) f /\ x IN X /\ y IN orbit f g x ==>
13696              (act_by f g x y) * (stabilizer f g x) = {a | a IN G /\ f a x = y}
13697Proof
13698  rw[orbit_element, coset_def, EXTENSION, EQ_IMP_THM] >-
13699  metis_tac[act_by_def, stabilizer_element, group_op_element] >-
13700  metis_tac[act_by_def, action_compose, stabilizer_element] >>
13701  qabbrev_tac `b = act_by f g x (f x' x)` >>
13702  `b IN G /\ (f b x = f x' x)` by rw[act_by_def, Abbr`b`] >>
13703  `|/ b * x' IN (stabilizer f g x)` by metis_tac[action_match_condition] >>
13704  qexists_tac `|/ b * x'` >>
13705  `b * ( |/ b * x') = (b * |/ b) * x'` by rw[group_assoc] >>
13706  `_ = x'` by rw[] >>
13707  rw[]
13708QED
13709
13710(* Another formulation of the same result. *)
13711
13712(* Theorem: The reachable set from x to y is the coset act_by y of (stabilizer x).
13713            Group g /\ (g act X) f /\ x IN X /\ y IN orbit f g x ==>
13714            !a. a IN G /\ f a x = y ==>
13715                a * (stabilizer f g x) = {b | b IN G /\ f b x = y} *)
13716(* Proof:
13717   By orbit_element, coset_def, this is to show:
13718   (1) z IN stabilizer f g x ==> a * z IN G
13719       Note z IN G            by stabilizer_element
13720         so a * z IN G        by group_op_element
13721   (2) z IN stabilizer f g x ==> f (a * z) x = f a x
13722       Note f z x = x         by stabilizer_element
13723         f (a * z) x
13724       = f a (f z x)          by action_compose
13725       = f a x                by above
13726   (3) b IN G /\ f a x = f b a ==> ?z. b = a * z /\ z IN stabilizer f g x
13727       Let z = |/ a * b.
13728         a * z
13729       = a * ( |/ a * b)      by notation
13730       = (a * |/ a) * b       by group_assoc
13731       = #e * b               by group_rinv
13732       = b                    by group_lid
13733       Hence z IN stabilizer f g x,
13734                              by action_match_condition, f a x = f b x
13735*)
13736Theorem action_reachable_coset_alt:
13737  !f g X x y. Group g /\ (g act X) f /\ x IN X /\ y IN orbit f g x ==>
13738              !a. a IN G /\ f a x = y ==>
13739                  a * (stabilizer f g x) = {b | b IN G /\ f b x = y}
13740Proof
13741  rw[orbit_element, coset_def, EXTENSION, EQ_IMP_THM] >-
13742  metis_tac[stabilizer_element, group_op_element] >-
13743  metis_tac[stabilizer_element, action_compose] >>
13744  qexists_tac `|/ a * x'` >>
13745  rpt strip_tac >-
13746  rw[GSYM group_assoc] >>
13747  metis_tac[action_match_condition]
13748QED
13749
13750(* Theorem: Elements of (orbit a) and cosets of (stabilizer a) are one-to-one.
13751            Group g /\ (g act X) f /\ x IN X ==>
13752            BIJ (\y. (act_by f g x y) * (stabilizer f g x))
13753                (orbit f g x)
13754                {a * (stabilizer f g x) | a IN G} *)
13755(* Proof:
13756   By BIJ_DEF, INJ_DEF, SURJ_DEF, this is to show:
13757   (1) y IN orbit f g x ==> ?a. (act_by f g x y * stabilizer f g x = a * stabilizer f g x) /\ a IN G
13758       Take a = act_by f g x y.
13759       Note (x ~~ y) f g         by orbit_element, y IN orbit f g x
13760       Thus a IN G               by act_by_def
13761   (2) y IN orbit f g x /\ z IN orbit f g x /\
13762       act_by f g x y * stabilizer f g x = act_by f g x z * stabilizer f g x ==> y = z
13763       Note (x ~~ y) f g /\ (x ~~ z) f g                 by orbit_element
13764        and act_by f g x y IN G /\ act_by f g x z IN G   by act_by_def
13765       Thus y
13766          = f (act_by f g x y) x        by act_by_def
13767          = f (act_by f g x z) x        by orbit_stabilizer_map_inj
13768          = z                           by act_by_def
13769   (3) same as (1)
13770   (4) a IN G ==> ?y. y IN orbit f g x /\ (act_by f g x y * stabilizer f g x = a * stabilizer f g x)
13771       Take y = f a x.
13772       Then (x ~~ y) f g                by reach_def
13773        and y IN X                      by action_closure
13774         so y IN orbit f g x            by orbit_element
13775       Let b = act_by f g x y.
13776       Then f a x = y = f b x           by act_by_def
13777        ==> a * stabilizer f g x = b * stabilizer f g x
13778                                        by orbit_stabilizer_map_good
13779*)
13780Theorem orbit_stabilizer_cosets_bij:
13781  !f g X x. Group g /\ (g act X) f /\ x IN X ==>
13782            BIJ (\y. (act_by f g x y) * (stabilizer f g x))
13783                (orbit f g x)
13784                {a * (stabilizer f g x) | a IN G}
13785Proof
13786  rw[BIJ_DEF, INJ_DEF, SURJ_DEF, EQ_IMP_THM] >-
13787  metis_tac[orbit_element, act_by_def] >-
13788  metis_tac[orbit_stabilizer_map_inj, orbit_element, act_by_def] >-
13789  metis_tac[orbit_element, act_by_def] >>
13790  qexists_tac `f a x` >>
13791  rpt strip_tac >-
13792  metis_tac[orbit_element, reach_def, action_closure] >>
13793  `(x ~~ (f a x)) f g` by metis_tac[reach_def] >>
13794  metis_tac[orbit_stabilizer_map_good, act_by_def]
13795QED
13796
13797(* The above version is not using CosetPartition. *)
13798
13799(* Theorem: Elements of (orbit x) and cosets of (stabilizer x) are one-to-one.
13800            Group g /\ (g act X) f /\ x IN X ==>
13801            BIJ (\y. (act_by f g x y) * (stabilizer f g x))
13802                (orbit f g x)
13803                (CosetPartition g (StabilizerGroup f g x) *)
13804(* Proof:
13805   By CosetPartition_def, partition_def, inCoset_def,
13806      StabilizerGroup_def, BIJ_DEF, INJ_DEF, SURJ_DEF, this is to show:
13807   (1) y IN orbit f g x ==>
13808          ?a. a IN G /\ (act_by f g x y * stabilizer f g x = {b | b IN G /\ b IN a * stabilizer f g x})
13809       Let c = act_by f g x y, and put a = c.
13810       Note (x ~~ y) f g        by orbit_element
13811        and c IN G              by act_by_def,
13812       By coset_def, EXTENSION, this is to show:
13813          (?z. a = c * z /\ z IN stabilizer f g x) <=>
13814          a IN G /\ ?z. a = c * z /\ z IN stabilizer f g x
13815       Need to show: c * z IN G.
13816       Now z IN G               by stabilizer_element
13817       Thus c * z IN G          by group_op_element
13818   (2) y IN orbit f g x /\ z IN orbit f g x /\
13819         act_by f g x y * stabilizer f g x = act_by f g x z * stabilizer f g x ==> y = z
13820       Note (x ~~ y) f g /\ (x ~~ z) f g                  by orbit_element
13821        and act_by f g x y IN G /\ act_by f g x z IN G    by act_by_def
13822        ==> f (act_by f g x y) x = f (act_by f g x z) x   by orbit_stabilizer_map_inj
13823         so y = z                                         by act_by_def
13824   (3) same as (1)
13825   (4) a IN G /\ s = {y | y IN G /\ y IN a * stabilizer f g x} ==>
13826         ?y. y IN orbit f g x /\ (act_by f g x y * stabilizer f g x = s)
13827       Let y = f a x.
13828       Note (x ~~ y) f g             by reach_def
13829        and act_by f g x y IN G /\ (f (act_by f g x y) x = f a x)  by act_by_def
13830        ==> act_by f g x y * (stabilizer f g x)
13831          = a * (stabilizer f g x)   by orbit_stabilizer_map_good
13832      By EXTENSION, this is to show:
13833         !b. b IN a * stabilizer f g x ==> b IN G
13834      Note b IN IMAGE (\z. a * z) (stabilizer f g x)     by coset_def
13835      Thus ?z. z IN (stabilizer f g x) /\ (b = a * z)    by IN_IMAGE
13836       Now z IN G                                        by stabilizer_element
13837      Thus b = a * z IN G                                by group_op_element
13838*)
13839Theorem orbit_stabilizer_cosets_bij_alt:
13840  !f g X x.
13841     Group g /\ (g act X) f /\ x IN X ==>
13842     BIJ (\y. (act_by f g x y) * (stabilizer f g x))
13843         (orbit f g x)
13844         (CosetPartition g (StabilizerGroup f g x))
13845Proof
13846  simp_tac (srw_ss()) [CosetPartition_def, partition_def, inCoset_def,
13847                       StabilizerGroup_def, BIJ_DEF, INJ_DEF, SURJ_DEF] >>
13848  rpt strip_tac >| [
13849    qabbrev_tac `z = act_by f g x y` >>
13850    qexists_tac `z` >>
13851    `(x ~~ y) f g` by metis_tac[orbit_element] >>
13852    `z IN G` by rw[act_by_def, Abbr`z`] >>
13853    asm_simp_tac (srw_ss()) [EXTENSION, EQ_IMP_THM] >>
13854    rw[coset_def, IMAGE_DEF, EXTENSION] >>
13855    metis_tac[stabilizer_element, group_op_element],
13856    metis_tac[orbit_element, orbit_stabilizer_map_inj, act_by_def],
13857    qabbrev_tac `z = act_by f g x y` >>
13858    qexists_tac `z` >>
13859    `(x ~~ y) f g` by metis_tac[orbit_element] >>
13860    `z IN G` by rw[act_by_def, Abbr`z`] >>
13861    rw[coset_def, IMAGE_DEF, EXTENSION] >>
13862    metis_tac[stabilizer_element, group_op_element],
13863    rename [‘x'' IN G’, ‘_ IN a * stabilizer f g x’] >>
13864    qexists_tac `f a x` >>
13865    rpt strip_tac >- metis_tac[orbit_element, action_closure, reach_def] >>
13866    qabbrev_tac `y = f a x` >>
13867    `(x ~~ y) f g` by metis_tac[reach_def] >>
13868    `act_by f g x y IN G /\ (f (act_by f g x y) x = f a x)` by rw[act_by_def] >>
13869    `act_by f g x y * (stabilizer f g x) = a * (stabilizer f g x)`
13870      by metis_tac[orbit_stabilizer_map_good] >>
13871    asm_simp_tac (srw_ss()) [EXTENSION, EQ_IMP_THM] >>
13872    metis_tac[coset_def, IN_IMAGE, stabilizer_element, group_op_element]
13873  ]
13874QED
13875
13876(* Theorem: [Orbit-Stabilizer Theorem]
13877            FiniteGroup g /\ (g act X) f /\ x IN X /\ FINITE X ==>
13878            CARD G = CARD (orbit f g x) * CARD (stabilizer f g x) *)
13879(* Proof:
13880   Let h = StabilizerGroup f g x
13881   Then h <= g                          by stabilizer_group_subgroup
13882    and H = stabilizer f g x            by stabilizer_group_property
13883   Note CosetPartition g h = partition (inCoset g h) G  by CosetPartition_def
13884     so FINITE (CosetPartition g h)     by FINITE_partition
13885   Note FINITE_partition = IMAGE (\a. f a x) G  by orbit_def
13886     so FINITE (orbit f g x)            by IMAGE_FINITE
13887
13888     CARD G
13889   = CARD H * CARD (CosetPartition g h)            by Lagrange_identity, h <= g
13890   = CARD (stabilizer f g x) * CARD (orbit f g x)  by orbit_stabilizer_cosets_bij_alt, FINITE_BIJ_CARD_EQ
13891   = CARD (orbit f g x) * CARD (stabilizer f g x)  by MULT_COMM
13892*)
13893Theorem orbit_stabilizer_thm:
13894  !f (g:'a group) X x. FiniteGroup g /\ (g act X) f /\ x IN X /\ FINITE X ==>
13895                       CARD G = CARD (orbit f g x) * CARD (stabilizer f g x)
13896Proof
13897  rpt (stripDup[FiniteGroup_def]) >>
13898  `StabilizerGroup f g x <= g` by metis_tac[stabilizer_group_subgroup] >>
13899  `(StabilizerGroup f g x).carrier = stabilizer f g x` by rw[stabilizer_group_property] >>
13900  `FINITE (CosetPartition g (StabilizerGroup f g x))` by metis_tac[CosetPartition_def, FINITE_partition] >>
13901  `FINITE (orbit f g x)` by rw[orbit_def] >>
13902  `CARD G = CARD (stabilizer f g x) * CARD (CosetPartition g (StabilizerGroup f g x))` by metis_tac[Lagrange_identity] >>
13903  `_ = CARD (stabilizer f g x) * CARD (orbit f g x)` by metis_tac[orbit_stabilizer_cosets_bij_alt, FINITE_BIJ_CARD_EQ] >>
13904  rw[]
13905QED
13906
13907(* This is a major milestone! *)
13908
13909(* Theorem: FiniteGroup g /\ (g act X) f /\ x IN X /\ FINITE X ==>
13910            CARD (orbit f g x) divides CARD G *)
13911(* Proof:
13912   Let b = orbit f g x,
13913       c = stabilizer f g x.
13914   Note CARD G = CARD b * CARD c         by orbit_stabilizer_thm
13915   Thus (CARD b) divides (CARD G)        by divides_def
13916*)
13917Theorem orbit_card_divides_target_card:
13918  !f (g:'a group) X x. FiniteGroup g /\ (g act X) f /\ x IN X /\ FINITE X ==>
13919                       CARD (orbit f g x) divides CARD G
13920Proof
13921  prove_tac[orbit_stabilizer_thm, divides_def, MULT_COMM]
13922QED
13923
13924(* ------------------------------------------------------------------------- *)
13925(* Fixed Points of action.                                                   *)
13926(* ------------------------------------------------------------------------- *)
13927
13928(*
13929Fixed Points have singleton orbits -- although it is not defined in this way,
13930this property is the theorem fixed_points_orbit_sing.
13931
13932This important property of fixed points gives this simple trick:
13933to count how many singleton orbits, just count the set (fixed_points f g X).
13934
13935Since orbits are equivalent classes, they cannot be empty, hence singleton
13936orbits are the simplest type. For equivalent classes:
13937
13938CARD Target = SUM CARD (orbits)
13939            = SUM CARD (singleton orbits) + SUM CARD (non-singleton orbits)
13940            = CARD (fixed_points) + SUM CARD (non-singleton orbits)
13941*)
13942
13943(* Fixed points of action: those points fixed by all group elements. *)
13944Definition fixed_points_def[nocompute]:
13945   fixed_points f (g:'a group) (X:'b -> bool) =
13946      {x | x IN X /\ !a. a IN G ==> f a x = x }
13947End
13948(* Note: use zDefine as this is not effective for computation. *)
13949(*
13950> fixed_points_def |> ISPEC ``$o``;
13951|- !g' X. fixed_points $o g' X = {x | x IN X /\ !a. a IN G'.carrier ==> a o x = x}: thm
13952*)
13953
13954(* Theorem: Fixed point elements:
13955            x IN (fixed_points f g X) <=> x IN X /\ !a. a IN G ==> f a x = x *)
13956(* Proof: by fixed_points_def. *)
13957Theorem fixed_points_element:
13958  !f g X x. x IN (fixed_points f g X) <=> x IN X /\ !a. a IN G ==> f a x = x
13959Proof
13960  simp[fixed_points_def]
13961QED
13962
13963(* Theorem: Fixed points are subsets of target set.
13964            (fixed_points f g X) SUBSET X *)
13965(* Proof: by fixed_points_def, SUBSET_DEF. *)
13966Theorem fixed_points_subset:
13967  !f g X. (fixed_points f g X) SUBSET X
13968Proof
13969  simp[fixed_points_def, SUBSET_DEF]
13970QED
13971
13972(* Theorem: Fixed points are finite.
13973            FINITE X ==> FINITE (fixed_points f g X) *)
13974(* Proof: by fixed_points_subset, SUBSET_FINITE. *)
13975Theorem fixed_points_finite:
13976  !f g X. FINITE X ==> FINITE (fixed_points f g X)
13977Proof
13978  metis_tac[fixed_points_subset, SUBSET_FINITE]
13979QED
13980
13981(* Theorem: x IN fixed_points f g X ==> x IN X *)
13982(* Proof: by fixed_points_def *)
13983Theorem fixed_points_element_element:
13984  !f g X x. x IN fixed_points f g X ==> x IN X
13985Proof
13986  simp[fixed_points_def]
13987QED
13988
13989(* Fixed Points have singleton orbits, or those with stabilizer = whole group. *)
13990
13991(* Theorem: Group g /\ (g act X) f ==>
13992            !x. x IN fixed_points f g X <=> x IN X /\ orbit f g x = {x} *)
13993(* Proof:
13994   By fixed_points_def, orbit_def, EXTENSION, this is to show:
13995   (1) a IN G /\ (!a. a IN G ==> f a x = x) ==> f a x = x
13996       This is true                by the included implication
13997   (2) (!a. a IN G ==> f a x = x) ==> ?a. a IN G /\ x = f a x
13998       Take a = #e,
13999       Then a IN G                 by group_id_element
14000        and f a x = x              by implication
14001   (3) (g act X) f /\ a IN G ==> f a x = x
14002       This is true                by action_closure
14003*)
14004Theorem fixed_points_orbit_sing:
14005  !f g X. Group g /\ (g act X) f ==>
14006          !x. x IN fixed_points f g X <=>
14007             x IN X /\ orbit f g x = {x}
14008Proof
14009  rw[fixed_points_def, orbit_def, EXTENSION, EQ_IMP_THM] >-
14010  rw_tac std_ss[] >-
14011  metis_tac[group_id_element] >>
14012  metis_tac[action_closure]
14013QED
14014
14015(* Theorem: For action f g X, x IN X, (orbit f g x = {x}) ==> x IN fixed_points f g X *)
14016(* Proof:
14017   By fixed_points_def, orbit_def, EXTENSION, this is to prove:
14018   (g act X) f /\ x IN X /\ a IN G /\
14019     !x. x IN X /\ (?b. b IN G /\ (f b x = x) <=> a = b) ==> f a x = x
14020   This is true by action_closure.
14021*)
14022Theorem orbit_sing_fixed_points:
14023  !f g X. (g act X) f ==>
14024          !x. x IN X /\ orbit f g x = {x} ==> x IN fixed_points f g X
14025Proof
14026  rw[fixed_points_def, orbit_def, EXTENSION] >>
14027  metis_tac[action_closure]
14028QED
14029(* This is weaker than the previous theorem. *)
14030
14031(* Theorem: Group g /\ (g act X) f ==>
14032           !x. x IN fixed_points f g X <=> SING (orbit f g x)) *)
14033(* Proof:
14034   By SING_DEF, this is to show:
14035   If part: x IN fixed_points f g X ==> ?z. (orbit f g x) = {a}
14036      Take z = x, then true              by fixed_points_orbit_sing
14037   Only-if part: (orbit f g x) = {x} ==> x IN fixed_points f g X
14038      Note a IN (orbit f g x)            by orbit_has_self
14039      Thus x = a                         by IN_SING
14040        so x IN fixed_points f g X       by fixed_points_orbit_sing
14041*)
14042Theorem fixed_points_orbit_iff_sing:
14043  !f g X. Group g /\ (g act X) f ==>
14044          !x. x IN X ==> (x IN fixed_points f g X <=> SING (orbit f g x))
14045Proof
14046  metis_tac[fixed_points_orbit_sing, orbit_has_self, SING_DEF, IN_SING]
14047QED
14048
14049(* Theorem: Group g /\ (g act X) f ==>
14050            !x. x IN (X DIFF fixed_points f g X) <=>
14051                x IN X /\ ~ SING (orbit f g x))  *)
14052(* Proof:
14053       x IN (X DIFF fixed_points f g X)
14054   <=> x IN X /\ x NOTIN (fixed_points f g X)  by IN_DIFF
14055   <=> x IN X /\ ~ SING (orbit f g x))         by fixed_points_orbit_iff_sing
14056*)
14057Theorem non_fixed_points_orbit_not_sing:
14058  !f g X. Group g /\ (g act X) f ==>
14059          !x. x IN (X DIFF fixed_points f g X) <=>
14060              x IN X /\ ~ SING (orbit f g x)
14061Proof
14062  metis_tac[IN_DIFF, fixed_points_orbit_iff_sing]
14063QED
14064
14065(* Theorem: FINITE X ==> CARD (X DIFF fixed_points f g X) =
14066                         CARD X - CARD (fixed_points f g X) *)
14067(* Proof:
14068   Let fp = fixed_points f g X.
14069   Note fp SUBSET X                by fixed_points_subset
14070   Thus X INTER fp = fp            by SUBSET_INTER_ABSORPTION
14071     CARD (X DIFF bp)
14072   = CARD X - CARD (X INTER fp)    by CARD_DIFF
14073   = CARD X - CARD fp              by SUBSET_INTER_ABSORPTION
14074*)
14075Theorem non_fixed_points_card:
14076  !f g X. FINITE X ==>
14077          CARD (X DIFF fixed_points f g X) =
14078          CARD X - CARD (fixed_points f g X)
14079Proof
14080  metis_tac[CARD_DIFF, fixed_points_subset,
14081            SUBSET_INTER_ABSORPTION, SUBSET_FINITE, INTER_COMM]
14082QED
14083
14084(* ------------------------------------------------------------------------- *)
14085(* Partition of Target into single orbits and non-single orbits.             *)
14086(* ------------------------------------------------------------------------- *)
14087
14088(* Define singleton and non-singleton orbits *)
14089Definition sing_orbits_def[nocompute]:
14090    sing_orbits f (g:'a group) (X:'b -> bool) = { e | e IN (orbits f g X) /\ SING e }
14091End
14092Definition multi_orbits_def[nocompute]:
14093    multi_orbits f (g:'a group) (X:'b -> bool) = { e | e IN (orbits f g X) /\ ~ SING e }
14094End
14095(* Note: use zDefine as this is not effective for computation. *)
14096
14097(* Theorem: e IN sing_orbits f g X <=> e IN (orbits f g X) /\ SING e *)
14098(* Proof: by sing_orbits_def *)
14099Theorem sing_orbits_element:
14100  !f g X e. e IN sing_orbits f g X <=> e IN (orbits f g X) /\ SING e
14101Proof
14102  simp[sing_orbits_def]
14103QED
14104
14105(* Theorem: (sing_orbits f g X) SUBSET (orbits f g X) *)
14106(* Proof: by sing_orbits_element, SUBSET_DEF *)
14107Theorem sing_orbits_subset:
14108  !f g X. (sing_orbits f g X) SUBSET (orbits f g X)
14109Proof
14110  simp[sing_orbits_element, SUBSET_DEF]
14111QED
14112
14113(* Theorem: FINITE X ==> FINITE (sing_orbits f g X) *)
14114(* Proof: by sing_orbits_subset, orbits_finite, SUBSET_FINITE *)
14115Theorem sing_orbits_finite:
14116  !f g X. FINITE X ==> FINITE (sing_orbits f g X)
14117Proof
14118  metis_tac[sing_orbits_subset, orbits_finite, SUBSET_FINITE]
14119QED
14120
14121(* Theorem: For (g act X) f, elements of (sing_orbits f g X) are subsets of X.
14122            (g act X) f /\ e IN (sing_orbits f g X) ==> e SUBSET X *)
14123(* Proof: by sing_orbits_element, orbits_element_subset *)
14124Theorem sing_orbits_element_subset:
14125  !f g X e. (g act X) f /\ e IN (sing_orbits f g X) ==> e SUBSET X
14126Proof
14127  metis_tac[sing_orbits_element, orbits_element_subset]
14128QED
14129
14130(* Theorem: e IN (sing_orbits f g X) ==> FINITE e *)
14131(* Proof: by sing_orbits_element, SING_FINITE *)
14132Theorem sing_orbits_element_finite:
14133  !f g X e. e IN (sing_orbits f g X) ==> FINITE e
14134Proof
14135  simp[sing_orbits_element, SING_FINITE]
14136QED
14137
14138(* Theorem: e IN (sing_orbits f g X) ==> CARD e = 1 *)
14139(* Proof: by sing_orbits_element, SING_DEF, CARD_SING *)
14140Theorem sing_orbits_element_card:
14141  !f g X e. e IN (sing_orbits f g X) ==> CARD e = 1
14142Proof
14143  metis_tac[sing_orbits_element, SING_DEF, CARD_SING]
14144QED
14145
14146(* Theorem: Group g /\ (g act X) f ==>
14147            !e. e IN (sing_orbits f g X) ==> CHOICE e IN fixed_points f g X *)
14148(* Proof:
14149   Note e IN orbits f g X /\ SING e  by sing_orbits_element
14150   Thus ?x. e = {x}                  by SING_DEF
14151    ==> x IN e /\ (CHOICE e = x)     by IN_SING, CHOICE_SING
14152     so e = orbit f g x              by orbits_element_is_orbit, x IN e
14153    and x IN X                       by orbits_element_element
14154    ==> x IN fixed_points f g X      by orbit_sing_fixed_points
14155*)
14156Theorem sing_orbits_element_choice:
14157  !f g X. Group g /\ (g act X) f ==>
14158          !e. e IN (sing_orbits f g X) ==> CHOICE e IN fixed_points f g X
14159Proof
14160  rw[sing_orbits_element] >>
14161  `?x. e = {x}` by rw[GSYM SING_DEF] >>
14162  `x IN e /\ CHOICE e = x` by rw[] >>
14163  `e = orbit f g x` by metis_tac[orbits_element_is_orbit] >>
14164  metis_tac[orbit_sing_fixed_points, orbits_element_element]
14165QED
14166
14167(* Theorem: e IN multi_orbits f g X <=> e IN (orbits f g X) /\ ~SING e *)
14168(* Proof: by multi_orbits_def *)
14169Theorem multi_orbits_element:
14170  !f g X e. e IN multi_orbits f g X <=> e IN (orbits f g X) /\ ~SING e
14171Proof
14172  simp[multi_orbits_def]
14173QED
14174
14175(* Theorem: (multi_orbits f g X) SUBSET (orbits f g X) *)
14176(* Proof: by multi_orbits_element, SUBSET_DEF *)
14177Theorem multi_orbits_subset:
14178  !f g X. (multi_orbits f g X) SUBSET (orbits f g X)
14179Proof
14180  simp[multi_orbits_element, SUBSET_DEF]
14181QED
14182
14183(* Theorem: FINITE X ==> FINITE (multi_orbits f g X) *)
14184(* Proof: by multi_orbits_subset, orbits_finite, SUBSET_FINITE *)
14185Theorem multi_orbits_finite:
14186  !f g X. FINITE X ==> FINITE (multi_orbits f g X)
14187Proof
14188  metis_tac[multi_orbits_subset, orbits_finite, SUBSET_FINITE]
14189QED
14190
14191(* Theorem: For (g act X) f, elements of (multi_orbits f g X) are subsets of X.
14192            (g act X) f /\ e IN (multi_orbits f g X) ==> e SUBSET X *)
14193(* Proof: by multi_orbits_element, orbits_element_subset *)
14194Theorem multi_orbits_element_subset:
14195  !f g X e. (g act X) f /\ e IN (multi_orbits f g X) ==> e SUBSET X
14196Proof
14197  metis_tac[multi_orbits_element, orbits_element_subset]
14198QED
14199
14200(* Theorem: (g act X) f /\ e IN (multi_orbits f g X) ==> FINITE e *)
14201(* Proof: by multi_orbits_element, orbits_element_finite *)
14202Theorem multi_orbits_element_finite:
14203  !f g X e. (g act X) f /\ FINITE X /\ e IN (multi_orbits f g X) ==> FINITE e
14204Proof
14205  metis_tac[multi_orbits_element, orbits_element_finite]
14206QED
14207
14208(* Theorem: sing_orbits and multi_orbits are disjoint.
14209            DISJOINT (sing_orbits f g X) (multi_orbits f g X) *)
14210(* Proof: by sing_orbits_def, multi_orbits_def, DISJOINT_DEF. *)
14211Theorem target_orbits_disjoint:
14212  !f g X. DISJOINT (sing_orbits f g X) (multi_orbits f g X)
14213Proof
14214  rw[sing_orbits_def, multi_orbits_def, DISJOINT_DEF, EXTENSION] >>
14215  metis_tac[]
14216QED
14217
14218(* Theorem: orbits = sing_orbits + multi_orbits.
14219            orbits f g X = (sing_orbits f g X) UNION (multi_orbits f g X) *)
14220(* Proof: by sing_orbits_def, multi_orbits_def. *)
14221Theorem target_orbits_union:
14222  !f g X. orbits f g X = (sing_orbits f g X) UNION (multi_orbits f g X)
14223Proof
14224  rw[sing_orbits_def, multi_orbits_def, EXTENSION] >>
14225  metis_tac[]
14226QED
14227
14228(* Theorem: For (g act X) f, CARD X = CARD sing_orbits + SIGMA CARD multi_orbits.
14229            Group g /\ (g act X) f /\ FINITE X ==>
14230            (CARD X = CARD (sing_orbits f g X) + SIGMA CARD (multi_orbits f g X)) *)
14231(* Proof:
14232   Let s = sing_orbits f g X, t = multi_orbits f g X.
14233   Note FINITE s                   by sing_orbits_finite
14234    and FINITE t                   by multi_orbits_finite
14235   also s INTER t = {}             by target_orbits_disjoint, DISJOINT_DEF
14236
14237     CARD X
14238   = SIGMA CARD (orbits f g X)     by target_card_by_partition
14239   = SIGMA CARD (s UNION t)        by target_orbits_union
14240   = SIGMA CARD s + SIGMA CARD t   by SUM_IMAGE_UNION, SUM_IMAGE_EMPTY
14241   = 1 * CARD s + SIGMA CARD t     by sing_orbits_element_card, SIGMA_CARD_CONSTANT
14242   = CARD s + SIGMA CARD t         by MULT_LEFT_1
14243*)
14244Theorem target_card_by_orbit_types:
14245  !f g X. Group g /\ (g act X) f /\ FINITE X ==>
14246          CARD X = CARD (sing_orbits f g X) + SIGMA CARD (multi_orbits f g X)
14247Proof
14248  rpt strip_tac >>
14249  qabbrev_tac `s = sing_orbits f g X` >>
14250  qabbrev_tac `t = multi_orbits f g X` >>
14251  `FINITE s` by rw[sing_orbits_finite, Abbr`s`] >>
14252  `FINITE t` by rw[multi_orbits_finite, Abbr`t`] >>
14253  `s INTER t = {}` by rw[target_orbits_disjoint, GSYM DISJOINT_DEF, Abbr`s`, Abbr`t`] >>
14254  `CARD X = SIGMA CARD (orbits f g X)` by rw_tac std_ss[target_card_by_partition] >>
14255  `_ = SIGMA CARD (s UNION t)` by rw_tac std_ss[target_orbits_union] >>
14256  `_ = SIGMA CARD s + SIGMA CARD t` by rw[SUM_IMAGE_UNION, SUM_IMAGE_EMPTY] >>
14257  `_ = 1 * CARD s + SIGMA CARD t` by metis_tac[sing_orbits_element_card, SIGMA_CARD_CONSTANT] >>
14258  rw[]
14259QED
14260
14261(* Theorem: The map: e IN (sing_orbits f g X) --> x IN (fixed_points f g X)
14262               where e = {x} is injective.
14263            Group g /\ (g act X) f ==>
14264            INJ (\e. CHOICE e) (sing_orbits f g X) (fixed_points f g X) *)
14265(* Proof:
14266   By INJ_DEF, this is to show:
14267   (1) e IN sing_orbits f g X ==> CHOICE e IN fixed_points f g X
14268       This is true                    by sing_orbits_element_choice
14269   (2) e IN sing_orbits f g X /\ e' IN sing_orbits f g X /\ CHOICE e = CHOICE e' ==> e = e'
14270       Note SING e /\ SING e'          by sing_orbits_element
14271       Thus this is true               by SING_DEF, CHOICE_SING.
14272*)
14273Theorem sing_orbits_to_fixed_points_inj:
14274  !f g X. Group g /\ (g act X) f ==>
14275          INJ (\e. CHOICE e) (sing_orbits f g X) (fixed_points f g X)
14276Proof
14277  rw[INJ_DEF] >-
14278  rw[sing_orbits_element_choice] >>
14279  metis_tac[sing_orbits_element, SING_DEF, CHOICE_SING]
14280QED
14281
14282(* Theorem: The map: e IN (sing_orbits f g X) --> x IN (fixed_points f g X)
14283               where e = {x} is surjective.
14284            Group g /\ (g act X) f ==>
14285            SURJ (\e. CHOICE e) (sing_orbits f g X) (fixed_points f g X) *)
14286(* Proof:
14287   By SURJ_DEF, this is to show:
14288   (1) e IN sing_orbits f g X ==> CHOICE e IN fixed_points f g X
14289       This is true                      by sing_orbits_element_choice
14290   (2) x IN fixed_points f g X ==> ?e. e IN sing_orbits f g X /\ (CHOICE e = x)
14291       Note x IN X                       by fixed_points_element
14292        and orbit f g x = {x}            by fixed_points_orbit_sing
14293       Take e = {x},
14294       Then CHOICE e = x                 by CHOICE_SING
14295        and SING e                       by SING_DEF
14296        and e IN orbits f g X            by orbit_is_orbits_element
14297        ==> e IN sing_orbits f g X       by sing_orbits_element
14298*)
14299Theorem sing_orbits_to_fixed_points_surj:
14300  !f g X. Group g /\ (g act X) f ==>
14301          SURJ (\e. CHOICE e) (sing_orbits f g X) (fixed_points f g X)
14302Proof
14303  rw[SURJ_DEF] >-
14304  rw[sing_orbits_element_choice] >>
14305  `x IN X` by metis_tac[fixed_points_element] >>
14306  `orbit f g x = {x}` by metis_tac[fixed_points_orbit_sing] >>
14307  qexists_tac `{x}` >>
14308  simp[sing_orbits_element] >>
14309  metis_tac[orbit_is_orbits_element]
14310QED
14311
14312(* Theorem: The map: e IN (sing_orbits f g X) --> x IN (fixed_points f g X)
14313               where e = {x} is bijective.
14314            Group g /\ (g act X) f ==>
14315            BIJ (\e. CHOICE e) (sing_orbits f g X) (fixed_points f g X) *)
14316(* Proof:
14317   By sing_orbits_to_fixed_points_inj,
14318      sing_orbits_to_fixed_points_surj, BIJ_DEF.
14319   True since the map is shown to be both injective and surjective.
14320*)
14321Theorem sing_orbits_to_fixed_points_bij:
14322  !f g X. Group g /\ (g act X) f ==>
14323          BIJ (\e. CHOICE e) (sing_orbits f g X) (fixed_points f g X)
14324Proof
14325  simp[BIJ_DEF, sing_orbits_to_fixed_points_surj,
14326                sing_orbits_to_fixed_points_inj]
14327QED
14328
14329(* Theorem: For (g act X) f, sing_orbits is the same size as fixed_points f g X,
14330            Group g /\ (g act X) f /\ FINITE X ==>
14331            CARD (sing_orbits f g X) = CARD (fixed_points f g X) *)
14332(* Proof:
14333   Let s = sing_orbits f g X, t = fixed_points f g X.
14334   Note s SUBSET (orbits f g X)    by sing_orbits_subset
14335    and t SUBSET X                 by fixed_points_subset
14336   Also FINITE s                   by orbits_finite, SUBSET_FINITE
14337    and FINITE t                   by SUBSET_FINITE
14338   With BIJ (\e. CHOICE e) s t     by sing_orbits_to_fixed_points_bij
14339    ==> CARD s = CARD t            by FINITE_BIJ_CARD_EQ
14340*)
14341Theorem sing_orbits_card_eqn:
14342  !f g X. Group g /\ (g act X) f /\ FINITE X ==>
14343          CARD (sing_orbits f g X) = CARD (fixed_points f g X)
14344Proof
14345  rpt strip_tac >>
14346  `(sing_orbits f g X) SUBSET (orbits f g X)` by rw[sing_orbits_subset] >>
14347  `(fixed_points f g X) SUBSET X` by rw[fixed_points_subset] >>
14348  metis_tac[sing_orbits_to_fixed_points_bij, FINITE_BIJ_CARD_EQ, SUBSET_FINITE, orbits_finite]
14349QED
14350
14351(* Theorem: For (g act X) f, CARD X = CARD fixed_points + SIGMA CARD multi_orbits.
14352            Group g /\ (g act X) f /\ FINITE X ==>
14353            CARD X = CARD (fixed_points f g X) + SIGMA CARD (multi_orbits f g X) *)
14354(* Proof:
14355   Let s = sing_orbits f g X, t = multi_orbits f g X.
14356     CARD X
14357   = CARD s + SIGMA CARD t                       by target_card_by_orbit_types
14358   = CARD (fixed_points f g X) + SIGMA CARD t    by sing_orbits_card_eqn
14359*)
14360Theorem target_card_by_fixed_points:
14361  !f g X. Group g /\ (g act X) f /\ FINITE X ==>
14362          CARD X = CARD (fixed_points f g X) + SIGMA CARD (multi_orbits f g X)
14363Proof
14364  metis_tac[target_card_by_orbit_types, sing_orbits_card_eqn]
14365QED
14366
14367(* Theorem:  Group g /\ (g act X) f /\ FINITE X /\ 0 < n /\
14368             (!e. e IN multi_orbits f g X ==> (CARD e = n)) ==>
14369             (CARD X MOD n = CARD (fixed_points f g X) MOD n) *)
14370(* Proof:
14371   Let s = fixed_points f g X,
14372       t = multi_orbits f g X.
14373   Note FINITE t                         by multi_orbits_finite
14374       (CARD X) MOD n
14375     = (CARD s + SIGMA CARD t) MOD n     by target_card_by_fixed_points
14376     = (CARD s + n * CARD t) MOD n       by SIGMA_CARD_CONSTANT, FINITE t
14377     = (CARD t * n + CARD s) MOD n       by ADD_COMM, MULT_COMM
14378     = (CARD s) MOD n                    by MOD_TIMES
14379*)
14380Theorem target_card_and_fixed_points_congruence:
14381  !f g X n. Group g /\ (g act X) f /\ FINITE X /\ 0 < n /\
14382            (!e. e IN multi_orbits f g X ==> (CARD e = n)) ==>
14383            CARD X MOD n = CARD (fixed_points f g X) MOD n
14384Proof
14385  rpt strip_tac >>
14386  imp_res_tac target_card_by_fixed_points >>
14387  `_ = CARD (fixed_points f g X) + n * CARD (multi_orbits f g X)`
14388     by rw[multi_orbits_finite, SIGMA_CARD_CONSTANT] >>
14389  fs[]
14390QED
14391
14392(* This is a very useful theorem! *)
14393
14394(* ------------------------------------------------------------------------- *)
14395(* Group Correspondence Documentation                                        *)
14396(* ------------------------------------------------------------------------- *)
14397(* Notes:
14398
14399   Author: Yiming Xu
14400   Editor: Joseph Chan
14401   Date: March 2018
14402   Summary: This makes use of the HOL4 Group and Subgroup Libraries
14403            to formalise the Correspondence Theorem of Group Theory.
14404   Reference: page 62 in Algebra (2nd Edition) by Michael Artin, ISBN: 0132413779.
14405*)
14406(* Overload:
14407*)
14408(* Definitions and Theorems (# are exported):
14409
14410   Helper Theorems:
14411   SURJ_IMAGE_PREIMAGE     |- !f a b. s SUBSET b /\ SURJ f a b ==> IMAGE f (PREIMAGE f s INTER a) = s
14412   count_formula           |- !g h. FiniteGroup g /\ h << g ==> CARD G = CARD H * CARD (g / h).carrier
14413   iso_group_same_card     |- !g h. FINITE G /\ GroupIso f g h ==> CARD G = CARD h.carrier
14414   Subgroup_subgroup       |- !g h. h <= g ==> subgroup h g
14415   Subgroup_homo_homo      |- !g h k f. h <= g /\ GroupHomo f g k ==> GroupHomo f h k
14416
14417   Lemma 1:
14418   image_subgroup_subgroup |- !f g1 g2 h. Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ h <= g1 ==>
14419                                          homo_image f h g2 <= g2
14420   Lemma 2:
14421   preimage_group_def          |- !f g1 g2 h. preimage_group f g1 g2 h =
14422                                              <|carrier := PREIMAGE f h INTER g1.carrier;
14423                                                     op := g1.op;
14424                                                     id := g1.id|>
14425   preimage_group_property     |- !f g1 g2 h x. x IN PREIMAGE f h INTER g1.carrier ==>
14426                                                x IN g1.carrier /\ f x IN h
14427   preimage_group_group        |- !f g1 g2 h. Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ h <= g2 ==>
14428                                              Group (preimage_group f g1 g2 h.carrier)
14429   preimage_subgroup_subgroup  |- !f g1 g2 h. Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ h <= g2 ==>
14430                                              preimage_group f g1 g2 h.carrier <= g1
14431
14432   Lemma 3:
14433   preimage_subgroup_kernel    |- !f g1 g2 h2. Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 ==>
14434                                               kernel f g1 g2 SUBSET PREIMAGE f h2.carrier INTER g1.carrier
14435
14436   Lemma 4:
14437   normal_preimage_normal      |- !f g1 g2 h2. Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 ==>
14438                                               h2 << g2 ==> preimage_group f g1 g2 h2.carrier << g1
14439   normal_surj_normal          |- !f g1 g2 h2. Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 /\
14440                                               SURJ f g1.carrier g2.carrier ==>
14441                                               preimage_group f g1 g2 h2.carrier << g1 ==> h2 << g2
14442   normal_iff_preimage_normal  |- !f g1 g2 h2. Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 /\
14443                                               SURJ f g1.carrier g2.carrier ==>
14444                                               (h2 << g2 <=> preimage_group f g1 g2 h2.carrier << g1)
14445
14446   Lemma 5:
14447   image_preimage_group    |- !f g1 g2 h. Group g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 /\
14448                                          SURJ f g1.carrier g2.carrier ==>
14449                                          IMAGE f (PREIMAGE f h.carrier INTER g1.carrier) = h.carrier
14450   subset_preimage_image   |- !f g1 g2 h. Group g1 /\ Group g2 /\ h <= g1 /\ GroupHomo f g1 g2 ==>
14451                                          H SUBSET PREIMAGE f (IMAGE f H) INTER g1.carrier
14452   preimage_image_subset   |- !f g1 g2 h. Group g1 /\ Group g2 /\ h <= g1 /\ GroupHomo f g1 g2 /\
14453                                          SURJ f g1.carrier g2.carrier /\ kernel f g1 g2 SUBSET H ==>
14454                                          PREIMAGE f (IMAGE f H) INTER g1.carrier SUBSET H
14455   bij_corres              |- !f g1 g2 h1 h2. Group g1 /\ Group g2 /\ h1 <= g1 /\ h2 <= g2 /\
14456                                              GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier /\
14457                                              kernel f g1 g2 SUBSET h1.carrier ==>
14458                               IMAGE f (PREIMAGE f h2.carrier INTER g1.carrier) = h2.carrier /\
14459                               PREIMAGE f (IMAGE f h1.carrier) INTER g1.carrier = h1.carrier
14460
14461   Lemma 6:
14462   homo_count_formula      |- !f g1 g2 h. FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
14463                               CARD (preimage_group f g1 g2 h.carrier).carrier =
14464                                 CARD (kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier *
14465                                 CARD (preimage_group f g1 g2 h.carrier /
14466                                       kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier
14467   image_iso_preimage_quotient     |- !f g1 g2 h. Group g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
14468      GroupIso (\z. coset (preimage_group f g1 g2 h.carrier)
14469              (CHOICE (preimage f (preimage_group f g1 g2 h.carrier).carrier z))
14470              (kernel f (preimage_group f g1 g2 h.carrier) g2))
14471        (homo_image f (preimage_group f g1 g2 h.carrier) g2)
14472        (preimage_group f g1 g2 h.carrier / kernel_group f (preimage_group f g1 g2 h.carrier) g2)
14473   finite_homo_image       |- !f g1 g2 h. FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
14474                              FINITE (homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier
14475   image_preimage_quotient_same_card   |- !f g1 g2 h.
14476      FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
14477      CARD (homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier =
14478      CARD (preimage_group f g1 g2 h.carrier / kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier
14479   homo_restrict_same_kernel    |- !f g1 g2 h. H SUBSET g1.carrier /\ GroupHomo f g1 g2 /\
14480                                               kernel f g1 g2 SUBSET H ==> kernel f g1 g2 = kernel f h g2
14481   preimage_cardinality    |- !f g1 g2 h. FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 /\
14482                                          SURJ f g1.carrier g2.carrier ==>
14483      CARD (preimage_group f g1 g2 h.carrier).carrier = CARD h.carrier * CARD (kernel f g1 g2)
14484
14485   Correspondence Theorem:
14486   corres_thm    |- !f g1 g2 h1 h2. Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\
14487                                    SURJ f g1.carrier g2.carrier /\ h1 <= g1 /\
14488                                    kernel f g1 g2 SUBSET h1.carrier /\ h2 <= g2 ==>
14489                     homo_image f h1 g2 <= g2 /\
14490                     preimage_group f g1 g2 h2.carrier <= g1 /\
14491                     kernel f g1 g2 SUBSET PREIMAGE f h2.carrier INTER g1.carrier /\
14492                     (h2 << g2 <=> preimage_group f g1 g2 h2.carrier << g1) /\
14493                     IMAGE f (PREIMAGE f h2.carrier INTER g1.carrier) = h2.carrier /\
14494                     PREIMAGE f (IMAGE f h1.carrier) INTER g1.carrier = h1.carrier /\
14495                     (FiniteGroup g1 ==>
14496                         CARD (preimage_group f g1 g2 h2.carrier).carrier =
14497                         CARD h2.carrier * CARD (kernel f g1 g2))
14498
14499*)
14500
14501(* ------------------------------------------------------------------------- *)
14502(* Helper Theorems                                                           *)
14503(* ------------------------------------------------------------------------- *)
14504
14505(* set tight equality *)
14506val _ = ParseExtras.tight_equality();
14507
14508(* Firstly we prove a useful fact for set-theoric function to be used later. *)
14509
14510(* lemma 0 (SURJ_IMAGE_PREIMAGE):
14511   Let f be a surjective function from set a to set b, let s be a subset of b, then f(f^{-1}(s) = s. *)
14512(* Theorem: s SUBSET b /\ SURJ f a b ==> (IMAGE f (PREIMAGE f s INTER a) = s) *)
14513(* Proof:
14514          f(f^{-1}(s)) = s
14515     <=>  x IN f(f^{-1}(s)) iff x IN s                                       definition of equality of sets
14516     <=>  ?y. y IN f^{-1}(s) /\ f(y) = x iff x IN s                          definition of image
14517     <=>  ?y. f(y) IN s /\ f(y) = x iff x IN s                               definition of preimage
14518     <=>  ?y. x IN s /\ f(y) = x iff x IN s                                  substitute ``f(y)`` by ``x``
14519     <=>  x IN s /\ !y. f(y) = x iff x IN s                                  FOL
14520     <=>  x IN s /\ T iff x IN s                                             definition of surjectiveness
14521     <=>  x IN s iff x IN s                                                  FOL
14522     <=>  T                                                                  FOL
14523*)
14524
14525Theorem SURJ_IMAGE_PREIMAGE:
14526  !f a b. s SUBSET b /\  SURJ f a b ==> (IMAGE f(PREIMAGE f s INTER a) = s)
14527Proof
14528  rpt strip_tac >> simp[EXTENSION, PREIMAGE_def] >> strip_tac >> fs[SURJ_DEF] >>
14529  eq_tac >> rpt strip_tac >> metis_tac[SUBSET_DEF]
14530QED
14531
14532(* Add some facts about cardinal arithmetic of groups. *)
14533
14534(* count_formula:
14535   Let g be a group and h be a normal subgroup of g. Then CARD g = CARD h * CARD g / h. *)
14536(* Theorem: FiniteGroup g /\ h << g ==> CARD G = CARD H * CARD ((g / h).carrier) *)
14537(* Proof:
14538   Note h <= g                   by normal_subgroup_def
14539    and FINITE G                 by FiniteGroup_def
14540        CARD G
14541      = CARD H * CARD (CosetPartition g h)    by Lagrange_identity
14542      = CARD H * CARD ((g / h).carrier)       by quotient_group_def
14543*)
14544Theorem count_formula:
14545    !g:'a group h. FiniteGroup g /\ h << g ==> CARD G = CARD H * CARD ((g / h).carrier)
14546Proof
14547  rpt strip_tac >>
14548  `(g / h).carrier = CosetPartition g h` by simp[quotient_group_def] >>
14549  fs[FiniteGroup_def, normal_subgroup_def] >>
14550  rw[Lagrange_identity]
14551QED
14552
14553(* iso_group_same_card: If two groups g and h are isomorphic, then CARD g = CARD h. *)
14554(* Theorem:  FINITE G /\ GroupIso f g h ==> CARD G = CARD h.carrier *)
14555(* Proof:
14556   Note BIJ f G h.carrier          by group_iso_bij
14557   Thus CARD G = CARD h.carrier    by FINITE_BIJ_CARD, FINITE G
14558*)
14559Theorem iso_group_same_card:
14560    !f g:'a group h. FINITE G /\ GroupIso f g h ==> CARD G = CARD h.carrier
14561Proof
14562  rpt strip_tac >>
14563  `BIJ f G h.carrier` by fs[group_iso_bij] >>
14564  metis_tac[FINITE_BIJ_CARD]
14565QED
14566
14567(* lemma 1' (Subgroup_subgroup):
14568   The definition "Subgroup_def" implies the definition "subgroup_def" *)
14569(* Theorem: h <= g ==> subgroup h g *)
14570(* Proof: by subgroup_homomorphism *)
14571Theorem Subgroup_subgroup:
14572    !g:'a group h. h <= g ==> subgroup h g
14573Proof
14574  rw[subgroup_homomorphism]
14575QED
14576
14577(* Theorem: h <= g /\ GroupHomo f g k ==> GroupHomo f h k *)
14578(* Proof:
14579   Note subgroup h g          by Subgroup_subgroup
14580   Thus GroupHomo f h k       by subgroup_homo_homo
14581*)
14582Theorem Subgroup_homo_homo:
14583    !g:'a group h k f. h <= g /\ GroupHomo f g k ==> GroupHomo f h k
14584Proof
14585  rpt strip_tac >>
14586  `subgroup h g` by metis_tac[Subgroup_subgroup] >>
14587  metis_tac[subgroup_homo_homo]
14588QED
14589
14590(* ------------------------------------------------------------------------- *)
14591(* Lemma 1                                                                   *)
14592(* ------------------------------------------------------------------------- *)
14593
14594(* lemma 1 (image_subgroup_subgroup) :
14595   For a group homomorphism f from a group g1 to a group g2,
14596   the image of any subgroup h of g1 under f is a subgroup of g2. *)
14597(* Theorem: Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ h <= g1 ==> homo_image f h g2 <= g2 *)
14598(* Proof:
14599   Note subgroup h g1             by Subgroup_subgroup, h <= g1
14600    ==> GroupHomo f h g2          by subgroup_homo_homo
14601    and Group h                   by subgroup_groups
14602   Thus homo_image f h g2 <= g2   by homo_image_subgroup
14603*)
14604Theorem image_subgroup_subgroup:
14605    !g1:'a group g2 h f. Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ h <= g1 ==> homo_image f h g2 <= g2
14606Proof
14607  rpt strip_tac >>
14608  `subgroup h g1` by fs[Subgroup_subgroup] >>
14609  `GroupHomo f h g2` by metis_tac[subgroup_homo_homo] >>
14610  `Group h` by metis_tac[subgroup_groups] >>
14611  metis_tac[homo_image_subgroup]
14612QED
14613
14614(* This is Lemma 1 *)
14615
14616(* ------------------------------------------------------------------------- *)
14617(* Lemma 2                                                                   *)
14618(* ------------------------------------------------------------------------- *)
14619
14620(* lemma 2 (preimage_subgroup_subgroup):
14621   For a group homomorphism f from a group g1 to a group g2,
14622       the preimage of any subgroup of g2 under f is a subgroup of g1. *)
14623
14624(* ------------------------------------------------------------------------- *)
14625(* Preimage Group of Group Homomorphism.                                     *)
14626(* ------------------------------------------------------------------------- *)
14627Definition preimage_group_def:
14628    preimage_group (f:'a -> 'b) (g1:'a group) (g2:'b group) (h:'b -> bool) =
14629    <| carrier := PREIMAGE f h INTER g1.carrier;
14630            op := g1.op;
14631            id := g1.id
14632     |>
14633End
14634(* This is subset_group g1 (PREIMAGE f h INTER g1.carrier) *)
14635
14636
14637(* Theorem: x IN (PREIMAGE f h) INTER g1.carrier ==> x IN g1.carrier /\ f x IN h *)
14638(* Proof: by definitions. *)
14639Theorem preimage_group_property:
14640      !(f:'a -> 'b) (g1:'a group) (g2:'b group) (h:'b -> bool) x.
14641       x IN (PREIMAGE f h) INTER g1.carrier ==> x IN g1.carrier /\ f x IN h
14642Proof
14643    rpt strip_tac >> fs[INTER_DEF, PREIMAGE_def]
14644QED
14645
14646(* Theorem: Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ h <= g2 ==>
14647            Group (preimage_group f g1 g2 h.carrier) *)
14648(* Proof:
14649   By group_def_alt and other definitions, this is to show:
14650   (1) f (g1.op x y) IN h.carrier
14651         f (g1.op x y)
14652       = g2.op (f x) (f y)      by GroupHomo_def
14653       = h.op (f x) (f y)       by Subgroup_def
14654       which is IN h.carrier    by Subgroup_def, Group h
14655   (2) g1.op (g1.op x y) z = g1.op x (g1.op y z)
14656       This is true             by group_assoc
14657   (3) f g1.id IN h.carrier
14658         f g1.id
14659       = g2.id                  by group_homo_id
14660       = h.id                   by subgroup_id
14661       which is IN h.carrier    by group_id_element, Group h
14662   (4) ?y. (f y IN h.carrier /\ y IN g1.carrier) /\ g1.op y x = g1.id
14663       Let y = g1.inv x.
14664       Then f y = g2.inv (f x)  by group_homo_inv
14665                = h.inv (f x)   by subgroup_inv
14666                IN h.carrier    by group_inv_element
14667        and   y IN g1.carrier   by group_inv_element
14668        and g1.op y x = g1.id   by group_inv_thm
14669*)
14670Theorem preimage_group_group:
14671   !f g1:'a group g2:'b group h. Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ h <= g2 ==> Group (preimage_group f g1 g2 h.carrier)
14672Proof
14673    rpt strip_tac >> rw_tac std_ss[group_def_alt] >> fs[preimage_group_def, preimage_group_property] >>
14674    fs[PREIMAGE_def]
14675    >- (fs[GroupHomo_def] >>
14676       ` g2.op (f x) (f y) = h.op (f x) (f y)` by fs[Subgroup_def] >>
14677       `Group h` by fs[Subgroup_def] >>
14678       `h.op (f x) (f y) IN h.carrier` by fs[group_def_alt] >> rw[])
14679
14680    >- fs[group_def_alt]
14681    >- (`f g1.id = g2.id` by metis_tac[group_homo_id] >>
14682        `h.id = g2.id` by fs[subgroup_id] >> fs[Subgroup_def] >> fs[group_def_alt])
14683    >- (qexists_tac `g1.inv x` >> rpt strip_tac
14684        >-
14685      ( `f (g1.inv x) = g2.inv (f x)` by fs[group_homo_inv] >>
14686       `g2.inv (f x) = h.inv (f x)` by fs[subgroup_inv] >>
14687       `Group h` by fs[Subgroup_def] >> fs[group_inv_element])
14688        >- (`Group h` by fs[Subgroup_def] >>
14689           `h.inv (f x) IN h.carrier` by fs[group_inv_element] >> rw[])
14690        >- fs[group_inv_thm])
14691QED
14692
14693(* Theorem: Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ h <= g2 ==>
14694            preimage_group f g1 g2 h.carrier <= g1 *)
14695(* Proof:
14696   By Subgroup_def, this is to show:
14697   (1) Group (preimage_group f g1 g2 h.carrier), true        by preimage_group_group
14698   (2) (preimage_group f g1 g2 h.carrier).carrier
14699        SUBSET g1.carrier, true                              by preimage_group_def
14700   (3) (preimage_group f g1 g2 h.carrier).op = g1.op, true   by preimage_group_def
14701*)
14702Theorem preimage_subgroup_subgroup:
14703  !f g1:'a group g2:'b group h.
14704    Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ h <= g2 ==>
14705    preimage_group f g1 g2 h.carrier <= g1
14706Proof
14707  rpt strip_tac >> simp[Subgroup_def] >> rpt strip_tac
14708  >- metis_tac[preimage_group_group] >>
14709  rw[preimage_group_def]
14710QED
14711
14712(* This is Lemma 2 *)
14713
14714(* ------------------------------------------------------------------------- *)
14715(* Lemma 3                                                                   *)
14716(* ------------------------------------------------------------------------- *)
14717
14718(* lemma 3 (preimage_subgroup_kernel):
14719   For a group homomorphism f from a group g to a group 'g,
14720   the preimage of any subgroup 'h of 'g under f contains the kernel of f. *)
14721
14722(* Theorem: Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 ==>
14723             (kernel f g1 g2) SUBSET (PREIMAGE f h2.carrier) INTER g1.carrier*)
14724(* Proof:
14725        k SUBSET f^{-1}('h)
14726    <=> !x. x IN k ==> x IN f^{-1}('h)                                 by definition of set inclusion
14727    <=> !x. x IN g /\ f(x) = #e ==> x IN g /\ f(x) IN 'h               by definition of kernel, preimage
14728    <=> !x. x IN g /\ f(x) = #e ==> x IN g /\ #e IN 'h                 substitute ``f(x)`` by ``#e``
14729    <=> T                                                              by definition of subgroup
14730*)
14731Theorem preimage_subgroup_kernel:
14732      !f g1:'a group g2 h2. Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 ==>
14733             (kernel f g1 g2) SUBSET (PREIMAGE f h2.carrier) INTER g1.carrier
14734Proof
14735    rpt strip_tac >> simp[SUBSET_DEF] >> rpt strip_tac >> rw[PREIMAGE_def] >>
14736    `h2.id = g2.id` by metis_tac[subgroup_id] >> `Group h2` by metis_tac[Subgroup_def] >>
14737    `h2.id IN h2.carrier` by metis_tac[group_id_element] >> metis_tac[]
14738QED
14739
14740(* ------------------------------------------------------------------------- *)
14741(* Lemma 4                                                                   *)
14742(* ------------------------------------------------------------------------- *)
14743
14744(* lemma 4 (normal_iff_preimage_normal):
14745   For a group homomorphism f from a group g to a group 'g, if 'h is a subgroup of 'g,
14746   then 'h is a normal subgroup of 'g iff PREIM f 'h is a normal subgroup of g. *)
14747(* Theorem: Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 ==>
14748            (h2 << g2 ==> (preimage_group f g1 g2 h2.carrier) << g1) *)
14749(* Proof:
14750       'h is a normal subgroup of 'g ==> f^{-1}('h) is a normal subgroup of g.
14751   <=> (!'x 'y. 'x IN 'g /\ 'y IN 'h ==> 'x * 'y * 'x^{-1} IN 'h)
14752       ==> (!x y. x IN g /\ y IN f^{-1}('h) ==> x * y * x^{-1} IN f^{-1}('h)) by definition of normal subgroup
14753   <=> (!'x 'y. 'x IN 'g /\ 'y IN 'h ==> 'x * 'y * 'x^{-1} IN 'h)
14754       ==> (!x y. x IN g /\ f(y) IN 'h ==> f(x * y * x^{-1}) IN 'h            by definition of preimage
14755   <=> (!'x 'y. 'x IN 'g /\ 'y IN 'h ==> 'x * 'y * 'x^{-1} IN 'h)
14756       ==> (!x y. x IN g /\ f(y) IN 'h ==> f(x) * f(y) * (f(x))^{-1} IN 'h    by definition of homomorphism
14757                                                                                 f(x^{-1}) = (f(x))^{-1}
14758   <=> T                                                                      by FOL
14759
14760       f^{-1}('h) is a normal subgroup of g ==> 'h is a normal subgroup of 'g.
14761   <=> (!a b. a IN g /\ b IN f^{-1}('h) ==> a * b * a^{-1} IN f^{-1}('h))
14762        ==> (!x y. x IN 'g /\ y IN 'h ==> x * y * x^{-1} IN 'h)               by definition of normal subgroup
14763   <=> (!a b. a IN g /\ f(b) IN 'h ==> f(a) * f(b) * (f(a))^{-1} IN 'h)
14764        ==> (!x y. x IN 'g /\ y IN 'h ==> x * y * x^{-1} IN 'h)               by definition of preimage
14765   Now !x y. ?x' y'. x' IN g /\ y' IN g /\ f(x') = x /\ f(y') = y             by definition of surjectiveness
14766   <=> (!a b. a IN g /\ f(b) IN 'h ==> f(a) * f(b) * (f(a))^{-1} IN 'h)
14767        ==> (!f(x') f(y'). f(x') IN 'g /\ f(y') IN 'h ==> f(x') * f(y') * (f(x))^{-1} IN 'h)
14768                             by substitute ``x`` by ``f(x')`` and substitute ``y`` by ``f(y')``
14769   <=> T                                                                      by condition satisfied
14770*)
14771Theorem normal_preimage_normal:
14772      !f:'a -> 'b g1:'a group g2:'b group h2. Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 ==>
14773    (h2 << g2 ==> (preimage_group f g1 g2 h2.carrier) << g1)
14774Proof
14775    rpt strip_tac >>
14776    fs[normal_subgroup_def] >> rpt strip_tac >>
14777    simp[preimage_subgroup_subgroup] >>
14778    fs[preimage_group_def] >> fs[PREIMAGE_def] >>
14779    `f (g1.op (g1.op a z) (g1.inv a)) = g2.op (g2.op (f a) (f z)) (f (g1.inv a))` by fs[GroupHomo_def] >>
14780    `f (g1.inv a) = g2.inv (f a)` by fs[group_homo_inv] >>
14781    `f (g1.op (g1.op a z) (g1.inv a)) = g2.op (g2.op (f a) (f z)) (g2.inv (f a))` by rw[] >>
14782    `(f a) IN g2.carrier` by metis_tac[group_homo_element] >>
14783    metis_tac[]
14784QED
14785
14786(* Theorem: Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier ==>
14787            ((preimage_group f g1 g2 h2.carrier) << g1 ==> (h2 << g2)) *)
14788(* Proof:
14789   By normal_subgroup_def and preimage_group_def, this is to show:
14790      a IN g2.carrier /\ z IN h2.carrier ==>
14791           g2.op (g2.op a z) (g2.inv a) IN h2.carrier
14792   Let a1 = CHOICE (preimage f g1.carrier a),
14793   and z1 = CHOICE (preimage f g1.carrier a),
14794   Then f a1 = a /\ f z1 = z          by preimage_choice_property.
14795    and f (g1.op (g1.op a1 z1) (g1.inv a1))
14796      = g2.op (g2.op a z) (g2.inv a)  by GroupHomo_def, group_homo_inv
14797   Thus g2.op (g2.op a z) (g2.inv a) IN h2.carrier    by GroupHomo_def
14798*)
14799Theorem normal_surj_normal:
14800      !f:'a -> 'b g1:'a group g2:'b group h2. Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier ==> ((preimage_group f g1 g2 h2.carrier) << g1 ==> (h2 << g2))
14801Proof
14802    rpt strip_tac >> fs[normal_subgroup_def] >> rpt strip_tac >> fs[preimage_group_def] >> fs[PREIMAGE_def] >>
14803    `IMAGE f g1.carrier = g2.carrier` by fs[IMAGE_SURJ] >>
14804    `h2.carrier SUBSET g2.carrier` by fs[Subgroup_def] >>
14805    `a IN IMAGE f g1.carrier` by metis_tac[] >>
14806    `z IN IMAGE f g1.carrier` by metis_tac[SUBSET_DEF] >>
14807    `CHOICE (preimage f g1.carrier a) IN g1.carrier /\ f (CHOICE (preimage f g1.carrier a)) = a` by metis_tac[preimage_choice_property] >>
14808    `CHOICE (preimage f g1.carrier z) IN g1.carrier /\ f (CHOICE (preimage f g1.carrier z)) = z` by metis_tac[preimage_choice_property] >>
14809    `f (CHOICE (preimage f g1.carrier z)) IN h2.carrier` by metis_tac[] >>
14810    `f (g1.op (g1.op (CHOICE (preimage f g1.carrier a)) (CHOICE (preimage f g1.carrier z))) (g1.inv (CHOICE (preimage f g1.carrier a)))) IN h2.carrier` by metis_tac[] >>
14811    `(f (g1.inv (CHOICE (preimage f g1.carrier a)))) = (g2.inv (f (CHOICE (preimage f g1.carrier a))))` by fs[group_homo_inv] >>
14812    `f (g1.op (g1.op (CHOICE (preimage f g1.carrier a)) (CHOICE (preimage f g1.carrier z))) (g1.inv (CHOICE (preimage f g1.carrier a)))) = g2.op (g2.op (f (CHOICE (preimage f g1.carrier a))) (f (CHOICE (preimage f g1.carrier z)))) (f (g1.inv (CHOICE (preimage f g1.carrier a))))` by fs[GroupHomo_def] >>
14813    `_ = g2.op (g2.op (f (CHOICE (preimage f g1.carrier a))) (f (CHOICE (preimage f g1.carrier z)))) (g2.inv (f (CHOICE (preimage f g1.carrier a))))` by rw[] >>
14814    `_ = g2.op (g2.op a z) (g2.inv a)` by rw[] >> metis_tac[]
14815QED
14816
14817
14818(* Theorem: Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier ==>
14819            (h2 << g2 <=> (preimage_group f g1 g2 h2.carrier) << g1) *)
14820(* Proof:
14821   If part: h2 << g2 ==> preimage_group f g1 g2 h2.carrier << g1
14822      This is true                    by normal_preimage_normal
14823   Only-if part: preimage_group f g1 g2 h2.carrier << g1 ==> h2 << g2
14824      This is true                    by normal_surj_normal
14825*)
14826Theorem normal_iff_preimage_normal:
14827      !f:'a -> 'b g1:'a group g2:'b group h2. Group g1 /\ Group g2 /\ h2 <= g2 /\ GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier ==>
14828    (h2 << g2 <=> (preimage_group f g1 g2 h2.carrier) << g1)
14829Proof
14830    rpt strip_tac >> eq_tac >- metis_tac[normal_preimage_normal] >> metis_tac[normal_surj_normal]
14831QED
14832
14833(* This is Lemma 4 *)
14834
14835(* ------------------------------------------------------------------------- *)
14836(* Lemma 5                                                                   *)
14837(* ------------------------------------------------------------------------- *)
14838
14839(* lemma 5 (bij_corres):
14840    Let g, 'g are groups and f is a surjective group homomorphism from g to 'g.
14841    Let h be a subgroup of g contains the kernel of f, and let 'h be any subgroup of 'g,
14842    then f (PREIM f 'h) = 'h and PREIM f (f h) = h. *)
14843(* Proof:
14844   only need to prove f^{-1}(f(h)) is a subset of h,
14845   the other three follows from IMAGE_PREIMAGE, PREIMAGE_IMAGE, SURJ_IMAGE_PREIMAGE respectively.
14846
14847          f^{-1}(f(h)) SUBSET h
14848      <=> !x. x IN f^{-1}(f(h)) ==> x IN h                               by definition of set inclusion
14849      <=> !x. f(x) IN f(h) ==> x IN h                                    by definition of preimage
14850      <=> !x. f(x) IN 'g /\ ?x'. x' IN h /\ f(x') = f(x) ==> x IN h      by definition of image
14851     Note f(x'^{-1} * x) = f(x'^{-1}) * f(x)                             by definition of homomorphism
14852                         = f(x')^{-1} * f(x)                             by (previous thm)
14853                   = f(x)^{-1} * f(x)                                    substitute ``f(x')`` by ``f(x)``
14854                   = #e                                                  by definition of inverse
14855      so x'^{-1} * x IN k                                                by definition of kernel
14856      so x'^{-1} * x IN h                                                by definition of subset
14857      so ?y. y IN h /\ x'^{-1} * x = y                                   by definition of element
14858      so ?y. y IN h /\ x = x' * y                                        by left cancellation
14859      so x IN h                                                          by closure of group
14860*)
14861
14862
14863(* Theorem: Group g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier ==>
14864            IMAGE f (PREIMAGE f h.carrier INTER g1.carrier) = h.carrier *)
14865(* Proof: by SURJ_IMAGE_PREIMAGE *)
14866Theorem image_preimage_group:
14867    !f g1:'a group g2 h.
14868      Group g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier ==>
14869        IMAGE f (PREIMAGE f h.carrier INTER g1.carrier) = h.carrier
14870Proof
14871  rpt strip_tac >>
14872  `h.carrier SUBSET g2.carrier` by metis_tac[Subgroup_def] >>
14873  metis_tac[SURJ_IMAGE_PREIMAGE]
14874QED
14875
14876(* Theorem: Group g1 /\ Group g2 /\ h <= g1 /\ GroupHomo f g1 g2 ==>
14877            h.carrier SUBSET PREIMAGE f (IMAGE f h.carrier) INTER g1.carrier *)
14878(* Proof: by PREIMAGE_IMAGE *)
14879Theorem subset_preimage_image:
14880      !f g1:'a group g2 h. Group g1 /\ Group g2 /\ h <= g1 /\ GroupHomo f g1 g2 ==> h.carrier SUBSET PREIMAGE f (IMAGE f h.carrier) INTER g1.carrier
14881Proof
14882    rpt strip_tac >> `h.carrier SUBSET g1.carrier` by metis_tac[Subgroup_def] >> fs[PREIMAGE_IMAGE]
14883QED
14884
14885(* Theorem: Group g1 /\ Group g2 /\ h <= g1 /\ GroupHomo f g1 g2 /\
14886            SURJ f g1.carrier g2.carrier /\ kernel f g1 g2 SUBSET h.carrier ==>
14887            PREIMAGE f (IMAGE f h.carrier) INTER g1.carrier SUBSET h.carrier *)
14888(* Proof:
14889   By SUBSET_DEF, PREIMAGE_def, this is to show:
14890      (!x. x IN g1.carrier /\ f x = g2.id ==> x IN H) /\ h <= g1 /\
14891      x' IN H /\ x IN g1.carrier /\ f x = f x' ==> x IN H
14892
14893   Let y = g1.op x (g1.inv x').
14894   Note x' IN g1.carrier                 by subgroup_element
14895   Thus (g1.inv x') in g1.carrier        by group_inv_element
14896     or y IN g1.carrier                  by group_op_element
14897        f y
14898      = f (g1.op x (g1.inv x'))
14899      = g2.op (f x) f (g1.inv x')        by GroupHomo_def
14900      = g2.op (f x') f (g1.inv x')       by given, f x = f x'
14901      = f (g1.op x' (g1.inv x'))         by GroupHomo_def
14902      = f (g1.id)                        by group_rinv
14903      = g2.id                            by group_homo_id
14904   Thus y IN H                           by implication
14905    ==> h.op y x' IN H                   by group_op_element, h <= g1
14906    But h.op y x'
14907      = g1.op y x'                       by subgroup_op
14908      = g1.op (g1.op x (g1.inv x')) x'   by definition of y
14909      = g1.op x (g1.op (g1.inv x') x')   by group_assoc
14910      = g1.op x g1.id                    by group_linv
14911      = x                                by group_rid
14912     or x IN H
14913*)
14914Theorem preimage_image_subset:
14915      !f g1:'a group g2 h. Group g1 /\ Group g2 /\ h <= g1 /\ GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier /\ kernel f g1 g2 SUBSET h.carrier ==> PREIMAGE f (IMAGE f h.carrier) INTER g1.carrier SUBSET h.carrier
14916Proof
14917    rpt strip_tac >> fs[SUBSET_DEF] >> rpt strip_tac >> fs[PREIMAGE_def] >>
14918    `H SUBSET g1.carrier` by fs[Subgroup_def] >>
14919    `x' IN g1.carrier` by fs[SUBSET_DEF] >>
14920    `g1.op x (g1.inv x') IN g1.carrier` by fs[group_def_alt] >>
14921    `(f x) IN g2.carrier` by fs[GroupHomo_def] >>
14922    `(f x') IN g2.carrier` by fs[GroupHomo_def] >>
14923    `g2.inv (f x') = f (g1.inv x')` by rw_tac std_ss[group_homo_inv] >>
14924    `g2.op (f x) (g2.inv (f x)) = g2.id` by fs[group_div_cancel] >>
14925    `g2.op (f x) (g2.inv (f x')) = g2.id` by metis_tac[] >>
14926    `g2.op (f x) (g2.inv (f x')) = g2.op (f x) (f (g1.inv x'))` by metis_tac[] >>
14927    `_ = f (g1.op x (g1.inv x'))` by fs[GroupHomo_def] >>
14928    `g1.inv x' IN g1.carrier` by fs[group_inv_element] >>
14929    `g1.op x (g1.inv x') IN g1.carrier` by fs[group_def_alt] >>
14930    `f (g1.op x (g1.inv x')) = g2.id` by metis_tac[] >>
14931    `g1.op x (g1.inv x') IN H` by metis_tac[] >>
14932    `Group h` by metis_tac[Subgroup_def] >>
14933    `g1.inv x' = h.inv x'` by metis_tac[subgroup_inv] >>
14934    `g1.op x (g1.inv x') = h.op x (g1.inv x')` by metis_tac[Subgroup_def] >>
14935    `_ = h.op x (h.inv x')` by metis_tac[] >>
14936    `h.op (h.op x (h.inv x')) x' IN H` by metis_tac[group_def_alt] >>
14937    `h.op (h.op x (h.inv x')) x' = g1.op (g1.op x (h.inv x')) x'` by fs[Subgroup_def] >>
14938    `_ = g1.op (g1.op x (g1.inv x')) x'` by metis_tac[subgroup_inv] >>
14939    `_ = g1.op x (g1.op (g1.inv x') x')` by metis_tac[group_assoc] >>
14940    `g1.op (g1.inv x') x' = g1.id` by metis_tac[group_linv] >>
14941    `h.op (h.op x (h.inv x')) x' = g1.op x g1.id` by metis_tac[] >>
14942    `g1.op x g1.id = x` by metis_tac[group_id] >> metis_tac[]
14943QED
14944
14945(* Theorem: Group g1 /\ Group g2 /\ h1 <= g1 /\ h2 <= g2 /\ GroupHomo f g1 g2 /\
14946            SURJ f g1.carrier g2.carrier /\ kernel f g1 g2 SUBSET h1.carrier ==>
14947            IMAGE f (PREIMAGE f h2.carrier INTER g1.carrier) = h2.carrier /\
14948            PREIMAGE f (IMAGE f h1.carrier) INTER g1.carrier = h1.carrier *)
14949(* Proof:
14950   This is to show:
14951   (1) IMAGE f (PREIMAGE f h2.carrier INTER g1.carrier) = h2.carrier
14952       This is true                       by image_preimage_group
14953   (2) PREIMAGE f (IMAGE f h1.carrier) INTER g1.carrier = h1.carrier
14954       By SUBSET_ANTISYM, need to show:
14955       (1) PREIMAGE f (IMAGE f h1.carrier) INTER g1.carrier SUBSET h1.carrier
14956           This is true                   by preimage_image_subset
14957       (2) h1.carrier SUBSET PREIMAGE f (IMAGE f h1.carrier) INTER g1.carrier
14958           This is true                   by subset_preimage_image
14959*)
14960Theorem bij_corres:
14961  !f g1:'a group g2 h1 h2.
14962    Group g1 /\ Group g2 /\ h1 <= g1 /\ h2 <= g2 /\ GroupHomo f g1 g2 /\
14963    SURJ f g1.carrier g2.carrier /\ kernel f g1 g2 SUBSET h1.carrier ==>
14964    IMAGE f (PREIMAGE f h2.carrier INTER g1.carrier) = h2.carrier /\
14965    PREIMAGE f (IMAGE f h1.carrier) INTER g1.carrier = h1.carrier
14966Proof
14967  rpt strip_tac
14968  >- metis_tac[image_preimage_group] >>
14969  irule SUBSET_ANTISYM >> rpt conj_tac
14970  >- metis_tac[preimage_image_subset] >>
14971  metis_tac[subset_preimage_image]
14972QED
14973
14974(* This is Lemma 5 *)
14975
14976(* ------------------------------------------------------------------------- *)
14977(* Lemma 6                                                                   *)
14978(* ------------------------------------------------------------------------- *)
14979
14980(* lemma 6 (preimage_cardinality):
14981   If g, 'g are groups and f is a group homomorphism from g to 'g and 'h is a subgroup of 'g,
14982   then the cardinality of the preimage of 'h is
14983    the cardinality of 'h times the cardinality of the kernel of f. *)
14984(* Proof:
14985   Note f restrict to f^{-1}('h) is a group homomorphism
14986        from the group f^{-1}('h) to the group 'h. by previous thm
14987        (maybe we need to give another name to the restricted f, all in f'.)
14988   so k is also the kernel of f'.
14989   by the first isomorphism thm, Iso 'h f^{-1}('h) / k
14990   by iso_group_same_card, CARD 'h = CARD f^{-1}('h) / k
14991   by counting_formula, CARD f^{-1}('h) = CARD f^{-1}('h) / k * CARD k
14992   substitute CARD f^{-1}('h) by CARD 'h, the result follows.
14993*)
14994
14995(* Theorem: FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
14996            CARD (preimage_group f g1 g2 h.carrier).carrier =
14997              (CARD (kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier) *
14998               CARD (preimage_group f g1 g2 h.carrier /
14999                     kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier *)
15000(* Proof:
15001   Let t = preimage_group f g1 g2 h.carrier, k = kernel_group f t g2.
15002   Note Group g1             by finite_group_is_group
15003    and t <= g1              by preimage_subgroup_subgroup
15004    ==> GroupHomo f t g2     by Subgroup_homo_homo
15005   Also Group t              by preimage_group_group
15006   Thus k << t               by kernel_group_normal
15007    and FiniteGroup t        by finite_subgroup_finite_group
15008   Thus CARD t.carrier = (CARD k.carrier) * CARD (t / k).carrier
15009                             by count_formula
15010*)
15011Theorem homo_count_formula:
15012      !f g1 g2 h. FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==> CARD (preimage_group f g1 g2 h.carrier).carrier = (CARD (kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier) * CARD (preimage_group f g1 g2 h.carrier / kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier
15013Proof
15014    rpt strip_tac >>
15015    `Group g1` by metis_tac[finite_group_is_group] >>
15016    `preimage_group f g1 g2 h.carrier <= g1` by metis_tac[preimage_subgroup_subgroup] >>
15017    `GroupHomo f (preimage_group f g1 g2 h.carrier) g2` by metis_tac[Subgroup_homo_homo] >>
15018    `Group (preimage_group f g1 g2 h.carrier)` by metis_tac[preimage_group_group] >>
15019    `kernel_group f (preimage_group f g1 g2 h.carrier) g2 << (preimage_group f g1 g2 h.carrier)` by metis_tac[kernel_group_normal] >>
15020    `FiniteGroup (preimage_group f g1 g2 h.carrier)` by metis_tac[finite_subgroup_finite_group] >>
15021    metis_tac[count_formula]
15022QED
15023
15024(* Theorem: Group g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
15025            GroupIso (\z. coset (preimage_group f g1 g2 h.carrier)
15026                          (CHOICE (preimage f (preimage_group f g1 g2 h.carrier).carrier z))
15027                          (kernel f (preimage_group f g1 g2 h.carrier) g2))
15028               (homo_image f (preimage_group f g1 g2 h.carrier) g2)
15029               (preimage_group f g1 g2 h.carrier / kernel_group f (preimage_group f g1 g2 h.carrier) g2) *)
15030(* Proof:
15031   Note Group (preimage_group f g1 g2 h.carrier)             by preimage_group_group
15032    and (preimage_group f g1 g2 h.carrier) <= g1             by preimage_subgroup_subgroup
15033   also GroupHomo f (preimage_group f g1 g2 h.carrier) g2    by Subgroup_homo_homo
15034   The result follows                                        by group_first_isomorphism_thm
15035*)
15036Theorem image_iso_preimage_quotient:
15037      !f g1:'a group g2 h. Group g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
15038    GroupIso
15039         (λz.
15040             coset (preimage_group f g1 g2 h.carrier)
15041               (CHOICE
15042                  (preimage f (preimage_group f g1 g2 h.carrier).carrier
15043                     z))
15044               (kernel f (preimage_group f g1 g2 h.carrier) g2))
15045         (homo_image f (preimage_group f g1 g2 h.carrier) g2)
15046         (preimage_group f g1 g2 h.carrier /
15047          kernel_group f (preimage_group f g1 g2 h.carrier) g2)
15048Proof
15049    rpt strip_tac >>
15050    `Group (preimage_group f g1 g2 h.carrier)` by metis_tac[preimage_group_group] >>
15051    `(preimage_group f g1 g2 h.carrier) <= g1` by metis_tac[preimage_subgroup_subgroup] >>
15052    `GroupHomo f (preimage_group f g1 g2 h.carrier) g2` by metis_tac[Subgroup_homo_homo] >>
15053    imp_res_tac group_first_isomorphism_thm
15054QED
15055
15056(* Theorem: FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
15057            FINITE (homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier *)
15058(* Proof:
15059   Note FINITE g1.carrier                                  by FiniteGroup_def
15060   Thus FINITE (PREIMAGE f h.carrier INTER g1.carrier)     by FINITE_INTER
15061      = FINITE (preimage_group f g1 g2 h.carrier).carrier  by preimage_group_def
15062    ==> FINITE (IMAGE f (preimage_group f g1 g2 h.carrier).carrier)          by IMAGE_FINITE
15063      = FINITE (homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier  by homo_image_def
15064*)
15065Theorem finite_homo_image:
15066  !f g1:'a group g2 h.
15067    FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
15068    FINITE (homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier
15069Proof
15070  rpt strip_tac >>
15071  fs[homo_image_def] >>
15072  irule IMAGE_FINITE >>
15073  fs[preimage_group_def] >>
15074  irule FINITE_INTER >>
15075  metis_tac[FiniteGroup_def]
15076QED
15077
15078(* Theorem: FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
15079    CARD (homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier =
15080    CARD (preimage_group f g1 g2 h.carrier / kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier *)
15081(* Proof:
15082   Let map = \z. coset (preimage_group f g1 g2 h.carrier)
15083                 (CHOICE (preimage f (preimage_group f g1 g2 h.carrier).carrier z))
15084                 (kernel f (preimage_group f g1 g2 h.carrier) g2)
15085       t1 = homo_image f (preimage_group f g1 g2 h.carrier) g2
15086       t2 = preimage_group f g1 g2 h.carrier / kernel_group f (preimage_group f g1 g2 h.carrier) g2
15087   Then GroupIso map t1 t2                   by image_iso_preimage_quotient
15088   Note FINITE t1.carrier                    by finite_homo_image, FiniteGroup g1
15089   Thus CARD t1.carrier = CARD t2.carrier    by iso_group_same_card
15090*)
15091Theorem image_preimage_quotient_same_card:
15092  !f g1:'a group g2 h.
15093    FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 ==>
15094    CARD (homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier =
15095    CARD
15096      (preimage_group f g1 g2 h.carrier /
15097       kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier
15098Proof
15099  rpt strip_tac >>
15100  `Group g1` by metis_tac[finite_group_is_group] >>
15101  imp_res_tac image_iso_preimage_quotient >>
15102  `FINITE (homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier` by metis_tac[finite_homo_image] >>
15103  metis_tac[iso_group_same_card]
15104QED
15105
15106(* Theorem: H SUBSET g1.carrier /\
15107            GroupHomo f g1 g2 /\ (kernel f g1 g2) SUBSET H ==> kernel f g1 g2 = kernel f h g2 *)
15108(* Proof:
15109   By kernel_def, preimage_def, this is to show:
15110      {x | x IN g1.carrier /\ f x = g2.id} SUBSET H ==>
15111      {x | x IN g1.carrier /\ f x = g2.id} = {x | x IN H /\ f x = g2.id}
15112   Since each is the other's SUBSET, they are equal by SET_EQ_SUBSET.
15113*)
15114Theorem homo_restrict_same_kernel:
15115    !f g1:'a group g2 h:'a group. H SUBSET g1.carrier /\
15116          GroupHomo f g1 g2 /\ (kernel f g1 g2) SUBSET H ==> kernel f g1 g2 = kernel f h g2
15117Proof
15118  rpt strip_tac >>
15119  fs[kernel_def] >>
15120  fs[preimage_def] >>
15121  fs[SET_EQ_SUBSET] >>
15122  rpt strip_tac >-
15123  fs[SUBSET_DEF] >>
15124  fs[SUBSET_DEF]
15125QED
15126
15127(* Theorem: FiniteGroup g1 /\ Group g2 /\ h <= g2 /\
15128            GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier ==>
15129            CARD ((preimage_group f g1 g2 h.carrier).carrier) = CARD h.carrier * CARD (kernel f g1 g2) *)
15130(* Proof:
15131   Let t1 = preimage_group f g1 g2 h.carrier,
15132       t2 = kernel_group f t1 g2.
15133   Note Group g1                  by finite_group_is_group
15134        CARD t1.carrier
15135      = CARD t2.carrier * CARD ((t1 / t2).carrier)   by homo_count_formula
15136
15137   Let k = kernel f g1 g2.
15138   Then k SUBSET (PREIMAGE f h.carrier INTER g1.carrier)    by preimage_subgroup_kernel
15139    and k SUBSET t1.carrier                             by preimage_group_def
15140    and t1.carrier SUBSET g1.carrier                    by preimage_group_def
15141   Note t2.carrier
15142      = (kernel_group f t1).carrier                     by notation
15143      = kernel f t1 g2                                  by kernel_group_def
15144      = kernel f g1 g2 = k                              by homo_restrict_same_kernel
15145        CARD t1.carrier
15146      = CARD k * CARD ((t1 / t2.carrier))               by above
15147      = CARD k * CARD (homo_image f t1).carrier         by image_preimage_quotient_same_card
15148      = CARD k * CARD (IMAGE f t1.carrier)              by homo_image_def
15149      = CARD k * CARD (IMAGE f (PREIMAGE f h.carrier INTER g1.carrier)) by preimage_group_def
15150      = CARD k * CARD h.carrier                         by image_preimage_group
15151      = CARD h.carrier * CARD k                         by MULT_COMM
15152*)
15153Theorem preimage_cardinality:
15154      !f g1:'a group g2 h. FiniteGroup g1 /\ Group g2 /\ h <= g2 /\ GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier ==> CARD ((preimage_group f g1 g2 h.carrier).carrier) = CARD h.carrier * CARD (kernel f g1 g2)
15155Proof
15156    rpt strip_tac >>
15157    `Group g1` by fs[finite_group_is_group] >>
15158    `CARD (preimage_group f g1 g2 h.carrier).carrier = (CARD (kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier) * CARD (preimage_group f g1 g2 h.carrier / kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier` by metis_tac[homo_count_formula] >>
15159    `(kernel f g1 g2) SUBSET (PREIMAGE f h.carrier INTER g1.carrier)` by metis_tac[preimage_subgroup_kernel] >>
15160    `(kernel f g1 g2) SUBSET (preimage_group f g1 g2 h.carrier).carrier` by fs[preimage_group_def] >>
15161    `(preimage_group f g1 g2 h.carrier).carrier SUBSET g1.carrier` by fs[preimage_group_def] >>
15162    `kernel f (preimage_group f g1 g2 h.carrier) g2 = kernel f g1 g2` by fs[homo_restrict_same_kernel] >>
15163    `(kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier = kernel f (preimage_group f g1 g2 h.carrier) g2` by fs[kernel_group_def] >>
15164    ` _ = kernel f g1 g2` by rw[] >>
15165    ` CARD (preimage_group f g1 g2 h.carrier).carrier =
15166      CARD (kernel f g1 g2) *
15167      CARD (preimage_group f g1 g2 h.carrier /
15168            kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier` by rw[] >>
15169    `CARD (homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier =
15170     CARD (preimage_group f g1 g2 h.carrier / kernel_group f (preimage_group f g1 g2 h.carrier) g2).carrier` by fs[image_preimage_quotient_same_card] >>
15171    `CARD (preimage_group f g1 g2 h.carrier).carrier =
15172       CARD (kernel f g1 g2) * CARD (homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier` by rw[] >>
15173    `(homo_image f (preimage_group f g1 g2 h.carrier) g2).carrier = IMAGE f (preimage_group f g1 g2 h.carrier).carrier` by fs[homo_image_def] >>
15174    `_ = IMAGE f (PREIMAGE f h.carrier INTER g1.carrier)` by fs[preimage_group_def] >>
15175    `_ = h.carrier` by metis_tac[image_preimage_group] >>
15176    `CARD (preimage_group f g1 g2 h.carrier).carrier =
15177     CARD (kernel f g1 g2) * CARD h.carrier` by fs[] >>
15178    `CARD (kernel f g1 g2) * CARD h.carrier = CARD h.carrier * CARD (kernel f g1 g2)` by metis_tac[MULT_COMM] >>
15179    metis_tac[]
15180QED
15181
15182(* This is Lemma 6 *)
15183
15184(* ------------------------------------------------------------------------- *)
15185(* Correspondence Theorem                                                    *)
15186(* ------------------------------------------------------------------------- *)
15187
15188(* Theorem:
15189   Let f be a surjective group homomorphism from group g to group 'g with kernel k.
15190   There is a bijective correspondence between subgroups of 'g and subgroups of g that contains k.
15191   The correspondence is defined as follows:
15192   a subgroup h of g that contains k |-> its image f h in 'g,
15193   a subgroup 'h of 'g |-> its inverse image f^{-1} 'h in g.
15194   If h and 'h are corresponding subgroups, then h is normal in g iff 'h is normal in 'g.
15195   If h and 'h are corresponding subgroups, then | h | = | 'h | | k |.
15196*)
15197
15198(* Theorem: Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier /\
15199            h1 <= g1 /\ (kernel f g1 g2) SUBSET h1.carrier /\ h2 <= g2 ==>
15200            homo_image f h1 g2 <= g2 /\
15201            preimage_group f g1 g2 h2.carrier <= g1 /\
15202            (kernel f g1 g2) SUBSET (PREIMAGE f h2.carrier) INTER g1.carrier /\
15203            (h2 << g2 <=> (preimage_group f g1 g2 h2.carrier) << g1) /\
15204            IMAGE f (PREIMAGE f h2.carrier INTER g1.carrier) = h2.carrier /\
15205            PREIMAGE f (IMAGE f h1.carrier) INTER g1.carrier = h1.carrier /\
15206            (FiniteGroup g1 ==>
15207              CARD (preimage_group f g1 g2 h2.carrier).carrier = CARD h2.carrier * CARD (kernel f g1 g2)) *)
15208(* Proof:
15209   Directly by lemma 1, 2, 3 and 4.
15210   Specifically, to show:
15211   (1) homo_image f h1 g2 <= g2, true                 by image_subgroup_subgroup
15212   (2) preimage_group f g1 g2 h2.carrier <= g1, true  by preimage_subgroup_subgroup
15213   (3) kernel f g1 g2 SUBSET PREIMAGE f h2.carrier INTER g1.carrier
15214       This is true                                   by preimage_subgroup_kernel
15215   (4) h2 << g2 <=> preimage_group f g1 g2 h2.carrier << g1
15216       This is true                                   by normal_iff_preimage_normal
15217   (5) IMAGE f (PREIMAGE f h2.carrier INTER g1.carrier) = h2.carrier
15218       This is true                                   by bij_corres
15219   (6) PREIMAGE f (IMAGE f h1.carrier) INTER g1.carrier = h1.carrier
15220       This is true                                   by bij_corres
15221   (7) CARD (preimage_group f g1 g2 h2.carrier).carrier =
15222       CARD h2.carrier * CARD (kernel f g1 g2)
15223       This is true                                   by preimage_cardinality
15224*)
15225Theorem corres_thm:
15226     !f g1:'a group g2:'b group h1 h2.
15227   Group g1 /\ Group g2 /\ GroupHomo f g1 g2 /\ SURJ f g1.carrier g2.carrier /\
15228   h1 <= g1 /\ (kernel f g1 g2) SUBSET h1.carrier /\ h2 <= g2 ==>
15229   homo_image f h1 g2 <= g2 /\
15230   preimage_group f g1 g2 h2.carrier <= g1 /\
15231   (kernel f g1 g2) SUBSET (PREIMAGE f h2.carrier) INTER g1.carrier /\
15232   (h2 << g2 <=> (preimage_group f g1 g2 h2.carrier) << g1) /\
15233   IMAGE f (PREIMAGE f h2.carrier INTER g1.carrier) = h2.carrier /\
15234   PREIMAGE f (IMAGE f h1.carrier) INTER g1.carrier = h1.carrier /\
15235   (FiniteGroup g1 ==> CARD (preimage_group f g1 g2 h2.carrier).carrier =
15236                       CARD h2.carrier * CARD (kernel f g1 g2))
15237Proof
15238   rpt strip_tac >-
15239   metis_tac[image_subgroup_subgroup] >- metis_tac[preimage_subgroup_subgroup] >-
15240   metis_tac[preimage_subgroup_kernel] >- metis_tac[normal_iff_preimage_normal] >-
15241   metis_tac[bij_corres] >- metis_tac[bij_corres] >- metis_tac[preimage_cardinality]
15242QED
15243
15244(* ------------------------------------------------------------------------- *)
15245(* Congruences Documentation                                                 *)
15246(* ------------------------------------------------------------------------- *)
15247
15248(* Purpose:
15249   subgroupTheory has finite_abelian_Fermat
15250   groupInstancesTheory has Z_star and mult_mod
15251   For Z_star p, show that MOD_MUL_INV can be evaluted by Fermat's Little Theorem.
15252   For mult_mod p, show that MOD_MULT_INV can be evaluted by Fermat's Little Theorem.
15253*)
15254
15255(* Definitions and Theorems (# are exported):
15256
15257   Fermat's Little Theorem:
15258   fermat_little      |- !p a. prime p /\ 0 < a /\ a < p ==> (a ** (p - 1) MOD p = 1)
15259   fermat_little_alt  |- !p a. prime p ==> (a ** (p - 1) MOD p = if a MOD p = 0 then 0 else 1)
15260   fermat_little_thm  |- !p. prime p ==> !a. a ** p MOD p = a MOD p
15261   fermat_roots       |- !p. prime p ==> !x y z. (x ** p + y ** p = z ** p) ==> ((x + y) MOD p = z MOD p)
15262
15263   Multiplicative Inverse by Fermat's Little Theorem:
15264   Zstar_inverse          |- !p. prime p ==> !a. 0 < a /\ a < p ==> ((Zstar p).inv a = a ** (p - 2) MOD p)
15265   Zstar_inverse_compute  |- !p a. (Zstar p).inv a =
15266                             if prime p /\ 0 < a /\ a < p then a ** (p - 2) MOD p else (Zstar p).inv a
15267   PRIME_2    |- prime 2
15268   PRIME_3    |- prime 3
15269   PRIME_5    |- prime 5
15270   PRIME_7    |- prime 7
15271   mult_mod_inverse          |- !p. prime p ==>
15272                                !a. 0 < a /\ a < p ==> ((mult_mod p).inv a = a ** (p - 2) MOD p)
15273   mult_mod_inverse_compute  |- !p a. (mult_mod p).inv a =
15274                                if prime p /\ 0 < a /\ a < p then a ** (p - 2) MOD p else (mult_mod p).inv a
15275*)
15276
15277(* ------------------------------------------------------------------------- *)
15278(* Fermat's Little Theorem (by Zp finite abelian group)                      *)
15279(* ------------------------------------------------------------------------- *)
15280
15281(* Theorem: For prime p, 0 < a < p,  a**(p-1) = 1 (mod p) *)
15282(* Proof:
15283   Since 0 < a < p, a IN (Zstar p).carrier,
15284   and (Zstar p) is a FiniteAbelian Group, by Zstar_finite_abelian_group
15285   and CARD (Zstar p).carrier = (p-1)      by Zstar_property.
15286   this follows by finite_abelian_Fermat and Zstar_exp, which relates group_exp to EXP.
15287
15288> finite_abelian_Fermat |> ISPEC ``(Zstar p)``;
15289val it = |- !a. FiniteAbelianGroup (Zstar p) /\ a IN (Zstar p).carrier ==>
15290                ((Zstar p).exp a (CARD (Zstar p).carrier) = (Zstar p).id): thm
15291*)
15292Theorem fermat_little:
15293    !p a. prime p /\ 0 < a /\ a < p ==> (a ** (p - 1) MOD p = 1)
15294Proof
15295  rpt strip_tac >>
15296  `FiniteAbelianGroup (Zstar p)` by rw_tac std_ss[Zstar_finite_abelian_group] >>
15297  `a IN (Zstar p).carrier /\ ((Zstar p).id = 1)` by rw[Zstar_def, residue_def] >>
15298  `CARD (Zstar p).carrier = p - 1` by rw_tac std_ss[PRIME_POS, Zstar_property] >>
15299  metis_tac[finite_abelian_Fermat, Zstar_exp]
15300QED
15301
15302(* Theorem: Fermat's Little Theorem for all a: (a**(p-1) MOD p = if (a MOD p = 0) then 0 else 1  when p is prime. *)
15303(* Proof: by cases of a, and restricted Fermat's Little Theorem. *)
15304Theorem fermat_little_alt:
15305    !p a. prime p ==> (a**(p-1) MOD p = if (a MOD p = 0) then 0 else 1)
15306Proof
15307  rpt strip_tac >>
15308  `0 < p /\ 1 < p` by rw_tac std_ss[PRIME_POS, ONE_LT_PRIME] >>
15309  `a ** (p-1) MOD p = (a MOD p) ** (p-1) MOD p` by metis_tac[EXP_MOD] >>
15310  rw_tac std_ss[] >| [
15311    `0 < (p - 1)` by decide_tac >>
15312    `?k. (p - 1) = SUC k` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO] >>
15313    rw[EXP],
15314    `0 < a MOD p` by decide_tac >>
15315    `a MOD p < p` by rw[MOD_LESS] >>
15316    metis_tac[fermat_little]
15317  ]
15318QED
15319
15320(* Theorem: For prime p, a**p = a (mod p) *)
15321(* Proof: by fermat_little. *)
15322Theorem fermat_little_thm:
15323    !p. prime p ==> !a. a ** p MOD p = a MOD p
15324Proof
15325  rpt strip_tac >>
15326  `0 < p` by rw_tac std_ss[PRIME_POS] >>
15327  `a ** p MOD p = (a MOD p) ** p MOD p` by rw_tac std_ss[MOD_EXP] >>
15328  Cases_on `a MOD p = 0` >-
15329  metis_tac[ZERO_MOD, ZERO_EXP, NOT_ZERO_LT_ZERO] >>
15330  `0 < a MOD p` by decide_tac >>
15331  `a MOD p < p` by rw_tac std_ss[MOD_LESS] >>
15332  `p = SUC (p-1)` by decide_tac >>
15333  `(a MOD p) ** p MOD p = ((a MOD p) * (a MOD p) ** (p-1)) MOD p`
15334    by metis_tac[EXP] >>
15335  `_ = ((a MOD p) * ((a MOD p) ** (p-1) MOD p)) MOD p`
15336    by metis_tac[MOD_TIMES2, MOD_MOD] >>
15337  `_ = ((a MOD p) * 1) MOD p` by rw_tac std_ss[fermat_little] >>
15338  `_ = a MOD p` by rw_tac std_ss[MULT_RIGHT_1, MOD_MOD] >>
15339  rw_tac std_ss[]
15340QED
15341
15342(* Theorem: For prime p > 2, x ** p + y ** p = z ** p ==> x + y = z (mod p) *)
15343(* Proof:
15344        x ** p + y ** p = z ** p
15345   ==>  x ** p + y ** p = z ** p   mod p
15346   ==>       x +      y = z        mod p   by Fermat's Little Theorem.
15347*)
15348Theorem fermat_roots:
15349    !p. prime p ==> !x y z. (x ** p + y ** p = z ** p) ==> ((x + y) MOD p = z MOD p)
15350Proof
15351  rpt strip_tac >>
15352  `0 < p` by rw_tac std_ss[PRIME_POS] >>
15353  `z ** p MOD p = (x ** p + y ** p) MOD p` by rw_tac std_ss[] >>
15354  `_ = (x ** p MOD p + y ** p MOD p) MOD p` by metis_tac[MOD_PLUS] >>
15355  `_ = (x MOD p + y MOD p) MOD p` by rw_tac std_ss[fermat_little_thm] >>
15356  `_ = (x + y) MOD p` by rw_tac std_ss[MOD_PLUS] >>
15357  metis_tac[fermat_little_thm]
15358QED
15359
15360(* ------------------------------------------------------------------------- *)
15361(* Multiplicative Inverse by Fermat's Little Theorem                         *)
15362(* ------------------------------------------------------------------------- *)
15363
15364(* There is already:
15365- Zstar_inv;
15366> val it = |- !p. prime p ==> !x. 0 < x /\ x < p ==> ((Zstar p).inv x = (Zstar p).exp x (order (Zstar p) x - 1)) : thm
15367*)
15368
15369(* Theorem: For prime p, (Zstar p).inv a = a**(p-2) MOD p *)
15370(* Proof:
15371   a * (a ** (p-2) MOD p = a**(p-1) MOD p = 1   by  fermat_little.
15372   Hence (a ** (p-2) MOD p) is the multiplicative inverse by group_rinv_unique.
15373*)
15374Theorem Zstar_inverse:
15375    !p. prime p ==> !a. 0 < a /\ a < p ==> ((Zstar p).inv a = (a**(p-2)) MOD p)
15376Proof
15377  rpt strip_tac >>
15378  `a IN (Zstar p).carrier` by rw_tac std_ss[Zstar_element] >>
15379  `Group (Zstar p)` by rw_tac std_ss[Zstar_group] >>
15380  `(Zstar p).id = 1` by rw_tac std_ss[Zstar_property] >>
15381  `(Zstar p).exp a (p-2) = a**(p-2) MOD p` by rw_tac std_ss[Zstar_exp] >>
15382  `0 < p` by decide_tac >>
15383  `SUC (p-2) = p - 1` by decide_tac >>
15384  `(Zstar p).op a (a**(p-2) MOD p) = (a * (a**(p-2) MOD p)) MOD p` by rw_tac std_ss[Zstar_property] >>
15385  `_ = ((a MOD p) * (a**(p-2) MOD p)) MOD p` by rw_tac std_ss[LESS_MOD] >>
15386  `_ = (a * a**(p-2)) MOD p` by rw_tac std_ss[MOD_TIMES2] >>
15387  `_ = a ** (p-1) MOD p` by metis_tac[EXP] >>
15388  `_ = 1` by rw_tac std_ss[fermat_little] >>
15389  metis_tac[group_rinv_unique, group_exp_element]
15390QED
15391
15392(* Theorem: As function, for prime p, (Zstar p).inv a = a**(p-2) MOD p *)
15393(* Proof: by Zstar_inverse. *)
15394Theorem Zstar_inverse_compute:
15395    !p a. (Zstar p).inv a =
15396          if (prime p /\ 0 < a /\ a < p) then (a**(p-2) MOD p) else ((Zstar p).inv a)
15397Proof
15398  rw_tac std_ss[Zstar_inverse]
15399QED
15400
15401(* Theorem: 2 is prime. *)
15402(* Proof: by definition of prime. *)
15403Theorem PRIME_2:
15404    prime 2
15405Proof
15406  rw_tac std_ss  [prime_def] >>
15407  `0 < 2` by decide_tac >>
15408  `0 < b /\ b <= 2` by metis_tac[DIVIDES_LE, ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
15409  rw_tac arith_ss []
15410QED
15411
15412(* Theorem: 3 is prime. *)
15413(* Proof: by definition of prime. *)
15414Theorem PRIME_3:
15415    prime 3
15416Proof
15417  rw_tac std_ss[prime_def] >>
15418  `b <= 3` by rw_tac std_ss[DIVIDES_LE] >>
15419  `(b=0) \/ (b=1) \/ (b=2) \/ (b=3)` by decide_tac >-
15420  fs[] >-
15421  fs[] >-
15422  full_simp_tac arith_ss [divides_def] >>
15423  metis_tac[]
15424QED
15425
15426(* Theorem: 5 is prime. *)
15427(* Proof: by definition of prime. *)
15428Theorem PRIME_5:
15429    prime 5
15430Proof
15431  rw_tac std_ss[prime_def] >>
15432  `0 < 5` by decide_tac >>
15433  `0 < b /\ b <= 5` by metis_tac[DIVIDES_LE, ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
15434  `(b = 1) \/ (b = 2) \/ (b = 3) \/ (b = 4) \/ (b = 5)` by decide_tac >-
15435  rw_tac std_ss[] >-
15436  full_simp_tac arith_ss [divides_def] >-
15437  full_simp_tac arith_ss [divides_def] >-
15438  full_simp_tac arith_ss [divides_def] >>
15439  rw_tac std_ss[]
15440QED
15441
15442(* Theorem: 7 is prime. *)
15443(* Proof: by definition of prime. *)
15444Theorem PRIME_7:
15445    prime 7
15446Proof
15447  rw_tac std_ss[prime_def] >>
15448  `0 < 7` by decide_tac >>
15449  `0 < b /\ b <= 7` by metis_tac[DIVIDES_LE, ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
15450  `(b = 1) \/ (b = 2) \/ (b = 3) \/ (b = 4) \/ (b = 5) \/ (b = 6) \/ (b = 7)` by decide_tac >-
15451  rw_tac std_ss[] >-
15452  full_simp_tac arith_ss [divides_def] >-
15453  full_simp_tac arith_ss [divides_def] >-
15454  full_simp_tac arith_ss [divides_def] >-
15455  full_simp_tac arith_ss [divides_def] >-
15456  full_simp_tac arith_ss [divides_def] >>
15457  rw_tac std_ss[]
15458QED
15459
15460(* These computation uses Zstar_inv_compute of groupInstances.
15461
15462- val _ = computeLib.add_persistent_funs ["PRIME_5"];
15463- EVAL ``prime 5``;
15464> val it = |- prime 5 <=> T : thm
15465- EVAL ``(Zstar 5).inv 2``;
15466> val it = |- (Zstar 5).inv 2 = 3 : thm
15467- EVAL ``(Zstar 5).id``;
15468> val it = |- (Zstar 5).id = 1 : thm
15469- EVAL ``(Zstar 5).op 2 3``;
15470> val it = |- (Zstar 5).op 2 3 = 1 : thm
15471- EVAL ``(Zstar 5).inv 2``;
15472> val it = |- (Zstar 5).inv 2 = 3 : thm
15473- EVAL ``(Zstar 5).inv 3``;
15474> val it = |- (Zstar 5).inv 3 = 2 : thm
15475*)
15476
15477
15478(*
15479val th = mk_thm([], ``MOD_MULT_INV 7 x = (x ** 5) MOD 7``);
15480val _ = save_thm("th", th);
15481val _ = computeLib.add_persistent_funs ["th"];
15482
15483val _ = computeLib.add_persistent_funs [("Zstar5_inv", Zstar5_inv)];
15484EVAL ``(Zstar 5).op 2 3``;
15485> val it = |- (Zstar 5).op 2 3 = 1 : thm
15486EVAL ``(Zstar 5).inv 2``;
15487> val it = |- (Zstar 5).inv 2 = MOD_MUL_INV 5 2 : thm  (before)
15488> val it = |- (Zstar 5).inv 2 = 3 : thm
15489*)
15490
15491
15492(* There is already this in groupInstancesTheory:
15493
15494- mult_mod_inv;
15495> val it = |- !p. prime p ==> !x. 0 < x /\ x < p ==> ((mult_mod p).inv x = (mult_mod p).exp x (order (mult_mod p) x - 1)) : thm
15496*)
15497
15498(* Theorem: For prime p, (mult_mod p).inv a = a**(p-2) MOD p *)
15499(* Proof:
15500   a * (a ** (p-2) MOD p = a**(p-1) MOD p = 1   by  fermat_little.
15501   Hence (a ** (p-2) MOD p) is the multiplicative inverse by group_rinv_unique.
15502*)
15503Theorem mult_mod_inverse:
15504    !p. prime p ==> !a. 0 < a /\ a < p ==> ((mult_mod p).inv a = (a**(p-2)) MOD p)
15505Proof
15506  rpt strip_tac >>
15507  `a IN (mult_mod p).carrier` by rw_tac std_ss[mult_mod_property] >>
15508  `Group (mult_mod p)` by rw_tac std_ss[mult_mod_group] >>
15509  `(mult_mod p).exp a (p-2) = (a**(p-2) MOD p)` by rw_tac std_ss[mult_mod_exp] >>
15510  `0 < p /\ 1 < p` by rw_tac std_ss[PRIME_POS, ONE_LT_PRIME] >>
15511  `SUC (p-2) = p - 1` by decide_tac >>
15512  `(mult_mod p).exp a (p-2) IN (mult_mod p).carrier` by rw_tac std_ss[group_exp_element] >>
15513  `(mult_mod p).op a (a**(p-2) MOD p) = (a * (a**(p-2) MOD p)) MOD p` by rw_tac std_ss[mult_mod_property] >>
15514  `_ = (a * a**(p-2)) MOD p` by metis_tac[MOD_TIMES2, MOD_MOD] >>
15515  `_ = a ** (p-1) MOD p` by metis_tac[EXP] >>
15516  `_ = 1` by rw_tac std_ss[fermat_little] >>
15517  metis_tac[group_rinv_unique, mult_mod_property]
15518QED
15519
15520(* Theorem: As function, for prime p, (mult_mod p).inv a = a**(p-2) MOD p *)
15521(* Proof: by mult_mod_inverse. *)
15522Theorem mult_mod_inverse_compute:
15523    !p a. (mult_mod p).inv a =
15524          if (prime p /\ 0 < a /\ a < p) then (a**(p-2) MOD p) else (mult_mod p).inv a
15525Proof
15526  rw_tac std_ss[mult_mod_inverse]
15527QED
15528
15529(* These computation uses mult_mod_inv_compute of groupInstances.
15530
15531- val _ = computeLib.add_persistent_funs ["PRIME_7"];
15532- EVAL ``prime 7``;
15533> val it = |- prime 7 <=> T : thm
15534- EVAL ``(mult_mod 7).id``;
15535> val it = |- (mult_mod 7).id = 1 : thm
15536- EVAL ``(mult_mod 7).op 5 3``;
15537> val it = |- (mult_mod 7).op 5 3 = 1 : thm
15538- EVAL ``(mult_mod 7).inv 5``;
15539> val it = |- (mult_mod 7).inv 5 = 3 : thm
15540- EVAL ``(mult_mod 7).inv 3``;
15541> val it = |- (mult_mod 7).inv 3 = 5 : thm
15542*)
15543
15544(* ------------------------------------------------------------------------- *)