ringScript.sml

1(* ------------------------------------------------------------------------- *)
2(* Ring Library                                                              *)
3(*                                                                           *)
4(* A ring takes into account the interplay between its additive group and    *)
5(* multiplicative monoid.                                                    *)
6(* ------------------------------------------------------------------------- *)
7(* Ring Theory                                                               *)
8(* Units in a Ring                                                           *)
9(* Ring Maps                                                                 *)
10(* Ideals in Ring                                                            *)
11(* Binomial coefficients and expansion, for Ring                             *)
12(* Divisibility in Ring                                                      *)
13(* Ring Theory -- Ideal and Quotient Ring.                                   *)
14(* Applying Ring Theory: Ring Instances                                      *)
15(* Integers as a Ring                                                        *)
16(* Integral Domain Theory                                                   *)
17(* Applying Integral Domain Theory: Integral Domain Instances                *)
18(* ------------------------------------------------------------------------- *)
19(* (Joseph) Hing-Lun Chan, The Australian National University, 2014-2019     *)
20(* ------------------------------------------------------------------------- *)
21
22(*
23Ring Theory
24============
25HOL source has:
26src\ring\src\ringScript.sml
27src\ring\src\ringNormScript.sml
28src\ring\src\semi_ringScript.sml
29src\ring\src\numRingScript.sml
30src\integer\integerRingScript.sml
31src\rational\ratRingScript.sml
32*)
33(*===========================================================================*)
34
35Theory ring
36Ancestors
37  prim_rec arithmetic divides gcd gcdset pred_set list bag
38  container While sorting integer number combinatorics prime
39  monoid group
40Libs
41  jcLib dep_rewrite
42
43(* val _ = load "jcLib"; *)
44val _ = intLib.deprecate_int ();
45
46(* ------------------------------------------------------------------------- *)
47(* Ring Documentation                                                       *)
48(* ------------------------------------------------------------------------- *)
49(* Data type:
50   The generic symbol for ring data is r.
51   r.carrier = Carrier set of Ring, overloaded as R.
52   r.sum     = Addition component of Ring, binary operation overloaded as +.
53   r.prod    = Multiplication component of Ring, binary operation overloaded as *.
54
55   Overloading:
56   +   = r.sum.op
57   #0  = r.sum.id
58   ##  = r.sum.exp
59   -   = r.sum.inv
60   *   = r.prod.op
61   #1  = r.prod.id
62   **  = r.prod.exp
63
64   R   = r.carrier
65   R+  = ring_nonzero r
66   r*  = Invertibles r.prod
67   R*  = r*.carrier
68   f*  = (r.prod excluding #0)
69   F*  = f*.carrier
70*)
71(* Definitions and Theorems (# are exported):
72
73   Definitions:
74   Ring_def        |- !r. Ring r <=> AbelianGroup r.sum /\ AbelianMonoid r.prod /\
75                                     (r.sum.carrier = R) /\ (r.prod.carrier = R) /\
76                                     !x y z. x IN R /\ y IN R /\ z IN R ==> (x * (y + z) = x * y + x * z)
77   FiniteRing_def  |- !r. FiniteRing r <=> Ring r /\ FINITE R
78
79   Simple theorems:
80#  ring_carriers                   |- !r. Ring r ==> (r.sum.carrier = R) /\ (r.prod.carrier = R)
81   ring_add_group                  |- !r. Ring r ==> Group r.sum /\ (r.sum.carrier = R) /\
82                                      !x y. x IN R /\ y IN R ==> (x + y = y + x)
83#  ring_add_group_rwt              |- !r. Ring r ==> Group r.sum /\ (r.sum.carrier = R)
84   ring_add_abelian_group          |- !r. Ring r ==> AbelianGroup r.sum
85   ring_mult_monoid                |- !r. Ring r ==> Monoid r.prod /\ (r.prod.carrier = R) /\
86                                      !x y. x IN R /\ y IN R ==> (x * y = y * x)
87#  ring_mult_monoid_rwt            |- !r. Ring r ==> Monoid r.prod /\ (r.prod.carrier = R)
88   ring_mult_abelian_monoid        |- !r. Ring r ==> AbelianMonoid r.prod
89   finite_ring_add_finite_group    |- !r. FiniteRing r ==> FiniteGroup r.sum /\ (r.sum.carrier = R)
90   finite_ring_add_finite_abelian_group
91                                   |- !r. FiniteRing r ==> FiniteAbelianGroup r.sum /\ (r.sum.carrier = R)
92   finite_ring_mult_finite_monoid  |- !r. FiniteRing r ==> FiniteMonoid r.prod
93   finite_ring_mult_finite_abelian_monoid
94                                   |- !r. FiniteRing r ==> FiniteAbelianMonoid r.prod
95
96   Lifting Theorems:
97#  ring_zero_element     |- !r. Ring r ==> #0 IN R
98#  ring_one_element      |- !r. Ring r ==> #1 IN R
99   ring_carrier_nonempty |- !r. Ring r ==> R <> {}
100
101   Ring Addition Theorems from Group (r.sum):
102#  ring_add_element    |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> x + y IN R
103   ring_add_assoc      |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x + y + z = x + (y + z))
104   ring_add_comm       |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (x + y = y + x)
105   ring_add_assoc_comm |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x + (y + z) = y + (x + z))
106#  ring_add_zero_zero  |- !r. Ring r ==> (#0 + #0 = #0)
107#  ring_add_lzero      |- !r. Ring r ==> !x. x IN R ==> (#0 + x = x)
108#  ring_add_rzero      |- !r. Ring r ==> !x. x IN R ==> (x + #0 = x)
109   ring_zero_unique    |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
110                          ((y + x = x) <=> (y = #0)) /\ ((x + y = x) <=> (y = #0))
111
112   Ring Multiplication Theorems from Monoid (r.prod):
113#  ring_mult_element    |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> x * y IN R
114   ring_mult_assoc      |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x * y * z = x * (y * z))
115   ring_mult_comm       |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (x * y = y * x)
116   ring_mult_assoc_comm |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x * (y * z) = y * (x * z))
117#  ring_mult_rzero      |- !r. Ring r ==> !x. x IN R ==> (x * #0 = #0)
118#  ring_mult_lzero      |- !r. Ring r ==> !x. x IN R ==> (#0 * x = #0)
119#  ring_mult_zero_zero  |- !r. Ring r ==> (#0 * #0 = #0)
120#  ring_mult_one_one    |- !r. Ring r ==> (#1 * #1 = #1)
121#  ring_mult_lone       |- !r. Ring r ==> !x. x IN R ==> (#1 * x = x)
122#  ring_mult_rone       |- !r. Ring r ==> !x. x IN R ==> (x * #1 = x)
123   ring_one_unique      |- !r. Ring r ==> !y. y IN R ==>
124                           ((!x. x IN R ==> (y * x = x) \/ (x * y = x)) <=> (y = #1))
125   ring_one_eq_zero     |- !r. Ring r ==> ((#1 = #0) <=> (R = {#0}))
126
127   Ring Numerical Theorems (from group_exp of ring_add_group):
128#  ring_num_element      |- !r. Ring r ==> !n. ##n IN R
129#  ring_num_mult_element |- !r. Ring r ==> !x. x IN R ==> !n. ##n * x IN R
130#  ring_num_SUC          |- !r n. Ring r ==> (##(SUC n) = #1 + ##n)
131   ring_num_suc          |- !r. Ring r ==> !n. ##(SUC n) = ##n + #1
132#  ring_num_0            |- !r. ##0 = #0
133   ring_num_one          |- !r. ##1 = #1 + #0
134#  ring_num_1            |- !r. Ring r ==> (##1 = #1)
135   ring_num_2            |- !r. Ring r ==> (##2 = #1 + #1)
136   ring_sum_zero         |- !r. Ring r ==> !n. r.sum.exp #0 n = #0
137   ring_num_all_zero     |- !r. Ring r ==> (#1 = #0) ==> !c. ##c = #0
138
139   Ring Exponent Theorems (from monoid_exp of ring_mult_monoid):
140#  ring_exp_element      |- !r. Ring r ==> !x. x IN R ==> !n. x ** n IN R
141#  ring_exp_0            |- !x. x ** 0 = #1
142#  ring_exp_SUC          |- !x n. x ** SUC n = x * x ** n
143   ring_exp_suc          |- !r. Ring r ==> !x. x IN R ==> !n. x ** SUC n = x ** n * x
144#  ring_exp_1            |- !r. Ring r ==> !x. x IN R ==> (x ** 1 = x)
145   ring_exp_comm         |- !r. Ring r ==> !x. x IN R ==> !n. x ** n * x = x * x ** n
146#  ring_mult_exp         |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> !n. (x * y) ** n = x ** n * y ** n
147   ring_exp_small        |- !r. Ring r ==> !x. x IN R ==>
148                            (x ** 0 = #1) /\ (x ** 1 = x) /\ (x ** 2 = x * x) /\
149                            (x ** 3 = x * x ** 2) /\ (x ** 4 = x * x ** 3) /\
150                            (x ** 5 = x * x ** 4) /\ (x ** 6 = x * x ** 5) /\
151                            (x ** 7 = x * x ** 6) /\ (x ** 8 = x * x ** 7) /\
152                            (x ** 9 = x * x ** 8)
153
154   Ring Distribution Theorems:
155#  ring_mult_radd        |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==>
156                            (x * (y + z) = x * y + x * z)
157#  ring_mult_ladd        |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==>
158                            ((y + z) * x = y * x + z * x)
159   ring_mult_add         |- !r. Ring r ==> !z y x. x IN R /\ y IN R /\ z IN R ==>
160                                           (x * (y + z) = x * y + x * z) /\ ((y + z) * x = y * x + z * x)
161   ring_num_mult_suc     |- !r. Ring r ==> !x. x IN R ==> !n. ##(SUC n) * x = ##n * x + x
162   ring_num_mult_small   |- !r. Ring r ==> !x. x IN R ==>
163                                           (#0 * x = #0) /\ (#1 * x = x) /\
164                                           (##2 * x = x + x) /\ (##3 * x = ##2 * x + x)
165
166   Ring Negation Theorems:
167#  ring_neg_element     |- !r. Ring r ==> !x. x IN R ==> -x IN R
168#  ring_neg_zero        |- !r. Ring r ==> (-#0 = #0)
169#  ring_add_lneg        |- !r. Ring r ==> !x. x IN R ==> (-x + x = #0)
170#  ring_add_rneg        |- !r. Ring r ==> !x. x IN R ==> (x + -x = #0)
171   ring_add_lneg_assoc  |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (y = x + (-x + y)) /\ (y = -x + (x + y))
172   ring_add_rneg_assoc  |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (y = y + -x + x) /\ (y = y + x + -x)
173   ring_add_lcancel     |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x + y = x + z) <=> (y = z))
174   ring_add_rcancel     |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((y + x = z + x) <=> (y = z))
175   ring_zero_fix        |- !r. Ring r ==> !x. x IN R ==> ((x + x = x) <=> (x = #0))
176#  ring_neg_neg         |- !r. Ring r ==> !x. x IN R ==> (--x = x)
177   ring_neg_eq_zero     |- !r. Ring r ==> !x. x IN R ==> ((-x = #0) <=> (x = #0))
178   ring_neg_eq          |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> ((-x = -y) <=> (x = y))
179   ring_neg_eq_swap     |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> ((-x = y) <=> (x = -y))
180   ring_add_eq_zero     |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> ((x + y = #0) <=> (y = -x))
181   ring_neg_add_comm    |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (-(x + y) = -y + -x)
182#  ring_neg_add         |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (-(x + y) = -x + -y)
183
184   Ring Distribution Theorems with Negation:
185#  ring_mult_lneg       |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (-x * y = -(x * y))
186#  ring_mult_rneg       |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (x * -y = -(x * y))
187#  ring_neg_mult        |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
188                           (-(x * y) = -x * y) /\ (-(x * y) = x * -y)
189#  ring_mult_neg_neg    |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (-x * -y = x * y)
190
191   More Ring Numeral Theorems (involving distribution eventually):
192   ring_num_add         |- !r. Ring r ==> !n k. ##(n + k) = ##n + ##k
193   ring_num_add_assoc   |- !r. Ring r ==> !x. x IN R ==> !m n. ##m + (##n + x) = ##(m + n) + x
194   ring_num_mult        |- !r. Ring r ==> !m n. ##m * ##n = ##(m * n)
195   ring_num_mult_assoc  |- !r. Ring r ==> !m n x. x IN R ==> (##m * (##n * x) = ##(m * n) * x)
196   ring_num_exp         |- !r. Ring r ==> !m n. ##m ** n = ##(m ** n)
197   ring_num_add_mult    |- !r. Ring r ==> !x. x IN R ==> !m n. ##(m + n) * x = ##m * x + ##n * x
198   ring_num_add_mult_assoc  |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
199                               !m n. ##(m + n) * x + y = ##m * x + (##n * x + y)
200   ring_num_mult_neg    |- !r. Ring r ==> !x. x IN R ==> !n. -(##n * x) = ##n * -x
201   ring_num_mult_radd   |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> !n. ##n * (x + y) = ##n * x + ##n * y
202   ring_single_add_single |- !r. Ring r ==> !x. x IN R ==> (x + x = ##2 * x)
203   ring_single_add_single_assoc |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (x + (x + y) = ##2 * x + y)
204   ring_single_add_mult |- !r. Ring r ==> !x. x IN R ==> !n. x + ##n * x = ##(n + 1) * x
205   ring_single_add_mult_assoc |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
206                                 !n. x + (##n * x + y) = ##(n + 1) * x + y
207   ring_single_add_neg_mult   |- !r. Ring r ==> !x. x IN R ==>
208                                 !n. x + -(##n * x) = if n = 0 then x else -(##(n - 1) * x)
209   ring_single_add_neg_mult_assoc |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
210                       !n. x + (-(##n * x) + y) = if n = 0 then x + y else -(##(n - 1) * x) + y
211   ring_mult_add_neg              |- !r. Ring r ==> !x. x IN R ==>
212                       !n. ##n * x + -x = if n = 0 then -x else ##(n - 1) * x
213   ring_mult_add_neg_assoc        |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
214                       !n. ##n * x + (-x + y) = if n = 0 then -x + y else ##(n - 1) * x + y
215   ring_mult_add_neg_mult         |- !r. Ring r ==> !x. x IN R ==>
216                       !m n. ##m * x + -(##n * x) = if m < n then -(##(n - m) * x) else ##(m - n) * x
217   ring_mult_add_neg_mult_assoc   |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
218           !m n. ##m * x + (-(##n * x) + y) = if m < n then -(##(n - m) * x) + y else ##(m - n) * x + y
219   ring_neg_add_neg       |- !r. Ring r ==> !x. x IN R ==> (-x + -x = -(##2 * x))
220   ring_neg_add_neg_assoc |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (-x + (-x + y) = -(##2 * x) + y)
221   ring_neg_add_neg_mult  |- !r. Ring r ==> !x. x IN R ==> !n. -x + -(##n * x) = -(##(n + 1) * x)
222   ring_neg_add_neg_mult_assoc      |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
223                                       !n. -x + (-(##n * x) + y) = -(##(n + 1) * x) + y
224   ring_neg_mult_add_neg_mult       |- !r. Ring r ==> !x. x IN R ==>
225                                       !m n. -(##m * x) + -(##n * x) = -(##(m + n) * x)
226   ring_neg_mult_add_neg_mult_assoc |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
227                                       !m n. -(##m * x) + (-(##n * x) + y) = -(##(m + n) * x) + y
228
229   More Ring Exponent Theorems:
230   ring_single_mult_single       |- !r. Ring r ==> !x. x IN R ==> (x * x = x ** 2)
231   ring_single_mult_single_assoc |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (x * (x * y) = x ** 2 * y)
232   ring_single_mult_exp          |- !r. Ring r ==> !x. x IN R ==> !n. x * x ** n = x ** (n + 1)
233   ring_single_mult_exp_assoc    |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
234                                    !n. x * (x ** n * y) = x ** (n + 1) * y
235#  ring_exp_add       |- !r. Ring r ==> !x. x IN R ==> !n k. x ** (n + k) = x ** n * x ** k
236   ring_exp_add_assoc |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
237                         !n k. x ** n * (x ** k * y) = x ** (n + k) * y
238#  ring_one_exp       |- !r. Ring r ==> !n. #1 ** n = #1
239   ring_zero_exp      |- !r. Ring r ==> !n. #0 ** n = if n = 0 then #1 else #0
240#  ring_exp_mult      |- !r. Ring r ==> !x. x IN R ==> !n k. x ** (n * k) = (x ** n) ** k
241   ring_exp_mult_comm |- !r. Ring r ==> !x. x IN R ==> !m n. (x ** m) ** n = (x ** n) ** m
242   ring_neg_square    |- !r. Ring r ==> !x. x IN R ==> (-x ** 2 = x ** 2)
243   ring_exp_neg       |- !r. Ring r ==> !x. x IN R ==> !n. -x ** n = if EVEN n then x ** n else -(x ** n)
244   ring_neg_exp       |- !r. Ring r ==> !x. x IN R ==> !n. -x ** n = if EVEN n then x ** n else -(x ** n)
245   ring_num_mult_exp  |- !r. Ring r ==> !k m n. ##k * ##m ** n = ##(k * m ** n)
246   ring_exp_mod_order |- !r. Ring r ==> !x. x IN R /\ 0 < order r.prod x ==>
247                                        !n. x ** n = x ** (n MOD order r.prod x)
248
249   Ring Subtraction Theorems:
250#  ring_sub_def       |- !r x y. x - y = x + -y
251   ring_sub_zero      |- !r. Ring r ==> !x. x IN R ==> (x - #0 = x)
252   ring_sub_eq_zero   |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> ((x - y = #0) <=> (x = y))
253   ring_sub_eq        |- !r. Ring r ==> !x. x IN R ==> (x - x = #0)
254#  ring_sub_element   |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> x - y IN R
255   ring_zero_sub      |- !r. Ring r ==> !x. x IN R ==> (#0 - x = -x)
256   ring_sub_lcancel   |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x - y = x - z) <=> (y = z))
257   ring_sub_rcancel   |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((y - x = z - x) <=> (y = z))
258   ring_neg_sub       |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (-(x - y) = y - x)
259   ring_add_sub       |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (x + y - y = x)
260   ring_add_sub_comm  |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (y + x - y = x)
261   ring_add_sub_assoc |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x + y - z = x + (y - z))
262   ring_sub_add       |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (x - y + y = x)
263   ring_sub_eq_add    |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x - y = z) <=> (x = y + z))
264   ring_sub_pair_reduce   |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x + z - (y + z) = x - y)
265   ring_add_sub_identity  |- !r. Ring r ==> !x y z t. x IN R /\ y IN R /\ z IN R /\ t IN R ==>
266                                            ((x + y = z + t) <=> (x - z = t - y))
267   ring_mult_lsub      |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x * z - y * z = (x - y) * z)
268   ring_mult_rsub      |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x * y - x * z = x * (y - z))
269   ring_add_pair_sub   |- !r. Ring r ==> !x y p q. x IN R /\ y IN R /\ p IN R /\ q IN R ==>
270                                         (x + y - (p + q) = x - p + (y - q))
271   ring_mult_pair_sub  |- !r. Ring r ==> !x y p q. x IN R /\ y IN R /\ p IN R /\ q IN R ==>
272                                         (x * y - p * q = (x - p) * (y - q) + (x - p) * q + p * (y - q))
273   ring_mult_pair_diff |- !r. Ring r ==> !x y p q. x IN R /\ y IN R /\ p IN R /\ q IN R ==>
274                                                   (x * y - p * q = (x - p) * y + p * (y - q))
275   ring_num_sub        |- !r. Ring r ==> !n m. m < n ==> (##(n - m) = ##n - ##m)
276
277   Ring Binomial Expansions:
278   ring_binomial_2  |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
279                           ((x + y) ** 2 = x ** 2 + ##2 * (x * y) + y ** 2)
280   ring_binomial_3  |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
281                           ((x + y) ** 3 = x ** 3 + ##3 * (x ** 2 * y) + ##3 * (x * y ** 2) + y ** 3)
282   ring_binomial_4  |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
283                           ((x + y) ** 4 = x ** 4 + ##4 * (x ** 3 * y) +
284                                           ##6 * (x ** 2 * y ** 2) + ##4 * (x * y ** 3) + y ** 4)
285
286   Non-zero Elements of a Ring (for Integral Domain):
287   ring_nonzero_def          |- !r. R+ = R DIFF {#0}
288   ring_nonzero_eq           |- !r x. x IN R+ <=> x IN R /\ x <> #0
289   ring_nonzero_element      |- !r x. x IN R+ ==> x IN R
290   ring_neg_nonzero          |- !r. Ring r ==> !x. x IN R+ ==> -x IN R+
291   ring_nonzero_mult_carrier |- !r. Ring r ==> (F* = R+)
292
293   Ring Characteristic:
294   char_def       |- !r. char r = order r.sum #1
295   char_property  |- !r. ##(char r) = #0
296   char_eq_0      |- !r. (char r = 0) <=> !n. 0 < n ==> ##n <> #0
297   char_minimal   |- !r. 0 < char r ==> !n. 0 < n /\ n < char r ==> ##n <> #0
298   finite_ring_char_pos |- !r. FiniteRing r ==> 0 < char r
299
300   Characteristic Theorems:
301   ring_char_divides    |- !r. Ring r ==> !n. (##n = #0) <=> (char r) divides n
302   ring_char_eq_1       |- !r. Ring r ==> ((char r = 1) <=> (#1 = #0))
303   ring_char_2_property |- !r. Ring r /\ (char r = 2) ==> (#1 + #1 = #0)
304   ring_char_2_neg_one  |- !r. Ring r /\ (char r = 2) ==> (-#1 = #1)
305   ring_char_2_double   |- !r. Ring r /\ (char r = 2) ==> !x. x IN R ==> (x + x = #0)
306   ring_neg_char_2      |- !r. Ring r /\ (char r = 2) ==> !x. x IN R ==> (-x = x)
307   ring_add_char_2      |- !r. Ring r /\ (char r = 2) ==> !x y. x IN R /\ y IN R ==> (x + y = x - y)
308   ring_num_char_coprime_nonzero |- !r. Ring r /\ #1 <> #0 ==> !c. coprime c (char r) ==> ##c <> #0
309   ring_char_alt        |- !r. Ring r ==> !n. 0 < n ==>
310                               ((char r = n) <=> (##n = #0) /\ !m. 0 < m /\ m < n ==> ##m <> #0)
311   ring_neg_one_eq_one  |- !r. Ring r /\ #1 <> #0 ==> ((-#1 = #1) <=> (char r = 2))
312   ring_add_exp_eqn     |- !r. Ring r ==> !x. x IN R ==> !n. r.sum.exp x n = x * ##n
313   ring_num_eq          |- !r. Ring r ==> !n m. n < char r /\ m < char r ==> ((##n = ##m) <=> (n = m))
314   ring_num_mod         |- !r. Ring r /\ 0 < char r ==> !n. ##n = ##(n MOD char r)
315   ring_num_negative    |- !r. Ring r /\ 0 < char r ==> !z. ?y x. (y = ##x) /\ (y + ##z = #0)
316   ring_char_0          |- !r. Ring r /\ (char r = 0) ==> INFINITE R
317   ring_char_1          |- !r. Ring r /\ (char r = 1) ==> (R = {#0})
318
319   Finite Ring:
320   finite_ring_is_ring       |- !r. FiniteRing r ==> Ring r
321   finite_ring_card_pos      |- !r. FiniteRing r ==> 0 < CARD R
322   finite_ring_card_eq_1     |- !r. FiniteRing r ==> ((CARD R = 1) <=> (#1 = #0))
323   finite_ring_char          |- !r. FiniteRing r ==> 0 < char r /\ (char r = order r.sum #1)
324   finite_ring_char_divides  |- !r. FiniteRing r ==> (char r) divides (CARD R)
325   finite_ring_card_prime    |- !r. FiniteRing r /\ prime (CARD R) ==> (char r = CARD R)
326   finite_ring_char_alt      |- !r. FiniteRing r ==>
327                        !n. (char r = n) <=> 0 < n /\ (##n = #0) /\ !m. 0 < m /\ m < n ==> ##m <> #0
328
329*)
330
331(* ------------------------------------------------------------------------- *)
332(* Basic definitions                                                         *)
333(* ------------------------------------------------------------------------- *)
334
335(* Set up ring type as a record
336   A Ring has:
337   . a carrier set (set = function 'a -> bool, since MEM is a boolean function)
338   . a sum group (with sum as its binary operation )
339   . a product monoid (with multiplication as its binary operation)
340*)
341Datatype:
342  ring = <| carrier: 'a -> bool;
343                sum: 'a group;
344               prod: 'a monoid (* monoid and group share the same type *)
345          |>
346End
347
348(* overloading  *)
349Overload "+" = ``r.sum.op``
350Overload "*" = ``r.prod.op``
351Overload R = ``r.carrier``(* just use this, also for field later. *)
352Overload "#0" = ``r.sum.id``(* define zero *)
353Overload "#1" = ``r.prod.id``(* define one *)
354
355(* Ring Definition:
356   A Ring is a record r with elements of type 'a ring, such that
357   . r.sum is an Abelian group
358   . r.prod is an Abelian group (so-called commutative ring)
359   . r.sum.carrier is the whole set
360   . r.prod.carrier is the whole set (so there may be #0 divisors)
361   . #0 multiplies to #0 (on the left) (no need, can be deduced from distributive law)
362   . multiplication distributes over addition (on the left)
363*)
364Definition Ring_def:
365    Ring (r:'a ring) <=>
366       AbelianGroup r.sum  /\
367       AbelianMonoid r.prod /\
368       (r.sum.carrier = R) /\
369       (r.prod.carrier = R) /\
370       (!x y z. x IN R /\ y IN R /\ z IN R ==> (x * (y + z) = (x * y) + (x * z)))
371End
372
373(* A finite ring *)
374Definition FiniteRing_def:
375    FiniteRing (r:'a ring) <=> Ring r /\ FINITE R
376End
377
378(* ------------------------------------------------------------------------- *)
379(* Simple Theorems                                                           *)
380(* ------------------------------------------------------------------------- *)
381
382(* Theorem: Ring r ==> (r.sum.carrier = R) /\ (r.prod.carrier = R) *)
383(* Proof: by Ring_def. *)
384Theorem ring_carriers[simp]:
385    !r:'a ring. Ring r ==> (r.sum.carrier = R) /\ (r.prod.carrier = R)
386Proof
387  rw_tac std_ss[Ring_def]
388QED
389
390
391(* Theorem: Ring additions form an Abelian group. *)
392(* Proof: by definition. *)
393Theorem ring_add_group:
394    !r:'a ring. Ring r ==> Group r.sum /\ (r.sum.carrier = R) /\ !x y. x IN R /\ y IN R ==> (x + y = y + x)
395Proof
396  rw_tac std_ss[Ring_def, AbelianGroup_def]
397QED
398
399(* export this will introduce commutativity in rewrite, no good. *)
400(* val _ = export_rewrites ["ring_add_group"]; *)
401
402(* Use Michael's version for export_rewrites, stripping commutativity. *)
403Theorem ring_add_group_rwt[simp] =
404  ring_add_group |> SPEC_ALL |> UNDISCH |> CONJUNCTS
405                 |> (fn l => LIST_CONJ (List.take(l,2)))
406                 |> DISCH_ALL |> GEN_ALL;
407(* > val ring_add_group_rwt = |- !r. Ring r ==> Group r.sum /\ (r.sum.carrier = R) : thm *)
408
409(* Theorem: Ring r ==> AbelianGroup r.sum *)
410(* Proof: By AbelianGroup_def, ring_add_group. *)
411Theorem ring_add_abelian_group[simp]:
412    !r:'a ring. Ring r ==> AbelianGroup r.sum
413Proof
414  rw[AbelianGroup_def, ring_add_group]
415QED
416
417(* Theorem: Ring multiplications form an Abelian monoid. *)
418(* Proof: by definition. *)
419Theorem ring_mult_monoid:
420    !r:'a ring. Ring r ==> Monoid r.prod /\ (r.prod.carrier = R) /\ !x y. x IN R /\ y IN R ==> (x * y = y * x)
421Proof
422  rw_tac std_ss[Ring_def, AbelianMonoid_def]
423QED
424
425(* export this will introduce commutativity in rewrite, no good. *)
426(* val _ = export_rewrites ["ring_mult_monoid"]; *)
427
428(* Copy Michael's version for export_rewrites, stripping commutativity. *)
429Theorem ring_mult_monoid_rwt[simp] =
430  ring_mult_monoid |> SPEC_ALL |> UNDISCH |> CONJUNCTS
431                   |> (fn l => LIST_CONJ (List.take(l,2)))
432                   |> DISCH_ALL |> GEN_ALL;
433(* > val ring_mult_monoid_rwt = |- !r. Ring r ==> Monoid r.prod /\ (r.prod.carrier = R) : thm *)
434
435(* Theorem: Ring r ==> AbelianMonoid r.prod *)
436(* Proof: By AbelianMonoid_def, ring_mult_monoid. *)
437Theorem ring_mult_abelian_monoid:
438    !r:'a ring. Ring r ==> AbelianMonoid r.prod
439Proof
440  rw[AbelianMonoid_def, ring_mult_monoid]
441QED
442
443(* Theorem: FiniteRing r ==> FiniteGroup r.sum *)
444(* Proof: by definitions. *)
445Theorem finite_ring_add_finite_group:
446    !r:'a ring. FiniteRing r ==> FiniteGroup r.sum /\ (r.sum.carrier = R)
447Proof
448  metis_tac[FiniteRing_def, FiniteGroup_def, ring_add_group]
449QED
450
451(* Theorem: FiniteRing r ==> FiniteAbelianGroup r.sum *)
452(* Proof: by definitions. *)
453Theorem finite_ring_add_finite_abelian_group:
454    !r:'a ring. FiniteRing r ==> FiniteAbelianGroup r.sum /\ (r.sum.carrier = R)
455Proof
456  metis_tac[FiniteRing_def, FiniteAbelianGroup_def, AbelianGroup_def, ring_add_group]
457QED
458
459(* Theorem: FiniteRing r ==> FiniteMonoid r.prod *)
460(* Proof: by definitions. *)
461Theorem finite_ring_mult_finite_monoid:
462    !r:'a ring. FiniteRing r ==> FiniteMonoid r.prod
463Proof
464  metis_tac[FiniteRing_def, FiniteMonoid_def, ring_mult_monoid]
465QED
466
467(* Theorem: FiniteRing r ==> FiniteAbelianMonoid r.prod *)
468(* Proof: by definitions. *)
469Theorem finite_ring_mult_finite_abelian_monoid:
470    !r:'a ring. FiniteRing r ==> FiniteAbelianMonoid r.prod
471Proof
472  metis_tac[FiniteRing_def, FiniteAbelianMonoid_def, AbelianMonoid_def, ring_mult_monoid]
473QED
474
475(* ------------------------------------------------------------------------- *)
476(* Lifting Theorems                                                          *)
477(* ------------------------------------------------------------------------- *)
478
479(*
480
481local
482val rag = ring_add_group |> SPEC_ALL |> UNDISCH_ALL
483val rgroup = rag |> CONJUNCT1
484val rsc = rag |> CONJUNCT2 |> CONJUNCT1
485in
486fun lift_group_thm gname rname = let
487  val gthm = DB.fetch "group" ("group_" ^ gname)
488  val gthm' = SPEC ``(r:'a ring).sum`` gthm
489in
490  save_thm("ring_" ^ rname,
491           MP gthm' rgroup
492              |> REWRITE_RULE [rsc]
493              |> DISCH_ALL |> GEN_ALL)
494end
495end (* local *)
496
497val ring_neg_add_comm = lift_group_thm "inv_op" "neg_add'"
498
499*)
500
501
502(* Lifting Group theorem for Ring
503   from: !g: 'a group. Group g ==> E(g)
504     to: !r:'a ring.  Ring r ==> E(r.sum)
505    via: !r:'a ring.  Ring r ==> Group r.sum /\ (r.sum.carrier = R)
506*)
507local
508val rag = ring_add_group |> SPEC_ALL |> UNDISCH_ALL
509val rgroup = rag |> CONJUNCT1
510val rsc = rag |> CONJUNCT2 |> CONJUNCT1
511in
512fun lift_group_thm gsuffix rsuffix = let
513  val gthm = DB.fetch "group" ("group_" ^ gsuffix)
514  val gthm' = gthm |> SPEC ``(r:'a ring).sum``
515in
516  save_thm("ring_" ^ rsuffix,
517           MP gthm' rgroup
518              |> REWRITE_RULE [rsc]
519              |> DISCH_ALL |> GEN_ALL)
520end
521end; (* local *)
522
523(* Lifting Monoid theorem for Ring
524   from: !g: 'a monoid. Monoid g ==> E(g)
525     to: !r:'a ring.  Ring r ==> E(r.prod)
526    via: !r:'a ring.  Ring r ==> Monoid r.prod /\ (r.prod.carrier = R)
527*)
528local
529val rmm = ring_mult_monoid |> SPEC_ALL |> UNDISCH_ALL
530val rmonoid = rmm |> CONJUNCT1
531val rpc = rmm |> CONJUNCT2 |> CONJUNCT1
532in
533fun lift_monoid_thm msuffix rsuffix = let
534  val mthm = DB.fetch "monoid" ("monoid_" ^ msuffix)
535  val mthm' = mthm |> SPEC ``(r:'a ring).prod``
536in
537  save_thm("ring_" ^ rsuffix,
538           MP mthm' rmonoid
539              |> REWRITE_RULE [rpc]
540              |> DISCH_ALL |> GEN_ALL)
541end
542end; (* local *)
543
544(* ------------------------------------------------------------------------- *)
545(* Properties of #0 and #1 - representations of ring_zero and ring_one       *)
546(* ------------------------------------------------------------------------- *)
547
548(* Theorem: Ring #0 in carrier. *)
549(* Proof: by group_id_element. *)
550val ring_zero_element = lift_group_thm "id_element" "zero_element";
551(* > val ring_zero_element = |- !r. Ring r ==> #0 IN R : thm *)
552
553(* Theorem: Ring one in carrier. *)
554(* Proof: by monoid_id_element *)
555val ring_one_element = lift_monoid_thm "id_element" "one_element";
556(* > val ring_one_element = |- !r. Ring r ==> #1 IN R : thm *)
557
558val _ = export_rewrites ["ring_zero_element", "ring_one_element"];
559
560(* Theorem: Ring r ==> R <> {} *)
561(* Proof: by ring_zero_element, MEMBER_NOT_EMPTY *)
562Theorem ring_carrier_nonempty:
563    !r:'a ring. Ring r ==> R <> {}
564Proof
565  metis_tac[ring_zero_element, MEMBER_NOT_EMPTY]
566QED
567
568(* ------------------------------------------------------------------------- *)
569(* Theorems from Group and Monoid Theory (for addition and multiplication)   *)
570(* ------------------------------------------------------------------------- *)
571
572(* ------------------------------------------------------------------------- *)
573(* Ring Addition Theorems from Group (r.sum)                                 *)
574(* ------------------------------------------------------------------------- *)
575
576(* Theorem: Ring addition in carrier. *)
577(* Proof: by group_op_element of Group (r.sum). *)
578val ring_add_element = lift_group_thm "op_element" "add_element";
579(* > val ring_add_element = |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> x + y IN R : thm *)
580
581val _ = export_rewrites ["ring_add_element"];
582
583(* Theorem: Ring addition is associative. *)
584(* Proof: by group_assoc of Group (r.sum). *)
585val ring_add_assoc = lift_group_thm "assoc" "add_assoc";
586(* > val ring_add_assoc = |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x + y + z = x + (y + z)) : thm *)
587
588(* no export of associativity *)
589(* val _ = export_rewrites ["ring_add_assoc"]; *)
590
591(* Theorem: Ring addition is commutative *)
592(* Proof: by commutativity of Abelian Group (r.sum). *)
593Theorem ring_add_comm:
594    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (x + y = y + x)
595Proof
596  rw_tac std_ss[ring_add_group]
597QED
598
599(* no export of commutativity *)
600(* val _ = export_rewrites ["ring_add_comm"]; *)
601
602(* Theorem: Ring addition is associate-commutative. *)
603(* Proof: by ring_add_comm and ring_add_assoc.
604      x + (y + z)
605    = (x + y) + z   by ring_add_assoc
606    = (y + x) + z   by ring_add_comm
607    = y + (x + z)   by ring_add_assoc
608*)
609Theorem ring_add_assoc_comm:
610    !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x + (y + z) = y + (x + z))
611Proof
612  rw_tac std_ss[GSYM ring_add_assoc, ring_add_comm]
613QED
614
615(* Theorem: #0 + #0 = #0 *)
616(* Proof: by group_id_id of Group (r.sum). *)
617val ring_add_zero_zero = lift_group_thm "id_id" "add_zero_zero";
618(* > val ring_add_zero_zero = |- !r. Ring r ==> (#0 + #0 = #0) : thm *)
619
620(* Theorem: #0 + x = x. *)
621(* Proof: by group_lid of Group (r.sum). *)
622val ring_add_lzero = lift_group_thm "lid" "add_lzero";
623(* > val ring_add_lzero = |- !r. Ring r ==> !x. x IN R ==> (#0 + x = x) : thm *)
624
625(* Theorem: x + #0 = x. *)
626(* Proof: by group_rid of Group (r.sum), or by ring_add_lzero and ring_add_comm.
627      x + #0
628    = #0 + x    by ring_add_comm
629    = x         by ring_add_lzero
630*)
631val ring_add_rzero = lift_group_thm "rid" "add_rzero";
632(* > val ring_add_rzero = |- !r. Ring r ==> !x. x IN R ==> (x + #0 = x) : thm *)
633
634val _ = export_rewrites ["ring_add_zero_zero", "ring_add_lzero", "ring_add_rzero"];
635
636(* Theorem: #0 is unique. *)
637(* Proof: by group_id_unique of Group (r.sum). *)
638val ring_zero_unique = lift_group_thm "id_unique" "zero_unique";
639(* > val ring_zero_unique = |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> ((y + x = x) <=> (y = #0)) /\ ((x + y = x) <=> (y = #0)) : thm *)
640
641(* ------------------------------------------------------------------------- *)
642(* Ring Multiplication Theorems from Monoid (r.prod)                         *)
643(* ------------------------------------------------------------------------- *)
644
645(* Theorem: x * y IN R *)
646(* Proof: by monoid_op_element of Monoid (r.prod). *)
647val ring_mult_element = lift_monoid_thm "op_element" "mult_element";
648(* > val ring_mult_element = |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> x * y IN R : thm *)
649
650val _ = export_rewrites ["ring_mult_element"];
651
652(* Theorem: (x * y) * z = x * (y * z) *)
653(* Proof: by monoid_assoc of Monoid (r.prod). *)
654val ring_mult_assoc = lift_monoid_thm "assoc" "mult_assoc";
655(* > val ring_mult_assoc = |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x * y * z = x * (y * z)) : thm *)
656
657(* no export of associativity *)
658(* val _ = export_rewrites ["ring_mult_assoc"]; *)
659
660(* Theorem: x * y = y * x *)
661(* Proof: by commutativity of Abelian Monoid (r.prod). *)
662Theorem ring_mult_comm:
663    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (x * y = y * x)
664Proof
665  rw_tac std_ss[ring_mult_monoid]
666QED
667
668(* no export of commutativity *)
669(* val _ = export_rewrites ["ring_mult_comm"]; *)
670
671(* Theorem: x * (y * z) = y * (x * z) *)
672(* Proof: by ring_mult_assoc and ring_mult_comm. *)
673Theorem ring_mult_assoc_comm:
674    !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x * (y * z) = y * (x * z))
675Proof
676  rw_tac std_ss[GSYM ring_mult_assoc, ring_mult_comm]
677QED
678
679(* Theorem: x * #0 = #0 *)
680(* Proof: by distribution and group_id_fix.
681     x * #0
682   = x * (#0 + #0)       by ring_add_zero_zero
683   = x * #0 + x * #0     by distribution in Ring_def
684   hence x * #0 = #0     by group_id_fix
685*)
686Theorem ring_mult_rzero[simp]:
687    !r:'a ring. Ring r ==> !x. x IN R ==> (x * #0 = #0)
688Proof
689  rpt strip_tac >>
690  `#0 IN R /\ x * #0 IN R` by rw_tac std_ss[ring_zero_element, ring_mult_element] >>
691  metis_tac[ring_add_zero_zero, ring_add_group, group_id_fix, Ring_def]
692QED
693
694
695(* Theorem: #0 * x = #0 *)
696(* Proof: by ring_mult_rzero and Ring_def implicit x * y = y * x.
697   or by ring_mult_lzero and ring_mult_comm.
698*)
699Theorem ring_mult_lzero[simp]:
700    !r:'a ring. Ring r ==> !x. x IN R ==> (#0 * x = #0)
701Proof
702  rw[ring_mult_comm]
703QED
704
705
706(* Theorem: #0 * #0 = #0 *)
707(* Proof: by ring_mult_lzero, ring_zero_element. *)
708Theorem ring_mult_zero_zero[simp]:
709    !r:'a ring. Ring r ==> (#0 * #0 = #0)
710Proof
711  rw[]
712QED
713
714
715(* Theorem: #1 * #1 = #1 *)
716(* Proof: by monoid_id_id. *)
717val ring_mult_one_one = lift_monoid_thm "id_id" "mult_one_one";
718(* > val ring_mult_one_one = |- !r. Ring r ==> (#1 * #1 = #1) : thm *)
719
720(* Theorem: #1 * x = x *)
721(* Proof: by defintion and monoid_lid. *)
722val ring_mult_lone = lift_monoid_thm "lid" "mult_lone";
723(* > val ring_mult_lone = |- !r. Ring r ==> !x. x IN R ==> (#1 * x = x) : thm *)
724
725(* Theorem: x * #1 = x *)
726(* Proof: by defintion and monoid_rid. *)
727val ring_mult_rone = lift_monoid_thm "rid" "mult_rone";
728(* > val ring_mult_rone = |- !r. Ring r ==> !x. x IN R ==> (x * #1 = x) : thm *)
729
730val _ = export_rewrites ["ring_mult_one_one", "ring_mult_lone", "ring_mult_rone"];
731
732(* Theorem: #1 is unique. *)
733(* Proof: from monoid_id_unique.
734   Note this is: if there is a y that looks like #1 (i.e. !x. y * x = x or x * y = x)
735   then it must be y = #1. This is NOT: !x y. y * x = x ==> y = #1.
736*)
737Theorem ring_one_unique:
738    !r:'a ring. Ring r ==> !y. y IN R ==> ((!x. x IN R ==> (y * x = x) \/ (x * y = x)) = (y = #1))
739Proof
740  metis_tac[monoid_id_unique, ring_mult_monoid]
741QED
742
743(* Theorem: For a Ring, #1 = #0 iff R = {#0} *)
744(* Proof:
745   If part: #1 = #0 ==> R = {#0}
746      !x. x IN R ==> #1 * x = x    by ring_mult_lone
747      !x. x IN R ==> #0 * x = #0   by ring_mult_lzero
748      !x. x IN R ==> x = #0        by #1 = #0
749      Since #0 IN R                by ring_zero_element
750      this means R = {#0}          by UNIQUE_MEMBER_SING
751   Only-if part: R = {#0} ==> #1 = #0
752      #0 IN R                      by ring_zero_element
753      #1 IN R                      by ring_one_element
754      thus R = {#0} ==> #1 = #0    by IN_SING
755*)
756Theorem ring_one_eq_zero:
757    !r:'a ring. Ring r ==> ((#1 = #0) <=> (R = {#0}))
758Proof
759  rw_tac std_ss[EQ_IMP_THM] >| [
760    metis_tac[ring_zero_element, ring_mult_lone, ring_mult_lzero, UNIQUE_MEMBER_SING],
761    metis_tac[ring_zero_element, ring_one_element, IN_SING]
762  ]
763QED
764
765(* ------------------------------------------------------------------------- *)
766(* Theorems inherit from Group or Monoid Theory (for ring_num and ring_exp)  *)
767(* ------------------------------------------------------------------------- *)
768
769(* ------------------------------------------------------------------------- *)
770(* Ring numbers: iterations on ring_add using one                            *)
771(* ##0 = #0, ##1 = #1, ##2 = #1+#1, ##3 = #1+#1+#1, etc.                     *)
772(* ------------------------------------------------------------------------- *)
773
774Overload ring_numr = ``r.sum.exp #1``(* for fallback *)
775Overload "##" = ``r.sum.exp #1``(* current use *)
776
777val _ = remove_termtok { tok = "##", term_name = "##" };
778
779val _ = add_rule { fixity = Prefix 2200,
780                   term_name = "##",
781                   block_style = (AroundEachPhrase, (PP.CONSISTENT, 0)),
782                   paren_style = OnlyIfNecessary,
783                   pp_elements = [TOK "##"] };
784
785(* ------------------------------------------------------------------------- *)
786(* Ring exponentials: iterations on ring_mult                                *)
787(* x ** 0 = #1, x ** 1 = x, x ** 2 = x * x, x ** 3 = x * x * x, etc.         *)
788(* ------------------------------------------------------------------------- *)
789(* val ring_exp_def = Define `ring_exp (r:'a ring) = monoid_exp r.prod`; *)
790(*
791val ring_exp_def = Define`
792  (ring_exp (r:'a ring) x 0 = #1) /\
793  (ring_exp (r:'a ring) x (SUC n) = x * (ring_exp r x n))
794`;
795*)
796(* val _ = overload_on ("**", ``ring_exp r``); *)
797(* val _ = export_rewrites ["ring_exp_def"]; *)
798
799Overload "**" = ``r.prod.exp``
800
801(* ------------------------------------------------------------------------- *)
802(* Ring Numerical Theorems (from group_exp of ring_add_group).               *)
803(* ------------------------------------------------------------------------- *)
804
805(* Problem: Should use lifting by incorporating ring_one_element. *)
806
807(*
808- show_assums := true;
809> val it = () : unit
810
811- group_exp_element;
812> val it = [] |- !g. Group g ==> !x. x IN G ==> !n. x ** n IN G : thm
813- group_exp_element |> SPEC ``(r:'a ring).sum``;
814> val it = [] |- Group r.sum ==> !x. x IN r.sum.carrier ==> !n. r.sum.exp x n IN r.sum.carrier : thm
815- group_exp_element |> SPEC ``(r:'a ring).sum`` |> UNDISCH;
816> val it = [Group r.sum] |- !x. x IN r.sum.carrier ==> !n. r.sum.exp x n IN r.sum.carrier : thm
817- group_exp_element |> SPEC ``(r:'a ring).sum`` |> UNDISCH |> SPEC ``#1``;
818> val it =  [Group r.sum] |- #1 IN r.sum.carrier ==> !n. ##n IN r.sum.carrier : thm
819- ring_add_group |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT1;
820> val it =  [Ring r] |- Group r.sum : thm
821- group_exp_element |> SPEC ``(r:'a ring).sum`` |> UNDISCH |> SPEC ``#1`` |> PROVE_HYP (ring_add_group |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT1);
822> val it =  [Ring r] |- #1 IN r.sum.carrier ==> !n. ##n IN r.sum.carrier : thm
823- ring_add_group |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT2 |> CONJUNCT1;
824> val it =  [Ring r] |- r.sum.carrier = R : thm
825- group_exp_element |> SPEC ``(r:'a ring).sum`` |> UNDISCH |> SPEC ``#1`` |> PROVE_HYP (ring_add_group |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT1) |> REWRITE_RULE [ring_add_group |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT2 |> CONJUNCT1];
826> val it =  [Ring r] |- #1 IN R ==> !n. ##n IN R : thm;
827- ring_one_element |> SPEC_ALL |> UNDISCH_ALL;
828> val it =  [Ring r] |- #1 IN R : thm
829- group_exp_element |> SPEC ``(r:'a ring).sum`` |> UNDISCH |> SPEC ``#1`` |> PROVE_HYP (ring_add_group |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT1) |> REWRITE_RULE [ring_add_group |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT2 |> CONJUNCT1, ring_one_element |> SPEC_ALL |> UNDISCH_ALL];
830> val it =  [Ring r] |- !n. ##n IN R : thm
831- group_exp_element |> SPEC ``(r:'a ring).sum`` |> UNDISCH |> SPEC ``#1`` |> PROVE_HYP (ring_add_group |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT1) |> REWRITE_RULE [ring_add_group |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT2 |> CONJUNCT1, ring_one_element |> SPEC_ALL |> UNDISCH_ALL] |> DISCH_ALL |> GEN_ALL
832> val it =  [] |- !r. Ring r ==> !n. ##n IN R : thm
833
834- show_assums := false;
835> val it = () : unit
836
837*)
838
839(* Lifting Group exp theorem for Ring
840   from: !g: 'a group. Group g ==> E(g.exp #1 n)
841     to: !r:'a ring.  Ring r ==> E(##n)
842    via: !r:'a ring.  Ring r ==> Group r.sum /\ (r.sum.carrier = R)
843         !r:'a ring.  Ring r ==> #1 IN R
844*)
845local
846val rag = ring_add_group |> SPEC_ALL |> UNDISCH_ALL
847val rgroup = rag |> CONJUNCT1
848val rsc = rag |> CONJUNCT2 |> CONJUNCT1
849val roe = ring_one_element |> SPEC_ALL |> UNDISCH_ALL
850in
851fun lift_group_exp gsuffix rsuffix = let
852  val gthm = DB.fetch "group" ("group_exp_" ^ gsuffix)
853  val gthm' = gthm |> SPEC ``(r:'a ring).sum`` |> UNDISCH |> SPEC ``#1``
854in
855  save_thm("ring_num_" ^ rsuffix,
856           gthm' |> PROVE_HYP rgroup
857                 |> REWRITE_RULE [rsc, roe]
858                 |> DISCH_ALL |> GEN_ALL)
859end
860end; (* local *)
861
862local
863val rag = ring_add_group |> SPEC_ALL |> UNDISCH_ALL
864val rgroup = rag |> CONJUNCT1
865val rsc = rag |> CONJUNCT2 |> CONJUNCT1
866val roe = ring_one_element |> SPEC_ALL |> UNDISCH_ALL
867in
868fun lift_group_exp_def gsuffix rsuffix = let
869  val gthm = DB.fetch "group" ("group_exp_" ^ gsuffix)
870  val gthm' = gthm |> SPEC ``(r:'a ring).sum`` |> SPEC ``#1`` (* no UNDISCH *)
871in
872  save_thm("ring_num_" ^ rsuffix,
873           gthm' |> PROVE_HYP rgroup
874                 |> REWRITE_RULE [rsc, roe]
875                 |> DISCH_ALL |> GEN_ALL)
876end
877end; (* local *)
878
879(* Theorem: ##n IN R *)
880(* Proof: by group_exp_element and ring_num_def. *)
881val ring_num_element = lift_group_exp "element" "element";
882(* > val ring_num_element = |- !r. Ring r ==> !n. ##n IN R : thm *)
883
884val _ = export_rewrites ["ring_num_element"];
885
886(* Theorem: ##n * x IN R *)
887(* Proof: by ring_num_element and ring_mult_element. *)
888Theorem ring_num_mult_element[simp]:
889    !r:'a ring. Ring r ==> !x. x IN R ==> !n. ##n * x IN R
890Proof
891  rw[]
892QED
893
894
895(* Theorem: ##(SUC n) = #1 + ##n *)
896(* Proof: by group_exp_SUC. *)
897val ring_num_SUC = lift_group_exp_def "SUC" "SUC";
898(* > val ring_num_SUC = |- !r n. Ring r ==> (##(SUC n) = #1 + ##n) : thm *)
899
900val _ = export_rewrites ["ring_num_SUC"];
901
902(* Theorem: ##(SUC n) = ##n + #1 *)
903(* Proof: by group_exp_SUC and ring_add_comm. *)
904Theorem ring_num_suc:
905    !r:'a ring. Ring r ==> !n. ##(SUC n) = ##n + #1
906Proof
907  rw[ring_add_comm]
908QED
909
910(*
911ringTheory.ring_num_0   has Ring r ==> ##0 = #0   by lifting.
912but:
913monoid_exp_def |> ISPEC ``(r:'a ring).sum`` |> ISPEC ``#1`` |> ISPEC ``0`` |> SIMP_RULE bool_ss [FUNPOW_0];
914val it = |- ##0 = #0: thm
915> monoid_exp_def |> ISPEC ``(r:'a ring).sum`` |> ISPEC ``#1`` |> ISPEC ``1`` |> SIMP_RULE bool_ss [FUNPOW_1];
916val it = |- ##1 = #1 + #0: thm
917> monoid_exp_def |> ISPEC ``(r:'a ring).sum`` |> ISPEC ``#1`` |> ISPEC ``c:num``;
918val it = |- ##c = FUNPOW ($+ #1) c #0: thm
919*)
920
921(* Obtain a better theorem *)
922Theorem ring_num_0[simp] =
923    monoid_exp_def |> ISPEC “(r:'a ring).sum” |> ISPEC “#1” |> ISPEC “0 :num”
924                   |> SIMP_RULE bool_ss [FUNPOW_0] |> GEN “r:'a ring”
925(* val ring_num_0 = |- !r. ##0 = #0: thm *)
926
927(* Obtain another theorem *)
928Theorem ring_num_one =
929    monoid_exp_def |> ISPEC “(r:'a ring).sum” |> ISPEC “#1” |> ISPEC “1 :num”
930                   |> SIMP_RULE bool_ss [FUNPOW_1] |> GEN “r:'a ring”
931(* val ring_num_one = |- !r. ##1 = #1 + #0: thm *)
932(* Do not export this one: an expansion. *)
933
934(* Theorem: ##1 = #1 *)
935(* Proof: by group_exp_1. *)
936val ring_num_1 = lift_group_exp "1" "1";
937(* > val ring_num_1 = |- !r. Ring r ==> (##1 = #1) : thm *)
938
939val _ = export_rewrites ["ring_num_1"];
940
941(* Theorem: ##2 = #1 + #1 *)
942(* Proof:
943   ##2 = ##(SUC 1)    by TWO
944       = #1 + ##1     by ring_num_SUC
945       = #1 + #1      by ring_num_1
946*)
947Theorem ring_num_2:
948    !r:'a ring. Ring r ==> (##2 = #1 + #1)
949Proof
950  metis_tac[TWO, ring_num_SUC, ring_num_1]
951QED
952
953local
954val rag = ring_add_group |> SPEC_ALL |> UNDISCH_ALL
955val rgroup = rag |> CONJUNCT1
956val rsc = rag |> CONJUNCT2 |> CONJUNCT1
957val rze = ring_zero_element |> SPEC_ALL |> UNDISCH_ALL
958in
959fun lift_group_id_exp gsuffix rsuffix = let
960  val gthm = DB.fetch "group" ("group_" ^ gsuffix)
961  val gthm' = gthm |> SPEC ``(r:'a ring).sum`` |> UNDISCH
962in
963  save_thm("ring_" ^ rsuffix,
964           gthm' |> PROVE_HYP rgroup
965                 |> REWRITE_RULE [rsc, rze]
966                 |> DISCH_ALL |> GEN_ALL)
967end
968end; (* local *)
969
970(* Theorem: r.sum.exp #0 n = #0 *)
971(* Proof: by group_id_exp and ring_num_def. *)
972val ring_sum_zero = lift_group_id_exp "id_exp" "sum_zero";
973(* > val ring_sum_zero = |- !r. Ring r ==> !n. r.sum.exp #0 n = #0 : thm *)
974
975(* Theorem: #1 = #0 ==> !c. ##c = #0 *)
976(* Proof:
977   #1 = #0 ==> R = {#0}   by ring_one_eq_zero
978   since ##c IN R         by ring_num_element
979   ##c = #0               by IN_SING
980*)
981Theorem ring_num_all_zero:
982    !r:'a ring. Ring r ==> ((#1 = #0) ==> (!c. ##c = #0))
983Proof
984  metis_tac [IN_SING, ring_one_eq_zero, ring_num_element]
985QED
986
987(* ------------------------------------------------------------------------- *)
988(* Ring Exponent Theorems (from monoid_exp of ring_mult_monoid).             *)
989(* ------------------------------------------------------------------------- *)
990
991
992local
993val rmm = ring_mult_monoid |> SPEC_ALL |> UNDISCH_ALL
994val rmonoid = rmm |> CONJUNCT1
995val rpc = rmm |> CONJUNCT2 |> CONJUNCT1
996in
997fun lift_monoid_def gsuffix rsuffix = let
998  val gthm = DB.fetch "monoid" ("monoid_" ^ gsuffix)
999  val gthm' = gthm |> SPEC ``(r:'a ring).prod`` (* no UNDISCH *)
1000in
1001  save_thm("ring_" ^ rsuffix,
1002           gthm' |> PROVE_HYP rmonoid
1003                 |> REWRITE_RULE [rpc]
1004                 |> DISCH_ALL |> GEN_ALL)
1005end
1006end; (* local *)
1007
1008(* Theorem: x ** n IN R *)
1009(* Proof: by monoid_exp_carrier. *)
1010val ring_exp_element = lift_monoid_thm "exp_element" "exp_element";
1011(* > val ring_exp_element = |- !r. Ring r ==> !x. x IN R ==> !n. x ** n IN R : thm *)
1012
1013val _ = export_rewrites ["ring_exp_element"];
1014
1015(* Theorem: x ** 0 = #1 *)
1016(* Proof: by monoid_exp_0. *)
1017(* Note: monoid_exp_0 |- !g x. x ** 0 = #e *)
1018Theorem ring_exp_0[simp]: !x:'a. x ** 0 = #1
1019Proof rw[]
1020QED
1021
1022(* Theorem: x ** (SUC n) = x * x ** n  *)
1023(* Proof: by monoid_exp_SUC. *)
1024(* Note: monoid_exp_SUC |- !g x n. x ** SUC n = x * x ** n *)
1025Theorem ring_exp_SUC[simp]: !x n. x ** SUC n = x * x ** n
1026Proof rw[]
1027QED
1028
1029(* Theorem: x ** SUC n = x ** n * x *)
1030(* Proof: by ring_exp_SUC and ring_mult_comm. *)
1031Theorem ring_exp_suc:
1032    !r:'a ring. Ring r ==> !x. x IN R ==> !n. x ** (SUC n) = (x ** n) * x
1033Proof
1034  rw[ring_mult_comm]
1035QED
1036
1037(* Theorem: x ** 1 = x *)
1038(* Proof: by monoid_exp_1. *)
1039val ring_exp_1 = lift_monoid_thm "exp_1" "exp_1";
1040(* > val ring_exp_1 = |- !r. Ring r ==> !x. x IN R ==> (x ** 1 = x) : thm *)
1041
1042val _ = export_rewrites ["ring_exp_1"];
1043
1044(* Theorem: x ** n * x = x * x ** n *)
1045(* Proof: by monoid_exp_comm. *)
1046val ring_exp_comm = lift_monoid_thm "exp_comm" "exp_comm";
1047(* > val ring_exp_comm = |- !r. Ring r ==> !x. x IN R ==> !n. x ** n * x = x * x ** n: thm *)
1048
1049(* Theorem: (x * y) ** n = x ** n * y ** n *)
1050(* Proof: by monoid_comm_op_exp. *)
1051Theorem ring_mult_exp[simp]:
1052    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> !n. (x * y) ** n = x ** n * y ** n
1053Proof
1054  rw_tac std_ss[monoid_comm_op_exp, ring_mult_monoid]
1055QED
1056
1057
1058(* Theorem: computation of small values of ring_exp *)
1059(* Proof: apply ring_exp_SUC. *)
1060Theorem ring_exp_small:
1061    !r:'a ring. Ring r ==> !x. x IN R ==>
1062       (x ** 0 = #1) /\
1063       (x ** 1 = x) /\
1064       (x ** 2 = x * x) /\
1065       (x ** 3 = x * (x ** 2)) /\
1066       (x ** 4 = x * (x ** 3)) /\
1067       (x ** 5 = x * (x ** 4)) /\
1068       (x ** 6 = x * (x ** 5)) /\
1069       (x ** 7 = x * (x ** 6)) /\
1070       (x ** 8 = x * (x ** 7)) /\
1071       (x ** 9 = x * (x ** 8))
1072Proof
1073  rpt strip_tac >>
1074  `(2 = SUC 1) /\ (3 = SUC 2) /\ (4 = SUC 3) /\ (5 = SUC 4) /\
1075   (6 = SUC 5) /\ (7 = SUC 6) /\ (8 = SUC 7) /\ (9 = SUC 8)` by decide_tac >>
1076  metis_tac[ring_exp_SUC, ring_exp_1, ring_exp_0]
1077QED
1078
1079(* ------------------------------------------------------------------------- *)
1080(* Ring Distribution Theorems.                                               *)
1081(* ------------------------------------------------------------------------- *)
1082
1083(* Theorem: x * (y + z) = x * y + x * z *)
1084(* Proof: by definition. *)
1085Theorem ring_mult_radd[simp] =
1086  Ring_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH_ALL |> CONJUNCTS |> last |> DISCH_ALL |> GEN_ALL;
1087(* > val ring_mult_radd = |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x * (y + z) = x * y + x * z) : thm *)
1088
1089
1090(* Theorem: (y + z) * x = y * x + z * x *)
1091(* Proof: by ring_mult_radd and ring_mult_comm. *)
1092Theorem ring_mult_ladd[simp]:
1093    !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((y + z) * x = y * x + z * x)
1094Proof
1095  rw[ring_mult_comm]
1096QED
1097
1098
1099(*
1100- ring_mult_radd |> SPEC_ALL |> UNDISCH |> SPEC_ALL |> UNDISCH;
1101> val it =  [..] |- x * (y + z) = x * y + x * z : thm
1102- ring_mult_ladd |> SPEC_ALL |> UNDISCH |> SPEC_ALL |> UNDISCH;
1103> val it =  [..] |- (y + z) * x = y * x + z * x : thm
1104- CONJ (ring_mult_radd |> SPEC_ALL |> UNDISCH |> SPEC_ALL |> UNDISCH)
1105       (ring_mult_ladd |> SPEC_ALL |> UNDISCH |> SPEC_ALL |> UNDISCH) |> DISCH_ALL |> GEN_ALL;
1106> val it = |- !z y x r. x IN R /\ y IN R /\ z IN R ==>
1107              Ring r ==> (x * (y + z) = x * y + x * z) /\ ((y + z) * x = y * x + z * x) : thm
1108- CONJ (ring_mult_radd |> SPEC_ALL |> UNDISCH |> SPEC_ALL |> UNDISCH)
1109       (ring_mult_ladd |> SPEC_ALL |> UNDISCH |> SPEC_ALL |> UNDISCH) |> DISCH ``x IN R /\ y IN R /\ z IN R``
1110       |> DISCH_ALL |> GEN_ALL;
1111> val it = |- !z y x r. Ring r ==>
1112               x IN R /\ y IN R /\ z IN R ==> (x * (y + z) = x * y + x * z) /\ ((y + z) * x = y * x + z * x) : thm
1113- CONJ (ring_mult_radd |> SPEC_ALL |> UNDISCH |> SPEC_ALL |> UNDISCH)
1114       (ring_mult_ladd |> SPEC_ALL |> UNDISCH |> SPEC_ALL |> UNDISCH) |> DISCH ``x IN R /\ y IN R /\ z IN R`` |> GEN_ALL
1115       |> DISCH_ALL |> GEN_ALL;
1116> val it = |- !r. Ring r ==> !z y x. x IN R /\ y IN R /\ z IN R ==>
1117      (x * (y + z) = x * y + x * z) /\ ((y + z) * x = y * x + z * x) : thm
1118*)
1119
1120(* Theorem: x * (y + z) = x * y + x * z /\ (y + z) * x = y * x + z * x *)
1121(* Proof: by ring_mult_ladd and ring_mult_radd. *)
1122Theorem ring_mult_add =
1123    CONJ (ring_mult_radd |> SPEC_ALL |> UNDISCH |> SPEC_ALL |> UNDISCH)
1124         (ring_mult_ladd |> SPEC_ALL |> UNDISCH |> SPEC_ALL |> UNDISCH)
1125         |> DISCH ``x IN R /\ y IN R /\ z IN R`` |> GEN_ALL
1126         |> DISCH_ALL |> GEN_ALL;
1127(* > val ring_mult_add =
1128    |- !r. Ring r ==> !z y x. x IN R /\ y IN R /\ z IN R ==>
1129           (x * (y + z) = x * y + x * z) /\ ((y + z) * x = y * x + z * x) : thm *)
1130
1131(* Theorem: ##(SUC n) * x = (##n) * x + x *)
1132(* Proof:
1133     ##(SUC n) * x
1134   = (##n + #1) * x            by ring_num_suc
1135   = ##n * x + #1 * x          by ring_mult_ladd
1136   = ##n * x + x               by ring_mult_lone
1137*)
1138Theorem ring_num_mult_suc:
1139    !r:'a ring. Ring r ==> !x. x IN R ==> !n. ##(SUC n) * x = ##n * x + x
1140Proof
1141  rw[ring_add_comm]
1142QED
1143
1144(* Theorem: computation of small values of ring multiplication with ##n. *)
1145(* Proof: apply ring_num_mult_suc. *)
1146Theorem ring_num_mult_small:
1147    !r:'a ring. Ring r ==> !x. x IN R ==>
1148       (#0 * x = #0) /\
1149       (#1 * x = x) /\
1150       (##2 * x = x + x) /\
1151       (##3 * x = ##2 * x + x)
1152Proof
1153  rw_tac std_ss[RES_FORALL_THM] >-
1154  rw[] >-
1155  rw[] >-
1156  (`2 = SUC 1` by decide_tac >> metis_tac[ring_num_mult_suc, ring_mult_lone, ring_num_1]) >>
1157  (`3 = SUC 2` by decide_tac >> metis_tac[ring_num_mult_suc])
1158QED
1159
1160(* ------------------------------------------------------------------------- *)
1161(* Ring Negation Theorems                                                    *)
1162(* ------------------------------------------------------------------------- *)
1163
1164(* old:
1165val ring_neg_def = Define `ring_neg (r:'a ring) = r.sum.inv`;
1166val _ = overload_on ("numeric_negate", ``ring_neg r``); (* unary negation *)
1167*)
1168Overload numeric_negate = ``r.sum.inv``(* unary negation *)
1169
1170(* Theorem: Ring negatives in carrier. *)
1171(* Proof: by group_inv_element. *)
1172val ring_neg_element = lift_group_thm "inv_element" "neg_element";
1173(* > val ring_neg_element = |- !r. Ring r ==> !x. x IN R ==> -x IN R : thm *)
1174
1175val _ = export_rewrites ["ring_neg_element"];
1176
1177(* Theorem: - #0 = #0 *)
1178(* Proof: by group_inv_id. *)
1179val ring_neg_zero = lift_group_thm "inv_id" "neg_zero";
1180(* > val ring_neg_zero = |- !r. Ring r ==> (-#0 = #0) : thm *)
1181
1182val _ = export_rewrites ["ring_neg_zero"];
1183
1184(* Theorem: (-x) + x = #0 *)
1185(* Proof: by group_linv. *)
1186val ring_add_lneg = lift_group_thm "linv" "add_lneg";
1187(* > val ring_add_lneg = |- !r. Ring r ==> !x. x IN R ==> (-x + x = #0) : thm *)
1188
1189(* Theorem: x + (-x) = #0 *)
1190(* Proof: by group_rinv. *)
1191val ring_add_rneg = lift_group_thm "rinv" "add_rneg";
1192(* > val ring_add_rneg = |- !r. Ring r ==> !x. x IN R ==> (x + -x = #0) : thm *)
1193
1194val _ = export_rewrites ["ring_add_lneg", "ring_add_rneg"];
1195
1196(* Theorem:  x + (-x + y) = y /\ (-x) + (x + y) = y *)
1197(* Proof: by group_linv_assoc. *)
1198val ring_add_lneg_assoc = lift_group_thm "linv_assoc" "add_lneg_assoc";
1199(* > val ring_add_lneg_assoc = |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (y = x + (-x + y)) /\ (y = -x + (x + y)) : thm *)
1200
1201(* Theorem: y + -x + x = y /\ y + x + -x = y *)
1202(* Proof: by group_rinv_assoc. *)
1203val ring_add_rneg_assoc = lift_group_thm "rinv_assoc" "add_rneg_assoc";
1204(* > val ring_add_rneg_assoc = |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (y = y + -x + x) /\ (y = y + x + -x) : thm *)
1205
1206(* Theorem: [Left-cancellation] (x + y = x + z) = (y = z) *)
1207(* Proof: by group_lcancel. *)
1208val ring_add_lcancel = lift_group_thm "lcancel" "add_lcancel";
1209(* > val ring_add_lcancel = |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x + y = x + z) <=> (y = z)) : thm *)
1210
1211(* Theorem: [Right-cancellation] (y + x = z + x) = (y = z) *)
1212(* Proof: by group_rcancel. *)
1213val ring_add_rcancel = lift_group_thm "rcancel" "add_rcancel";
1214(* > val ring_add_rcancel = |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((y + x = z + x) <=> (y = z)) : thm *)
1215
1216(* Theorem: x = x + x <=> x = #0 *)
1217(* Proof: by group_id_fix. *)
1218val ring_zero_fix = lift_group_thm "id_fix" "zero_fix";
1219(* > val ring_zero_fix = |- !r. Ring r ==> !x. x IN R ==> ((x + x = x) <=> (x = #0)) : thm *)
1220
1221(* Theorem: - (- x) = x *)
1222(* Proof: by group_inv_inv for r.sum group. *)
1223val ring_neg_neg = lift_group_thm "inv_inv" "neg_neg";
1224(* > val ring_neg_neg = |- !r. Ring r ==> !x. x IN R ==> (--x = x) : thm *)
1225
1226val _ = export_rewrites ["ring_neg_neg"];
1227
1228(* Theorem: -x = #0 <=> x = #0 *)
1229(* Proof: by group_inv_eq_id. *)
1230val ring_neg_eq_zero = lift_group_thm "inv_eq_id" "neg_eq_zero";
1231(* > val ring_neg_eq_zero = |- !r. Ring r ==> !x. x IN R ==> ((-x = #0) <=> (x = #0)) : thm *)
1232
1233(* Theorem: - x = - y <=> x = y *)
1234(* Proof: by group_inv_eq for r.sum group. *)
1235val ring_neg_eq = lift_group_thm "inv_eq" "neg_eq";
1236(* > val ring_neg_eq = |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> ((-x = -y) <=> (x = y)) : thm *)
1237
1238(* Theorem: -x = y <=> x = - y *)
1239(* Proof: by group_inv_eq_swap. *)
1240val ring_neg_eq_swap = lift_group_thm "inv_eq_swap" "neg_eq_swap";
1241(* > val ring_neg_eq_swap = |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> ((-x = y) <=> (x = -y)) : thm *)
1242
1243(* Theorem: x + y = #0 <=> y = -x  *)
1244(* Proof: by group_rinv_unique for r.sum group. *)
1245val ring_add_eq_zero = lift_group_thm "rinv_unique" "add_eq_zero";
1246(* > val ring_add_eq_zero = |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> ((x + y = #0) <=> (y = -x)) : thm *)
1247
1248(* Theorem: - (x + y) = -y + -x *)
1249(* Proof: by group_inv_op for r.sum group. *)
1250val ring_neg_add_comm = lift_group_thm "inv_op" "neg_add_comm";
1251(* > val ring_neg_add_comm = |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (-(x + y) = -y + -x) : thm *)
1252
1253(* Theorem: For ring, - (x + y) = -x + -y *)
1254(* Proof: by ring_neg_add_comm and ring_add_comm. *)
1255Theorem ring_neg_add[simp]:
1256    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (- (x + y) = -x + -y)
1257Proof
1258  rw[ring_neg_add_comm, ring_add_comm]
1259QED
1260
1261
1262(* ------------------------------------------------------------------------- *)
1263(* Ring Distribution Theorems with Negation.                                 *)
1264(* ------------------------------------------------------------------------- *)
1265
1266(* Theorem: -x * y = - (x * y) *)
1267(* Proof:
1268     (x * y) + (-x * y)
1269   = (x + -x)* y            by ring_mult_ladd
1270   = #0 * y                 by ring_add_rneg
1271   = #0                     by ring_mult_lzero
1272   Hence -x * y = - (x*y)   by ring_add_eq_zero
1273*)
1274Theorem ring_mult_lneg[simp]:
1275    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (- x * y = - (x * y))
1276Proof
1277  rpt strip_tac >>
1278  `- x IN R /\ x * y IN R /\ - x * y IN R` by rw[] >>
1279  `x * y + (- x) * y = (x + -x) * y` by rw_tac std_ss[ring_mult_ladd] >>
1280  metis_tac[ring_add_eq_zero, ring_add_rneg, ring_mult_lzero]
1281QED
1282
1283(* Theorem: x * - y = - (x * y) *)
1284(* Proof: by ring_mult_lneg and ring_mult_comm. *)
1285Theorem ring_mult_rneg[simp]:
1286    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (x * - y = - (x * y))
1287Proof
1288  metis_tac[ring_mult_lneg, ring_mult_comm, ring_neg_element]
1289QED
1290
1291(* Theorem: -(x * y) = -x * y  and -(x * y) = x * -y *)
1292(* Proof: by ring_mult_lneg and ring_mult_rneg. *)
1293Theorem ring_neg_mult[simp]:
1294    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (- (x * y) = - x * y) /\ (- (x * y) = x * - y)
1295Proof
1296  rw[]
1297QED
1298
1299(* Theorem: - x * - y = x * y *)
1300(* Proof:
1301     - x * - y
1302   = - (x * - y)     by ring_mult_lneg
1303   = - (- (x * y))   by ring_mult_rneg
1304   = x * y           by ring_mult_neg_neg
1305*)
1306Theorem ring_mult_neg_neg[simp]:
1307    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (- x * - y = x * y)
1308Proof
1309  metis_tac[ring_mult_lneg, ring_mult_rneg, ring_neg_neg, ring_neg_element]
1310QED
1311
1312(* ------------------------------------------------------------------------- *)
1313(* More Ring Numeral Theorems (involving distribution eventually).           *)
1314(* ------------------------------------------------------------------------- *)
1315
1316(* Theorem: ##(n + k) = ##n + ##k *)
1317(* Proof: by  group_exp_add. *)
1318val ring_num_add = lift_group_exp "add" "add";
1319(* > val ring_num_add = |- !r. Ring r ==> !n k. ##(n + k) = ##n + ##k : thm *)
1320
1321(* Theorem: ##m + (##n + x) = ##(m+n) + x *)
1322(* Proof: by ring_num_add.
1323     ##m + (##n + x)
1324   = ##m + ##n + x     by ring_add_assoc
1325   = ##(m + n) + x     by ring_num_add
1326*)
1327Theorem ring_num_add_assoc:
1328    !r:'a ring. Ring r ==> !x. x IN R ==> !m n. ##m + (##n + x) = ##(m + n) + x
1329Proof
1330  metis_tac[ring_num_add, ring_add_assoc, ring_num_element]
1331QED
1332
1333(* Theorem: ##m * ##n = ##(m * n) *)
1334(* Proof: by induction on m.
1335   Base case: !n. #0 * ##n = ##(0 * n)
1336      #0 * ##n
1337    = #0                    by ring_mult_lzero
1338    = ##(0 * n)             by MULT
1339   Step case: !n. ##m * ##n = ##(m * n) ==> !n. ##(SUC m) * ##n = ##(SUC m * n)
1340      ##(SUC m) * ##n
1341    = (##m + #1) * ##n      by ring_num_suc
1342    = ##m * ##n + #1 * ##n  by ring_mult_ladd
1343    = ##(m * n) + #1 * ##n  by induction hypothesis
1344    = ##(m * n) + ##n       by ring_mult_lone
1345    = ##(m * n + n)         by ring_num_add
1346    = ##(SUC m * n)         by MULT
1347*)
1348Theorem ring_num_mult:
1349    !r:'a ring. Ring r ==> !m n. (##m) * (##n) = ##(m * n)
1350Proof
1351  strip_tac >>
1352  strip_tac >>
1353  Induct >-
1354  rw[] >>
1355  rpt strip_tac >>
1356  `##(SUC m) * ##n = (##m + #1) * ##n` by rw_tac std_ss[ring_num_suc] >>
1357  `_ = ##(m * n) + ##n` by rw[ring_mult_ladd] >>
1358  rw_tac std_ss[ring_num_add, MULT]
1359QED
1360
1361(* Theorem: ##m * (##n * x) = ##(m * n) * x *)
1362(* Proof: by ring_num_mult.
1363     ##m * (##n * x)
1364   = ##m * ##n * x      by ring_mult_assoc
1365   = ##(m * n) * x     by ring_num_mult
1366*)
1367Theorem ring_num_mult_assoc:
1368    !r:'a ring. Ring r ==> !m n x. x IN R ==> ((##m) * (##n * x) = ##(m * n) * x)
1369Proof
1370  metis_tac[ring_num_mult, ring_mult_assoc, ring_num_element]
1371QED
1372
1373(* Theorem: (##m) ** n = ##(m**n) *)
1374(* Proof: by induction on n.
1375   Base case: ##m ** 0 = ##(m ** 0)
1376      ##m ** 0
1377    = #1               by ring_exp_0
1378    = ##(m ** 0)        by EXP
1379   Step case: ##m ** n = ##(m ** n) ==> ##m ** SUC n = ##(m ** SUC n)
1380      ##m ** SUC n
1381    = ##m ** n * ##m     by ring_exp_suc
1382    = ##(m ** n) * ##m   by induction hypothesis
1383    = ##(m ** n * m)    by ring_num_mult
1384    = ##(m ** SUC n)    by EXP
1385*)
1386Theorem ring_num_exp:
1387    !r:'a ring. Ring r ==> !m n. (##m) ** n = ##(m ** n)
1388Proof
1389  rpt strip_tac >>
1390  Induct_on `n` >>
1391  rw[ring_num_mult, EXP]
1392QED
1393
1394(* Theorem: ##(m + n) * x = ##m * x + ##n * x *)
1395(* Proof:
1396     ##(m + n) * x
1397   = (##m + ##n) * x     by ring_num_add
1398   = ##m * x + ##n * x   by ring_mult_ladd
1399*)
1400Theorem ring_num_add_mult:
1401    !r:'a ring. Ring r ==> !x. x IN R ==> !m n. ##(m + n) * x = ##m * x + ##n * x
1402Proof
1403  metis_tac[ring_num_add, ring_mult_ladd, ring_num_element]
1404QED
1405
1406(* Theorem: ##(m + n) * x + y = ##m * x + (##n * x + y) *)
1407(* Proof: by ring_num_add_mult.
1408     ##(m + n) * x + y
1409   = ##m * x + ##n * x + y     by ring_num_add_mult
1410   = ##m * x + (##n * x + y)   by ring_add_assoc
1411*)
1412Theorem ring_num_add_mult_assoc:
1413    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> !m n. ##(m + n) * x + y = ##m * x + (##n * x + y)
1414Proof
1415  rw_tac std_ss[ring_num_add_mult, ring_add_assoc, ring_num_mult_element]
1416QED
1417
1418(* Theorem: - (##n * x) = ##n * (- x) *)
1419(* Proof: by ring_mult_rneg. *)
1420Theorem ring_num_mult_neg:
1421    !r:'a ring. Ring r ==> !x. x IN R ==> !n. - (##n * x) = ##n * (- x)
1422Proof
1423  rw_tac std_ss[ring_mult_rneg, ring_num_element]
1424QED
1425
1426(* Theorem: ##n * (x + y) = ##n * x + ##n * y *)
1427(* Proof: by ring_mult_radd. *)
1428Theorem ring_num_mult_radd:
1429    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> !n. ##n * (x + y) = ##n * x + ##n * y
1430Proof
1431  rw[]
1432QED
1433
1434(* Theorem: x + x = ##2 * x *)
1435(* Proof: by ring_num_mult_small. *)
1436Theorem ring_single_add_single:
1437    !r:'a ring. Ring r ==> !x. x IN R ==> (x + x = ##2 * x)
1438Proof
1439  rw_tac std_ss[ring_num_mult_small]
1440QED
1441
1442(* Theorem: x + (x + y) = ##2 * x + y *)
1443(* Proof: by ring_single_add_single. *)
1444Theorem ring_single_add_single_assoc:
1445    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (x + (x + y) = ##2 * x + y)
1446Proof
1447  metis_tac[ring_single_add_single, ring_add_assoc]
1448QED
1449
1450(* Theorem: x + ##n * x = ##(n+1) * x *)
1451(* Proof:
1452     x + ##n * x
1453   = #1 * x + ##n * x   by ring_mult_lone
1454   = ##(1 + n) * x      by ring_num_add_mult
1455   = ##(n+1) * x        by ADD_COMM
1456*)
1457Theorem ring_single_add_mult:
1458    !r:'a ring. Ring r ==> !x. x IN R ==> !n. x + ##n * x = ##(n + 1) * x
1459Proof
1460  metis_tac[ring_mult_lone, ring_num_add_mult, ring_num_1, ADD_COMM]
1461QED
1462
1463(* Theorem: x + (##n * x + y) = ##(n+1) * x + y *)
1464(* Proof: by ring_single_add_mult.
1465     x + (##n * x + y)
1466   = x + ##n * x + y     by ring_add_assoc
1467   = ##(n+1) * x + y     by ring_single_add_mult
1468*)
1469Theorem ring_single_add_mult_assoc:
1470    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> !n. x + (##n * x + y) = ##(n + 1) * x + y
1471Proof
1472  rw_tac std_ss[RES_FORALL_THM] >>
1473  `x + (##n * x + y) = x + ##n * x + y` by rw[ring_add_assoc] >>
1474  rw_tac std_ss[ring_single_add_mult]
1475QED
1476
1477(* Theorem: x + - (##n * x) = (n = 0) ? x : - ##(n-1) * x *)
1478(* Proof: by cases on n.
1479   case n = 0:
1480     x + - (#0 * x)
1481   = x + - #0       by ring_mult_lzero
1482   = x + #0         by ring_neg_zero
1483   = x              by ring_add_rzero
1484   case n <> 0:
1485     x + - (##n * x)
1486   = - - x + - (##n * x)            by ring_neg_neg
1487   = - (- x + ##n * x)              by ring_neg_add
1488   = - (- x + (#1 * x + ##(n-1)*x)) by ring_num_add_mult, n = 1 + (n-1) for n <> 0
1489   = - (- x + (x + ##(n-1) * x))    by ring_mult_lone
1490   = - (##(n-1) * x)                by ring_add_assoc, ring_add_lneg, ring_add_lzero
1491*)
1492Theorem ring_single_add_neg_mult:
1493    !r:'a ring. Ring r ==> !x. x IN R ==> !n. x + -(##n * x) = if n = 0 then x else -(##(n - 1) * x)
1494Proof
1495  rpt strip_tac >>
1496  rw_tac std_ss[ring_num_0] >-
1497  rw_tac std_ss[ring_mult_lzero, ring_neg_zero, ring_add_rzero] >>
1498  `n = 1 + (n-1)` by decide_tac >>
1499  `#1 IN R /\ - #1 IN R /\ -x IN R /\ ##n IN R /\ ##(n-1) IN R` by rw[] >>
1500  `x + - (##n * x) = - (- x + ##n * x)` by rw_tac std_ss[ring_neg_neg, ring_neg_add, ring_num_mult_element] >>
1501  `_ = - (-x + (#1 * x + ##(n-1) * x))` by metis_tac[ring_num_add_mult, ring_num_1] >>
1502  `_ = - (-x + x + ##(n-1) * x)` by rw[ring_add_assoc] >>
1503  rw_tac std_ss[ring_add_lneg, ring_add_lzero, ring_num_mult_element]
1504QED
1505
1506(* Theorem: x + (- ##n * x + y) = (n = 0) ? x + y : - ##(n-1) * x + y  *)
1507(* Proof: by ring_single_add_neg_mult. *)
1508Theorem ring_single_add_neg_mult_assoc:
1509    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==>
1510   !n. x + ((- (##n * x)) + y) = if n = 0 then x + y else - (##(n - 1) * x) + y
1511Proof
1512  rpt strip_tac >>
1513  `x + ((- ((##n) * x)) + y) = x + (- ((##n) * x)) + y`
1514    by rw_tac std_ss[ring_add_assoc, ring_num_mult_element, ring_neg_element] >>
1515  rw_tac std_ss[ring_single_add_neg_mult]
1516QED
1517
1518(* Theorem: ##n * x + - x = (n = 0) ? - x : ##(n - 1) * x *)
1519(* Proof: by cases on n.
1520   case n = 0:
1521     #0 * x + -x
1522   = #0 + -x        by ring_mult_lzero
1523   = -x             by ring_add_lzero
1524   case n <> 0:
1525     ##n * x + -x
1526   = ##(n-1) * x + #1 * x + -x  by ring_num_add_mult, n = (n-1) + 1 for n <> 0
1527   = ##(n-1) * x + (x + -x)     by ring_mult_lone, ring_add_assoc
1528   = ##(n-1) * x                by ring_add_rneg, ring_add_rzero
1529*)
1530Theorem ring_mult_add_neg:
1531    !r:'a ring. Ring r ==> !x. x IN R ==> !n. ##n * x + - x = if n = 0 then - x else ##(n - 1) * x
1532Proof
1533  rpt strip_tac >>
1534  rw_tac std_ss[ring_num_0] >-
1535  rw_tac std_ss[ring_mult_lzero, ring_add_lzero, ring_neg_element] >>
1536  `n = n-1 + 1` by decide_tac >>
1537  `##n IN R /\ ##(n-1) IN R /\ -x IN R` by rw[] >>
1538  `##n * x + - x = ##(n - 1) * x + #1 * x + - x` by metis_tac[ring_num_add_mult, ring_num_1] >>
1539  `_ = ##(n-1) * x + (x + - x)` by rw_tac std_ss[ring_mult_lone, ring_add_assoc, ring_mult_element] >>
1540  rw_tac std_ss[ring_add_rneg, ring_add_rzero, ring_mult_element]
1541QED
1542
1543(* Theorem: ##n * x + (- x + y) = (n = 0) ? - x + y : ##(n - 1) * x + y *)
1544(* Proof: by ring_mult_add_neg. *)
1545Theorem ring_mult_add_neg_assoc:
1546    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> !n. ##n * x + (- x + y) = if n = 0 then - x + y else ##(n - 1) * x + y
1547Proof
1548  rpt strip_tac >>
1549  `##n * x + (- x + y) = ##n * x + - x + y` by rw[ring_add_assoc] >>
1550  metis_tac[ring_mult_add_neg]
1551QED
1552
1553(* Theorem: ##m * x + - (##n * x) = if m < n then - (##(n - m) * x) else ##(m - n) * x *)
1554(* Proof: by cases on m < n.
1555   case m < n: n = m + (n - m)
1556     ##m * x + - (##n * x)
1557   = ##m * x + - (##m * x + ##(n-m) * x)   by ring_num_add_mult
1558   = ##m * x + - (##m * x) - ##(n-m) * x   by ring_neg_add, ring_add_assoc
1559   = - ##(n-m) * x                       by ring_add_rneg, ring_add_lzero
1560   case m >= n: m = (m - n) + n
1561     ##m * x + - (##n * x)
1562   = ##(m-n) * x + ##n * x + - (##n * x)   by ring_num_add_mult
1563   = ##(m-n) * x + (##n * x + - (##n * x)) by ring_add_assoc
1564   = ##(m-n) * x                         by ring_add_rneg, ring_add_rzero
1565*)
1566Theorem ring_mult_add_neg_mult:
1567    !r:'a ring. Ring r ==> !x. x IN R ==> !m n. ##m * x + - (##n * x) = if m < n then - (##(n - m) * x) else ##(m - n) * x
1568Proof
1569  rpt strip_tac >>
1570  rw_tac std_ss[] >| [
1571    `n = m + (n - m)` by decide_tac >>
1572    `##m * x + - (##n * x) = ##m * x + - (##m * x + ##(n - m) * x)` by metis_tac[ring_num_add_mult] >>
1573    `_ = ##m * x + - (##m * x) + - (##(n-m) * x)`
1574      by rw_tac std_ss[ring_neg_add, ring_add_assoc, ring_num_mult_element, ring_neg_element] >>
1575    rw_tac std_ss[ring_add_rneg, ring_add_lzero, ring_num_mult_element, ring_neg_element],
1576    `m = m - n + n` by decide_tac >>
1577    `##m * x + - (##n * x) = ##(m - n) * x + ##n * x + - (##n * x)` by metis_tac[ring_num_add_mult] >>
1578    rw_tac std_ss[ring_add_assoc, ring_add_rneg, ring_add_rzero, ring_num_mult_element, ring_neg_element]
1579  ]
1580QED
1581
1582(* Theorem: ##m * x + (- (##n * x) + y) = if m < n then - (##(n - m) * x) + y else ##(m - n) * x + y *)
1583(* Proof: by ring_mult_add_neg_mult. *)
1584Theorem ring_mult_add_neg_mult_assoc:
1585    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==>
1586   !m n. ##m * x + (- (##n * x) + y) = if m < n then - (##(n - m) * x) + y else ##(m - n) * x + y
1587Proof
1588  rpt strip_tac >>
1589  `##m * x + (- (##n * x) + y) = ##m * x + - (##n * x) + y`
1590    by rw_tac std_ss[ring_add_assoc, ring_num_mult_element, ring_neg_element] >>
1591  rw_tac std_ss[ring_mult_add_neg_mult]
1592QED
1593
1594(* Theorem: - x + - x = - (##2 * x) *)
1595(* Proof:
1596     - x + - x
1597   = - (x + x)     by ring_neg_add
1598   = - (##2 * x)   by ring_num_mult_small
1599*)
1600Theorem ring_neg_add_neg:
1601    !r:'a ring. Ring r ==> !x. x IN R ==> (- x + - x = - (##2 * x))
1602Proof
1603  rw_tac std_ss[ring_neg_add, ring_num_mult_small]
1604QED
1605
1606(* Theorem: - x + (- x + y) = - (##2 * x) + y *)
1607(* Proof: by ring_neg_add_neg. *)
1608Theorem ring_neg_add_neg_assoc:
1609    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (- x + (- x + y) = - (##2 * x) + y)
1610Proof
1611  rpt strip_tac >>
1612  `- x + (- x + y) = - x + - x + y` by rw[ring_add_assoc] >>
1613  rw_tac std_ss[ring_neg_add_neg]
1614QED
1615
1616(* Theorem:  - x + - (##n * x) = - (##(n + 1) * x) *)
1617(* Proof:
1618     - x + - (##n * x)
1619   = - x + ##n * (- x)    by ring_num_mult_neg
1620   = ##(n+1) * (- x)      by ring_single_add_mult
1621   = - (##(n+1) * x)      by ring_num_mult_neg
1622*)
1623Theorem ring_neg_add_neg_mult:
1624    !r:'a ring. Ring r ==> !x. x IN R ==> !n. - x + - (##n * x) = - (##(n + 1) * x)
1625Proof
1626  rw_tac std_ss[ring_num_mult_neg, ring_single_add_mult, ring_neg_element]
1627QED
1628
1629(* Theorem: - x + (- (##n * x) + y) = - (##(n + 1) * x) + y *)
1630(* Proof: by ring_neg_add_neg_mult. *)
1631Theorem ring_neg_add_neg_mult_assoc:
1632    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> !n.  - x + (- (##n * x) + y) = - (##(n + 1) * x) + y
1633Proof
1634  rpt strip_tac >>
1635  `- x + (- (##n * x) + y) = - x + - (##n * x) + y`
1636    by rw_tac std_ss[ring_add_assoc, ring_num_mult_element, ring_neg_element] >>
1637  rw_tac std_ss[ring_neg_add_neg_mult]
1638QED
1639
1640(* Theorem: - (##m * x) + - (##n * x) = - (##(m + n) * x) *)
1641(* Proof:
1642     - (##m * x) + - (##n * x)
1643   = ##m * (-x) + ##n * (-x)   by ring_num_mult_neg
1644   = ##(m + n) * (-x)         by ring_num_add_mult
1645   = - (##(m + n) * x)        by ring_num_mult_neg
1646*)
1647Theorem ring_neg_mult_add_neg_mult:
1648    !r:'a ring. Ring r ==> !x. x IN R ==> !m n. - (##m * x) + - (##n * x) = - (##(m + n) * x)
1649Proof
1650  rw_tac std_ss[ring_num_add_mult, ring_num_mult_neg, ring_neg_element]
1651QED
1652
1653(* Theorem: - (##m * x) + (- (##n * x) + y) = - (##(m + n) * x) + y *)
1654(* Proof: by ring_neg_mult_add_neg_mult.
1655     - (##m * x) + (- (##n * x) + y)
1656   = - (##m * x) + -(##n * x) + y    by ring_add_assoc
1657   = - (##(m + n) * x) + y           by ring_neg_mult_add_neg_mult
1658*)
1659Theorem ring_neg_mult_add_neg_mult_assoc:
1660    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> !m n. - (##m * x) + (- (##n * x) + y) = - (##(m + n) * x) + y
1661Proof
1662  rpt strip_tac >>
1663  `- (##m * x) + (- (##n * x) + y) = - (##m * x) + - (##n * x) + y`
1664    by rw_tac std_ss[ring_add_assoc, ring_num_mult_element, ring_neg_element] >>
1665  rw_tac std_ss[ring_neg_mult_add_neg_mult]
1666QED
1667
1668(* ------------------------------------------------------------------------- *)
1669(* More Ring Exponent Theorems.                                              *)
1670(* ------------------------------------------------------------------------- *)
1671
1672(* Theorem: x * x = x ** 2 *)
1673(* Proof: by ring_exp_small. *)
1674Theorem ring_single_mult_single:
1675    !r:'a ring. Ring r ==> !x. x IN R ==> (x * x = x ** 2)
1676Proof
1677  rw_tac std_ss[ring_exp_small]
1678QED
1679
1680(* Theorem: x * (x * y) = x ** 2 * y *)
1681(* Proof: by ring_single_mult_single. *)
1682Theorem ring_single_mult_single_assoc:
1683    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (x * (x * y) = x ** 2 * y)
1684Proof
1685  metis_tac[ring_mult_assoc, ring_single_mult_single]
1686QED
1687
1688(* Theorem: x * x ** n = x ** (n + 1) *)
1689(* Proof: by ring_exp_def. *)
1690Theorem ring_single_mult_exp:
1691    !r:'a ring. Ring r ==> !x. x IN R ==> !n. x * x ** n = x ** (n + 1)
1692Proof
1693  metis_tac[ring_exp_SUC, ADD1]
1694QED
1695
1696(* Theorem: x * x ** n = x ** (n + 1) *)
1697(* Proof: by ring_single_mult_exp. *)
1698Theorem ring_single_mult_exp_assoc:
1699    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> !n. x * ((x ** n) * y) = (x ** (n + 1)) *  y
1700Proof
1701  rpt strip_tac >>
1702  `x * (x ** n * y) = x * x ** n * y` by rw_tac std_ss[ring_mult_assoc, ring_exp_element] >>
1703  rw_tac std_ss[ring_single_mult_exp]
1704QED
1705
1706(* Theorem: x ** (n + k) = x ** n * x ** k *)
1707(* Proof: by monoid_exp_add. *)
1708val ring_exp_add = lift_monoid_thm "exp_add" "exp_add";
1709(* > val ring_exp_add = |- !r. Ring r ==> !x. x IN R ==> !n k. x ** (n + k) = x ** n * x ** k : thm *)
1710
1711val _ = export_rewrites ["ring_exp_add"];
1712
1713(* Theorem: x ** m * (x ** n * y) = x ** (m + n) * y *)
1714(* Proof: by ring_exp_add. *)
1715Theorem ring_exp_add_assoc:
1716    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> !n k. x ** n * (x ** k * y) = x ** (n + k) * y
1717Proof
1718  rw_tac std_ss[ring_exp_add, ring_mult_assoc, ring_exp_element]
1719QED
1720
1721(* Theorem: #1 ** n = #1 *)
1722(* Proof: by monoid_id_exp and r.prod a monoid. *)
1723val ring_one_exp = lift_monoid_thm "id_exp" "one_exp";
1724(* > val ring_one_exp = |- !r. Ring r ==> !n. #1 ** n = #1 : thm *)
1725
1726val _ = export_rewrites ["ring_one_exp"];
1727
1728(* Theorem: #0 ** n = (n = 0) ? #1 : #0 *)
1729(* Proof: by cases on n = 0.
1730   If n = 0, #0 ** 0 = #1                     by ring_exp_0.
1731   If n <> 0, #0 ** n = #0 * #0 ** (n-1) = #0 by ring_exp_SUC, ring_mult_lzero.
1732*)
1733Theorem ring_zero_exp:
1734    !r:'a ring. Ring r ==> !n. #0 ** n = if n = 0 then #1 else #0
1735Proof
1736  rpt strip_tac >>
1737  rw_tac std_ss[] >-
1738  rw[] >>
1739  `n = SUC (n-1)` by decide_tac >>
1740  metis_tac[ring_exp_SUC, ring_mult_lzero, ring_exp_element, ring_zero_element]
1741QED
1742(*
1743val ring_zero_exp = store_thm(
1744  "ring_zero_exp",
1745  ``!r:'a ring. Ring r ==> !n. #0 ** n = if n = 0 then #1 else #0``,
1746  rpt strip_tac >>
1747  rw_tac std_ss[] >-
1748  rw[] >>
1749  metis_tac[ring_exp_SUC, ring_mult_lzero, ring_exp_element, ring_zero_element, DECIDE ``n <> 0 ==> (n = SUC (n-1))``]);
1750*)
1751
1752(* Theorem: x ** (m * n) = (x ** m) ** n *)
1753(* Proof: by monoid_exp_mult. *)
1754val ring_exp_mult = lift_monoid_thm "exp_mult" "exp_mult";
1755(* > val ring_exp_mult = |- !r. Ring r ==> !x. x IN R ==> !n k. x ** (n * k) = (x ** n) ** k : thm *)
1756
1757val _ = export_rewrites ["ring_exp_mult"];
1758
1759(* Theorem: Ring r ==> !x. x IN R ==> !n m. (x ** n) ** m = (x ** m) ** n *)
1760(* Theorem: x ** (m * n) = (x ** n) ** m *)
1761(* Proof: by monoid_exp_mult_comm. *)
1762val ring_exp_mult_comm = lift_monoid_thm "exp_mult_comm" "exp_mult_comm";
1763(* > val ring_exp_mult_comm = |- !r. Ring r ==> !x. x IN R ==> !m n. (x ** m) ** n = (x ** n) ** m: thm *)
1764
1765(* Theorem: (-x) ** 2 = x ** 2 *)
1766(* Proof:
1767     ((-x) ** 2)
1768   = (-x) * (-x)    by ring_single_mult_single
1769   = - (- (x * x))  by ring_mult_lneg, ring_mult_rneg
1770   = x * x          by ring_neg_neg
1771   = x ** 2         by ring_single_mult_single
1772*)
1773Theorem ring_neg_square:
1774    !r:'a ring. Ring r ==> !x. x IN R ==> ((- x) ** 2 = x ** 2)
1775Proof
1776  metis_tac[ring_single_mult_single, ring_mult_lneg, ring_mult_rneg, ring_neg_neg, ring_neg_element]
1777QED
1778
1779(* Theorem: (- x) ** n = if EVEN n then x ** n else - (x ** n) *)
1780(* Proof: by cases on EVEN n.
1781   case EVEN n: n = 2*m
1782     (-x) ** n
1783   = ((-x) ** 2) ** m      by ring_exp_mult
1784   = (x**2) ** m           by ring_neg_square
1785   = x ** n                by ring_exp_mult
1786   case ~EVEN n: n = 2*m + 1
1787      Since n <> 0, n = SUC(n-1) and EVEN (n-1).
1788     (-x) ** n
1789   = (-x) * (-x) ** (n-1)  by ring_exp_def, n = SUC(n-1)
1790   = (-x) * (x ** (n-1))   by EVEN (n-1)
1791   = -(x * x ** (n-1))     by ring_mult_lneg
1792   = - (x ** n)            by ring_exp_def
1793*)
1794Theorem ring_exp_neg:
1795    !r:'a ring. Ring r ==> !x. x IN R ==> !n. (- x) ** n = if EVEN n then x ** n else - (x ** n)
1796Proof
1797  rpt strip_tac >>
1798  `-x IN R` by rw[] >>
1799  `!n. EVEN n ==> ((-x) ** n = x ** n)` by
1800  (rw_tac std_ss[EVEN_EXISTS] >>
1801  metis_tac[ring_neg_square, ring_exp_mult]) >>
1802  rw_tac std_ss[] >>
1803  `n <> 0 ==> (n = SUC(n-1))` by decide_tac >>
1804  `EVEN (n-1) /\ (n = SUC(n-1))` by metis_tac[EVEN] >>
1805  metis_tac[ring_exp_SUC, ring_mult_lneg, ring_exp_element]
1806QED
1807
1808(* Same theorem, better proof. *)
1809
1810(* Theorem: Ring r ==> !x. x IN R ==>
1811            !n. -x ** n = if EVEN n then x ** n else -(x ** n) *)
1812(* Proof:
1813   By induction on n.
1814   Base case: -x ** 0 = if EVEN 0 then x ** 0 else -(x ** 0)
1815      LHS = -x ** 0
1816          = #1          by ring_exp_0
1817      RHS = x ** 0      by EVEN, EVEN 0 = T
1818          = #1 = LHS    by ring_exp_0
1819   Step case: -x ** n = if EVEN n then x ** n else -(x ** n) ==>
1820              -x ** SUC n = if EVEN (SUC n) then x ** SUC n else -(x ** SUC n)
1821      If EVEN n, ~EVEN (SUC n)     by EVEN
1822         -x ** SUC n
1823       = -x * (-x ** n)            by ring_exp_SUC
1824       = -x * x ** n               by induction hypothesis
1825       = -(x * x ** n)             by ring_mult_lneg
1826       = - x ** SUC n              by ring_exp_SUC
1827      If ~EVEN n, EVEN (SUC n)     by EVEN
1828         -x ** SUC n
1829       = -x * (-x ** n)            by ring_exp_SUC
1830       = -x * (-(x ** n))          by induction hypothesis
1831       = x * -(-(x ** n))          by ring_mult_lneg
1832       = x * x ** n                by ring_neg_neg
1833       = x ** SUC n                by ring_exp_SUC
1834*)
1835Theorem ring_neg_exp:
1836    !r:'a ring. Ring r ==> !x. x IN R ==>
1837   !n. -x ** n = if EVEN n then x ** n else -(x ** n)
1838Proof
1839  rpt strip_tac >>
1840  Induct_on `n` >-
1841  rw[] >>
1842  rw_tac std_ss[ring_exp_SUC, EVEN] >-
1843  rw_tac std_ss[ring_mult_lneg, ring_exp_element] >>
1844  rw[]
1845QED
1846
1847(* Theorem: ##k * ##m ** n = ##(k * m ** n) *)
1848(* Proof: by induction on n.
1849   Base case: ##k * ##m ** 0 = ##(k * m ** 0)
1850     LHS = ##k * ##m ** 0
1851         = ##k * #1          by ring_exp_0
1852         = ##k               by ring_mult_rone
1853         = ##(k * 1)         by MULT_RIGHT_1
1854         = ##(k * m ** 0)    by EXP: m ** 0 = 1
1855         = RHS
1856   Step case: ##k * ##m ** n = ##(k * m ** n) ==>
1857              ##k * ##m ** SUC n = ##(k * m ** SUC n)
1858      ##k * ##m ** SUC n
1859    = ##k * (##m * ##m ** n)   by ring_exp_SUC
1860    = ##k * ##m * ##m ** n     by ring_mult_assoc
1861    = ##m * ##k * ##m ** n     by ring_mult_comm
1862    = ##m * (##k * ##m ** n)   by ring_mult_assoc
1863    = ##m * ##(k * m ** n)     by induction hypothesis
1864    = ##(m * (k * m ** n))     by ring_num_mult
1865    = ##(m * k * m ** n)       by MULT_ASSOC
1866    = ##(k * m * m ** n)       by MULT_COMM
1867    = ##(k * (m * m ** n))     by MULT_ASSOC
1868    = ##(k * m ** SUC n)       by EXP
1869*)
1870Theorem ring_num_mult_exp:
1871    !r:'a ring. Ring r ==> !k m n. ##k * ##m ** n = ##(k * m ** n)
1872Proof
1873  rpt strip_tac >>
1874  Induct_on `n` >-
1875  rw[EXP] >>
1876  `##k * ##m ** SUC n = ##k * ##m * ##m ** n` by rw[ring_mult_assoc] >>
1877  `_ = ##m * ##k * ##m ** n` by rw_tac std_ss [ring_mult_comm, ring_num_element] >>
1878  `_ = ##m * ##(k * m ** n)` by rw[ring_mult_assoc] >>
1879  `_ = ##(m * k * m ** n)` by rw[ring_num_mult] >>
1880  `_ = ##(k * m * m ** n)` by rw_tac std_ss[MULT_COMM] >>
1881  rw[EXP]
1882QED
1883
1884(* Theorem: Ring r ==> !x. x IN R /\ 0 < order r.prod x ==> !n. x ** n = x ** (n MOD (order r.prod x) *)
1885(* Proof:
1886   Since Ring r ==> Monoid r.prod    by ring_mult_monoid
1887   Hence result follows              by monoid_exp_mod_order, ring_carriers
1888*)
1889Theorem ring_exp_mod_order:
1890    !r:'a ring. Ring r ==> !x. x IN R /\ 0 < order r.prod x ==> !n. x ** n = x ** (n MOD (order r.prod x))
1891Proof
1892  metis_tac[ring_mult_monoid, monoid_exp_mod_order, ring_carriers]
1893QED
1894
1895(* ------------------------------------------------------------------------- *)
1896(* Ring Subtraction Theorems.                                                *)
1897(* ------------------------------------------------------------------------- *)
1898Definition ring_sub_def[simp]:   ring_sub (r:'a ring) x y = x + (- y)
1899End
1900Overload "-" = ``ring_sub r``
1901
1902(* Theorem: Ring r ==> x - #0 = x *)
1903(* Proof:
1904     x - #0
1905   = x + -#0    by ring_sub_def
1906   = x + #0     by ring_neg_zero
1907   = x          by ring_add_rzero
1908*)
1909Theorem ring_sub_zero:
1910    !r:'a ring. Ring r ==> !x. x IN R ==> (x - #0 = x)
1911Proof
1912  rw[]
1913QED
1914
1915(* Theorem: (x - y = #0) <=> (x = y) *)
1916(* Proof:
1917       x - y = #0
1918   <=> x + -y = #0   by ring_sub_def
1919   <=> -x = -y       by ring_add_eq_zero
1920   <=> x = y         by ring_neg_neg
1921*)
1922Theorem ring_sub_eq_zero:
1923    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> ((x - y = #0) = (x = y))
1924Proof
1925  metis_tac[ring_sub_def, ring_add_eq_zero, ring_neg_neg, ring_neg_element]
1926QED
1927
1928(* Theorem: x - x = #0 *)
1929(* Proof: by ring_sub_eq_zero. *)
1930Theorem ring_sub_eq:
1931    !r:'a ring. Ring r ==> !x y. x IN R ==> (x - x = #0)
1932Proof
1933  rw_tac std_ss[ring_sub_eq_zero]
1934QED
1935
1936(* Theorem: x - y IN R *)
1937(* Proof: by definition, and ring_add_element, ring_neg_element. *)
1938Theorem ring_sub_element[simp]:
1939    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> x - y IN R
1940Proof
1941  rw[]
1942QED
1943
1944
1945(* Theorem: Ring r ==> !x. x IN R ==> (#0 - x = -x) *)
1946(* Proof:
1947     #0 - x
1948   = #0 + (-x)       by ring_sub_def
1949   = -x              by ring_add_lzero
1950*)
1951Theorem ring_zero_sub:
1952    !r:'a ring. Ring r ==> !x. x IN R ==> (#0 - x = -x)
1953Proof
1954  rw[]
1955QED
1956
1957(* Theorem: Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x - y = x - z) <=> (y = z)) *)
1958(* Proof:
1959   Note -y IN R /\ -z IN R       by ring_neg_element
1960           x - y = x - z
1961    <=> x + (-y) = x + (-z)      by ring_sub_def
1962    <=>       -y = -z            by ring_add_lcancel
1963    <=>        y = z             by ring_neg_neg
1964*)
1965Theorem ring_sub_lcancel:
1966    !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x - y = x - z) <=> (y = z))
1967Proof
1968  rw[ring_add_lcancel]
1969QED
1970
1971(* Theorem: Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((y - x = z - x) <=> (y = z)) *)
1972(* Proof:
1973   Note -x IN R                  by ring_neg_element
1974           y - x = z - x
1975    <=> y + (-x) = z + (-x)      by ring_sub_def
1976    <=>        y = z             by ring_add_rcancel
1977*)
1978Theorem ring_sub_rcancel:
1979    !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((y - x = z - x) <=> (y = z))
1980Proof
1981  rw[ring_add_rcancel]
1982QED
1983
1984(* Theorem: -(x - y) = y - x *)
1985(* Proof:
1986     -(x - y)
1987   = -(x + -y)     by ring_sub_def
1988   = -x + --y      by ring_neg_add
1989   = -x + y        by ring_neg_neg
1990   = y + -x        by ring_add_comm
1991   = y - x         by ring_sub_def
1992*)
1993Theorem ring_neg_sub:
1994    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (-(x - y) = y - x )
1995Proof
1996  rw[ring_sub_def, ring_add_comm]
1997QED
1998
1999(* Theorem: x + y - y = x *)
2000(* Proof:
2001     x + y - y
2002   = x + y + -y     by ring_sub_def
2003   = x + (y + -y)   by ring_add_assoc, ring_neg_element
2004   = x + #0         by ring_add_rneg
2005   = x              by ring_add_rzero
2006*)
2007Theorem ring_add_sub:
2008    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (x + y - y = x)
2009Proof
2010  rw[ring_add_assoc]
2011QED
2012
2013(* Theorem: y + x - y = x *)
2014(* Proof:
2015     y + x - y
2016   = x + y - y     by ring_add_comm
2017   = x             by ring_add_sub
2018*)
2019Theorem ring_add_sub_comm:
2020    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (y + x - y = x)
2021Proof
2022  metis_tac[ring_add_sub, ring_add_comm]
2023QED
2024
2025(* Theorem: Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x + y - z = x + (y - z)) *)
2026(* Proof:
2027     x + y - z
2028   = x + y + (-z)    by ring_sub_def
2029   = x + (y + (-z))  by ring_add_assoc, ring_neg_element
2030   = x + (y - z)     by ring_sub_def
2031*)
2032Theorem ring_add_sub_assoc:
2033    !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x + y - z = x + (y - z))
2034Proof
2035  rw_tac std_ss[ring_sub_def, ring_neg_element, ring_add_assoc]
2036QED
2037
2038(* Theorem: x - y + y = x *)
2039(* Proof:
2040     x - y + y
2041   = x + -y + y     by ring_sub_def
2042   = x + (-y + y)   by ring_add_assoc, ring_neg_element
2043   = x + #0         by ring_add_lneg
2044   = x              by ring_add_rzero
2045*)
2046Theorem ring_sub_add:
2047    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> (x - y + y = x)
2048Proof
2049  rw[ring_add_assoc]
2050QED
2051
2052(* Theorem: x = y <=> x + z = y + z *)
2053(* This is ring_add_rcancel:
2054   |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((y + x = z + x) <=> (y = z)) *)
2055
2056(* Theorem: x - y = z <=> x = y + z *)
2057(* Proof:
2058       x - y = z
2059   <=> x - y + y = z + y      by ring_add_sub
2060   <=>         x = z + y      by ring_sub_add
2061   <=>         x = y + z      by ring_add_comm
2062*)
2063Theorem ring_sub_eq_add:
2064    !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x - y = z) <=> (x = y + z))
2065Proof
2066  rpt strip_tac >>
2067  `(x - y = z) <=> (x - y + y = z + y)` by metis_tac[ring_add_sub, ring_sub_element] >>
2068  rw[ring_sub_add, ring_add_comm]
2069QED
2070
2071(* Theorem: Ring r ==> (x + z) - (y + z) = x - y *)
2072(* Proof:
2073   Since Ring r ==> Group r.sum and r.sum.carrier = R   by ring_add_group
2074     (x + z) - (y + z)
2075   = (x + z) + (-(y + z))   by ring_sub_def
2076   = x + -y                 by group_pair_reduce
2077   = x - y                  by ring_sub_def
2078
2079   Should use Theorem Lifting of group_pair_reduce.
2080*)
2081Theorem ring_sub_pair_reduce:
2082    !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x + z) - (y + z) = x - y)
2083Proof
2084  rw_tac std_ss[ring_sub_def, ring_add_group, group_pair_reduce]
2085QED
2086
2087(* Theorem: Ring r ==> !x y z t. x IN R /\ y IN R /\ z IN R /\ t IN R ==>
2088                       ((x + y = z + t) <=> (x - z = t - y)) *)
2089(* Proof:
2090       x + y = z + t
2091   <=> x = z + t - y      by ring_add_sub, ring_sub_add, ring_add_element
2092   <=> x = z + (t - y)    by ring_add_assoc, ring_sub_def, ring_neg_element
2093   <=> x = (t - y) + z    by ring_add_comm, ring_sub_element
2094   <=> x - z = t - y      by ring_add_sub, ring_sub_element
2095*)
2096Theorem ring_add_sub_identity:
2097    !r:'a ring. Ring r ==> !x y z t. x IN R /\ y IN R /\ z IN R /\ t IN R ==>
2098    ((x + y = z + t) <=> (x - z = t - y))
2099Proof
2100  rpt strip_tac >>
2101  `(t - y) IN R /\ (z + t) IN R` by rw[] >>
2102  rw_tac std_ss[EQ_IMP_THM] >| [
2103    `x = z + t - y` by metis_tac[ring_add_sub] >>
2104    `_ = t - y + z` by rw[ring_add_comm, ring_add_assoc] >>
2105    metis_tac[ring_add_sub],
2106    `x = t - y + z` by metis_tac[ring_sub_add] >>
2107    `_ = z + t - y` by rw[ring_add_comm, ring_add_assoc] >>
2108    metis_tac[ring_sub_add]
2109  ]
2110QED
2111
2112(* Theorem: Ring r ==> x * z - y * z = (x - y) * z *)
2113(* Proof:
2114     x * z - y * z
2115   = x * z + (- (y * z))    by ring_sub_def
2116   = x * z + (- y) * z      by ring_neg_mult
2117   = (x + (-y)) * z         by ring_mult_ladd
2118   = (x - y) * z            by ring_sub_def
2119*)
2120Theorem ring_mult_lsub:
2121    !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x * z) - (y * z) = (x - y) * z)
2122Proof
2123  rw_tac std_ss[ring_neg_mult, ring_mult_ladd, ring_neg_element, ring_sub_def]
2124QED
2125
2126(* Theorem: Ring r ==> x * y - x * z = x * (y - z) *)
2127(* Proof:
2128     x * y - x * z
2129   = y * x - z * x     by ring_mult_comm
2130   = (y - z) * x       by ring_mult_lsub
2131   = x * (y - z)       by ring_mult_comm, ring_sub_element
2132*)
2133Theorem ring_mult_rsub:
2134    !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x * y - x * z = x * (y - z))
2135Proof
2136  rpt strip_tac >>
2137  `x * y - x * z = y * x - z * x` by rw_tac std_ss[ring_mult_comm] >>
2138  `_ = (y - z) * x` by rw_tac std_ss[ring_mult_lsub] >>
2139  `_ = x * (y - z)` by rw_tac std_ss[ring_mult_comm, ring_sub_element] >>
2140  metis_tac[]
2141QED
2142
2143(* Theorem: Ring r ==> x + y - (p + q) = (x - p) + (y - q)  *)
2144(* Proof:
2145     x + y - (p + q)
2146   = x + y + -(p + q)       by ring_sub_def
2147   = x + y + (- p + - q)    by ring_neg_add
2148   = (x + y + - p) + - q    by ring_add_assoc
2149   = (y + x + - p) + - q    by ring_add_comm
2150   = y + (x + - p) + - q    by ring_add_assoc
2151   = ((x + - p) + y) + - q  by ring_add_comm
2152   = (x + - p) + (y + - q)  by ring_add_assoc
2153   = (x - p) + (y - q)      by ring_sub_def
2154*)
2155Theorem ring_add_pair_sub:
2156    !r:'a ring. Ring r ==> !x y p q. x IN R /\ y IN R /\ p IN R /\ q IN R ==> (x + y - (p + q) = (x - p) + (y - q))
2157Proof
2158  rpt strip_tac >>
2159  `x + y - (p + q) = x + y + (- p + - q)` by rw[] >>
2160  `_ = (x + y + - p) + - q` by rw[ring_add_assoc] >>
2161  `_ = (y + x + - p) + - q` by rw_tac std_ss[ring_add_comm] >>
2162  `_ = y + (x + - p) + - q` by rw[ring_add_assoc] >>
2163  `_ = ((x + - p) + y) + - q` by rw_tac std_ss[ring_add_comm, ring_add_element, ring_neg_element] >>
2164  `_ = (x + - p) + (y + - q)` by rw[ring_add_assoc] >>
2165  `_ = (x - p) + (y - q)` by rw_tac std_ss[ring_sub_def] >>
2166  rw_tac std_ss[]
2167QED
2168
2169(* Theorem: Ring r ==> x * y - p * q = (x - p) * (y - q) + (x - p) * q + p * (y - q) *)
2170(* Proof:
2171   (x - p) * (y - q) = x * y - x * q - p * y + p * q    by ring_mult_ladd, ring_mult_radd
2172   Hence
2173   x * y - p * q = (x - p) * (y - q) + x * q + p * y - p * q - p * q
2174                 = (x - p) * (y - q) + (x * q - p * q) + (p * y - p * q)
2175                 = (x - p) * (y - q) + (x - p) * q + p * (y - q)
2176*)
2177Theorem ring_mult_pair_sub:
2178    !r:'a ring. Ring r ==> !x y p q. x IN R /\ y IN R /\ p IN R /\ q IN R ==>
2179               (x * y - p * q = (x - p) * (y - q) + (x - p) * q + p * (y - q))
2180Proof
2181  rw_tac std_ss[ring_sub_def] >>
2182  `-x IN R /\ -y IN R /\ -p IN R /\ -q IN R` by rw[] >>
2183  `(x + -p) IN R /\ (y + -q) IN R` by rw[] >>
2184  `(x + -p) * (y + -q) + (x + -p) * q + p * (y + -q) =
2185    (x + -p) * (y + -q + q) + p * (y + -q)` by rw_tac std_ss[ring_mult_radd] >>
2186  `_ = (x + -p) * y + p * (y + -q)` by rw_tac std_ss[ring_add_lneg, ring_add_rzero, ring_add_assoc] >>
2187  `_ = (x * y + -p * y) + (p * y + p * -q)` by rw_tac std_ss[ring_mult_ladd, ring_mult_radd] >>
2188  `_ = (x * y + -(p * y)) + (p * y + -(p * q))` by metis_tac[ring_neg_mult] >>
2189  `_ = x * y + (-(p * y) + p * y) + -(p * q)` by
2190    rw_tac std_ss[ring_add_assoc, ring_mult_element, ring_add_element, ring_neg_element] >>
2191  `_ = x * y + - (p * q)` by rw_tac std_ss[ring_mult_element, ring_add_lneg, ring_add_rzero] >>
2192  rw_tac std_ss[]
2193QED
2194
2195(* Theorem: Ring r ==> !x y p q. x IN R /\ y IN R /\ p IN R /\ q IN R ==>
2196                       (x * y - p * q = (x - p) * y + p * (y - q)) *)
2197(* Proof:
2198     x * y - p * q
2199   = x * y + #0 - p * q                    by ring_add_rzero
2200   = x * y + (-(p * y) + p * y) - p * q    by ring_add_lneg
2201   = (x * y + -(p * y)) + p * y - p * q    by ring_add_assoc
2202   = (x * y - p * y) + p * y - p * q       by ring_sub_def
2203   = (x * y - p * y) + (p * y - p * q)     by ring_add_sub_assoc
2204   = (x - p) * y + (p * y - p * q)         by ring_mult_lsub
2205   = (x - p) * y + p * (y - q)             by ring_mult_rsub
2206*)
2207Theorem ring_mult_pair_diff:
2208    !r:'a ring. Ring r ==> !x y p q. x IN R /\ y IN R /\ p IN R /\ q IN R ==>
2209       (x * y - p * q = (x - p) * y + p * (y - q))
2210Proof
2211  rpt strip_tac >>
2212  `!x y. x IN R /\ y IN R ==> -x IN R /\ (x * y) IN R` by rw[] >>
2213  `x * y - p * q = x * y + #0 - p * q` by rw_tac std_ss[ring_add_rzero] >>
2214  `_ = x * y + (-(p * y) + p * y) - p * q` by rw_tac std_ss[ring_add_lneg] >>
2215  `_ = x * y + -(p * y) + p * y - p * q` by prove_tac[ring_add_assoc] >>
2216  `_ = x * y - p * y + p * y - p * q` by rw_tac std_ss[ring_sub_def] >>
2217  `_ = (x * y - p * y) + (p * y - p * q)` by rw_tac std_ss[ring_add_sub_assoc, ring_sub_element] >>
2218  `_ = (x - p) * y + (p * y - p * q)` by rw_tac std_ss[ring_mult_lsub] >>
2219  `_= (x - p) * y + p * (y - q)` by rw_tac std_ss[ring_mult_rsub] >>
2220  rw_tac std_ss[]
2221QED
2222
2223(* Theorem: Ring r ==> !n m. m < n ==> ##(n - m) = ##n - ##m *)
2224(* Proof:
2225   Since ##(n - m) + ##m = ##(n - m + m) = ##n
2226   and   ##n - ##m + ##m = ##n + (-##m + ##m) = ##n
2227   The results follows by ring_add_rcancel.
2228*)
2229Theorem ring_num_sub:
2230    !r:'a ring. Ring r ==> !n m. m < n ==> (##(n - m) = ##n - ##m)
2231Proof
2232  rpt strip_tac >>
2233  `##(n - m) + ##m = ##(n - m + m)` by rw[] >>
2234  `_ = ##n` by rw_tac arith_ss[] >>
2235  `##n - ##m + ##m = ##n` by rw[ring_add_assoc] >>
2236  `##m IN R /\ ##(n - m) IN R /\ (##n - ##m) IN R` by rw[] >>
2237  metis_tac[ring_add_rcancel]
2238QED
2239
2240(* ------------------------------------------------------------------------- *)
2241(* Ring Binomial Expansions.                                                 *)
2242(* ------------------------------------------------------------------------- *)
2243
2244(* These may not be useful, but they demonstrate various HOL techniques to work against increasing complexity. *)
2245
2246(* Theorem: (x + y) ** 2 = x ** 2 + ##2 * (x * y) + y ** 2 *)
2247(* Proof:
2248     (x + y) ** 2
2249   = (x + y) * (x + y)                  by ring_exp_small
2250   = x * (x + y) + y * (x + y)          by ring_mult_ladd
2251   = x * x + x * y + (y * x + y * y)    by ring_mult_radd
2252   = x * x + (x * y + (y * x + y * y))  by ring_add_assoc
2253   = x * x + (x * y + y * x + y * y)    by ring_add_assoc
2254   = x * x + (x * y + x * y + y * y)    by ring_mult_comm
2255   = x ** 2 + (x * y + x * y + y ** 2)  by ring_exp_small
2256   = x ** 2 + (##2 (x * y) + y **2)     by ring_num_mult_small
2257   = x ** 2 + ##2 (x * y) + y ** 2      by ring_add_assoc
2258*)
2259Theorem ring_binomial_2:
2260    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==> ((x + y) ** 2 = x ** 2 + ##2 * (x * y) + y ** 2)
2261Proof
2262  rw[ring_exp_small, ring_num_mult_small, ring_mult_comm, ring_add_assoc]
2263QED
2264
2265(* Theorem: (x + y) ** 3 =
2266            x ** 3 + ##3 * (x ** 2 * y) + ##3 * (x * y ** 2) + y ** 3 *)
2267(* Proof:
2268     (x + y) ** 3
2269   = (x + y) * (x + y) ** 2                                                                              by ring_exp_small
2270   = (x + y) * (x ** 2 + ##2 * (x * y) + y ** 2)                                                        by ring_binomial_2
2271   = (x + y) * (x ** 2 + (##2 * (x * y) + y ** 2))                                                        by ring_add_assoc
2272   = x * (x ** 2 + (##2 * (x * y) + y ** 2)) + y * (x ** 2 + (##2 * (x * y) + y ** 2))                     by ring_mult_ladd
2273   = x * x ** 2 + x * (##2 * (x * y) + y ** 2) + (y * x ** 2 + y * (##2 * (x * y) + y ** 2))               by ring_mult_radd
2274   = x * x ** 2 + (x * (##2 * (x * y)) + x * y ** 2) + (y * x ** 2 + (y * (##2 * (x * y)) + y * y ** 2))   by ring_mult_radd
2275   = x * x ** 2 + ((##2 * (x * y)) * x + x * y ** 2) + (x ** 2 * y + ((##2 * (x * y)) * y + y * y ** 2))   by ring_mult_comm
2276   = x * x ** 2 + ((##2 * (x * y)) * x + (x * y ** 2 + x ** 2 * y + (##2 * (x * y)) * y + y * y ** 2))     by ring_add_assoc
2277   = x * x ** 2 + ((##2 * (x * y)) * x + (x ** 2 * y + x * y ** 2 + (##2 * (x * y)) * y + y * y ** 2))     by ring_add_comm
2278   = x * x ** 2 + ((##2 * (x * y)) * x + x ** 2 * y + (x * y ** 2 + ##2 * (x * y) * y + y * y ** 2))       by ring_add_assoc
2279   First cross term:
2280     ##2 * (x * y)) * x + x ** 2 * y
2281   = ##2 * (x * y * x) + x ** 2 * y      by ring_mult_assoc
2282   = ##2 * (x * (y * x)) + x ** 2 * y    by ring_mult_assoc
2283   = ##2 * (x * (x * y)) + x ** 2 * y    by ring_mult_comm
2284   = ##2 * (x * x * y) + x ** 2 * y      by ring_mult_assoc
2285   = ##2 * (x ** 2 * y) + x ** 2 * y     by ring_exp_small
2286   = x ** 2 * y + ##2 * (x ** 2 * y)     by ring_add_comm
2287   = ##3 * (x ** 2 * y)                  by ring_single_add_mult
2288   Next cross term:
2289     x * y ** 2 + ##2 * (x * y) * y
2290   = x * y ** 2 + ##2 * ((x * y) * y)    by ring_mult_assoc
2291   = x * y ** 2 + ##2 * (x * y * y)      by ring_mult_assoc
2292   = x * y ** 2 + ##2 * (x * (y * y))    by ring_mult_assoc
2293   = x * y ** 2 + ##2 * (x * y **2)      by ring_exp_small
2294   = ##3 * (x * y ** 2)                  by ring_single_add_mult
2295   Overall, apply ring_exp_small, ring_add_assoc.
2296*)
2297Theorem ring_binomial_3:
2298    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==>
2299    ((x + y) ** 3 = x ** 3 + ##3 * (x ** 2 * y) + ##3 * (x * y ** 2) + y ** 3)
2300Proof
2301  rpt strip_tac >>
2302  `x ** 2 IN R /\ ##2 * (x * y) IN R /\ y ** 2 IN R` by rw[] >>
2303  `(x + y) ** 3 = (x + y) * (x ** 2 + ##2 * (x * y) + y ** 2)` by rw[ring_binomial_2, ring_exp_small] >>
2304  `_ = (x + y) * (x ** 2 + (##2 * (x * y) + y ** 2))` by rw[ring_add_assoc] >>
2305  `_ = x * x ** 2 + (x * (##2 * (x * y)) + x * y ** 2) + (y * x ** 2 + (y * (##2 * (x * y)) + y * y ** 2))` by rw[] >>
2306  `_ = x * x ** 2 + ((##2 * (x * y)) * x + x * y ** 2) + (x ** 2 * y + ((##2 * (x * y)) * y + y * y ** 2))`
2307    by rw[ring_mult_comm] >>
2308  `_ = x * x ** 2 + ((##2 * (x * y)) * x + (x * y ** 2 + x ** 2 * y + (##2 * (x * y)) * y + y * y ** 2))`
2309    by rw[ring_add_assoc] >>
2310  `_ = x * x ** 2 + ((##2 * (x * y)) * x + (x ** 2 * y + x * y ** 2 + (##2 * (x * y)) * y + y * y ** 2))`
2311    by rw[ring_add_comm] >>
2312  `_ = x * x ** 2 + ((##2 * (x * y)) * x + x ** 2 * y + (x * y ** 2 + ##2 * (x * y) * y + y * y ** 2))`
2313    by rw[ring_add_assoc] >>
2314  `(##2 * (x * y)) * x + x ** 2 * y = ##2 * (x * x * y) + x ** 2 * y` by rw[ring_mult_assoc, ring_mult_comm] >>
2315  `_ = ##2 * (x ** 2 * y) + x ** 2 * y` by rw[ring_exp_small] >>
2316  `_ = x ** 2 * y + ##2 * (x ** 2 * y)` by rw[ring_add_comm] >>
2317  `_ = ##3 * (x ** 2 * y)` by rw_tac std_ss[ring_single_add_mult, ring_mult_element] >>
2318  `x * y ** 2 + ##2 * (x * y) * y = x * y ** 2 + ##2 * (x * (y * y))` by rw[ring_mult_assoc] >>
2319  `_ = x * y ** 2 + ##2 * (x * y **2)` by rw[ring_exp_small] >>
2320  `_ = ##3 * (x * y ** 2)` by rw_tac std_ss[ring_single_add_mult, ring_mult_element] >>
2321  `x ** 3 + ##3 * (x ** 2 * y) + ##3 * (x * y ** 2) + y ** 3 =
2322   x ** 3 + (##3 * (x ** 2 * y) + (##3 * (x * y ** 2) + y ** 3))` by rw[ring_add_assoc] >>
2323  rw_tac std_ss[ring_exp_small]
2324QED
2325
2326(* Theorem:  (x + y) ** 4 =
2327              x ** 4 + ##4 * (x ** 3 * y) + ##6 * (x ** 2 * y ** 2) + ##4 * (x * y ** 3) + y ** 4 *)
2328(* Proof:
2329     (x + y) ** 4
2330   = (x + y) * (x + y) ** 3                                                                 by ring_exp_small
2331   = (x + y) * (x ** 3 + ##3 * (x ** 2 * y) + ##3 * (x * y ** 2) + y ** 3)                  by ring_binomial_3
2332   = (x + y) * (x ** 3 + (##3 * (x ** 2 * y) + (##3 * (x * y ** 2) + y ** 3)))                by ring_add_assoc
2333   = x * (x ** 3 + (##3 * (x ** 2 * y) + (##3 * (x * y ** 2) + y ** 3))) +
2334        y * (x ** 3 + (##3 * (x ** 2 * y) + (##3 * (x * y ** 2) + y ** 3)))                   by ring_mult_ladd
2335   = (x * x ** 3 + (x * (##3 * (x ** 2 * y)) + (x * (##3 * (x * y ** 2)) + x * y ** 3))) +
2336        (y * x ** 3 + (y * (##3 * (x ** 2 * y)) + (y * (##3 * (x * y ** 2)) + y * y ** 3)))   by ring_mult_radd
2337   = (x * x ** 3 + (x * (##3 * (x ** 2 * y)) + x * (##3 * (x * y ** 2)) + x * y ** 3)) +
2338        (y * x ** 3 + (y * (##3 * (x ** 2 * y)) + y * (##3 * (x * y ** 2)) + y * y ** 3))     by ring_add_assoc
2339   = (x ** 4 + (x * (##3 * (x ** 2 * y)) + x * (##3 * (x * y ** 2)) + x * y ** 3)) +
2340        (y * x ** 3 + (y * (##3 * (x ** 2 * y)) + y * (##3 * (x * y ** 2)) + y ** 4))         by ring_exp_small
2341
2342   Let  x3y = x ** 3 * y
2343       x2y2 = x ** 2 * y ** 2
2344        xy3 = x * y ** 3
2345   First term:
2346     x * (##3 * (x ** 2 * y))
2347   = ##3 * (x ** 2 * y) * x        by ring_mult_comm
2348   = ##3 * (x ** 2 * y * x)        by ring_mult_assoc
2349   = ##3 * (x ** 2 * (y * x))      by ring_mult_assoc
2350   = ##3 * (x ** 2 * (x * y))      by ring_mult_comm
2351   = ##3 * (x ** 2 * x * y)        by ring_mult_assoc
2352   = ##3 * (x * x ** 2 * y)        by ring_mult_comm
2353   = ##3 * (x ** 3 * y)            by ring_exp_small
2354   = ##3 * x3y
2355   Second term:
2356     x * (##3 * (x * y ** 2))
2357   = ##3 * (x * y ** 2) * x        by ring_mult_comm
2358   = ##3 * (x * y ** 2 * x)        by ring_mult_assoc
2359   = ##3 * (x * (y ** 2 * x))      by ring_mult_assoc
2360   = ##3 * (x * (x * y ** 2))      by ring_mult_comm
2361   = ##3 * (x * x * y ** 2)        by ring_mult_assoc
2362   = ##3 * (x ** 2 * y ** 2)       by ring_exp_small
2363   = ##3 * x2y2
2364   Third term:
2365     y * x ** 3
2366   = x ** 3 * y                   by ring_mult_comm
2367   = x3y
2368   Fourth term:
2369     y * (##3 * (x ** 2 * y))
2370   = ##3 * (x ** 2 * y) * y        by ring_mult_comm
2371   = ##3 * (x ** 2 * y * y)        by ring_mult_assoc
2372   = ##3 * (x ** 2 * (y * y))      by ring_mult_assoc
2373   = ##3 * (x ** 2 * y ** 2)       by ring_exp_small
2374   = ##3 * x2y2
2375   Fifth term:
2376     y * (##3 * (x * y ** 2))
2377   = ##3 * (x * y ** 2) * y        by ring_mult_comm
2378   = ##3 * ((x * y ** 2) * y)      by ring_mult_assoc
2379   = ##3 * (x * (y ** 2 * y))      by ring_mult_assoc
2380   = ##3 * (x * (y * y ** 2))      by ring_mult_comm
2381   = ##3 * (x * y ** 3)            by ring_exp_small
2382   = ##3 * xy3
2383   Simplify expansion:
2384     x ** 4 + (x * (##3 * (x ** 2 * y)) + x * (##3 * (x * y ** 2)) + xy3) +
2385       (y * x ** 3 + (y * (##3 * (x ** 2 * y)) + y * (##3 * (x * y ** 2)) + y ** 4))
2386   = x ** 4 + (##3 * x3y + ##3 * x2y2 + xy3) + (x3y + (##3 * x2y2 + ##3 * xy3 + y ** 4))
2387   = x ** 4 + (##3 * x3y + ##3 * x2y2 + xy3 + x3y + (##3 * x2y2 + ##3 * xy3 + y ** 4))    by ring_add_assoc
2388   = x ** 4 + (x3y + (##3 * x3y + ##3 * x2y2 + xy3) + (##3 * x2y2 + ##3 * xy3 + y ** 4))  by ring_add_comm
2389   = x ** 4 + (x3y + ##3 * x3y + ##3 * x2y2 + xy3 + (##3 * x2y2 + ##3 * xy3 + y ** 4))    by ring_add_assoc
2390   = x ** 4 + (##4 * x3y + ##3 * x2y2 + xy3 + (##3 * x2y2 + ##3 * xy3 + y ** 4))          by ring_single_add_mult
2391   = x ** 4 + (##4 * x3y + (##3 * x2y2 + xy3) + (##3 * x2y2 + ##3 * xy3 + y ** 4))        by ring_add_assoc
2392   = x ** 4 + (##4 * x3y + (##3 * x2y2 + xy3 + (##3 * x2y2 + ##3 * xy3 + y ** 4)))        by ring_add_assoc
2393   = x ** 4 + (##4 * x3y + (##3 * x2y2 + xy3 + (##3 * x2y2 + (##3 * xy3 + y ** 4))))      by ring_add_assoc
2394   = x ** 4 + (##4 * x3y + (##3 * x2y2 + (xy3 + ##3 * x2y2 + (##3 * xy3 + y ** 4))))      by ring_add_assoc
2395   = x ** 4 + (##4 * x3y + (##3 * x2y2 + (##3 * x2y2 + xy3 + (##3 * xy3 + y ** 4))))      by ring_add_comm
2396   = x ** 4 + (##4 * x3y + (##3 * x2y2 + ##3 * x2y2 + (xy3 + ##3 * xy3 + y ** 4)))        by ring_add_assoc
2397   = x ** 4 + (##4 * x3y + (##6 * x2y2 + (xy3 + ##3 * xy3 + y ** 4)))                    by ring_num_add_mult
2398   = x ** 4 + (##4 * x3y + (##6 * x2y2 + (##4 * xy3 + y ** 4)))                          by ring_single_add_mult
2399   = x ** 4 +  ##4 * x3y +  ##6 * x2y2 +  ##4 * xy3 + y ** 4                             by ring_add_assoc
2400   Hence true.
2401*)
2402Theorem ring_binomial_4:
2403    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==>
2404    ((x + y) ** 4 = x ** 4 + ##4 * (x ** 3 * y) + ##6 * (x ** 2 * y ** 2) + ##4 * (x * y ** 3) + y ** 4)
2405Proof
2406  rpt strip_tac >>
2407  `x ** 3 IN R /\ x ** 2 * y IN R /\ x * y ** 2 IN R /\ y ** 3 IN R /\
2408    x ** 3 * y IN R /\ x ** 2 * y ** 2 IN R /\ x * y ** 3 IN R /\ y * y ** 3 IN R` by rw[] >>
2409  `x ** 3 + (##3 * (x ** 2 * y) + (##3 * (x * y ** 2) + y ** 3)) IN R` by rw[] >>
2410  `x * (##3 * (x ** 2 * y)) IN R /\ x * (##3 * (x * y ** 2)) IN R` by rw[] >>
2411  `y * (##3 * (x ** 2 * y)) IN R /\ y * (##3 * (x * y ** 2)) IN R` by rw[] >>
2412  `(x + y) ** 4 = (x + y) * (x ** 3 + ##3 * (x ** 2 * y) + ##3 * (x * y ** 2) + y ** 3)`
2413    by rw_tac std_ss[ring_exp_small, ring_binomial_3, ring_add_element] >>
2414  `_ = (x + y) * (x ** 3 + (##3 * (x ** 2 * y) + (##3 * (x * y ** 2) + y ** 3)))` by rw[ring_add_assoc] >>
2415  `_ = x * (x ** 3 + (##3 * (x ** 2 * y) + (##3 * (x * y ** 2) + y ** 3))) +
2416        y * (x ** 3 + (##3 * (x ** 2 * y) + (##3 * (x * y ** 2) + y ** 3)))` by rw[ring_mult_ladd] >>
2417  `_ = (x * x ** 3 + (x * (##3 * (x ** 2 * y)) + (x * (##3 * (x * y ** 2)) + x * y ** 3))) +
2418        (y * x ** 3 + (y * (##3 * (x ** 2 * y)) + (y * (##3 * (x * y ** 2)) + y * y ** 3)))` by rw[] >>
2419  `_ = (x * x ** 3 + (x * (##3 * (x ** 2 * y)) + x * (##3 * (x * y ** 2)) + x * y ** 3)) +
2420        (y * x ** 3 + (y * (##3 * (x ** 2 * y)) + y * (##3 * (x * y ** 2)) + y * y ** 3))`
2421    by rw_tac std_ss[ring_add_assoc] >>
2422  `_ = (x ** 4 + (x * (##3 * (x ** 2 * y)) + x * (##3 * (x * y ** 2)) + x * y ** 3)) +
2423        (y * x ** 3 + (y * (##3 * (x ** 2 * y)) + y * (##3 * (x * y ** 2)) + y ** 4))` by rw[ring_exp_small] >>
2424  qabbrev_tac `x3y = x ** 3 * y` >>
2425  qabbrev_tac `x2y2 = x ** 2 * y ** 2` >>
2426  qabbrev_tac `xy3 = x * y ** 3` >>
2427  `x * (##3 * (x ** 2 * y)) = ##3 * (x ** 2 * y) * x` by rw[ring_mult_comm] >>
2428  `_ = ##3 * (x ** 2 * (y * x))` by rw[ring_mult_assoc] >>
2429  `_ = ##3 * (x ** 2 * (x * y))` by rw[ring_mult_comm] >>
2430  `_ = ##3 * (x * x ** 2 * y)` by rw[ring_mult_assoc, ring_mult_comm] >>
2431  `_ = ##3 * x3y` by rw[ring_exp_small, Abbr`x3y`] >>
2432  `x * (##3 * (x * y ** 2)) = ##3 * (x * y ** 2) * x` by rw[ring_mult_comm] >>
2433  `_ = ##3 * (x * x * y ** 2)` by rw[ring_mult_assoc, ring_mult_comm] >>
2434  `_ = ##3 * x2y2` by rw[ring_exp_small, Abbr`x2y2`] >>
2435  `y * x ** 3 = x3y` by rw[ring_mult_comm, Abbr`x3y`] >>
2436  `y * (##3 * (x ** 2 * y)) = ##3 * (x ** 2 * y) * y` by rw[ring_mult_comm] >>
2437  `_ = ##3 * (x ** 2 * (y * y))` by rw[ring_mult_assoc] >>
2438  `_ = ##3 * x2y2` by rw[ring_exp_small, Abbr`x2y2`] >>
2439  `y * (##3 * (x * y ** 2)) = ##3 * (x * y ** 2) * y` by rw[ring_mult_comm] >>
2440  `_ = ##3 * (x * (y * y ** 2))` by rw[ring_mult_assoc, ring_mult_comm] >>
2441  `_ = ##3 * xy3` by rw[ring_exp_small, Abbr`xy3`] >>
2442  `##3 * x3y + ##3 * x2y2 + xy3 IN R /\ ##3 * x2y2 + ##3 * xy3 + y ** 4 IN R` by rw[] >>
2443  `x ** 4 + (x * (##3 * (x ** 2 * y)) + x * (##3 * (x * y ** 2)) + xy3) +
2444   (y * x ** 3 + (y * (##3 * (x ** 2 * y)) + y * (##3 * (x * y ** 2)) + y ** 4)) =
2445   x ** 4 + (##3 * x3y + ##3 * x2y2 + xy3) + (x3y + (##3 * x2y2 + ##3 * xy3 + y ** 4))` by rw[] >>
2446  `_ = x ** 4 + (##3 * x3y + ##3 * x2y2 + xy3 + x3y + (##3 * x2y2 + ##3 * xy3 + y ** 4))` by rw[ring_add_assoc] >>
2447  `_ = x ** 4 + (x3y + (##3 * x3y + ##3 * x2y2 + xy3) + (##3 * x2y2 + ##3 * xy3 + y ** 4))` by rw[ring_add_comm] >>
2448  `_ = x ** 4 + (x3y + ##3 * x3y + ##3 * x2y2 + xy3 + (##3 * x2y2 + ##3 * xy3 + y ** 4))` by rw[ring_add_assoc] >>
2449  `_ = x ** 4 + (##4 * x3y + ##3 * x2y2 + xy3 + (##3 * x2y2 + ##3 * xy3 + y ** 4))` by rw_tac std_ss[ring_single_add_mult] >>
2450  `_ = x ** 4 + (##4 * x3y + (##3 * x2y2 + (xy3 + ##3 * x2y2 + (##3 * xy3 + y ** 4))))` by rw[ring_add_assoc] >>
2451  `_ = x ** 4 + (##4 * x3y + (##3 * x2y2 + (##3 * x2y2 + xy3 + (##3 * xy3 + y ** 4))))` by rw[ring_add_comm] >>
2452  `_ = x ** 4 + (##4 * x3y + (##3 * x2y2 + ##3 * x2y2 + (xy3 + ##3 * xy3 + y ** 4)))` by rw[ring_add_assoc] >>
2453  `_ = x ** 4 + (##4 * x3y + (##(3 + 3) * x2y2 + (xy3 + ##3 * xy3 + y ** 4)))` by rw[ring_num_add_mult] >>
2454  `_ = x ** 4 + (##4 * x3y + (##(3 + 3) * x2y2 + (##4 * xy3 + y ** 4)))` by rw_tac std_ss[ring_single_add_mult] >>
2455  `_ = x ** 4 + ##4 * x3y + ##(3 + 3) * x2y2 + ##4 * xy3 + y ** 4` by rw[ring_add_assoc] >>
2456  rw_tac std_ss[DECIDE “3 + 3 = (6 :num)”]
2457QED
2458
2459(* Can also use:
2460    (x + y) ** 4
2461  = ((x + y) ** 2) ** 2
2462  = (x ** 2 + (##2 * x * y + y ** 2)) ** 2
2463*)
2464
2465(* ------------------------------------------------------------------------- *)
2466(* Non-zero Elements of a Ring (for Integral Domain)                         *)
2467(* ------------------------------------------------------------------------- *)
2468
2469(* Define the Ring nonzero elements *)
2470Definition ring_nonzero_def:   ring_nonzero (r:'a ring) = R DIFF {#0}
2471End
2472Overload "R+" = ``ring_nonzero r``(* instead of R_plus *)
2473
2474(* use overloading for the multiplicative group *)
2475Overload "f*" = ``r.prod excluding #0``
2476Overload "F*" = ``f*.carrier``
2477
2478(* Overload on subfield multiplicative group *)
2479Overload "s*" = ``s.prod excluding s.sum.id``
2480Overload "B*" = ``s*.carrier``
2481
2482(* No export of conversion. *)
2483(* val _ = export_rewrites ["ring_nonzero_def"]; *)
2484
2485(* Theorem: [Ring nonzero characterization] x IN R+ = (x IN R) and x <> #0 *)
2486(* Proof: by definition. *)
2487Theorem ring_nonzero_eq:
2488    !(r:'a ring) x. x IN R+ <=> x IN R /\ x <> #0
2489Proof
2490  rw[ring_nonzero_def]
2491QED
2492
2493(* This export is very bad, same as conversion. *)
2494(* val _ = export_rewrites ["ring_nonzero_eq"]; *)
2495
2496(* Theorem: x IN R+ ==> x IN R. *)
2497(* Proof: by definition and IN_DIFF. *)
2498Theorem ring_nonzero_element:
2499    !(r:'a ring) x. x IN R+ ==> x IN R
2500Proof
2501  rw[ring_nonzero_def]
2502QED
2503
2504(* This export is very bad: all goals of x IN R will trigger this and lead to prove x IN R+. *)
2505(* val _ = export_rewrites ["ring_nonzero_element"]; *)
2506
2507(* Theorem: x IN R+ ==> -x IN R+ *)
2508(* Proof: by contradiction.
2509   Suppose -x NOTIN R+,
2510   then since -x IN R, -x = #0  by ring_nonzero_eq.
2511   then x = #0     by ring_neg_eq_zero, contradicting x IN R+.
2512   Hence x = - #0  by ring_neg_eq_swap,
2513   or    x = #0    by ring_neg_zero, contradicting x IN R+.
2514*)
2515Theorem ring_neg_nonzero:
2516    !r:'a ring. Ring r ==> !x. x IN R+ ==> -x IN R+
2517Proof
2518  rw[ring_nonzero_eq]
2519QED
2520
2521(* Theorem: Ring r ==> (F* = R+) *)
2522(* Proof:
2523   Note R+ = R DIFF {#0}
2524        F* = (r.prod excluding #0).carrier
2525        R* = monoid_invertibles r.prod
2526     F*
2527   = r.prod.carrier DIFF {#0}  by excluding_def
2528   = R DIFF {#0}               by ring_carriers
2529   = R+                        by ring_nonzero_def
2530*)
2531Theorem ring_nonzero_mult_carrier:
2532    !r:'a ring. Ring r ==> (F* = R+)
2533Proof
2534  rw[excluding_def, ring_nonzero_def]
2535QED
2536
2537(* ------------------------------------------------------------------------- *)
2538(* Application of Group Exponentiaton in Ring: Characteristic of Ring.       *)
2539(* ------------------------------------------------------------------------- *)
2540
2541(* ------------------------------------------------------------------------- *)
2542(* Ring Characteristic                                                       *)
2543(* ------------------------------------------------------------------------- *)
2544
2545(* Define characteristic of a ring *)
2546Definition char_def:   char (r:'a ring) = order r.sum #1
2547End
2548
2549(* Theorem: ##(char r) = #0 *)
2550(* Proof: by char_def, order_property. *)
2551Theorem char_property:
2552    !r:'a ring. ##(char r) = #0
2553Proof
2554  rw_tac std_ss[char_def, order_property]
2555QED
2556
2557(* Theorem: char r = 0 <=> !n. 0 < n ==> ##n <> #0 *)
2558(* Proof: by char_def, order_eq_0. *)
2559Theorem char_eq_0:
2560    !r:'a ring. (char r = 0) <=> !n. 0 < n ==> ##n <> #0
2561Proof
2562  rw_tac std_ss[char_def, order_eq_0]
2563QED
2564
2565(* Theorem: 0 < char r ==> !n. 0 < n /\ n < (char r) ==> ##n <> #0 *)
2566(* Proof: by char_def, order_minimal. *)
2567Theorem char_minimal:
2568    !r:'a ring. 0 < char r ==> !n. 0 < n /\ n < char r ==> ##n <> #0
2569Proof
2570  rw_tac std_ss[char_def, order_minimal]
2571QED
2572
2573(* Theorem: FiniteRing r ==> 0 < char r *)
2574(* Proof:
2575   Note FiniteRing r ==> Ring r /\ FINITE R    by FiniteRing_def
2576    and FiniteGroup r.sum                      by finite_ring_add_finite_group
2577   Since #1 IN R                               by ring_one_element
2578      so 0 < order r.sum #1                    by group_order_pos
2579      or 0 < char r                            by char_def
2580*)
2581Theorem finite_ring_char_pos:
2582    !r:'a ring. FiniteRing r ==> 0 < char r
2583Proof
2584  rpt (stripDup[FiniteRing_def]) >>
2585  `FiniteGroup r.sum` by rw[finite_ring_add_finite_group] >>
2586  rw[group_order_pos, char_def]
2587QED
2588
2589(* ------------------------------------------------------------------------- *)
2590(* Characteristic Theorems                                                   *)
2591(* ------------------------------------------------------------------------- *)
2592
2593(* Theorem: Ring r ==> ##n = #0 iff (char r) divides n  *)
2594(* Proof:
2595   Let m = char r.
2596   If m = 0, then !n. ##n <> #0   by char_eq_0
2597   and 0 divides n iff n = 0      by ZERO_DIVIDES
2598   but ##0 = #0                   by ring_num_0
2599   Hence true.
2600   If m <> 0, 0 < m, ##m = #0     by char_property
2601   Apply DIVISION, there are q p such that:
2602     n = q * m + p   with p < m
2603   ##n = ##(q * m + p)
2604       = ##(q * m) + ##p          by ring_num_add
2605       = ##q * ##m + ##p          by ring_num_mult
2606       = ##q * #0  + ##p          by above
2607       = #0 + ##p                 by ring_mult_rzero
2608       = ##p                      by ring_add_lzero
2609
2610   For if case, p = 0             by char_minimal
2611   hence m divides n              by divides_def
2612   For only-if case,
2613       m divides (q * m + p)
2614   ==> m divides p                by DIVIDES_ADD_2
2615   ==> p = 0                      by NOT_LT_DIVIDES
2616   Hence ##n = ##p = #0           by ring_num_0
2617*)
2618Theorem ring_char_divides:
2619    !r:'a ring. Ring r ==> !n. (## n = #0) <=> (char r) divides n
2620Proof
2621  rpt strip_tac >>
2622  `!x. x <> 0 <=>  0 < x` by decide_tac >>
2623  qabbrev_tac `m = char r` >>
2624  Cases_on `m = 0` >-
2625  metis_tac[char_eq_0, ring_num_0, ZERO_DIVIDES] >>
2626  `?q p. (n = q * m + p) /\ p < m` by metis_tac[DIVISION] >>
2627  `## m = #0` by rw_tac std_ss[GSYM char_property] >>
2628  `## n = ## q * ## m + ## p` by rw_tac std_ss[ring_num_add, ring_num_mult] >>
2629  `_ = ## p` by rw[] >>
2630  rw_tac std_ss[EQ_IMP_THM] >-
2631  metis_tac[char_minimal, divides_def, ADD_0] >>
2632  metis_tac[divides_def, DIVIDES_ADD_2, NOT_LT_DIVIDES, ring_num_0]
2633QED
2634
2635(* Theorem: Ring r ==> char r = 1 iff #1 = #0  *)
2636(* Proof:
2637   If part,
2638   char r = 1 ==> ##1 = #0           by char_property
2639   hence true since #1 = ##1         by ring_num_1
2640   Only-if part, (char r) divides 1  by ring_char_divides,
2641   hence char r = 1                  by DIVIDES_ONE.
2642*)
2643Theorem ring_char_eq_1:
2644    !r:'a ring. Ring r ==> ((char r = 1) <=> (#1 = #0))
2645Proof
2646  rw_tac std_ss [EQ_IMP_THM] >| [
2647    rw [GSYM char_property],
2648    rw [GSYM ring_char_divides, GSYM DIVIDES_ONE]
2649  ]
2650QED
2651
2652(* Theorem: Ring r /\ (char r = 2) ==> (- #1 = #1) *)
2653(* Proof:
2654   Given char r = 2
2655      so order r.sum #1 = 2      by char_def
2656      or r.sum.exp #1 2 = #0     by order_property
2657     i.e.           ##2 = #0     by notation
2658      or        #1 + #1 = #0     by ring_num_2
2659*)
2660Theorem ring_char_2_property:
2661    !r:'a ring. Ring r /\ (char r = 2) ==> (#1 + #1 = #0)
2662Proof
2663  metis_tac[char_def, order_property, ring_num_2]
2664QED
2665
2666(* Theorem: Ring r /\ (char r = 2) ==> (- #1 = #1) *)
2667(* Proof:
2668   Since #1 + #1 = #0     by ring_char_2_property
2669     and #1 IN R          by ring_one_element
2670   hence - #1 = #1        by ring_add_eq_zero
2671*)
2672Theorem ring_char_2_neg_one:
2673    !r:'a ring. Ring r /\ (char r = 2) ==> (- #1 = #1)
2674Proof
2675  metis_tac[ring_char_2_property, ring_add_eq_zero, ring_one_element]
2676QED
2677
2678(* Theorem: Ring r /\ (char r = 2) ==> !x. x IN R ==> (x + x = #0) *)
2679(* Proof:
2680     x + x
2681   = #1 * x + #1 * x       by ring_mult_lone
2682   = (#1 + #1) * x         by ring_mult_ladd
2683   = #0 * x                by ring_char_2_property
2684   = #0                    by ring_mult_lzero
2685*)
2686Theorem ring_char_2_double:
2687    !r:'a ring. Ring r /\ (char r = 2) ==> !x. x IN R ==> (x + x = #0)
2688Proof
2689  rpt strip_tac >>
2690  `x + x = (#1 + #1) * x` by rw[] >>
2691  `_ = #0` by rw_tac std_ss[ring_char_2_property, ring_mult_lzero] >>
2692  rw[]
2693QED
2694
2695(* Theorem: Ring r /\ (char r = 2) ==> !x. x IN R ==> (-x = x) *)
2696(* Proof:
2697     x + x = #0            by ring_char_2_double
2698   Hence -x = x            by ring_add_eq_zero
2699*)
2700Theorem ring_neg_char_2:
2701    !r:'a ring. Ring r /\ (char r = 2) ==> !x. x IN R ==> (-x = x)
2702Proof
2703  rw[ring_char_2_double, GSYM ring_add_eq_zero]
2704QED
2705
2706(* Theorem: Ring r /\ (char r = 2) ==> !x y. x IN R /\ y IN R ==> (x + y = x - y) *)
2707(* Proof:
2708     x - y
2709   = x + -y     by ring_sub_def
2710   = x + y      by ring_neg_char_2
2711*)
2712Theorem ring_add_char_2:
2713    !r:'a ring. Ring r /\ (char r = 2) ==> !x y. x IN R /\ y IN R ==> (x + y = x - y)
2714Proof
2715  rw[ring_neg_char_2]
2716QED
2717
2718(* Theorem: Ring r /\ #1 <> #0 ==> !c. coprime c (char r) ==> ##c <> #0 *)
2719(* Proof:
2720   #1 <> #0 ==> char r = n <> 1    by ring_char_eq_1
2721   If ##c = #0, divides n c        by ring_char_divides
2722   then gcd n c = n                by divides_iff_gcd_fix
2723   or   gcd c n = n                by GCD_SYM
2724   but coprime c n means gcd c n = 1,
2725   contradicting n <> 1. Hence ##c <> #0.
2726*)
2727Theorem ring_num_char_coprime_nonzero:
2728    !r:'a ring. Ring r /\ #1 <> #0 ==> !c. coprime c (char r) ==> ##c <> #0
2729Proof
2730  metis_tac[ring_char_eq_1, ring_char_divides, divides_iff_gcd_fix, GCD_SYM]
2731QED
2732
2733(* Theorem: Ring r ==> !n. 0 < n ==>
2734            ((char r = n) <=> (##n = #0) /\ (!m. 0 < m /\ m < n ==> ##m <> #0)) *)
2735(* Proof: by char_def, order_thm *)
2736Theorem ring_char_alt:
2737    !r:'a ring. Ring r ==> !n. 0 < n ==>
2738   ((char r = n) <=> (##n = #0) /\ (!m. 0 < m /\ m < n ==> ##m <> #0))
2739Proof
2740  rw[char_def, order_thm]
2741QED
2742
2743(* Theorem: Ring r /\ #1 <> #0 ==> ((-#1 = #1) <=> (char r = 2)) *)
2744(* Proof:
2745   If part: #1 = -#1 ==> char r = 2
2746      Since ##1 = #1           by ring_num_1
2747                <> #0          by given
2748        and ##2 = #1 + #1      by ring_num_mult_small
2749                = #1 + (-#1)   by given
2750                = #0           by ring_add_rneg
2751      Hence char r = 2         by ring_char_alt, 0 < char r
2752   Only-if part: char r = 2 ==> -#1 = #1
2753      True by ring_char_2_neg_one
2754*)
2755Theorem ring_neg_one_eq_one:
2756    !r:'a ring. Ring r /\ #1 <> #0 ==> ((-#1 = #1) <=> (char r = 2))
2757Proof
2758  rw[EQ_IMP_THM] >| [
2759    `##1 = #1` by rw[] >>
2760    `##2 = #1 + #1` by rw[GSYM ring_num_mult_small] >>
2761    `_ = #1 + (-#1)` by metis_tac[] >>
2762    `_ = #0` by rw[] >>
2763    rw[ring_char_alt, DECIDE``!m. 0 < m /\ m < 2 ==> (m = 1)``],
2764    rw[ring_char_2_neg_one]
2765  ]
2766QED
2767
2768(* Theorem: Ring r ==> !x. x IN R ==> !n. r.sum.exp x n = x * ##n *)
2769(* Proof:
2770   By induction on n.
2771   Base: r.sum.exp x 0 = x * ##0
2772         r.sum.exp x 0
2773       = #0                        by group_exp_0
2774       = x * ##0
2775   Step: r.sum.exp x n = x * ##n ==> r.sum.exp x (SUC n) = x * ##(SUC n)
2776         r.sum.exp x (SUC n)
2777       = x + (r.sum.exp x n)       by group_exp_SUC
2778       = x + x * ##n               by induction hypothesis
2779       = x * (#1 + ##n)            by ring_mult_radd
2780       = x * ##(SUC n)             by ring_num_SUC
2781*)
2782Theorem ring_add_exp_eqn:
2783    !r:'a ring. Ring r ==> !x. x IN R ==> !n. r.sum.exp x n = x * ##n
2784Proof
2785  rpt strip_tac >>
2786  Induct_on `n` >-
2787  rw[] >>
2788  rw[ring_mult_radd]
2789QED
2790
2791(* Theorem: Ring r ==> !n m. n < char r /\ m < char r ==> (##n = ##m <=> (n = m)) *)
2792(* Proof:
2793   Note 0 < char r                          by n < char r, m < char r
2794    and Group r.sum /\ (r.sum.carrier = R)  by ring_add_group
2795   This follows by group_order_unique:
2796   group_order_unique |> SPEC ``r.sum``;
2797   > val it = |- Group r.sum ==> !x. x IN r.sum.carrier ==>
2798         !m n. m < order r.sum x /\ n < order r.sum x ==> (r.sum.exp x m = r.sum.exp x n) ==> (m = n) : thm
2799   Take x = #1, apply char_def.
2800*)
2801Theorem ring_num_eq:
2802    !r:'a ring. Ring r ==> !n m. n < char r /\ m < char r ==> ((##n = ##m) <=> (n = m))
2803Proof
2804  rpt strip_tac >>
2805  `0 < char r` by decide_tac >>
2806  `Group r.sum /\ (r.sum.carrier = R)` by rw[ring_add_group] >>
2807  metis_tac[group_order_unique, char_def, ring_one_element]
2808QED
2809
2810(* Theorem: Ring r /\ 0 < char r ==> !n. ##n = ##(n MOD (char r)) *)
2811(* Proof:
2812   Note Group r.sum /\ (r.sum.carrier = R)  by ring_add_group
2813   The result follows                       by group_exp_mod, char_def
2814*)
2815Theorem ring_num_mod:
2816    !r:'a ring. Ring r /\ 0 < char r ==> !n. ##n = ##(n MOD (char r))
2817Proof
2818  rpt strip_tac >>
2819  `Group r.sum` by rw[ring_add_group] >>
2820  fs[Once group_exp_mod, char_def]
2821QED
2822
2823(* export simple result -- but this is bad! *)
2824(* val _ = export_rewrites ["finite_ring_num_mod"]; *)
2825
2826(* Theorem: Ring r /\ 0 < char r ==> !z. ?y x. (y = ##x) /\ (y + ##z = #0) *)
2827(* Proof:
2828   Let n = char r, then 0 < n.
2829   Let x = n - z MOD n, and y - ##x.
2830     y + ##z
2831   = ##x + ##z
2832   = ##(x + z)       by ring_num_add
2833   = ##(n - z MOD n + (z DIV n * n + z MOD n))    by DIVISION
2834   = ##(n + z DIV n * n)                          by arithmetic
2835   = ##n + ##(z DIV n * n)                        by ring_num_add
2836   = ##n + ##(z DIV n) * ##n                      by ring_num_mult
2837   = #0 + #0                                      by char_property
2838   = #0                                           by ring_add_zero_zero
2839*)
2840Theorem ring_num_negative:
2841    !r:'a ring. Ring r /\ 0 < char r ==>
2842   !z:num. ?(y:'a) (x:num). (y = ##x) /\ (y + ##z = #0)
2843Proof
2844  rpt strip_tac >>
2845  qabbrev_tac `n = char r` >>
2846  `(z = z DIV n * n + z MOD n) /\ z MOD n < n` by rw[DIVISION] >>
2847  `?x. x = n - z MOD n` by rw[] >>
2848  qexists_tac `##x` >>
2849  `##x + ##z = ##(n - z MOD n) + ##z` by rw[] >>
2850  `_ = ##(n - z MOD n + z)` by rw[] >>
2851  `_ = ##(n - z MOD n + (z DIV n * n + z MOD n))` by metis_tac[] >>
2852  `_ = ##(n + z DIV n * n)` by rw_tac arith_ss[] >>
2853  `_ = ##n + ##(z DIV n * n)` by rw[] >>
2854  `_ = ##n + ##(z DIV n) * ##n` by rw[GSYM ring_num_mult] >>
2855  `_ = #0 + #0` by rw[char_property, Abbr`n`] >>
2856  `_ = #0` by rw[] >>
2857  metis_tac[]
2858QED
2859
2860(* Theorem: Ring r /\ (char r = 0) ==> INFINITE R *)
2861(* Proof:
2862   By contradiction, suppose FINITE R.
2863   Then Ring r /\ FINITE R ==> FiniteRing r   by FiniteRing_def
2864    ==> 0 < char r                            by finite_ring_char_pos
2865   This contradicts char r = 0.
2866*)
2867Theorem ring_char_0:
2868    !r:'a ring. Ring r /\ (char r = 0) ==> INFINITE R
2869Proof
2870  metis_tac[finite_ring_char_pos, FiniteRing_def, NOT_ZERO_LT_ZERO]
2871QED
2872
2873(* Theorem: Ring r /\ (char r = 1) ==> (R = {#0}) *)
2874(* Proof:
2875         char r = 1
2876     <=> order r.sum #1 = 1     by char_def
2877     ==> ##1 = #0               by order_property
2878     <=> #1 = #0                by ring_num_1
2879     <=> R = {#0}               by ring_one_eq_zero
2880*)
2881Theorem ring_char_1:
2882    !r:'a ring. Ring r /\ (char r = 1) ==> (R = {#0})
2883Proof
2884  rpt strip_tac >>
2885  `##(order r.sum #1) = #0` by rw[order_property] >>
2886  `#1 = #0` by metis_tac[char_def, ring_num_1] >>
2887  rw[GSYM ring_one_eq_zero]
2888QED
2889
2890(* ------------------------------------------------------------------------- *)
2891(* Finite Ring.                                                              *)
2892(* ------------------------------------------------------------------------- *)
2893
2894(* Theorem: FiniteRing r ==> Ring r *)
2895(* Proof: by FiniteRing_def *)
2896Theorem finite_ring_is_ring:
2897    !r:'a ring. FiniteRing r ==> Ring r
2898Proof
2899  rw[FiniteRing_def]
2900QED
2901
2902(* Theorem: FiniteRing r ==> 0 < CARD R *)
2903(* Proof:
2904   Note FiniteRing r ==> Ring r /\ FINITE R    by FiniteRing_def
2905   Since #0 IN R                               by ring_zero_element
2906      so R <> {}                               by MEMBER_NOT_EMPTY
2907    then CARD R <> 0                           by CARD_EQ_0
2908      or 0 < CARD R                            by NOT_ZERO_LT_ZERO
2909*)
2910Theorem finite_ring_card_pos:
2911    !r:'a ring. FiniteRing r ==> 0 < CARD R
2912Proof
2913  rw[FiniteRing_def] >>
2914  `#0 IN R` by rw[] >>
2915  `CARD R <> 0` by metis_tac[CARD_EQ_0, MEMBER_NOT_EMPTY] >>
2916  decide_tac
2917QED
2918
2919(* Theorem: FiniteRing r ==> ((CARD R = 1) <=> (#1 = #0)) *)
2920(* Proof:
2921   Note FiniteRing r ==> Ring r /\ FINITE R    by FiniteRing_def
2922   If part: (CARD R = 1) ==> (#1 = #0)
2923      FINTE R /\ (CARD R = 1) ==> SING R       by SING_IFF_CARD1
2924      Since #1 IN R                            by ring_one_element
2925        and #0 IN R                            by ring_zero_element
2926      Hence #1 = #0                            by IN_SING, SING_DEF
2927   Only-if part: (#1 = #0) ==> (CARD R = 1)
2928      #1 = #0 ==> R = {#0}                     by ring_one_eq_zero
2929              ==> CARD R = 1                   by CARD_SING
2930*)
2931Theorem finite_ring_card_eq_1:
2932    !r:'a ring. FiniteRing r ==> ((CARD R = 1) <=> (#1 = #0))
2933Proof
2934  rw[FiniteRing_def, EQ_IMP_THM] >-
2935  metis_tac[SING_IFF_CARD1, SING_DEF, IN_SING, ring_one_element, ring_zero_element] >>
2936  metis_tac[ring_one_eq_zero, CARD_SING]
2937QED
2938
2939(* Theorem: FiniteRing r ==> 0 < char r /\ (char r = order r.sum #1) *)
2940(* Proof:
2941   Note FiniteRing r ==> Ring r /\ FINITE R    by FiniteRing_def
2942    and FiniteGroup r.sum                      by finite_ring_add_finite_group
2943   Since #1 IN R                               by ring_one_element
2944      so 0 < order r.sum #1                    by group_order_pos
2945      or 0 < char r /\ (char r = order r.sum #1)   by char_def
2946*)
2947Theorem finite_ring_char:
2948    !r:'a ring. FiniteRing r ==> (0 < char r) /\ (char r = order r.sum #1)
2949Proof
2950  (strip_tac >> stripDup[FiniteRing_def]) >>
2951  `FiniteGroup r.sum` by rw[finite_ring_add_finite_group] >>
2952  rw[group_order_pos, char_def]
2953QED
2954
2955(* Theorem: FiniteRing r ==> (char r) divides (CARD R) *)
2956(* Proof:
2957   Note FiniteRing r ==> Ring r /\ FINITE R    by FiniteRing_def
2958    and FiniteGroup r.sum                      by finite_ring_add_finite_group
2959    and r.sum.carrier = R                      by ring_carriers
2960   Since #1 IN R                               by ring_one_element
2961      so (order r.sum #1) divides (CARD R)     by group_order_divides
2962      or (char r) divides (CARD R)             by char_def
2963*)
2964Theorem finite_ring_char_divides:
2965    !r:'a ring. FiniteRing r ==> (char r) divides (CARD R)
2966Proof
2967  rpt (stripDup[FiniteRing_def]) >>
2968  `FiniteGroup r.sum` by rw[finite_ring_add_finite_group] >>
2969  metis_tac[group_order_divides, char_def, ring_one_element, ring_carriers]
2970QED
2971
2972(* Theorem: FiniteRing r /\ prime (CARD R) ==> (char r = CARD R) *)
2973(* Proof:
2974   Since char r divides CARD R               by finite_ring_char_divides
2975      so (char r = CARD R) \/ (char r = 1)   by prime_def
2976   If char r = CARD R, it is done.
2977   If char r = 1,
2978      then #1 = #0                           by ring_char_eq_1
2979       and R = {#0}                          by ring_one_eq_zero
2980        so CARD R = 1                        by CARD_SING
2981      which makes prime (CARD R) = F,
2982           but (char r = CARD R) = T.
2983*)
2984Theorem finite_ring_card_prime:
2985    !r:'a ring. FiniteRing r /\ prime (CARD R) ==> (char r = CARD R)
2986Proof
2987  rpt (stripDup[FiniteRing_def]) >>
2988  `char r divides CARD R` by rw[finite_ring_char_divides] >>
2989  `(char r = CARD R) \/ (char r = 1)` by metis_tac[prime_def] >>
2990  `#1 = #0` by rw[GSYM ring_char_eq_1] >>
2991  `R = {#0}` by rw[GSYM ring_one_eq_zero] >>
2992  rw[]
2993QED
2994
2995(* Note: the converse is false:
2996   Counter-example for: char r = CARD R ==> prime (CARD R)
2997   Take r = Z_6, char r = CARD R = 6, but 6 is not prime.
2998   ZN_char: 0 < n ==> (char (ZN n) = n)
2999   ZN_card: CARD (ZN n).carrier = n
3000*)
3001
3002(* Theorem: FiniteRing r ==> char r = n <=> 0 < n /\ ##n = #0 /\ !m. 0 < m /\ m < n ==> ##m <> #0 *)
3003(* Proof:
3004   Note FiniteRing r ==> 0 < char r     by finite_ring_char_pos
3005   Hence true by ring_char_alt
3006*)
3007Theorem finite_ring_char_alt:
3008    !r:'a ring. FiniteRing r ==>
3009   !n. (char r = n) <=> 0 < n /\ (##n = #0) /\ (!m. 0 < m /\ m < n ==> ##m <> #0)
3010Proof
3011  rpt (stripDup[FiniteRing_def]) >>
3012  `0 < char r` by rw[finite_ring_char_pos] >>
3013  metis_tac[ring_char_alt]
3014QED
3015
3016(* ------------------------------------------------------------------------- *)
3017(* Ring Units Documentation                                                  *)
3018(* ------------------------------------------------------------------------- *)
3019(*
3020   Overloading:
3021   r*       = Invertibles (r.prod)
3022   R*       = r*.carrier
3023   unit x   = x IN R*
3024   |/       = r*.inv
3025   x =~ y   = unit_eq r x y
3026*)
3027(* Definitions and Theorems (# are exported):
3028
3029   Units in a Ring:
3030   ring_units_property       |- !r. Ring r ==> (r*.op = $* ) /\ (r*.id = #1)
3031   ring_units_has_one        |- !r. Ring r ==> #1 IN R*
3032   ring_units_has_zero       |- !r. Ring r ==> (#0 IN R* <=> (#1 = #0))
3033   ring_units_element        |- !r. Ring r ==> !x. x IN R* ==> x IN R
3034
3035   Units in a Ring form a Group:
3036   ring_units_group          |- !r. Ring r ==> Group r*
3037   ring_units_abelain_group  |- !r. Ring r ==> AbelianGroup r*
3038
3039   Ring Units:
3040#  ring_unit_one             |- !r. Ring r ==> unit #1
3041   ring_unit_zero            |- !r. Ring r ==> (unit #0 <=> (#1 = #0))
3042   ring_unit_nonzero         |- !r. Ring r /\ #1 <> #0 ==> !x. unit x ==> x <> #0
3043   ring_unit_has_inv         |- !r. Ring r ==> !x. unit x ==> unit ( |/ x)
3044   ring_unit_linv            |- !r. Ring r ==> !x. unit x ==> ( |/ x * x = #1)
3045   ring_unit_rinv            |- !r. Ring r ==> !x. unit x ==> (x * |/ x = #1)
3046#  ring_unit_element         |- !r. Ring r ==> !x. unit x ==> x IN R
3047   ring_unit_inv_element     |- !r. Ring r ==> !x. unit x ==> |/ x IN R
3048   ring_unit_inv_nonzero     |- !r. Ring r /\ #1 <> #0 ==> !x. unit x ==> |/ x <> #0
3049   ring_unit_mult_zero       |- !r. Ring r ==> !x y. unit x /\ y IN R ==> ((x * y = #0) <=> (y = #0))
3050   ring_unit_property        |- !r. Ring r ==> !u. unit u <=> u IN R /\ ?v. v IN R /\ (u * v = #1)
3051   ring_unit_neg             |- !r. Ring r ==> !x. unit x ==> unit (-x)
3052   ring_unit_mult_unit       |- !r. Ring r ==> !u v. unit u /\ unit v ==> unit (u * v)
3053   ring_unit_mult_eq_unit    |- !r. Ring r ==> !x y. x IN R /\ y IN R ==> (unit (x * y) <=> unit x /\ unit y)
3054   ring_unit_rinv_unique     |- !r. Ring r ==> !u v. unit u /\ v IN R /\ (u * v = #1) ==> (v = |/ u)
3055   ring_unit_linv_unique     |- !r. Ring r ==> !u v. u IN R /\ unit v /\ (u * v = #1) ==> (u = |/ v)
3056   ring_unit_inv_inv         |- !r. Ring r ==> !u. unit u ==> (u = |/ ( |/ u))
3057   ring_unit_linv_inv        |- !r. Ring r ==> !u v. unit u /\ v IN R /\ ( |/ u * v = #1) ==> (u = v)
3058   ring_unit_rinv_inv        |- !r. Ring r ==> !u v. u IN R /\ unit v /\ (u * |/ v = #1) ==> (u = v)
3059#  ring_inv_one              |- !r. Ring r ==> ( |/ #1 = #1)
3060
3061   Ring Unit Equivalence:
3062   unit_eq_def       |- !r x y. x =~ y <=> ?u. unit u /\ (x = u * y)
3063   unit_eq_refl      |- !r. Ring r ==> !x. x IN R ==> x =~ x
3064   unit_eq_sym       |- !r. Ring r ==> !x y. x IN R /\ y IN R /\ x =~ y ==> y =~ x
3065   unit_eq_trans     |- !r. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R /\ x =~ y /\ y =~ z ==> x =~ z
3066   ring_eq_unit_eq   |- !r. Ring r ==> !x y. x IN R /\ y IN R /\ (x = y) ==> x =~ y
3067*)
3068
3069(* ------------------------------------------------------------------------- *)
3070(* Units in a Ring = Invertibles of (r.prod).                                *)
3071(* ------------------------------------------------------------------------- *)
3072
3073(*
3074(* Define the Units of a Ring *)
3075val Units_def = Define`
3076  Units (r:'a ring) = Invertibles (r.prod)
3077`;
3078*)
3079Overload "r*" = ``Invertibles (r.prod)``(* instead of r_star *)
3080Overload "R*" = ``r*.carrier``(* instead of R_star *)
3081
3082(* Theorem: r*.op = r.prod.op /\ r*.id = #1 *)
3083(* Proof: by ring_of_units, and Invertibles_def *)
3084Theorem ring_units_property:
3085    !r:'a ring. Ring r ==> (r*.op = r.prod.op) /\ (r*.id = #1)
3086Proof
3087  rw_tac std_ss[Invertibles_def]
3088QED
3089
3090(* Theorem: #1 IN R* *)
3091(* Proof: by monoid_id_invertible. *)
3092Theorem ring_units_has_one:
3093    !r:'a ring. Ring r ==> #1 IN R*
3094Proof
3095  rw[ring_mult_monoid, Invertibles_def]
3096QED
3097
3098(* Theorem: #0 IN R* ==> #1 = #0 *)
3099(* Proof:
3100   If part: #0 IN R* ==> #1 = #0
3101      This means ?x. x IN R* /\ x * #0 = #1 /\ #0 * x = #1   by monoid_invertibles_def
3102      Therefore #1 = #0 by ring_mult_lzero, ring_mult_rzero.
3103   Only-if part: #1 = #0 ==> #0 IN R*
3104      true ring_units_has_one.
3105*)
3106Theorem ring_units_has_zero:
3107    !r:'a ring. Ring r ==> (#0 IN R* <=> (#1 = #0))
3108Proof
3109  rw_tac std_ss[EQ_IMP_THM] >| [
3110    `Monoid r.prod /\ (r.prod.carrier = R)` by rw_tac std_ss[ring_mult_monoid] >>
3111    `R* = monoid_invertibles r.prod` by rw_tac std_ss[Invertibles_def] >>
3112    metis_tac[ring_mult_lzero, monoid_inv_from_invertibles],
3113    metis_tac[ring_units_has_one]
3114  ]
3115QED
3116
3117(* Theorem: Ring r ==> x IN R* ==> x IN R *)
3118(* Proof:
3119       x IN R*
3120   ==> x IN (Invertibles (r.prod)).carrier
3121   ==> x IN monoid_invertibles r.prod         by Invertibles_def
3122   ==> x IN r.prod.carrier                    by monoid_invertibles
3123   ==> x IN R                                 by ring_carriers
3124*)
3125Theorem ring_units_element:
3126    !r:'a ring. Ring r ==> !x. x IN R* ==> x IN R
3127Proof
3128  rw[Invertibles_def, monoid_invertibles_def]
3129QED
3130
3131(* ------------------------------------------------------------------------- *)
3132(* Units in a Ring form a Group.                                             *)
3133(* ------------------------------------------------------------------------- *)
3134
3135(* Theorem: Ring r ==> Group r* *)
3136(* Proof: by monoid_invertibles_is_group, ring_mult_monoid. *)
3137Theorem ring_units_group:
3138    !r:'a ring. Ring r ==> Group r*
3139Proof
3140  rw[monoid_invertibles_is_group, ring_mult_monoid]
3141QED
3142
3143(* Theorem: Units of Ring is an Abelian Group. *)
3144(* Proof: by checking definition.
3145   (1) Ring r ==> Group r*
3146       by ring_units_group
3147   (2) x IN R* /\ y IN R* ==> r*op x y = r*.op y x
3148       x IN R /\ y IN R       by ring_units_element
3149       r*.op = r.prod.op      by ring_units_property
3150       Hence true             by ring_mult_monoid
3151*)
3152Theorem ring_units_abelain_group:
3153    !r:'a ring. Ring r ==> AbelianGroup r*
3154Proof
3155  rw[AbelianGroup_def, ring_units_group] >>
3156  rw[ring_units_element, ring_mult_monoid, ring_units_property]
3157QED
3158
3159(* ------------------------------------------------------------------------- *)
3160(* Units in a Ring have inverses.                                            *)
3161(* ------------------------------------------------------------------------- *)
3162
3163(* ------------------------------------------------------------------------- *)
3164(* Ring Units                                                                *)
3165(* ------------------------------------------------------------------------- *)
3166
3167(* define unit by overloading *)
3168Overload unit = ``\x. x IN R*``
3169
3170(* Theorem: #1 IN R* *)
3171(* Proof: by monoid_id_invertible. *)
3172Theorem ring_unit_one[simp]:
3173    !r:'a ring. Ring r ==> unit #1
3174Proof
3175  rw[ring_mult_monoid, Invertibles_def]
3176QED
3177
3178
3179(* Theorem: #0 IN R* ==> #1 = #0 *)
3180(* Proof:
3181   If part: #0 IN R* ==> #1 = #0
3182      This means ?x. x IN R* /\ x * #0 = #1 /\ #0 * x = #1   by monoid_invertibles_def
3183      Therefore #1 = #0 by ring_mult_lzero, ring_mult_rzero.
3184   Only-if part: #1 = #0 ==> #0 IN R*
3185      True by ring_unit_one.
3186*)
3187Theorem ring_unit_zero:
3188    !r:'a ring. Ring r ==> (unit #0 <=> (#1 = #0))
3189Proof
3190  rw[EQ_IMP_THM] >| [
3191    `Monoid r.prod /\ (r.prod.carrier = R)` by rw[ring_mult_monoid] >>
3192    `R* = monoid_invertibles r.prod` by rw[Invertibles_def] >>
3193    metis_tac[ring_mult_lzero, monoid_inv_from_invertibles],
3194    metis_tac[ring_unit_one]
3195  ]
3196QED
3197
3198(* Theorem: Ring r /\ #1 <> #0 ==> !x. unit x ==> x <> #0 *)
3199(* Proof: by ring_unit_zero: |- !r. Ring r ==> (unit #0 <=> (#1 = #0)) *)
3200Theorem ring_unit_nonzero:
3201    !r:'a ring. Ring r /\ #1 <> #0 ==> !x. unit x ==> x <> #0
3202Proof
3203  metis_tac[ring_unit_zero]
3204QED
3205
3206(*
3207group_inv_element |> SPEC ``r*``;
3208|- Group r* ==> !x. x IN R* ==> r*.inv x IN R*: thm
3209group_inv_element |> SPEC ``r*`` |> UNDISCH_ALL |> PROVE_HYP (ring_units_group |> SPEC_ALL |> UNDISCH_ALL);
3210group_inv_element |> SPEC ``r*`` |> UNDISCH_ALL |> PROVE_HYP (ring_units_group |> SPEC_ALL |> UNDISCH_ALL)
3211    |> DISCH_ALL |> GEN_ALL;
3212|- !r. Ring r ==> !x. x IN R* ==> r*.inv x IN R*: thm
3213*)
3214
3215(* Lifting Group Inverse Theorem for Ring units
3216   from: !g: 'a group. Group g ==> E(g.inv)
3217     to: !r:'a ring.  Ring r ==> E(r*.inv)
3218    via: !r:'a ring.  Ring r ==> Group r*
3219*)
3220local
3221val rug = ring_units_group |> SPEC_ALL |> UNDISCH_ALL
3222val rupropery = ring_units_property |> SPEC_ALL |> UNDISCH_ALL
3223in
3224fun lift_group_inv_thm gsuffix rsuffix = let
3225  val thm = DB.fetch "group" ("group_" ^ gsuffix)
3226  val thm' = thm |> SPEC ``r*`` |> UNDISCH_ALL
3227in
3228  save_thm("ring_" ^ rsuffix,
3229           thm' |> PROVE_HYP rug
3230           |> REWRITE_RULE [rupropery]
3231           |> DISCH_ALL |> GEN_ALL)
3232end
3233end; (* local *)
3234
3235(* overloading for inverse *)
3236Overload "|/" = ``r*.inv``
3237
3238(* Theorem: x IN R* ==> |/ x IN R* *)
3239(* Proof: by group_inv_element, ring_units_group. *)
3240val ring_unit_has_inv = lift_group_inv_thm "inv_element" "unit_has_inv";
3241(* val ring_unit_has_inv = |- !r. Ring r ==> !x. unit x ==> unit ( |/ x) : thm *)
3242
3243(* Theorem: x IN R* ==> |/ x * x = #1 *)
3244(* Proof: by group_linv, ring_units_group. *)
3245val ring_unit_linv = lift_group_inv_thm "linv" "unit_linv";
3246(* val ring_unit_linv = |- !r. Ring r ==> !x. unit x ==> ( |/ x * x = #1) : thm *)
3247
3248(* Theorem: x IN R* ==> x * |/ x = #1 *)
3249(* Proof: by group_rinv, ring_units_group. *)
3250val ring_unit_rinv = lift_group_inv_thm "rinv" "unit_rinv";
3251(* val ring_unit_rinv = |- !r. Ring r ==> !x. unit x ==> (x * |/ x = #1) : thm *)
3252
3253(* Theorem: x IN R* ==> x IN R *)
3254Theorem ring_unit_element[simp] = ring_units_element;
3255(* > val ring_unit_element = |- !r. Ring r ==> !x. unit x ==> x IN R : thm *)
3256
3257
3258(* Theorem: x IN R* ==> |/ x IN R *)
3259(* Proof: by ring_unit_has_inv, ring_unit_element. *)
3260Theorem ring_unit_inv_element:
3261    !r:'a ring. Ring r ==> !x. unit x ==> |/ x IN R
3262Proof
3263  rw[ring_unit_has_inv]
3264QED
3265
3266(* Theorem: Ring r /\ #1 <> #0 ==> !x. unit x ==> |/ x <> #0 *)
3267(* Proof:
3268   By contradiction, suppose |/ x = #0.
3269     #1 = x * |/x          by ring_unit_rinv
3270        = x * #0           by assumption
3271        = #0               by ring_mult_rzero
3272   This contradicts #1 <> #0.
3273*)
3274Theorem ring_unit_inv_nonzero:
3275    !r:'a ring. Ring r /\ #1 <> #0 ==> !x. unit x ==> |/ x <> #0
3276Proof
3277  metis_tac[ring_unit_rinv, ring_mult_rzero, ring_unit_element]
3278QED
3279
3280(* Theorem: x IN R*, y IN R, x * y = #0 <=> y = #0 *)
3281(* Proof:
3282                   x * y = #0
3283   <=>     |/x * (x * y) = |/x * #0 = #0    by ring_mult_rzero
3284   <=>     ( |/x * x) * y = #0              by ring_mult_assoc
3285   <=>            #1 * y = #0               by ring_unit_linv
3286   <=>                 y = #0               by ring_mult_lone
3287*)
3288Theorem ring_unit_mult_zero:
3289    !r:'a ring. Ring r ==> !x y. unit x /\ y IN R ==> ((x * y = #0) <=> (y = #0))
3290Proof
3291  rpt strip_tac >>
3292  `x IN R` by rw[] >>
3293  rw[EQ_IMP_THM] >>
3294  `|/x IN R` by rw[ring_unit_inv_element] >>
3295  `y = #1 * y` by rw[] >>
3296  `_ = ( |/x * x) * y` by rw[ring_unit_linv] >>
3297  metis_tac[ring_mult_assoc, ring_mult_rzero]
3298QED
3299
3300(* Theorem: Ring r ==> !u. unit u <=> ?v. u * v = #1 *)
3301(* Proof:
3302   If part: unit u ==> ?v. u * v = #1
3303     unit u ==> |/u IN R, and u * |/u = #1, so take v = |/u.
3304   Only-if part: ?v. u * v = #1 ==> unit u
3305     by definition of unit x = x IN R*
3306                             = x IN r*.carrier
3307                             = x IN (Invertibles (r.prod)).carrier
3308*)
3309Theorem ring_unit_property:
3310    !r:'a ring. Ring r ==> !u. unit u <=> u IN R /\ (?v. v IN R /\ (u * v = #1))
3311Proof
3312  rw[EQ_IMP_THM] >-
3313  metis_tac[ring_unit_inv_element, ring_unit_rinv] >>
3314  `r.prod.carrier = R` by rw[ring_mult_monoid] >>
3315  rw_tac std_ss[Invertibles_def, monoid_invertibles_def, GSPECIFICATION] >>
3316  metis_tac[ring_mult_comm]
3317QED
3318
3319(* Theorem: Ring r ==> !x. unit x ==> unit (-x) *)
3320(* Proof:
3321   Since unit x
3322     ==> x IN R /\ ?v. v IN R /\ x * v = #1    by ring_unit_property
3323   hence (-x) * (-v) = x * v                   by ring_mult_neg_neg
3324                     = #1                      by above
3325   Since -v IN R                               by ring_neg_element
3326   Hence unit (-x)                             by ring_unit_property
3327*)
3328Theorem ring_unit_neg:
3329    !r:'a ring. Ring r ==> !x. unit x ==> unit (-x)
3330Proof
3331  metis_tac[ring_unit_property, ring_mult_neg_neg, ring_neg_element]
3332QED
3333
3334(* Theorem: Ring r ==> !u v. unit u /\ unit v ==> unit (u * v) *)
3335(* Proof:
3336   Let z = |/ v * |/ u
3337   Since |/ u IN R /\ |/ v IN R     by ring_unit_inv_element
3338      so z IN R                     by ring_mult_element
3339    also (u * v) * z
3340       = (u * v) * ( |/ v * |/ u)   by above
3341       = (u * v * |/ v) * |/u       by ring_mult_assoc
3342       = u * |/ u                   by ring_unit_rinv, ring_mult_rone
3343       = #1                         by ring_unit_rinv
3344   Hence unit (u * v)               by ring_unit_property
3345*)
3346Theorem ring_unit_mult_unit:
3347    !r:'a ring. Ring r ==> !u v. unit u /\ unit v ==> unit (u * v)
3348Proof
3349  rpt strip_tac >>
3350  qabbrev_tac `z = |/ v * |/ u` >>
3351  `u IN R /\ v IN R` by rw[ring_unit_element] >>
3352  `|/ v IN R /\ |/ u IN R` by rw[ring_unit_inv_element] >>
3353  `z IN R` by rw[Abbr`z`] >>
3354  `(u * v) * z = (u * v) * ( |/ v * |/ u)` by rw[Abbr`z`] >>
3355  `_ = u * (v * ( |/ v * |/ u))` by rw[ring_mult_assoc] >>
3356  `_ = u * (v * |/ v * |/ u)` by rw[ring_mult_assoc] >>
3357  `_ = u * |/ u` by rw[ring_unit_rinv] >>
3358  `_ = #1` by rw[ring_unit_rinv] >>
3359  metis_tac[ring_unit_property, ring_mult_element]
3360QED
3361
3362(* Theorem: Ring r ==> !x y. x IN R /\ y IN R ==>
3363            (unit (x * y) <=> unit x /\ unit y) *)
3364(* Proof:
3365   If part: unit (x * y) ==> unit x /\ unit y
3366      Let z = x * y.
3367      Then z IN R /\
3368           ?u. u IN R /\ (z * u = #1)   by ring_unit_property
3369       ==> (x * y) * u = #1             by z = x * y
3370       ==> x * (y * u) = #1             by ring_mult_assoc
3371       Hence unit x                     by ring_unit_property, ring_mult_element
3372       Also (y * u) * x = #1            by ring_mult_comm
3373       ==>  y * (u * x) = #1            by ring_mult_assoc
3374       Hence unit y                     by ring_unit_property, ring_mult_element
3375
3376   Only-if part: unit x /\ unit y ==> unit (x * y)
3377      This is true         by ring_unit_mult_unit
3378*)
3379Theorem ring_unit_mult_eq_unit:
3380    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==>
3381    (unit (x * y) <=> unit x /\ unit y)
3382Proof
3383  rpt strip_tac >>
3384  simp[EQ_IMP_THM] >>
3385  ntac 2 strip_tac >| [
3386    qabbrev_tac `z = x * y` >>
3387    `z IN R /\ ?u. u IN R /\ (z * u = #1)` by metis_tac[ring_unit_property] >>
3388    `x * (y * u) = #1` by rw[GSYM ring_mult_assoc, Abbr`z`] >>
3389    `y * (u * x) = #1` by rw[GSYM ring_mult_assoc, ring_mult_comm, Abbr`z`] >>
3390    metis_tac[ring_unit_property, ring_mult_element],
3391    rw[ring_unit_mult_unit]
3392  ]
3393QED
3394
3395(* Theorem: Ring r ==> unit u /\ u * v = #1 ==> v = |/ u *)
3396(* Proof:
3397   unit u ==> |/ u in R             by ring_unit_inv_element
3398   so  |/ u * (u * v) = |/ u * #1
3399   or  ( |/ u * u) * v = |/ u * #1  by ring_mult_assoc
3400               #1 * v = |/ u * #1   by ring_unit_linv
3401                    v = |/ u        by ring_mult_lone, ring_mult_rone
3402*)
3403Theorem ring_unit_rinv_unique:
3404    !r:'a ring. Ring r ==> !u v. unit u /\ v IN R /\ (u * v = #1) ==> (v = |/ u)
3405Proof
3406  rpt strip_tac >>
3407  `u IN R /\ |/ u IN R` by rw[ring_unit_inv_element] >>
3408  `v = ( |/u * u) * v` by rw[ring_unit_linv] >>
3409  `_ = |/ u * (u * v)` by rw[ring_mult_assoc] >>
3410  `_ = |/ u` by rw[] >>
3411  rw[]
3412QED
3413
3414(* Theorem: Ring r ==> unit v /\ u * v = #1 ==> u = |/ v *)
3415(* Proof: by ring_unit_rinv_unique and ring_mult_comm. *)
3416Theorem ring_unit_linv_unique:
3417    !r:'a ring. Ring r ==> !u v. u IN R /\ unit v /\ (u * v = #1) ==> (u = |/ v)
3418Proof
3419  rw[ring_unit_rinv_unique, ring_mult_comm]
3420QED
3421
3422(* Theorem: Ring r ==> unit u ==> |/ ( |/ u) = u *)
3423(* Proof: by ring_unit_rinv_unique, put v = |/ u. *)
3424Theorem ring_unit_inv_inv:
3425    !r:'a ring. Ring r ==> !u. unit u ==> (u = |/ ( |/ u))
3426Proof
3427  rw[ring_unit_inv_element, ring_unit_has_inv, ring_unit_linv, ring_unit_rinv_unique]
3428QED
3429
3430(* Theorem: Ring r ==> unit u /\ |/ u * v = #1 ==> u = v *)
3431(* Proof:
3432   unit u ==> |/ u in R           by ring_unit_inv_element
3433   so   u * ( |/ u * v) = u * #1
3434   or   (u * |/ u) * v = u * #1   by ring_mult_assoc
3435   or           #1 * v = u * #1   by ring_unit_rinv
3436   or                v = u        by ring_mult_lone, ring_mult_rone
3437*)
3438Theorem ring_unit_linv_inv:
3439    !r:'a ring. Ring r ==> !u v. unit u /\ v IN R /\ ( |/ u * v = #1) ==> (u = v)
3440Proof
3441  rpt strip_tac >>
3442  `u IN R /\ |/ u IN R` by rw[ring_unit_inv_element] >>
3443  `u = (u * |/ u) * v` by rw[ring_mult_assoc] >>
3444  `_ = v` by rw[ring_unit_rinv] >>
3445  rw[]
3446QED
3447
3448(* Theorem: Ring r ==> unit v /\ u * |/ v = #1 ==> u = v *)
3449(* Proof: by ring_unit_linv_inv and ring_mult_comm. *)
3450Theorem ring_unit_rinv_inv:
3451    !r:'a ring. Ring r ==> !u v. u IN R /\ unit v /\ (u * |/ v = #1) ==> (u = v)
3452Proof
3453  metis_tac[ring_unit_linv_inv, ring_mult_comm, ring_unit_inv_element]
3454QED
3455
3456(* Theorem: Ring r ==> ( |/ #1 = #1) *)
3457(* Proof:
3458   Note Group r*                by ring_units_group
3459    and r*.id = #1              by ring_units_property
3460   Thus r*.inv r*.id = r*.id    by group_inv_id
3461     or        |/ #1 = #1       by notation
3462*)
3463Theorem ring_inv_one[simp]:
3464    !r:'a ring. Ring r ==> ( |/ #1 = #1)
3465Proof
3466  rpt strip_tac >>
3467  `Group r*` by rw[ring_units_group] >>
3468  `r*.id = #1` by rw[ring_units_property] >>
3469  metis_tac[group_inv_id]
3470QED
3471
3472
3473(* ------------------------------------------------------------------------- *)
3474(* Ring Unit Equivalence                                                     *)
3475(* ------------------------------------------------------------------------- *)
3476
3477(* Define unit equivalence for ring *)
3478Definition unit_eq_def:
3479   unit_eq (r:'a ring) (x:'a) (y:'a) = ?(u:'a). unit u /\ (x = u * y)
3480End
3481(* overload on unit equivalence *)
3482Overload "=~" = ``unit_eq r``
3483val _ = set_fixity "=~" (Infix(NONASSOC, 450)); (* same as relation *)
3484(*
3485> unit_eq_def;
3486val it = |- !r x y. x =~ y <=> ?u. unit u /\ (x = u * y): thm
3487*)
3488
3489(* Theorem: Ring r ==> !x. x IN R ==> x =~ x *)
3490(* Proof:
3491   Since unit #1      by ring_unit_one
3492     and x = #1 * x   by ring_mult_lone
3493   Hence x =~ x       by unit_eq_def
3494*)
3495Theorem unit_eq_refl:
3496  !r:'a ring. Ring r ==> !x. x IN R ==> x =~ x
3497Proof
3498  metis_tac[unit_eq_def, ring_unit_one, ring_mult_lone]
3499QED
3500
3501(* Theorem: Ring r ==> !x y. x IN R /\ y IN R /\ x =~ y ==> y =~ x *)
3502(* Proof:
3503   Since x =~ y
3504     ==> ?u. unit u /\ (x = u * y)    by unit_eq_def
3505     and unit ( |/ u)                 by ring_unit_has_inv
3506     and |/ u * u = #1                by ring_unit_linv
3507      so y = #1 * y                   by ring_mult_lone
3508           = ( |/ u * u) * y          by above
3509           = |/ u * (u * y)           by ring_mult_assoc, ring_unit_element
3510           = |/ u * x                 by above
3511   Hence y =~ x  by taking ( |/ u)    by unit_eq_def
3512*)
3513Theorem unit_eq_sym:
3514  !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R /\ x =~ y ==> y =~ x
3515Proof
3516  rw[unit_eq_def] >>
3517  `unit ( |/ u)` by rw[ring_unit_has_inv] >>
3518  `|/ u * u = #1` by rw[ring_unit_linv] >>
3519  metis_tac[ring_mult_assoc, ring_unit_element, ring_mult_lone]
3520QED
3521
3522(* Theorem: Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R /\ x =~ y /\ y =~ z ==> x =~ z *)
3523(* Proof:
3524   Since x =~ y
3525     ==> ?u. unit u /\ (x = u * y)    by unit_eq_def
3526     and y =~ z
3527     ==> ?v. unit v /\ (y = v * z)    by unit_eq_def
3528   Hence x = u * (v * z)              by above
3529           = (u * v) * z              by ring_mult_assoc, ring_unit_element
3530     and unit (u * v)                 by ring_unit_mult_unit
3531    Thus x =~ z                       by unit_eq_def
3532*)
3533Theorem unit_eq_trans:
3534  !r:'a ring. Ring r ==> !x y z. x IN R /\ y IN R /\ z IN R /\ x =~ y /\ y =~ z ==> x =~ z
3535Proof
3536  rw[unit_eq_def] >>
3537  qexists_tac `u * u'` >>
3538  rw[ring_unit_element, ring_unit_mult_unit, ring_mult_assoc]
3539QED
3540
3541(* Theorem: Ring r ==> !x. x IN R /\ y IN R /\ (x = y) ==> x =~ y *)
3542(* Proof: by unit_eq_refl *)
3543Theorem ring_eq_unit_eq:
3544  !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R /\ (x = y) ==> x =~ y
3545Proof
3546  rw[unit_eq_refl]
3547QED
3548
3549(* ------------------------------------------------------------------------- *)
3550(* Ring Maps Documentation                                                   *)
3551(* ------------------------------------------------------------------------- *)
3552(* Overloading:
3553   (r ~r~ r_) f  = Ring r /\ Ring r_ /\ RingHomo f r r_
3554   (r =r= r_) f  = Ring r /\ Ring r_ /\ RingIso f r r_
3555   R_            = (r_:'b ring).carrier
3556   R+_           = ring_nonzero (r_:'b ring)
3557   #0_           = (r_:'b ring).sum.id
3558   #1_           = (r_:'b ring).prod.id
3559   +_            = (r_:'b ring).sum.op
3560   *_            = (r_:'b ring).prod.op
3561   -_            = ring_sub (r_:'b ring)
3562   neg_          = (r_:'b ring).sum.inv
3563   ##_           = (r_:'b ring).sum.exp
3564   **_           = (r_:'b ring).prod.exp
3565   unit_ x       = x IN (Invertibles (r_:'b ring).prod).carrier
3566   Unit r x      = x IN (Invertibles r.prod).carrier
3567   |/_           = (Invertibles (r_:'b ring ).prod).inv
3568   Inv r         = (Invertibles r.prod).inv
3569   -_            = neg_
3570
3571   B            = s.carrier
3572   s <= r       = Ring r /\ Ring s /\ subring s r
3573   fR           = (homo_ring r f).carrier
3574*)
3575(* Definitions and Theorems (# are exported):
3576
3577   Homomorphisms, isomorphisms, endomorphisms, automorphisms and subrings:
3578   RingHomo_def        |- !f r s. RingHomo f r s <=> (!x. x IN R ==> f x IN s.carrier) /\
3579                                  GroupHom f r.sum s.sum /\ MonoidHomo f r.prod s.prod
3580   RingIso_def         |- !f r s. RingIso f r s <=> RingHomo f r s /\ BIJ f R s.carrier
3581   RingEndo_def        |- !f r. RingEndo f r <=> RingHomo f r r
3582   RingAuto_def        |- !f r. RingAuto f r <=> RingIso f r r
3583   subring_def         |- !s r. subring s r <=> RingHomo I s r
3584
3585   Ring Homomorphisms:
3586#  ring_homo_zero      |- !r r_ f. (r ~r~ r_) f ==> (f #0 = #0_)
3587#  ring_homo_one       |- !r r_ f. (r ~r~ r_) f ==> (f #1 = #1_)
3588#  ring_homo_ids       |- !r r_ f. (r ~r~ r_) f ==> (f #0 = #0_) /\ (f #1 = #1_)
3589#  ring_homo_element   |- !r r_ f. RingHomo f r r_ ==> !x. x IN R ==> f x IN R_
3590   ring_homo_property  |- !r r_ f. Ring r /\ RingHomo f r r_ ==> !x y. x IN R /\ y IN R ==>
3591                                   (f (x + y) = f x +_ f y) /\ (f (x * y) = f x *_ f y)
3592   ring_homo_cong      |- !r r_ f1 f2. Ring r /\ Ring r_ /\ (!x. x IN R ==> (f1 x = f2 x)) ==>
3593                                       (RingHomo f1 r r_ <=> RingHomo f2 r r_)
3594   ring_homo_add       |- !r r_ f. (r ~r~ r_) f ==> !x y. x IN R /\ y IN R ==> (f (x + y) = f x +_ f y)
3595   ring_homo_mult      |- !r r_ f. (r ~r~ r_) f ==> !x y. x IN R /\ y IN R ==> (f (x * y) = f x *_ f y)
3596   ring_homo_neg       |- !r r_ f. (r ~r~ r_) f ==> !x. x IN R ==> (f (-x) = $-_ (f x))
3597   ring_homo_sub       |- !r r_ f. (r ~r~ r_) f ==> !x y. x IN R /\ y IN R ==> (f (x - y) = f x -_ f y)
3598   ring_homo_num       |- !r r_ f. (r ~r~ r_) f ==> !n. f (##n) = ##_ #1_ n
3599   ring_homo_exp       |- !r r_ f. (r ~r~ r_) f ==> !x. x IN R ==> !n. f (x ** n) = f x **_ n
3600   ring_homo_char_divides  |- !r r_ f. (r ~r~ r_) f ==> char r_ divides char r
3601   ring_homo_I_refl    |- !r. RingHomo I r r
3602   ring_homo_trans     |- !r s t f1 f2. RingHomo f1 r s /\ RingHomo f2 s t ==> RingHomo (f2 o f1) r t
3603   ring_homo_sym       |- !r r_ f. (r ~r~ r_) f /\ BIJ f R R_ ==> RingHomo (LINV f R) r_ r
3604   ring_homo_compose   |- !r s t f1 f2. RingHomo f1 r s /\ RingHomo f2 s t ==> RingHomo (f2 o f1) r t
3605   ring_homo_linv_homo |- !r r_ f. (r ~r~ r_) f /\ BIJ f R R_ ==> RingHomo (LINV f R) r_ r
3606   ring_homo_eq_zero   |- !r r_ f. (r ~r~ r_) f /\ INJ f R R_ ==> !x. x IN R ==> ((f x = #0_) <=> (x = #0))
3607   ring_homo_one_eq_zero       |- !r r_ f. (r ~r~ r_) f /\ (#1 = #0) ==> (#1_ = #0_)
3608   ring_homo_sum_num_property  |- !r r_ f. (r ~r~ r_) f ==>
3609                                  !c. 0 < c /\ c < char r_ ==> ##c <> #0 /\ ##_ #1_ c <> #0_
3610   ring_homo_num_nonzero       |- !r r_ f. (r ~r~ r_) f ==>
3611                                  !c. 0 < c /\ c < char r_ ==> ##c <> #0 /\ f (##c) <> #0_
3612   ring_homo_unit              |- !r r_ f. (r ~r~ r_) f ==> !x. unit x ==> unit_ (f x)
3613   ring_homo_unit_nonzero      |- !r r_ f. (r ~r~ r_) f /\ #1_ <> #0_ ==> !x. unit x ==> f x <> #0_
3614   ring_homo_unit_inv_element  |- !r r_ f. (r ~r~ r_) f ==> !x. unit x ==> |/_ (f x) IN R_
3615   ring_homo_unit_inv_nonzero  |- !r r_ f. (r ~r~ r_) f /\ #1_ <> #0_ ==> !x. unit x ==> |/_ (f x) <> #0_
3616   ring_homo_unit_inv          |- !r r_ f. (r ~r~ r_) f ==> !x. unit x ==> ( |/_ (f x) = f ( |/ x))
3617   ring_homo_inv               |- !r r_ f. (r ~r~ r_) f ==> !x. unit x ==> (f ( |/ x) = |/_ (f x))
3618
3619   Ring Isomorphisms:
3620   ring_iso_zero       |- !r r_ f. (r =r= r_) f ==> (f #0 = #0_)
3621   ring_iso_one        |- !r r_ f. (r =r= r_) f ==> (f #1 = #1_)
3622#  ring_iso_ids        |- !r r_ f. (r =r= r_) f ==> (f #0 = #0_) /\ (f #1 = #1_)
3623   ring_iso_element    |- !r r_ f. RingIso f r r_ ==> !x. x IN R ==> f x IN R_
3624   ring_iso_property   |- !r r_ f. Ring r /\ RingIso f r r_ ==> !x y. x IN R /\ y IN R ==>
3625                                   (f (x + y) = f x +_ f y) /\ (f (x * y) = f x *_ f y)
3626   ring_iso_cong       |- !r r_ f1 f2. Ring r /\ Ring r_ /\ (!x. x IN R ==> (f1 x = f2 x)) ==>
3627                                       (RingIso f1 r r_ <=> RingIso f2 r r_)
3628   ring_iso_add        |- !r r_ f. (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> (f (x + y) = f x +_ f y)
3629   ring_iso_mult       |- !r r_ f. (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> (f (x * y) = f x *_ f y)
3630   ring_iso_neg        |- !r r_ f. (r =r= r_) f ==> !x. x IN R ==> (f (-x) = $-_ (f x))
3631   ring_iso_sub        |- !r r_ f. (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> (f (x - y) = f x -_ f y)
3632   ring_iso_num        |- !r r_ f. (r =r= r_) f ==> !n. f (##n) = ##_ #1_ n
3633   ring_iso_exp        |- !r r_ f. (r =r= r_) f ==> !x. x IN R ==> !n. f (x ** n) = f x **_ n
3634   ring_iso_I_refl     |- !r. RingIso I r r
3635   ring_iso_trans      |- !r s t f1 f2. RingIso f1 r s /\ RingIso f2 s t ==> RingIso (f2 o f1) r t
3636   ring_iso_sym        |- !r r_ f. (r =r= r_) f ==> RingIso (LINV f R) r_ r
3637   ring_iso_compose    |- !r s t f1 f2. RingIso f1 r s /\ RingIso f2 s t ==> RingIso (f2 o f1) r t
3638   ring_iso_linv_iso   |- !r r_ f. (r =r= r_) f ==> RingIso (LINV f R) r_ r
3639   ring_iso_eq_zero    |- !r r_ f. (r =r= r_) f ==> !x. x IN R ==> ((f x = #0_) <=> (x = #0))
3640   ring_iso_card_eq    |- !r r_ f. RingIso f r r_ /\ FINITE R ==> (CARD R = CARD R_)
3641   ring_iso_char_eq    |- !r r_ f. (r =r= r_) f ==> (char r_ = char r)
3642   ring_iso_bij        |- !r r_ f. (r =r= r_) f ==> BIJ f R R_
3643   ring_iso_unit       |- !r r_ f. (r =r= r_) f ==> !x. unit x ==> unit_ (f x)
3644   ring_iso_nonzero    |- !r r_ f. (r =r= r_) f ==> !x. x IN R+ ==> f x IN R+_
3645   ring_iso_inv        |- !r r_ f. (r =r= r_) f ==> !x. unit x ==> (f ( |/ x) = |/_ (f x))
3646   ring_iso_eq_one     |- !r r_ f. (r =r= r_) f ==> !x. x IN R ==> ((f x = #1_) <=> (x = #1))
3647   ring_iso_inverse_element
3648                       |- !r r_ f. (r =r= r_) f ==> !y. y IN R_ ==> LINV f R y IN R /\ (y = f (LINV f R y))
3649   ring_iso_inverse    |- !r r_ f. (r =r= r_) f ==> !y. y IN R_ ==> ?x. x IN R /\ (y = f x)
3650   ring_iso_element_unique
3651                       |- !r r_ f. (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> ((f x = f y) <=> (x = y))
3652
3653   Ring Automorphisms:
3654   ring_auto_zero      |- !r f. Ring r /\ RingAuto f r ==> (f #0 = #0)
3655   ring_auto_one       |- !r f. Ring r /\ RingAuto f r ==> (f #1 = #1)
3656   ring_auto_ids       |- !r f. Ring r /\ RingAuto f r ==> (f #0 = #0) /\ (f #1 = #1)
3657   ring_auto_element   |- !r f. RingAuto f r ==> !x. x IN R ==> f x IN R
3658   ring_auto_cong      |- !r f1 f2. Ring r /\ (!x. x IN R ==> (f1 x = f2 x)) ==>
3659                                    (RingAuto f1 r <=> RingAuto f2 r)
3660   ring_auto_compose   |- !r f1 f2. RingAuto f1 r /\ RingAuto f2 r ==> RingAuto (f1 o f2) r
3661   ring_auto_I         |- !r. RingAuto I r
3662   ring_auto_linv_auto |- !r f. Ring r /\ RingAuto f r ==> RingAuto (LINV f R) r
3663   ring_auto_bij       |- !r f. Ring r /\ RingAuto f r ==> f PERMUTES R
3664
3665   Subrings:
3666   subring_element         |- !r s. subring s r ==> !x. x IN B ==> x IN R
3667   subring_carrier_subset  |- !r s. subring s r ==> B SUBSET R
3668   subring_carrier_finite  |- !r s. FiniteRing r /\ subring s r ==> FINITE B
3669   subring_finite_ring     |- !r s. FiniteRing r /\ s <= r ==> FiniteRing s
3670   subring_refl            |- !r. subring r r
3671   subring_trans           |- !r s t. subring r s /\ subring s t ==> subring r t
3672   subring_I_antisym       |- !r s. subring s r /\ subring r s ==> RingIso I s r
3673   subring_carrier_antisym |- !r s. subring s r /\ R SUBSET B ==> RingIso I s r
3674   subring_sum_subgroup    |- !r s. subring s r ==> subgroup s.sum r.sum
3675   subring_prod_submonoid  |- !r s. subring s r ==> submonoid s.prod r.prod
3676   subring_by_subgroup_submonoid |- !r s. s <= r <=>
3677                              Ring r /\ Ring s /\ subgroup s.sum r.sum /\ submonoid s.prod r.prod
3678   subring_homo_homo       |- !r s r_ f. subring s r /\ RingHomo f r r_ ==> RingHomo f s r_
3679
3680   Subring Theorems:
3681#  subring_zero          |- !r s. s <= r ==> (s.sum.id = #0)
3682#  subring_one           |- !r s. s <= r ==> (s.prod.id = #1)
3683   subring_ids           |- !r s. s <= r ==> (s.sum.id = #0) /\ (s.prod.id = #1)
3684#  subring_element_alt   |- !r s. s <= r ==> !x. x IN B ==> x IN R
3685   subring_property      |- !r s. Ring s /\ subring s r ==> !x y. x IN B /\ y IN B ==>
3686                                  (s.sum.op x y = x + y) /\ (s.prod.op x y = x * y)
3687   subring_add           |- !r s. s <= r ==> !x y. x IN B /\ y IN B ==> (s.sum.op x y = x + y)
3688   subring_mult          |- !r s. s <= r ==> !x y. x IN B /\ y IN B ==> (s.prod.op x y = x * y)
3689   subring_neg           |- !r s. s <= r ==> !x. x IN B ==> (s.sum.inv x = -x)
3690   subring_sub           |- !r s. s <= r ==> !x y. x IN B /\ y IN B ==> (ring_sub s x y = x - y)
3691   subring_num           |- !r s. s <= r ==> !n. s.sum.exp s.prod.id n = ##n
3692   subring_exp           |- !r s. s <= r ==> !x. x IN B ==> !n. s.prod.exp x n = x ** n
3693   subring_char_divides  |- !r s. s <= r ==> (char r) divides (char s)
3694   subring_char          |- !r s. s <= r ==> (char s = char r)
3695   subring_unit          |- !r s. s <= r ==> !x. Unit s x ==> unit x
3696   subring_unit_nonzero  |- !r s. s <= r /\ #1 <> #0 ==> !x. Unit s x ==> x <> #0
3697   subring_unit_inv_element |- !r s. s <= r ==> !x. Unit s x ==> Inv s x IN B
3698   subring_unit_inv_nonzero |- !r s. s <= r /\ #1 <> #0 ==> !x. Unit s x ==> Inv s x <> #0
3699   subring_unit_inv         |- !r s. s <= r ==> !x. Unit s x ==> Inv s x = |/ x
3700   subring_ring_iso_compose |- !r s r_ f. subring s r /\ RingIso f r r_ ==> RingHomo f s r_
3701
3702   Homomorphic Image of Ring:
3703   homo_ring_def       |- !r f. homo_ring r f =
3704                          <|carrier := IMAGE f R; sum := homo_group r.sum f; prod := homo_group r.prod f|>
3705   homo_ring_property  |- !r f. (fR = IMAGE f R) /\ ((homo_ring r f).sum = homo_group r.sum f) /\
3706                                ((homo_ring r f).prod = homo_group r.prod f)
3707   homo_ring_ring      |- !r f. Ring r /\ RingHomo f r (homo_ring r f) ==> Ring (homo_ring r f)
3708   homo_ring_subring   |- !r s f. Ring r /\ Ring s /\ RingHomo f r s ==> subring (homo_ring r f) s
3709   homo_ring_by_inj    |- !r f. Ring r /\ INJ f R univ(:'b) ==> RingHomo f r (homo_ring r f)
3710
3711   Homomorphic Image between Rings:
3712   ring_homo_image_def    |- !f r r_. ring_homo_image f r r_ =
3713                                     <|carrier := IMAGE f R;
3714                                           sum := homo_image f r.sum r_.sum;
3715                                          prod := homo_image f r.prod r_.prod
3716                                      |>
3717   ring_homo_image_carrier          |- !r r_ f. (ring_homo_image f r r_).carrier = IMAGE f R
3718   ring_homo_image_ring             |- !r r_ f. (r ~r~ r_) f ==> Ring (ring_homo_image f r r_)
3719   ring_homo_image_subring_subring  |- !r r_ f. (r ~r~ r_) f ==>
3720                                       !s. Ring s /\ subring s r ==> subring (ring_homo_image f s r_) r_
3721   ring_homo_image_is_subring       |- !r r_ f. (r ~r~ r_) f ==> subring (ring_homo_image f r r_) r_
3722   ring_homo_image_subring          |- !r r_ f. (r ~r~ r_) f ==> ring_homo_image f r r_ <= r_
3723   ring_homo_image_homo             |- !r r_ f. (r ~r~ r_) f ==> RingHomo f r (ring_homo_image f r r_)
3724   ring_homo_image_bij              |- !r r_ f. (r ~r~ r_) f /\ INJ f R R_ ==>
3725                                                BIJ f R (ring_homo_image f r r_).carrier
3726   ring_homo_image_iso              |- !r r_ f. (r ~r~ r_) f /\ INJ f R R_ ==>
3727                                                RingIso f r (ring_homo_image f r r_)
3728   ring_homo_image_surj_property    |- !r r_ f. Ring r /\ Ring r_ /\ SURJ f R R_ ==>
3729                                                RingIso I r_ (ring_homo_image f r r_)
3730
3731   ring_homo_subring_homo       |- !r s r_ f. (r ~r~ r_) f /\ s <= r ==> (s ~r~ ring_homo_image f s r_) f
3732   ring_iso_subring_iso         |- !r s r_ f. (r =r= r_) f /\ s <= r ==> (s =r= ring_homo_image f s r_) f
3733   ring_homo_ring_homo_subring  |- !r r_ f. (r ~r~ r_) f ==> subring (ring_homo_image f r r_) r_
3734   ring_iso_ring_homo_subring   |- !r r_ f. (r =r= r_) f ==> subring (ring_homo_image f r r_) r_
3735   subring_ring_iso_ring_homo_subring
3736                                |- !r s r_ f. s <= r /\ (r =r= r_) f ==> ring_homo_image f s r_ <= r_
3737
3738   Injective Image of Ring:
3739   ring_inj_image_def           |- !r f. Ring r ==> ring_inj_image r f =
3740      <|carrier := IMAGE f R;
3741            sum := <|carrier := IMAGE f R; op := (\x y. f (LINV f R x + LINV f R y)); id := f #0|>;
3742           prod := <|carrier := IMAGE f R; op := (\x y. f (LINV f R x * LINV f R y)); id := f #1|>
3743       |>
3744   ring_inj_image_carrier       |- !r f. (ring_inj_image r f).carrier = IMAGE f R
3745   ring_inj_image_alt           |- !f r. Ring r ==> ring_inj_image r f =
3746                                         <|carrier := IMAGE f R;
3747                                               sum := monoid_inj_image r.sum f;
3748                                              prod := monoid_inj_image r.prod f
3749                                          |>
3750   ring_inj_image_ring          |- !r f. Ring r /\ INJ f R univ(:'b) ==> Ring (ring_inj_image r f)
3751   ring_inj_image_sum_monoid    |- !r f. Ring r /\ INJ f R univ(:'b) ==> Monoid (ring_inj_image r f).sum
3752   ring_inj_image_sum_group     |- !r f. Ring r /\ INJ f R univ(:'b) ==> Group (ring_inj_image r f).sum
3753   ring_inj_image_sum_abelian_group
3754                                |- !r f. Ring r /\ INJ f R univ(:'b) ==> AbelianGroup (ring_inj_image r f).sum
3755   ring_inj_image_prod_monoid   |- !r f. Ring r /\ INJ f R univ(:'b) ==> Monoid (ring_inj_image r f).prod
3756   ring_inj_image_prod_abelian_monoid
3757                                |- !r f. Ring r /\ INJ f R univ(:'b) ==> AbelianMonoid (ring_inj_image r f).prod
3758   ring_inj_image_sum_group_homo
3759                      |- !r f. Ring r /\ INJ f R univ(:'b) ==> GroupHomo f r.sum (ring_inj_image r f).sum
3760   ring_inj_image_prod_monoid_homo
3761                      |- !r f. Ring r /\ INJ f R univ(:'b) ==> MonoidHomo f r.prod (ring_inj_image r f).prod
3762   ring_inj_image_ring_homo
3763                      |- !r f. Ring r /\ INJ f R univ(:'b) ==> RingHomo f r (ring_inj_image r f)
3764*)
3765
3766(* ------------------------------------------------------------------------- *)
3767(* Homomorphisms, isomorphisms, endomorphisms, automorphisms and subrings.   *)
3768(* ------------------------------------------------------------------------- *)
3769
3770(* A function f from r to s is a homomorphism if ring properties are preserved. *)
3771Definition RingHomo_def:
3772  RingHomo f (r:'a ring) (s:'b ring) <=>
3773     (!x. x IN r.carrier ==> f x IN s.carrier) /\
3774     GroupHomo f (r.sum) (s.sum) /\
3775     MonoidHomo f (r.prod) (s.prod)
3776End
3777
3778(* A function f from r to s is an isomorphism if f is a bijective homomorphism. *)
3779Definition RingIso_def:
3780  RingIso f r s <=> RingHomo f r s /\ BIJ f r.carrier s.carrier
3781End
3782
3783(* A ring homomorphism from r to r is an endomorphism. *)
3784Definition RingEndo_def:   RingEndo f r <=> RingHomo f r r
3785End
3786
3787(* A ring isomorphism from r to r is an automorphism. *)
3788Definition RingAuto_def:   RingAuto f r <=> RingIso f r r
3789End
3790
3791(* A subring s of r if identity is a homomorphism from s to r *)
3792Definition subring_def:   subring s r <=> RingHomo I s r
3793End
3794
3795(* Overloads for Homomorphism and Isomorphisms with map *)
3796Overload "~r~" = ``\(r:'a ring) (r_:'b ring) f. Ring r /\ Ring r_ /\ RingHomo f r r_``
3797Overload "=r=" = ``\(r:'a ring) (r_:'b ring) f. Ring r /\ Ring r_ /\ RingIso f r r_``
3798(* make infix operators *)
3799val _ = set_fixity "~r~" (Infix(NONASSOC, 450)); (* same as relation *)
3800val _ = set_fixity "=r=" (Infix(NONASSOC, 450)); (* same as relation *)
3801
3802(* Overloads for Ring of type 'b *)
3803Overload R_ = ``(r_:'b ring).carrier``
3804Overload "R+_" = ``ring_nonzero (r_:'b ring)``
3805Overload "#0_" = ``(r_:'b ring).sum.id``
3806Overload "#1_" = ``(r_:'b ring).prod.id``
3807Overload "+_" = ``(r_:'b ring).sum.op``
3808Overload "*_" = ``(r_:'b ring).prod.op``
3809Overload "-_" = ``ring_sub (r_:'b ring)``
3810Overload neg_ = ``(r_:'b ring).sum.inv``(* unary negation *)
3811Overload "##_" = ``(r_:'b ring).sum.exp``
3812Overload "**_" = ``(r_:'b ring).prod.exp``
3813Overload unit_ = ``\x. x IN (Invertibles (r_:'b ring).prod).carrier``
3814Overload "|/_" = ``(Invertibles (r_:'b ring).prod).inv``
3815Overload Unit = ``\r x. x IN (Invertibles r.prod).carrier``(* for any type *)
3816Overload Inv = ``\r. (Invertibles r.prod).inv``(* for any type *)
3817(* make infix operators *)
3818val _ = set_fixity "+_" (Infixl 500); (* same as + in arithmeticScript.sml *)
3819val _ = set_fixity "-_" (Infixl 500); (* same as - in arithmeticScript.sml *)
3820val _ = set_fixity "*_" (Infixl 600); (* same as * in arithmeticScript.sml *)
3821val _ = set_fixity "**_" (Infixr 700); (* same as EXP in arithmeticScript.sml, infix right *)
3822(* 900 for numeric_negate *)
3823(* make unary symbolic *)
3824Overload "-_" = ``neg_``(* becomes $-_ *)
3825
3826(* ------------------------------------------------------------------------- *)
3827(* Ring Homomorphisms.                                                       *)
3828(* ------------------------------------------------------------------------- *)
3829
3830(* Theorem: (r ~r~ r_) f ==> (f #0 = #0_) *)
3831(* Proof:
3832   Ring r ==> Group r.sum                        by ring_add_group
3833   Ring r_ ==> Group r_.sum                      by ring_add_group
3834   RingHomo f r r_ ==> GroupHomo f r.sum r_.sum  by RingHomo_def
3835   Hence true by group_homo_id.
3836*)
3837Theorem ring_homo_zero:
3838    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> (f #0 = #0_)
3839Proof
3840  rw_tac std_ss[ring_add_group, RingHomo_def, group_homo_id]
3841QED
3842
3843(* Theorem: (r ~r~ r_) f ==> (f #1 = #1_) *)
3844(* Proof:
3845   Ring r ==> Monoid r.prod                         by ring_mult_monoid
3846   Ring r_ ==> Monoid r_.prod                       by ring_mult_monoid
3847   RingHomo f r r_ ==> MonoidHomo f r.prod r_.prod  by RingHomo_def
3848   Hence true by MonoidHomo_def.
3849*)
3850Theorem ring_homo_one:
3851    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> (f #1 = #1_)
3852Proof
3853  rw_tac std_ss[ring_mult_monoid, RingHomo_def, MonoidHomo_def]
3854QED
3855
3856(* Theorem: (r ~r~ r_) f ==> (f #0 = #0_) /\ (f #1 = #1_) *)
3857(* Proof: by ring_homo_zero, ring_homo_one *)
3858Theorem ring_homo_ids[simp]:
3859    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> (f #0 = #0_) /\ (f #1 = #1_)
3860Proof
3861  rw_tac std_ss[ring_homo_zero, ring_homo_one]
3862QED
3863
3864
3865(* Theorem: RingHomo f r r_ ==> !x. x IN R ==> f x IN R_ *)
3866(* Proof: by RingHomo_def *)
3867Theorem ring_homo_element:
3868    !(r:'a ring) (r_:'b ring) f. RingHomo f r r_ ==> !x. x IN R ==> f x IN R_
3869Proof
3870  rw[RingHomo_def]
3871QED
3872
3873(* Theorem: Ring r /\ RingHomo f r r_ ==>
3874            !x y. x IN R /\ y IN R ==> (f (x + y) = (f x) +_ (f y)) /\ (f (x * y) = (f x) *_ (f y)) *)
3875(* Proof: by definitions. *)
3876Theorem ring_homo_property:
3877    !(r:'a ring) (r_:'b ring) f. Ring r /\ RingHomo f r r_ ==>
3878    !x y. x IN R /\ y IN R ==> (f (x + y) = (f x) +_ (f y)) /\ (f (x * y) = (f x) *_ (f y))
3879Proof
3880  rw[RingHomo_def, GroupHomo_def, MonoidHomo_def]
3881QED
3882
3883(* Theorem: Ring r /\ Ring r_ /\ (!x. x IN R ==> (f1 x = f2 x)) ==> (RingHomo f1 r r_ = RingHomo f2 r r_) *)
3884(* Proof: by RingHomo_def, ring_add_group, group_homo_cong, ring_mult_monoid, monoid_homo_cong *)
3885Theorem ring_homo_cong:
3886    !(r:'a ring) (r_:'b ring) f1 f2. Ring r /\ Ring r_ /\ (!x. x IN R ==> (f1 x = f2 x)) ==>
3887                (RingHomo f1 r r_ = RingHomo f2 r r_)
3888Proof
3889  rw_tac std_ss[RingHomo_def, EQ_IMP_THM] >-
3890  metis_tac[ring_add_group, group_homo_cong] >-
3891  metis_tac[ring_mult_monoid, monoid_homo_cong] >-
3892  metis_tac[ring_add_group, group_homo_cong] >>
3893  metis_tac[ring_mult_monoid, monoid_homo_cong]
3894QED
3895
3896(* Theorem: (r ~r~ r_) f ==> !x y. x IN R /\ y IN R ==> (f (x + y) = (f x) +_ (f y)) *)
3897(* Proof: by ring_homo_property. *)
3898Theorem ring_homo_add:
3899    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> !x y. x IN R /\ y IN R ==> (f (x + y) = (f x) +_ (f y))
3900Proof
3901  rw[ring_homo_property]
3902QED
3903
3904(* Theorem: (r ~r~ r_) f ==> !x y. x IN R /\ y IN R ==> (f (x * y) = (f x) *_ (f y)) *)
3905(* Proof: by ring_homo_property. *)
3906Theorem ring_homo_mult:
3907    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> !x y. x IN R /\ y IN R ==> (f (x * y) = (f x) *_ (f y))
3908Proof
3909  rw[ring_homo_property]
3910QED
3911
3912(* Theorem: (r ~r~ r_) f ==> !x. x IN R ==> (f (-x) = $-_ (f x)) *)
3913(* Proof:
3914   Ring r ==> Group r.sum                          by ring_add_group
3915   Ring r_ ==> Group r_.sum                        by ring_add_group
3916   RingHomo f r r_ ==> GroupHomo f r.sum r_.sum    by RingHomo_def
3917   Hence true                                      by group_homo_inv
3918*)
3919Theorem ring_homo_neg:
3920    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> !x. x IN R ==> (f (-x) = $-_ (f x))
3921Proof
3922  rw[ring_add_group, RingHomo_def, group_homo_inv]
3923QED
3924
3925(* Theorem: (r ~r~ r_) f ==> !x y. x IN R /\ y IN R ==> (f (x - y) = (f x) -_ (f y)) *)
3926(* Proof:
3927       f (x - y)
3928     = f (x + -y)              by ring_sub_def
3929     = (f x) +_ f (- y)        by ring_homo_add, ring_neg_element
3930     = (f x) +_ ($-_ (f y))    by ring_homo_neg
3931     = (f x) -_ (f y)          by ring_sub_def
3932*)
3933Theorem ring_homo_sub:
3934    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> !x y. x IN R /\ y IN R ==> (f (x - y) = (f x) -_ (f y))
3935Proof
3936  metis_tac[ring_sub_def, ring_homo_add, ring_homo_neg, ring_neg_element]
3937QED
3938
3939(* Theorem: (r ~r~ r_) f ==> !n. f ##n = ##_ #1_ n *)
3940(* Proof:
3941   By induction on n.
3942   Base case: f (##0) = ##_ #1_ 0
3943     f (## 0)
3944   = f #0          by ring_num_0
3945   = #1_           by ring_homo_zero
3946   = ##_ #1_ 0     by ring_num_0
3947   Step case: f (##n) = ##_ #1_ n ==> f (##(SUC n)) = ##_ #1_ (SUC n)
3948     f (##(SUC n))
3949   = f (#1 + ##n)          by ring_num_SUC
3950   = (f #1) +_ (f ##n)     by ring_homo_property
3951   = #1_ +_ (f ##n)        by ring_homo_one
3952   = #1_ +_ (##_ #1_ n)    by induction hypothesis
3953   = ##_ #1_ (SUC n)       by ring_num_SUC
3954*)
3955Theorem ring_homo_num:
3956    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> !n. f ##n = ##_ #1_ n
3957Proof
3958  rpt strip_tac >>
3959  Induct_on `n` >-
3960  rw[] >>
3961  `f (##(SUC n)) = f (#1 + ##n)` by rw[] >>
3962  `_ = (f #1) +_ (f ##n)` by rw[ring_homo_property] >>
3963  `_ = #1_ +_ (f ##n)` by metis_tac[ring_homo_one] >>
3964  rw[]
3965QED
3966
3967(* Theorem: (r ~r~ r_) f ==> !x. x IN R ==> !n. f (x ** n) = (f x) **_ n *)
3968(* Proof:
3969   By induction on n.
3970   Base case: f (x ** 0) = f x **_ 0
3971     f (x ** 0)
3972   = f #1          by ring_exp_0
3973   = #1_           by ring_homo_one
3974   = f x **_ 0     by ring_exp_0
3975   Step case: f (x ** n) = f x **_ n ==> f (x ** SUC n) = (f x) **_ SUC n
3976     f (x ** SUC n)
3977   = f (x * x ** n)              by ring_exp_SUC
3978   = (f x) *_ (f (x ** n))       by ring_homo_property
3979   = (f x) *_ (f x **_ n)        by induction hypothesis
3980   = (f x) **_ SUC n             by ring_exp_SUC
3981*)
3982Theorem ring_homo_exp:
3983    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> !x. x IN R ==> !n. f (x ** n) = (f x) **_ n
3984Proof
3985  rpt strip_tac >>
3986  Induct_on `n` >-
3987  rw[] >>
3988  `f (x ** SUC n) = f (x * x ** n)` by rw[] >>
3989  `_ = (f x) *_ (f (x ** n))` by rw[ring_homo_property] >>
3990  rw[]
3991QED
3992
3993(* Theorem: If two rings r and s have a ring homomorphism, then (char s) divides (char f).
3994            (r ~r~ r_) f ==> (char r_) divides (char r) *)
3995(* Proof:
3996   Let n = char r, m = char r_. This is to show: m divides n.
3997   If n = 0, result is true by ALL_DIVIDES_0.
3998   If n <> 0, 0 < n.
3999   then  ##n = #0           by char_property
4000   so  f ##n = f #0
4001   or ##_ #1_ n = #0_       by ring_homo_num, ring_homo_zero
4002   and result follows       by ring_char_divides.
4003*)
4004Theorem ring_homo_char_divides:
4005    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> (char r_) divides (char r)
4006Proof
4007  rpt strip_tac >>
4008  Cases_on `char r = 0` >-
4009  rw_tac std_ss[ALL_DIVIDES_0] >>
4010  `0 < char r` by decide_tac >>
4011  metis_tac[char_property, ring_homo_num, ring_homo_zero, ring_char_divides]
4012QED
4013
4014(* Theorem: RingHomo I r r *)
4015(* Proof:
4016   By RingHomo_def, this is to show:
4017   (1) GroupHomo I r.sum r.sum, true by group_homo_I_refl
4018   (2) GroupHomo I f* f*, true by group_homo_I_refl
4019*)
4020Theorem ring_homo_I_refl:
4021    !r:'a ring. RingHomo I r r
4022Proof
4023  rw_tac std_ss[RingHomo_def, group_homo_I_refl, monoid_homo_I_refl]
4024QED
4025
4026(* Theorem: RingHomo f1 r s /\ RingHomo f2 s t ==> RingHomo f2 o f1 r t *)
4027(* Proof:
4028   By RingHomo_def, this is to show:
4029   (1) GroupHomo f1 r.sum s.sum /\ GroupHomo f2 s.sum t.sum ==>  GroupHomo (f2 o f1) r.sum t.sum
4030       True by group_homo_trans.
4031   (2) MonoidHomo f1 r.prod s.prod /\ MonoidHomo f2 s.prod t.pro ==> MonoidHomo (f2 o f1) r.prod t.prod
4032       True by monoid_homo_trans.
4033*)
4034Theorem ring_homo_trans:
4035    !(r:'a ring) (s:'b ring) (t:'c ring). !f1 f2. RingHomo f1 r s /\ RingHomo f2 s t ==> RingHomo (f2 o f1) r t
4036Proof
4037  rw_tac std_ss[RingHomo_def] >| [
4038    metis_tac[group_homo_trans],
4039    metis_tac[monoid_homo_trans]
4040  ]
4041QED
4042
4043(* Theorem: (r ~r~ r_) f /\ BIJ f R R_ ==> RingHomo (LINV f R) r_ r *)
4044(* Proof:
4045   Note BIJ f R R_
4046    ==> BIJ (LINV f R) R_ R                  by BIJ_LINV_BIJ
4047   By RingHomo_def, this is to show:
4048   (1) x IN R_ ==> LINV f R x IN R
4049       With BIJ (LINV f R) R_ R
4050        ==> INJ (LINV f R) R_ R              by BIJ_DEF
4051        ==> x IN R_ ==> LINV f R x IN R      by INJ_DEF
4052   (2) GroupHomo f r.sum r_.sum /\ BIJ f R R_ ==> GroupHomo (LINV f R) r_.sum r.sum
4053       Since Ring r
4054         ==> Group r.sum /\ (r.sum.carrier = R)      by ring_add_group
4055         and Ring r_ ==> r_.sum.carrier = R_         by ring_add_group
4056       Hence GroupHomo (LINV f R) r_.sum r.sum       by group_homo_sym
4057   (3) MonoidHomo f r.prod r_.prod /\ BIJ f R R_ ==> MonoidHomo (LINV f R) r_.prod r.prod
4058       Since Ring r
4059         ==> Group r.prod /\ (r.prod.carrier = R)    by ring_mult_monoid
4060         and Ring r_ ==> r_.prod.carrier = R_        by ring_mult_monoid
4061       Hence MonoidHomo (LINV f R) r_.prod r.prod    by monoid_homo_sym
4062*)
4063Theorem ring_homo_sym:
4064    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f /\ BIJ f R R_ ==> RingHomo (LINV f R) r_ r
4065Proof
4066  rpt strip_tac >>
4067  `BIJ (LINV f R) R_ R` by rw[BIJ_LINV_BIJ] >>
4068  fs[RingHomo_def] >>
4069  rpt strip_tac >-
4070  metis_tac[BIJ_DEF, INJ_DEF] >-
4071 (`Group r.sum /\ (r.sum.carrier = R)` by rw[ring_add_group] >>
4072  `r_.sum.carrier = R_` by rw[ring_add_group] >>
4073  metis_tac[group_homo_sym]) >>
4074  `Monoid r.prod /\ (r.prod.carrier = R)` by rw[ring_mult_monoid] >>
4075  `r_.prod.carrier = R_` by rw[ring_mult_monoid] >>
4076  metis_tac[monoid_homo_sym]
4077QED
4078
4079Theorem ring_homo_sym_any:
4080  Ring r /\ Ring s /\ RingHomo f r s /\
4081  (!x. x IN s.carrier ==> i x IN r.carrier /\ f (i x) = x) /\
4082  (!x. x IN r.carrier ==> i (f x) = x)
4083  ==>
4084  RingHomo i s r
4085Proof
4086  rpt strip_tac
4087  \\ fs[RingHomo_def]
4088  \\ conj_tac
4089  >- (
4090    irule group_homo_sym_any
4091    \\ conj_tac >- metis_tac[Ring_def, AbelianGroup_def]
4092    \\ qexists_tac`f`
4093    \\ metis_tac[ring_carriers] )
4094  \\ irule monoid_homo_sym_any
4095  \\ conj_tac >- metis_tac[Ring_def, AbelianMonoid_def]
4096  \\ qexists_tac`f`
4097  \\ metis_tac[ring_carriers]
4098QED
4099
4100(* Theorem: RingHomo f1 r s /\ RingHomo f2 s t ==> RingHomo (f2 o f1) r t *)
4101(* Proof:
4102   By RingHomo_def, this is to show:
4103   (1) GroupHomo f1 r.sum s.sum /\ GroupHomo f2 s.sum t.sum ==> GroupHomo (f2 o f1) r.sum t.sum
4104       True by group_homo_compose.
4105   (2) MonoidHomo f1 r.prod s.prod /\ MonoidHomo f2 s.prod t.prod ==> MonoidHomo (f2 o f1) r.prod t.prod
4106       True by monoid_homo_compose
4107*)
4108Theorem ring_homo_compose:
4109    !(r:'a ring) (s:'b ring) (t:'c ring).
4110   !f1 f2. RingHomo f1 r s /\ RingHomo f2 s t ==> RingHomo (f2 o f1) r t
4111Proof
4112  rw_tac std_ss[RingHomo_def] >-
4113  metis_tac[group_homo_compose] >>
4114  metis_tac[monoid_homo_compose]
4115QED
4116(* This is the same as ring_homo_trans *)
4117
4118(* Theorem: (r ~r~ r_) f /\  /\ BIJ f R R_ ==> RingHomo (LINV f R) r_ r *)
4119(* Proof:
4120   By RingIso_def, RingHomo_def, this is to show:
4121   (1) BIJ f R R_ /\ x IN R_ ==> LINV f R x IN R
4122       True by BIJ_LINV_ELEMENT
4123   (2) BIJ f R R_ /\ GroupHomo (LINV f R) r_.sum r.sum
4124       Note Group r.sum                            by ring_add_group
4125        and R = r.sum.carrier                      by ring_carriers
4126        and R_ = r_.sum.carrier                    by ring_carriers
4127        ==> GroupIso f r.sum r_.sum                by GroupIso_def, BIJ f R R_
4128       Thus GroupHomo (LINV f R) r_.sum r.sum      by group_iso_linv_iso
4129   (3) BIJ f R R_ /\ MonoidHomo (LINV f R) r_.prod r.prod
4130       Note Monoid r.prod                          by ring_mult_monoid
4131        and R = r.prod.carrier                     by ring_carriers
4132        and R_ = r_.prod.carrier                   by ring_carriers
4133        ==> MonoidIso f r.prod r_.prod             by MonoidIso_def, BIJ f R R_
4134       Thus MonoidHomo (LINV f R) r_.prod r.prod   by monoid_iso_linv_iso
4135*)
4136Theorem ring_homo_linv_homo:
4137    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f /\ BIJ f R R_ ==> RingHomo (LINV f R) r_ r
4138Proof
4139  rw_tac std_ss[RingHomo_def] >-
4140  metis_tac[BIJ_LINV_ELEMENT] >-
4141  metis_tac[group_iso_linv_iso, ring_add_group, ring_carriers, GroupIso_def] >>
4142  metis_tac[monoid_iso_linv_iso, ring_mult_monoid, ring_carriers, MonoidIso_def]
4143QED
4144(* This is the same as ring_homo_sym, direct proof. *)
4145
4146(* Theorem: (r ~r~ r_) f /\ INJ f R R_ ==> !x. x IN R ==> ((f x = #0_) <=> (x = #0)) *)
4147(* Proof:
4148   If part: f x = #0_ ==> x = #0
4149      Note f #0 = #0_      by ring_homo_zero
4150       and #0 IN R         by ring_zero_element
4151      Thus x = #0          by INJ_DEF, x IN R
4152   Only-if part: x = #0 ==> f x = #0_
4153      True                 by ring_homo_zero
4154*)
4155Theorem ring_homo_eq_zero:
4156    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f /\ INJ f R R_ ==> !x. x IN R ==> ((f x = #0_) <=> (x = #0))
4157Proof
4158  metis_tac[ring_homo_zero, INJ_DEF, ring_zero_element]
4159QED
4160
4161(* Theorem: (r ~r~ r_) f /\ (#1 = #0) ==> (#1_ = #0_) *)
4162(* Proof:
4163   Since f #1 = #1_     by ring_homo_one
4164     and f #0 = #0_     by ring_homo_zero
4165   Hence #1_ = #0_
4166*)
4167Theorem ring_homo_one_eq_zero:
4168    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f /\ (#1 = #0) ==> (#1_ = #0_)
4169Proof
4170  metis_tac[ring_homo_one, ring_homo_zero]
4171QED
4172
4173(* Theorem: (r ~r~ r_) f ==> !c:num. 0 < c /\ c < char r_ ==> ##c <> #0 /\ ##_ #1_ c <> #0_ *)
4174(* Proof:
4175   This is to show:
4176   (1) ##c <> #0
4177       By contradiction.
4178       Suppose ##c = #0.
4179          Then (char r) divides c   by ring_char_divides
4180            or (char r) <= c        by DIVIDES_LE, 0 < c.
4181           But 0 < c means c <> 0
4182         Hence char r <> 0          by ZERO_DIVIDES
4183            or 0 < char r
4184           Now (char r_) divides (char r)   by ring_homo_char_divides
4185            so (char r_) <= (char r)        by DIVIDES_LE, 0 < char r.
4186            or c < char r                   by c < char r_
4187       This is a contradiction with (char r) <= c.
4188   (2) ##_ #1_ c <> #0_
4189       By contradiction.
4190       Suppose ##_ #1_ c = #0_.
4191          Then (char r_) divides c          by ring_char_divides
4192            so (char r_) <= c               by DIVIDES_LE, 0 < c.
4193       This is a contradiction with given c < (char r_).
4194*)
4195Theorem ring_homo_sum_num_property:
4196    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==>
4197   !c:num. 0 < c /\ c < char r_ ==> ##c <> #0 /\ ##_ #1_ c <> #0_
4198Proof
4199  rpt strip_tac >| [
4200    `(char r) divides c` by rw[GSYM ring_char_divides] >>
4201    `(char r) <= c` by rw[DIVIDES_LE] >>
4202    `c <> 0` by decide_tac >>
4203    `char r <> 0` by metis_tac[ZERO_DIVIDES] >>
4204    `0 < char r` by decide_tac >>
4205    `(char r_) divides (char r)` by metis_tac[ring_homo_char_divides] >>
4206    `(char r_) <= (char r)` by rw[DIVIDES_LE] >>
4207    decide_tac,
4208    `(char r_) divides c` by rw[GSYM ring_char_divides] >>
4209    `(char r_) <= c` by rw[DIVIDES_LE] >>
4210    decide_tac
4211  ]
4212QED
4213
4214(* Theorem: (r ~r~ r_) f ==> !c:num. 0 < c /\ c < char r_ ==>  ##c <> #0 /\ f (##c) <> #0_ *)
4215(* Proof:
4216   Given 0 < c /\ c < char r_,
4217         ##c <> #0 /\ ##_ #1_ c <> #0_   by ring_homo_sum_num_property
4218     f (##c)
4219   = ##_ #1_ c      by ring_homo_num
4220   <> #0_           by above
4221*)
4222Theorem ring_homo_num_nonzero:
4223    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==>
4224   !c:num. 0 < c /\ c < char r_ ==>  ##c <> #0 /\ f (##c) <> #0_
4225Proof
4226  metis_tac[ring_homo_num, ring_homo_sum_num_property]
4227QED
4228
4229(* Theorem: (r ~r~ r_) f ==> !x. unit x ==> unit_ (f x) *)
4230(* Proof:
4231       unit x
4232   ==> x IN R                             by ring_unit_element
4233   ==> |/ x IN R                          by ring_unit_inv_element
4234   ==> (f x) IN R_ /\ (f ( |/ x)) IN R_   by ring_homo_element
4235     #1_
4236   = f #1                      by ring_homo_one
4237   = f (x * |/ x)              by ring_unit_rinv
4238   = (f x) *_ (f ( |/ x))      by ring_homo_property
4239   Hence true                  by ring_unit_property
4240*)
4241Theorem ring_homo_unit:
4242    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> !x. unit x ==> unit_ (f x)
4243Proof
4244  rpt strip_tac >>
4245  `x IN R` by rw[ring_unit_element] >>
4246  `|/ x IN R` by rw[ring_unit_inv_element] >>
4247  `(f x) IN R_ /\ (f ( |/ x)) IN R_` by metis_tac[ring_homo_element] >>
4248  `#1_ = f #1` by rw[ring_homo_one] >>
4249  `_ = f (x * |/ x)` by rw[ring_unit_rinv] >>
4250  `_ = (f x) *_ (f ( |/ x))` by rw[ring_homo_property] >>
4251  metis_tac[ring_unit_property]
4252QED
4253
4254(* Theorem: (r ~r~ r_) f /\ #1_ <> #0_ ==> !x. unit x ==> (f x) <> #0_ *)
4255(* Proof:
4256   By contradiction. Suppose (f x) = #0_.
4257   Since unit x ==> f x IN (Invertibles r_.prod).carrier   by ring_homo_unit
4258   But this contradicts the given #1_ <> #0_               by ring_unit_zero
4259*)
4260Theorem ring_homo_unit_nonzero:
4261    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f /\ #1_ <> #0_ ==> !x. unit x ==> (f x) <> #0_
4262Proof
4263  metis_tac[ring_homo_unit, ring_unit_zero]
4264QED
4265
4266(* Theorem: (r ~r~ r_) f ==> !x. unit x ==> |/_ (f x) = f ( |/ x) *)
4267(* Proof:
4268       unit x
4269   ==> x IN R                             by ring_unit_element
4270   ==> |/ x IN R                          by ring_unit_inv_element
4271   ==> (f x) IN R_ /\ (f ( |/ x)) IN R_   by ring_homo_element
4272     (f x) *_ (f ( |/ x))
4273   = f (x * |/ x)              by ring_homo_property
4274   = f #1                      by ring_unit_rinv
4275   = #1_                       by ring_homo_one
4276   Since unit_ (f x)           by ring_homo_unit
4277   Hence |/_ (f x) = f ( |/x)  by ring_unit_rinv_unique
4278*)
4279Theorem ring_homo_unit_inv:
4280    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> !x. unit x ==> |/_ (f x) = f ( |/ x)
4281Proof
4282  rpt strip_tac >>
4283  `x IN R` by rw[ring_unit_element] >>
4284  `|/ x IN R` by rw[ring_unit_inv_element] >>
4285  `(f x) IN R_ /\ (f ( |/ x)) IN R_` by metis_tac[ring_homo_element] >>
4286  `(f x) *_ (f ( |/ x)) = f (x * |/x)` by rw[ring_homo_property] >>
4287  `_ = f #1` by rw[ring_unit_rinv] >>
4288  `_ = #1_` by rw[ring_homo_one] >>
4289  metis_tac[ring_homo_unit, ring_unit_rinv_unique]
4290QED
4291
4292(* Theorem: (r ~r~ r_) f ==> !x. unit x ==> |/_ (f x) IN R_ *)
4293(* Proof:
4294   Note unit_ (f x)        by ring_homo_unit
4295   Thus |/_ (f x) IN R_    by ring_unit_inv_element
4296*)
4297Theorem ring_homo_unit_inv_element:
4298    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> !x. unit x ==> |/_ (f x) IN R_
4299Proof
4300  metis_tac[ring_homo_unit, ring_unit_inv_element]
4301QED
4302
4303(* Theorem: (r ~r~ r_) f /\ #1_ <> #0_ ==> !x. unit x ==> |/_ (f x) <> #0_ *)
4304(* Proof:
4305   Note unit_ (f x)        by ring_homo_unit
4306   Thus |/_ (f x) <> #0_   by ring_unit_inv_nonzero
4307*)
4308Theorem ring_homo_unit_inv_nonzero:
4309    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f /\ #1_ <> #0_ ==>
4310   !x. unit x ==> |/_ (f x) <> #0_
4311Proof
4312  metis_tac[ring_homo_unit, ring_unit_inv_nonzero]
4313QED
4314
4315(* Theorem: (r ~r~ r_) f ==> !x. unit x ==> (f ( |/ x) = |/_ (f x)) *)
4316(* Proof:
4317       unit x
4318   ==> x IN R                             by ring_unit_element
4319   ==> |/ x IN R                          by ring_unit_inv_element
4320   ==> (f x) IN R_ /\ (f ( |/ x)) IN R_   by ring_homo_element
4321     #1_
4322   = f #1                                 by ring_homo_one
4323   = f (x * |/ x)                         by ring_unit_rinv
4324   = (f x) *_ (f ( |/ x))                 by ring_homo_property
4325   Since unit_ (f x)                      by ring_homo_unit
4326   Hence f ( |/ x) = |/_ (f x)            by ring_unit_rinv_unique
4327*)
4328Theorem ring_homo_inv:
4329    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> !x. unit x ==> (f ( |/ x) = |/_ (f x))
4330Proof
4331  rpt strip_tac >>
4332  `x IN R` by rw[ring_unit_element] >>
4333  `|/ x IN R` by rw[ring_unit_inv_element] >>
4334  `(f x) IN R_ /\ (f ( |/ x)) IN R_` by metis_tac[ring_homo_element] >>
4335  `#1_ = f #1` by rw[ring_homo_one] >>
4336  `_ = f (x * |/ x)` by rw[ring_unit_rinv] >>
4337  `_ = (f x) *_ (f ( |/ x))` by rw[ring_homo_property] >>
4338  `unit_ (f x)` by metis_tac[ring_homo_unit] >>
4339  rw[ring_unit_rinv_unique]
4340QED
4341
4342(* ------------------------------------------------------------------------- *)
4343(* Ring Isomorphisms.                                                        *)
4344(* ------------------------------------------------------------------------- *)
4345
4346(* Theorem: (r =r= r_) f ==> (f #0 = #0_) *)
4347(* Proof: by RingIso_def, ring_homo_zero *)
4348Theorem ring_iso_zero:
4349    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> (f #0 = #0_)
4350Proof
4351  rw[RingIso_def]
4352QED
4353
4354(* Theorem: (r =r= r_) f ==> (f #1 = #1_) *)
4355(* Proof: by RingIso_def, ring_homo_zero *)
4356Theorem ring_iso_one:
4357    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> (f #1 = #1_)
4358Proof
4359  rw[RingIso_def]
4360QED
4361
4362(* Theorem: (r =r= r_) f ==> (f #0 = #0_) /\ (f #1 = #1_) *)
4363(* Proof: by ring_iso_zero, ring_iso_one. *)
4364Theorem ring_iso_ids[simp]:
4365    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> (f #0 = #0_) /\ (f #1 = #1_)
4366Proof
4367  rw_tac std_ss[ring_iso_zero, ring_iso_one]
4368QED
4369
4370
4371(* Theorem: RingIso f r r_ ==> !x. x IN R ==> f x IN R_ *)
4372(* Proof: by RingIso_def, ring_homo_element *)
4373Theorem ring_iso_element:
4374    !(r:'a ring) (r_:'b ring) f. RingIso f r r_ ==> !x. x IN R ==> f x IN R_
4375Proof
4376  metis_tac[RingIso_def, ring_homo_element]
4377QED
4378
4379(* Theorem: Ring r /\ RingIso f r r_ ==>
4380            !x y. x IN R /\ y IN R ==> (f (x + y) = (f x) +_ (f y)) /\ (f (x * y) = (f x) *_ (f y)) *)
4381(* Proof: by RingIso_def, ring_homo_property *)
4382Theorem ring_iso_property:
4383    !(r:'a ring) (r_:'b ring) f. Ring r /\ RingIso f r r_ ==>
4384    !x y. x IN R /\ y IN R ==> (f (x + y) = (f x) +_ (f y)) /\ (f (x * y) = (f x) *_ (f y))
4385Proof
4386  rw[RingIso_def, ring_homo_property]
4387QED
4388
4389(* Theorem: Ring r /\ Ring r_ /\ (!x. x IN R ==> (f1 x = f2 x)) ==> (RingIso f1 r r_ <=> RingIso f2 r r_) *)
4390(* Proof:
4391   If part: RingIso f1 r r_ ==> RingIso f2 r r_
4392      By RingIso_def, RingHomo_def, this is to show:
4393      (1) x IN R ==> f2 x IN R_, true         by implication, given x IN R ==> f1 x IN R_
4394      (2) GroupHomo f2 r.sum r_.sum, true     by GroupHomo_def, ring_carriers, ring_add_element
4395      (3) MonoidHomo f2 r.prod r_.prod, true  by MonoidHomo_def, ring_carriers, ring_mult_element, ring_one_element
4396      (4) BIJ f R R_ ==> BIJ f2 R R_, true    by BIJ_DEF, INJ_DEF, SURJ_DEF
4397   Only-if part: RingIso f2 r r_ ==> RingIso f1 r r_
4398      By RingIso_def, RingHomo_def, this is to show:
4399      (1) x IN R_ ==> f1 x IN R, true trivially, given x IN R_ ==> f1 x IN R
4400      (2) GroupHomo f1 r_.sum r.sum, true     by GroupHomo_def
4401      (3) MonoidHomo f1 r_.prod r.prod, true  by MonoidHomo_def
4402      (4) BIJ f2 R R_ ==> BIJ f1 R R), true   by BIJ_DEF, INJ_DEF, SURJ_DEF
4403*)
4404Theorem ring_iso_cong:
4405    !(r:'a ring) (r_:'b ring) f1 f2. Ring r /\ Ring r_ /\ (!x. x IN R ==> (f1 x = f2 x)) ==>
4406        (RingIso f1 r r_ <=> RingIso f2 r r_)
4407Proof
4408  rw_tac std_ss[EQ_IMP_THM] >| [
4409    fs[RingIso_def, RingHomo_def] >>
4410    rpt strip_tac >-
4411    metis_tac[] >-
4412   (fs[GroupHomo_def] >>
4413    metis_tac[ring_carriers, ring_add_element]) >-
4414   (fs[MonoidHomo_def] >>
4415    metis_tac[ring_carriers, ring_mult_element, ring_one_element]) >>
4416    fs[BIJ_DEF, INJ_DEF, SURJ_DEF] >>
4417    metis_tac[],
4418    fs[RingIso_def, RingHomo_def] >>
4419    rpt strip_tac >-
4420    fs[GroupHomo_def] >-
4421    fs[MonoidHomo_def] >>
4422    fs[BIJ_DEF, INJ_DEF, SURJ_DEF] >>
4423    metis_tac[]
4424  ]
4425QED
4426
4427(* Theorem: (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> (f (x + y) = (f x) +_ (f y)) *)
4428(* Proof: by RingIso_def, ring_homo_add *)
4429Theorem ring_iso_add:
4430    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> (f (x + y) = (f x) +_ (f y))
4431Proof
4432  rw[RingIso_def, ring_homo_add]
4433QED
4434
4435(* Theorem: (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> (f (x * y) = (f x) *_ (f y)) *)
4436(* Proof: by RingIso_def, ring_homo_mult *)
4437Theorem ring_iso_mult:
4438    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> (f (x * y) = (f x) *_ (f y))
4439Proof
4440  rw[RingIso_def, ring_homo_mult]
4441QED
4442
4443(* Theorem: (r =r= r_) f ==> !x. x IN R ==> (f (-x) = $-_ (f x)) *)
4444(* Proof: by RingIso_def, ring_homo_neg *)
4445Theorem ring_iso_neg:
4446    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x. x IN R ==> (f (-x) = $-_ (f x))
4447Proof
4448  rw[RingIso_def, ring_homo_neg]
4449QED
4450
4451(* Theorem: (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> (f (x - y) = (f x) -_ (f y)) *)
4452(* Proof: by RingIso_def, ring_homo_sub *)
4453Theorem ring_iso_sub:
4454    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> (f (x - y) = (f x) -_ (f y))
4455Proof
4456  rw[RingIso_def, ring_homo_sub]
4457QED
4458
4459(* Theorem: (r =r= r_) f ==> !n. f (##n) = ##_ #1_ n *)
4460(* Proof: by RingIso_def, ring_homo_num *)
4461Theorem ring_iso_num:
4462    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !n. f (##n) = ##_ #1_ n
4463Proof
4464  rw[RingIso_def, ring_homo_num]
4465QED
4466
4467(* Theorem: (r =r= r_) f ==> !x. x IN R ==> !n. f (x ** n) = (f x) **_ n *)
4468(* Proof: by RingIso_def, ring_homo_exp *)
4469Theorem ring_iso_exp:
4470    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x. x IN R ==> !n. f (x ** n) = (f x) **_ n
4471Proof
4472  rw[RingIso_def, ring_homo_exp]
4473QED
4474
4475(* Theorem: RingIso I r r *)
4476(* Proof:
4477   By RingIso_def, this is to show:
4478   (1) RingHomo I r r, true by ring_homo_I_refl
4479   (2) BIJ I R R, true      by BIJ_I_SAME
4480*)
4481Theorem ring_iso_I_refl:
4482    !r:'a ring. RingIso I r r
4483Proof
4484  rw[RingIso_def, ring_homo_I_refl, BIJ_I_SAME]
4485QED
4486
4487(* Theorem: RingIso f1 r s /\ RingIso f2 s t ==> RingIso (f2 o f1) r t *)
4488(* Proof:
4489   By RingIso_def, this is to show:
4490   (1) RingHomo f1 r s /\ RingHomo f2 s t ==> RingHomo (f2 o f1) r t
4491       True by ring_homo_trans.
4492   (2) BIJ f1 R s.carrier /\ BIJ f2 s.carrier t.carrier ==> BIJ (f2 o f1) R t.carrier
4493       True by BIJ_COMPOSE.
4494*)
4495Theorem ring_iso_trans:
4496    !(r:'a ring) (s:'b ring) (t:'c ring). !f1 f2. RingIso f1 r s /\ RingIso f2 s t ==> RingIso (f2 o f1) r t
4497Proof
4498  rw[RingIso_def] >-
4499  metis_tac[ring_homo_trans] >>
4500  metis_tac[BIJ_COMPOSE]
4501QED
4502(* This is the same as ring_iso_trans. *)
4503
4504(* Theorem: (r =r= r_) f ==> RingIso (LINV f R) r_ r *)
4505(* Proof:
4506   By RingIso_def, this is to show:
4507   (1) RingHomo f r r_ /\ BIJ f R R_ ==> RingHomo (LINV f R) r_ r, true  by ring_homo_sym
4508   (2) BIJ f R R_ ==> BIJ (LINV f R) R_ R, true                          by BIJ_LINV_BIJ
4509*)
4510Theorem ring_iso_sym:
4511    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> RingIso (LINV f R) r_ r
4512Proof
4513  rw[RingIso_def, ring_homo_sym, BIJ_LINV_BIJ]
4514QED
4515
4516Theorem ring_iso_sym_any:
4517  Ring r /\ Ring s /\ RingIso f r s /\
4518  (!x. x IN s.carrier ==> i x IN r.carrier /\ f (i x) = x) /\
4519  (!x. x IN r.carrier ==> i (f x) = x)
4520  ==>
4521  RingIso i s r
4522Proof
4523  rpt strip_tac \\ fs[RingIso_def]
4524  \\ conj_tac >- metis_tac[ring_homo_sym_any]
4525  \\ simp[BIJ_IFF_INV]
4526  \\ qexists_tac`f`
4527  \\ metis_tac[BIJ_DEF, INJ_DEF]
4528QED
4529
4530(* Theorem: RingIso f1 r s /\ RingIso f2 s t ==> RingIso (f2 o f1) r t *)
4531(* Proof:
4532   By RingIso_def, this is to show:
4533   (1) RingHomo f1 r s /\ RingHomo f2 s t ==> RingHomo (f2 o f1) r t
4534       True by ring_homo_compose.
4535   (2) BIJ f1 R s.carrier /\ BIJ f2 s.carrier t.carrier ==> BIJ (f2 o f1) R t.carrier
4536       True by BIJ_COMPOSE
4537*)
4538Theorem ring_iso_compose:
4539    !(r:'a ring) (s:'b ring) (t:'c ring).
4540   !f1 f2. RingIso f1 r s /\ RingIso f2 s t ==> RingIso (f2 o f1) r t
4541Proof
4542  rw_tac std_ss[RingIso_def] >-
4543  metis_tac[ring_homo_compose] >>
4544  metis_tac[BIJ_COMPOSE]
4545QED
4546
4547(* Theorem: Ring r /\ Ring r_ /\ RingIso f r r_ ==> RingIso (LINV f R) r_ r *)
4548(* Proof:
4549   By RingIso_def, RingHomo_def, this is to show:
4550   (1) BIJ f R R_ /\ x IN R_ ==> LINV f R x IN R
4551       True by BIJ_LINV_ELEMENT
4552   (2) BIJ f R R_ /\ GroupHomo (LINV f R) r_.sum r.sum
4553       Note Group r.sum                            by ring_add_group
4554        and R = r.sum.carrier                      by ring_carriers
4555        and R_ = r_.sum.carrier                    by ring_carriers
4556        ==> GroupIso f r.sum r_.sum                by GroupIso_def
4557       Thus GroupHomo (LINV f R) r_.sum r.sum      by group_iso_linv_iso
4558   (3) BIJ f R R_ /\ MonoidHomo (LINV f R) r_.prod r.prod
4559       Note Monoid r.prod                          by ring_mult_monoid
4560        and R = r.prod.carrier                     by ring_carriers
4561        and R_ = r_.prod.carrier                   by ring_carriers
4562        ==> MonoidIso f r.prod r_.prod             by MonoidIso_def
4563       Thus MonoidHomo (LINV f R) r_.prod r.prod   by monoid_iso_linv_iso
4564   (4) BIJ f R R_ ==> BIJ (LINV f R) R_ R
4565       True by BIJ_LINV_BIJ
4566*)
4567Theorem ring_iso_linv_iso:
4568    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> RingIso (LINV f R) r_ r
4569Proof
4570  rw_tac std_ss[RingIso_def, RingHomo_def] >-
4571  metis_tac[BIJ_LINV_ELEMENT] >-
4572  metis_tac[group_iso_linv_iso, ring_add_group, ring_carriers, GroupIso_def] >-
4573  metis_tac[monoid_iso_linv_iso, ring_mult_monoid, ring_carriers, MonoidIso_def] >>
4574  rw_tac std_ss[BIJ_LINV_BIJ]
4575QED
4576(* This is the same as ring_iso_sym, direct proof. *)
4577
4578(* Theorem: (r =r= r_) f ==> !x. x IN R ==> ((f x = #0_) <=> (x = #0)) *)
4579(* Proof: by ring_homo_eq_zero, RingIso_def, BIJ_DEF *)
4580Theorem ring_iso_eq_zero:
4581    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x. x IN R ==> ((f x = #0_) <=> (x = #0))
4582Proof
4583  rw_tac std_ss[ring_homo_eq_zero, RingIso_def, BIJ_DEF]
4584QED
4585
4586(* Theorem: RingIso f r r_ /\ FINITE R ==> (CARD R = CARD R_ *)
4587(* Proof:
4588   Since BIJ f R R_               by RingIso_def
4589      so FINITE R ==> FINITE R_   by BIJ_FINITE
4590    thus CARD R = CARD R_         by FINITE_BIJ_CARD_EQ
4591*)
4592Theorem ring_iso_card_eq:
4593    !(r:'a ring) (r_:'b ring) f. RingIso f r r_ /\ FINITE R ==> (CARD R = CARD R_)
4594Proof
4595  metis_tac[RingIso_def, BIJ_FINITE, FINITE_BIJ_CARD_EQ]
4596QED
4597
4598(* Theorem: (r =r= r_) f ==> (char r_ = char r) *)
4599(* Proof:
4600   Note RingIso (LINV f R) r_ r     by ring_iso_sym
4601   Thus (char r_) divides (char r)  by RingIso_def, ring_homo_char_divides,
4602    and (char r) divides (char r_)  by RingIso_def, ring_homo_char_divides
4603    ==> char r_ = char r            by DIVIDES_ANTISYM
4604*)
4605Theorem ring_iso_char_eq:
4606    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> (char r_ = char r)
4607Proof
4608  metis_tac[ring_iso_sym, DIVIDES_ANTISYM, RingIso_def, ring_homo_char_divides]
4609QED
4610
4611(* Theorem: (r =r= r_) f ==> BIJ f R R_ *)
4612(* Proof: by RingIso_def *)
4613Theorem ring_iso_bij:
4614    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> BIJ f R R_
4615Proof
4616  rw_tac std_ss[RingIso_def]
4617QED
4618
4619(* Theorem: (r =r= r_) f ==> !x. unit x ==> unit_ (f x) *)
4620(* Proof:
4621   Note RingIso f r r_ ==> RingHomo f r r_   by RingIso_def
4622   Thus !x. unit x ==> unit_ (f x)           by ring_homo_unit
4623*)
4624Theorem ring_iso_unit:
4625    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x. unit x ==> unit_ (f x)
4626Proof
4627  metis_tac[ring_homo_unit, RingIso_def]
4628QED
4629
4630(* Theorem: (r =r= r_) f ==> !x. x IN R+ ==> !x. x IN R+ ==> (f x) IN R+_ *)
4631(* Proof:
4632   Note (r === r_) f
4633      = Ring r /\ Ring r_ /\ RingIso f r r_     by notation
4634   Note x IN R+ <=> x IN R /\ x <> #0           by ring_nonzero_eq
4635    But x IN R ==> f x IN R_                    by ring_iso_element
4636    and x <> #0 ==> f x <> #0_                  by ring_iso_eq_zero
4637     so (f x) IN R+_                            by ring_nonzero_eq
4638*)
4639Theorem ring_iso_nonzero:
4640    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x. x IN R+ ==> (f x) IN R+_
4641Proof
4642  metis_tac[ring_nonzero_eq, ring_iso_element, ring_iso_eq_zero]
4643QED
4644
4645(* Theorem: (r =r= r_) f ==> !x. unit x ==> (f ( |/ x) = |/_ (f x)) *)
4646(* Proof:
4647   Note (r =r= r_) f
4648     = Ring r /\ Ring r_ /\ RingIso f r r_     by notation
4649   ==> Ring r /\ Ring r_ /\ RingdHomo f r r_   by RingIso_def
4650   ==> f ( |/ x) = |/_ (f x)                   by ring_homo_inv, unit x
4651*)
4652Theorem ring_iso_inv:
4653    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x. unit x ==> (f ( |/ x) = |/_ (f x))
4654Proof
4655  rw[RingIso_def, ring_homo_inv]
4656QED
4657
4658(* Theorem: (r =r= r_) f ==> !x. x IN R ==> ((f x = #1_) <=> (x = #1)) *)
4659(* Proof:
4660   If part: f x = #1_ ==> x = #1
4661      Note INJ R R_         by RingIso_def, BIJ_DEF
4662     Since f x = f #1       by ring_iso_one
4663        so   x = #1         by INJ_DEF
4664   Only-if part: x = #1 ==> f x = #1_
4665      True by ring_iso_one
4666*)
4667Theorem ring_iso_eq_one:
4668    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x. x IN R ==> ((f x = #1_) <=> (x = #1))
4669Proof
4670  prove_tac[ring_iso_one, RingIso_def, BIJ_DEF, INJ_DEF, ring_one_element]
4671QED
4672
4673(* Theorem: (r =r= r_) f ==> !y. y IN R_ ==> (LINV f R y) IN R /\ (y = f (LINV f R y)) *)
4674(* Proof: by RingIso_def, BIJ_DEF, BIJ_LINV_ELEMENT, BIJ_LINV_INV *)
4675Theorem ring_iso_inverse_element:
4676    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !y. y IN R_ ==> (LINV f R y) IN R /\ (y = f (LINV f R y))
4677Proof
4678  metis_tac[RingIso_def, BIJ_DEF, BIJ_LINV_ELEMENT, BIJ_LINV_INV]
4679QED
4680
4681(* Theorem: (r =r= r_) f ==> !y. y IN R_ ==> ?x. x IN R /\ (y = f x) *)
4682(* Proof: by ring_iso_inverse_element *)
4683Theorem ring_iso_inverse:
4684    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !y. y IN R_ ==> ?x. x IN R /\ (y = f x)
4685Proof
4686  metis_tac[ring_iso_inverse_element]
4687QED
4688
4689(* Theorem: (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> ((f x = f y) <=> (x = y)) *)
4690(* Proof:
4691   Note INJ R R_                   by RingIso_def, BIJ_DEF
4692   Hence (f x = f y) <=> (x = y)   by INJ_DEF
4693*)
4694Theorem ring_iso_element_unique:
4695    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> !x y. x IN R /\ y IN R ==> ((f x = f y) <=> (x = y))
4696Proof
4697  prove_tac[RingIso_def, BIJ_DEF, INJ_DEF]
4698QED
4699
4700(* ------------------------------------------------------------------------- *)
4701(* Ring Automorphisms.                                                       *)
4702(* ------------------------------------------------------------------------- *)
4703
4704(* Theorem: Ring r /\ RingAuto f r ==> (f #0 = #0) *)
4705(* Proof: by RingAuto_def, ring_iso_zero *)
4706Theorem ring_auto_zero:
4707    !(r:'a ring) f. Ring r /\ RingAuto f r ==> (f #0 = #0)
4708Proof
4709  rw_tac std_ss[RingAuto_def, ring_iso_zero]
4710QED
4711
4712(* Theorem: Ring r /\ RingAuto f r ==> (f #1 = #1) *)
4713(* Proof: by RingAuto_def, ring_iso_one *)
4714Theorem ring_auto_one:
4715    !(r:'a ring) f. Ring r /\ RingAuto f r ==> (f #1 = #1)
4716Proof
4717  rw_tac std_ss[RingAuto_def, ring_iso_one]
4718QED
4719
4720(* Theorem: Ring r /\ RingAuto f r ==> (f #0 = #0) /\ (f #1 = #1) *)
4721(* Proof: by ring_auto_zero, ring_auto_one. *)
4722Theorem ring_auto_ids:
4723    !(r:'a ring) f. Ring r /\ RingAuto f r ==> (f #0 = #0) /\ (f #1 = #1)
4724Proof
4725  rw_tac std_ss[ring_auto_zero, ring_auto_one]
4726QED
4727
4728(* Theorem: RingAuto f r ==> !x. x IN R ==> f x IN R *)
4729(* Proof: by RingAuto_def, ring_iso_element *)
4730Theorem ring_auto_element:
4731    !(r:'a ring) f. RingAuto f r ==> !x. x IN R ==> f x IN R
4732Proof
4733  metis_tac[RingAuto_def, ring_iso_element]
4734QED
4735
4736(* Theorem: Ring r /\ (!x. x IN R ==> (f1 x = f2 x)) ==> (RingAuto f1 r <=> RingAuto f2 r) *)
4737(* Proof: by RingAuto_def, ring_iso_cong. *)
4738Theorem ring_auto_cong:
4739    !(r:'a ring) f1 f2. Ring r /\ (!x. x IN R ==> (f1 x = f2 x)) ==> (RingAuto f1 r <=> RingAuto f2 r)
4740Proof
4741  rw_tac std_ss[RingAuto_def, ring_iso_cong]
4742QED
4743
4744(* Theorem: RingAuto I r *)
4745(* Proof: by RingAuto_def, ring_iso_I_refl. *)
4746Theorem ring_auto_I:
4747    !(r:'a ring). RingAuto I r
4748Proof
4749  rw_tac std_ss[RingAuto_def, ring_iso_I_refl]
4750QED
4751
4752(* Theorem: Ring r /\ RingAuto f r ==> RingAuto (LINV f R) r *)
4753(* Proof:
4754       RingAuto f r
4755   ==> RingIso f r r                by RingAuto_def
4756   ==> RingIso (LINV f R) r         by ring_iso_linv_iso
4757   ==> RingAuto (LINV f R) r        by RingAuto_def
4758*)
4759Theorem ring_auto_linv_auto:
4760    !(r:'a ring) f. Ring r /\ RingAuto f r ==> RingAuto (LINV f R) r
4761Proof
4762  rw_tac std_ss[RingAuto_def, ring_iso_linv_iso]
4763QED
4764
4765
4766(* Theorem: Ring r /\ RingAuto f r ==> f PERMUTES R *)
4767(* Proof: by RingAuto_def, ring_iso_bij *)
4768Theorem ring_auto_bij:
4769    !(r:'a ring) f. Ring r /\ RingAuto f r ==> f PERMUTES R
4770Proof
4771  rw_tac std_ss[RingAuto_def, ring_iso_bij]
4772QED
4773
4774(* ------------------------------------------------------------------------- *)
4775(* Subrings.                                                                 *)
4776(* ------------------------------------------------------------------------- *)
4777
4778(* Overload on s.carrier, base carrier *)
4779Overload B = ``(s:'a ring).carrier``
4780
4781(* Overload on subring situation *)
4782Overload "<=" = ``\(s r):'a ring. Ring r /\ Ring s /\ subring s r``
4783
4784(* Theorem: subring s r ==> !x. x IN B ==> x IN R *)
4785(* Proof: by subring_def, RingHomo_def *)
4786Theorem subring_element:
4787    !(r s):'a ring. subring s r ==> !x. x IN B ==> x IN R
4788Proof
4789  rw_tac std_ss[subring_def, RingHomo_def]
4790QED
4791
4792(* Theorem: subring s r ==> B SUBSET R *)
4793(* Proof: by subring_element, SUBSET_DEF *)
4794Theorem subring_carrier_subset:
4795    !(r s):'a ring. subring s r ==> B SUBSET R
4796Proof
4797  metis_tac[subring_element, SUBSET_DEF]
4798QED
4799
4800(* Theorem: FiniteRing r /\ subring s r ==> FINITE B *)
4801(* Proof:
4802   Since FiniteRing r ==> FINITE R    by FiniteRing_def
4803     and subring s r ==> B SUBSET R   by subring_carrier_subset
4804   Hence FINITE B                     by SUBSET_FINITE
4805*)
4806Theorem subring_carrier_finite:
4807    !(r s):'a ring. FiniteRing r /\ subring s r ==> FINITE B
4808Proof
4809  metis_tac[FiniteRing_def, subring_carrier_subset, SUBSET_FINITE]
4810QED
4811
4812(* Theorem: FiniteRing r /\ s <= r ==> FiniteRing s *)
4813(* Proof:
4814   Since FINITE B       by subring_carrier_finite
4815   Hence FiniteRing s   by FiniteRing_def
4816*)
4817Theorem subring_finite_ring:
4818    !(r s):'a ring. FiniteRing r /\ s <= r ==> FiniteRing s
4819Proof
4820  metis_tac[FiniteRing_def, subring_carrier_finite]
4821QED
4822
4823(* Theorem: subring r r *)
4824(* Proof:
4825   By subring_def, this is to show:
4826   RingHomo I r r, true by ring_homo_I_refl.
4827*)
4828Theorem subring_refl:
4829    !r:'a ring. subring r r
4830Proof
4831  rw[subring_def, ring_homo_I_refl]
4832QED
4833
4834(* Theorem: subring r s /\ subring s t ==> subring r t *)
4835(* Proof:
4836   By subring_def, this is to show:
4837   RingHomo I r s /\ RingHomo I s t ==> RingHomo I r t
4838   Since I o I = I       by combinTheory.I_o_ID
4839   This is true          by ring_homo_trans
4840*)
4841Theorem subring_trans:
4842    !(r s t):'a ring. subring r s /\ subring s t ==> subring r t
4843Proof
4844  prove_tac[subring_def, combinTheory.I_o_ID, ring_homo_trans]
4845QED
4846
4847(* Theorem: subring s r /\ subring r s ==> RingIso I s r *)
4848(* Proof:
4849   By subring_def, RingIso_def, this is to show:
4850      RingHomo I s r /\ RingHomo I r s ==> BIJ I B R
4851   By BIJ_DEF, INJ_DEF, SURJ_DEF, this is to show:
4852   (1) x IN B ==> x IN R, true    by subring_carrier_subset, subring s r
4853   (2) x IN R ==> x IN B, true    by subring_carrier_subset, subring r s
4854*)
4855Theorem subring_I_antisym:
4856    !(r:'a ring) s. subring s r /\ subring r s ==> RingIso I s r
4857Proof
4858  rw_tac std_ss[subring_def, RingIso_def] >>
4859  fs[RingHomo_def] >>
4860  rw_tac std_ss[BIJ_DEF, INJ_DEF, SURJ_DEF]
4861QED
4862
4863(* Theorem: subring s r /\ R SUBSET B ==> RingIso I s r *)
4864(* Proof:
4865   By subring_def, RingIso_def, this is to show:
4866      RingHomo I s r /\ R SUBSET B ==> BIJ I B R
4867   By BIJ_DEF, INJ_DEF, SURJ_DEF, this is to show:
4868   (1) x IN B ==> x IN R, true    by subring_carrier_subset, subring s r
4869   (2) x IN R ==> x IN B, true    by R SUBSET B, given
4870*)
4871Theorem subring_carrier_antisym:
4872    !(r:'a ring) s. subring s r /\ R SUBSET B ==> RingIso I s r
4873Proof
4874  rpt (stripDup[subring_def]) >>
4875  rw_tac std_ss[RingIso_def] >>
4876  `B SUBSET R` by rw[subring_carrier_subset] >>
4877  fs[RingHomo_def, SUBSET_DEF] >>
4878  rw_tac std_ss[BIJ_DEF, INJ_DEF, SURJ_DEF]
4879QED
4880
4881(* Theorem: subring s r ==> subgroup s.sum r.sum *)
4882(* Proof:
4883        subring s r
4884    <=> RingHomo I s r            by subring_def
4885    ==> GroupHomo I s.sum r.sum   by RingHomo_def
4886    ==> subgroup s.rum r.sum      by subgroup_def
4887*)
4888Theorem subring_sum_subgroup:
4889    !(r:'a ring) (s:'a ring). subring s r ==> subgroup s.sum r.sum
4890Proof
4891  rw_tac std_ss[subring_def, RingHomo_def, subgroup_def]
4892QED
4893
4894(* Theorem: subring s r ==> submonoid s.prod r.prod *)
4895(* Proof:
4896        subring s r
4897    <=> RingHomo I s r               by subring_def
4898    ==> MonoidHomo I s.prod r.prod   by RingHomo_def
4899    ==> submonoid s.prod r.prod      by submonoid_def
4900*)
4901Theorem subring_prod_submonoid:
4902    !(r:'a ring) (s:'a ring). subring s r ==> submonoid s.prod r.prod
4903Proof
4904  rw_tac std_ss[subring_def, RingHomo_def, submonoid_def]
4905QED
4906
4907(* Theorem: s <= r <=> Ring r /\ Ring s /\ subgroup s.sum r.sum /\ submonoid s.prod r.prod *)
4908(* Proof:
4909   If part: s <= r ==> Ring r /\ Ring s /\ subgroup s.sum r.sum /\ submonoid s.prod r.prod
4910      Note subgroup s.sum r.sum      by subring_sum_subgroup
4911       and submonoid s.prod r.prod   by subring_prod_submonoid
4912   Only-if part: Ring r /\ Ring s /\ subgroup s.sum r.sum /\ submonoid s.prod r.prod ==> s <= r
4913      Note subgroup s.sum r.sum
4914       ==> s.sum.carrier SUBSET r.sum.carrier   by subgroup_subset
4915       ==> B SUBSET R                           by ring_carriers
4916       ==> !x. x IN B ==> I x IN R              by SUBSET_DEF, I_THM
4917       and subgroup s.sum r.sum ==> GroupHomo I s.sum r.sum         by subgroup_def
4918       and submonoid s.prod r.prod ==> MonoidHomo I s.prod r.prod   by submonoid_def
4919      Thus RingHomo I s r            by RingHomo_def
4920        or s <= r                    by subring_def
4921*)
4922Theorem subring_by_subgroup_submonoid:
4923    !(r:'a ring) (s:'a ring). s <= r <=>
4924     Ring r /\ Ring s /\ subgroup s.sum r.sum /\ submonoid s.prod r.prod
4925Proof
4926  rw[EQ_IMP_THM] >-
4927  rw[subring_sum_subgroup] >-
4928  rw[subring_prod_submonoid] >>
4929  rw_tac std_ss[subring_def, RingHomo_def] >-
4930  metis_tac[subgroup_subset, ring_carriers, SUBSET_DEF] >-
4931  fs[subgroup_def] >>
4932  fs[submonoid_def]
4933QED
4934
4935(* Theorem: subring s r /\ RingHomo f r r_ ==> RingHomo f s r_ *)
4936(* Proof:
4937   By RingHomo_def, this is to show:
4938   (1) subring s r /\ x IN B ==> f x IN R_, true          by subring_element
4939   (2) subring s r /\ GroupHomo f r.sum r_.sum ==> GroupHomo f s.sum r_.sum
4940       Note subgroup s.sum r.sum                          by subring_sum_subgroup
4941       Thus GroupHomo f s.sum r_.sum                      by subgroup_homo_homo
4942   (3) subring s r /\ MonoidHomo f r.prod r_.prod ==> MonoidHomo f s.prod r_.prod
4943       Note submonoid s.prod r.prod                       by subring_prod_submonoid
4944       Thus MonoidHomo f s.prod r_.prod                   by submonoid_homo_homo
4945*)
4946Theorem subring_homo_homo:
4947    !(r:'a ring) (s:'a ring) (r_:'b ring) f. subring s r /\ RingHomo f r r_ ==> RingHomo f s r_
4948Proof
4949  rw_tac std_ss[RingHomo_def] >-
4950  metis_tac[subring_element] >-
4951  metis_tac[subring_sum_subgroup, subgroup_homo_homo] >>
4952  metis_tac[subring_prod_submonoid, submonoid_homo_homo]
4953QED
4954
4955(* ------------------------------------------------------------------------- *)
4956(* Subring Theorems                                                          *)
4957(* ------------------------------------------------------------------------- *)
4958
4959(* Theorem: I x = x *)
4960val i_thm = combinTheory.I_THM;
4961
4962(* Theorem: (f o g) x = f (g x) *)
4963val o_thm = combinTheory.o_THM;
4964
4965(* Theorem: s <= r ==> s.sum.id = #0 *)
4966(* Proof: by subring_def, ring_homo_zero. *)
4967Theorem subring_zero[simp]:
4968    !(r s):'a ring. s <= r ==> (s.sum.id = #0)
4969Proof
4970  metis_tac[subring_def, ring_homo_zero, i_thm]
4971QED
4972
4973(* Theorem: s <= r ==> s.prod.id = #1 *)
4974(* Proof: by subring_def, ring_homo_one. *)
4975Theorem subring_one[simp]:
4976    !(r s):'a ring. s <= r ==> (s.prod.id = #1)
4977Proof
4978  metis_tac[subring_def, ring_homo_one, i_thm]
4979QED
4980
4981(* Theorem: s <= r ==> s.sum.id = #0 /\ s.prod.id = #1 *)
4982(* Proof: by subring_zero, subring_one. *)
4983Theorem subring_ids:
4984    !(r s):'a ring. s <= r ==> (s.sum.id = #0) /\ (s.prod.id = #1)
4985Proof
4986  rw[]
4987QED
4988
4989(* Theorem: s <= r ==> !x. x IN B ==> x IN R *)
4990(* Proof: by subring_def, ring_homo_element. *)
4991Theorem subring_element_alt:
4992    !(r s):'a ring. s <= r ==> !x. x IN B ==> x IN R
4993Proof
4994  metis_tac[subring_def, ring_homo_element, i_thm]
4995QED
4996
4997(* Theorem: subring preserves sum and product. *)
4998(* Proof: by subring_def, ring_homo_property. *)
4999Theorem subring_property:
5000    !(r s):'a ring. Ring s /\ subring s r ==>
5001     !x y. x IN B /\ y IN B ==> (s.sum.op x y = x + y) /\ (s.prod.op x y = x * y)
5002Proof
5003  metis_tac[subring_def, ring_homo_property, i_thm]
5004QED
5005
5006(* Theorem: s <= r ==> !x y. x IN B /\ y IN B ==> (s.sum.op x y = x + y) *)
5007(* Proof: by subring_def, ring_homo_add. *)
5008Theorem subring_add:
5009    !(r s):'a ring. s <= r ==> !x y. x IN B /\ y IN B ==> (s.sum.op x y = x + y)
5010Proof
5011  metis_tac[subring_def, ring_homo_add, i_thm]
5012QED
5013
5014(* Theorem: s <= r ==> !x y. x IN B /\ y IN B ==> (s.prod.op x y = x * y) *)
5015(* Proof: by subring_def, ring_homo_mult. *)
5016Theorem subring_mult:
5017    !(r s):'a ring. s <= r ==> !x y. x IN B /\ y IN B ==> (s.prod.op x y = x * y)
5018Proof
5019  metis_tac[subring_def, ring_homo_mult, i_thm]
5020QED
5021
5022(* Theorem: s <= r ==> !x. x IN B ==> (s.sum.inv x = -x) *)
5023(* Proof: by subring_def, ring_homo_neg. *)
5024Theorem subring_neg:
5025    !(r s):'a ring. s <= r ==> !x. x IN B ==> (s.sum.inv x = -x)
5026Proof
5027  metis_tac[subring_def, ring_homo_neg, i_thm]
5028QED
5029
5030(* Theorem: s <= r ==> !x y. x IN B /\ y IN B ==> (ring_sub s x y = x - y) *)
5031(* Proof: by subring_def, ring_homo_sub. *)
5032Theorem subring_sub:
5033    !(r s):'a ring. s <= r ==> !x y. x IN B /\ y IN B ==> (ring_sub s x y = x - y)
5034Proof
5035  metis_tac[subring_def, ring_homo_sub, i_thm]
5036QED
5037
5038(* Theorem: s <= r ==> !n. s.sum.exp s.prod.id n = ##n *)
5039(* Proof: by subring_def, ring_homo_num. *)
5040Theorem subring_num:
5041    !(r s):'a ring. s <= r ==> !n. s.sum.exp s.prod.id n = ##n
5042Proof
5043  metis_tac[subring_def, ring_homo_num, i_thm]
5044QED
5045
5046(* Theorem: s <= r ==> !n. s.sum.exp s.prod.id n = ##n *)
5047(* Proof: by subring_def, ring_homo_exp. *)
5048Theorem subring_exp:
5049    !(r s):'a ring. s <= r ==> !x. x IN B ==> !n. s.prod.exp x n = x ** n
5050Proof
5051  metis_tac[subring_def, ring_homo_exp, i_thm]
5052QED
5053
5054(* Theorem: s <= r ==> (char r) (char s) divides *)
5055(* Proof: by subring_def, ring_homo_char_divides. *)
5056Theorem subring_char_divides:
5057    !(r s):'a ring. s <= r ==> (char r) divides (char s)
5058Proof
5059  metis_tac[subring_def, ring_homo_char_divides, i_thm]
5060QED
5061
5062(* Note: This seems wrong, but
5063   ring_homo_char_divides |- !r s. Ring r /\ Ring s ==> !f. RingHomo f r s ==> (char s) divides (char r)
5064   subring_def |- !s r. subring s r <=> RingHomo I s r
5065   So for subring s r, it is really (char r) divides (char s).
5066*)
5067
5068(* Note:
5069There is no such theorem: m divides n ==> subring (ZN m) (ZN n)
5070This is because (ZN m) is (mod m), but (ZN n) is (mod n), totally different operations.
5071This means: (GF p) a subring of (ZN n), where prime p divides n, is not true!
5072*)
5073
5074(* Theorem: s <= r ==> (char s = char r) *)
5075(* Proof:
5076     char s
5077   = order s.sum s.prod.id              by char_def
5078   = case OLEAST k. period r.sum #1 k
5079       of NONE => 0 | SOME k => k       by order_def
5080   = case OLEAST k. 0 < k /\ (s.sum.exp s.prod.id k = s.sum.id)
5081       of NONE => 0 | SOME k => k       by period_def
5082   = case OLEAST k. 0 < k /\ (##k = #0)
5083       of NONE => 0 | SOME k => k       by subring_num, subring_ids
5084   = order r.sum #1                     by order_def, period_def
5085   = char r                             by char_def
5086*)
5087Theorem subring_char:
5088    !(r s):'a ring. s <= r ==> (char s = char r)
5089Proof
5090  rw[char_def, order_def, period_def, subring_exp] >>
5091  metis_tac[subring_num, subring_ids]
5092QED
5093
5094(* Theorem: s <= r ==> !x. Unit s x ==> unit x *)
5095(* Proof:
5096   Note s <= r ==> RingHomo I s r   by subring_def
5097   Thus Unit s x = unit (I x)       by ring_homo_unit
5098                 = unit x           by I_THM
5099*)
5100Theorem subring_unit:
5101    !(r:'a ring) s. s <= r ==> !x. Unit s x ==> unit x
5102Proof
5103  metis_tac[ring_homo_unit, subring_def, combinTheory.I_THM]
5104QED
5105
5106(* Theorem: s <= r /\ #1 <> #0 ==> !x. Unit s x ==> x <> #0 *)
5107(* Proof:
5108   Note s <= r ==> RingHomo I s r   by subring_def
5109   Thus Unit s x <> s.prod.id       by ring_homo_unit_nonzero
5110     or          <> I #0 = #0       by I_THM
5111*)
5112Theorem subring_unit_nonzero:
5113    !(r:'a ring) s. s <= r /\ #1 <> #0 ==> !x. Unit s x ==> x <> #0
5114Proof
5115  metis_tac[ring_homo_unit_nonzero, subring_def, combinTheory.I_THM]
5116QED
5117
5118(* Theorem: s <= r ==> !x. Unit s x ==> (Inv s x) IN s.carrier *)
5119(* Proof:
5120   Note Unit s x                by subring_unit
5121   Thus (Inv s x) IN s.carrier  by ring_unit_inv_element
5122
5123   Note:
5124> ring_homo_unit_inv_element |> ISPEC ``s:'a ring`` |> ISPEC ``r:'a ring``;
5125val it = |- !f. (s ~r~ r) f ==> !x. Unit s x ==> |/ (f x) IN R: thm
5126   This is not what we want to prove.
5127*)
5128Theorem subring_unit_inv_element:
5129    !(r s):'a ring. s <= r ==> !x. Unit s x ==> (Inv s x) IN s.carrier
5130Proof
5131  rw[subring_unit, ring_unit_inv_element]
5132QED
5133
5134(* Theorem: s <= r /\ #1 <> #0 ==> !x. Unit s x ==> (Inv s x) <> #0 *)
5135(* Proof:
5136   Note Unit s x                        by subring_unit
5137   Thus (Inv s x) <> s.prod.id          by subring_unit_inv_nonzero
5138    and s.sum.id = #0, s.prod.id = #1   by subring_ids
5139
5140   Note:
5141> ring_homo_unit_inv_nonzero |> ISPEC ``s:'a ring`` |> ISPEC ``r:'a ring``;
5142val it = |- !f. (s ~r~ r) f /\ #1 <> #0 ==> !x. Unit s x ==> |/ (f x) <> #0
5143   This is not what we want to prove.
5144*)
5145Theorem subring_unit_inv_nonzero:
5146    !(r s):'a ring. s <= r /\ #1 <> #0 ==> !x. Unit s x ==> (Inv s x) <> #0
5147Proof
5148  metis_tac[subring_unit, ring_unit_inv_nonzero, subring_ids]
5149QED
5150
5151(* Theorem: s <= r ==> !x. Unit s x ==> (Inv s x = |/ x) *)
5152(* Proof:
5153   Note s <= r ==> RingHomo I s r   by subring_def
5154   Thus |/ (I x) = I (Inv s x)      by ring_homo_unit_inv
5155     or     |/ x = Inv s x          by I_THM
5156
5157> ring_homo_unit_inv |> ISPEC ``s:'a ring`` |> ISPEC ``r:'a ring``;
5158val it = |- !f. (s ~r~ r) f ==> !x. Unit s x ==> |/ (f x) = f (Inv s x): thm
5159> ring_homo_inv |> ISPEC ``s:'a ring`` |> ISPEC ``r:'a ring``;
5160val it = |- !f. (s ~r~ r) f ==> !x. Unit s x ==> f (Inv s x) = |/ (f x): thm
5161*)
5162Theorem subring_unit_inv:
5163  !(r s):'a ring. s <= r ==> !x. Unit s x ==> (Inv s x = |/ x)
5164Proof
5165  metis_tac[ring_homo_unit_inv, subring_def, combinTheory.I_THM]
5166QED
5167
5168(* Theorem: subring s r /\ RingIso f r r_ ==> RingHomo f s r_ *)
5169(* Proof:
5170   Note subring s r ==> RingHomo I s r         by subring_def
5171    and RingIso f r r_  ==> RingHomo f r r_    by RingIso_def
5172   Thus RingHomo (f o I) s r_                  by ring_homo_compose
5173     or RingHomo f s r_                        by I_o_ID
5174*)
5175Theorem subring_ring_iso_compose:
5176    !(r:'a ring) (s:'a ring) (r_:'b ring) f. subring s r /\ RingIso f r r_ ==> RingHomo f s r_
5177Proof
5178  rpt strip_tac >>
5179  `RingHomo I s r` by rw[GSYM subring_def] >>
5180  `RingHomo f r r_` by metis_tac[RingIso_def] >>
5181  prove_tac[ring_homo_compose, combinTheory.I_o_ID]
5182QED
5183
5184(* ------------------------------------------------------------------------- *)
5185(* Homomorphic Image of Ring.                                                *)
5186(* ------------------------------------------------------------------------- *)
5187
5188(* Define the homomorphic image of a ring. *)
5189Definition homo_ring_def:
5190  homo_ring (r:'a ring) (f:'a -> 'b) =
5191    <| carrier := IMAGE f R;
5192           sum := homo_group (r.sum) f;
5193          prod := homo_monoid (r.prod) f
5194     |>
5195End
5196
5197(* set overloading *)
5198Overload fR = ``(homo_ring (r:'a ring) (f:'a -> 'b)).carrier``
5199
5200(* Theorem: Properties of homo_ring. *)
5201(* Proof: by homo_ring_def. *)
5202Theorem homo_ring_property:
5203    !(r:'a ring) (f:'a -> 'b). (fR = IMAGE f R) /\
5204      ((homo_ring r f).sum = homo_group (r.sum) f) /\
5205      ((homo_ring r f).prod = homo_monoid (r.prod) f)
5206Proof
5207  rw_tac std_ss[homo_ring_def]
5208QED
5209
5210(* Theorem: Homomorphic image of a Ring is a Ring. *)
5211(* Proof:
5212   This is to show each of these:
5213   (1) GroupHomo f r.sum (homo_ring r f).sum ==> AbelianGroup (homo_ring r f).sum
5214       Note AbelianGroup r.sum                           by Ring_def
5215        and (homo_ring r f).sum = homo_group r.sum f     by homo_ring_property
5216       Thus GroupHomo f r.sum (homo_group r.sum f)       by above
5217        ==> AbelianGroup (homo_group r.sum f)            by homo_group_abelian_group
5218         or AbelianGroup (homo_ring r f).sum             by above
5219   (2) MonoidHomo f r.prod (homo_ring r f).prod ==> AbelianMonoid (homo_ring r f).prod
5220       Note AbelianMonoid r.prod                         by Ring_def
5221        and (homo_ring r f).prod = homo_group r.prod f   by homo_ring_property
5222       Thus MonoidHomo f r.prod (homo_group r.prod f)    by above
5223        ==> AbelianMonoid (homo_group r.prod f)          by homo_monoid_abelian_monoid
5224         or AbelianMonoid (homo_ring r f).prod           by above
5225   (3) (homo_ring r f).sum.carrier = fR
5226            (homo_ring r f).sum.carrier
5227          = (homo_group r.sum f).carrier                 by homo_ring_property
5228          = IMAGE f r.sum.carrier                        by homo_monoid_property
5229          = IMAGE f R = fR                               by ring_carriers
5230   (4) (homo_ring r f).prod.carrier = fR
5231            (homo_ring r f).prod.carrier
5232          = (homo_group r.prod f).carrier                by homo_ring_property
5233          = IMAGE f r.prod.carrier                       by homo_monoid_property
5234          = IMAGE f R = fR                               by ring_carriers
5235   (5) x IN fR /\ y IN fR /\ z IN fR ==>
5236        (homo_ring r f).prod.op x ((homo_ring r f).sum.op y z) =
5237        (homo_ring r f).sum.op ((homo_ring r f).prod.op x y) ((homo_ring r f).prod.op x z)
5238       Note ?a. x = f a /\ a IN R                        by homo_ring_property, IN_IMAGE
5239        and ?b. y = f b /\ b IN R                        by homo_ring_property, IN_IMAGE
5240        and ?c. z = f c /\ c IN R                        by homo_ring_property, IN_IMAGE
5241        (homo_ring r f).prod.op x ((homo_ring r f).sum.op y z)
5242      = (homo_ring r f).prod.op x (f (b + c))            by GroupHomo_def, ring_carriers
5243      = f (a * (b + c))                                  by MonoidHomo_def, ring_carriers
5244      = f (a * b + a * c)                                by ring_mult_radd
5245      = (homo_ring r f).sum.op (a * b) (a * c)           by MonoidHomo_def, ring_carriers
5246      = (homo_ring r f).sum.op ((homo_ring r f).prod.op x y)
5247                               ((homo_ring r f).prod.op x z)  by GroupHomo_def, ring_carriers
5248*)
5249Theorem homo_ring_ring:
5250    !(r:'a ring) f. Ring r /\ RingHomo f r (homo_ring r f) ==> Ring (homo_ring r f)
5251Proof
5252  rw_tac std_ss[RingHomo_def] >>
5253  rw_tac std_ss[Ring_def] >| [
5254    fs[homo_ring_property] >>
5255    `AbelianGroup r.sum` by metis_tac[Ring_def] >>
5256    rw[homo_group_abelian_group],
5257    fs[homo_ring_property] >>
5258    `AbelianMonoid r.prod` by metis_tac[Ring_def] >>
5259    rw[homo_monoid_abelian_monoid],
5260    fs[homo_ring_property] >>
5261    rw[homo_monoid_property, ring_carriers],
5262    fs[homo_ring_property] >>
5263    rw[homo_monoid_property, ring_carriers],
5264    fs[homo_ring_property] >>
5265    `x' * (x'' + x''') = x' * x'' + x' * x'''` by rw[ring_mult_radd] >>
5266    `x'' + x''' IN R /\ x' * x'' IN R /\ x' * x''' IN R` by rw[] >>
5267    fs[GroupHomo_def, MonoidHomo_def] >>
5268    metis_tac[ring_carriers]
5269  ]
5270QED
5271
5272(* Theorem: Homomorphic image of a Ring is a subring of the target ring. *)
5273(* Proof:
5274   This is to show each of these:
5275   (1) RingHomo f r s /\ x IN fR ==> x IN s.carrier
5276           x IN fR
5277       ==> x IN IMAGE f R       by homo_ring_property
5278       ==> ?z. x = f x, x IN R  by IN_IMAGE
5279       ==> f x IN s.carrier     by RingHomo_def
5280   (2) RingHomo f r s ==> GroupHomo I (homo_ring r f).sum s.sum
5281       RingHomo f r s ==> GroupHomo f r.sum s.sum  by RingHomo_def
5282       hence this is to show: GroupHomo f r.sum s.sum ==> GroupHomo I (homo_ring r f).sum s.sum
5283       Expand by definitions, need to show:
5284       (2.1) x IN IMAGE f r.sum.carrier /\ (!x. x IN r.sum.carrier ==> f x IN s.sum.carrier) ==> x IN s.sum.carrier
5285             True by IN_IMAGE.
5286       (2.2) x IN IMAGE f r.sum.carrier /\ y IN IMAGE f r.sum.carrier /\ ... ==>
5287             f (CHOICE (preimage f r.sum.carrier x) + CHOICE (preimage f r.sum.carrier y)) = s.sum.op x y
5288             True by preimage_choice_property.
5289   (3) RingHomo f r s ==> MonoidHomo I (homo_ring r f).prod s.prod
5290       RingHomo f r s ==> MonoidHomo f r.prod s.prod   by RingHomo_def
5291       hence this is to show: MonoidHomo f r.prod s.prod ==> MonoidHomo I (homo_ring r f).prod s.prod
5292       Expand by definitions, need to show:
5293       (3.1) x IN IMAGE f r.prod.carrier /\ (!x. x IN r.prod.carrier ==> f x IN s.prod.carrier) ==> x IN s.prod.carrier
5294             True by IN_IMAGE.
5295       (3.2) x IN IMAGE f r.prod.carrier /\ y IN IMAGE f r.prod.carrier /\ ... ==>
5296             f (CHOICE (preimage f r.prod.carrier x) * CHOICE (preimage f r.prod.carrier y)) = s.prod.op x y
5297             True by preimage_choice_property.
5298*)
5299Theorem homo_ring_subring:
5300    !(r:'a ring) (s:'b ring) f. Ring r /\ Ring s /\ RingHomo f r s ==> subring (homo_ring r f) s
5301Proof
5302  rpt strip_tac >>
5303  rw_tac std_ss[subring_def, RingHomo_def] >| [
5304    metis_tac[homo_ring_property, IN_IMAGE, RingHomo_def],
5305    `GroupHomo f r.sum s.sum` by metis_tac[RingHomo_def] >>
5306    pop_assum mp_tac >>
5307    rw_tac std_ss[GroupHomo_def, homo_ring_property, homo_monoid_property] >| [
5308      metis_tac[IN_IMAGE],
5309      metis_tac[preimage_choice_property]
5310    ],
5311    `MonoidHomo f r.prod s.prod` by metis_tac[RingHomo_def] >>
5312    pop_assum mp_tac >>
5313    rw_tac std_ss[MonoidHomo_def, homo_ring_property, homo_monoid_property] >| [
5314      metis_tac[IN_IMAGE],
5315      metis_tac[preimage_choice_property]
5316    ]
5317  ]
5318QED
5319
5320(* Theorem: Ring r /\ INJ f R UNIV ==> RingHomo f r (homo_ring r f) *)
5321(* Proof:
5322   By RingHomo_def, homo_ring_property, this is to show:
5323   (1) x IN R ==> f x IN IMAGE f R, true                by IN_IMAGE
5324   (2) GroupHomo f r.sum (homo_group r.sum f), true     by homo_group_by_inj
5325   (3) MonoidHomo f r.prod (homo_group r.prod f), true  by homo_monoid_by_inj
5326*)
5327Theorem homo_ring_by_inj:
5328    !(r:'a ring) (f:'a -> 'b). Ring r /\ INJ f R UNIV ==> RingHomo f r (homo_ring r f)
5329Proof
5330  rw_tac std_ss[RingHomo_def, homo_ring_property] >-
5331  rw[] >-
5332  rw[homo_group_by_inj] >>
5333  rw[homo_monoid_by_inj]
5334QED
5335
5336(* ------------------------------------------------------------------------- *)
5337(* Homomorphic Image between Rings.                                          *)
5338(* ------------------------------------------------------------------------- *)
5339
5340(* Define homomorphism image of Ring *)
5341Definition ring_homo_image_def:
5342  ring_homo_image f (r:'a ring) (r_:'b ring) =
5343     <| carrier := IMAGE f R;
5344            sum := homo_image f r.sum r_.sum;
5345           prod := homo_image f r.prod r_.prod
5346      |>
5347End
5348(*
5349We have these (based on image_op):
5350- homo_ring_def;
5351> val it = |- !r f. homo_ring r f = <|carrier := IMAGE f R;
5352                                          sum := homo_group r.sum f;
5353                                         prod := homo_group r.prod f
5354                                     |> : thm
5355- homo_monoid_def;
5356> val it = |- !g f. homo_group g f = <|carrier := IMAGE f G;
5357                                            op := image_op g f;
5358                                            id := f #e
5359                                      |> : thm
5360We also have (based on real op):
5361- homo_image_def;
5362> val it = |- !f g h. homo_image f g h = <|carrier := IMAGE f G;
5363                                                op := h.op;
5364                                                id := h.id
5365                                          |> : thm
5366So ring_homo_image is based on homo_image.
5367*)
5368
5369(* Theorem: (ring_homo_image f r r_).carrier = IMAGE f R *)
5370(* Proof: by ring_homo_image_def *)
5371Theorem ring_homo_image_carrier:
5372    !(r:'a ring) (r_:'b ring) f. (ring_homo_image f r r_).carrier = IMAGE f R
5373Proof
5374  rw_tac std_ss[ring_homo_image_def]
5375QED
5376
5377(* Theorem: (r ~r~ r_) f ==> Ring (ring_homo_image f r r_) *)
5378(* Proof:
5379   By ring_homo_image_def, Ring_def, this is to show:
5380   (1) AbelianGroup (homo_image f r.sum r_.sum)
5381       Ring r ==> Group r.sum /\ !x y. x IN R /\ y IN R ==> (x + y = y + x)         by ring_add_group
5382       Ring r_ ==> Group r_.sum /\ !x y. x IN R_ /\ y IN R_ ==> (x +_ y = y +_ x)   by ring_add_group
5383       Thus Group (homo_image f r.sum r_.sum)                                       by homo_image_group
5384       And  !x' x''. x' IN R /\ x'' IN R ==> f x' +_ f x'' = f x'' +_ f x'          by commutative properties
5385       Hence AbelianGroup (homo_image f r.sum r_.sum)                               by AbelianGroup_def
5386   (2) AbelianMonoid (homo_image f r.prod r_.prod)
5387       Ring r ==> Monoid r.prod /\ !x y. x IN R /\ y IN R ==> (x * y = y * x)       by ring_mult_monoid
5388       Ring s ==> Monoid r_.prod /\ !x y. x IN R_ /\ y IN R_ ==> (x *_ y = y *_ x)  by ring_mult_monoid
5389       Thus Monoid (homo_image f r.prod r_.prod)                                    by homo_image_monoid
5390       And  !x' x''. x' IN R /\ x'' IN R ==> f x' *_ f x'' = f x'' *_ f x'          by commutative properties
5391       Hence AbelianMonoid (homo_image f r.prod r_.prod)                            by AbelianMonoid_def
5392   (3) (homo_image f r.sum r_.sum).carrier = IMAGE f R
5393       True by ring_add_group, homo_image_def.
5394   (4) (homo_image f r.prod r_.prod).carrier = IMAGE f R
5395       True by ring_mult_monoid, homo_image_def
5396   (5) x IN IMAGE f R /\ y IN IMAGE f R /\ z IN IMAGE f R ==> x *_ (y +_ z) = x *_ y +_ x *_ z
5397       By IN_IMAGE, there are a IN R with f a = x, hence x = f a IN R_
5398                              b IN R with f b = y, hence y = f b IN R_
5399                          and c IN R with f c = z, hence z = f c IN R_
5400       Hence true by ring_mult_radd.
5401*)
5402Theorem ring_homo_image_ring:
5403    !(r:'a ring) (r_:'b ring). !f. (r ~r~ r_) f ==> Ring (ring_homo_image f r r_)
5404Proof
5405  rw_tac std_ss[RingHomo_def] >>
5406  `!x. x IN IMAGE f R ==> ?a. a IN R /\ (f a = x)` by metis_tac[IN_IMAGE] >>
5407  rw_tac std_ss[ring_homo_image_def, Ring_def] >| [
5408    `Group r.sum /\ !x y. x IN R /\ y IN R ==> (x + y = y + x)` by rw[ring_add_group] >>
5409    `Group r_.sum /\ !x y. x IN R_ /\ y IN R_ ==> (x +_ y = y +_ x)` by rw[ring_add_group] >>
5410    `Group (homo_image f r.sum r_.sum)` by rw[homo_image_group] >>
5411    rw[AbelianGroup_def, homo_image_def] >>
5412    metis_tac[],
5413    `Monoid r.prod /\ !x y. x IN R /\ y IN R ==> (x * y = y * x)` by rw[ring_mult_monoid] >>
5414    `Monoid r_.prod /\ !x y. x IN R_ /\ y IN R_ ==> (x *_ y = y *_ x)` by rw[ring_mult_monoid] >>
5415    `Monoid (homo_image f r.prod r_.prod)` by rw[homo_image_monoid] >>
5416    rw[AbelianMonoid_def, homo_image_def] >>
5417    metis_tac[],
5418    rw[homo_image_def],
5419    rw[homo_image_def],
5420    rw[homo_image_def] >>
5421    `x IN R_ /\ y IN R_ /\ z IN R_` by metis_tac[] >>
5422    rw[]
5423  ]
5424QED
5425
5426(* Theorem: (r ~r~ r_) f ==> !s. Ring s /\ subring s r ==> subring (ring_homo_image f s r_) r_ *)
5427(* Proof:
5428   Note RingHomo I s r               by subring_def
5429   By RingHomo_def, this is to show:
5430   (1) x IN (ring_homo_image f s r_).carrier ==> x IN R_
5431           x IN (ring_homo_image f s r_).carrier
5432       ==> x IN IMAGE f B            by ring_homo_image_def
5433       ==> ?y. y IN B /\ (f y = x)   by IN_IMAGE
5434       ==> ?y. y IN R /\ (f y = x)   by RingHomo_def, RingHomo I s r
5435       ==> x IN IMAGE f R            by IN_IMAGE
5436       ==> x IN R_                   by notation
5437   (2) GroupHomo I (ring_homo_image f s r_).sum r_.sum
5438       By GroupHomo_def, ring_homo_image_def, homo_image_def, this is to show:
5439          y IN B ==> f y IN R_, true by RingHomo_def
5440   (3) MonoidHomo I (ring_homo_image f s r_).prod r_.prod
5441       By MonoidHomo_def, ring_homo_image_def, homo_image_def, this is to show:
5442          y IN B ==> f y IN R_, true by RingHomo_def
5443*)
5444Theorem ring_homo_image_subring_subring:
5445    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==>
5446   !s. Ring s /\ subring s r ==> subring (ring_homo_image f s r_) r_
5447Proof
5448  rw[subring_def] >>
5449  rw_tac std_ss[RingHomo_def] >| [
5450    fs[ring_homo_image_def] >>
5451    metis_tac[RingHomo_def, combinTheory.I_THM],
5452    rw[GroupHomo_def, ring_homo_image_def, homo_image_def] >>
5453    metis_tac[RingHomo_def, combinTheory.I_THM],
5454    rw[MonoidHomo_def, ring_homo_image_def, homo_image_def] >>
5455    metis_tac[RingHomo_def, combinTheory.I_THM]
5456  ]
5457QED
5458
5459(* Theorem: (r ~r~ r_) f ==> subring (ring_homo_image f r r_) r_ *)
5460(* Proof:
5461   Note subring r r                           by subring_refl
5462   Thus subring (ring_homo_image f r r_) r_   by ring_homo_image_subring_subring
5463*)
5464Theorem ring_homo_image_is_subring:
5465    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> subring (ring_homo_image f r r_) r_
5466Proof
5467  metis_tac[ring_homo_image_subring_subring, subring_refl]
5468QED
5469
5470(* Theorem: (r ~r~ r_) f ==> (ring_homo_image f r r_) <= r_ *)
5471(* Proof: by ring_homo_image_ring, ring_homo_image_is_subring  *)
5472Theorem ring_homo_image_subring:
5473    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> (ring_homo_image f r r_) <= r_
5474Proof
5475  rw_tac std_ss[ring_homo_image_ring, ring_homo_image_is_subring]
5476QED
5477
5478(* Theorem: (r ~r~ r_) f ==> RingHomo f r (ring_homo_image f r r_) *)
5479(* Proof:
5480   By RingHomo_def, this is to show:
5481   (1) x IN R ==> f x IN (ring_homo_image f r r_).carrier
5482       True by ring_homo_image_def.
5483   (2) GroupHomo f r.sum (ring_homo_image f r r_).sum
5484       Expanding by definitions, this is to show: f (x + y) = f x +_ f y
5485       True by ring_homo_property.
5486   (3) MonoidHomo f r.prod (ring_homo_image f r r_).prod
5487       Expanding by definitions, this is to show: f (x * y) = f x *_ f y
5488       True by ring_homo_property.
5489*)
5490Theorem ring_homo_image_homo:
5491    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> RingHomo f r (ring_homo_image f r r_)
5492Proof
5493  rpt strip_tac >>
5494  rw_tac std_ss[RingHomo_def] >-
5495  rw[ring_homo_image_def] >-
5496  rw[GroupHomo_def, ring_homo_image_def, homo_image_def, ring_homo_property] >>
5497  rw[MonoidHomo_def, ring_homo_image_def, homo_image_def, ring_homo_property]
5498QED
5499
5500(* Theorem: (r ~r~ r_) f /\ INJ f R R_ ==> BIJ f R (ring_homo_image f r r_).carrier *)
5501(* Proof:
5502   Since (ring_homo_image f r r_).carrier = IMAGE f R     by ring_homo_image_def
5503   Hence true given INJ f R R_                            by INJ_IMAGE_BIJ
5504*)
5505Theorem ring_homo_image_bij:
5506    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f /\ INJ f R R_ ==> BIJ f R (ring_homo_image f r r_).carrier
5507Proof
5508  rpt strip_tac >>
5509  `(ring_homo_image f r r_).carrier = IMAGE f R` by rw[ring_homo_image_def] >>
5510  metis_tac[INJ_IMAGE_BIJ]
5511QED
5512
5513(* Theorem: (r ~r~ r_) f /\ INJ f R R_ ==> RingIso f r (ring_homo_image f r r_) *)
5514(* Proof:
5515   By RingIso_def, this is to show:
5516   (1) RingHomo f r r_ ==> RingHomo f r (ring_homo_image f r s), true by ring_homo_image_homo
5517   (2) RingHomo f r r_ /\ INJ f R R_ ==>
5518       BIJ f R (ring_homo_image f r r_).carrier, true by ring_homo_image_bij.
5519*)
5520Theorem ring_homo_image_iso:
5521    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f /\ INJ f R R_ ==> RingIso f r (ring_homo_image f r r_)
5522Proof
5523  rw[RingIso_def, ring_homo_image_homo, ring_homo_image_bij]
5524QED
5525
5526(* This turns RingHomo to RingIso, for the same function. *)
5527
5528(* Theorem: Ring r /\ Ring r_ /\ SURJ f R R_ ==> RingIso I r_ (ring_homo_image f r r_) *)
5529(* Proof:
5530   By RingIso_def, this is to show:
5531   (1) RingHomo I r_ (ring_homo_image f r r_)
5532       After expanding by definitions and ring_carriers,
5533       the goal is: SURJ f R R_ /\ x IN R_ ==> x IN IMAGE f R
5534       This is true by SURJ_DEF, IN_IMAGE.
5535   (2) SURJ f R R_ ==> BIJ I R_ (ring_homo_image f r r_).carrier
5536       After expanding by definitions and ring_carriers, this is to show:
5537       (1) SURJ f R R_ ==> INJ I R_ (IMAGE f R)
5538           By INJ_DEF, this is true by SURJ_DEF, IN_IMAGE.
5539       (2) SURJ f R R_ ==> SURJ I R_ (IMAGE f R)
5540           By SURJ_DEF, this is true by SURJ_DEF, IN_IMAGE.
5541*)
5542Theorem ring_homo_image_surj_property:
5543    !(r:'a ring) (r_:'b ring) f. Ring r /\ Ring r_ /\ SURJ f R R_ ==> RingIso I r_ (ring_homo_image f r r_)
5544Proof
5545  rw_tac std_ss[RingIso_def] >| [
5546    rw_tac std_ss[RingHomo_def, GroupHomo_def, MonoidHomo_def, ring_homo_image_def, homo_image_def, ring_carriers] >>
5547    metis_tac[SURJ_DEF, IN_IMAGE],
5548    rw_tac std_ss[BIJ_DEF, ring_homo_image_def, homo_image_def, ring_carriers] >| [
5549      rw_tac std_ss[INJ_DEF] >>
5550      metis_tac[SURJ_DEF, IN_IMAGE],
5551      rewrite_tac[SURJ_DEF, combinTheory.I_THM] >>
5552      metis_tac[SURJ_DEF, IN_IMAGE]
5553    ]
5554  ]
5555QED
5556
5557(* Theorem: (r ~r~ r_) f /\ s <= r ==> (s ~r~ (ring_homo_image f s r_)) f *)
5558(* Proof:
5559   Note RingHomo f s r_                              by subring_homo_homo
5560   This is to show:
5561   (1) Ring (ring_homo_image f s r_), true           by ring_homo_image_ring
5562   (2) RingHomo f s (ring_homo_image f s r_), true   by ring_homo_image_homo
5563*)
5564Theorem ring_homo_subring_homo:
5565    !(r:'a ring) (s:'a ring) (r_:'b ring) f. (r ~r~ r_) f /\ s <= r ==> (s ~r~ (ring_homo_image f s r_)) f
5566Proof
5567  ntac 5 strip_tac >>
5568  `RingHomo f s r_` by metis_tac[subring_homo_homo] >>
5569  rw_tac std_ss[] >-
5570  rw[ring_homo_image_ring] >>
5571  rw[ring_homo_image_homo]
5572QED
5573
5574(* Theorem: (r =r= r_) f /\ s <= r ==> (s =r= (ring_homo_image f s r_)) f *)
5575(* Proof:
5576   Note RingHomo f r r_ /\ INJ f R R_    by RingIso_def
5577    ==> RingHomo f s r_                  by subring_homo_homo
5578   This is to show:
5579   (1) Ring (ring_homo_image f s r_), true  by ring_homo_image_ring
5580   (2) RingIso f s (ring_homo_image f s r_)
5581       Note INJ f R R_                             by BIJ_DEF
5582        ==> INJ f B R_                             by INJ_SUBSET, subring_carrier_subset, SUBSET_REFL
5583       Thus RingIso f s (ring_homo_image f s r_)   by ring_homo_image_iso
5584*)
5585Theorem ring_iso_subring_iso:
5586    !(r:'a ring) (s:'a ring) (r_:'b ring) f. (r =r= r_) f /\ s <= r ==> (s =r= (ring_homo_image f s r_)) f
5587Proof
5588  ntac 5 strip_tac >>
5589  `RingHomo f r r_ /\ BIJ f R R_` by metis_tac[RingIso_def] >>
5590  `RingHomo f s r_` by metis_tac[subring_homo_homo] >>
5591  rw_tac std_ss[] >-
5592  rw[ring_homo_image_ring] >>
5593  `INJ f B R_` by metis_tac[BIJ_DEF, INJ_SUBSET, subring_carrier_subset, SUBSET_REFL] >>
5594  rw[ring_homo_image_iso]
5595QED
5596
5597(* Theorem alias *)
5598Theorem ring_homo_ring_homo_subring = ring_homo_image_is_subring;
5599(*
5600val ring_homo_ring_homo_subring = |- !r r_ f. (r ~r~ r_) f ==> subring (ring_homo_image f r r_) r_: thm
5601*)
5602
5603(* Theorem: (r =r= r_) f ==> subring (ring_homo_image f r r_) r_ *)
5604(* Proof:
5605   Note RingIso f r r_ ==> RingHomo f r r_   by RingIso_def
5606   Thus subring (ring_homo_image f r r_) r_  by ring_homo_ring_homo_subring
5607*)
5608Theorem ring_iso_ring_homo_subring:
5609    !(r:'a ring) (r_:'b ring) f. (r =r= r_) f ==> subring (ring_homo_image f r r_) r_
5610Proof
5611  rw_tac std_ss[ring_homo_ring_homo_subring, RingIso_def]
5612QED
5613
5614(* Theorem: s <= r /\ (r =r= r_) f ==> (ring_homo_image f s r_) <= r_ *)
5615(* Proof:
5616   Note RingHomo f s r_                    by subring_ring_iso_compose
5617   Thus (s ~r~ r_) f                       by notation, Ring s
5618    ==> (ring_homo_image f s r_) <= r_     by ring_homo_image_subring
5619*)
5620Theorem subring_ring_iso_ring_homo_subring:
5621    !(r:'a ring) (s:'a ring) (r_:'b ring) f. s <= r /\ (r =r= r_) f ==> (ring_homo_image f s r_) <= r_
5622Proof
5623  metis_tac[ring_homo_image_subring, subring_ring_iso_compose]
5624QED
5625
5626(* ------------------------------------------------------------------------- *)
5627(* Injective Image of Ring.                                                  *)
5628(* ------------------------------------------------------------------------- *)
5629
5630(* Idea: Given a Ring r, and an injective function f,
5631   then the image (f R) is a Ring, with an induced binary operator:
5632        op := (\x y. f (f^-1 x * f^-1 y))  *)
5633
5634(* Define a ring injective image for an injective f, with LINV f R. *)
5635Definition ring_inj_image_def:
5636   ring_inj_image (r:'a ring) (f:'a -> 'b) =
5637       <| carrier := IMAGE f R;
5638              sum := <| carrier := IMAGE f R; op := (\x y. f ((LINV f R x) + LINV f R y)); id := f #0 |>;
5639             prod := <| carrier := IMAGE f R; op := (\x y. f ((LINV f R x) * LINV f R y)); id := f #1 |>
5640        |>
5641End
5642
5643(* Theorem: (ring_inj_image r f).carrier = IMAGE f R *)
5644(* Proof: by ring_inj_image_def *)
5645Theorem ring_inj_image_carrier:
5646  !(r:'a ring) f. (ring_inj_image r f).carrier = IMAGE f R
5647Proof
5648  simp[ring_inj_image_def]
5649QED
5650
5651val ring_component_equality = DB.fetch "-" "ring_component_equality";
5652
5653(* Alternative definitaion the image of ring injection, so that LINV f R makes sense. *)
5654
5655(* Theorem: equivalent definition of ring_inj_image r f. *)
5656(* Proof:
5657   By ring_inj_image_def, monoid_inj_image_def, and component_equality of types,
5658   this is to show:
5659   (1) IMAGE f R = IMAGE f r.sum.carrier, true         by ring_carriers
5660   (2) (\x y. f (LINV f r.sum.carrier x + LINV f r.sum.carrier y)) =
5661       (\x y. f (LINV f R x + LINV f R y)), true       by ring_carriers
5662   (3) IMAGE f R = IMAGE f r.prod.carrier, true        by ring_carriers
5663   (4) (\x y. f (LINV f r.prod.carrier x * LINV f r.prod.carrier y)) =
5664       (\x y. f (LINV f R x * LINV f R y)), true       by ring_carriers
5665*)
5666Theorem ring_inj_image_alt:
5667  !(r:'a ring) (f:'a -> 'b).  Ring r ==>
5668     ring_inj_image r f = <| carrier := IMAGE f R;
5669                                 sum := monoid_inj_image r.sum f;
5670                                prod := monoid_inj_image r.prod f
5671                           |>
5672Proof
5673  simp[ring_inj_image_def, monoid_inj_image_def, ring_component_equality,
5674       monoid_component_equality]
5675QED
5676
5677(* Theorem: Ring r /\ INJ f R univ(:'b) ==> Ring (ring_inj_image r f) *)
5678(* Proof:
5679   By Ring_def and ring_inj_image_alt, this is to show:
5680   (1) AbelianGroup (monoid_inj_image r.sum f)
5681           Ring r
5682       ==> AbelianGroup (r.sum)                        by ring_add_abelian_group
5683       ==> AbelianGroup (monoid_inj_image r.sum f)     by group_inj_image_abelian_group
5684   (2) AbelianMonoid (monoid_inj_image r.prod f)
5685           Ring r
5686       ==> AbelianMonoid (r.prod)                      by ring_mult_abelian_monoid
5687       ==> AbelianMonoid (monoid_inj_image r.prod f)   by monoid_inj_image_abelian_monoid
5688   (3) (monoid_inj_image r.sum f).carrier = IMAGE f R
5689         (monoid_inj_image r.sum f).carrier
5690       = IMAGE f r.sum.carrier                         by monoid_inj_image_def
5691       = IMAGE f R                                     by ring_carriers
5692   (4) (monoid_inj_image r.prod f).carrier = IMAGE f R
5693         (monoid_inj_image r.prod f).carrier
5694       = IMAGE f r.prod.carrier                        by monoid_inj_image_def
5695       = IMAGE f R                                     by ring_carriers
5696   (5) x IN IMAGE f R /\ y IN IMAGE f R /\ z IN IMAGE f R ==>
5697       f (t x * t (f (t y + t z))) = f (t (f (t x * t y)) + t (f (t x * t z)))
5698       by monoid_inj_image_def, ring_carriers, where t = LINV f R.
5699       Note INJ f R univ(:'b) ==> BIJ f R (IMAGE f R)  by INJ_IMAGE_BIJ_ALT
5700         so !x. x IN R ==> t (f x) = x
5701        and !x. x IN (IMAGE f R) ==> f (t x) = x       by BIJ_LINV_THM
5702       Note ?a. (x = f a) /\ a IN R                    by IN_IMAGE
5703            ?b. (y = f b) /\ b IN R                    by IN_IMAGE
5704            ?c. (z = f c) /\ c IN R                    by IN_IMAGE
5705       LHS = f (t x * t (f (t y + t z)))
5706           = f (t (f a) * t (f (t (f b) + t (f c))))   by x = f a, y = f b, z = f c
5707           = f (a * t (f (b + c)))                     by !y. t (f y) = y
5708           = f (a * (b + c))                           by !y. t (f y) = y, ring_add_element
5709       RHS = f (t (f (t x * t y)) + t (f (t x * t z)))
5710           = f (t (f (t (f a) * t (f b))) + t (f (t (f a) * t (f b))))   by x = f a, y = f b, z = f c
5711           = f (t (f (a * b)) + t (f (a * b)))         by !y. t (f y) = y
5712           = f (a * b + a * c)                         by !y. t (f y) = y, ring_mult_element
5713           = f (a * (b + c))                           by ring_mult_ladd
5714           = LHS
5715*)
5716Theorem ring_inj_image_ring:
5717  !(r:'a ring) (f:'a -> 'b).
5718    Ring r /\ INJ f R univ(:'b) ==> Ring (ring_inj_image r f)
5719Proof
5720  rpt strip_tac >>
5721  rw_tac std_ss[Ring_def, ring_inj_image_alt] >-
5722  rw[ring_add_abelian_group, group_inj_image_abelian_group] >-
5723  rw[ring_mult_abelian_monoid, monoid_inj_image_abelian_monoid] >-
5724  rw[monoid_inj_image_def] >-
5725  rw[monoid_inj_image_def] >>
5726  rw_tac std_ss[monoid_inj_image_def, ring_carriers] >>
5727  pop_assum mp_tac >>
5728  pop_assum mp_tac >>
5729  pop_assum mp_tac >>
5730  pop_assum mp_tac >>
5731  `BIJ f R (IMAGE f R)` by rw[INJ_IMAGE_BIJ_ALT] >>
5732  imp_res_tac BIJ_LINV_THM >>
5733  rpt strip_tac >>
5734  `?a. (x = f a) /\ a IN R` by rw[GSYM IN_IMAGE] >>
5735  `?b. (y = f b) /\ b IN R` by rw[GSYM IN_IMAGE] >>
5736  `?c. (z = f c) /\ c IN R` by rw[GSYM IN_IMAGE] >>
5737  rw[ring_mult_ladd, Abbr`t`]
5738QED
5739
5740(* The following will be applied to finite fields, for existence and extension. *)
5741
5742(* Theorem: Ring r /\ INJ f R univ(:'b) ==> Monoid (ring_inj_image r f).sum *)
5743(* Proof:
5744   Let s = IMAGE f R.
5745   Then BIJ f R s                              by INJ_IMAGE_BIJ_ALT
5746     so INJ f R s                              by BIJ_DEF
5747   Note !x. x IN R ==> f x IN s                by INJ_DEF
5748    and !x. x IN s ==> LINV f R x IN R         by BIJ_LINV_ELEMENT
5749   also !x. x IN R ==> (LINV f R (f x) = x)    by BIJ_LINV_THM
5750    and !x. x IN s ==> (f (LINV f R x) = x)    by BIJ_LINV_THM
5751
5752   Let xx = LINV f R x, yy = LINV f R y, zz = LINV f R z.
5753   By Monoid_def, ring_inj_image_def, this is to show:
5754   (1) x IN s /\ y IN s ==> f (xx + yy) IN s, true by ring_add_element
5755   (2) x IN s /\ y IN s /\ z IN s ==> f (LINV f R (f (xx + yy)) + zz) = f (xx + LINV f R (f (yy + zz)))
5756       Since LINV f R (f (xx + yy)) = xx + yy  by ring_add_element
5757         and LINV f R (f (yy + zz)) = yy + zz  by ring_add_element
5758       The result follows                      by ring_add_assoc
5759   (3) f #0 IN s, true                         by ring_zero_element
5760   (4) x IN s ==> f (LINV f R (f #0) + xx) = x
5761       Since LINV f R (f #0) = #0              by ring_zero_element
5762       f (#0 + xx) = f xx = x                  by ring_add_lzero
5763   (5) x IN s ==> f (xx + LINV f R (f #0)) = x
5764       Since LINV f R (f #0) = #0              by ring_zero_element
5765       f (xx + #0) = f xx = x                  by ring_add_rzero
5766*)
5767Theorem ring_inj_image_sum_monoid:
5768  !(r:'a ring) f. Ring r /\ INJ f R univ(:'b) ==> Monoid (ring_inj_image r f).sum
5769Proof
5770  rpt strip_tac >>
5771  qabbrev_tac `s = IMAGE f R` >>
5772  `BIJ f R s` by rw[INJ_IMAGE_BIJ_ALT, Abbr`s`] >>
5773  `INJ f R s` by metis_tac[BIJ_DEF] >>
5774  `!x. x IN R ==> f x IN s` by metis_tac[INJ_DEF] >>
5775  `!x. x IN s ==> LINV f R x IN R` by metis_tac[BIJ_LINV_ELEMENT] >>
5776  `!x. x IN R ==> (LINV f R (f x) = x)` by metis_tac[BIJ_LINV_THM] >>
5777  `!x. x IN s ==> (f (LINV f R x) = x)` by metis_tac[BIJ_LINV_THM] >>
5778  rw_tac std_ss[Monoid_def, ring_inj_image_def] >-
5779  rw[] >-
5780 (qabbrev_tac `xx = LINV f R x` >>
5781  qabbrev_tac `yy = LINV f R y` >>
5782  qabbrev_tac `zz = LINV f R z` >>
5783  `LINV f R (f (xx + yy)) = xx + yy` by metis_tac[ring_add_element] >>
5784  `LINV f R (f (yy + zz)) = yy + zz` by metis_tac[ring_add_element] >>
5785  rw[ring_add_assoc, Abbr`xx`, Abbr`yy`, Abbr`zz`]) >-
5786  rw[] >-
5787  rw[] >>
5788  rw[]
5789QED
5790
5791(* Theorem: Ring r /\ INJ f R univ(:'b) ==> Group (ring_inj_image r f).sum *)
5792(* Proof:
5793   By Group_def, this is to show:
5794   (1) Monoid (ring_inj_image r f).sum, true     by ring_inj_image_sum_monoid
5795   (2) monoid_invertibles (ring_inj_image r f).sum = (ring_inj_image r f).sum.carrier
5796      Let xx = LINV f R x.
5797       By ring_inj_image_def, monoid_invertibles_def, this is to show:
5798       x IN IMAGE f R ==> ?y. y IN IMAGE f R /\ (f (xx + LINV f R y) = f #0) /\ (f (LINV f R y + xx) = f #0)
5799       Let s = IMAGE f R.
5800       Then BIJ f R s                            by INJ_IMAGE_BIJ_ALT
5801         so INJ f R s                            by BIJ_DEF
5802       Note !x. x IN R ==> f x IN s              by INJ_DEF
5803        and !x. x IN s ==> LINV f R x IN R       by BIJ_LINV_ELEMENT
5804       also !x. x IN R ==> (LINV f R (f x) = x)  by BIJ_LINV_THM
5805        and !x. x IN s ==> (f (LINV f R x) = x)  by BIJ_LINV_THM
5806      Since -xx IN R                             by ring_neg_element
5807       Take y = f (-xx).
5808       Then y = f (-xx) IN s                     by above
5809        and LINV f R y = LINV f R (-xx) = -xx    by above
5810       Also f (xx + -xx) = f #0                  by ring_add_rneg
5811        and f (-xx + xx) = f #0                  by ring_add_lneg
5812*)
5813Theorem ring_inj_image_sum_group:
5814  !(r:'a ring) f. Ring r /\ INJ f R univ(:'b) ==> Group (ring_inj_image r f).sum
5815Proof
5816  rw[Group_def] >-
5817  rw[ring_inj_image_sum_monoid] >>
5818  rw_tac std_ss[ring_inj_image_def, monoid_invertibles_def, GSPECIFICATION, EXTENSION, EQ_IMP_THM] >>
5819  qabbrev_tac `s = IMAGE f R` >>
5820  `BIJ f R s` by rw[INJ_IMAGE_BIJ_ALT, Abbr`s`] >>
5821  `INJ f R s` by metis_tac[BIJ_DEF] >>
5822  `!x. x IN R ==> f x IN s` by metis_tac[INJ_DEF] >>
5823  `!x. x IN s ==> LINV f R x IN R` by metis_tac[BIJ_LINV_ELEMENT] >>
5824  `!x. x IN R ==> (LINV f R (f x) = x)` by metis_tac[BIJ_LINV_THM] >>
5825  `!x. x IN s ==> (f (LINV f R x) = x)` by metis_tac[BIJ_LINV_THM] >>
5826  qabbrev_tac `xx = LINV f R x` >>
5827  `-xx IN R` by rw[Abbr`xx`] >>
5828  metis_tac[ring_add_lneg, ring_add_rneg, ring_zero_element]
5829QED
5830
5831(* Theorem: Ring r /\ INJ f R univ(:'b) ==> AbelianGroup (ring_inj_image r f).sum *)
5832(* Proof:
5833   By AbelianGroup_def, this is to show:
5834   (1) Group (ring_inj_image r f).sum, true      by ring_inj_image_sum_group
5835   (2) x' IN R /\ x'' IN R ==>
5836       f (LINV f R (f x') + LINV f R (f x'')) = f (LINV f R (f x'') + LINV f R (f x'))
5837       Let s = IMAGE f R.
5838       Then BIJ f R s                            by INJ_IMAGE_BIJ_ALT
5839         so INJ f R s                            by BIJ_DEF
5840       Note !x. x IN R ==> f x IN s              by INJ_DEF
5841        and !x. x IN s ==> LINV f R x IN R       by BIJ_LINV_ELEMENT
5842       also !x. x IN R ==> (LINV f R (f x) = x)  by BIJ_LINV_THM
5843        and !x. x IN s ==> (f (LINV f R x) = x)  by BIJ_LINV_THM
5844       The result follows                        by ring_add_comm
5845*)
5846Theorem ring_inj_image_sum_abelian_group:
5847  !(r:'a ring) f. Ring r /\ INJ f R univ(:'b) ==> AbelianGroup (ring_inj_image r f).sum
5848Proof
5849  rw[AbelianGroup_def] >-
5850  rw[ring_inj_image_sum_group] >>
5851  pop_assum mp_tac >>
5852  pop_assum mp_tac >>
5853  rw[ring_inj_image_def] >>
5854  qabbrev_tac `s = IMAGE f R` >>
5855  `BIJ f R s` by rw[INJ_IMAGE_BIJ_ALT, Abbr`s`] >>
5856  `INJ f R s` by metis_tac[BIJ_DEF] >>
5857  `!x. x IN R ==> f x IN s` by metis_tac[INJ_DEF] >>
5858  `!x. x IN s ==> LINV f R x IN R` by metis_tac[BIJ_LINV_ELEMENT] >>
5859  `!x. x IN R ==> (LINV f R (f x) = x)` by metis_tac[BIJ_LINV_THM] >>
5860  `!x. x IN s ==> (f (LINV f R x) = x)` by metis_tac[BIJ_LINV_THM] >>
5861  rw[ring_add_comm]
5862QED
5863
5864(* Theorem: Ring r /\ INJ f R univ(:'b) ==> Monoid (ring_inj_image r f).prod *)
5865(* Proof:
5866   Let s = IMAGE f R.
5867   Then BIJ f R s                              by INJ_IMAGE_BIJ_ALT
5868     so INJ f R s                              by BIJ_DEF
5869   Note !x. x IN R ==> f x IN s                by INJ_DEF
5870    and !x. x IN s ==> LINV f R x IN R         by BIJ_LINV_ELEMENT
5871   also !x. x IN R ==> (LINV f R (f x) = x)    by BIJ_LINV_THM
5872    and !x. x IN s ==> (f (LINV f R x) = x)    by BIJ_LINV_THM
5873
5874   Let xx = LINV f R x, yy = LINV f R y, zz = LINV f R z.
5875   By Monoid_def, ring_inj_image_def, this is to show:
5876   (1) x IN s /\ y IN s ==> f (xx * yy) IN s, true by ring_mult_element
5877   (2) x IN s /\ y IN s /\ z IN s ==> f (LINV f R (f (xx * yy)) * zz) = f (xx * LINV f R (f (yy * zz)))
5878       Since LINV f R (f (xx * yy)) = xx * yy  by ring_mult_element
5879         and LINV f R (f (yy * zz)) = yy * zz  by ring_mult_element
5880       The result follows                      by ring_mult_assoc
5881   (3) f #1 IN s, true                         by ring_one_element
5882   (4) x IN s ==> f (LINV f R (f #1) * xx) = x
5883       Since LINV f R (f #1) = #1              by ring_one_element
5884       f (#1 * xx) = f xx = x                  by ring_mult_lone
5885   (5) x IN s ==> f (xx * LINV f R (f #1)) = x
5886       Since LINV f R (f #1) = #1              by ring_one_element
5887       f (xx * #1) = f xx = x                  by ring_mult_rone
5888*)
5889Theorem ring_inj_image_prod_monoid:
5890  !(r:'a ring) f. Ring r /\ INJ f R univ(:'b) ==> Monoid (ring_inj_image r f).prod
5891Proof
5892  rpt strip_tac >>
5893  qabbrev_tac `s = IMAGE f R` >>
5894  `BIJ f R s` by rw[INJ_IMAGE_BIJ_ALT, Abbr`s`] >>
5895  `INJ f R s` by metis_tac[BIJ_DEF] >>
5896  `!x. x IN R ==> f x IN s` by metis_tac[INJ_DEF] >>
5897  `!x. x IN s ==> LINV f R x IN R` by metis_tac[BIJ_LINV_ELEMENT] >>
5898  `!x. x IN R ==> (LINV f R (f x) = x)` by metis_tac[BIJ_LINV_THM] >>
5899  `!x. x IN s ==> (f (LINV f R x) = x)` by metis_tac[BIJ_LINV_THM] >>
5900  rw_tac std_ss[Monoid_def, ring_inj_image_def] >-
5901  rw[] >-
5902 (qabbrev_tac `xx = LINV f R x` >>
5903  qabbrev_tac `yy = LINV f R y` >>
5904  qabbrev_tac `zz = LINV f R z` >>
5905  `LINV f R (f (xx * yy)) = xx * yy` by metis_tac[ring_mult_element] >>
5906  `LINV f R (f (yy * zz)) = yy * zz` by metis_tac[ring_mult_element] >>
5907  rw[ring_mult_assoc, Abbr`xx`, Abbr`yy`, Abbr`zz`]) >-
5908  rw[] >-
5909  rw[] >>
5910  rw[]
5911QED
5912
5913(* Theorem: Ring r /\ INJ f R univ(:'b) ==> AbelianMonoid (ring_inj_image r f).prod *)
5914(* Proof:
5915   By AbelianMonoid_def, this is to show:
5916   (1) Monoid (ring_inj_image r f).prod, true    by ring_inj_image_prod_monoid
5917   (2) x' IN R /\ x'' IN R ==>
5918       f (LINV f R (f x') * LINV f R (f x'')) = f (LINV f R (f x'') * LINV f R (f x'))
5919       Let s = IMAGE f R.
5920       Then BIJ f R s                            by INJ_IMAGE_BIJ_ALT
5921         so INJ f R s                            by BIJ_DEF
5922       Note !x. x IN R ==> f x IN s              by INJ_DEF
5923        and !x. x IN s ==> LINV f R x IN R       by BIJ_LINV_ELEMENT
5924       also !x. x IN R ==> (LINV f R (f x) = x)  by BIJ_LINV_THM
5925        and !x. x IN s ==> (f (LINV f R x) = x)  by BIJ_LINV_THM
5926       The result follows                        by ring_mult_comm
5927*)
5928Theorem ring_inj_image_prod_abelian_monoid:
5929  !(r:'a ring) f. Ring r /\ INJ f R univ(:'b) ==> AbelianMonoid (ring_inj_image r f).prod
5930Proof
5931  rw[AbelianMonoid_def] >-
5932  rw[ring_inj_image_prod_monoid] >>
5933  pop_assum mp_tac >>
5934  pop_assum mp_tac >>
5935  rw[ring_inj_image_def] >>
5936  qabbrev_tac `s = IMAGE f R` >>
5937  `BIJ f R s` by rw[INJ_IMAGE_BIJ_ALT, Abbr`s`] >>
5938  `INJ f R s` by metis_tac[BIJ_DEF] >>
5939  `!x. x IN R ==> f x IN s` by metis_tac[INJ_DEF] >>
5940  `!x. x IN s ==> LINV f R x IN R` by metis_tac[BIJ_LINV_ELEMENT] >>
5941  `!x. x IN R ==> (LINV f R (f x) = x)` by metis_tac[BIJ_LINV_THM] >>
5942  `!x. x IN s ==> (f (LINV f R x) = x)` by metis_tac[BIJ_LINV_THM] >>
5943  rw[ring_mult_comm]
5944QED
5945
5946(* Theorem: Ring r /\ INJ f R univ(:'b) ==> GroupHomo f r.sum (ring_inj_image r f).sum *)
5947(* Proof:
5948   Note R = r.prod.carrier                     by ring_carriers
5949   Let s = IMAGE f R.
5950   Then BIJ f R s                              by INJ_IMAGE_BIJ_ALT
5951     so INJ f R s                              by BIJ_DEF
5952
5953   By GroupHomo_def, ring_inj_image_def, this is to show:
5954   (1) x IN R ==> f x IN IMAGE f R, true       by IN_IMAGE
5955   (2) x IN R /\ y IN R ==> f (x + y) = f (LINV f R (f x) + LINV f R (f y))
5956       Since LINV f R (f x) = x                by BIJ_LINV_THM
5957         and LINV f R (f y) = y                by BIJ_LINV_THM
5958       The result is true.
5959*)
5960Theorem ring_inj_image_sum_group_homo:
5961  !(r:'a ring) f. Ring r /\ INJ f R univ(:'b) ==> GroupHomo f r.sum (ring_inj_image r f).sum
5962Proof
5963  rw[GroupHomo_def, ring_inj_image_def] >>
5964  qabbrev_tac `s = IMAGE f R` >>
5965  `BIJ f R s` by rw[INJ_IMAGE_BIJ_ALT, Abbr`s`] >>
5966  `INJ f R s` by metis_tac[BIJ_DEF] >>
5967  metis_tac[BIJ_LINV_THM]
5968QED
5969
5970(* Theorem: Ring r /\ INJ f R univ(:'b) ==> MonoidHomo f r.prod (ring_inj_image r f).prod *)
5971(* Proof:
5972   Note R = r.prod.carrier                     by ring_carriers
5973   Let s = IMAGE f R.
5974   Then BIJ f R s                              by INJ_IMAGE_BIJ_ALT
5975     so INJ f R s                              by BIJ_DEF
5976
5977   By MonoidHomo_def, ring_inj_image_def, this is to show:
5978   (1) x IN R ==> f x IN IMAGE f R, true       by IN_IMAGE
5979   (2) x IN R /\ y IN R ==> f (x * y) = f (LINV f R (f x) * LINV f R (f y))
5980       Since LINV f R (f x) = x                by BIJ_LINV_THM
5981         and LINV f R (f y) = y                by BIJ_LINV_THM
5982       The result is true.
5983*)
5984Theorem ring_inj_image_prod_monoid_homo:
5985  !(r:'a ring) f. Ring r /\ INJ f R univ(:'b) ==> MonoidHomo f r.prod (ring_inj_image r f).prod
5986Proof
5987  rw[MonoidHomo_def, ring_inj_image_def] >>
5988  qabbrev_tac `s = IMAGE f R` >>
5989  `BIJ f R s` by rw[INJ_IMAGE_BIJ_ALT, Abbr`s`] >>
5990  `INJ f R s` by metis_tac[BIJ_DEF] >>
5991  metis_tac[BIJ_LINV_THM]
5992QED
5993
5994(* Theorem: Ring r /\ INJ f R univ(:'b) ==> RingHomo f r (ring_inj_image r f) *)
5995(* Proof:
5996   By RingHomo_def, this is to show:
5997   (1) x IN R ==> f x IN (ring_inj_image r f).carrier
5998       Note (ring_inj_image r f).carrier = IMAGE f R       by ring_inj_image_carrier
5999       Thus f x IN IMAGE f R                               by INJ_DEF, IN_IMAGE
6000   (2) GroupHomo f r.sum (ring_inj_image r f).sum, true    by ring_inj_image_sum_group_homo
6001   (3) MonoidHomo f r.prod (ring_inj_image r f).prod, true by ring_inj_image_prod_monoid_homo
6002*)
6003Theorem ring_inj_image_ring_homo:
6004  !(r:'a ring) f. Ring r /\ INJ f R univ(:'b) ==> RingHomo f r (ring_inj_image r f)
6005Proof
6006  rw_tac std_ss[RingHomo_def] >-
6007  rw[ring_inj_image_carrier, INJ_DEF] >-
6008  rw[ring_inj_image_sum_group_homo] >>
6009  rw[ring_inj_image_prod_monoid_homo]
6010QED
6011
6012(* ------------------------------------------------------------------------- *)
6013(* Ideals in Ring Documentation                                              *)
6014(* ------------------------------------------------------------------------- *)
6015(* Overloads:
6016   I       = i.carrier
6017   J       = j.carrier
6018   i << r  = ideal i r
6019   x o I   = coset r.sum x i.carrier
6020   x * R   = coset r.prod x r.carrier
6021   x === y = ideal_congruence r i x y
6022   <p>     = principal_ideal r p
6023   <q>     = principal_ideal r q
6024   <#0>    = principal_ideal r #0
6025   i + j   = ideal_sum r i j
6026   maxi    = ideal_maximal r
6027   atom    = irreducible r
6028*)
6029(* Definitions and Theorems (# are exported):
6030
6031   Ring Ideals:
6032   ideal_def    |- !i r. i << r <=>
6033                    i.sum <= r.sum /\ (i.sum.carrier = I) /\
6034                    (i.prod.carrier = I) /\ (i.prod.op = $* ) /\ (i.prod.id = #1) /\
6035                    !x y. x IN I /\ y IN R ==> x * y IN I /\ y * x IN I
6036   ideal_has_subgroup      |- !r i. i << r ==> i.sum <= r.sum
6037   ideal_carriers          |- !r i. i << r ==> (i.sum.carrier = I) /\ (i.prod.carrier = I)
6038   ideal_product_property  |- !r i. i << r ==> !x y. x IN I /\ y IN R ==> x * y IN I /\ y * x IN I
6039   ideal_element           |- !r i. i << r ==> !x. x IN I ==> x IN r.sum.carrier
6040   ideal_ops               |- !r i. i << r ==> (i.sum.op = $+) /\ (i.prod.op = $* )
6041
6042   Ideal Theorems:
6043   ideal_element_property  |- !r i. Ring r /\ i << r ==> !x. x IN I ==> x IN R
6044   ideal_property          |- !r i. Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> x + y IN I /\ x * y IN I
6045   ideal_has_zero          |- !r i. Ring r /\ i << r ==> #0 IN I
6046   ideal_has_neg           |- !r i. Ring r /\ i << r ==> !x. x IN I ==> -x IN I
6047   ideal_has_sum           |- !r i. Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> x + y IN I
6048   ideal_has_diff          |- !r i. Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> x - y IN I
6049   ideal_has_product       |- !r i. Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> x * y IN I
6050   ideal_has_multiple      |- !r i. i << r ==> !x y. x IN I /\ y IN R ==> x * y IN I
6051   ideal_zero              |- !r i. Ring r /\ i << r ==> (i.sum.id = #0)
6052   ideal_eq_ideal          |- !r i j. Ring r /\ i << r /\ j << r ==> ((i = j) <=> (I = J))
6053   ideal_sub_ideal         |- !r i j. Ring r /\ i << r /\ j << r ==> (i << j <=> I SUBSET J)
6054   ideal_sub_itself        |- !r i. Ring r /\ i << r ==> i << i
6055   ideal_refl              |- !r. Ring r ==> r << r
6056   ideal_antisym           |- !r i. i << r /\ r << i ==> (i = r)
6057   ideal_has_one           |- !r i. Ring r /\ i << r /\ #1 IN I ==> (I = R)
6058   ideal_with_one          |- !r. Ring r ==> !i. i << r /\ #1 IN I <=> (i = r)
6059   ideal_with_unit         |- !r i. Ring r /\ i << r ==> !x. x IN I /\ unit x ==> (i = r)
6060
6061   Ideal Cosets:
6062   ideal_coset_of_element  |- !r i. Ring r /\ i << r ==> !x. x IN I ==> (x o I = I)
6063   ideal_coset_eq_carrier  |- !r i. Ring r /\ i << r ==> !x. x IN R /\ (x o I = I) <=> x IN I
6064   ideal_coset_eq          |- !r i. Ring r /\ i << r ==> !x y. x IN R /\ y IN R ==> ((x o I = y o I) <=> x - y IN I)
6065
6066   Ideal induces congruence in Ring:
6067#  ideal_congruence_def    |- !r i x y. x === y <=> x - y IN I
6068   ideal_congruence_refl   |- !r i. Ring r /\ i << r ==> !x. x IN R ==> x === x
6069   ideal_congruence_sym    |- !r i. Ring r /\ i << r ==> !x y. x IN R /\ y IN R ==> (x === y <=> y === x)
6070   ideal_congruence_trans  |- !r i. Ring r /\ i << r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> x === y /\ y === z ==> x === z
6071   ideal_congruence_equiv  |- !r i. Ring r /\ i << r ==> $=== equiv_on R
6072   ideal_congruence_iff_inCoset  |- !r i. Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> (x === y <=> inCoset r.sum i.sum x y)
6073   ideal_coset_eq_congruence     |- !r i. Ring r /\ i << r ==> !x y. x IN R /\ y IN R ==> ((x o I = y o I) <=> x === y)
6074   ideal_congruence_mult         |- !r i. Ring r /\ i << r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> x === y ==> z * x === z * y
6075   ideal_congruence_elements     |- !r i. Ring r /\ i << r ==> !x y. x IN I /\ y IN R ==> (y IN I <=> x === y)
6076
6077   Principal Ideal:
6078   principal_ideal_def      |- !r p.  <p> =  <|carrier := p * R;
6079                                                   sum := <|carrier := p * R; op := $+; id := #0|>;
6080                                                  prod := <|carrier := p * R; op := $*; id := #1|>
6081                                              |>
6082   principal_ideal_property |- !r p. (<p>.carrier = p * R) /\ (<p>.sum.carrier = p * R) /\
6083                                     (<p>.prod.carrier = p * R) /\ (<p>.sum.op = $+) /\
6084                                     (<p>.prod.op = $* ) /\ (<p>.sum.id = #0) /\ (<p>.prod.id = #1)
6085   principal_ideal_element              |- !p x. x IN <p>.carrier <=> ?z. z IN R /\ (x = p * z)
6086   principal_ideal_has_element          |- !r. Ring r ==> !p. p IN R ==> p IN <p>.carrier
6087   principal_ideal_group                |- !r. Ring r ==> !p. p IN R ==> Group <p>.sum
6088   principal_ideal_subgroup             |- !r. Ring r ==> !p. p IN R ==> <p>.sum <= r.sum
6089   principal_ideal_subgroup_normal      |- !r. Ring r ==> !p. p IN R ==> <p>.sum << r.sum
6090   principal_ideal_ideal                |- !r. Ring r ==> !p. p IN R ==> <p> << r
6091   principal_ideal_has_principal_ideal  |- !r. Ring r ==> !p q. p IN R /\ q IN <p>.carrier ==> <q> << <p>
6092   principal_ideal_eq_principal_ideal   |- !r. Ring r ==> !p q u. p IN R /\ q IN R /\ unit u /\ (p = q * u) ==> (<p> = <q>)
6093   ideal_has_principal_ideal            |- !r i. Ring r /\ i << r ==> !p. p IN R ==> (p IN I <=> <p> << i)
6094
6095   Trivial Ideal:
6096   zero_ideal_sing          |- !r. Ring r ==> (<#0>.carrier = {#0})
6097   zero_ideal_ideal         |- !r. Ring r ==> <#0> << r
6098   ideal_carrier_sing       |- !r i. Ring r /\ i << r ==> (SING I <=> (i = <#0>))
6099
6100   Sum of Ideals:
6101   ideal_sum_def            |- !r i j. i + j =
6102                                <|carrier := {x + y | x IN I /\ y IN J};
6103                                      sum := <|carrier := {x + y | x IN I /\ y IN J}; op := $+; id := #0|>;
6104                                     prod := <|carrier := {x + y | x IN I /\ y IN J}; op := $*; id := #1|>
6105                                 |>
6106   ideal_sum_element         |- !i j x. x IN (i + j).carrier <=> ?y z. y IN I /\ z IN J /\ (x = y + z)
6107   ideal_sum_comm            |- !r i j. Ring r /\ i << r /\ j << r ==> (i + j = j + i)
6108   ideal_sum_group           |- !r i j. Ring r /\ i << r /\ j << r ==> Group (i + j).sum
6109   ideal_subgroup_ideal_sum  |- !r i j. Ring r /\ i << r /\ j << r ==> i.sum <= (i + j).sum
6110   ideal_sum_subgroup        |- !r i j. Ring r /\ i << r /\ j << r ==> (i + j).sum <= r.sum
6111   ideal_sum_has_ideal       |- !r i j. Ring r /\ i << r /\ j << r ==> i << (i + j)
6112   ideal_sum_has_ideal_comm  |- !r i j. Ring r /\ i << r /\ j << r ==> j << (i + j)
6113   ideal_sum_ideal           |- !r i j. Ring r /\ i << r /\ j << r ==> (i + j) << r
6114   ideal_sum_sub_ideal       |- !r i j. Ring r /\ i << r /\ j << r ==> ((i + j) << j <=> i << j)
6115
6116   principal_ideal_sum_eq_ideal     |- !r i. Ring r /\ i << r ==> !p. p IN I ==> (<p> + i = i)
6117   principal_ideal_sum_equal_ideal  |- !r i. Ring r /\ i << r ==> !p. p IN I <=> p IN R /\ (<p> + i = i)
6118
6119   Maximal Ideals:
6120   ideal_maximal_def     |- !r i. maxi i <=> i << r /\ !j. i << j /\ j << r ==> (i = j) \/ (j = r)
6121
6122   Irreducibles:
6123   irreducible_def       |- !r z. atom z <=> z IN R+ /\ z NOTIN R* /\ !x y. x IN R /\ y IN R /\ (z = x * y) ==> unit x \/ unit y
6124   irreducible_element   |- !r p. atom p ==> p IN R
6125
6126   Principal Ideal Ring:
6127   PrincipalIdealRing_def             |- !r. PrincipalIdealRing r <=> Ring r /\ !i. i << r ==> ?p. p IN R /\ (<p> = i)
6128   principal_ideal_ring_ideal_maximal |- !r. PrincipalIdealRing r ==> !p. atom p ==> maxi <p>
6129
6130   Euclidean Ring:
6131   EuclideanRing_def     |- !r f. EuclideanRing r f <=> Ring r /\ (!x. (f x = 0) <=> (x = #0)) /\
6132                            !x y. x IN R /\ y IN R /\ y <> #0 ==> ?q t. q IN R /\ t IN R /\ (x = q * y + t) /\ f t < f y
6133   euclid_ring_ring      |- !r f. EuclideanRing r f ==> Ring r
6134   euclid_ring_map       |- !r f. EuclideanRing r f ==> !x. (f x = 0) <=> (x = #0)
6135   euclid_ring_property  |- !r f. EuclideanRing r f ==> !x y. x IN R /\ y IN R /\ y <> #0 ==>
6136                                                     ?q t. q IN R /\ t IN R /\ (x = y * q + t) /\ f t < f y
6137   ideal_gen_exists      |- !r i. Ring r /\ i << r /\ i <> <#0> ==> !f. (!x. (f x = 0) <=> (x = #0)) ==>
6138                            ?p. p IN I /\ p <> #0 /\ !z. z IN I /\ z <> #0 ==> f p <= f z
6139   ideal_gen_def         |- !r i f. Ring r /\ i << r /\ i <> <#0> /\ (!x. (f x = 0) <=> (x = #0)) ==>
6140                            ideal_gen r i f IN I /\ ideal_gen r i f <> #0 /\
6141                            !z. z IN I /\ z <> #0 ==> f (ideal_gen r i f) <= f z
6142   ideal_gen_minimal     |- !r i. Ring r /\ i << r /\ i <> <#0> ==> !f. (!x. (f x = 0) <=> (x = #0)) ==>
6143                            !z. z IN I ==> (f z < f (ideal_gen r i f) <=> (z = #0))
6144   euclid_ring_principal_ideal_ring   |- !r f. EuclideanRing r f ==> PrincipalIdealRing r
6145
6146   Ideal under Ring Homomorphism:
6147   homo_ideal_def           |- !f r i. homo_ideal f r s i =
6148                               <|carrier := IMAGE f I;
6149                                    sum := <|carrier := IMAGE f I; op := s.sum.op; id := f #0|>;
6150                                   prod := <|carrier := IMAGE f I; op := s.prod.op; id := f #1|>
6151                                |>
6152   ring_homo_ideal_group    |- !r s f. Ring r /\ Ring s /\ RingHomo f r s ==> !i. i << r ==> Group (homo_ideal f r s i).sum
6153   ring_homo_ideal_subgroup |- !r s f. Ring r /\ Ring s /\ RingHomo f r s ==> !i. i << r ==> (homo_ideal f r s i).sum <= s.sum
6154   ring_homo_ideal_ideal    |- !r s f. Ring r /\ Ring s /\ RingHomo f r s /\ SURJ f R s.carrier ==>
6155                               !i. i << r ==> homo_ideal f r s i << s
6156*)
6157
6158(* ------------------------------------------------------------------------- *)
6159(* Ring Ideals                                                               *)
6160(* ------------------------------------------------------------------------- *)
6161
6162(* The carrier of Ideal = carrier of group i.sum *)
6163Overload I[local] = ``i.carrier``
6164(* The carrier of Ideal = carrier of group j.sum *)
6165Overload J[local] = ``j.carrier``
6166
6167(* An Ideal i (structurally a ring: carrier, sum, prod) of a ring r satisfies 2 conditions:
6168   (1) sum part is subgroup: i.sum is a subgroup of r.sum
6169   (2) prod part is absorption: !x IN I, y IN R, x * y IN I
6170   (3) !x IN I, y IN R, y * x IN I
6171*)
6172Definition ideal_def:
6173  ideal (i:'a ring) (r:'a ring) <=>
6174    i.sum <= r.sum /\
6175    (i.sum.carrier = I) /\
6176    (i.prod.carrier = I) /\
6177    (i.prod.op = r.prod.op) /\
6178    (i.prod.id = #1) /\
6179    (!x y. x IN I /\ y IN R ==> x * y IN I /\ y * x IN I)
6180End
6181(*
6182- ideal_def;
6183> val ideal_def = |- !i r. ideal i r <=>
6184         i.sum <= r.sum /\ (i.sum.carrier = I) /\
6185         (i.prod.carrier = I) /\ (i.prod.op = $* ) /\ (i.prod.id = #1) /\
6186         !x y. x IN I /\ y IN R ==> x * y IN I /\ y * x IN I : thm
6187*)
6188(* set overloading *)
6189Overload "<<" = ``ideal``
6190val _ = set_fixity "<<" (Infixl 650); (* higher than * or / *)
6191
6192(* Theorem: Ideal add_group is a subgroup. *)
6193Theorem ideal_has_subgroup =
6194    ideal_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH_ALL |> CONJUNCT1 |> DISCH_ALL |> GEN_ALL;
6195(* > val ideal_has_subgroup = |- !r i. i << r ==> i.sum <= r.sum : thm *)
6196
6197(* Theorem: Ideal carriers are I. *)
6198Theorem ideal_carriers =
6199    CONJ (ideal_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH_ALL |> CONJUNCT2 |> CONJUNCT1)
6200         (ideal_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH_ALL |> CONJUNCT2 |> CONJUNCT2 |> CONJUNCT1)
6201         |> DISCH_ALL |> GEN_ALL;
6202(* > val ideal_carriers = |- !r i. i << r ==> (i.sum.carrier = I) /\ (i.prod.carrier = I) : thm *)
6203
6204(* Theorem: Ideal is multiplicative closed with all elements. *)
6205Theorem ideal_product_property =
6206    ideal_def |> SPEC_ALL |> #1 o EQ_IMP_RULE |> UNDISCH_ALL |> CONJUNCTS |> last |> DISCH_ALL |> GEN_ALL;
6207(* > val ideal_product_property = |- !r i. i << r ==> !x y. x IN I /\ y IN R ==> x * y IN I /\ y * x IN I : thm *)
6208
6209(* Theorem: i << r ==> !x. x IN I ==> x IN r.sum.carrier *)
6210(* Proof:
6211   i.sum <= r.sum /\ i.sum.carrier = I    by ideal_def
6212   x IN i.sum.carrier ==> x IN r.sum.carrier  by subgroup_element
6213   hence true.
6214*)
6215Theorem ideal_element:
6216    !r i:'a ring. i << r ==> !x. x IN I ==> x IN r.sum.carrier
6217Proof
6218  metis_tac[ideal_def, subgroup_element]
6219QED
6220
6221(* Theorem: i << r ==> (i.sum.op = r.sum.op) /\ (i.prod.op = r.prod.op *)
6222(* Proof:
6223   i << r ==> i.sum <= r.sum          by ideal_def
6224          ==> i.sum.op = r.sum.op     by Subgroup_def
6225   i << r ==> i.prod.op = r.prod.op   by ideal_def
6226*)
6227Theorem ideal_ops:
6228    !r i:'a ring. i << r ==> (i.sum.op = r.sum.op) /\ (i.prod.op = r.prod.op)
6229Proof
6230  rw[ideal_def, Subgroup_def]
6231QED
6232
6233(* ------------------------------------------------------------------------- *)
6234(* Ideal Theorems                                                            *)
6235(* ------------------------------------------------------------------------- *)
6236
6237(* Theorem: Ring r /\ i << r ==> !x. x IN I ==> x IN R *)
6238(* Proof:
6239   x IN I ==> x IN r.sum.carrier    by ideal_element
6240   r.sum.carrier = R                by ring_add_group
6241   hence true.
6242*)
6243Theorem ideal_element_property:
6244    !r i:'a ring. Ring r /\ i << r ==> !x. x IN I ==> x IN R
6245Proof
6246  metis_tac[ideal_element, ring_add_group]
6247QED
6248
6249(* Theorem: Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> x + y IN I /\ x * y IN I *)
6250(* Proof:
6251   For the first one, x + y IN I
6252     It is because i.sum <= r.sum /\ (i.sum.carrier = I)  by ideal_def
6253     Hence Group i.sum /\ (i.sum.op x y = x + y)          by subgroup_property
6254     Since x, y IN I, x, y IN R                           by ideal_element_property
6255     Hence true by group_op_element.
6256   For the second one, x * y IN I
6257     It is because y IN I ==> y IN R by ideal_element_property
6258     Hence true by ideal_product_property.
6259*)
6260Theorem ideal_property:
6261    !r i:'a ring. Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> x + y IN I /\ x * y IN I
6262Proof
6263  rpt strip_tac >| [
6264    `i.sum <= r.sum /\ (i.sum.carrier = I)` by metis_tac[ideal_def] >>
6265    `Group i.sum /\ (i.sum.op x y = x + y)` by metis_tac[subgroup_property] >>
6266    metis_tac[group_op_element, ideal_element_property],
6267    metis_tac[ideal_product_property, ideal_element_property]
6268  ]
6269QED
6270
6271(* Theorem: i << r ==> #0 IN I *)
6272(* Proof:
6273   i.sum <= r.sum /\ (i.sum.carrier = I)   by ideal_def
6274   i.sum.id = #0                           by subgroup_id
6275   hence true by Subgroup_def, group_id_element.
6276*)
6277Theorem ideal_has_zero:
6278    !r i:'a ring. Ring r /\ i << r ==> #0 IN I
6279Proof
6280  rpt strip_tac >>
6281  `i.sum <= r.sum /\ (i.sum.carrier = I)` by metis_tac[ideal_def] >>
6282  metis_tac[subgroup_id, Subgroup_def, group_id_element]
6283QED
6284
6285(* Theorem: i << r ==> !x. x IN I <=> -x IN I *)
6286(* Proof:
6287   i.sum <= r.sum /\ (i.sum.carrier = I)   by ideal_def
6288   hence true by Subgroup_def, group_inv_element.
6289*)
6290Theorem ideal_has_neg:
6291    !r i:'a ring. Ring r /\ i << r ==> !x. x IN I ==> -x IN I
6292Proof
6293  rpt strip_tac >>
6294  `i.sum <= r.sum /\ (i.sum.carrier = I)` by metis_tac[ideal_def] >>
6295  metis_tac[subgroup_inv, Subgroup_def, group_inv_element]
6296QED
6297
6298(* Theorem: i << r ==> !x y. x IN I /\ y IN I ==> (x + y) IN I *)
6299(* Proof: by ideal_property. *)
6300Theorem ideal_has_sum:
6301    !r i:'a ring. Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> (x + y) IN I
6302Proof
6303  rw[ideal_property]
6304QED
6305
6306(* Theorem: i << r ==> !x y. x IN I /\ y IN I ==> (x - y) IN I *)
6307(* Proof: by ideal_has_neg, ideal_has_sum. *)
6308Theorem ideal_has_diff:
6309    !r i:'a ring. Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> (x - y) IN I
6310Proof
6311  rw[ideal_has_neg, ideal_has_sum]
6312QED
6313
6314(* Theorem: i << r ==> !x y. x IN I /\ y IN I ==> (x * y) IN I *)
6315(* Proof: by ideal_property. *)
6316Theorem ideal_has_product:
6317    !r i:'a ring. Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> (x * y) IN I
6318Proof
6319  rw[ideal_property]
6320QED
6321
6322(* Theorem: i << r ==> !x y. x IN I /\ y IN R ==> x * y IN I *)
6323(* Proof: by ideal_product_property. *)
6324Theorem ideal_has_multiple:
6325    !r i:'a ring. i << r ==> !x y. x IN I /\ y IN R ==> x * y IN I
6326Proof
6327  rw[ideal_product_property]
6328QED
6329
6330(* Theorem: i << r ==> i.sum.id = #0 *)
6331(* Proof:
6332       i << r
6333   ==> i.sum <= r.sum        by ideal_def
6334   ==> i.sum.id = #0         by subgroup_id
6335*)
6336Theorem ideal_zero:
6337    !r i:'a ring. Ring r /\ i << r ==> (i.sum.id = #0)
6338Proof
6339  rw[ideal_def, subgroup_id]
6340QED
6341
6342(* Theorem: i << r /\ j << r ==> ((i = j) <=> (I = J)) *)
6343(* Proof:
6344   If part: i = j ==> I = J, true by I = i.carrier, J = j.carrier.
6345   Only-if part: I = J ==> i = j
6346   By ring_component_equality, this is to show:
6347   (1) I = J ==> i.sum = j.sum
6348       True by monoid_component_equality, ideal_def, ideal_ops, ideal_zero.
6349   (2) I = J ==> i.prod = j.prod
6350       True by monoid_component_equality, ideal_def, ideal_ops.
6351*)
6352Theorem ideal_eq_ideal:
6353    !r i j:'a ring. Ring r /\ i << r /\ j << r ==> ((i = j) <=> (I = J))
6354Proof
6355  rw[ring_component_equality, EQ_IMP_THM] >>
6356  metis_tac[monoid_component_equality, ideal_def, ideal_ops, ideal_zero]
6357QED
6358
6359(* Theorem: i << r /\ j << r ==> ((i << j) <=> (I <= J)) *)
6360(* Proof:
6361   After expanding by definitions, this is to show:
6362   (1) x IN I /\ y IN J /\ I SUBSET J ==> x * y IN I, true by SUBSET_DEF, and y IN J ==> y IN R.
6363   (2) x IN I /\ y IN J /\ I SUBSET J ==> y * x IN I, true by SUBSET_DEF, and x IN I ==> x IN R.
6364*)
6365Theorem ideal_sub_ideal:
6366    !r i j:'a ring. Ring r /\ i << r /\ j << r ==> ((i << j) <=> (I SUBSET J))
6367Proof
6368  rw[ideal_def, Subgroup_def] >>
6369  `r.sum.carrier = R` by rw[ring_add_group] >>
6370  metis_tac[SUBSET_DEF]
6371QED
6372
6373(* Theorem: i << r ==> i << i *)
6374(* Proof:
6375   i << i iff I SUBSET I    by ideal_sub_ideal
6376          iff T             by SUBSET_REFL
6377*)
6378Theorem ideal_sub_itself:
6379    !r i:'a ring. Ring r /\ i << r ==> i << i
6380Proof
6381  metis_tac[ideal_sub_ideal, SUBSET_REFL]
6382QED
6383
6384(* Theorem: r << r *)
6385(* Proof: by definition, this is to show:
6386   (1) r.sum <= r.sum, true by subgroup_refl.
6387   (2) r.prod.carrier = R, true by ring_mult_monoid.
6388   (3) x IN R /\ y IN R ==> x * y IN R, true by ring_mult_element.
6389   (4) x IN R /\ y IN R ==> y * x IN R, true by ring_mult_element.
6390*)
6391Theorem ideal_refl:
6392    !r:'a ring. Ring r ==> r << r
6393Proof
6394  rw[ideal_def, subgroup_refl]
6395QED
6396
6397(* Theorem: i << r /\ #1 IN I ==> i = r *)
6398(* Proof:
6399   By ring_component_equality, this is to show:
6400   (1) i << r /\ r << i ==> I = R
6401       i << r ==> i.sum.carrier = I SUBSET R = r.sum.carrier   by ideal_def, Subgroup_def
6402       r << i ==> r.sum.carrier = R SUBSET I = i.sum.carrier   by ideal_def, Subgroup_def
6403       Hence true by SUBSET_ANTISYM.
6404   (2) i << r /\ r << i ==> i.sum = r.sum
6405       i << r ==> i.sum <= r.sum    by ideal_def
6406       r << i ==> r.sum <= i.sum    by ideal_def
6407       Hence true by subgroup_antisym.
6408   (3) i << r /\ r << i ==> i.prod = r.prod
6409       By monoid_component_equality, this is to show:
6410       (a)  << r /\ r << i ==> i.prod.carrier = r.prod.carrier,
6411           i.e. I = R     by ideal_def
6412           so apply (1).
6413       (b) i << r ==> i.prod.op = $*, true by ideal_def.
6414       (c) i << r ==> i.prod.id = #1, true by ideal_def.
6415*)
6416Theorem ideal_antisym:
6417    !(r:'a ring) (i:'a ring). i << r /\ r << i ==> (i = r)
6418Proof
6419  rw[ring_component_equality] >-
6420  metis_tac[ideal_def, Subgroup_def, SUBSET_ANTISYM] >-
6421  metis_tac[ideal_def, subgroup_antisym] >>
6422  rw[monoid_component_equality] >>
6423  metis_tac[ideal_def, Subgroup_def, SUBSET_ANTISYM]
6424QED
6425
6426(* Theorem: i << r /\ #1 IN I ==> I = R *)
6427(* Proof:
6428   First, i << r ==> I SUBSET R, by Subgroup_def.
6429   Now, !z. #1 IN I /\ z IN R ==> #1 * z = z IN I by ideal_def.
6430   Hence R SUBSET I, or I = R by SUBSET_ANTISYM.
6431*)
6432Theorem ideal_has_one:
6433    !r i:'a ring. Ring r /\ i << r /\ #1 IN I ==> (I = R)
6434Proof
6435  rw[ideal_def] >>
6436  `I SUBSET R` by metis_tac[Subgroup_def, Ring_def] >>
6437  `!y. y IN R ==> (#1 * y = y)` by rw[] >>
6438  `R SUBSET I` by metis_tac[SUBSET_DEF] >>
6439  rw[SUBSET_ANTISYM]
6440QED
6441
6442(* Theorem: i << r /\ #1 IN I <=> i = r *)
6443(* Proof:
6444   If part: i << r /\ #1 IN I ==> i = r
6445   By ring_component_equality, this is to show:
6446   (1) i << r /\ #1 IN I ==> I = R, true by ideal_has_one.
6447   (2) i << r /\ #1 IN I ==> i.sum = r.sum
6448       By monoid_component_equality, this is to show:
6449       (a) i.sum.carrier = R, i.e. I = R, given by (1)
6450       (b) i.sum.op = $+, true by ideal_ops.
6451       (c) i.sum.id = #0, true by i.sum <= r.sum, and subgroup_id.
6452   (3) i << r /\ #1 IN I ==> i.prod = r.prod
6453       By monoid_component_equality, this is to show:
6454       (a) i.prod.carrier = r.prod.carrier, i.e. I = R, given by (1)
6455       (b) i.prod.op = $*, true by ideal_ops.
6456       (c) i.prod.id = #1, true by ideal_def.
6457   Only-if part: Ring i ==> i << i
6458   True by ideal_refl.
6459*)
6460Theorem ideal_with_one:
6461    !r:'a ring. Ring r ==> !i. i << r /\ #1 IN I <=> (i = r)
6462Proof
6463  rw[EQ_IMP_THM] >| [
6464    rw[ring_component_equality] >| [
6465      rw[ideal_has_one],
6466      rw[monoid_component_equality] >| [
6467        metis_tac[ideal_carriers, ideal_has_one],
6468        rw[ideal_ops],
6469        metis_tac[ideal_def, subgroup_id]
6470      ],
6471      rw[monoid_component_equality] >| [
6472        metis_tac[ideal_def, ring_mult_monoid, ideal_has_one],
6473        rw[ideal_ops],
6474        metis_tac[ideal_def]
6475      ]
6476    ],
6477    rw[ideal_refl]
6478  ]
6479QED
6480
6481(* Theorem: i << r /\ x IN I /\ unit x ==> i = r *)
6482(* Proof:
6483   x IN I ==> x IN R        by ideal_element_property
6484   unit x ==> |/ x IN R     by ring_unit_inv_element
6485   So x * |/x IN I          by ideal_has_multiple
6486   But x * |/x = #1         by ring_unit_rinv
6487   i.e. #1 IN I, hence follows by ideal_with_one.
6488*)
6489Theorem ideal_with_unit:
6490    !r i:'a ring. Ring r /\ i << r ==> !x. x IN I /\ unit x ==> (i = r)
6491Proof
6492  rpt strip_tac >>
6493  `x IN R` by metis_tac[ideal_element_property] >>
6494  `|/x IN R` by rw[ring_unit_inv_element] >>
6495  `x * |/x = #1` by rw[ring_unit_rinv] >>
6496  `#1 IN I` by metis_tac[ideal_has_multiple] >>
6497  metis_tac[ideal_with_one]
6498QED
6499
6500(* ------------------------------------------------------------------------- *)
6501(* Ideal Cosets                                                              *)
6502(* ------------------------------------------------------------------------- *)
6503
6504(* Define (left) coset of ideal with an element a in R by overloading *)
6505Overload o = ``coset r.sum``
6506
6507(* Theorem: i << r ==> !x. x IN I ==> x o I = I *)
6508(* Proof: by coset_def, this is to show:
6509   (1) x IN I /\ z IN I ==> x + z IN I
6510       True by ideal_property.
6511   (2) x IN I /\ x' IN I ==> ?z. (x' = x + z) /\ z IN I
6512       Let z = x' + (-x)
6513       -x IN I         by ideal_has_neg
6514       hence z IN I    by ideal_property
6515       and x + z
6516         = x + (x' + -x)
6517         = x + (-x + x')  by ring_add_comm
6518         = x'             by ring_add_lneg_assoc
6519*)
6520Theorem ideal_coset_of_element:
6521    !r i:'a ring. Ring r /\ i << r ==> !x. x IN I ==> (x o I = I)
6522Proof
6523  rw[coset_def, EXTENSION, EQ_IMP_THM] >-
6524  rw[ideal_property] >>
6525  qexists_tac `x' + -x` >>
6526  `-x IN I` by rw[ideal_has_neg] >>
6527  metis_tac[ring_add_lneg_assoc, ring_add_comm, ideal_element_property, ideal_property]
6528QED
6529
6530(* Theorem: i << r ==> !x. x IN R /\ (x o I = I) <=> x IN I *)
6531(* Proof:
6532   If part: x IN R /\ x o I = I ==> x IN I
6533     x o I = IMAGE (\z. x + z) I   by coset_def
6534     Since #0 IN I                 by ideal_has_zero
6535     x + #0 IN IMAGE (\z. x + z) I
6536     i.e. x + #0 IN I
6537     or x IN I                     by ring_add_rzero
6538   Only if part: x IN I ==> x IN R /\ (x o I = I)
6539     x IN R     by ideal_element_property
6540     x o I = I  by ideal_coset_of_element.
6541*)
6542Theorem ideal_coset_eq_carrier:
6543    !r i:'a ring. Ring r /\ i << r ==> !x. x IN R /\ (x o I = I) <=> x IN I
6544Proof
6545  rw[EQ_IMP_THM] >| [
6546    `x o I = IMAGE (\z. x + z) I` by rw[GSYM coset_def] >>
6547    `#0 IN I` by rw[ideal_has_zero] >>
6548    `x + #0 IN IMAGE (\z. x + z) I` by rw[] >>
6549    metis_tac[ring_add_rzero, ideal_element_property],
6550    metis_tac[ideal_element_property],
6551    rw[ideal_coset_of_element]
6552  ]
6553QED
6554
6555(* Theorem: Ring r /\ (i << r) ==> !x y. x IN R /\ y IN R ==> ((x o I = y o I) <=> x - y IN I) *)
6556(* Proof:
6557   Since i << r, i.sum <= r.sum by ideal_def
6558   Also r.sum.carrier = R       by ring_add_group
6559   Hence by subgroup_coset_eq, this is to show:
6560            - y + x IN I
6561   or        x + -y IN I        by ring_add_comm, ring_neg_element
6562   or        x - y  IN I        by ring_sub_def
6563*)
6564Theorem ideal_coset_eq:
6565    !r i:'a ring. Ring r /\ (i << r) ==> !x y. x IN R /\ y IN R ==> ((x o I = y o I) <=> x - y IN I)
6566Proof
6567  rpt strip_tac >>
6568  `i.sum <= r.sum /\ (i.sum.carrier = I)` by metis_tac[ideal_def] >>
6569  `r.sum.carrier = R` by rw[] >>
6570  metis_tac[subgroup_coset_eq, ring_add_comm, ring_neg_element, ring_sub_def]
6571QED
6572
6573(* ------------------------------------------------------------------------- *)
6574(* Ideal induces congruence in Ring.                                         *)
6575(* ------------------------------------------------------------------------- *)
6576
6577(* Define congruence by ideal in Ring *)
6578Definition ideal_congruence_def[simp]:
6579  ideal_congruence (r:'a ring) (i:'a ring) (x:'a) (y:'a) <=> x - y IN i.carrier
6580End
6581
6582(* set overloading *)
6583Overload "===" = ``ideal_congruence r i``
6584val _ = set_fixity "===" (Infix(NONASSOC, 450));
6585
6586(* Theorem: x === x *)
6587(* Proof:
6588   x - x = #0            by ring_sub_eq_zero
6589   hence true            by ideal_has_zero
6590*)
6591Theorem ideal_congruence_refl:
6592    !r i:'a ring. Ring r /\ i << r ==> !x. x IN R ==> x === x
6593Proof
6594  rw[ideal_has_zero]
6595QED
6596
6597(* Theorem: x === y <=> y === x *)
6598(* Proof:
6599   x - y = - (y - x)    by ring_neg_sub
6600   hence true           by ideal_had_neg
6601*)
6602Theorem ideal_congruence_sym:
6603    !r i:'a ring. Ring r /\ i << r ==> !x y. x IN R /\ y IN R ==> (x === y <=> y === x)
6604Proof
6605  rw_tac std_ss[ideal_congruence_def] >>
6606  metis_tac[ring_neg_sub, ideal_has_neg]
6607QED
6608
6609(* Theorem: x === y /\ y === z ==> x === z *)
6610(* Proof:
6611   x - z = (x - y) + (y - z)   by ring_sub_def, ring_add_assoc, ring_add_lneg, ring_add_lzero
6612   hence true                  by ideal_has_sum
6613*)
6614Theorem ideal_congruence_trans:
6615    !r i:'a ring. Ring r /\ i << r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> (x === y /\ y === z ==> x === z)
6616Proof
6617  rw_tac std_ss[ideal_congruence_def] >>
6618  `(x - y) + (y - z) = x + (-y + (y + -z))` by rw[ring_add_assoc] >>
6619  `_ = x + (-y + y + -z)` by rw[ring_add_assoc] >>
6620  `_ = x - z` by rw[] >>
6621  metis_tac[ideal_has_sum]
6622QED
6623
6624(* Theorem: === is an equivalence relation on R. *)
6625(* Proof: by reflexive, symmetric and transitive of === on R. *)
6626Theorem ideal_congruence_equiv:
6627    !r i:'a ring. Ring r /\ i << r ==> $=== equiv_on R
6628Proof
6629  rw_tac std_ss[equiv_on_def] >-
6630  rw[ideal_congruence_refl] >-
6631  rw[ideal_congruence_sym] >>
6632  metis_tac[ideal_congruence_trans]
6633QED
6634
6635(* Theorem: Ring r /\ (i << r) ==> !x y. x IN R /\ y IN R ==> ((x o I = y o I) <=> x === y) *)
6636(* Proof: by ideal_congruence_def, ideal_coset_eq. *)
6637Theorem ideal_coset_eq_congruence:
6638    !r i:'a ring. Ring r /\ i << r ==> !x y. x IN R /\ y IN R ==> ((x o I = y o I) <=> x === y)
6639Proof
6640  rw[ideal_coset_eq]
6641QED
6642
6643(* Characterization: x === y iff x, y in the same coset, element of (r/i) *)
6644
6645(* Theorem: i << r ==> !x y. x IN I /\ y IN I ==> (x === y) <=> inCoset r.sum i.sum x y *)
6646(* Proof: by definitions, this is to show:
6647   (1) x IN I /\ y IN I /\ x + -y IN I ==> ?z. (y = x + z) /\ z IN I
6648       Let z = -x + y,
6649       then z IN I   by ideal_has_neg, ideal_has_sum
6650       and y = x + (-x + y)   by ring_add_lneg_assoc
6651   (2) x IN I /\ z IN I ==> x + -(x + z) IN I
6652         x + -(x + z)
6653       = x + (-x + -z)   by ring_neg_add
6654       = -z              by ring_add_lneg_assoc
6655       hence true        by ideal_has_neg
6656*)
6657Theorem ideal_congruence_iff_inCoset:
6658    !r i:'a ring. Ring r /\ i << r ==> !x y. x IN I /\ y IN I ==> ((x === y) <=> inCoset r.sum i.sum x y)
6659Proof
6660  rpt strip_tac >>
6661  `i.sum <= r.sum /\ (i.sum.carrier = I)` by metis_tac[ideal_def] >>
6662  `!z. z IN I ==> z IN R` by metis_tac[ideal_element_property] >>
6663  rw[inCoset_def, coset_def, EQ_IMP_THM] >| [
6664    qexists_tac `-x + y` >>
6665    metis_tac[ring_add_lneg_assoc, ideal_has_neg, ideal_has_sum],
6666    `!y. y IN R ==> -y IN R` by rw[] >>
6667    metis_tac[ring_neg_add, ring_add_lneg_assoc, ideal_has_neg]
6668  ]
6669QED
6670
6671(* Theorem: x === y ==> z * x === z * y  *)
6672(* Proof:
6673       x === y
6674   ==> x - y IN R          by ideal_congruence_def
6675   ==> z * (x - y) IN R    by ideal_def
6676   ==> z * x - z * y IN R  by ring_mult_rsub, ideal_element_property
6677   ==> z * x === z * y     by ideal_congruence_def
6678*)
6679Theorem ideal_congruence_mult:
6680    !r i:'a ring. Ring r /\ i << r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x === y) ==> (z * x === z * y))
6681Proof
6682  rw_tac std_ss[ideal_congruence_def] >>
6683  `z * (x - y) IN I` by metis_tac[ideal_def] >>
6684  metis_tac[ring_mult_rsub, ideal_element_property]
6685QED
6686
6687(* Theorem: i << r /\ x IN I /\ y IN R ==> y IN I <=> x === y *)
6688(* Proof:
6689   If part: y IN I ==> x === y
6690       x IN I /\ y IN I
6691   ==> x - y IN I             by ideal_has_diff
6692   ==> x === y                by ideal_congruence_def
6693   Only-if part: x === y ==> y IN I
6694       x === y
6695   ==> y === x                by ideal_congruence_sym
6696   ==> y - x IN I             by ideal_congruence_def
6697   ==> (y - x) + x IN I       by ideal_has_sum
6698   ==> y IN I                 by ring_sub_add
6699*)
6700Theorem ideal_congruence_elements:
6701    !r i:'a ring. Ring r /\ i << r ==> !x y. x IN I /\ y IN R ==> (y IN I <=> x === y)
6702Proof
6703  rpt strip_tac >>
6704  `!z. z IN I ==> z IN R` by metis_tac[ideal_element_property] >>
6705  rw_tac std_ss[ideal_congruence_def, EQ_IMP_THM] >-
6706  rw[ideal_has_diff] >>
6707  `x + -y IN I` by metis_tac[ring_sub_def] >>
6708  `x + -y - x IN I` by rw[ideal_has_diff] >>
6709  `-y IN I` by metis_tac[ring_add_sub_comm, ring_neg_element] >>
6710  metis_tac[ideal_has_neg, ring_neg_neg]
6711QED
6712
6713(* ------------------------------------------------------------------------- *)
6714(* Principal Ideal = Ideal generated by a Ring element                       *)
6715(* ------------------------------------------------------------------------- *)
6716
6717(* Multiples of a Ring element p *)
6718(* val element_multiple_def = Define `element_multiple (r:'a ring) (p:'a) = {p * x | x IN R}`; *)
6719
6720(* use overloading *)
6721Overload "*" = ``coset r.prod``
6722
6723(* Integer Ring Ideals are multiples *)
6724Definition principal_ideal_def:
6725  principal_ideal (r:'a ring) (p:'a) =
6726    <| carrier := p * R;
6727           sum := <| carrier := p * R; op := r.sum.op; id := r.sum.id |>;
6728          prod := <| carrier := p * R; op := r.prod.op; id := r.prod.id |>
6729     |>
6730End
6731(* Note: <p>.prod is only type-compatible with monoid, it is not a monoid: prod.id may not be in carrier. *)
6732
6733(* set overloading *)
6734Overload "<p>" = ``principal_ideal r p``
6735Overload "<q>" = ``principal_ideal r q``
6736
6737(*
6738- principal_ideal_def;
6739> val it = |- !r p. <p> = <|carrier := p * R;
6740                                sum := <|carrier := p * R; op := $+; id := #0|>;
6741                               prod := <|carrier := p * R; op := $*; id := #1|>
6742                           |> : thm
6743*)
6744
6745(* Theorem: Properties of principal ideal. *)
6746(* Proof: by definition. *)
6747Theorem principal_ideal_property:
6748    !(r:'a ring) (p:'a).
6749     (<p>.carrier = p * R) /\ (<p>.sum.carrier = p * R) /\ (<p>.prod.carrier = p * R) /\
6750     (<p>.sum.op = r.sum.op) /\ (<p>.prod.op = r.prod.op) /\
6751     (<p>.sum.id = #0) /\ (<p>.prod.id = #1)
6752Proof
6753  rw[principal_ideal_def]
6754QED
6755
6756(* Theorem: x IN <p>.carrier <=> ?z. z IN R /\ (x = p * z) *)
6757(* Proof: by definitions. *)
6758Theorem principal_ideal_element:
6759    !p x:'a. x IN <p>.carrier <=> ?z. z IN R /\ (x = p * z)
6760Proof
6761  rw[principal_ideal_def, coset_def] >>
6762  metis_tac[]
6763QED
6764
6765(* Theorem: p IN <p>.carrier *)
6766(* Proof:
6767   By principal_ideal_element, this is to show:
6768   ?x. (p = p * x) /\ x IN R
6769   Let x = #1,
6770   then #1 IN R      by ring_one_element
6771   and  p = p * #1   by ring_mult_rone
6772   hence true.
6773*)
6774Theorem principal_ideal_has_element:
6775    !r:'a ring. Ring r ==> !p. p IN R ==> p IN <p>.carrier
6776Proof
6777  metis_tac[principal_ideal_element, ring_one_element, ring_mult_rone]
6778QED
6779
6780(* Theorem: Group <p>.sum *)
6781(* Proof:
6782   First, <p>.carrier = p * R     by principal_ideal_property
6783   and !x. x IN p * R ==> x IN R  by coset_def
6784   Check group axioms:
6785   (1) x IN p * R /\ y IN p * R ==> x + y IN p * R
6786       Let x = p * u, y = p * v,  u IN R and v IN R
6787       x + y = p * u + p * v
6788             = p * (u + v)        by ring_mult_radd
6789       Hence in p * R.
6790   (2) x IN p * R /\ y IN p * R /\ z IN p * R ==> x + y + z = x + (y + z)
6791       True by ring_add_assoc.
6792   (3) #0 IN p * R
6793       Since #0 = p * #0          by ring_mult_rzero
6794       and #0 IN R                by ring_zero_element
6795       Hence true.
6796   (4) x IN p * R ==> #0 + x = x
6797       True by ring_add_lzero.
6798   (5) x IN p * R ==> ?y. y IN p * R /\ (y + x = #0)
6799       Let x = p * u, u IN R      by principal_ideal_element
6800       Let y = p * (-u), -u IN R  by ring_neg_element
6801       Hence y IN p * R, and
6802          y + x
6803       = p * -u + p * u
6804       = - (p * u) + p * u        by ring_neg_mult
6805       = #0                       by ring_add_lneg
6806*)
6807Theorem principal_ideal_group:
6808    !r:'a ring. Ring r ==> !p. p IN R ==> Group <p>.sum
6809Proof
6810  ntac 4 strip_tac >>
6811  `<p>.carrier = p * R` by rw[principal_ideal_property] >>
6812  (`!x. x IN p * R ==> x IN R` by (rw[coset_def] >> rw[])) >>
6813  rw_tac std_ss[principal_ideal_def, group_def_alt, GSPECIFICATION] >| [
6814    `?u. u IN R /\ (x = p * u)` by metis_tac[principal_ideal_element] >>
6815    `?v. v IN R /\ (y = p * v)` by metis_tac[principal_ideal_element] >>
6816    `x + y = p * (u + v)` by rw[ring_mult_radd] >>
6817    metis_tac[principal_ideal_element, ring_add_element],
6818    rw[ring_add_assoc],
6819    metis_tac[principal_ideal_element, ring_zero_element, ring_mult_rzero],
6820    rw[],
6821    `?u. u IN R /\ (x = p * u)` by metis_tac[principal_ideal_element] >>
6822    qexists_tac `p * (-u)` >>
6823    `p * -u = - x` by metis_tac[ring_neg_mult] >>
6824    `p * -u + x = #0` by metis_tac[ring_add_lneg] >>
6825    metis_tac[principal_ideal_element, ring_neg_element]
6826  ]
6827QED
6828
6829(* Theorem: <p>.sum <= r.sum *)
6830(* Proof: for a subgroup:
6831   (1) Group <p>.sum,
6832       true by principal_ideal_group
6833   (2) <p>.sum SUBSET r.sum.carrier,
6834       i.e. to show: p * R SUBSET R
6835         or to show: p IN R /\ z IN R ==> p * z IN R
6836       true by ring_mult_element.
6837*)
6838Theorem principal_ideal_subgroup:
6839    !r:'a ring. Ring r ==> !p. p IN R ==> <p>.sum <= r.sum
6840Proof
6841  rw[Subgroup_def, principal_ideal_group, principal_ideal_def] >>
6842  rw[coset_def, SUBSET_DEF] >>
6843  rw[]
6844QED
6845
6846(* Theorem: <p>.sum << r.sum *)
6847(* Proof: for a normal subgroup:
6848   (1) <p>.sum <= r.sum,
6849       true by principal_ideal_subgroup
6850   (2) p IN R /\ a IN R ==> IMAGE (\z. a + z) <p>.sum.carrier = IMAGE (\z. z + a) <p>.sum.carrier
6851       true ring_add_comm and EXTENSION.
6852*)
6853Theorem principal_ideal_subgroup_normal:
6854    !r:'a ring. Ring r ==> !p. p IN R ==> <p>.sum << r.sum
6855Proof
6856  rw[normal_subgroup_alt, coset_def, right_coset_def] >| [
6857    rw[principal_ideal_subgroup],
6858    rw[principal_ideal_def, coset_def, EXTENSION] >>
6859    `!x. x IN R ==> (a + p * x = p * x + a)` by rw[ring_add_comm] >>
6860    metis_tac[]
6861  ]
6862QED
6863
6864(* Theorem: <p> is an ideal: <p> << r. *)
6865(* Proof: by ideal_def
6866   (1) <p>.sum <= r.sum
6867       True by principal_ideal_subgroup.
6868   (2) x IN p * R /\ y IN R ==> x * y IN p * R
6869       x = p * u   for some u IN R
6870       x * y = (p * u) * y
6871             = p * (u * y)     by ring_mult_assoc
6872       Hence x * y IN p * R.
6873   (3) x IN p * R /\ y IN R ==> y * x IN p * R
6874       Use above and y * x = x * y   by ring_mult_comm
6875*)
6876Theorem principal_ideal_ideal:
6877    !r:'a ring. Ring r ==> !p. p IN R ==> <p> << r
6878Proof
6879  rpt strip_tac >>
6880  `<p>.carrier = p * R` by metis_tac[principal_ideal_property] >>
6881  rw[ideal_def, principal_ideal_def, principal_ideal_subgroup] >| [
6882    `?u. u IN R /\ (x = p * u)` by metis_tac[principal_ideal_element] >>
6883    `x * y = p * (u * y)` by rw[ring_mult_assoc] >>
6884    metis_tac[principal_ideal_element, ring_mult_element],
6885    `?u. u IN R /\ (x = p * u)` by metis_tac[principal_ideal_element] >>
6886    `y * (p * u) = p * u  * y` by rw[ring_mult_comm] >>
6887    `_ = p * (u * y)` by rw[ring_mult_assoc] >>
6888    metis_tac[principal_ideal_element, ring_mult_element]
6889  ]
6890QED
6891
6892(* Theorem: A principal ideal has all ideals of its elements:
6893            p IN R /\ q IN <p>.carrier ==> <q> << <p> *)
6894(* Proof:
6895   First, q IN R    by principal_ideal_element, ring_mult_element
6896   thus  <p> << r   by principal_ideal_ideal
6897   and   <q> << r   by principal_ideal_ideal
6898   By ideal_def, this is to show:
6899   (1) <q>.sum <= <p>.sum
6900       By Subgroup_def, this is to show:
6901       (a) Group <q>.sum, true by ideal_has_subgroup and Subgroup_def.
6902       (b) Group <p>.sum, true by ideal_has_subgroup and Subgroup_def.
6903       (c) <q>.sum.carrier SUBSET <p>.sum.carrier,
6904           or, x IN <q>.sum.carrier ==> x IN <p>.sum.carrier
6905           Since q IN <p>.carrier,
6906               q = p * z   for some z IN R, by principal_ideal_def
6907           x = q * k       for some k IN R, by principal_ideal_def
6908             = p * (z * k) by ring_mult_assoc
6909           hence x IN <p>.carrier.
6910       (d) <q>.sum.op = <p>.sum.op, true by ideal_ops.
6911   (2) <q>.sum.carrier = <q>.carrier, true by ideal_carriers.
6912   (3) <q>.prod.carrier = <q>.carrier, true by ideal_carriers.
6913   (4) <q>.prod.op = <p>.prod.op, true by ideal_ops.
6914   (5) <q>.prod.id = <p>.prod.id, true by ideal_def.
6915   (6) x IN <q>.carrier /\ y IN <q>.carrier ==> <p>.prod.op x y IN <q>.carrier, true by ideal_product_property.
6916       y IN <q>.carrier ==> y IN R    by ideal_element_property
6917       <p>.prod.op = r.prod.op        by ideal_ops
6918       Hence true by ideal_product_property.
6919   (7) Similar to (6), also by ideal_product_property
6920*)
6921Theorem principal_ideal_has_principal_ideal:
6922    !r:'a ring. Ring r ==> !p q. p IN R /\ q IN <p>.carrier ==> (<q> << <p>)
6923Proof
6924  rpt strip_tac >>
6925  `<p> << r` by rw[principal_ideal_ideal] >>
6926  `q IN R` by metis_tac[principal_ideal_element, ring_mult_element] >>
6927  `<q> << r` by rw[principal_ideal_ideal] >>
6928  rw[ideal_def] >| [
6929    rw[Subgroup_def]
6930    >- metis_tac[ideal_has_subgroup, Subgroup_def]
6931    >- metis_tac[ideal_has_subgroup, Subgroup_def]
6932    >- (`<q>.carrier SUBSET <p>.carrier` suffices_by metis_tac[ideal_carriers]>>
6933        `?z. z IN R /\ (q = p * z)` by metis_tac[principal_ideal_element] >>
6934        rw[principal_ideal_def, coset_def, SUBSET_DEF] >>
6935        rename [‘p * a * b = p * _ ∧ _ ∈ R’] >>
6936        qexists_tac `a * b` >>
6937        rw[ring_mult_assoc]) >>
6938    metis_tac[ideal_ops],
6939    metis_tac[ideal_carriers],
6940    metis_tac[ideal_carriers],
6941    metis_tac[ideal_ops],
6942    metis_tac[ideal_def],
6943    metis_tac[ideal_element_property, ideal_ops, ideal_product_property],
6944    metis_tac[ideal_element_property, ideal_ops, ideal_product_property]
6945  ]
6946QED
6947
6948(* Theorem: if elements are associates, their principal ideals are equal.
6949            p IN R /\ q IN R /\ unit u /\ (p = q * u) ==> <p> = <q>  *)
6950(* Proof:
6951   First, <p> << r     by principal_ideal_ideal
6952      and <q> << r     by principal_ideal_ideal
6953      and u IN R       by ring_unit_element
6954   By ideal_eq_ideal, only need to show: <p>.carrier = <q>.carrier
6955   Let x IN <p>.carrier,
6956   i.e. x = p * z      for some z
6957          = q * u * z  given p = q * u
6958          = q * (u * z)
6959   Hence x IN <q>.carrier. Thus <p>.carrier SUBSET <q>.carrier.
6960   But u has |/u IN R    by ring_unit_inv_element
6961     p * |/u
6962   = q * u * |/u         given p = q * u
6963   = q * (u * |/u)       by ring_mult_assoc
6964   = q * #1              by ring_unit_rinv
6965   = q                   by ring_mult_rone
6966   Hence using the same argument gives <q>.carrier SUBSET <p>.carrier.
6967   or <p>.carrier = <q>.carrier    by SUBSET_ANTISYM
6968*)
6969Theorem principal_ideal_eq_principal_ideal:
6970    !r:'a ring. Ring r ==> !p q u. p IN R /\ q IN R /\ unit u /\ (p = q * u) ==> (<p> = <q>)
6971Proof
6972  rpt strip_tac >>
6973  `<p> << r` by rw[principal_ideal_ideal] >>
6974  `<q> << r` by rw[principal_ideal_ideal] >>
6975  `u IN R` by rw[ring_unit_element] >>
6976  `<p>.carrier = <q>.carrier` suffices_by metis_tac[ideal_eq_ideal] >>
6977  rw[principal_ideal_def, coset_def, EXTENSION, EQ_IMP_THM] >| [
6978    qexists_tac `u * z` >>
6979    rw[ring_mult_assoc],
6980    `|/u IN R` by rw[ring_unit_inv_element] >>
6981    qexists_tac `|/u * z` >>
6982    `q * u * ( |/ u * z) = q * (u * |/ u * z)` by rw[ring_mult_assoc] >>
6983    rw[ring_unit_rinv]
6984  ]
6985QED
6986(* Note: the converse can be proved only in integral domain. *)
6987
6988(* Theorem: i << r /\ p IN R ==> (p IN I <=> <p> << i) *)
6989(* Proof:
6990   First, <p> << r    by principal_ideal_ideal
6991   If part: p IN I ==> <p> << i
6992   By ideal_def, this is to show:
6993   (1) <p>.sum <= i.sum
6994       By Subgroup_def, this is to show:
6995       (a) Group <p>.sum, true by ideal_has_subgroup, Subgroup_def
6996       (b) Group i.sum, true by ideal_has_subgroup, Subgroup_def
6997       (c) <p>.carrier SUBSET I
6998           By principal_ideal_def, this is to show:
6999           p IN I /\ z IN R ==> p * z IN I, true by ideal_product_property
7000   (2) <p>.prod.id = i.prod.id
7001       <p>.prod.id = r.prod.id    by ideal_def
7002       i.prod.id = r.prod.id      by ideal_def
7003       Hence true.
7004   (3) x IN <p>.carrier /\ y IN I ==> x * y IN <p>.carrier
7005       Since y IN I ==> y IN R    by ideal_element_property
7006       This is true by ideal_product_property.
7007   (4) x IN <p>.carrier /\ y IN I ==> y * x IN <p>.carrier
7008       Since y IN I ==> y IN R    by ideal_element_property
7009       This is also true by ideal_product_property.
7010   Only-if part: p IN R /\ <p> << i ==> p IN I
7011     p IN <p>.carrier           by principal_ideal_has_element
7012     hence p IN i.sum.carrier   by ideal_element
7013     or p IN I since i.sum.carrier = I   by ideal_carriers.
7014*)
7015Theorem ideal_has_principal_ideal:
7016    !r i:'a ring. Ring r /\ i << r ==> !p. p IN R ==> (p IN I <=> (<p> << i))
7017Proof
7018  rpt strip_tac >>
7019  `<p> << r` by rw[principal_ideal_ideal] >>
7020  rw[EQ_IMP_THM] >| [
7021    `!j. j << r ==> (j.sum.carrier = J)` by metis_tac[ideal_carriers] >>
7022    `!j. j << r ==> (j.prod.carrier = J)` by metis_tac[ideal_carriers] >>
7023    `!j. j << r ==> (j.sum.op = r.sum.op)` by metis_tac[ideal_ops] >>
7024    `!j. j << r ==> (j.prod.op = r.prod.op)` by metis_tac[ideal_ops] >>
7025    rw[ideal_def] >| [
7026      `Group <p>.sum` by metis_tac[ideal_has_subgroup, Subgroup_def] >>
7027      `Group i.sum` by metis_tac[ideal_has_subgroup, Subgroup_def] >>
7028      rw[Subgroup_def] >>
7029      rw[principal_ideal_def, coset_def, SUBSET_DEF] >>
7030      rw[ideal_product_property],
7031      metis_tac[ideal_def],
7032      metis_tac[ideal_element_property, ideal_product_property],
7033      metis_tac[ideal_element_property, ideal_product_property]
7034    ],
7035    metis_tac[principal_ideal_has_element, ideal_element, ideal_carriers]
7036  ]
7037QED
7038
7039(* ------------------------------------------------------------------------- *)
7040(* Trivial Ideal                                                             *)
7041(* ------------------------------------------------------------------------- *)
7042
7043(* use overloading for ring ideal zero *)
7044Overload "<#0>" = ``principal_ideal r #0``
7045
7046(* Theorem: <#0>.carrier = {#0} *)
7047(* Proof: by definitions, this is to show:
7048   (1) z IN R ==> #0 * z = #0, true by ring_mult_lzero.
7049   (2) ?z. (#0 = #0 * z) /\ z IN R, let z = #0, true by ring_mult_zero_zero.
7050*)
7051Theorem zero_ideal_sing:
7052    !r:'a ring. Ring r ==> (<#0>.carrier = {#0})
7053Proof
7054  rw[principal_ideal_def, coset_def, EXTENSION, EQ_IMP_THM] >-
7055  rw[] >>
7056  metis_tac[ring_mult_zero_zero, ring_zero_element]
7057QED
7058
7059(* Theorem: <#0> << r *)
7060(* Proof:
7061   Since #0 IN R    by ring_zero_element
7062   This follows     by principal_ideal_ideal.
7063*)
7064Theorem zero_ideal_ideal:
7065    !r:'a ring. Ring r ==> <#0> << r
7066Proof
7067  rw[principal_ideal_ideal]
7068QED
7069
7070(* Theorem: SING I <=> i = <#0> *)
7071(* Proof: This is to show:
7072   (1) i << r /\ SING I ==> i = <#0>
7073       Since #0 IN I      by ideal_has_zero
7074       I = {#0}           by SING_DEF, IN_SING
7075         = <#0>.carrier   by zero_ideal_sing
7076       but <#0> << r      by zero_ideal_ideal
7077       hence i = <#0>     by ideal_eq_ideal
7078   (2) SING <#0>.carrier
7079       Since <#0>.carrier = {#0}   by zero_ideal_sing
7080       hence true                  by SING_DEF
7081*)
7082Theorem ideal_carrier_sing:
7083    !r i:'a ring. Ring r /\ i << r ==> (SING I <=> (i = <#0>))
7084Proof
7085  rw[EQ_IMP_THM] >| [
7086    `#0 IN I` by rw[ideal_has_zero] >>
7087    `I = {#0}` by metis_tac[SING_DEF, IN_SING] >>
7088    metis_tac[ideal_eq_ideal, zero_ideal_ideal, zero_ideal_sing],
7089    rw[zero_ideal_sing]
7090  ]
7091QED
7092
7093(* ------------------------------------------------------------------------- *)
7094(* Sum of Ideals                                                             *)
7095(* ------------------------------------------------------------------------- *)
7096
7097(* Define sum of ideals *)
7098Definition ideal_sum_def:
7099  ideal_sum (r:'a ring) (i:'a ring) (j:'a ring) =
7100      <| carrier := {x + y | x IN I /\ y IN J};
7101             sum := <| carrier := {x + y | x IN I /\ y IN J}; op := r.sum.op; id := r.sum.id |>;
7102            prod := <| carrier := {x + y | x IN I /\ y IN J}; op := r.prod.op; id := r.prod.id |>
7103       |>
7104End
7105Overload "+" = ``ideal_sum r``
7106
7107(* Theorem: x IN (i + j).carrier <=> ?y z. y IN I /\ z IN J /\ (x = y + z) *)
7108(* Proof: by definition. *)
7109Theorem ideal_sum_element:
7110    !(i:'a ring) (j:'a ring) x. x IN (i + j).carrier <=> ?y z. y IN I /\ z IN J /\ (x = y + z)
7111Proof
7112  rw[ideal_sum_def] >>
7113  metis_tac[]
7114QED
7115
7116(* Theorem: i << r /\ j << r ==> i + j = j + i *)
7117(* Proof:
7118   By ideal_sum_def, this is to show:
7119   {x + y | x IN I /\ y IN J} = {x + y | x IN J /\ y IN I}
7120   Since !z. z IN I ==> z IN R    by ideal_element_property
7121   This is true by ring_add_comm.
7122*)
7123Theorem ideal_sum_comm:
7124    !r i j:'a ring. Ring r /\ i << r /\ j << r ==> (i + j = j + i)
7125Proof
7126  rw[ideal_sum_def, EXTENSION] >>
7127  metis_tac[ideal_element_property, ring_add_comm]
7128QED
7129
7130(* Theorem: i << r /\ j << r ==>  Group (i + j).sum *)
7131(* Proof: by group definition, this is to show:
7132   for x = x' + y', y = x'' + y'', z = x''' + y''', x, y, z in (i + j).sum,
7133   Note !z. z IN I ==> z IN R /\ z IN J ==> z IN R     by ideal_element_property
7134   (1) ?x y. x IN I /\ y IN J /\ (x' + y' + (x'' + y'') = x + y)
7135       x' + y' + (x'' + y'') = (x' + x'') + (y' + y'')      by ring_add_assoc, ring_add_comm
7136       Let x = x' + x'', y = y' + y'', then x IN I, y IN J  by ideal_property
7137   (2) x' + y' + (x'' + y'') + (x''' + y''') = x' + y' + (x'' + y'' + (x''' + y'''))
7138       True by ring_add_assoc.
7139   (3) ?x y. x IN I /\ y IN J /\ (#0 = x + y)
7140       Let x = #0, y = #0, and #0 IN I, #0 IN J by ideal_has_zero.
7141       True by ring_add_zero_zero.
7142   (4) #0 + (x' + y) = x' + y
7143       True by ring_add_lzero.
7144   (5) x' IN J /\ y IN J ==> ?y'. (?x y. x IN I /\ y IN J /\ (y' = x + y)) /\ (y' + (x' + y) = #0)
7145       Let y' = -(x' + y) = -x' + -y   by ring_neg_add
7146       -x' IN I and -y IN J            by ideal_has_neg
7147       Hence true by ring_add_lneg.
7148*)
7149Theorem ideal_sum_group:
7150    !r i j:'a ring. Ring r /\ i << r /\ j << r ==> Group (i + j).sum
7151Proof
7152  rpt strip_tac >>
7153  (`!z. z IN {x + y | x IN I /\ y IN J} <=> ?x y. x IN I /\ y IN J /\ (z = x + y)` by (rw[] >> metis_tac[])) >>
7154  `!z. (z IN I ==> z IN R) /\ (z IN J ==> z IN R)` by metis_tac[ideal_element_property] >>
7155  rw_tac std_ss[ideal_sum_def, group_def_alt] >| [
7156    `x' + y' + (x'' + y'') = x' + (y' + x'' + y'')` by rw[ring_add_assoc] >>
7157    `_ = x' + (x'' + y' + y'')` by rw[ring_add_comm] >>
7158    `_ = (x' + x'') + (y' + y'')` by rw[ring_add_assoc] >>
7159    `x' + x'' IN I /\ y' + y'' IN J` by rw[ideal_property] >>
7160    metis_tac[],
7161    rw[ring_add_assoc],
7162    `#0 IN I /\ #0 IN J` by rw[ideal_has_zero] >>
7163    metis_tac[ring_add_zero_zero],
7164    rw[],
7165    `-(x' + y) = -x' + -y` by rw[ring_neg_add] >>
7166    `-x' IN I /\ -y IN J` by rw[ideal_has_neg] >>
7167    qexists_tac `-(x' + y)` >>
7168    rw[] >>
7169    metis_tac[]
7170  ]
7171QED
7172
7173(* Theorem: i << r /\ j << r ==> i.sum <= (i + j).sum *)
7174(* Proof: by Subgroup_def, this is to show:
7175   (1) Group i.sum,
7176       Since i.sum << r.sum   by ideal_def, true by Subgroup_def.
7177   (2) i << r /\ j << r ==> Group (i + j).sum
7178       True by ideal_sum_group.
7179   (3) i.sum.carrier SUBSET (i + j).sum.carrier
7180       i.e. x IN I ==> ?y. y IN J /\ x = x + y,
7181       so take y = #0, and #0 IN J by ideal_has_zero.
7182   (4) x IN I /\ y IN I ==> i.sum.op x y = (i + j).sum.op x y
7183       True by ideal_ops.
7184*)
7185Theorem ideal_subgroup_ideal_sum:
7186    !r i j:'a ring. Ring r /\ i << r /\ j << r ==> i.sum <= (i + j).sum
7187Proof
7188  rw[Subgroup_def] >| [
7189    metis_tac[ideal_def, Subgroup_def],
7190    rw[ideal_sum_group],
7191    rw[ideal_sum_def, SUBSET_DEF] >>
7192    metis_tac[ideal_def, ideal_has_zero, ring_add_rzero, ideal_element_property],
7193    rw[ideal_sum_def] >>
7194    metis_tac[ideal_ops]
7195  ]
7196QED
7197
7198(* Theorem: i << r /\ j << r ==> (i + j).sum <= r.sum *)
7199(* Proof: by Subgroup_def, this is to show:
7200   (1) Group (i + j).sum,
7201       True by ideal_sum_group.
7202   (2) (i + j).sum.carrier SUBSET R
7203       By ideal_sum_def, and SUBSET_DEF, this is to show:
7204       x' IN I /\ y IN J ==> x' + y IN R
7205       But x' IN R /\ y IN R   by ideal_element_property
7206       hence true by ring_add_element.
7207   (3) x IN (i + j).sum.carrier /\ y IN (i + j).sum.carrier ==> (i + j).sum.op x y = x + y
7208       True by ideal_sum_def.
7209*)
7210Theorem ideal_sum_subgroup:
7211    !r i j:'a ring. Ring r /\ i << r /\ j << r ==> (i + j).sum <= r.sum
7212Proof
7213  rw[Subgroup_def] >| [
7214    rw[ideal_sum_group],
7215    rw[ideal_sum_def, SUBSET_DEF] >>
7216    metis_tac[ideal_element_property, ring_add_element],
7217    rw[ideal_sum_def]
7218  ]
7219QED
7220
7221(* Theorem: i << r /\ j << r ==> i << i + j *)
7222(* Proof: by definition, this is to show:
7223   (1) i.sum <= (i + j).sum, true by ideal_subgroup_ideal_sum.
7224   (2) i.sum.carrier = I, true by ideal_def.
7225   (3) i.prod.carrier = I, true by ideal_def.
7226   (4) i.prod.op = (i + j).prod.op, true by ideal_sum_def, ideal_ops.
7227   (5) i.prod.id = (i + j).prod.id, true by ideal_sum_def, ideal_def.
7228   (6) x IN I /\ y IN (i + j).carrier ==> (i + j).prod.op x y IN I
7229       i.e. x * y IN I
7230       Since y IN (i + j).carrier, y IN R  by ideal_element_property, ring_add_element
7231       Hence x * y IN I by ideal_def.
7232   (7) x IN I /\ y IN (i + j).carrier ==> (i + j).prod.op y x IN I
7233       i.e. y * x IN I
7234       By same reasoning above, apply ring_mult_comm.
7235*)
7236Theorem ideal_sum_has_ideal:
7237    !r i j:'a ring. Ring r /\ i << r /\ j << r ==> i << (i + j)
7238Proof
7239  rpt strip_tac >>
7240  rw[ideal_def] >-
7241  rw[ideal_subgroup_ideal_sum] >-
7242  metis_tac[ideal_def] >-
7243  metis_tac[ideal_def] >-
7244 (rw[ideal_sum_def] >>
7245  metis_tac[ideal_ops]) >-
7246 (rw[ideal_sum_def] >>
7247  metis_tac[ideal_def]) >-
7248 (rw[ideal_sum_def] >>
7249  (`!z. z IN (i + j).carrier <=> ?x y. x IN I /\ y IN J /\ (z = x + y)` by (rw[ideal_sum_def] >> metis_tac[])) >>
7250  metis_tac[ideal_element_property, ring_add_element, ideal_def]) >>
7251  rw[ideal_sum_def] >>
7252  (`!z. z IN (i + j).carrier <=> ?x y. x IN I /\ y IN J /\ (z = x + y)` by (rw[ideal_sum_def] >> metis_tac[])) >>
7253  metis_tac[ideal_element_property, ring_add_element, ring_mult_comm, ideal_def]
7254QED
7255
7256(* Theorem: i << r /\ j << r ==> j << i + j *)
7257(* Proof: by ideal_sum_has_ideal and ideal_sum_comm. *)
7258Theorem ideal_sum_has_ideal_comm:
7259    !r i j:'a ring. Ring r /\ i << r /\ j << r ==> j << (i + j)
7260Proof
7261  metis_tac[ideal_sum_has_ideal, ideal_sum_comm]
7262QED
7263
7264(* Theorem: i << r /\ j << r ==> i + j << r *)
7265(* Proof: by definition, this is to show:
7266   (1) (i + j).sum <= r.sum, true by ideal_sum_subgroup.
7267   (2) (i + j).sum.carrier = (i + j).carrier, true by ideal_sum_def.
7268   (3) (i + j).prod.carrier = (i + j).carrier, true by ideal_sum_def.
7269   (4) (i + j).prod.op = $*, true by ideal_sum_def.
7270   (5) (i + j).prod.id = #1, true by ideal_sum_def.
7271   (6) x IN (i + j).carrier /\ y IN R ==> x * y IN (i + j).carrier
7272       Since x = p + q    with p IN I and q IN J
7273       x * y = (p + q) * y
7274             = p * y + q * y           by ring_mult_ladd
7275       But p * y IN I and q * y IN J   by ideal_def
7276       hence x * y IN (i + j).carrier.
7277   (7) x IN (i + j).carrier /\ y IN R ==> y * x IN (i + j).carrier
7278       Same reasoning above, using ring_mult_radd.
7279*)
7280Theorem ideal_sum_ideal:
7281    !r i j:'a ring. Ring r /\ i << r /\ j << r ==> (i + j) << r
7282Proof
7283  rpt strip_tac >>
7284  rw[ideal_def] >| [
7285    rw[ideal_sum_subgroup],
7286    rw[ideal_sum_def],
7287    rw[ideal_sum_def],
7288    rw[ideal_sum_def],
7289    rw[ideal_sum_def],
7290    (`!z. z IN (i + j).carrier <=> ?x y. x IN I /\ y IN J /\ (z = x + y)` by (rw[ideal_sum_def] >> metis_tac[])) >>
7291    `!z. (z IN I ==> z IN R) /\ (z IN J ==> z IN R)` by metis_tac[ideal_element_property] >>
7292    `?p q. p IN I /\ q IN J /\ (x = p + q)` by metis_tac[] >>
7293    `x * y = (p + q) * y` by rw[] >>
7294    `_ = p * y + q * y` by rw[ring_mult_ladd] >>
7295    `p * y IN I /\ q * y IN J` by metis_tac[ideal_def] >>
7296    metis_tac[],
7297    (`!z. z IN (i + j).carrier <=> ?x y. x IN I /\ y IN J /\ (z = x + y)` by (rw[ideal_sum_def] >> metis_tac[])) >>
7298    `!z. (z IN I ==> z IN R) /\ (z IN J ==> z IN R)` by metis_tac[ideal_element_property] >>
7299    `?p q. p IN I /\ q IN J /\ (x = p + q)` by metis_tac[] >>
7300    `y * x = y * (p + q)` by rw[] >>
7301    `_ = y * p + y * q` by rw[ring_mult_radd] >>
7302    `y * p IN I /\ y * q IN J` by metis_tac[ideal_def] >>
7303    metis_tac[]
7304  ]
7305QED
7306
7307(* Theorem: i << r /\ j << r ==> (i + j << j <=> i << j) *)
7308(* Proof:
7309   By ideal_sub_ideal, this is to show:
7310   (i + j).carrier SUBSET J <=> I SUBSET J
7311   Expand by ideal_sum_element, this is to show:
7312   (1) x IN I /\ !x. (?y z. y IN I /\ z IN J /\ (x = y + z)) ==> x IN J ==> x IN J ==> x IN J
7313       x IN I ==> x IN R                      by ideal_element_property
7314       j << r ==> #0 IN J                     by ideal_has_zero
7315       x = x + #0                             by ring_add_rzero
7316       Hence x IN (i + j).carrier             by ideal_sum_element
7317       and x IN J                             by given implication
7318   (2) y IN I /\ z IN J /\ !x. x IN I ==> x IN J ==> y + z IN J
7319       y IN I ==> y IN J                      by implication
7320       Hence y + z IN J                       by ideal_property
7321*)
7322Theorem ideal_sum_sub_ideal:
7323    !r i j:'a ring. Ring r /\ i << r /\ j << r ==> ((i + j) << j <=> i << j)
7324Proof
7325  rpt strip_tac >>
7326  `(i + j) << r` by rw[ideal_sum_ideal] >>
7327  `(i + j).carrier SUBSET J <=> I SUBSET J` suffices_by metis_tac[ideal_sub_ideal] >>
7328  rw[ideal_sum_element, SUBSET_DEF, EQ_IMP_THM] >| [
7329    `x IN R /\ #0 IN J` by metis_tac[ideal_element_property, ideal_has_zero] >>
7330    `x = x + #0` by rw[] >>
7331    metis_tac[],
7332    rw[ideal_property]
7333  ]
7334QED
7335
7336(* Theorem: i << r /\ p IN I ==> <p> + i = i *)
7337(* Proof:
7338   Since i << r,
7339         p IN I ==> p IN R    by ideal_element_property
7340   thus  <p> << r             by principal_ideal_ideal
7341   and   <p> + i << r         by ideal_sum_ideal
7342   By ideal_eq_ideal, only need to show:
7343     (<p> + i).carrier = I
7344   By ideal_sum_def, need to show:
7345   (1) x' IN <p>.carrier /\ y IN I ==> x' + y IN I
7346       Since ?z. z IN R /\ (x' = p * z)  by principal_ideal_element
7347       x' IN I by ideal_product_property (or ideal_def)
7348       thus x' + y IN I by ideal_property.
7349   (2) p IN I /\ x IN I ==> ?x' y. (x = x' + y) /\ x' IN <p>.carrier /\ y IN I
7350       Since x = #0 + x      by ring_add_lzero
7351       and #0 IN <p>.carrier by principal_ideal_ideal, ideal_has_zero
7352       Let x' = #0, y = x, hence true.
7353*)
7354Theorem principal_ideal_sum_eq_ideal:
7355    !r i:'a ring. Ring r /\ i << r ==> !p. p IN I ==> (<p> + i = i)
7356Proof
7357  rpt strip_tac >>
7358  `<p> << r` by metis_tac[principal_ideal_ideal, ideal_element_property] >>
7359  `(<p> + i) << r` by rw[ideal_sum_ideal] >>
7360  `(<p> + i).carrier = I` suffices_by metis_tac[ideal_eq_ideal] >>
7361  rw[ideal_sum_def, EXTENSION, EQ_IMP_THM] >| [
7362    `?z. z IN R /\ (x' = p * z)` by metis_tac[principal_ideal_element] >>
7363    metis_tac[ideal_def, ideal_property],
7364    `!z. z IN I ==> z IN R` by metis_tac[ideal_element_property] >>
7365    `x = #0 + x` by rw[] >>
7366    metis_tac[principal_ideal_ideal, ideal_has_zero]
7367  ]
7368QED
7369
7370(* Theorem: i << r /\ p IN I <=> p IN R /\ (<p> + i = i) *)
7371(* Proof:
7372   If part: i << r /\ p IN I ==> p IN R /\ (<p> + i = i)
7373     the part: p IN I ==> p IN R, true by ideal_element_property.
7374     the part: p IN I ==> <p> + i = i, true by principal_ideal_sum_eq_ideal.
7375   Only-if part: i << r /\ p IN R /\ (<p> + i = i) ==> p IN I
7376     Since <p> << r                  by principal_ideal_ideal
7377     <p> << (<p> + i)                by ideal_sum_has_ideal
7378         p IN <p>.carrier            by principal_ideal_has_element
7379     ==> p IN (<p> + i).sum.carrier  by ideal_element
7380     or  p IN (<p> + i).carrier      by ideal_carriers
7381     ==> p IN I                      by given: <p> + i = i
7382*)
7383Theorem principal_ideal_sum_equal_ideal:
7384    !r i:'a ring. Ring r /\ i << r ==> (!p. p IN I <=> p IN R /\ (<p> + i = i))
7385Proof
7386  rw[EQ_IMP_THM] >-
7387  metis_tac[ideal_element_property] >-
7388  rw[principal_ideal_sum_eq_ideal] >>
7389  `<p> << r` by rw[principal_ideal_ideal] >>
7390  `<p> << (<p> + i)` by rw[ideal_sum_has_ideal] >>
7391  `p IN <p>.carrier` by rw[principal_ideal_has_element] >>
7392  `p IN (<p> + i).carrier` by metis_tac[ideal_element, ideal_carriers] >>
7393  metis_tac[]
7394QED
7395
7396(* ------------------------------------------------------------------------- *)
7397(* Maximal Ideals                                                            *)
7398(* ------------------------------------------------------------------------- *)
7399
7400(* Define maximal ideal *)
7401Definition ideal_maximal_def:
7402  ideal_maximal (r:'a ring) (i:'a ring) <=>
7403    (i << r) /\
7404    (!j:'a ring. i << j /\ j << r ==> (i = j) \/ (j = r))
7405End
7406
7407(* use overloading *)
7408Overload maxi = ``ideal_maximal r``
7409
7410(* ------------------------------------------------------------------------- *)
7411(* Irreduicables in Ring                                                     *)
7412(* ------------------------------------------------------------------------- *)
7413
7414(* A ring element is irreducible if it is non-zero and non-unit, and its only factors are trivial. *)
7415Definition irreducible_def:
7416  irreducible (r:'a ring) (z:'a) <=>
7417    (z IN R+) /\ ~(unit z) /\
7418    (!x y. x IN R /\ y IN R /\ (z = x * y) ==> (unit x) \/ (unit y))
7419End
7420
7421(* use overloading *)
7422Overload atom = ``irreducible r``
7423
7424(*
7425- irreducible_def;
7426> val it = |- !r z. atom z <=> z IN R+ /\ z NOTIN R* /\ !x y. x IN R /\ y IN R /\ (z = x * y) ==> unit x \/ unit y : thm
7427*)
7428
7429(* Theorem: atom p ==> p IN R *)
7430(* Proof:
7431   atom p ==> p IN R+       by irreducible_def
7432          ==> p IN R        by ring_nonzero_element
7433*)
7434Theorem irreducible_element:
7435    !r:'a ring. !p. atom p ==> p IN R
7436Proof
7437  rw[irreducible_def, ring_nonzero_element]
7438QED
7439
7440(* ------------------------------------------------------------------------- *)
7441(* Principal Ideal Ring                                                      *)
7442(* ------------------------------------------------------------------------- *)
7443
7444(* A principal ideal ring = a ring with all ideals being principal ideals. *)
7445Definition PrincipalIdealRing_def:
7446  PrincipalIdealRing (r:'a ring) <=>
7447    (Ring r) /\
7448    (!(i:'a ring). i << r ==> ?p. p IN R /\ (<p> = i))
7449End
7450(*
7451> val PrincipalIdealRing_def = |- !r. PrincipalIdealRing r <=> Ring r /\ !i. i << r ==> ?p. p IN R /\ (<p> = i)
7452*)
7453
7454(* Theorem: For a principal ideal ring, an irreducible element generates a maximal ideal *)
7455(* Proof:
7456   By definitions, this is to show:
7457   (1) p IN R+ ==>  <p> << r,
7458       p IN R+ ==> p IN R           by ring_nonzero_element
7459       Hence true                   by principal_ideal_ideal.
7460   (2) <p> << j /\ j << r ==> (<p> = j) \/ (j = r)
7461      Since r is a principal ring, ?q. q IN R /\ (<q> = j).
7462      p IN R+ ==> p IN R            by ring_nonzero_element
7463      p IN <p>.carrier              by principal_ideal_has_element
7464      p IN <q>.carrier              by ideal_element
7465      so ?u. u IN R /\ (p = q * u)  by principal_ideal_element
7466      hence unit q or unit u        by ideal_maximal_def
7467      If unit q,
7468        Since q IN <q>.carrier      by principal_ideal_has_element
7469         unit q IN <q>.carrier
7470        hence <q> = j = r           by ideal_with_unit
7471      If unit u,
7472        <p> = <q>                   by principal_ideal_eq_principal_ideal.
7473*)
7474Theorem principal_ideal_ring_ideal_maximal:
7475    !r:'a ring. PrincipalIdealRing r ==> !p. atom p ==> maxi <p>
7476Proof
7477  rw[PrincipalIdealRing_def, irreducible_def, ideal_maximal_def] >-
7478  rw[principal_ideal_ideal, ring_nonzero_element] >>
7479  `?q. q IN R /\ (<q> = j)` by rw[] >>
7480  `p IN R` by rw[ring_nonzero_element] >>
7481  `p IN <p>.carrier` by rw[principal_ideal_has_element] >>
7482  `p IN <q>.carrier` by metis_tac[ideal_element, principal_ideal_property] >>
7483  `?u. u IN R /\ (p = q * u)` by metis_tac[principal_ideal_element] >>
7484  `unit q \/ unit u` by rw[] >-
7485  metis_tac[principal_ideal_has_element, ideal_with_unit] >>
7486  metis_tac[principal_ideal_eq_principal_ideal]
7487QED
7488
7489(* ------------------------------------------------------------------------- *)
7490(* Euclidean Ring                                                            *)
7491(* ------------------------------------------------------------------------- *)
7492
7493(* A Euclidean Ring is a ring with a norm function f for division algorithm. *)
7494Definition EuclideanRing_def:
7495  EuclideanRing (r:'a ring) (f:'a -> num) <=>
7496    (Ring r) /\
7497    (!x. (f x = 0) <=> (x = #0)) /\
7498    (!x y:'a. x IN R /\ y IN R /\ y <> #0 ==>
7499     ?q t:'a. q IN R /\ t IN R /\ (x = q * y + t) /\ f(t) < f(y))
7500End
7501
7502(* Theorem: EuclideanRing r ==> Ring r *)
7503Theorem euclid_ring_ring =
7504    EuclideanRing_def |> SPEC_ALL |> #1 o EQ_IMP_RULE
7505                   |> UNDISCH_ALL |> CONJUNCT1 |> DISCH_ALL |> GEN_ALL;
7506(* > val euclid_ring_ring = |- !r f. EuclideanRing r f ==> Ring r : thm *)
7507
7508(* Theorem: EuclideanRing r ==> !x. (f x = 0) <=> (x = #0) *)
7509Theorem euclid_ring_map =
7510    EuclideanRing_def |> SPEC_ALL |> #1 o EQ_IMP_RULE
7511                   |> UNDISCH_ALL |> CONJUNCT2 |> CONJUNCT1 |> DISCH_ALL |> GEN_ALL;
7512(* > val euclid_ring_map = |- !r f. EuclideanRing r f ==> !x. (f x = 0) <=> (x = #0) : thm *)
7513
7514(* Theorem: EuclideanRing property:
7515            !x y. x IN R /\ y IN R /\ y <> #0 ==> ?q t. q IN R /\ t IN R /\ (x = q * y + t) /\ f t < f y  *)
7516(* Proof: by EuclideanRing_def. *)
7517(*
7518val euclid_ring_property = store_thm(
7519  "euclid_ring_property",
7520  ``!r:'a ring. !f. EuclideanRing r f ==>
7521   !x y. x IN R /\ y IN R /\ y <> #0 ==> ?q t. q IN R /\ t IN R /\ (x = y * q + t) /\ f t < f y``,
7522  rw[EuclideanRing_def]); -- Note: not by metis_tac!
7523*)
7524Theorem euclid_ring_property =
7525    EuclideanRing_def |> SPEC_ALL |> #1 o EQ_IMP_RULE
7526                      |> UNDISCH_ALL |> CONJUNCTS |> last |> DISCH_ALL |> GEN_ALL;
7527(* > val euclid_ring_property = |- !r f.  EuclideanRing r f ==> !x y. x IN R /\ y IN R /\ y <> #0 ==>
7528                                ?q t. q IN R /\ t IN R /\ (x = q * y + t) /\ f t < f y : thm *)
7529
7530(* Theorem: ideal generator exists:
7531            Ring r /\ i << r /\ i <> <#0> ==> !f. (!x. (f x = 0) <=> (x = #0))
7532            ==> ?p. p IN I /\ p <> #0 /\ !z. z IN I /\ f z < f p ==> z = #0        *)
7533(* Proof:
7534   Since #0 IN R,            by ring_zero_element
7535   <#0> << r                 by principal_ideal_ideal
7536   Since <#0>.carrier = {#0} by zero_ideal_sing
7537   i.carrier <> {#0}         by ideal_eq_ideal
7538   Since #0 IN I,            by ideal_has_zero
7539   there is x IN I, x <> #0  by ONE_ELEMENT_SING
7540   and f x <> 0              by condition on f
7541   Thus f x IN s, where s = IMAGE f I DELETE 0
7542   Let p IN I such that f p = MIN_SET s
7543   then for any z IN s,
7544   z IN I /\ z <> #0         by IN_IMAGE
7545   and  f p <= f z           by MIN_SET_LEM
7546*)
7547Theorem ideal_gen_exists:
7548    !r i:'a ring. Ring r /\ i << r /\ i <> <#0> ==> !f:'a -> num. (!x. (f x = 0) <=> (x = #0))
7549    ==> ?p. p IN I /\ p <> #0 /\ !z. z IN I /\ z <> #0 ==> f p <= f z
7550Proof
7551  rpt strip_tac >>
7552  `<#0> << r` by rw[principal_ideal_ideal] >>
7553  `i.carrier <> {#0}` by metis_tac[ideal_eq_ideal, zero_ideal_sing] >>
7554  `?x. x IN I /\ x <> #0` by metis_tac[ONE_ELEMENT_SING, ideal_has_zero, MEMBER_NOT_EMPTY] >>
7555  `f x IN (IMAGE f I)` by rw[] >>
7556  `f x <> 0` by rw[] >>
7557  `IMAGE f I DELETE 0 <> {}` by metis_tac[IN_DELETE, MEMBER_NOT_EMPTY] >>
7558  qabbrev_tac `s = IMAGE f I DELETE 0` >>
7559  `MIN_SET s IN s /\ !x. x IN s ==> MIN_SET s <= x` by metis_tac[MIN_SET_LEM] >>
7560  `?p. p IN I /\ p <> #0 /\ (f p = MIN_SET s)` by metis_tac[IN_IMAGE, IN_DELETE] >>
7561  metis_tac[IN_IMAGE, IN_DELETE]
7562QED
7563
7564(* Apply Skolemization *)
7565Theorem lemma[local]:
7566    !r i f. ?p. Ring r /\ i << r /\ i <> <#0> /\ (!x. (f x = 0) <=> (x = #0))
7567       ==> p IN I /\ p <> #0 /\ !z. z IN I /\ z <> #0 ==> f p <= f z
7568Proof
7569  metis_tac[ideal_gen_exists]
7570QED
7571(*
7572- SKOLEM_THM;
7573> val it = |- !P. (!x. ?y. P x y) <=> ?f. !x. P x (f x) : thm
7574*)
7575(* Define ideal generator *)
7576(*
7577- SIMP_RULE (srw_ss()) [SKOLEM_THM] lemma;
7578> val it = |- ?f. !r i f'.
7579           Ring r /\ i << r /\ i <> <#0> /\ (!x. (f' x = 0) <=> (x = #0)) ==>
7580           f r i f' IN I /\ f r i f' <> #0 /\ !z. z IN I /\ z <> #0 ==> f' (f r i f') <= f' z : thm
7581*)
7582val ideal_gen_def = new_specification(
7583    "ideal_gen_def",
7584    ["ideal_gen"],
7585    SIMP_RULE (srw_ss()) [SKOLEM_THM] lemma
7586    |> CONV_RULE (RENAME_VARS_CONV ["h", "r", "i", "f"])); (* replace f r i f' by h r i f *)
7587(* val ideal_gen_def = |- !r i f. Ring r /\ i << r /\ i <> <#0> /\ (!x. (f x = 0) <=> (x = #0)) ==>
7588        ideal_gen r i f IN I /\ ideal_gen r i f <> #0 /\ !z. z IN I /\ z <> #0 ==> f (ideal_gen r i f) <= f z : thm *)
7589
7590(* Theorem: property of ideal generator:
7591            !z. z IN I ==> (f z < f (ideal_gen r i f) <=> z = #0) *)
7592(* Proof:
7593   If part: f z < f (ideal_gen r i f) ==> z = #0
7594     By contradicton, assume z <> #0,
7595     then f (ideal_gen r i f) <= f z   by ideal_gen_def
7596     which contradicts f z < f (ideal_gen r i f).
7597   Only-if part: z = #0 ==> f z < f (ideal_gen r i f)
7598     (ideal_gen r i f) <> #0           by ideal_gen_def
7599     hence f (ideal_gen r i f) <> 0    by given f: f x = 0 <=> x = #0
7600     Since f #0 = 0                    by given f above
7601     This is true.
7602*)
7603Theorem ideal_gen_minimal:
7604    !r i:'a ring. Ring r /\ i << r /\ i <> <#0> ==> !f:'a -> num. (!x. (f x = 0) <=> (x = #0))
7605   ==> !z. z IN I ==> (f z < f (ideal_gen r i f) <=> (z = #0))
7606Proof
7607  rw[ideal_gen_def, EQ_IMP_THM] >| [
7608    spose_not_then strip_assume_tac >>
7609    `f (ideal_gen r i f) <= f z` by metis_tac[ideal_gen_def] >>
7610    decide_tac,
7611    `(ideal_gen r i f) <> #0` by metis_tac[ideal_gen_def] >>
7612    `f (ideal_gen r i f) <> 0 /\ (f #0 = 0)` by metis_tac[] >>
7613    decide_tac
7614  ]
7615QED
7616
7617(* Theorem: EuclideanRing f r ==> PrincipalIdealRing r *)
7618(* Proof:
7619   First,
7620   EuclideanRing r f ==> Ring r by EuclideanRing_def
7621   By PrincipalIdealRing_def, this is to show:
7622     !i. i << r ==> ?p. p IN R /\ (<p> = i)
7623   If i = <#0>, it is generated by #0.
7624   If i <> <#0>,
7625   Let p = ideal_gen r i f
7626   Then p IN I /\ p <> #0       by ideal_gen_def
7627   and for any x IN I, x IN R   by ideal_element_property
7628   By EuclideanRing_Def,
7629   there exists y IN R, t IN R
7630   such that  x = y * p + t     with (f t) < (f p)
7631   or  x = p * y + t            by ring_mult_comm
7632   Since p * y IN I             by ideal_product_property
7633   t = x - p * y IN I           by ideal_has_diff
7634   Thus t = #0                  by ideal_gen_minimal
7635   or x = p * y,
7636   so x IN <p>.carrier          by principal_ideal_element
7637   i.e. I SUBSET <p>.carrier    by SUBSET_DEF
7638   On the other hand,
7639   p IN I ==> <p> << i          by ideal_has_principal_ideal
7640   so !x IN <p>.carrier ==> x IN I   by ideal_element
7641   i.e. <p>.carrier SUBSET I    by SUBSET_DEF
7642   so <p>.carrier = I           by SUBSET_ANTISYM
7643   Hence <p> = i                by ideal_eq_ideal.
7644*)
7645Theorem euclid_ring_principal_ideal_ring:
7646    !r:'a ring. !f. EuclideanRing r f ==> PrincipalIdealRing r
7647Proof
7648  rw[EuclideanRing_def, PrincipalIdealRing_def] >>
7649  Cases_on `i = <#0>` >-
7650  metis_tac[ring_zero_element] >>
7651  `!z. z IN I ==> z IN R` by metis_tac[ideal_element_property] >>
7652  `ideal_gen r i f IN I /\ ideal_gen r i f <> #0` by metis_tac[ideal_gen_def] >>
7653  `!z. z IN I ==> (f z < f (ideal_gen r i f) <=> (z = #0))` by rw[ideal_gen_minimal] >>
7654  qabbrev_tac `p = ideal_gen r i f` >>
7655  `<p> << r` by rw[principal_ideal_ideal] >>
7656  qexists_tac `p` >>
7657  rw[] >>
7658  `<p>.carrier = I` suffices_by metis_tac[ideal_eq_ideal] >>
7659  rw[principal_ideal_def, coset_def, EXTENSION, EQ_IMP_THM] >-
7660  metis_tac[ideal_product_property] >>
7661  `?q t. q IN R /\ t IN R /\ (x = q * p + t) /\ f t < f p` by rw[] >>
7662  `x = p * q + t` by rw[ring_mult_comm] >>
7663  `p * q IN I` by metis_tac[ideal_product_property] >>
7664  `t = x - p * q` by metis_tac[ring_sub_eq_add] >>
7665  `t IN I` by rw[ideal_has_diff] >>
7666  `t = #0` by metis_tac[ideal_gen_minimal] >>
7667  `x = p * q` by rw[] >>
7668  metis_tac[]
7669QED
7670
7671(* ------------------------------------------------------------------------- *)
7672(* Ideal under Ring Homomorphism                                             *)
7673(* ------------------------------------------------------------------------- *)
7674
7675(* Homomorphic image of ideal *)
7676(*
7677val homo_ideal_def = Define`
7678  homo_ideal (f:'a -> 'b) (r:'a ring) (i:'a ring) =
7679    <| carrier := IMAGE f I;
7680           sum := <| carrier := IMAGE f I; op := image_op i.sum f; id := f #0 |>;
7681          prod := <| carrier := IMAGE f I; op := image_op i.prod f; id := f #1 |>
7682     |>
7683`;
7684*)
7685Definition homo_ideal_def:
7686  homo_ideal (f:'a -> 'b) (r:'a ring) (s:'b ring) (i:'a ring) =
7687    <| carrier := IMAGE f I;
7688           sum := <| carrier := IMAGE f I; op := s.sum.op; id := f #0 |>;
7689          prod := <| carrier := IMAGE f I; op := s.prod.op; id := f #1 |>
7690     |>
7691End
7692
7693(* Theorem: RingHomo f r s /\ i << r ==> Group (homo_ideal f r s i).sum *)
7694(* Proof: checking group axioms:
7695   (1) x IN IMAGE f I /\ y IN IMAGE f I ==> s.sum.op x y IN IMAGE f I
7696       Let p = CHOICE (preimage f I x),
7697           q = CHOICE (preimage f I y)
7698       then p IN I /\ f p = x    by preimage_choice_property
7699        and q IN I /\ f q = y    by preimage_choice_property
7700       Since  p + q IN I         by ideal_property
7701         f (p + q) IN IMAGE f I
7702       but f (p + q)
7703       = s.sum.op (f p) (f q)    by RingHomo_def and GroupHomo_def.
7704   (2) x IN IMAGE f I /\ y IN IMAGE f I /\ z IN IMAGE f I ==> s.sum.op (s.sum.op x y) z = s.sum.op x (s.sum.op y z)
7705       Let p = CHOICE (preimage f I x)
7706       Let q = CHOICE (preimage f I y)
7707       Let t = CHOICE (preimage f I z)
7708       Then p IN I /\ (f p = x)    by preimage_choice_property
7709            q IN I /\ (f q = y)    by preimage_choice_property
7710            t IN I /\ (f t = z)    by preimage_choice_property
7711       Since !z. z IN I ==> z IN R   by ideal_element_property
7712       and   !z. z IN R ==> f z IN s.carrier by RingHomo_def
7713       This is true by ring_add_assoc.
7714   (3) f #0 IN IMAGE f I
7715       Since #O IN I    by ideal_has_zero, this is true.
7716   (4) s.sum.op (f #0) x = x
7717       Let p = CHOICE (preimage f I x)
7718       then p IN I /\ f p = x    by preimage_choice_property
7719         s.sum.op (f #0) x
7720       = f (#0 + p)              by RingHomo_def, GroupHomo_def
7721       = f p = x                 by ring_add_lzero
7722   (5) ?y. y IN IMAGE f I /\ (s.sum.op y x = f #0)
7723       Let p = CHOICE (preimage f I x)
7724       Then   p IN I /\ (f p = x)       by preimage_choice_property
7725       Hence    -p IN I                 by ideal_has_neg
7726       and  f (-p) IN IMAGE f I
7727       Let y = f (-p), then
7728         s.sum.op y x
7729       = s.sum.op (f (-p)) (f p)
7730       = f (-p + p)                     by RingHomo_def, GroupHomo_def
7731       = f #0                           by ring_add_lneg
7732*)
7733Theorem ring_homo_ideal_group:
7734    !(r:'a ring) (s:'b ring) f.  Ring r /\ Ring s /\ RingHomo f r s ==> !i. i << r ==> Group (homo_ideal f r s i).sum
7735Proof
7736  rpt strip_tac >>
7737  `r.sum.carrier = R` by rw[] >>
7738  `!z. z IN I ==> z IN R` by metis_tac[ideal_element_property] >>
7739  `i.sum.carrier = I` by metis_tac[ideal_def] >>
7740  `i.sum.op = r.sum.op` by metis_tac[ideal_ops] >>
7741  `GroupHomo f r.sum s.sum` by metis_tac[RingHomo_def] >>
7742  `!x y. x IN R /\ y IN R ==> (f (x + y) = s.sum.op (f x) (f y))` by metis_tac[GroupHomo_def] >>
7743  `!z. z IN R ==> f z IN s.carrier` by metis_tac[RingHomo_def] >>
7744  `s.sum.id = f #0` by rw[ring_homo_zero] >>
7745  rw_tac std_ss[homo_ideal_def, group_def_alt] >| [
7746    qabbrev_tac `p = CHOICE (preimage f I x)` >>
7747    qabbrev_tac `q = CHOICE (preimage f I y)` >>
7748    `p IN I /\ (f p = x)` by rw[preimage_choice_property, Abbr`p`] >>
7749    `q IN I /\ (f q = y)` by rw[preimage_choice_property, Abbr`q`] >>
7750    `p + q IN I` by rw[ideal_property] >>
7751    `f (p + q) IN IMAGE f I` by rw[] >>
7752    metis_tac[],
7753    qabbrev_tac `p = CHOICE (preimage f I x)` >>
7754    qabbrev_tac `q = CHOICE (preimage f I y)` >>
7755    qabbrev_tac `t = CHOICE (preimage f I z)` >>
7756    `p IN I /\ (f p = x)` by rw[preimage_choice_property, Abbr`p`] >>
7757    `q IN I /\ (f q = y)` by rw[preimage_choice_property, Abbr`q`] >>
7758    `t IN I /\ (f t = z)` by rw[preimage_choice_property, Abbr`t`] >>
7759    rw[ring_add_assoc],
7760    rw[ideal_has_zero],
7761    qabbrev_tac `p = CHOICE (preimage f I x)` >>
7762    `p IN I /\ (f p = x)` by rw[preimage_choice_property, Abbr`p`] >>
7763    metis_tac[ring_add_lzero],
7764    qabbrev_tac `p = CHOICE (preimage f I x)` >>
7765    `p IN I /\ (f p = x)` by rw[preimage_choice_property, Abbr`p`] >>
7766    `-p IN I` by rw[ideal_has_neg] >>
7767    `f (-p) IN IMAGE f I` by rw[] >>
7768    qexists_tac `f (-p)` >>
7769    metis_tac[ring_add_lneg]
7770  ]
7771QED
7772
7773(* Theorem: RingHomo f r s /\ i << r ==> (homo_ideal f r s i).sum <= s.sum *)
7774(* Proof: by Subgroup_def, this is to show:
7775   (1) Group (homo_ideal f r s i).sum
7776       True by ring_homo_ideal_group.
7777   (2) (homo_ideal f r s i).sum.carrier SUBSET s.carrier
7778       i.e. to show: IMAGE f I SUBSET s.carrier
7779       Since !x. x IN I ==> x IN R            by ideal_element_property
7780       and   !x. x IN R ==> f x IN s.carrier  by RingHomo_def
7781       This is true by SUBSET_DEF.
7782   (3) (homo_ideal f r s i).sum.op = s.sum.op
7783*)
7784Theorem ring_homo_ideal_subgroup:
7785    !(r:'a ring) (s:'b ring) f.  Ring r /\ Ring s /\ RingHomo f r s ==> !i. i << r ==> (homo_ideal f r s i).sum <= s.sum
7786Proof
7787  rw[Subgroup_def] >| [
7788    rw[ring_homo_ideal_group],
7789    rw[homo_ideal_def] >>
7790    rw[SUBSET_DEF] >>
7791    metis_tac[ideal_element_property, RingHomo_def],
7792    rw[homo_ideal_def]
7793  ]
7794QED
7795
7796(* Theorem: Ring homomorphic image of an ideal is still an ideal of the target ring, if the map is surjective.
7797            RingHomo f r s /\ SURJ f R s.carrier ==> !i. i << r ==> (homo_ideal f r s i) << s  *)
7798(* Proof: by ideal_def, this is to show:
7799   (1) (homo_ideal f r s i).sum <= s.sum
7800       True by ring_homo_ideal_subgroup.
7801   (2) (homo_ideal f r s i).sum.carrier = (homo_ideal f r s i).carrier
7802       True by homo_ideal_def.
7803   (3) (homo_ideal f r s i).prod.carrier = (homo_ideal f r s i).carrier
7804       True by homo_ideal_def.
7805   (4) (homo_ideal f r s i).prod.op = s.prod.op
7806       True by homo_ideal_def.
7807   (5) (homo_ideal f r s i).prod.id = s.prod.id
7808       True by homo_ideal_def, ring_homo_one.
7809   -- so far, no need for surjective, but the next two require surjective.
7810   (6) x IN (homo_ideal f r s i).carrier /\ y IN s.carrier ==> s.prod.op x y IN (homo_ideal f r s i).carrier
7811       or, by homo_ideal_def, this is to show:
7812       x IN IMAGE f I /\ y IN s.carrier ==> s.prod.op x y IN IMAGE f I
7813       y IN s.carrier = IMAGE f R   by IMAGE_SURJ, due to SURJ f R s.carrier
7814       Let p = CHOICE (preimage f I x),
7815           q = CHOICE (preimage f R y)
7816       Then  p IN I /\ (f p = x)   by preimage_choice_property
7817             q IN R /\ (f q = y)   by preimage_choice_property
7818         s.prod.op x y
7819       = s.prod.op (f p) (f q)
7820       = f (p * q)                 by RingHomo_def, MonoidHomo_def
7821       Since  p * q IN I           by ideal_def
7822       f (p * q) IN IMAGE f I, hence true
7823   (7) x IN (homo_ideal f r s i).carrier /\ y IN s.carrier ==> s.prod.op y x IN (homo_ideal f r s i).carrier
7824       Same as (7), apply ring_mult_comm.
7825*)
7826Theorem ring_homo_ideal_ideal:
7827    !(r:'a ring) (s:'b ring) f. Ring r /\ Ring s /\ RingHomo f r s /\ SURJ f R s.carrier ==>
7828     !i. i << r ==> (homo_ideal f r s i) << s
7829Proof
7830  rpt strip_tac >>
7831  `r.prod.carrier = R` by metis_tac[Ring_def] >>
7832  `MonoidHomo f r.prod s.prod` by metis_tac[RingHomo_def] >>
7833  `!x y. x IN R /\ y IN R ==> (f (x * y) = s.prod.op (f x) (f y))` by metis_tac[MonoidHomo_def] >>
7834  `!z. z IN R ==> f z IN s.carrier` by metis_tac[RingHomo_def] >>
7835  `(homo_ideal f r s i).carrier = IMAGE f I` by rw[homo_ideal_def] >>
7836  `IMAGE f R = s.carrier` by rw[GSYM IMAGE_SURJ] >>
7837  rw_tac std_ss[ideal_def] >-
7838  rw[ring_homo_ideal_subgroup] >-
7839  rw[homo_ideal_def] >-
7840  rw[homo_ideal_def] >-
7841  rw[homo_ideal_def] >-
7842  rw[homo_ideal_def, ring_homo_one] >-
7843 (`y IN IMAGE f R` by metis_tac[] >>
7844  qabbrev_tac `p = CHOICE (preimage f I x)` >>
7845  qabbrev_tac `q = CHOICE (preimage f R y)` >>
7846  `p IN I /\ (f p = x)` by rw[preimage_choice_property, Abbr`p`] >>
7847  `q IN R /\ (f q = y)` by rw[preimage_choice_property, Abbr`q`] >>
7848  `s.prod.op x y = f (p * q)` by metis_tac[ideal_element_property] >>
7849  `p * q IN I` by metis_tac[ideal_def] >>
7850  metis_tac[IN_IMAGE]) >>
7851  `y IN IMAGE f R` by metis_tac[] >>
7852  qabbrev_tac `p = CHOICE (preimage f I x)` >>
7853  qabbrev_tac `q = CHOICE (preimage f R y)` >>
7854  `p IN I /\ (f p = x)` by rw[preimage_choice_property, Abbr`p`] >>
7855  `q IN R /\ (f q = y)` by rw[preimage_choice_property, Abbr`q`] >>
7856  `s.prod.op y x = f (q * p)` by metis_tac[ideal_element_property] >>
7857  `q * p IN I` by metis_tac[ideal_def] >>
7858  metis_tac[IN_IMAGE]
7859QED
7860
7861(* ------------------------------------------------------------------------- *)
7862(* Ring Binomial Documentation                                               *)
7863(* ------------------------------------------------------------------------- *)
7864(*
7865   Overloading:
7866   rlist    = ring_list r
7867   rsum     = ring_sum r
7868   rfun     = ring_fun r
7869*)
7870(* Definitions and Theorems (# are exported):
7871
7872   List from elements in Ring:
7873#  ring_list_def         |- (!r. rlist [] <=> T) /\ !r h t. rlist (h::t) <=> h IN R /\ rlist t
7874   ring_list_nil         |- !r. rlist [] <=> T
7875   ring_list_cons        |- !r h t. rlist (h::t) <=> h IN R /\ rlist t
7876   ring_list_front_last  |- !s. rlist (FRONT s) /\ LAST s IN R ==> rlist s
7877   ring_list_SNOC        |- !x s. rlist (SNOC x s) <=> x IN R /\ rlist s
7878
7879   Summation in Ring:
7880#  ring_sum_def      |- (!r. rsum [] = #0) /\ !r h t. rsum (h::t) = h + rsum t
7881   ring_sum_nil      |- !r. rsum [] = #0
7882   ring_sum_cons     |- !r h t. rsum (h::t) = h + rsum t
7883#  ring_sum_element  |- !r. Ring r ==> !s. rlist s ==> rsum s IN R
7884   ring_sum_sing     |- !r. Ring r ==> !x. x IN R ==> (rsum [x] = x)
7885   ring_sum_append   |- !r. Ring r ==> !s t. rlist s /\ rlist t ==> (rsum (s ++ t) = rsum s + rsum t)
7886   ring_sum_mult     |- !r. Ring r ==> !k s. k IN R /\ rlist s ==> (k * rsum s = rsum (MAP (\x. k * x) s))
7887   ring_sum_mult_ladd  |- !r. Ring r ==> !m n s. m IN R /\ n IN R /\ rlist s ==>
7888                          ((m + n) * rsum s = rsum (MAP (\x. m * x) s) + rsum (MAP (\x. n * x) s))
7889   ring_sum_SNOC     |- !r. Ring r ==> !k s. k IN R /\ rlist s ==> (rsum (SNOC k s) = rsum s + k)
7890
7891   Function giving elements in Ring:
7892#  ring_fun_def     |- !r f. rfun f <=> !x. f x IN R
7893   ring_fun_add     |- !r. Ring r ==> !a b. rfun a /\ rfun b ==> rfun (\k. a k + b k)
7894   ring_fun_genlist |- !f. rfun f ==> !n. rlist (GENLIST f n)
7895   ring_fun_map     |- !f l. rfun f ==> rlist (MAP f l)
7896   ring_fun_from_ring_fun      |- !r. Ring r ==> !f. rfun f ==> !x. x IN R ==> rfun (\j. f j * x ** j)
7897   ring_fun_from_ring_fun_exp  |- !r. Ring r ==> !f. rfun f ==> !x. x IN R ==>
7898                                  !n. rfun (\j. (f j * x ** j) ** n)
7899   ring_list_gen_from_ring_fun |- !r. Ring r ==> !f. rfun f ==> !x. x IN R ==>
7900                                  !n. rlist (GENLIST (\j. f j * x ** j) n)
7901   ring_list_from_genlist_ring_fun   |- !r f. rfun f ==> !n g. rlist (GENLIST (f o g) n)
7902   ring_list_from_genlist            |- !r f. rfun f ==> !n. rlist (GENLIST f n)
7903
7904   Ring Sum Involving GENLIST:
7905   ring_sum_fun_zero           |- !r. Ring r ==> !f. rfun f ==> !n. (!k. 0 < k /\ k < n ==>
7906                                  (f k = #0)) ==> (rsum (MAP f (GENLIST SUC (PRE n))) = #0)
7907
7908   ring_sum_decompose_first |- !r f n. rsum (GENLIST f (SUC n)) = f 0 + rsum (GENLIST (f o SUC) n)
7909   ring_sum_decompose_last  |- !r. Ring r ==> !f n. rfun f ==> (rsum (GENLIST f (SUC n)) = rsum (GENLIST f n) + f n)
7910   ring_sum_decompose_first_last  |- !r. Ring r ==> !f n. rfun f /\ 0 < n ==>
7911                                    (rsum (GENLIST f (SUC n)) = f 0 + rsum (GENLIST (f o SUC) (PRE n)) + f n)
7912   ring_sum_genlist_add       |- !r. Ring r ==> !a b. rfun a /\ rfun b ==>
7913                              !n. rsum (GENLIST a n) + rsum (GENLIST b n) = rsum (GENLIST (\k. a k + b k) n)
7914   ring_sum_genlist_append    |- !r. Ring r ==> !a b. rfun a /\ rfun b ==>
7915                              !n. rsum (GENLIST a n ++ GENLIST b n) = rsum (GENLIST (\k. a k + b k) n)
7916   ring_sum_genlist_sum     |- !r. Ring r ==> !f. rfun f ==>
7917                     !n m. rsum (GENLIST f (n + m)) = rsum (GENLIST f m) + rsum (GENLIST (\k. f (k + m)) n)
7918   ring_sum_genlist_const   |- !r. Ring r ==> !x. x IN R ==> !n. rsum (GENLIST (K x) n) = ##n * x
7919
7920   Ring Binomial Theorem:
7921   ring_binomial_genlist_index_shift  |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
7922                            !n. GENLIST ((\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) o SUC) n =
7923                                GENLIST (\k. ##(binomial n (SUC k)) * x ** (n - k) * y ** SUC k) n
7924   ring_binomial_index_shift  |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
7925                              !n. (\k. ##(binomial (SUC n) k) * x ** (SUC n - k) * y ** k) o SUC =
7926                                  (\k. ##(binomial (SUC n) (SUC k)) * x ** (n - k) * y ** SUC k)
7927   ring_binomial_term_merge_x |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
7928     !n. (\k. x * k) o (\k. ##(binomial n k) * x ** (n - k) * y ** k) = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k)
7929   ring_binomial_term_merge_y |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
7930     !n. (\k. y * k) o (\k. ##(binomial n k) * x ** (n - k) * y ** k) = (\k. ##(binomial n k) * x ** (n - k) * y ** SUC k)
7931   ring_binomial_thm          |- !r. Ring r ==> !x y. x IN R /\ y IN R ==>
7932     !n. (x + y) ** n = rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** k) (SUC n))
7933
7934   Ring with prime characteristic:
7935   ring_char_prime        |- !r. Ring r ==> (prime (char r) <=>
7936                             1 < char r /\ !k. 0 < k /\ k < char r ==> (##(binomial (char r) k) = #0))
7937   ring_freshman_thm      |- !r. Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
7938                             ((x + y) ** char r = x ** char r + y ** char r)
7939   ring_freshman_all      |- !r. Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
7940                             !n. (x + y) ** char r ** n = x ** char r ** n + y ** char r ** n
7941   ring_freshman_thm_sub  |- !r. Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
7942                             ((x - y) ** char r = x ** char r - y ** char r)
7943   ring_freshman_all_sub  |- !r. Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
7944                             !n. (x - y) ** char r ** n = x ** char r ** n - y ** char r ** n
7945   ring_fermat_thm        |- !r. Ring r /\ prime (char r) ==> !n. (##n) ** (char r) = (##n)
7946   ring_fermat_all        |- !r. Ring r /\ prime (char r) ==> !n k. ##n ** char r ** k = ##n
7947   ring_sum_freshman_thm  |- !r. Ring r /\ prime (char r) ==> !f. rfun f ==> !x. x IN R ==>
7948                             !n. rsum (GENLIST (\j. f j * x ** j) n) ** char r =
7949                                 rsum (GENLIST (\j. (f j * x ** j) ** char r) n)
7950   ring_sum_freshman_all  |- !r. Ring r /\ prime (char r) ==> !f. rfun f ==> !x. x IN R ==>
7951                             !n k. rsum (GENLIST (\j. f j * x ** j) n) ** char r ** k =
7952                                   rsum (GENLIST (\j. (f j * x ** j) ** char r ** k) n)
7953   ring_char_prime_endo   |- !r. Ring r /\ prime (char r) ==> RingEndo (\x. x ** char r) r
7954*)
7955
7956(*
7957binomial_thm:
7958!n x y. (x + y)**n = rsum (GENLIST (\k. (binomial n k)* x**(n-k) * y**k) (SUC n))
7959*)
7960
7961(* ------------------------------------------------------------------------- *)
7962(* List from elements in Ring                                                *)
7963(* ------------------------------------------------------------------------- *)
7964
7965(* Ring element list. *)
7966Definition ring_list_def[simp]:
7967  (ring_list (r:'a ring) [] <=> T) /\
7968  (ring_list (r:'a ring) ((h:'a)::(t:'a list)) <=> h IN R /\ (ring_list r t))
7969End
7970Overload rlist = ``ring_list r``
7971
7972(* Theorem: rlist [] <=> T *)
7973Theorem ring_list_nil = ring_list_def |> CONJUNCT1;
7974(* > val ring_list_nil = |- !r. rlist [] <=> T : thm *)
7975
7976(* Theorem: rlist (h::t) <=> h IN R /\ rlist t *)
7977Theorem ring_list_cons = ring_list_def |> CONJUNCT2;
7978(* > val ring_list_cons = |- !r h t. rlist (h::t) <=> h IN R /\ rlist t : thm *)
7979
7980
7981(* Theorem: rlist (FRONT l) /\ LAST l IN R ==> rlist l *)
7982(* Proof: by induction on s.
7983   Base case: rlist (FRONT []) ==> LAST [] IN R ==> rlist []
7984     true since rlist []   by ring_list_nil.
7985   Step case: rlist (FRONT s) ==> LAST s IN R ==> rlist s ==>
7986              !h. rlist (FRONT (h::s)) ==> LAST (h::s) IN R ==> rlist (h::s)
7987     If s = [],
7988        FRONT (h::[]) = [], LAST (h::[]) = h,   by FRONT_CONS and LAST_CONS,
7989        hence rlist [] /\ h IN R, hence rlist (h::[])  by ring_list_cons.
7990     If s <> [], s = h'::t
7991        FRONT (h::s) = h::FRONT s, LAST (h::s) = LAST s, by FRONT_CONS and LAST_CONS,
7992        hence rlist (h::FRONT s) /\ LAST s IN R,
7993           or h IN R /\ rlist (FRONT s) /\ LAST s IN R   by ring_list_cons
7994           or h IN R /\ rlist s                          by induction hypothesis
7995           hence rlist (h::s)                            by ring_list_cons
7996*)
7997Theorem ring_list_front_last:
7998    !s. rlist (FRONT s) /\ LAST s IN R ==> rlist s
7999Proof
8000  rpt strip_tac >>
8001  Induct_on `s` >-
8002  rw[] >>
8003  metis_tac[FRONT_CONS, LAST_CONS, ring_list_def, list_CASES]
8004QED
8005
8006(* Theorem: !x s. rlist (SNOC x s) <=> x IN R /\ rlist s *)
8007(* Proof:
8008   By induction on s.
8009   Base case: rlist (SNOC x []) <=> x IN R /\ rlist []
8010          rlist (SNOC x [])
8011      <=> rlist [x]           by SNOC
8012      <=> x IN R /\ rlist []  by ring_list_cons
8013   Step case: rlist (SNOC x s) <=> x IN R /\ rlist s ==>
8014              !h. rlist (SNOC x (h::s)) <=> x IN R /\ rlist (h::s)
8015          rlist (SNOC x (h::s))
8016      <=> rlist (h::SONC x s)          by SNOC
8017      <=> h IN R /\ rlist (SNOC x s)   by ring_list_cons
8018      <=> h IN R /\ x IN R /\ rlist s  by induction hypothesis
8019      <=> x IN R /\ rlist (h::s)       by ring_list_cons
8020*)
8021Theorem ring_list_SNOC:
8022    !x s. rlist (SNOC x s) <=> x IN R /\ rlist s
8023Proof
8024  rpt strip_tac >>
8025  Induct_on `s` >-
8026  rw[] >>
8027  rw[] >>
8028  metis_tac[]
8029QED
8030
8031(* ------------------------------------------------------------------------- *)
8032(* Summation in Ring                                                         *)
8033(* ------------------------------------------------------------------------- *)
8034
8035(* Summation in a Ring. *)
8036Definition ring_sum_def[simp]:
8037  (ring_sum (r:'a ring) [] = #0) /\
8038  (ring_sum (r:'a ring) ((h:'a)::(t:'a list)) = h + (ring_sum r t))
8039End
8040Overload rsum = ``ring_sum r``
8041
8042(* Theorem: rsum [] = #0 *)
8043Theorem ring_sum_nil = ring_sum_def |> CONJUNCT1;
8044(* > val ring_sum_nil = |- !r. rsum [] = #0 : thm *)
8045
8046(* Theorem: rsum (h::t)= h + rsum t *)
8047Theorem ring_sum_cons = ring_sum_def |> CONJUNCT2;
8048(* > val ring_sum_cons = |- !r h t. rsum (h::t) = h + rsum t : thm *)
8049
8050(* Theorem: rsum s IN R *)
8051(* Proof: by induction on s.
8052   Base case: rlist [] ==> rsum [] IN R
8053      true by ring_sum_nil, ring_zero_element.
8054   Step case: rlist s ==> rsum s IN R ==> !h. rlist (h::s) ==> rsum (h::s) IN R
8055      rlist (h::s) ==> h IN R /\ rlist s      by ring_list_cons
8056      since  ring_sum(h::s) = h + rsum s      by ring_sum_cons
8057      with h IN R and rlist s ==> rsum s IN R by induction hypothesis
8058      true by ring_add_element
8059*)
8060Theorem ring_sum_element[simp]:
8061    !r:'a ring. Ring r ==> !s. rlist s ==> rsum s IN R
8062Proof
8063  rpt strip_tac >>
8064  Induct_on `s` >>
8065  rw[]
8066QED
8067
8068
8069(* Theorem: rsum [x] = x *)
8070(* Proof:
8071     rsum [x]
8072   = x + rsum []    by ring_sum_cons
8073   = x + #0         by ring_sum_nil
8074   = x              by ring_add_rzero
8075*)
8076Theorem ring_sum_sing:
8077    !r:'a ring. Ring r ==> !x. x IN R ==> (rsum [x] = x)
8078Proof
8079  rw[]
8080QED
8081
8082(* Theorem: rsum (s ++ t) = rsum s + rsum t *)
8083(* Proof: by induction on s
8084   Base case: rlist [] ==> (rsum ([] ++ t) = rsum [] + rsum t)
8085     rsum ([] ++ t)
8086   = rsum t                   by APPEND
8087   = #0 + rsum t              by ring_add_lzero
8088   = rsum [] + rsum t   by ring_sum_nil
8089   Step case: rlist s /\ rlist t ==> (rsum (s ++ t) = rsum s + rsum t) ==>
8090              rlist (h::s) ==> (rsum (h::s ++ t) = rsum (h::s) + rsum t)
8091     rsum (h::s ++ t)
8092   = rsum (h::(s ++ t))       by APPEND
8093   = h + rsum (s ++ t)        by ring_sum_cons, h IN R by ring_list_cons
8094   = h + (rsum s + rsum t)    by induction hypothesis
8095   = (h + rsum s) + rsum t    by ring_add_assoc
8096   = rsum (h::s) + rsum t     by ring_sum_cons
8097*)
8098Theorem ring_sum_append:
8099    !r:'a ring. Ring r ==> !s t. rlist s /\ rlist t ==> (rsum (s ++ t) = rsum s + rsum t)
8100Proof
8101  rpt strip_tac >>
8102  Induct_on `s` >>
8103  rw[ring_add_assoc]
8104QED
8105
8106(* Theorem: constant multiplication: k * rsum s = rsum (MAP (\x. k*x) s))  *)
8107(* Proof: by induction on s
8108   Base case: k * rsum [] = rsum (MAP (\x. k * x) [])
8109   LHS = k * rsum []
8110       = k * #0          by ring_sum_nil
8111       = #0              by ring_mult_rzero
8112   RHS = rsum (MAP (\x. k * x) [])
8113       = rsum []         by MAP
8114       = #0              by ring_sum_nil
8115       = LHS
8116   Step case: rlist s ==> (k * rsum s = rsum (MAP (\x. k * x) s)) ==>
8117              !h. rlist (h::s) ==> (k * rsum (h::s) = rsum (MAP (\x. k * x) (h::s)))
8118   LHS = k * rsum (h::s)
8119       = k * (h + rsum s)     by ring_sum_cons
8120       = k * h + k * rsum s   by ring_mult_radd
8121       = k * h + rsum (MAP (\x. k * x) s)   by induction hypothesis
8122   RHS = rsum (MAP (\x. k * x) (h::s))
8123       = rsum ((\x. k * x) h :: MAP (\x. k * x) s)  by MAP
8124       = (\x. k * x) h + rsum (MAP (\x. k * x) s)   by ring_sum_cons
8125       = k * h + rsum (MAP (\x. k * x) s
8126       = LHS
8127*)
8128Theorem ring_sum_mult:
8129    !r:'a ring. Ring r ==> !k s. k IN R /\ rlist s ==> (k * rsum s = rsum (MAP (\x. k*x) s))
8130Proof
8131  rpt strip_tac >>
8132  Induct_on `s` >>
8133  rw[]
8134QED
8135
8136(* Theorem: (m+n) * rsum s = rsum (MAP (\x. m*x) s) + rsum (MAP (\x. n*x) s)  *)
8137(* Proof:
8138    (m + n) * rsum s
8139  = m * rsum s + n * rsum s                          by ring_mult_ladd
8140  = rsum (MAP (\x. m*x) s) + rsum (MAP (\x. n*x) s)  by ring_sum_mult
8141*)
8142Theorem ring_sum_mult_ladd:
8143    !r:'a ring. Ring r ==> !m n s. m IN R /\ n IN R /\ rlist s ==>
8144       ((m + n) * rsum s = rsum (MAP (\x. m*x) s) + rsum (MAP (\x. n*x) s))
8145Proof
8146  rw[ring_sum_mult, ring_mult_ladd]
8147QED
8148
8149(*
8150- EVAL ``GENLIST I 4``;
8151> val it = |- GENLIST I 4 = [0; 1; 2; 3] : thm
8152- EVAL ``GENLIST SUC 4``;
8153> val it = |- GENLIST SUC 4 = [1; 2; 3; 4] : thm
8154- EVAL ``GENLIST (\k. binomial 4 k) 5``;
8155> val it = |- GENLIST (\k. binomial 4 k) 5 = [1; 4; 6; 4; 1] : thm
8156- EVAL ``GENLIST (\k. binomial 5 k) 6``;
8157> val it = |- GENLIST (\k. binomial 5 k) 6 = [1; 5; 10; 10; 5; 1] : thm
8158- EVAL ``GENLIST (\k. binomial 10 k) 11``;
8159> val it = |- GENLIST (\k. binomial 10 k) 11 = [1; 10; 45; 120; 210; 252; 210; 120; 45; 10; 1] : thm
8160*)
8161
8162(* Theorems on GENLIST:
8163
8164- GENLIST;
8165> val it = |- (!f. GENLIST f 0 = []) /\
8166               !f n. GENLIST f (SUC n) = SNOC (f n) (GENLIST f n) : thm
8167- NULL_GENLIST;
8168> val it = |- !n f. NULL (GENLIST f n) <=> (n = 0) : thm
8169- GENLIST_CONS;
8170> val it = |- GENLIST f (SUC n) = f 0::GENLIST (f o SUC) n : thm
8171- EL_GENLIST;
8172> val it = |- !f n x. x < n ==> (EL x (GENLIST f n) = f x) : thm
8173- EXISTS_GENLIST;
8174> val it = |- !n. EXISTS P (GENLIST f n) <=> ?i. i < n /\ P (f i) : thm
8175- EVERY_GENLIST;
8176> val it = |- !n. EVERY P (GENLIST f n) <=> !i. i < n ==> P (f i) : thm
8177- MAP_GENLIST;
8178> val it = |- !f g n. MAP f (GENLIST g n) = GENLIST (f o g) n : thm
8179- GENLIST_APPEND;
8180> val it = |- !f a b. GENLIST f (a + b) = GENLIST f b ++ GENLIST (\t. f (t + b)) a : thm
8181- HD_GENLIST;
8182> val it = |- HD (GENLIST f (SUC n)) = f 0 : thm
8183- TL_GENLIST;
8184> val it = |- !f n. TL (GENLIST f (SUC n)) = GENLIST (f o SUC) n : thm
8185- HD_GENLIST_COR;
8186> val it = |- !n f. 0 < n ==> (HD (GENLIST f n) = f 0) : thm
8187- GENLIST_FUN_EQ;
8188> val it = |- !n f g. (GENLIST f n = GENLIST g n) <=> !x. x < n ==> (f x = g x) : thm
8189
8190*)
8191
8192(* Theorem: rsum (SNOC h s) = (rsum s) + h *)
8193(* Proof: by induction on s.
8194   Base case: (rsum (SNOC k []) = rsum [] + k)
8195      rsum (SNOC k [])
8196    = rsum [k]            by SNOC
8197    = k + #0              by ring_sum_cons, ring_sum_nil
8198    = k                   by ring_add_rzero
8199    = #0 + k              by ring_add_lzero
8200    = rsum [] + k         by ring_sum_nil
8201   Step case: rlist s ==> (rsum (SNOC k s) = rsum s + k) ==>
8202              !h. rlist (h::s) ==> (rsum (SNOC k (h::s)) = rsum (h::s) + k)
8203     rsum (SNOC k (h::s))
8204   = rsum (h::SNOC k s)   by SNOC
8205   = h + rsum (SNOC k s)  by ring_sum_cons
8206   = h + (rsum s + k)     by induction hypothesis
8207   = (h + rsum s) + k     by ring_add_assoc, ring_sum_element
8208   = rsum(h::s) + k       by ring_sum_cons
8209*)
8210Theorem ring_sum_SNOC:
8211    !r:'a ring. Ring r ==> !k s. k IN R /\ rlist s ==> (rsum (SNOC k s) = (rsum s) + k)
8212Proof
8213  rpt strip_tac >>
8214  Induct_on `s` >>
8215  rw[ring_add_assoc]
8216QED
8217
8218(* ------------------------------------------------------------------------- *)
8219(* Function giving elements in Ring                                          *)
8220(* ------------------------------------------------------------------------- *)
8221
8222(* Ring element function. *)
8223Definition ring_fun_def[simp]:
8224  ring_fun (r:'a ring) f <=> !x. f x IN R
8225End
8226Overload rfun = ``ring_fun r``
8227
8228(* Theorem: rfun a /\ rfun b ==> rfun (\k. a k + b k) *)
8229(* Proof: by ring_add_element. *)
8230Theorem ring_fun_add:
8231    !r:'a ring. Ring r ==> !a b. rfun a /\ rfun b ==> rfun (\k. a k + b k)
8232Proof
8233  rw[]
8234QED
8235
8236(* Theorem: rfun f ==> rlist (GENLIST f n) *)
8237(* Proof: by induction on n.
8238   Base case: rlist (GENLIST f 0)
8239      Since GENLIST f 0 = []   by GENLIST
8240      hence true by ring_list_nil.
8241   Step case: rlist (GENLIST f n) ==> rlist (GENLIST f (SUC n))
8242*)
8243Theorem ring_fun_genlist:
8244    !f. rfun f ==> !n. rlist (GENLIST f n)
8245Proof
8246  rw_tac std_ss[ring_fun_def] >>
8247  Induct_on `n` >-
8248  rw[] >>
8249  rw_tac std_ss[ring_list_cons, GENLIST] >>
8250  `rlist (FRONT (SNOC (f n) (GENLIST f n)))` by rw_tac std_ss[FRONT_SNOC] >>
8251  `LAST (SNOC (f n) (GENLIST f n)) IN R` by rw_tac std_ss[LAST_SNOC] >>
8252  metis_tac[ring_list_front_last]
8253QED
8254
8255(* Theorem: rfun f ==> rlist (MAP f l) *)
8256(* Proof: by induction.
8257   Base case: rlist (MAP f [])
8258     True by ring_list_nil, MAP: MAP f [] = []
8259   Step case: rlist l ==> rlist (MAP f l) ==> !h. rlist (h::l) ==> rlist (MAP f (h::l))
8260     True by ring_list_cons, MAP: MAP f (h::t) = f h::MAP f t
8261*)
8262Theorem ring_fun_map:
8263    !f l. rfun f ==> rlist (MAP f l)
8264Proof
8265  rw_tac std_ss[ring_fun_def] >>
8266  Induct_on `l` >| [
8267    rw_tac std_ss[MAP, ring_list_nil],
8268    rw_tac std_ss[MAP, ring_list_cons]
8269  ]
8270QED
8271
8272(* Theorem: rfun f ==> !x. x IN R ==> rfun (\j. f j * x ** j *)
8273(* Proof: by ring_fun_def, ring_exp_element, ring_mult_element *)
8274Theorem ring_fun_from_ring_fun:
8275    !r:'a ring. Ring r ==> !f. rfun f ==> !x. x IN R ==> rfun (\j. f j * x ** j)
8276Proof
8277  rw[ring_fun_def]
8278QED
8279
8280(* Theorem: rfun f ==> !x. x IN R ==> !n. rfun (\j. (f j * x ** j) ** n) *)
8281(* Proof: by ring_fun_def, ring_exp_element, ring_mult_element *)
8282Theorem ring_fun_from_ring_fun_exp:
8283    !r:'a ring. Ring r ==> !f. rfun f ==> !x. x IN R ==> !n. rfun (\j. (f j * x ** j) ** n)
8284Proof
8285  rw[ring_fun_def]
8286QED
8287
8288(* Theorem: rfun f ==> !x. x IN R ==> !n. rlist (GENLIST (\j. f j * x ** j) n) *)
8289(* Proof:
8290   By induction on n.
8291   Base case: rlist (GENLIST (\j. f j * x ** j) 0)
8292      Since rlist (GENLIST (\j. f j * x ** j) 0) = rlist []    by GENLIST
8293        and rlist [] = T                                       by ring_list_nil
8294   Step case: rlist (GENLIST (\j. f j * x ** j) n) ==> rlist (GENLIST (\j. f j * x ** j) (SUC n))
8295        rlist (GENLIST (\j. f j * x ** j) (SUC n))
8296      = rlist (SNOC (f n * x ** n) (GENLIST (\j. f j * x ** j) n))    by GENLIST
8297      = (f n ** x ** n) IN R /\ rlist (GENLIST (\j. f j * x ** j) n)  by ring_list_SNOC
8298      = true /\ rlist (GENLIST (\j. f j * x ** j) n)                  by ring_fun_def, ring_exp_element
8299      = true /\ true                                                  by induction hypothesis
8300*)
8301Theorem ring_list_gen_from_ring_fun:
8302    !r:'a ring. Ring r ==> !f. rfun f ==> !x. x IN R ==> !n. rlist (GENLIST (\j. f j * x ** j) n)
8303Proof
8304  rpt strip_tac >>
8305  Induct_on `n` >-
8306  rw[] >>
8307  `!j. f j IN R` by metis_tac[ring_fun_def] >>
8308  rw_tac std_ss[GENLIST, ring_list_SNOC, ring_exp_element, ring_mult_element]
8309QED
8310
8311(* Theorem: !f. rfun f ==> !n g. rlist (GENLIST (f o g) n) *)
8312(* Proof:
8313   By induction on n.
8314   Base: rlist (GENLIST (f o g) 0)
8315          rlist (GENLIST (f o g) 0)
8316      <=> rlist []                   by GENLIST_0
8317      <=> T                          by ring_list_nil
8318   Step: rlist (GENLIST (f o g) n) ==> rlist (GENLIST (f o g) (SUC n))
8319          rlist (GENLIST (f o g) (SUC n))
8320      <=> rlist (SNOC ((f o g) n) (GENLIST (f o g) n))   by GENLIST
8321      <=> (f o g) n IN R /\ rlist (GENLIST (f o g) n)    by ring_list_SNOC
8322      <=> (f o g) n IN R /\ T                            by induction hypothesis
8323      <=> f (g n) IN R                                   by o_THM
8324      <=> T                                              by ring_fun_def
8325*)
8326Theorem ring_list_from_genlist_ring_fun:
8327    !r:'a ring. !f. rfun f ==> !n g. rlist (GENLIST (f o g) n)
8328Proof
8329  rpt strip_tac >>
8330  Induct_on `n` >-
8331  rw[] >>
8332  `rlist (GENLIST (f o g) (SUC n)) <=> f (g n) IN R` by rw_tac std_ss[GENLIST, ring_list_SNOC] >>
8333  metis_tac[ring_fun_def]
8334QED
8335
8336(* Theorem: !f. rfun f ==> !n. rlist (GENLIST f n) *)
8337(* Proof:
8338   Since f = f o I      by I_o_ID
8339   The result follows from ring_list_from_genlist_ring_fun
8340*)
8341Theorem ring_list_from_genlist:
8342    !r:'a ring. !f. rfun f ==> !n. rlist (GENLIST f n)
8343Proof
8344  rpt strip_tac >>
8345  `f = f o I` by rw[] >>
8346  `rlist (GENLIST (f o I) n)` by rw[ring_list_from_genlist_ring_fun] >>
8347  metis_tac[]
8348QED
8349
8350(* ------------------------------------------------------------------------- *)
8351(* Ring Sum Involving GENLIST                                                *)
8352(* ------------------------------------------------------------------------- *)
8353
8354(* Theorem: Ring r ==> !f n k. (0 < k /\ k < n ==> (f k = #0)) ==> (rsum (MAP f (GENLIST SUC (PRE p))) = #0) *)
8355(* Proof: by induction on n
8356   Base case: (!k. 0 < k /\ k < 0 ==> (f k = #0)) ==> (rsum (MAP f (GENLIST SUC (PRE 0))) = #0)
8357     rsum (MAP f (GENLIST SUC (PRE 0))
8358   = rsum (MAP f (GENLIST SUC 0))         by PRE 0 = 0
8359   = rsum (MAP f [])                      by GENLIST f 0 = [] in GENLIST
8360   = rsum []                              by MAP f [] = []    in MAP
8361   = #0                                   by ring_sum_nil
8362   Step case: (!k. 0 < k /\ k < n ==> (f k = #0)) ==> (rsum (MAP f (GENLIST SUC (PRE n))) = #0) ==>
8363              (!k. 0 < k /\ k < SUC n ==> (f k = #0)) ==> (rsum (MAP f (GENLIST SUC (PRE (SUC n)))) = #0)
8364   First, note that n < SUC n             by LESS_SUC
8365   hence !k. 0 < k /\ k < n ==> f k = #0  by LESS_TRANS
8366   If n = 0, true by similar reasoning in base case.
8367   If n <> 0, 0 < n, then n = SUC m for some m    by num_CASES
8368     rsum (MAP f (GENLIST SUC (PRE (SUC n))))
8369   = rsum (MAP f (GENLIST SUC n))
8370   = rsum (MAP f (GENLIST SUC (SUC (PRE n))))               by SUC_PRE
8371   = rsum (MAP f ((GENLIST SUC (PRE n)) ++ [SUC (PRE n)]))  by GENLIST, SNOC_APPEND
8372   = rsum (MAP f ((GENLIST SUC (PRE n)) ++ [n]))            by SUC_PRE
8373   = rsum (MAP f (GENLIST SUC (PRE n)) ++ MAP f [n])        by MAP_APPEND
8374   = rsum (MAP f (GENLIST SUC (PRE n))) + rsum (MAP f [n])  by ring_sum_append, ring_fun_map
8375   = #0 + rsum (MAP f [n])                                  by induction hypothesis
8376   = rsum (MAP f [n])                                       by ring_add_lzero, ring_sum_element, ring_fun_map
8377   = rsum ([f n])                                           by MAP
8378   = f n                                                    by ring_sum_sing, ring_fun_def
8379   = #0                                                     by n < SUC n
8380*)
8381Theorem ring_sum_fun_zero:
8382    !r:'a ring. Ring r ==> !f. rfun f ==>
8383    !n. (!k. 0 < k /\ k < n ==> (f k = #0)) ==> (rsum (MAP f (GENLIST SUC (PRE n))) = #0)
8384Proof
8385  ntac 4 strip_tac >>
8386  Induct_on `n` >| [
8387    `GENLIST SUC 0 = []` by rw_tac std_ss[GENLIST] >>
8388    `MAP f [] = []` by rw_tac std_ss[MAP] >>
8389    rw_tac std_ss[ring_sum_nil],
8390    rw_tac std_ss[] >>
8391    `n < SUC n /\ !k. 0 < k /\ k < n ==> (f k = #0)` by metis_tac[LESS_SUC, LESS_TRANS] >>
8392    Cases_on `n = 0` >| [
8393      rw_tac std_ss[] >>
8394      `GENLIST SUC 0 = []` by rw_tac std_ss[GENLIST] >>
8395      `MAP f [] = []` by rw_tac std_ss[MAP] >>
8396      rw_tac std_ss[ring_sum_nil],
8397      `0 < n /\ ?m. n = SUC m` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO] >>
8398      `rsum (MAP f (GENLIST SUC n)) = rsum (MAP f (GENLIST SUC (SUC (PRE n))))` by rw_tac std_ss[SUC_PRE] >>
8399      `_ = rsum (MAP f ((GENLIST SUC (PRE n)) ++ [SUC (PRE n)]))` by rw_tac std_ss[GENLIST, SNOC_APPEND] >>
8400      `_ = rsum (MAP f ((GENLIST SUC (PRE n)) ++ [n]))` by rw_tac std_ss[SUC_PRE] >>
8401      `_ = rsum (MAP f (GENLIST SUC (PRE n)) ++ MAP f [n])` by rw_tac std_ss[MAP_APPEND] >>
8402      `_ = rsum (MAP f (GENLIST SUC (PRE n))) + rsum (MAP f [n])` by rw_tac std_ss[ring_sum_append, ring_fun_map] >>
8403      `_ = #0 + rsum (MAP f [n])` by metis_tac[] >>
8404      `_ = rsum (MAP f [n])` by rw_tac std_ss[ring_add_lzero, ring_sum_element, ring_fun_map] >>
8405      `_ = rsum ([f n])` by rw_tac std_ss[MAP] >>
8406      `_ = f n` by metis_tac[ring_sum_sing, ring_fun_def] >>
8407      metis_tac[]
8408    ]
8409  ]
8410QED
8411
8412(* Theorem: rsum (k=0..n) f(k) = f(0) + rsum (k=1..n) f(k)  *)
8413(* Proof:
8414     rsum (GENLIST f (SUC n))
8415   = rsum (f 0 :: GENLIST (f o SUC) n)   by GENLIST_CONS
8416   = f 0 + rsum (GENLIST (f o SUC) n)    by ring_sum_cons
8417*)
8418Theorem ring_sum_decompose_first:
8419    !r:'a ring. !f n. rsum (GENLIST f (SUC n)) = f 0 + rsum (GENLIST (f o SUC) n)
8420Proof
8421  rw[GENLIST_CONS]
8422QED
8423
8424(* Theorem: rsum (k=0..n) f(k) = rsum (k=0..(n-1)) f(k) + f n *)
8425(* Proof:
8426     rsum (GENLIST f (SUC n))
8427   = rsum (SNOC (f n) (GENLIST f n))   by GENLIST definition
8428   = rsum ((GENLIST f n) ++ [f n])     by SNOC_APPEND
8429   = rsum (GENLIST f n) + rsum [f n]   by ring_sum_append
8430   = rsum (GENLIST f n) + f n          by ring_sum_sing
8431*)
8432Theorem ring_sum_decompose_last:
8433    !r:'a ring. Ring r ==> !f n. rfun f ==> (rsum (GENLIST f (SUC n)) = rsum (GENLIST f n) + f n)
8434Proof
8435  rpt strip_tac >>
8436  `rlist (GENLIST f n)` by rw_tac std_ss[ring_fun_genlist] >>
8437  `f n IN R /\ rlist [f n]` by metis_tac[ring_list_def, ring_fun_def] >>
8438  rw_tac std_ss[GENLIST, SNOC_APPEND, ring_sum_append, ring_sum_sing]
8439QED
8440
8441(* Theorem: Ring r /\ rfun f /\ 0 < n ==> rsum (k=0..n) f(k) = f(0) + rsum (k=1..n-1) f(k) + f(n)  *)
8442(* Proof:
8443     rsum (GENLIST f (SUC n))
8444   = rsum (GENLIST f n) + f n                     by ring_sum_decompose_last
8445   = rsum (GENLIST f (SUC m)) + f n               by n = SUC m, since 0 < n
8446   = f 0 + rsum (GENLIST f o SUC m) + f n         by ring_sum_decompose_first
8447   = f 0 + rsum (GENLIST f o SUC (PRE n)) + f n   by PRE_SUC_EQ
8448*)
8449Theorem ring_sum_decompose_first_last:
8450    !r:'a ring. Ring r ==> !f n. rfun f /\ 0 < n ==> (rsum (GENLIST f (SUC n)) = f 0 + rsum (GENLIST (f o SUC) (PRE n)) + f n)
8451Proof
8452  rpt strip_tac >>
8453  `n <> 0` by decide_tac >>
8454  `?m. n = SUC m` by metis_tac[num_CASES] >>
8455  `rsum (GENLIST f (SUC n)) = rsum (GENLIST f n) + f n` by rw_tac std_ss[ring_sum_decompose_last] >>
8456  `_ = f 0 + rsum (GENLIST (f o SUC) m) + f n` by rw_tac std_ss[ring_sum_decompose_first] >>
8457  rw_tac std_ss[PRE_SUC_EQ]
8458QED
8459
8460(* Theorem: rsum (GENLIST a n) + rsum (GENLIST b n) = rsum (GENLIST (\k. a k + b k) n) *)
8461(* Proof: by induction on n.
8462   Base case: rsum (GENLIST a 0) + rsum (GENLIST b 0) = rsum (GENLIST (\k. a k + b k) 0)
8463      true by GENLIST f 0 = [], and rsum [] = #0, and #0 + #0 = #0 by ring_add_zero_zero.
8464   Step case: rsum (GENLIST a n) + rsum (GENLIST b n) = rsum (GENLIST (\k. a k + b k) n) ==>
8465              rsum (GENLIST a (SUC n)) + rsum (GENLIST b (SUC n)) = rsum (GENLIST (\k. a k + b k) (SUC n))
8466   LHS = rsum (GENLIST a (SUC n)) + rsum (GENLIST b (SUC n))
8467       = (rsum (GENLIST a n) + a n) + (rsum (GENLIST b n) + b n)    by ring_sum_decompose_last
8468       = rsum (GENLIST a n) + (a n + (rsum (GENLIST b n) + b n))    by ring_add_assoc
8469       = rsum (GENLIST a n) + (a n + rsum (GENLIST b n) + b n)      by ring_add_assoc
8470       = rsum (GENLIST a n) + (rsum (GENLIST b n) + a n + b n)      by ring_add_comm
8471       = rsum (GENLIST a n) + (rsum (GENLIST b n) + (a n + b n))    by ring_add_assoc
8472       = rsum (GENLIST a n) + rsum (GENLIST b n) + (a n + b n)      by ring_add_assoc
8473       = rsum (GENLIST (\k. a k + b k) n) + (a n + b n)             by induction hypothesis
8474       = rsum (GENLIST (\k. a k + b k) (SUC n))                     by ring_sum_decompose_last
8475       = RHS
8476*)
8477Theorem ring_sum_genlist_add:
8478    !r:'a ring. Ring r ==> !a b. rfun a /\ rfun b ==>
8479   !n. rsum (GENLIST a n) + rsum (GENLIST b n) = rsum (GENLIST (\k. a k + b k) n)
8480Proof
8481  rpt strip_tac >>
8482  Induct_on `n` >-
8483  rw[] >>
8484  `rfun (\k. a k + b k)` by rw_tac std_ss[ring_fun_add] >>
8485  rw_tac std_ss[ring_sum_decompose_last] >>
8486  `rsum (GENLIST a n) IN R /\ rsum (GENLIST b n) IN R` by rw_tac std_ss[ring_sum_element, ring_fun_genlist] >>
8487  `a n IN R /\ b n IN R` by metis_tac[ring_fun_def] >>
8488  `rsum (GENLIST a n) + a n + (rsum (GENLIST b n) + b n)
8489   = rsum (GENLIST a n) + (a n + rsum (GENLIST b n) + b n)` by rw[ring_add_assoc] >>
8490  `_ = rsum (GENLIST a n) + (rsum (GENLIST b n) + a n + b n)` by rw_tac std_ss[ring_add_comm] >>
8491  `_ = rsum (GENLIST a n) + rsum (GENLIST b n) + (a n + b n)` by rw[ring_add_assoc] >>
8492  rw_tac std_ss[]
8493QED
8494
8495(* Theorem: rsum (GENLIST a n ++ GENLIST b n) = rsum (GENLIST (\k. a k + b k) n) *)
8496(* Proof:
8497     rsum (GENLIST a n ++ GENLIST b n)
8498   = rsum (GENLIST a n) + rsum (GENLIST b n)   by ring_sum_append, due to ring_fun_genlist.
8499   = rsum (GENLIST (\k. a k + b k) n)          by ring_sum_genlist_add
8500*)
8501Theorem ring_sum_genlist_append:
8502    !r:'a ring. Ring r ==> !a b. rfun a /\ rfun b ==>
8503    !n. rsum (GENLIST a n ++ GENLIST b n) = rsum (GENLIST (\k. a k + b k) n)
8504Proof
8505  rw_tac std_ss[ring_sum_append, ring_sum_genlist_add, ring_fun_genlist]
8506QED
8507
8508(* Theorem: Ring r ==> !f. rfun f  ==>
8509            !n m. rsum (GENLIST f (n + m)) = rsum (GENLIST f m) + rsum (GENLIST (\k. f (k + m)) n) *)
8510(* Proof:
8511   Note (\k. f (k + m)) = f o (\k. k + m)    by FUN_EQ_THM
8512   Hence rlist (GENLIST f m)                 by ring_list_from_genlist
8513     and rlist (GENLIST (\k. f (k + m)) n)   by ring_list_from_genlist_ring_fun
8514     rsum (GENLIST f (n + m))
8515   = rsum (GENLIST f m ++ GENLIST (\k. f (k + m)) n)         by GENLIST_APPEND
8516   = rsum (GENLIST f m) + rsum (GENLIST (\k. f (k + m)) n)   by ring_sum_append
8517*)
8518Theorem ring_sum_genlist_sum:
8519    !r:'a ring. Ring r ==> !f. rfun f  ==>
8520   !n m. rsum (GENLIST f (n + m)) = rsum (GENLIST f m) + rsum (GENLIST (\k. f (k + m)) n)
8521Proof
8522  rpt strip_tac >>
8523  `(\k. f (k + m)) = f o (\k. k + m)` by rw[FUN_EQ_THM] >>
8524  `rlist (GENLIST (\k. f (k + m)) n)` by rw[ring_list_from_genlist_ring_fun] >>
8525  `rlist (GENLIST f m)` by rw[ring_list_from_genlist] >>
8526  metis_tac[GENLIST_APPEND, ring_sum_append]
8527QED
8528
8529(* Theorem: Ring r ==> !x. x IN R ==> !n. rsum (GENLIST (K x) n) = ##n * x *)
8530(* Proof:
8531   By induction on n.
8532   Base: rsum (GENLIST (K x) 0) = ##0 * x
8533         rsum (GENLIST (K x) 0)
8534       = rsum []               by GENLIST_0
8535       = #0                    by ring_sum_nil
8536       = ##0 * x               by ring_num_0, ring_mult_lzero
8537   Step: rsum (GENLIST (K x) n) = ##n * x ==>
8538         rsum (GENLIST (K x) (SUC n)) = ##(SUC n) * x
8539       Note rfun (K x)                     by ring_fun_def, K_THM, x IN R
8540         so rlist (GENLIST (K x) n)        by ring_list_from_genlist
8541         rsum (GENLIST (K x) (SUC n))
8542       = rsum (SNOC ((K x) n) (GENLIST (K x) n))   by GENLIST
8543       = rsum (SNOC x (GENLIST (K x) n))           by K_THM
8544       = rsum (GENLIST (K x) n) + x                by ring_sum_SNOC
8545       = ##n * x + x                               by induction hypothesis
8546       = ##n * x + #1 * x                          by ring_mult_lone
8547       = (##n + #1) * x                            by ring_mult_ladd
8548       = ##(SUC n) * x                             by ring_num_suc
8549*)
8550Theorem ring_sum_genlist_const:
8551    !r:'a ring. Ring r ==> !x. x IN R ==> !n. rsum (GENLIST (K x) n) = ##n * x
8552Proof
8553  rpt strip_tac >>
8554  Induct_on `n` >-
8555  rw[] >>
8556  `rfun (K x)` by rw[ring_fun_def] >>
8557  `rlist (GENLIST (K x) n)` by rw[ring_list_from_genlist] >>
8558  `rsum (GENLIST (K x) (SUC n)) = ##n * x + x` by rw[GENLIST, ring_sum_SNOC] >>
8559  rw[ring_mult_ladd, ring_num_suc]
8560QED
8561
8562(* ------------------------------------------------------------------------- *)
8563(* Ring Binomial Theorem                                                     *)
8564(* ------------------------------------------------------------------------- *)
8565
8566(* Theorem: Binomial Index Shifting, for
8567     rsum (k=1..n) ##C(n,k) x^(n+1-k) y^k = rsum (k=0..n-1) ##C(n,k+1) x^(n-k) y^(k+1)  *)
8568(* Proof:
8569   Since
8570     rsum (k=1..n) C(n,k)x^(n+1-k)y^k
8571   = rsum (MAP (\k. (binomial n k)* x**(n+1-k) * y**k) (GENLIST SUC n))
8572   = rsum (GENLIST (\k. (binomial n k)* x**(n+1-k) * y**k) o SUC n)
8573
8574     rsum (k=0..n-1) C(n,k+1)x^(n-k)y^(k+1)
8575   = rsum (MAP (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) (GENLIST I n))
8576   = rsum (GENLIST (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) o I n)
8577   = rsum (GENLIST (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) n)
8578
8579   This is equivalent to showing:
8580   (\k. (binomial n k)* x**(n-k+1) * y**k) o SUC = (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1))
8581*)
8582
8583(* Theorem: Binomial index shift for GENLIST:
8584   (\k. (binomial n k)* x**(n-k+1) * y**k) o SUC = (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) *)
8585(* Proof:
8586   For any k < n,
8587     ((\k. (binomial n k)* x**(n-k+1) * y**k) o SUC) k
8588   = ##(binomial n (SUC k)) * x ** SUC (n - SUC k) * y ** SUC k
8589   = ##(binomial n (SUC k)) * x ** (n-k) * y ** SUC k    by SUC (n - SUC k) = n - k for k < n
8590   = ##(binomial n (k + 1)) * x ** (n-k) * y ** (k+1)    by definition of SUC
8591   = (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) k
8592*)
8593Theorem ring_binomial_genlist_index_shift:
8594    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==>
8595   !n. GENLIST ((\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) o SUC) n =
8596       GENLIST (\k. ##(binomial n (SUC k)) * x**(n-k) * y**(SUC k)) n
8597Proof
8598  rw_tac std_ss[GENLIST_FUN_EQ] >>
8599  `SUC (n - SUC k) = n - k` by decide_tac >>
8600  rw_tac std_ss[]
8601QED
8602
8603(* This is closely related to above, with (SUC n) replacing (n),
8604   but does not require k < n. *)
8605(* Proof: by equality of function. *)
8606Theorem ring_binomial_index_shift:
8607    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==>
8608   !n. (\k. ##(binomial (SUC n) k) * x**((SUC n) - k) * y**k) o SUC =
8609       (\k. ##(binomial (SUC n) (SUC k)) * x**(n-k) * y**(SUC k))
8610Proof
8611  rw[FUN_EQ_THM]
8612QED
8613
8614(* Pattern for binomial expansion:
8615
8616    (x+y)(x^3 + 3x^2y + 3xy^2 + y^3)
8617  = x(x^3) + 3x(x^2y) + 3x(xy^2) + x(y^3) +
8618               y(x^3) + 3y(x^2y) + 3y(xy^2) + y(y^3)
8619  = x^4 + (3+1)x^3y + (3+3)(x^2y^2) + (1+3)(xy^3) + y^4
8620    = x^4 + 4x^3y   + 6x^2y^2       + 4xy^3       + y^4
8621
8622*)
8623
8624(* Theorem: multiply x into a binomial term:
8625   (\k. x*k) o (\k. ##(binomial n k) * x ** (n - k) * y ** k) = (\k. ##(binomial n k) * x ** (SUC(n - k)) * y ** k)  *)
8626(* Proof: to prove:
8627     x * (##(binomial n k) * x ** (n - k) * y ** k) = ##(binomial n k) * x ** SUC (n - k) * y ** k
8628   LHS = x * (##(binomial n k) * x ** (n - k) * y ** k)
8629       = x * (##(binomial n k) * (x ** (n - k) * y ** k))   by ring_mult_assoc
8630       = (x * ##(binomial n k)) * (x ** (n - k) * y ** k)   by ring_mult_assoc
8631       = (##(binomial n k) * x) * (x ** (n - k) * y ** k)   by ring_mult_comm
8632       = ##(binomial n k) * (x * x ** (n - k) * y ** k)     by ring_mult_assoc
8633       = ##(binomial n k) * (x ** SUC (n - k) * y ** k)     by ring_exp_SUC
8634       = ##(binomial n k) * x ** SUC (n - k) * y ** k       by ring_mult_assoc
8635       = RHS
8636*)
8637Theorem ring_binomial_term_merge_x:
8638    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==>
8639   !n. (\k. x*k) o (\k. ##(binomial n k) * x ** (n - k) * y ** k) = (\k. ##(binomial n k) * x ** (SUC(n - k)) * y ** k)
8640Proof
8641  rw_tac std_ss[FUN_EQ_THM] >>
8642  `##(binomial n k) IN R /\ x ** (n - k) IN R /\ y ** k IN R /\ x ** SUC (n - k) IN R` by rw[] >>
8643  `x * (##(binomial n k) * x ** (n - k) * y ** k) = (x * ##(binomial n k)) * (x ** (n - k) * y ** k)` by rw[ring_mult_assoc] >>
8644  `_ = (##(binomial n k) * x) * (x ** (n - k) * y ** k)` by rw_tac std_ss[ring_mult_comm] >>
8645  rw[ring_mult_assoc]
8646QED
8647
8648(* Theorem: multiply y into a binomial term:
8649   (\k. y*k) o (\k. ##(binomial n k) * x ** (n - k) * y ** k) = (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k))  *)
8650(* Proof: to prove:
8651     y * (##(binomial n k) * x ** (n - k) * y ** k) = ##(binomial n k) * x ** (n - k) * y ** SUC k
8652   LHS = y * (##(binomial n k) * x ** (n - k) * y ** k)
8653       = y * (##(binomial n k) * (x ** (n - k) * y ** k))   by ring_mult_assoc
8654       = (y * ##(binomial n k)) * (x ** (n - k) * y ** k)   by ring_mult_assoc
8655       = (##(binomial n k) * y) * (x ** (n - k) * y ** k)   by ring_mult_comm
8656       = (##(binomial n k) * y) * (y ** k * x ** (n - k))   by ring_mult_comm
8657       = ##(binomial n k) * (y * y ** k * x ** (n - k))     by ring_mult_assoc
8658       = ##(binomial n k) * (y ** SUC k * x ** (n - k))     by ring_exp_SUC
8659       = ##(binomial n k) * (x ** (n - k) * y ** SUC k)     by ring_mult_comm
8660       = ##(binomial n k) * x ** (n - k) * y ** SUC k       by ring_mult_assoc
8661       = RHS
8662*)
8663Theorem ring_binomial_term_merge_y:
8664    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==>
8665   !n. (\k. y*k) o (\k. ##(binomial n k) * x ** (n - k) * y ** k) = (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k))
8666Proof
8667  rw_tac std_ss[FUN_EQ_THM] >>
8668  `##(binomial n k) IN R /\ x ** (n - k) IN R /\ y ** k IN R /\ y ** SUC k IN R` by rw[] >>
8669  `y * (##(binomial n k) * x ** (n - k) * y ** k) =
8670    (y * ##(binomial n k)) * (x ** (n - k) * y ** k)` by rw[ring_mult_assoc] >>
8671  `_ = (##(binomial n k) * y) * (y ** k * x ** (n - k))` by rw_tac std_ss[ring_mult_comm] >>
8672  `_ = ##(binomial n k) * (y ** SUC k * x ** (n - k))` by rw[ring_mult_assoc] >>
8673  `_ = ##(binomial n k) * (x ** (n - k) * y ** SUC k)` by rw_tac std_ss[ring_mult_comm] >>
8674  rw[ring_mult_assoc]
8675QED
8676
8677
8678(* GOAL: *)
8679
8680(* Theorem: [Binomial Theorem]  (x + y)^n = rsum (k=0..n) C(n,k)x^(n-k)y^k
8681   or (x + y)**n = rsum (GENLIST (\k. (binomial n k)* x**(n-k) * y**k) (SUC n)) *)
8682(* Proof: by induction on n.
8683   Base case: to prove (x + y)^0 = rsum (k=0..0) C(0,k)x^(0-k)y^k
8684   or  (x + y) ** 0 = rsum (GENLIST (\k. ##(binomial 0 k) * x ** (0 - k) * y ** k) (SUC 0))
8685   LHS = (x + y) ** 0 = #1        by ring_exp_0, ring_add_element
8686   RHS = rsum (GENLIST (\k. ##(binomial 0 k) * x ** (0 - k) * y ** k) (SUC 0))
8687       = rsum (GENLIST (\k. ##(binomial 0 k) * x ** (0 - k) * y ** k) 1)   by ONE
8688       = rsum (SNOC (##(binomial 0 0) * x ** 0 * y ** 0) [])               by GENLIST
8689       = rsum [##(binomial 0 0) * x ** 0 * y ** 0]                         by SNOC
8690       = rsum [##(binomial 0 0) * #1 * #1]                                 by ring_exp_0
8691       = rsum [##1 * #1 * #1]                                              by binomial_n_n
8692       = rsum [#1 * #1 * #1]                                               by ring_num_1
8693       = rsum [#1]                                                         by ring_mult_one_one
8694       = #1                                                                by ring_sum_sing, ring_one_element
8695       = LHS
8696   Step case: assume (x + y)^n = rsum (k=0..n) C(n,k)x^(n-k)y^k
8697    to prove: (x + y)^SUC n = rsum (k=0..(SUC n)) C(SUC n,k)x^((SUC n)-k)y^k
8698    or (x + y) ** n = rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** k) (SUC n)) ==>
8699       (x + y) ** SUC n = rsum (GENLIST (\k. ##(binomial (SUC n) k) * x ** (SUC n - k) * y ** k) (SUC (SUC n)))
8700   LHS = (x + y) ** SUC n
8701       = (x + y) * (x + y) ** n       by ring_exp_SUC
8702       = (x + y) * rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** k) (SUC n))    by induction hypothesis
8703       = x * rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** k) (SUC n)) +
8704         y * rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** k) (SUC n))          by ring_mult_ladd
8705       = rsum (MAP (\k. x*k) (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** k) (SUC n))) +
8706         rsum (MAP (\k. y*k) (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** k) (SUC n)))  by ring_sum_mult
8707       = rsum (GENLIST ((\k. x*k) o (\k. ##(binomial n k) * x ** (n - k) * y ** k)) (SUC n)) +
8708         rsum (GENLIST ((\k. y*k) o (\k. ##(binomial n k) * x ** (n - k) * y ** k)) (SUC n))    by MAP_GENLIST
8709       = rsum (GENLIST (\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) (SUC n)) +
8710         rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) (SUC n))
8711                                                               by ring_binomial_term_merge_x, ring_binomial_term_merge_y
8712       = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8713         rsum (GENLIST ((\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) o SUC) n) +
8714         rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) (SUC n))   by ring_sum_decompose_first
8715       = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8716         rsum (GENLIST ((\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) o SUC) n) +
8717        (rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n) +
8718        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n )                      by ring_sum_decompose_last
8719       = (\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) 0 +
8720         rsum (GENLIST (\k. ##(binomial n (SUC k)) * x ** (n - k) * y ** (SUC k)) n) +
8721        (rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n) +
8722        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n )             by ring_binomial_genlist_index_shift
8723       = (\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) 0 +
8724        (rsum (GENLIST (\k. ##(binomial n (SUC k)) * x ** (n - k) * y ** (SUC k)) n) +
8725         rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n)) +
8726        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n               by ring_add_assoc, ring_add_element
8727       = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8728        rsum (GENLIST (\k. (##(binomial n (SUC k)) * x ** (n - k) * y ** (SUC k) +
8729                            ##(binomial n k) * x ** (n - k) * y ** (SUC k))) n) +
8730        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n                by ring_sum_genlist_add
8731       = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8732        rsum (GENLIST (\k. (##(binomial n (SUC k)) + ##(binomial n k)) * x ** (n - k) * y ** (SUC k)) n) +
8733        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n                by ring_mult_ladd, ring_mult_element
8734       = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8735        rsum (GENLIST (\k. (##(binomial n (SUC k)) * (x ** (n - k) * y ** (SUC k)) +
8736                            ##(binomial n k) * (x ** (n - k) * y ** (SUC k)))) n) +
8737        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n                by  ring_mult_assoc
8738       = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8739        rsum (GENLIST (\k. ##(binomial n (SUC k) + binomial n k) * (x ** (n - k) * y ** (SUC k))) n) +
8740        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n                by ring_num_add_mult, ring_mult_element
8741       = (\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) 0 +
8742        rsum (GENLIST (\k. ##(binomial (SUC n) (SUC k)) * (x ** (n - k) * y ** (SUC k))) n) +
8743        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n                by binomial_recurrence, ADD_COMM
8744       = (\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) 0 +
8745        rsum (GENLIST (\k. ##(binomial (SUC n) (SUC k)) * x ** (n - k) * y ** (SUC k)) n) +
8746        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n                by ring_mult_assoc
8747       = ##(binomial n 0) * x ** (SUC n) * y ** 0 +
8748        rsum (GENLIST (\k. ##(binomial (SUC n) (SUC k)) * x ** (n - k) * y ** (SUC k)) n) +
8749        ##(binomial n n) * x ** 0 * y ** (SUC n)                              by function application
8750       = ##(binomial (SUC n) 0) * x ** (SUC n) * y ** 0 +
8751        rsum (GENLIST (\k. ##(binomial (SUC n) (SUC k)) * x ** (n - k) * y ** (SUC k)) n) +
8752        ##(binomial (SUC n) (SUC n)) * x ** 0 * y ** (SUC n)                  by binomial_n_0, binomial_n_n
8753       = ##(binomial (SUC n) 0) * x ** (SUC n) * y ** 0 +
8754        rsum (GENLIST ((\k. ##(binomial (SUC n) k) * x ** ((SUC n) - k) * y ** k) o SUC) n) +
8755        ##(binomial (SUC n) (SUC n)) * x ** 0 * y ** (SUC n)                  by ring_binomial_index_shift
8756       = (\k. ##(binomial (SUC n) k) * x ** ((SUC n) - k) * y ** k) 0 +
8757        rsum (GENLIST ((\k. ##(binomial (SUC n) k) * x ** ((SUC n) - k) * y ** k) o SUC) n) +
8758        (\k. ##(binomial (SUC n) k) * x ** ((SUC n) - k) * y ** k) (SUC n)    by function application
8759       = rsum (GENLIST (\k. ##(binomial (SUC n) k) * x ** (SUC n - k) * y ** k) (SUC n)) +
8760        (\k. ##(binomial (SUC n) k) * x ** (SUC n - k) * y ** k) (SUC n)      by ring_sum_decompose_first
8761       = rsum (GENLIST (\k. ##(binomial (SUC n) k) * x ** (SUC n - k) * y ** k) (SUC (SUC n))) by ring_sum_decompose_last
8762       = RHS
8763    Conventionally,
8764      (x + y)^SUC n
8765    = (x + y)(x + y)^n      by EXP
8766    = (x + y) rsum (k=0..n) C(n,k)x^(n-k)y^k   by induction hypothesis
8767    = x (rsum (k=0..n) C(n,k)x^(n-k)y^k) +
8768      y (rsum (k=0..n) C(n,k)x^(n-k)y^k)       by RIGHT_ADD_DISTRIB
8769    = rsum (k=0..n) C(n,k)x^(n+1-k)y^k +
8770      rsum (k=0..n) C(n,k)x^(n-k)y^(k+1)       by moving factor into ring_sum
8771    = C(n,0)x^(n+1) + rsum (k=1..n) C(n,k)x^(n+1-k)y^k +
8772                      rsum (k=0..n-1) C(n,k)x^(n-k)y^(k+1) + C(n,n)y^(n+1)  by breaking sum
8773    = C(n,0)x^(n+1) + rsum (k=0..n-1) C(n,k+1)x^(n-k)y^(k+1) +
8774                      rsum (k=0..n-1) C(n,k)x^(n-k)y^(k+1) + C(n,n)y^(n+1)  by index shifting
8775    = C(n,0)x^(n+1) + rsum (k=0..n-1) [C(n,k+1) + C(n,k)] x^(n-k)y^(k+1) + C(n,n)y^(n+1)     by merging sums
8776    = C(n,0)x^(n+1) + rsum (k=0..n-1) C(n+1,k+1) x^(n-k)y^(k+1)          + C(n,n)y^(n+1)     by binomial recurrence
8777    = C(n,0)x^(n+1) + rsum (k=1..n) C(n+1,k) x^(n+1-k)y^k                + C(n,n)y^(n+1)     by index shifting again
8778    = C(n+1,0)x^(n+1) + rsum (k=1..n) C(n+1,k) x^(n+1-k)y^k              + C(n+1,n+1)y^(n+1) by binomial identities
8779    = rsum (k=0..(SUC n))C(SUC n,k) x^((SUC n)-k)y^k                                         by synthesis of sum
8780*)
8781Theorem ring_binomial_thm:
8782    !r:'a ring. Ring r ==> !x y. x IN R /\ y IN R ==>
8783   !n. (x + y)**n = rsum (GENLIST (\k. ##(binomial n k) * x**(n-k) * y**k) (SUC n))
8784Proof
8785  rpt strip_tac >>
8786  Induct_on `n` >-
8787  rw[ring_sum_sing, binomial_n_n] >>
8788  rw_tac std_ss[ring_exp_SUC, ring_add_element] >>
8789  `!m n k h. ##(binomial m n) IN R /\ x ** h IN R /\ y ** k IN R` by rw[] >>
8790  `!h. (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) h IN R` by rw_tac std_ss[ring_mult_element] >>
8791  `!h. (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) h IN R` by rw_tac std_ss[ring_mult_element] >>
8792  `!m. rfun (\k. ##(binomial m k) * x ** (m - k) * y ** k)` by rw_tac std_ss[ring_fun_def, ring_mult_element] >>
8793  `!m n. rlist (GENLIST (\k. ##(binomial m k) * x ** (m - k) * y ** k) n)` by rw_tac std_ss[ring_fun_genlist] >>
8794  `!m n. rsum (GENLIST (\k. ##(binomial m k) * x ** (m - k) * y ** k) n) IN R` by rw_tac std_ss[ring_sum_element] >>
8795  `!m. rfun (\k. ##(binomial m k) * x ** (m - k) * y ** SUC k)` by rw_tac std_ss[ring_fun_def, ring_mult_element] >>
8796  `!m n. rlist (GENLIST (\k. ##(binomial m k) * x ** (m - k) * y ** SUC k) n)` by rw_tac std_ss[ring_fun_genlist] >>
8797  `!m n. rsum (GENLIST (\k. ##(binomial m k) * x ** (m - k) * y ** SUC k) n) IN R` by rw_tac std_ss[ring_sum_element] >>
8798  `!m. rfun (\k. ##(binomial m (SUC k)) * x ** (m - k) * y ** SUC k)` by rw_tac std_ss[ring_fun_def, ring_mult_element] >>
8799  `!m n. rlist (GENLIST (\k. ##(binomial m (SUC k)) * x ** (m - k) * y ** SUC k) n)` by rw_tac std_ss[ring_fun_genlist] >>
8800  `!m n. rsum (GENLIST (\k. ##(binomial m (SUC k)) * x ** (m - k) * y ** SUC k) n) IN R` by rw_tac std_ss[ring_sum_element] >>
8801  `(x + y) * rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** k) (SUC n)) =
8802    x * rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** k) (SUC n)) +
8803    y * rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** k) (SUC n))` by rw_tac std_ss[ring_mult_ladd] >>
8804  `_ = rsum (GENLIST ((\k. x*k) o (\k. ##(binomial n k) * x ** (n - k) * y ** k)) (SUC n)) +
8805        rsum (GENLIST ((\k. y*k) o (\k. ##(binomial n k) * x ** (n - k) * y ** k)) (SUC n))`
8806    by rw_tac std_ss[ring_sum_mult, MAP_GENLIST] >>
8807  `_ = rsum (GENLIST (\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) (SUC n)) +
8808        rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) (SUC n))`
8809    by rw_tac std_ss[ring_binomial_term_merge_x, ring_binomial_term_merge_y] >>
8810  `_ = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8811         rsum (GENLIST ((\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) o SUC) n) +
8812         rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) (SUC n))`
8813    by rw_tac std_ss[ring_sum_decompose_first] >>
8814  `_ = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8815         rsum (GENLIST ((\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) o SUC) n) +
8816        (rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n) +
8817        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n )`
8818    by rw_tac std_ss[ring_sum_decompose_last] >>
8819  `_ = (\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) 0 +
8820         rsum (GENLIST (\k. ##(binomial n (SUC k)) * x ** (n - k) * y ** (SUC k)) n) +
8821        (rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n) +
8822        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n )`
8823    by rw_tac std_ss[ring_binomial_genlist_index_shift] >>
8824  `_ = (\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) 0 +
8825        (rsum (GENLIST (\k. ##(binomial n (SUC k)) * x ** (n - k) * y ** (SUC k)) n) +
8826         rsum (GENLIST (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n)) +
8827       (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n`
8828    by rw_tac std_ss[ring_add_assoc, ring_add_element] >>
8829  `_ = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8830        rsum (GENLIST (\k. (##(binomial n (SUC k)) * x ** (n - k) * y ** (SUC k) +
8831                            ##(binomial n k) * x ** (n - k) * y ** (SUC k))) n) +
8832        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n`
8833    by rw_tac std_ss[ring_sum_genlist_add] >>
8834  `_ = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8835        rsum (GENLIST (\k. (##(binomial n (SUC k)) * (x ** (n - k) * y ** (SUC k)) +
8836                            ##(binomial n k) * (x ** (n - k) * y ** (SUC k)))) n) +
8837        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n`
8838    by rw_tac std_ss[ring_mult_assoc] >>
8839  `_ = (\k. ##(binomial n k) * x ** SUC (n - k) * y ** k) 0 +
8840        rsum (GENLIST (\k. ##(binomial n (SUC k) + binomial n k) * (x ** (n - k) * y ** (SUC k))) n) +
8841        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n`
8842    by rw_tac std_ss[ring_num_add_mult, ring_mult_element] >>
8843  `_ = (\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) 0 +
8844        rsum (GENLIST (\k. ##(binomial (SUC n) (SUC k)) * (x ** (n - k) * y ** (SUC k))) n) +
8845        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n`
8846    by rw_tac std_ss[binomial_recurrence, ADD_COMM] >>
8847  `_ = (\k. ##(binomial n k) * x ** SUC(n - k) * y ** k) 0 +
8848        rsum (GENLIST (\k. ##(binomial (SUC n) (SUC k)) * x ** (n - k) * y ** (SUC k)) n) +
8849        (\k. ##(binomial n k) * x ** (n - k) * y ** (SUC k)) n`
8850    by rw_tac std_ss[ring_mult_assoc] >>
8851  `_ = ##(binomial (SUC n) 0) * x ** (SUC n) * y ** 0 +
8852        rsum (GENLIST (\k. ##(binomial (SUC n) (SUC k)) * x ** (n - k) * y ** (SUC k)) n) +
8853        ##(binomial (SUC n) (SUC n)) * x ** 0 * y ** (SUC n)`
8854        by rw_tac std_ss[binomial_n_0, binomial_n_n] >>
8855  `_ = ##(binomial (SUC n) 0) * x ** (SUC n) * y ** 0 +
8856        rsum (GENLIST ((\k. ##(binomial (SUC n) k) * x ** ((SUC n) - k) * y ** k) o SUC) n) +
8857        ##(binomial (SUC n) (SUC n)) * x ** 0 * y ** (SUC n)`
8858        by rw_tac std_ss[ring_binomial_index_shift] >>
8859  `_ = rsum (GENLIST (\k. ##(binomial (SUC n) k) * x ** (SUC n - k) * y ** k) (SUC n)) +
8860        (\k. ##(binomial (SUC n) k) * x ** (SUC n - k) * y ** k) (SUC n)`
8861        by rw_tac std_ss[ring_sum_decompose_first] >>
8862  `_ = rsum (GENLIST (\k. ##(binomial (SUC n) k) * x ** (SUC n - k) * y ** k) (SUC (SUC n)))`
8863        by rw_tac std_ss[ring_sum_decompose_last] >>
8864  rw_tac std_ss[]
8865QED
8866
8867(* This is a major milestone theorem. *)
8868
8869(* ------------------------------------------------------------------------- *)
8870(* Ring with prime characteristic                                            *)
8871(* ------------------------------------------------------------------------- *)
8872
8873(* Theorem: Ring r ==> prime (char r) <=> 1 < char r /\ ##(binomial (char r) k) = #0   for  0 < k < (char r) *)
8874(* Proof:
8875       prime (char r)
8876   <=> divides (char r) (binomial (char r) k) for 0 < k < (char r) by prime_iff_divides_binomials
8877   <=> ##(binomial (char r) k) = #0           for 0 < k < (char r) by ring_char_divides
8878*)
8879Theorem ring_char_prime:
8880    !r:'a ring. Ring r ==>
8881   (prime (char r) <=> 1 < char r /\ !k. 0 < k /\ k < char r ==> (##(binomial (char r) k) = #0))
8882Proof
8883  rw_tac std_ss[prime_iff_divides_binomials, ring_char_divides]
8884QED
8885
8886(* Theorem: [Freshman's Theorem]
8887            Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
8888            ((x + y) ** (char r) = x ** (char r) + y ** (char r)) *)
8889(* Proof:
8890   Let p = char r.
8891   prime p ==> 0 < p                                 by PRIME_POS
8892   Let f = (\k. ##(binomial p k) * x**(p-k) * y**k), then
8893   then rfun f /\ f 0 IN R /\ f p IN R               by ring_fun_def
8894   !k. 0 < k /\ k < p ==> (##(binomial p k) = #0)    by ring_char_prime
8895   !k. 0 < k /\ k < p ==> (f k = #0)                 by ring_mult_lzero, ring_num_element, ring_exp_element
8896     (x + y) ** p
8897   = rsum (GENLIST f) (SUC p))                       by ring_binomial_thm
8898   = f 0 + rsum (GENLIST (f o SUC) (PRE p)) + f p    by ring_sum_decompose_first_last
8899   = f 0 + rsum (MAP f (GENLIST SUC (PRE p))) + f p  by MAP_GENLIST
8900   = f 0 + #0 + f p                                  by ring_sum_fun_zero
8901   = f 0 + f p                                       by ring_add_rzero
8902
8903   f 0 = ##(binomial p 0) * x**(p-0) * y**0
8904       =  #1 * x**p * #1                             by binomial_n_0, ring_exp_0, ring_num_1
8905       = x ** p                                      by ring_mult_lone, ring_mult_rone
8906   f p = ##(binomial p p) * x**(p-p) * y**p
8907       = #1 * #1 * y**p                              by binomial_n_n, ring_exp_0, ring_num_1
8908       = y ** p                                      by ring_exp_element, ring_mult_one_one
8909   The result follows.
8910*)
8911Theorem ring_freshman_thm:
8912    !r:'a ring. Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
8913         ((x + y) ** (char r) = x ** (char r) + y ** (char r))
8914Proof
8915  rpt strip_tac >>
8916  qabbrev_tac `p = char r` >>
8917  `0 < p` by metis_tac[PRIME_POS] >>
8918  qabbrev_tac `f = (\k. ##(binomial p k) * x**(p-k) * y**k)` >>
8919  `rfun f /\ f 0 IN R /\ f p IN R` by rw[ring_fun_def, Abbr`f`] >>
8920  `!k. 0 < k /\ k < p ==> (##(binomial p k) = #0)` by metis_tac[ring_char_prime] >>
8921  `!k. 0 < k /\ k < p ==> (f k = #0)` by rw[Abbr`f`, Abbr`p`] >>
8922  `(x + y) ** p = rsum (GENLIST f (SUC p))` by rw_tac std_ss[ring_binomial_thm, Abbr(`p`), Abbr(`f`)] >>
8923  `(x + y) ** p = f 0 + rsum (GENLIST (f o SUC) (PRE p)) + f p` by metis_tac[ring_sum_decompose_first_last] >>
8924  `_ = f 0 + rsum (MAP f (GENLIST SUC (PRE p))) + f p` by rw_tac std_ss[MAP_GENLIST] >>
8925  `_ = f 0 + f p` by rw_tac std_ss[ring_sum_fun_zero, ring_add_rzero] >>
8926  `f 0 = #1 * x**p * #1` by rw_tac std_ss[Abbr`f`, binomial_n_0, ring_exp_0, ring_num_1] >>
8927  `f p = #1 * #1 * y**p` by rw_tac std_ss[Abbr`f`, binomial_n_n, ring_exp_0, ring_num_1] >>
8928  rw[]
8929QED
8930
8931(* Note: a ** b ** c = a ** (b ** c) *)
8932(* Theorem: [Freshman's Theorem Generalized]
8933             Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
8934             !n. (x + y) ** (char r) ** n = x ** (char r) ** n + y ** (char r) ** n *)
8935(* Proof:
8936   Let p = char r.
8937   prime p ==> 0 < p                by PRIME_POS
8938   By induction on n.
8939   Base case: (x + y) ** p ** 0 = x ** p ** 0 + y ** p ** 0
8940   LHS = (x + y) ** p ** 0
8941       = (x + y) ** 1               by EXP
8942       = x + y                      by ring_exp_1
8943       = x ** 1 + y ** 1            by ring_exp_1
8944       = x ** p ** 0 + y ** p ** 0  by EXP
8945       = RHS
8946   Step case: (x + y) ** p ** n = x ** p ** n + y ** p ** n ==>
8947              (x + y) ** p ** SUC n = x ** p ** SUC n + y ** p ** SUC n
8948   LHS = (x + y) ** p ** SUC n
8949       = (x + y) ** (p * p ** n)                   by EXP
8950       = (x + y) ** (p ** n * p)                   by MULT_COMM
8951       = ((x + y) ** p ** n) ** p                  by ring_exp_mult
8952       = (x ** p ** n + y ** p ** n) ** p          by induction hypothesis
8953       = (x ** p ** n) ** p + (y ** p ** n) ** p   by ring_freshman_thm
8954       = x ** (p ** n * p) + y ** (p ** n * p)     by ring_exp_mult
8955       = x ** (p * p ** n) + y ** (p * p ** n)     by MULT_COMM
8956       = x ** p ** SUC n + y ** p ** SUC n         by EXP
8957       = RHS
8958*)
8959Theorem ring_freshman_all:
8960    !r:'a ring. Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
8961   !n. (x + y) ** (char r) ** n = x ** (char r) ** n + y ** (char r) ** n
8962Proof
8963  rpt strip_tac >>
8964  qabbrev_tac `p = char r` >>
8965  Induct_on `n` >-
8966  rw[EXP] >>
8967  `(x + y) ** p ** SUC n = (x + y) ** (p * p ** n)` by rw[EXP] >>
8968  `_ = (x + y) ** (p ** n * p)` by rw_tac std_ss[MULT_COMM] >>
8969  `_ = ((x + y) ** p ** n) ** p` by rw[ring_exp_mult] >>
8970  `_ = (x ** p ** n + y ** p ** n) ** p` by rw[] >>
8971  `_ = (x ** p ** n) ** p + (y ** p ** n) ** p` by rw[ring_freshman_thm, Abbr`p`] >>
8972  `_ = x ** (p ** n * p) + y ** (p ** n * p)` by rw[ring_exp_mult] >>
8973  `_ = x ** (p * p ** n) + y ** (p * p ** n)` by rw_tac std_ss[MULT_COMM] >>
8974  `_ = x ** p ** SUC n + y ** p ** SUC n` by rw[EXP] >>
8975  rw[]
8976QED
8977
8978(* Theorem: Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
8979            ((x - y) ** char r = x ** char r - y ** char r) *)
8980(* Proof:
8981   Let m = char r.
8982     (x - y) ** m
8983   = (x + -y) ** m            by ring_sub_def
8984   = x ** m + (-y) ** m       by ring_freshman_thm
8985   If EVEN m,
8986      (-y) ** m = y ** m      by ring_neg_exp
8987      prime m ==> m = 2       by EVEN_PRIME
8988      y ** m = - (y ** m)     by ring_neg_char_2
8989      The result follows      by ring_sub_def
8990   If ~EVEN m,
8991      (-y) ** m = - (y ** m)  by ring_neg_exp
8992      The result follows      by ring_sub_def
8993*)
8994Theorem ring_freshman_thm_sub:
8995    !r:'a ring. Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
8996               ((x - y) ** char r = x ** char r - y ** char r)
8997Proof
8998  rpt strip_tac >>
8999  qabbrev_tac `m = char r` >>
9000  rw[] >>
9001  `(x + -y) ** m = x ** m + (-y) ** m` by rw[ring_freshman_thm, Abbr`m`] >>
9002  Cases_on `EVEN m` >-
9003  rw[GSYM EVEN_PRIME, ring_neg_exp, ring_neg_char_2, Abbr`m`] >>
9004  rw[ring_neg_exp]
9005QED
9006
9007(* Theorem: Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
9008            !n. (x - y) ** (char r) ** n = x ** (char r) ** n - y ** (char r) ** n *)
9009(* Proof:
9010   Let m = char r.
9011   prime m ==> 0 < m                by PRIME_POS
9012   By induction on n.
9013   Base case: (x - y) ** m ** 0 = x ** m ** 0 - y ** m ** 0
9014        (x - y) ** m ** 0
9015      = (x - y) ** 1               by EXP
9016      = x - y                      by ring_exp_1
9017      = x ** 1 - y ** 1            by ring_exp_1
9018      = x ** m ** 0 - y ** m ** 0  by EXP
9019   Step case: (x - y) ** m ** n = x ** m ** n - y ** m ** n ==>
9020              (x - y) ** m ** SUC n = x ** m ** SUC n - y ** m ** SUC n
9021        (x - y) ** m ** SUC n
9022      = (x - y) ** (m * m ** n)                   by EXP
9023      = (x - y) ** (m ** n * m)                   by MULT_COMM
9024      = ((x - y) ** m ** n) ** m                  by ring_exp_mult
9025      = (x ** m ** n - y ** m ** n) ** m          by induction hypothesis
9026      = (x ** m ** n) ** m - (y ** m ** n) ** m   by ring_freshman_thm_sub
9027      = x ** (m ** n * m) - y ** (m ** n * m)     by ring_exp_mult
9028      = x ** (m * m ** n) - y ** (m * m ** n)     by MULT_COMM
9029      = x ** m ** SUC n - y ** m ** SUC n         by EXP
9030*)
9031Theorem ring_freshman_all_sub:
9032    !r:'a ring. Ring r /\ prime (char r) ==> !x y. x IN R /\ y IN R ==>
9033   !n. (x - y) ** (char r) ** n = x ** (char r) ** n - y ** (char r) ** n
9034Proof
9035  rpt strip_tac >>
9036  qabbrev_tac `m = char r` >>
9037  Induct_on `n` >-
9038  rw[EXP] >>
9039  `(x - y) ** m ** SUC n = (x - y) ** (m * m ** n)` by rw[EXP] >>
9040  `_ = (x - y) ** (m ** n * m)` by rw_tac std_ss[MULT_COMM] >>
9041  `_ = ((x - y) ** m ** n) ** m` by rw[ring_exp_mult] >>
9042  `_ = (x ** m ** n - y ** m ** n) ** m` by rw[] >>
9043  `_ = (x ** m ** n) ** m - (y ** m ** n) ** m` by rw[ring_freshman_thm_sub, Abbr`m`] >>
9044  `_ = x ** (m ** n * m) - y ** (m ** n * m)` by rw[ring_exp_mult] >>
9045  `_ = x ** (m * m ** n) - y ** (m * m ** n)` by rw_tac std_ss[MULT_COMM] >>
9046  `_ = x ** m ** SUC n - y ** m ** SUC n` by rw[EXP] >>
9047  rw[]
9048QED
9049
9050(* Theorem: [Fermat's Little Theorem]
9051            Ring r /\ prime (char r) ==> !n. (##n) ** (char r) = (##n)  *)
9052(* Proof: by induction on n.
9053   Let p = char r, prime p ==> 0 < p   by PRIME_POS
9054   Base case: ##0 ** p = ##0
9055     ##0 ** p
9056   = #0 ** p              by ring_num_0
9057   = #0                   by ring_zero_exp, p <> 0
9058   = ##0                  by ring_num_0
9059   Step case: ##n ** p = ##n ==> ##(SUC n) ** p = ##(SUC n)
9060     ##(SUC n) ** p
9061   = (#1 + ##n) ** p      by ring_num_SUC
9062   = #1 ** p + ##n ** p   by ring_freshman_thm
9063   = #1 ** p + ##n        by induction hypothesis
9064   = #1 + ##n             by ring_one_exp
9065   = ##(SUC n)            by ring_num_SUC
9066*)
9067Theorem ring_fermat_thm:
9068    !r:'a ring. Ring r /\ prime (char r) ==> !n. (##n) ** (char r) = (##n)
9069Proof
9070  rpt strip_tac >>
9071  qabbrev_tac `p = char r` >>
9072  `0 < p` by rw_tac std_ss[PRIME_POS] >>
9073  `p <> 0` by decide_tac >>
9074  Induct_on `n` >| [
9075    rw[ring_zero_exp],
9076    rw_tac std_ss[ring_num_SUC] >>
9077    `#1 IN R /\ ##n IN R` by rw[] >>
9078    metis_tac[ring_freshman_thm, ring_one_exp]
9079  ]
9080QED
9081
9082(* Theorem: [Fermat's Little Theorem Generalized]
9083            Ring r /\ prime (char r) ==> !n k. (##n) ** (char r) ** k = (##n)  *)
9084(* Proof:
9085   Let p = char r. By induction on k.
9086   Base case: ##n ** p ** 0 = ##n
9087     ##n ** p ** 0
9088   = ##n ** 1               by EXP
9089   = ##n                    by ring_exp_1
9090   Step case: ##n ** p ** k = ##n ==> ##n ** p ** SUC k = ##n
9091     ##n ** p ** SUC k
9092   = ##n ** (p * p ** k)    by EXP
9093   = ##n ** (p ** k * p)    by MULT_COMM
9094   = (##n ** p ** k) ** p   by ring_exp_mult
9095   = ##n ** p               by induction hypothesis
9096   = ##n                    by ring_fermat_thm
9097*)
9098Theorem ring_fermat_all:
9099    !r:'a ring. Ring r /\ prime (char r) ==> !n k. (##n) ** (char r) ** k = (##n)
9100Proof
9101  rpt strip_tac >>
9102  qabbrev_tac `p = char r` >>
9103  Induct_on `k` >-
9104  rw[EXP] >>
9105  `##n ** p ** SUC k = ##n ** (p * p ** k)` by rw[EXP] >>
9106  `_ = ##n ** (p ** k * p)` by rw_tac std_ss[MULT_COMM] >>
9107  rw[ring_exp_mult, ring_fermat_thm, Abbr`p`]
9108QED
9109
9110(* Theorem: [Freshman Theorem for Ring Sum]
9111            Ring r /\ prime (char r) ==> !f. rfun f ==> !x. x IN R ==>
9112            !n. rsum (GENLIST (\j. f j * x ** j) n) ** char r =
9113                rsum (GENLIST (\j. (f j * x ** j) ** char r) n) *)
9114(* Proof:
9115   Let m = char r.
9116   By induction on n.
9117   Base case: rsum (GENLIST (\j. f j * x ** j) 0) ** m =
9118              rsum (GENLIST (\j. (f j * x ** j) ** m) 0)
9119      Note 0 < m                      by PRIME_POS
9120        rsum (GENLIST (\j. f j * x ** j) 0) ** m
9121      = rsum [] ** m                  by GENLIST
9122      = #0 ** m                       by ring_sum_nil
9123      = #0                            by ring_zero_exp, 0 < m.
9124      = rsum []                       by ring_sum_nil
9125      = rsum (GENLIST (\j. (f j * x ** j) ** m) 0)   by GENLIST
9126   Step case: rsum (GENLIST (\j. f j * x ** j) (SUC n)) ** m =
9127              rsum (GENLIST (\j. (f j * x ** j) ** m) (SUC n))
9128      Note rfun (\j. f j * x ** j)                   by ring_fun_from_ring_fun
9129       and rfun (\j. (f j * x ** j) ** m)            by ring_fun_from_ring_fun_exp
9130       and rsum (GENLIST (\j. f j * x ** j) n) IN R  by ring_sum_element, ring_list_gen_from_ring_fun
9131        rsum (GENLIST (\j. f j * x ** j) (SUC n)) ** m
9132      = (rsum (GENLIST (\j. f j * x ** j) n) + (f n * x ** n)) ** m       by ring_sum_decompose_last
9133      = (rsum (GENLIST (\j. f j * x ** j) n)) ** m + (f n * x ** n) ** m  by ring_freshman_thm
9134      = rsum (GENLIST (\j. (f j * x ** j) ** m) n) + (f n * x ** n) ** m  by induction hypothesis
9135      = rsum (GENLIST (\j. (f j * x ** j) ** m) (SUC n))                  by poly_sum_decompose_last
9136*)
9137Theorem ring_sum_freshman_thm:
9138    !r:'a ring. Ring r /\ prime (char r) ==> !f. rfun f ==> !x. x IN R ==>
9139   !n. rsum (GENLIST (\j. f j * x ** j) n) ** char r =
9140       rsum (GENLIST (\j. (f j * x ** j) ** char r) n)
9141Proof
9142  rpt strip_tac >>
9143  qabbrev_tac `m = char r` >>
9144  Induct_on `n` >| [
9145    rw_tac std_ss[GENLIST, ring_sum_nil] >>
9146    `0 < m` by rw[PRIME_POS, Abbr`m`] >>
9147    `m <> 0` by decide_tac >>
9148    rw[ring_zero_exp],
9149    `rfun (\j. f j * x ** j)` by rw[ring_fun_from_ring_fun] >>
9150    `rfun (\j. (f j * x ** j) ** m)` by rw[ring_fun_from_ring_fun_exp] >>
9151    `rsum (GENLIST (\j. f j * x ** j) n) IN R` by rw[ring_sum_element, ring_list_gen_from_ring_fun] >>
9152    `!j. f j IN R` by metis_tac[ring_fun_def] >>
9153    `f n * x ** n IN R` by rw[] >>
9154    `rsum (GENLIST (\j. f j * x ** j) (SUC n)) ** m
9155    = (rsum (GENLIST (\j. f j * x ** j) n) + (f n * x ** n)) ** m` by rw[ring_sum_decompose_last] >>
9156    `_ = (rsum (GENLIST (\j. f j * x ** j) n)) ** m + (f n * x ** n) ** m` by rw[ring_freshman_thm, Abbr`m`] >>
9157    `_ = rsum (GENLIST (\j. (f j * x ** j) ** m) n) + (f n * x ** n) ** m` by rw[] >>
9158    `_ = rsum (GENLIST (\j. (f j * x ** j) ** m) (SUC n))` by rw[ring_sum_decompose_last] >>
9159    rw[]
9160  ]
9161QED
9162
9163(* Theorem: Ring r /\ prime (char r) ==> !f. rfun f ==> !x. x IN R ==>
9164            !n k. rsum (GENLIST (\j. f j * x ** j) n) ** char r ** k =
9165                  rsum (GENLIST (\j. (f j * x ** j) ** char r ** k) n) *)
9166(* Proof:
9167   Let m = char r.
9168   By induction on n.
9169   Base case: rsum (GENLIST (\j. f j * x ** j) 0) ** m ** k =
9170              rsum (GENLIST (\j. (f j * x ** j) ** m ** k) 0)
9171      Note 0 < m                      by PRIME_POS
9172        so 0 < m ** k                 by EXP_NONZERO
9173        rsum (GENLIST (\j. f j * x ** j) 0) ** m ** k
9174      = rsum [] ** m ** k        by GENLIST
9175      = #0 ** m ** k             by ring_sum_nil
9176      = #0                       by ring_zero_exp, 0 < m ** k.
9177      = rsum []                  by ring_sum_nil
9178      = rsum (GENLIST (\j. (f j * x ** j) ** m ** k) 0)   by GENLIST
9179   Step case: rsum (GENLIST (\j. f j * x ** j) (SUC n)) ** m ** k =
9180              rsum (GENLIST (\j. (f j * x ** j) ** m ** k) (SUC n))
9181      Note rfun (\j. f j * x ** j)                   by ring_fun_from_ring_fun
9182       and rfun (\j. (f j * x ** j) ** m ** k)       by ring_fun_from_ring_fun_exp
9183       and rsum (GENLIST (\j. f j * x ** j) n) IN R  by ring_sum_element, ring_list_gen_from_ring_fun
9184        rsum (GENLIST (\j. f j * x ** j) (SUC n)) ** m ** k
9185      = (rsum (GENLIST (\j. f j * x ** j) n) + (f n * x ** n)) ** m ** k            by ring_sum_decompose_last
9186      = (rsum (GENLIST (\j. f j * x ** j) n)) ** m ** k + (f n * x ** n) ** m ** k  by ring_freshman_all
9187      = rsum (GENLIST (\j. (f j * x ** j) ** m ** k) n) + (f n * x ** n) ** m ** k  by induction hypothesis
9188      = rsum (GENLIST (\j. (f j * x ** j) ** m ** k) (SUC n))                       by ring_sum_decompose_last
9189*)
9190Theorem ring_sum_freshman_all:
9191    !r:'a ring. Ring r /\ prime (char r) ==> !f. rfun f ==> !x. x IN R ==>
9192   !n k. rsum (GENLIST (\j. f j * x ** j) n) ** char r ** k =
9193         rsum (GENLIST (\j. (f j * x ** j) ** char r ** k) n)
9194Proof
9195  rpt strip_tac >>
9196  qabbrev_tac `m = char r` >>
9197  Induct_on `n` >| [
9198    rw_tac std_ss[GENLIST, ring_sum_nil] >>
9199    `0 < m` by rw[PRIME_POS, Abbr`m`] >>
9200    `m <> 0` by decide_tac >>
9201    `m ** k <> 0` by rw[EXP_NONZERO] >>
9202    rw[ring_zero_exp],
9203    `rfun (\j. f j * x ** j)` by rw[ring_fun_from_ring_fun] >>
9204    `rfun (\j. (f j * x ** j) ** m ** k)` by rw[ring_fun_from_ring_fun_exp] >>
9205    `rsum (GENLIST (\j. f j * x ** j) n) IN R` by rw[ring_sum_element, ring_list_gen_from_ring_fun] >>
9206    `!j. f j IN R` by metis_tac[ring_fun_def] >>
9207    `f n * x ** n IN R` by rw[] >>
9208    `rsum (GENLIST (\j. f j * x ** j) (SUC n)) ** m ** k
9209    = (rsum (GENLIST (\j. f j * x ** j) n) + (f n * x ** n)) ** m ** k` by rw[ring_sum_decompose_last] >>
9210    `_ = (rsum (GENLIST (\j. f j * x ** j) n)) ** m ** k + (f n * x ** n) ** m ** k` by rw[ring_freshman_all, Abbr`m`] >>
9211    `_ = rsum (GENLIST (\j. (f j * x ** j) ** m ** k) n) + (f n * x ** n) ** m ** k` by rw[] >>
9212    `_ = rsum (GENLIST (\j. (f j * x ** j) ** m ** k) (SUC n))` by rw[ring_sum_decompose_last] >>
9213    rw[]
9214  ]
9215QED
9216
9217(* Theorem: [Frobenius Theorem]
9218            For a Ring with prime p = char r, x IN R,
9219            the map x --> x^p  is a ring homomorphism to itself (endomorphism)
9220         or Ring r /\ prime (char r) ==> RingEndo (\x. x ** (char r)) r  *)
9221(* Proof:
9222   Let p = char r, and prime p.
9223   First, x IN R ==> x ** p IN R           by ring_exp_element.
9224   So we need to verify F(x) = x ** p is a ring homomorphism, meaning:
9225   (1) Ring r /\ prime p ==> GroupHomo (\x. x ** p) (ring_sum r) (ring_sum r)
9226       Expanding by GroupHomo_def, this is to show:
9227       Ring r /\ prime p /\ x IN R /\ x' IN R ==> (x + x') ** p = x ** p + x' ** p
9228       which is true by ring_freshman_thm.
9229   (2) Ring r ==> MonoidHomo (\x. x ** p) r.prod r.prod
9230       Expanding by MonoidHomo_def, this is to show:
9231       Ring r /\ prime p /\ x IN R /\ x' IN R ==> (x * x') ** p = x ** p * x' ** p
9232       which is true by ring_mult_exp.
9233*)
9234Theorem ring_char_prime_endo:
9235    !r:'a ring. Ring r /\ prime (char r) ==> RingEndo (\x. x ** (char r)) r
9236Proof
9237  rpt strip_tac >>
9238  rw[RingEndo_def, RingHomo_def] >| [
9239    rw[GroupHomo_def] >>
9240    metis_tac[ring_freshman_thm],
9241    rw[MonoidHomo_def, ring_mult_monoid]
9242  ]
9243QED
9244
9245(* ------------------------------------------------------------------------- *)
9246(* Divisbility in Ring Documentation                                         *)
9247(* ------------------------------------------------------------------------- *)
9248(* Overloads:
9249   I             = i.carrier
9250   J             = j.carrier
9251   p rdivides q  = ring_divides r p q
9252   rassoc p q    = ring_associates r p q
9253   rprime p      = ring_prime r p
9254   rgcd p q      = ring_gcd r p q
9255   <a>           = principal_ideal r a
9256   <b>           = principal_ideal r b
9257   <u>           = principal_ideal r u
9258*)
9259(* Definitions and Theorems (# are exported):
9260
9261   Ring Divisiblity:
9262   ring_divides_def     |- !r q p. q rdivides p <=> ?s. s IN R /\ (p = s * q)
9263   ring_associates_def  |- !r p q. rassoc p q <=> ?s. unit s /\ (p = s * q)
9264   ring_prime_def       |- !r p. rprime p <=> !a b. a IN R /\ b IN R /\ p rdivides a * b ==> p rdivides a \/ p rdivides b
9265
9266   irreducible_associates |- !r. Ring r /\ #1 <> #0 ==> !p s. p IN R /\ unit s ==> (atom p <=> atom (s * p))
9267   irreducible_factors   |- !r z. atom z ==> z IN R+ /\ z NOTIN R* /\ !p. p IN R /\ p rdivides z ==> rassoc z p \/ unit p
9268
9269   ring_divides_refl    |- !r. Ring r ==> !p. p IN R ==> p rdivides p
9270   ring_divides_trans   |- !r. Ring r ==> !p q t. p IN R /\ q IN R /\ t IN R /\ p rdivides q /\ q rdivides t ==> p rdivides t
9271   ring_divides_zero    |- !r. Ring r ==> !p. p IN R ==> p rdivides #0
9272   ring_zero_divides    |- !r. Ring r ==> !x. x IN R ==> (#0 rdivides x <=> (x = #0))
9273   ring_divides_by_one  |- !r. Ring r ==> !p. p IN R ==> #1 rdivides p
9274   ring_divides_by_unit |- !r. Ring r ==> !p t. p IN R /\ unit t ==> t rdivides p
9275   ring_factor_multiple |- !r. Ring r ==> !p q. p IN R /\ q IN R /\ (?k. k IN R /\ (p = k * q)) ==>
9276                           !z. z IN R /\ (?s. s IN R /\ (z = s * p)) ==> ?t. t IN R /\ (z = t * q)
9277
9278   Euclidean Ring Greatest Common Divisor:
9279   ring_gcd_def          |- !r f p q. rgcd p q = if p = #0 then q else if q = #0 then p
9280                                  else (let s = {a * p + b * q | (a,b) | a IN R /\ b IN R /\ 0 < f (a * p + b * q)}
9281                                        in CHOICE (preimage f s (MIN_SET (IMAGE f s))))
9282   ring_gcd_zero         |- !r f p. (rgcd p #0 = p) /\ (rgcd #0 p = p)
9283   ring_gcd_linear       |- !r f. EuclideanRing r f ==> !p q. p IN R /\ q IN R ==>
9284                                  ?a b. a IN R /\ b IN R /\ (rgcd p q = a * p + b * q)
9285   ring_gcd_is_gcd       |- !r f. EuclideanRing r f ==> !p q. p IN R /\ q IN R ==>
9286                                  rgcd p q rdivides p /\ rgcd p q rdivides q /\
9287                                  !d. d IN R /\ d rdivides p /\ d rdivides q ==> d rdivides rgcd p q
9288   ring_gcd_divides      |- !r f. EuclideanRing r f ==> !p q. p IN R /\ q IN R ==> rgcd p q rdivides p /\ rgcd p q rdivides q
9289   ring_gcd_property     |- !r f. EuclideanRing r f ==> !p q. p IN R /\ q IN R ==>
9290                                  !d. d IN R /\ d rdivides p /\ d rdivides q ==> d rdivides rgcd p q
9291   ring_gcd_element      |- !r f. EuclideanRing r f ==> !p q. p IN R /\ q IN R ==> rgcd p q IN R
9292   ring_gcd_sym          |- !r f. EuclideanRing r f ==> !p q. p IN R /\ q IN R ==> (rgcd p q = rgcd q p)
9293   ring_irreducible_gcd  |- !r f. EuclideanRing r f ==> !p. p IN R /\ atom p ==> !q. q IN R ==> unit (rgcd p q) \/ p rdivides q
9294
9295   ring_ordering_def     |- !r f. ring_ordering r f <=> !a b. a IN R /\ b IN R /\ b <> #0 ==> f a <= f (a * b)
9296   ring_divides_le       |- !r f. EuclideanRing r f /\ ring_ordering r f ==>
9297                                  !p q. p IN R /\ q IN R /\ p <> #0 /\ q rdivides p ==> f q <= f p
9298
9299   Principal Ideal Ring: Irreducibles and Primes:
9300   principal_ideal_element_divides            |- !r. Ring r ==> !p. p IN R ==> !x. x IN <p>.carrier <=> p rdivides x
9301   principal_ideal_sub_implies_divides        |- !r. Ring r ==> !p q. p IN R /\ q IN R ==> (q rdivides p <=> <p> << <q>)
9302   principal_ideal_ring_atom_is_prime         |- !r. PrincipalIdealRing r ==> !p. atom p ==> rprime p
9303   principal_ideal_ring_irreducible_is_prime  |- !r. PrincipalIdealRing r ==> !p. atom p ==> rprime p
9304*)
9305
9306(* ------------------------------------------------------------------------- *)
9307(* Ring Divisiblity                                                          *)
9308(* ------------------------------------------------------------------------- *)
9309
9310(* The carrier of Ideal = carrier of group i.sum *)
9311Overload I[local] = ``i.carrier``
9312(* The carrier of Ideal = carrier of group j.sum *)
9313Overload J[local] = ``j.carrier``
9314
9315(* Divides relation in ring *)
9316Definition ring_divides_def:
9317  ring_divides (r:'a ring) (q:'a) (p:'a) =
9318    ?s:'a. s IN R /\ (p = s * q)
9319End
9320
9321(* Overload ring divides *)
9322Overload rdivides = ``ring_divides r``
9323val _ = set_fixity "rdivides" (Infix(NONASSOC, 450)); (* same as relation *)
9324(*
9325ring_divides_def;
9326> val it = |- !r q p. q | p <=> ?s. p = s * q : thm
9327*)
9328
9329(* Define ring associates *)
9330Definition ring_associates_def:
9331  ring_associates (r:'a ring) (p:'a) (q:'a) =
9332  ?s:'a. unit s /\ (p = s * q)
9333End
9334(* Overload ring associates *)
9335Overload rassoc = ``ring_associates r``
9336(*
9337- ring_associates_def;
9338> val it = |- !r p q. rassoc p q <=> ?s. unit s /\ (p = s * q) : thm
9339*)
9340
9341(* Define prime in ring *)
9342Definition ring_prime_def:
9343  ring_prime (r:'a ring) (p:'a) =
9344  !a b. a IN R /\ b IN R /\ p rdivides a * b ==> (p rdivides a) \/ (p rdivides b)
9345End
9346(* Overload prime in ring *)
9347Overload rprime = ``ring_prime r``
9348(*
9349- ring_prime_def;
9350> val it = |- !r p. rprime p <=> !a b. a IN R /\ b IN R /\ p rdivides a * b ==> p rdivides a \/ p rdivides b : thm
9351*)
9352
9353(* Theorem: Ring r /\ #1 <> #0 ==> p IN R /\ unit s ==> atom p <=> atom (s * p) *)
9354(* Proof:
9355   If part: atom p /\ unit s ==> atom (s * p)
9356   unit s ==> unit ( |/ s)   by ring_unit_has_inv
9357   and |/s IN R              by ring_unit_element
9358     |/s * (s * p)
9359   = ( |/s * s) * p          by ring_mult_assoc
9360   = #1 * p                  by ring_unit_linv
9361   = p                       by ring_mult_lone
9362   Since p <> #0             by irreducible_def, ring_nonzero_eq
9363   s * p <> #0               by ring_mult_rzero
9364   so s * p IN R+            by ring_nonzero_eq
9365   By irreducible_def, still more to show:
9366   (1) unit s /\ atom p ==> s * p NOTIN R*
9367       By contradiction, assume unit (s * p)
9368       Since Group r*                 by ring_units_group
9369           unit ( |/s) and unit (s * p)
9370       ==> unit ( |/s * (s * p))      by group_op_element
9371       ==> unit p                     by above
9372       which contradicts atom p       by irreducible_def
9373   (2) atom p /\ s * p = x * y ==> unit x \/ unit y
9374       |/s * (s * p) = |/s * (x * y)
9375       p = ( |/s * x) * y             by ring_mult_assoc
9376       Since atom p
9377       this means unit ( |/s * x) or unit y
9378                                      by irreducible_def
9379       If unit ( |/s * x)
9380       Since Group r*                 by ring_units_group
9381          unit s and unit ( |/s * x)
9382       ==> unit (s * |/s * x)         by group_op_element
9383       ==> unit (#1 * x) ==> unit x
9384       If unit y, this is trivial.
9385   Only-if part: p IN R /\ unit s /\ atom (s * p) ==> atom p /\ unit s
9386     unit s ==> s IN R                by ring_unit_element
9387     atom (p * s) ==> p * s <> #0     by irreducible_def
9388     hence p <> #0                    by ring_mult_rzero
9389     or p IN R+                       by ring_nonzero_eq
9390   By irreducible_def, still more to show:
9391   (1) unit s /\ atom (s * p) ==> p NOTIN R*
9392       By contradiction, assume unit p
9393       Since Group r*                 by ring_units_group
9394           unit s and unit p
9395       ==> unit (s * p)               by group_op_element
9396       which contradicts atom (s * p) by irreducible_def
9397   (2) unit s /\ atom (s * (x * y)) ==> unit x \/ unit y
9398       s * (x * y) = (s * x) * y      by ring_mult_assoc
9399       Since atom (s * (x * y))
9400       this means unit (s * x) or unit y
9401                                      by irreducible_def
9402       If unit (s * x)
9403       Since Group r*                 by ring_units_group
9404          unit ( |/s) and unit (s * x)
9405       ==> unit ( |/s * (s * x))      by group_op_element
9406       ==> unit (#1 * x) ==> unit x
9407       If unit y, this is trivial.
9408*)
9409Theorem irreducible_associates:
9410    !r:'a ring. Ring r /\ #1 <> #0 ==> !p s. p IN R /\ unit s ==> (atom p <=> atom (s * p))
9411Proof
9412  rw[EQ_IMP_THM] >| [
9413    `unit ((Invertibles r.prod).inv s)` by rw[ring_unit_has_inv] >>
9414    `s IN R` by rw[ring_unit_element] >>
9415    `s * p IN R /\ (Invertibles r.prod).inv s IN R` by rw[ring_unit_element] >>
9416    `((Invertibles r.prod).inv s) * (s * p) = ((Invertibles r.prod).inv s) * s * p` by rw[ring_mult_assoc] >>
9417    `_ = #1 * p` by rw[ring_unit_linv] >>
9418    `_ = p` by rw[] >>
9419    `p <> #0` by metis_tac[irreducible_def, ring_nonzero_eq] >>
9420    `s * p <> #0` by metis_tac[ring_mult_rzero] >>
9421    `s * p IN R+` by rw[ring_nonzero_eq] >>
9422    rw[irreducible_def] >| [
9423      spose_not_then strip_assume_tac >>
9424      `Group r*` by rw[ring_units_group] >>
9425      `unit (((Invertibles r.prod).inv s) * (s * p))` by metis_tac[group_op_element, ring_units_property] >>
9426      metis_tac[irreducible_def],
9427      `((Invertibles r.prod).inv s) * (x * y) = ((Invertibles r.prod).inv s) * x * y` by rw[ring_mult_assoc] >>
9428      `((Invertibles r.prod).inv s) * x IN R` by rw[] >>
9429      `unit (((Invertibles r.prod).inv s) * x) \/ unit y` by metis_tac[irreducible_def] >| [
9430        `Group r*` by rw[ring_units_group] >>
9431        `unit (s * (((Invertibles r.prod).inv s) * x))` by metis_tac[group_op_element, ring_units_property] >>
9432        `s * (((Invertibles r.prod).inv s) * x) = s * ((Invertibles r.prod).inv s) * x` by rw[ring_mult_assoc] >>
9433        `_ = #1 * x` by rw[ring_unit_rinv] >>
9434        `_ = x` by rw[] >>
9435        metis_tac[],
9436        rw[]
9437      ]
9438    ],
9439    `s IN R` by rw[ring_unit_element] >>
9440    `p IN R+` by metis_tac[ring_mult_rzero, irreducible_def, ring_nonzero_eq] >>
9441    rw[irreducible_def] >| [
9442      spose_not_then strip_assume_tac >>
9443      `Group r*` by rw[ring_units_group] >>
9444      `unit (s * p)` by metis_tac[group_op_element, ring_units_property] >>
9445      metis_tac[irreducible_def],
9446      `s * (x * y) = s * x * y` by rw[ring_mult_assoc] >>
9447      `s * x IN R` by rw[] >>
9448      `unit (s * x) \/ unit y` by metis_tac[irreducible_def] >| [
9449        `Group r*` by rw[ring_units_group] >>
9450        `unit ((Invertibles r.prod).inv s)` by rw[ring_unit_has_inv] >>
9451        `unit (((Invertibles r.prod).inv s) * (s * x))` by metis_tac[group_op_element, ring_units_property] >>
9452        `(Invertibles r.prod).inv s IN R` by rw[ring_unit_element] >>
9453        `((Invertibles r.prod).inv s) * (s * x) = ((Invertibles r.prod).inv s) * s * x` by rw[ring_mult_assoc] >>
9454        `_ = #1 * x` by rw[ring_unit_linv] >>
9455        `_ = x` by rw[] >>
9456        metis_tac[],
9457        rw[]
9458      ]
9459    ]
9460  ]
9461QED
9462
9463(* Theorem: atom z ==> z IN R+ /\ ~(unit z) /\ (!p. p IN R /\ p rdivides z ==> (rassoc z p) \/ unit p) *)
9464(* Proof:
9465       p rdivides z
9466   ==> ?s. s IN R /\ (z = s * p)    by ring_divides_def
9467   ==> unit s \/ unit p             by irreducible_def
9468   If unit s, rassoc z p            by ring_associates_def
9469   If unit p, trivially true.
9470*)
9471Theorem irreducible_factors:
9472    !r:'a ring. !z. atom z ==> z IN R+ /\ ~(unit z) /\ (!p. p IN R /\ p rdivides z ==> (rassoc z p) \/ unit p)
9473Proof
9474  rw[irreducible_def] >>
9475  `?s. s IN R /\ (z = s * p)` by rw[GSYM ring_divides_def] >>
9476  `unit s \/ unit p` by rw[] >-
9477  metis_tac[ring_associates_def] >>
9478  rw[]
9479QED
9480
9481(* Theorem: p rdivides p *)
9482(* Proof:
9483   Since #1 * p = p      by ring_mult_lone
9484   p rdivides p          by ring_divides_def
9485*)
9486Theorem ring_divides_refl:
9487    !r:'a ring. Ring r ==> !p. p IN R ==> p rdivides p
9488Proof
9489  rw[ring_divides_def] >>
9490  metis_tac[ring_mult_lone, ring_one_element]
9491QED
9492
9493(* Theorem: p rdivides q /\ q rdivides p ==> p = q *)
9494(* Proof:
9495*)
9496
9497(* Theorem: p rdivides q /\ q rdivides t ==> p rdivides t *)
9498(* Proof:
9499   p rdivides q ==> ?s. s IN R /\ q = s * p     by ring_divides_def
9500   q rdivides t ==> ?s'. s' IN R /\ t = s' * q  by ring_divides_def
9501   Hence t = s' * (s * p)
9502           = (s' * s) * p                       by ring_mult_assoc
9503   Since s' * s IN R                            by ring_mult_element
9504   p rdivides t                                 by ring_divides_def
9505*)
9506Theorem ring_divides_trans:
9507    !r:'a ring. Ring r ==> !p q t. p IN R /\ q IN R /\ t IN R /\ p rdivides q /\ q rdivides t ==> p rdivides t
9508Proof
9509  rw[ring_divides_def] >>
9510  `s' * (s * p) = s' * s * p` by rw[ring_mult_assoc] >>
9511  metis_tac[ring_mult_element]
9512QED
9513
9514(* Theorem: p rdivides #0 *)
9515(* Proof:
9516   Since #0 = #0 * p     by ring_mult_lzero
9517   Hence p rdivides #0   by ring_divides_def
9518*)
9519Theorem ring_divides_zero:
9520    !r:'a ring. Ring r ==> !p. p IN R ==> p rdivides #0
9521Proof
9522  rw[] >>
9523  metis_tac[ring_divides_def, ring_mult_lzero, ring_zero_element]
9524QED
9525
9526(* Theorem: Ring r ==> !x. x IN R ==> (#0 rdivides x <=> (x = #0)) *)
9527(* Proof:
9528       #0 rdivides x
9529   <=> ?s. s IN R /\ (x = s * #0)    by ring_divides_def
9530   <=> ?s. s IN R /\ (x = #0)        by ring_mult_rzero
9531   <=> x = #0
9532*)
9533Theorem ring_zero_divides:
9534    !r:'a ring. Ring r ==> !x. x IN R ==> (#0 rdivides x <=> (x = #0))
9535Proof
9536  metis_tac[ring_divides_def, ring_mult_rzero]
9537QED
9538
9539(* Theorem: #1 rdivides p *)
9540(* Proof:
9541   Since p = p * #1   by ring_mult_rone
9542   Hence true         by ring_divides_def
9543*)
9544Theorem ring_divides_by_one:
9545    !r:'a ring. Ring r ==> !p. p IN R ==> #1 rdivides p
9546Proof
9547  metis_tac[ring_divides_def, ring_mult_rone]
9548QED
9549
9550(* Theorem: unit t ==> t rdivides p *)
9551(* Proof:
9552   unit t ==> |/t IN R        by ring_unit_inv_element
9553   Since p = p * #1           by ring_mult_rone
9554           = p * ( |/ t * t)  by ring_unit_linv
9555           = (p * |/t) * t    by ring_mult_assoc
9556   Hence true                 by ring_divides_def
9557*)
9558Theorem ring_divides_by_unit:
9559    !r:'a ring. Ring r ==> !p t. p IN R /\ unit t ==> t rdivides p
9560Proof
9561  rpt strip_tac >>
9562  `|/t IN R /\ p * |/t IN R` by rw[ring_unit_inv_element] >>
9563  `p = p * #1` by rw[] >>
9564  `_ = p * ( |/t * t)` by rw[ring_unit_linv] >>
9565  `_ = p * |/t * t` by rw[ring_mult_assoc] >>
9566  metis_tac[ring_divides_def]
9567QED
9568
9569(* Theorem: p = k * q ==> z = s * p ==> z = t * q *)
9570(* Proof:
9571   z = s * p           by given
9572     = s * (k * q)     by given
9573     = (s * k) * q     by ring_mult_assoc
9574   So let t = s * k, then z = t * q
9575*)
9576Theorem ring_factor_multiple:
9577    !r:'a ring. Ring r ==> !p q. p IN R /\ q IN R /\ (?k. k IN R /\ (p = k * q)) ==>
9578     !z. z IN R /\ (?s. s IN R /\ (z = s * p)) ==> (?t. t IN R /\ (z = t * q))
9579Proof
9580  rpt strip_tac >>
9581  qexists_tac `s * k` >>
9582  rw[ring_mult_assoc]
9583QED
9584
9585Theorem ring_prime_divides_product:
9586  !r. Ring r ==>
9587  !p. p IN r.carrier ==>
9588    (ring_prime r p /\ ~Unit r p <=>
9589     (!b. FINITE_BAG b /\ SET_OF_BAG b SUBSET r.carrier /\
9590          ring_divides r p (GBAG r.prod b) ==>
9591          ?x. BAG_IN x b /\ ring_divides r p x))
9592Proof
9593  rpt strip_tac
9594  \\ reverse eq_tac
9595  >- (
9596    strip_tac
9597    \\ conj_tac
9598    >- (
9599      rw[ring_prime_def]
9600      \\ first_x_assum(qspec_then`{|a; b|}`mp_tac)
9601      \\ simp[SUBSET_DEF]
9602      \\ DEP_REWRITE_TAC[GBAG_INSERT]
9603      \\ simp[SUBSET_DEF]
9604      \\ dsimp[]
9605      \\ metis_tac[Ring_def])
9606    \\ strip_tac
9607    \\ `ring_divides r p r.prod.id`
9608    by (
9609      rfs[ring_unit_property, ring_divides_def]
9610      \\ metis_tac[ring_mult_comm] )
9611    \\ first_x_assum(qspec_then`{||}`mp_tac)
9612    \\ simp[] )
9613  \\ strip_tac
9614  \\ simp[Once(GSYM AND_IMP_INTRO)]
9615  \\ ho_match_mp_tac STRONG_FINITE_BAG_INDUCT
9616  \\ simp[]
9617  \\ simp[Once ring_divides_def]
9618  \\ conj_tac >- metis_tac[ring_unit_property, ring_mult_comm]
9619  \\ rpt strip_tac
9620  \\ fs[SUBSET_DEF]
9621  \\ pop_assum mp_tac
9622  \\ DEP_REWRITE_TAC[GBAG_INSERT]
9623  \\ fs[SUBSET_DEF]
9624  \\ conj_asm1_tac >- metis_tac[Ring_def]
9625  \\ fs[ring_prime_def]
9626  \\ `GBAG r.prod b IN r.prod.carrier`
9627  by ( irule GBAG_in_carrier \\ fs[SUBSET_DEF] )
9628  \\ rfs[] \\ strip_tac
9629  \\ `e IN r.carrier` by metis_tac[]
9630  \\ first_x_assum(drule_then (drule_then drule))
9631  \\ metis_tac[]
9632QED
9633
9634Theorem ring_product_factors_divide:
9635  !r. Ring r ==>
9636  !b. FINITE_BAG b ==>
9637      SET_OF_BAG b SUBSET r.carrier /\
9638      ring_divides r (GBAG r.prod b) x ==>
9639      !y. BAG_IN y b ==> ring_divides r y x
9640Proof
9641  ntac 2 strip_tac
9642  \\ ho_match_mp_tac STRONG_FINITE_BAG_INDUCT
9643  \\ simp[]
9644  \\ gen_tac \\ strip_tac
9645  \\ gen_tac \\ strip_tac
9646  \\ pop_assum mp_tac
9647  \\ DEP_REWRITE_TAC[GBAG_INSERT]
9648  \\ fs[SUBSET_DEF]
9649  \\ conj_asm1_tac >- metis_tac[Ring_def]
9650  \\ gs[ring_divides_def, PULL_EXISTS]
9651  \\ gen_tac \\ strip_tac
9652  \\ BasicProvers.VAR_EQ_TAC
9653  \\ last_x_assum(qspec_then`s * e`mp_tac)
9654  \\ simp[]
9655  \\ `GBAG r.prod b IN r.prod.carrier`
9656  by ( irule GBAG_in_carrier \\ simp[SUBSET_DEF] )
9657  \\ rfs[]
9658  \\ simp[ring_mult_assoc]
9659  \\ strip_tac
9660  \\ strip_tac
9661  \\ strip_tac
9662  >- (
9663    qexists_tac`s * GBAG r.prod b`
9664    \\ simp[ring_mult_assoc]
9665    \\ AP_TERM_TAC
9666    \\ simp[ring_mult_comm] )
9667  \\ res_tac
9668  \\ simp[]
9669QED
9670
9671Theorem ring_mult_divides:
9672  !r p q x.
9673    Ring r /\ ring_divides r (r.prod.op p q) x /\
9674    p IN R /\ q IN R
9675    ==>
9676    ring_divides r p x /\ ring_divides r q x
9677Proof
9678  rpt strip_tac
9679  \\ drule ring_product_factors_divide
9680  \\ disch_then(qspecl_then[`x`,`{|p;q|}`]mp_tac)
9681  \\ simp[SUBSET_DEF]
9682  \\ dsimp[]
9683  \\ DEP_REWRITE_TAC[GBAG_INSERT]
9684  \\ simp[]
9685  \\ metis_tac[Ring_def]
9686QED
9687
9688Theorem ring_associates_sym:
9689  !r p q.
9690    Ring r /\ q IN r.carrier /\ ring_associates r p q ==>
9691    ring_associates r q p
9692Proof
9693  rw[ring_associates_def]
9694  \\ rfs[ring_unit_property]
9695  \\ simp[PULL_EXISTS]
9696  \\ qexists_tac`v`
9697  \\ qexists_tac`s`
9698  \\ simp[]
9699  \\ simp[Once ring_mult_comm]
9700  \\ simp[GSYM ring_mult_assoc]
9701  \\ metis_tac[ring_mult_comm, ring_mult_lone]
9702QED
9703
9704Theorem ring_associates_trans:
9705  !r x y z.
9706    Ring r /\ z IN r.carrier /\
9707    ring_associates r x y /\
9708    ring_associates r y z ==>
9709    ring_associates r x z
9710Proof
9711  rw[ring_associates_def]
9712  \\ qexists_tac`s * s'`
9713  \\ simp[ring_mult_assoc]
9714  \\ simp[ring_unit_mult_unit]
9715QED
9716
9717Theorem ring_associates_refl:
9718  !r x. Ring r /\ x IN r.carrier ==> ring_associates r x x
9719Proof
9720  rw[ring_associates_def]
9721  \\ qexists_tac`#1`
9722  \\ simp[]
9723QED
9724
9725Theorem ring_associates_mult:
9726  !r p q x.
9727    Ring r /\ p IN r.carrier /\ q IN r.carrier /\ x IN r.carrier /\
9728    ring_associates r p q ==>
9729    ring_associates r (r.prod.op x p) (r.prod.op x q)
9730Proof
9731  rw[ring_associates_def]
9732  \\ rfs[ring_unit_property]
9733  \\ simp[PULL_EXISTS]
9734  \\ qexistsl_tac[`s`,`v`]
9735  \\ simp[GSYM ring_mult_assoc]
9736  \\ metis_tac[ring_mult_comm]
9737QED
9738
9739Theorem ring_associates_divides:
9740  !r p q x. Ring r /\ ring_associates r p q /\ q IN R /\
9741  ring_divides r p x ==> ring_divides r q x
9742Proof
9743  rw[ring_associates_def, ring_divides_def]
9744  \\ qexists_tac`s' * s`
9745  \\ simp[]
9746  \\ simp[ring_mult_assoc]
9747QED
9748
9749Theorem ring_divides_associates:
9750  !r x y p. Ring r /\ ring_associates r x y /\ p IN R /\ y IN R /\ ring_divides r p x ==>
9751  ring_divides r p y
9752Proof
9753  rw[ring_associates_def, ring_divides_def]
9754  \\ qexists_tac`|/ s * s'`
9755  \\ simp[ring_unit_inv_element, ring_mult_assoc]
9756  \\ simp[ring_unit_inv_element, GSYM ring_mult_assoc]
9757  \\ simp[ring_unit_linv]
9758QED
9759
9760Theorem LIST_REL_ring_associates_product:
9761  Ring r ==>
9762  !l1 l2. LIST_REL (ring_associates r) l1 l2 /\
9763          set l2 SUBSET r.carrier
9764          ==>
9765          ring_associates r (GBAG r.prod (LIST_TO_BAG l1))
9766                            (GBAG r.prod (LIST_TO_BAG l2))
9767Proof
9768  strip_tac
9769  \\ Induct_on`LIST_REL`
9770  \\ rw[]
9771  >- ( simp[ring_associates_def] \\ qexists_tac`#1` \\ simp[] )
9772  \\ DEP_REWRITE_TAC[GBAG_INSERT]
9773  \\ simp[]
9774  \\ fs[SUBSET_DEF, IN_LIST_TO_BAG]
9775  \\ conj_asm1_tac >- (
9776    fs[LIST_REL_EL_EQN, MEM_EL, PULL_EXISTS]
9777    \\ fs[ring_associates_def]
9778    \\ reverse conj_tac >- metis_tac[Ring_def]
9779    \\ rw[] \\ res_tac \\ rfs[]
9780    \\ res_tac \\ fs[] )
9781  \\ irule ring_associates_trans
9782  \\ simp[]
9783  \\ `GBAG r.prod (LIST_TO_BAG l2) IN r.prod.carrier` by (
9784    irule GBAG_in_carrier
9785    \\ simp[SUBSET_DEF, IN_LIST_TO_BAG] )
9786  \\ `GBAG r.prod (LIST_TO_BAG l1) IN r.prod.carrier` by (
9787    irule GBAG_in_carrier
9788    \\ simp[SUBSET_DEF, IN_LIST_TO_BAG] )
9789  \\ conj_tac >- ( irule ring_mult_element \\ rfs[] )
9790  \\ qexists_tac`h2 * GBAG r.prod (LIST_TO_BAG l1)`
9791  \\ reverse conj_tac
9792  >- ( irule ring_associates_mult \\ rfs[] )
9793  \\ DEP_ONCE_REWRITE_TAC[ring_mult_comm] \\ rfs[]
9794  \\ qmatch_abbrev_tac`rassoc foo _`
9795  \\ DEP_ONCE_REWRITE_TAC[ring_mult_comm] \\ rfs[]
9796  \\ qunabbrev_tac`foo`
9797  \\ irule ring_associates_mult \\ rfs[]
9798QED
9799
9800(* ------------------------------------------------------------------------- *)
9801(* Euclidean Ring Greatest Common Divisor                                    *)
9802(* ------------------------------------------------------------------------- *)
9803
9804(* Define greatest common divisor *)
9805Definition ring_gcd_def:
9806  ring_gcd (r:'a ring) (f:'a -> num) (p:'a) (q:'a) =
9807   if p = #0 then q
9808   else if q = #0 then p
9809   else let s = {a * p + b * q | (a, b) | a IN R /\ b IN R /\ 0 < f (a * p + b * q) }
9810         in CHOICE (preimage f s (MIN_SET (IMAGE f s)))
9811End
9812
9813(* Overload ring gcd *)
9814Overload rgcd = ``ring_gcd r f``
9815(*
9816- ring_gcd_def;
9817> val it = |- !r f p q. rgcd p q = if p = #0 then q else if q = #0 then p else
9818              (let s = {a * p + b * q | (a,b) | a IN R /\ b IN R /\ 0 < f (a * p + b * q)}
9819                in CHOICE (preimage f s (MIN_SET (IMAGE f s)))) : thm
9820*)
9821
9822(* Theorem: !p. (rgcd p #0 = p) /\ (rgcd #0 p = p) *)
9823(* Proof: by ring_gcd_def *)
9824Theorem ring_gcd_zero:
9825    !(r:'a ring) (f :'a -> num). !p. (rgcd p #0 = p) /\ (rgcd #0 p = p)
9826Proof
9827  rw[ring_gcd_def]
9828QED
9829
9830(* Theorem: EuclideanRing r f ==> !p q. p IN R /\ q IN R ==>
9831            (?a b. a IN R /\ b IN R /\ (rgcd p q = a * p + b * q)) *)
9832(* Proof:
9833   If p = #0, rgcd p q = q = #0 * p + #1 * q.
9834   If q = #0, rgcd p q = p = #1 * p + #0 * q.
9835   If p <> #0 and q <> #0, by ring_gcd_def,
9836   rgcd p q = CHOICE (preimage f s (MIN_SET (IMAGE f s)))
9837   where s = {a * p + b * q | (a, b) | a IN R /\ b IN R /\ 0 < f (a * p + b * q) }
9838   Since p = #1 * p + #0 * q,
9839   and with p <> #0, f p <> 0                by euclid_ring_map
9840   Hence s <> {},
9841    and  IMAGE f s <> {}                     by IMAGE_EMPTY
9842    and  MIN_SET (IMAGE f s) IN (IMAGE f s)  by MIN_SET_LEM
9843   Thus CHOICE (preimage f s (MIN_SET (IMAGE f s))) IN s  by preimage_choice_property
9844     or rgcd p q IN s                        by IN_IMAGE
9845     or ?a b. a IN R /\ b IN R /\ (rgcd p q = a * p + b * q).
9846*)
9847Theorem ring_gcd_linear:
9848    !(r:'a ring) (f:'a -> num). EuclideanRing r f ==>
9849     !p q. p IN R /\ q IN R ==> ?a b. a IN R /\ b IN R /\ (rgcd p q = a * p + b * q)
9850Proof
9851  rpt strip_tac >>
9852  `Ring r` by metis_tac[euclid_ring_ring] >>
9853  `#0 IN R /\ #1 IN R` by rw[] >>
9854  `p = #1 * p + #0 * q` by rw[] >>
9855  `q = #0 * p + #1 * q` by rw[] >>
9856  Cases_on `p = #0` >-
9857  metis_tac[ring_gcd_def] >>
9858  Cases_on `q = #0` >-
9859  metis_tac[ring_gcd_def] >>
9860  qabbrev_tac `s = {a * p + b * q | (a, b) | a IN R /\ b IN R /\ 0 < f (a * p + b * q) }` >>
9861  `rgcd p q = CHOICE (preimage f s (MIN_SET (IMAGE f s)))` by rw[ring_gcd_def] >>
9862  `!z. z IN s <=> ?a b. (z = a * p + b * q) /\ a IN R /\ b IN R /\ 0 < f (a * p + b * q)` by rw[Abbr`s`] >>
9863  `f p <> 0` by metis_tac[euclid_ring_map] >>
9864  `p IN s` by metis_tac[DECIDE ``!n. n <> 0 ==> 0 < n``] >>
9865  `s <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
9866  `IMAGE f s <> {}` by rw[IMAGE_EMPTY] >>
9867  `MIN_SET (IMAGE f s) IN (IMAGE f s)` by rw[MIN_SET_LEM] >>
9868  `CHOICE (preimage f s (MIN_SET (IMAGE f s))) IN s` by rw[preimage_choice_property] >>
9869  metis_tac[]
9870QED
9871
9872(* Theorem: EuclideanRing r f ==> rgcd p q rdivides p /\ rgcd p q rdivides q /\
9873            !d. d IN R /\ d rdivides p /\ d rdivides q ==> d rdivides rgcd p q *)
9874(* Proof:
9875   If p = #0, rgcd #0 q = q        by ring_gcd_def
9876      rgcd #0 q rdivides #0        by ring_divides_zero
9877      rgcd #0 q rdivides q         by ring_divides_refl
9878      d rdivides q ==> d rdivides rgcd #0 q = q is trivial.
9879   If q = #0, rgcd p #0 = p        by ring_gcd_def
9880      rgcd p #0 rdivides p         by ring_divides_refl
9881      rgcd p #0 rdivides #0        by ring_divides_zero
9882      d rdivides p ==> d rdivides rgcd p #0 = p is trivial.
9883   If p <> #0 and q <> #0,
9884      Let s = {a * p + b * q | (a, b) | a IN R /\ b IN R /\ 0 < f (a * p + b * q) }
9885      Then rgcd p q = CHOICE (preimage f s (MIN_SET (IMAGE f s)))  by ring_gcd_def
9886      Since p = #1 * p + #0 * q
9887        and p <> #0 ==> f p <> 0   by euclid_ring_map
9888      hence p IN s                 by SPECIIFICATION
9889         or s <> {}                by MEMBER_NOT_EMPTY
9890        and IMAGE f s <> {}        by IMAGE_EMPTY
9891      Therefore, by MIN_SET_LEM,
9892            MIN_SET (IMAGE f s) IN (IMAGE f s)
9893        and !x. x IN (IMAGE f s) ==> MIN_SET (IMAGE f s) <= x
9894      Also, by preimage_choice_property,
9895            CHOICE (preimage f s (MIN_SET (IMAGE f s))) IN s /\
9896            f (CHOICE (preimage f s (MIN_SET (IMAGE f s)))) = MIN_SET (IMAGE f s)
9897      Hence,
9898          rgcd p q IN s /\ f (rgcd p q) = MIN_SET (IMAGE f s)
9899      and ?a b. a IN R /\ b IN R /\ (rgcd p q = a * p + b * q)
9900      Let g = rgcd p q
9901      Then by g IN s, 0 < f g
9902      Hence   g <> #0              by euclid_ring_map
9903      Also    g IN R               by ring_mult_element, ring_add_element
9904      Now for each of the goals:
9905      (1) g rdivides p
9906          Divide p by g,
9907          ?u t. u IN R /\ t IN R /\ (p = u * g + t) /\ f t < f g  by euclid_ring_property
9908          If t = #0, g rdivides p is true.
9909          If t <> #0, f t <> 0     by euclid_ring_map
9910          and t = p - u * g        by ring_sub_eq_add
9911                = p - u * (a * p + b * q)
9912                = #1 * p + - (u * a) * p + - (u * b) * q
9913                = (#1 + - (u * a)) * p + - (u * b) * q
9914          Hence t IN s
9915             so f t IN IMAGE f s          by IN_IMAGE
9916           thus f g <= f t                from MIN_SET
9917           which contradicts f t < f g    from euclid_ring_property
9918      (2) g rdivides q
9919          Divide q by g,
9920          ?u t. u IN R /\ t IN R /\ (q = u * g + t) /\ f t < f g  by euclid_ring_property
9921          If t = #0, g rdivides q is true.
9922          If t <> #0, f t <> 0     by euclid_ring_map
9923          and t = q - u * g        by ring_sub_eq_add
9924                = q - u * (a * p + b * q)
9925                = - u * (a * p + b * q) + q
9926                = - (u * b) * q + - (u * a) * p + #1 * q
9927                = - (u * a) * p + (#1 + - (u * b)) * q
9928          Hence t IN s
9929             so f t IN IMAGE f s          by IN_IMAGE
9930           thus f g <= f t                from MIN_SET
9931           which contradicts f t < f g    from euclid_ring_property
9932      (3) d rdivides p /\ d rdivides q ==> d rdivides g
9933          d rdivides p ==> ?u. u IN R /\ (p = u * d)    by ring_divides_def
9934          d rdivides q ==> ?v. v IN R /\ (q = v * d)    by ring_divides_def
9935          g = a * p + b * q
9936            = a * (u * d) + b * (v * d)
9937            = a * u * d + b * v * d       by ring_mult_assoc
9938            = (a * u + b * v) * d         by ring_mult_ladd
9939          Hence d rdivides g              by ring_divides_def
9940*)
9941Theorem ring_gcd_is_gcd:
9942    !(r:'a ring) (f:'a -> num). EuclideanRing r f ==> !p q. p IN R /\ q IN R ==>
9943      rgcd p q rdivides p /\ rgcd p q rdivides q /\
9944      (!d. d IN R /\ d rdivides p /\ d rdivides q ==> d rdivides rgcd p q)
9945Proof
9946  ntac 6 strip_tac >>
9947  `Ring r` by metis_tac[euclid_ring_ring] >>
9948  Cases_on `p = #0` >-
9949  rw[ring_gcd_def, ring_divides_zero, ring_divides_refl] >>
9950  Cases_on `q = #0` >-
9951  rw[ring_gcd_def, ring_divides_zero, ring_divides_refl] >>
9952  qabbrev_tac `s = {a * p + b * q | (a, b) | a IN R /\ b IN R /\ 0 < f (a * p + b * q) }` >>
9953  `rgcd p q = CHOICE (preimage f s (MIN_SET (IMAGE f s)))` by rw[ring_gcd_def] >>
9954  `#0 IN R /\ #1 IN R` by rw[] >>
9955  `p = #1 * p + #0 * q` by rw[] >>
9956  `!z. z IN s <=> ?a b. (z = a * p + b * q) /\ a IN R /\ b IN R /\ 0 < f (a * p + b * q)` by rw[Abbr`s`] >>
9957  `f p <> 0` by metis_tac[euclid_ring_map] >>
9958  `p IN s` by metis_tac[DECIDE ``!n. n <> 0 ==> 0 < n``] >>
9959  `s <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
9960  `IMAGE f s <> {}` by rw[IMAGE_EMPTY] >>
9961  `MIN_SET (IMAGE f s) IN (IMAGE f s) /\ !x. x IN (IMAGE f s) ==> MIN_SET (IMAGE f s) <= x` by rw[MIN_SET_LEM] >>
9962  `CHOICE (preimage f s (MIN_SET (IMAGE f s))) IN s /\
9963    (f (CHOICE (preimage f s (MIN_SET (IMAGE f s)))) = MIN_SET (IMAGE f s))` by rw[preimage_choice_property] >>
9964  `rgcd p q IN s /\ (f (rgcd p q) = MIN_SET (IMAGE f s))` by metis_tac[] >>
9965  `?a b. a IN R /\ b IN R /\ (rgcd p q = a * p + b * q)` by metis_tac[] >>
9966  qabbrev_tac `g = rgcd p q` >>
9967  `0 < f g` by metis_tac[] >>
9968  `g <> #0` by metis_tac[euclid_ring_map, DECIDE ``!n. n < 0 ==> n <> 0``] >>
9969  `g IN R` by rw[] >>
9970  rpt strip_tac >| [
9971    `?u t. u IN R /\ t IN R /\ (p = u * g + t) /\ f t < f g` by rw[euclid_ring_property] >>
9972    `u * g IN R /\ a * p IN R /\ b * q IN R` by rw[] >>
9973    Cases_on `t = #0` >-
9974    metis_tac[ring_divides_def, ring_add_rzero, ring_mult_comm] >>
9975    `f t <> 0` by metis_tac[euclid_ring_map] >>
9976    `t IN s` by
9977  (`t = p - u * g` by metis_tac[ring_sub_eq_add] >>
9978    `_ = p - u * (a * p + b * q)` by rw[] >>
9979    `_ = p - (u * (a * p) + u * (b * q))` by rw_tac std_ss[ring_mult_radd] >>
9980    `_ = p - (u * a * p + u * b * q)` by rw_tac std_ss[ring_mult_assoc] >>
9981    `_ = p + (- (u * a * p + u * b * q))` by rw_tac std_ss[ring_sub_def] >>
9982    `_ = p + (- (u * a * p) + - (u * b * q))` by rw_tac std_ss[ring_neg_add, ring_mult_element] >>
9983    `_ = p + - (u * a * p) + - (u * b * q)` by rw_tac std_ss[ring_add_assoc, ring_mult_element, ring_neg_element] >>
9984    `_ = p + - (u * a) * p + - (u * b) * q` by rw_tac std_ss[ring_neg_mult, ring_mult_element] >>
9985    `_ = #1 * p + - (u * a) * p + - (u * b) * q` by rw_tac std_ss[ring_mult_lone] >>
9986    `_ = (#1 + - (u * a)) * p + - (u * b) * q` by rw_tac std_ss[ring_mult_ladd, ring_mult_element, ring_neg_element] >>
9987    `(#1 + - (u * a)) IN R /\ - (u * b) IN R` by rw[] >>
9988    metis_tac[DECIDE ``!n. n <> 0 ==> 0 < n``]) >>
9989    `f t IN IMAGE f s` by rw[] >>
9990    `f g <= f t` by metis_tac[] >>
9991    `!n m. n < m ==> ~(m <= n)` by decide_tac >>
9992    metis_tac[],
9993    `?u t. u IN R /\ t IN R /\ (q = u * g + t) /\ f t < f g` by rw[euclid_ring_property] >>
9994    `u * g IN R /\ a * p IN R /\ b * q IN R` by rw[] >>
9995    Cases_on `t = #0` >-
9996    metis_tac[ring_divides_def, ring_add_rzero, ring_mult_comm] >>
9997    `f t <> 0` by metis_tac[euclid_ring_map] >>
9998    `t IN s` by
9999  (`t = q - u * g` by metis_tac[ring_sub_eq_add] >>
10000    `_ = - (u * g) + q` by rw_tac std_ss[ring_sub_def, ring_add_comm, ring_neg_element] >>
10001    `_ = - u * g + q` by rw_tac std_ss[ring_neg_mult] >>
10002    `_ = - u * (a * p + b * q) + q` by rw[] >>
10003    `_ = - u * (a * p) + - u * (b * q) + q` by rw_tac std_ss[ring_mult_radd, ring_neg_element] >>
10004    `_ = - u * a * p + - u * b * q + q` by rw_tac std_ss[ring_mult_assoc, ring_neg_element] >>
10005    `_ = - u * a * p + (- u * b * q + q)` by rw_tac std_ss[ring_add_assoc, ring_mult_element, ring_neg_element] >>
10006    `_ = - u * a * p + (- u * b * q + #1 * q)` by rw_tac std_ss[ring_mult_lone] >>
10007    `_ = - u * a * p + (- u * b + #1) * q` by rw_tac std_ss[ring_mult_ladd, ring_mult_element, ring_neg_element] >>
10008    `- u * a  IN R /\ (- u * b + #1) IN R` by rw[] >>
10009    metis_tac[DECIDE ``!n. n <> 0 ==> 0 < n``]) >>
10010    `f t IN IMAGE f s` by rw[] >>
10011    `f g <= f t` by metis_tac[] >>
10012    `!n m. n < m ==> ~(m <= n)` by decide_tac >>
10013    metis_tac[],
10014    `?u. u IN R /\ (p = u * d)` by rw[GSYM ring_divides_def] >>
10015    `?v. v IN R /\ (q = v * d)` by rw[GSYM ring_divides_def] >>
10016    `g = a * (u * d) + b * (v * d)` by rw[] >>
10017    `_ = a * u * d + b * v * d` by rw[ring_mult_assoc] >>
10018    `_ = (a * u + b * v) * d` by rw[ring_mult_ladd] >>
10019    `a * u + b * v IN R` by rw[] >>
10020    metis_tac[ring_divides_def]
10021  ]
10022QED
10023
10024(* Theorem: rgcd p q rdivides p /\ rgcd p q rdivides q *)
10025Theorem ring_gcd_divides =
10026  (CONJ (ring_gcd_is_gcd |> SPEC_ALL |> UNDISCH_ALL |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT1)
10027        (ring_gcd_is_gcd |> SPEC_ALL |> UNDISCH_ALL |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCT2 |> CONJUNCT1))
10028        |> DISCH ``p IN R /\ q IN R`` |> GEN ``q`` |> GEN ``p`` |> DISCH_ALL |> GEN_ALL;
10029(* > val ring_gcd_divides = |- !r f. EuclideanRing r f ==>
10030         !p q. p IN R /\ q IN R ==> rgcd p q rdivides p /\ rgcd p q rdivides q : thm *)
10031
10032(* Theorem: d rdivides p /\ d rdivides q ==> d rdivides (rgcd p q) *)
10033Theorem ring_gcd_property =
10034  ring_gcd_is_gcd |> SPEC_ALL |> UNDISCH_ALL |> SPEC_ALL |> UNDISCH_ALL |> CONJUNCTS |> last
10035        |> DISCH ``p IN R /\ q IN R`` |> GEN ``q`` |> GEN ``p`` |> DISCH_ALL |> GEN_ALL;
10036(* > val ring_gcd_property = |- !r f. EuclideanRing r f ==>
10037         !p q. p IN R /\ q IN R ==> !d. d IN R /\ d rdivides p /\ d rdivides q ==> d rdivides rgcd p q : thm *)
10038
10039(* Theorem: p IN R /\ q IN R ==> rgcd p q IN R *)
10040(* Proof:
10041   ?a b. a IN R /\ b IN R /\ (rgcd p q = a * p + b * q)  by ring_gcd_linear
10042   Hence (rgcd p q) IN R                                 by ring_mult_element, ring_add_element
10043*)
10044Theorem ring_gcd_element:
10045    !(r:'a ring) (f:'a -> num). EuclideanRing r f ==> !p q. p IN R /\ q IN R ==> rgcd p q IN R
10046Proof
10047  rpt strip_tac >>
10048  `Ring r` by metis_tac[euclid_ring_ring] >>
10049  `?a b. a IN R /\ b IN R /\ (rgcd p q = a * p + b * q)` by rw[ring_gcd_linear] >>
10050  rw[]
10051QED
10052
10053(* Theorem: rgcd p q = rgcd q p *)
10054(* Proof:
10055   If p = #0,
10056   LHS = rgcd #0 q = q = rgcd q #0 = RHS    by ring_gcd_def
10057   If q = #0,
10058   LHS = rgcd p #0 = p = rgcd #0 p = RHS    by ring_gcd_def
10059   If p <> #0 and q <> #0, by ring_gcd_def,
10060   rgcd p q = let s = {a * p + b * q | (a,b) | a IN R /\ b IN R /\ 0 < f (a * p + b * q)}
10061                 in CHOICE (preimage f s (MIN_SET (IMAGE f s))))
10062   rgcd q p = let s' = {a * q + b * p | (a,b) | a IN R /\ b IN R /\ 0 < f (a * q + b * p)}
10063                 in CHOICE (preimage f s' (MIN_SET (IMAGE f s'))))
10064   But s = s'  by exchanging a and b, and by ring_add_comm
10065   Hence rgcd p q = rgcd q p.
10066*)
10067Theorem ring_gcd_sym:
10068    !(r:'a ring) (f:'a -> num). EuclideanRing r f ==> !p q. p IN R /\ q IN R ==> (rgcd p q = rgcd q p)
10069Proof
10070  rw_tac std_ss[ring_gcd_def] >>
10071  `s = s'` by
10072  (rw[Abbr`s`, Abbr`s'`, EXTENSION] >>
10073  `Ring r` by metis_tac[euclid_ring_ring] >>
10074  rw[EQ_IMP_THM] >| [
10075    qexists_tac `b` >>
10076    qexists_tac `a` >>
10077    rw[ring_add_comm],
10078    qexists_tac `b` >>
10079    qexists_tac `a` >>
10080    rw[ring_add_comm]
10081  ]) >>
10082  rw[]
10083QED
10084
10085(* Theorem: atom p ==> !q. q IN R ==> unit (rgcd p q) \/ p rdivides q *)
10086(* Proof:
10087   Let g = rgcd p q
10088   Since g rdivides p        by ring_gcd_divides
10089   ?t. t IN R /\ p = t * g   by ring_divides_def
10090   Hence unit t or unit g    by irreducible_def
10091   If unit g, this is trivially true.
10092   If unit t, |/t exists     by ring_unit_has_inv
10093   so g = |/t * p,
10094   or p rdivides g.
10095   Since g rdivides q        by ring_gcd_divides
10096   p rdivides q              by ring_divides_trans
10097*)
10098Theorem ring_irreducible_gcd:
10099    !(r:'a ring) (f:'a -> num). EuclideanRing r f ==>
10100     !p. p IN R /\ atom p ==> !q. q IN R ==> unit (rgcd p q) \/ p rdivides q
10101Proof
10102  rpt strip_tac >>
10103  `Ring r` by metis_tac[euclid_ring_ring] >>
10104  qabbrev_tac `g = rgcd p q` >>
10105  `g rdivides p /\ g rdivides q` by rw[ring_gcd_divides, Abbr`g`] >>
10106  `?t. t IN R /\ (p = t * g)` by rw[GSYM ring_divides_def] >>
10107  `g IN R` by rw[ring_gcd_element, Abbr`g`] >>
10108  `unit t \/ unit g` by metis_tac[irreducible_def] >| [
10109    `|/t IN R` by rw[ring_unit_inv_element] >>
10110    `|/t * p = |/t * t * g` by rw[ring_mult_assoc] >>
10111    `_ = #1 * g` by rw[ring_unit_linv] >>
10112    `_ = g` by rw[] >>
10113    `p rdivides g` by metis_tac[ring_divides_def] >>
10114    metis_tac[ring_divides_trans],
10115    rw[]
10116  ]
10117QED
10118
10119(* Define ring ordering function *)
10120Definition ring_ordering_def:
10121  ring_ordering (r:'a ring) (f:'a -> num) =
10122    !a b. a IN R /\ b IN R /\ b <> #0 ==> f a <= f (a * b)
10123End
10124
10125(* Theorem: EuclideanRing r /\ ring_ordering r f ==>
10126            !p q. p IN R /\ q IN R /\ p <> #0 /\ q rdivides p ==> f q <= f p *)
10127(* Proof:
10128   Since q rdivides p:
10129   ?s. s IN R /\ (p = s * q)     by ring_divides_def
10130   Since p <> #0, s <> #0        by ring_mult_lzero
10131   Hence f q <= f (q * s)        by ring_ordering_def
10132              = f (s * q)        by ring_mult_comm
10133              = f p
10134*)
10135Theorem ring_divides_le:
10136    !(r:'a ring) (f:'a -> num). EuclideanRing r f /\ ring_ordering r f ==>
10137        !p q. p IN R /\ q IN R /\ p <> #0 /\ q rdivides p ==> f q <= f p
10138Proof
10139  rpt strip_tac >>
10140  `Ring r` by metis_tac[euclid_ring_ring] >>
10141  `?s. s IN R /\ (p = s * q)` by rw[GSYM ring_divides_def] >>
10142  `_ = q * s` by rw[ring_mult_comm] >>
10143  metis_tac[ring_ordering_def, ring_mult_rzero]
10144QED
10145
10146(* division and primality are preserved by isomorphism *)
10147
10148Theorem ring_divides_iso:
10149  !r r_ f. Ring r /\ Ring r_ /\ RingIso f r r_ ==>
10150    !p q. p IN r.carrier /\ ring_divides r p q ==>
10151      ring_divides r_ (f p) (f q)
10152Proof
10153  rw[ring_divides_def]
10154  \\ qexists_tac`f s`
10155  \\ fs[RingIso_def, RingHomo_def]
10156  \\ rfs[MonoidHomo_def]
10157QED
10158
10159Theorem ring_prime_iso:
10160  !r r_ f. Ring r /\ Ring r_ /\ RingIso f r r_ ==>
10161    !p. p IN r.carrier /\ ring_prime r p ==> ring_prime r_ (f p)
10162Proof
10163  rw[ring_prime_def]
10164  \\ `BIJ f r.carrier r_.carrier` by fs[RingIso_def]
10165  \\ `?x y. a = f x /\ b = f y /\ x IN r.carrier /\ y IN r.carrier`
10166  by (
10167    fs[BIJ_DEF, SURJ_DEF]
10168    \\ res_tac \\ rw[]
10169    \\ metis_tac[] )
10170  \\ rpt BasicProvers.VAR_EQ_TAC
10171  \\ drule_then (drule_then drule) ring_iso_sym
10172  \\ strip_tac
10173  \\ first_x_assum(qspecl_then[`x`,`y`]mp_tac)
10174  \\ qspecl_then[`r`,`r_`,`f `]mp_tac ring_divides_iso
10175  \\ simp[] \\ strip_tac
10176  \\ impl_tac
10177  >- (
10178    `p = LINV f R (f p) /\ x = LINV f R (f x) /\ y = LINV f R (f y)`
10179    by metis_tac[BIJ_LINV_THM]
10180    \\ ntac 3 (pop_assum SUBST1_TAC)
10181    \\ `r.prod.op (LINV f R (f x)) (LINV f R (f y)) =
10182        LINV f R (r_.prod.op (f x) (f y))`
10183    by (
10184      qhdtm_x_assum`RingIso`mp_tac
10185      \\ simp_tac(srw_ss())[RingIso_def, RingHomo_def]
10186      \\ simp[MonoidHomo_def] )
10187    \\ pop_assum SUBST1_TAC
10188    \\ irule ring_divides_iso
10189    \\ metis_tac[BIJ_DEF, INJ_DEF] )
10190  \\ metis_tac[]
10191QED
10192
10193(* ------------------------------------------------------------------------- *)
10194(* Principal Ideal Ring: Irreducibles and Primes                             *)
10195(* ------------------------------------------------------------------------- *)
10196
10197(* Theorem: x IN <p>.carrier ==> p rdivides x *)
10198(* Proof:
10199        x IN <p>.carrier
10200   iff  ?z. z IN R /\ (x = p * z)    by principal_ideal_element
10201   iff  z IN R /\ (x = z * p)        by ring_mult_comm
10202   iff  p rdivides x                 by ring_divides_def
10203*)
10204Theorem principal_ideal_element_divides:
10205    !r:'a ring. Ring r ==> !p. p IN R ==> !x. x IN <p>.carrier <=> p rdivides x
10206Proof
10207  rw[principal_ideal_element, ring_divides_def] >>
10208  metis_tac[ring_mult_comm]
10209QED
10210
10211(* Theorem: q rdivides p <=> <p> << <q> *)
10212(* Proof:
10213   Note that <p> << r         by principal_ideal_ideal
10214         and <q> << r         by principal_ideal_ideal
10215   If part: q rdivides p ==> <p> << <q>
10216     This is to show <p>.carrier SUBSET <q>.carrier    by ideal_sub_ideal
10217     or p * R SUBSET q * R                             by principal_ideal_def
10218     Now q rdivides p
10219     ==> ?s. s IN R /\ (p = s * q)                     by ring_divides_def
10220     By coset_def, this is to show:
10221        ?z'. (s * q * z = q * z') /\ z' IN R
10222     But  s * q * z
10223        = q * s * z                                    by ring_mult_comm
10224        = q * (s * z)                                  by ring_mult_assoc
10225     Put z' = s * z, and z' IN R                       by ring_mult_element
10226  Only-if part: <p> << <q> ==> q rdivides p
10227     <p> << <q> means <p>.carrier SUBSET <q>.carrier   by ideal_sub_ideal
10228     Since p IN <p>.carrier                            by principal_ideal_has_element
10229           p IN <q>.carrier                            by SUBSET_DEF
10230     or    ?z. z IN R /\ (p = q * z)                   by principal_ideal_element
10231     i.e.  p = z * q                                   by ring_mult_comm
10232     Hence q rdivides p                                by ring_divides_def
10233*)
10234Theorem principal_ideal_sub_implies_divides:
10235    !r:'a ring. Ring r ==> !p q. p IN R /\ q IN R ==> (q rdivides p <=> <p> << <q>)
10236Proof
10237  rpt strip_tac >>
10238  `<p> << r /\ <q> << r` by rw[principal_ideal_ideal] >>
10239  rw[EQ_IMP_THM] >| [
10240    `<p>.carrier SUBSET <q>.carrier` suffices_by metis_tac[ideal_sub_ideal] >>
10241    rw[principal_ideal_def, coset_def, SUBSET_DEF] >>
10242    `?s. s IN R /\ (p = s * q)` by rw[GSYM ring_divides_def] >>
10243    `s * q * z = q * s * z` by rw[ring_mult_comm] >>
10244    `_ = q * (s * z)` by rw[ring_mult_assoc] >>
10245    metis_tac[ring_mult_element],
10246    `<p>.carrier SUBSET <q>.carrier` by metis_tac[ideal_sub_ideal] >>
10247    `p IN <p>.carrier` by rw[principal_ideal_has_element] >>
10248    `p IN <q>.carrier` by metis_tac[SUBSET_DEF] >>
10249    `?z. z IN R /\ (p = q * z)` by rw[GSYM principal_ideal_element] >>
10250    `_ = z * q` by rw[ring_mult_comm] >>
10251    metis_tac[ring_divides_def]
10252  ]
10253QED
10254
10255(* Introduce temporary overlaods *)
10256Overload "<a>"[local] = ``principal_ideal r a``
10257Overload "<b>"[local] = ``principal_ideal r b``
10258Overload "<u>"[local] = ``principal_ideal r u``
10259
10260(* Theorem: PrincipalIdealRing r ==> !p. atom p ==> rprime p *)
10261(* Proof:
10262   By ring_prime_def, this is to show:
10263   a IN R /\ b IN R /\ p rdivides a * b ==> p rdivides a \/ p rdivides b
10264   By contradiction, assume ~(p rdivides a) /\ ~(p rdivides b).
10265       ~(p rdivides a)
10266   ==> ~(<a> << <p>)           by principal_ideal_sub_implies_divides
10267   ==> ~((<a> + <p>) << <p>)   by ideal_sum_sub_ideal
10268   Since PrincipalIdealRing r,
10269   ?u. u IN R /\ <a> + <p> = <u>    by PrincipalIdealRing_def
10270   But p IN <p>.carrier             by principal_ideal_has_element
10271   so  p IN (<a> + <p>).carrier     by ideal_sum_element
10272   Therefore
10273       p IN <u>.carrier             by above
10274   or  ?z. z IN R /\ p = u * z      by principal_ideal_element
10275   Since atom p, unit u or unit z   by irreducible_def
10276   If unit z,
10277   <p> = <u>                        by principal_ideal_eq_principal_ideal
10278   and <u> << <p>                   by ideal_refl
10279   which contradicts ~(<u> << <p>)  since <u> = <a> + <p>.
10280   Hence unit u,
10281   Since u IN <u>.carrier           by principal_ideal_has_element
10282      so <u> = r                    by ideal_with_unit
10283   Since #1 IN R                    by ring_one_element
10284   ?x y. x IN <a>.carrier /\ y IN <p>.carrier /\ (#1 = x + y)   by ideal_sum_element
10285   ?h k. h IN R /\ k IN R /\ #1 = a * h + p * k                 by principal_ideal_element
10286   Multiply by b,
10287   b = b * #1                       by ring_mult_rone
10288     = b * (a * h + p * k)          by substitution
10289     = b * (a * h) + b * (p * k)    by ring_mult_radd
10290     = b * a * h + b * p * k        by ring_mult_assoc
10291     = a * b * h + p * b * k        by ring_mult_comm
10292   But p rdivides a * b,
10293   ?s. s IN R /\ (a * b = s * p)    by ring_divides_def
10294   or  a * b = p * s                by ring_mult_comm
10295   Thus
10296   b = p * s * h + p * b * k        by substitution
10297     = p * (s * h) + p * (b * k)    by ring_mult_assoc
10298     = p * (s * h + b * k)          by ring_mult_radd
10299     = (s * h + b * k) * p          by ring_mult_comm
10300   Hence p rdivides b               by ring_divides_def
10301   which contradicts ~(p rdivides b).
10302*)
10303Theorem principal_ideal_ring_atom_is_prime:
10304    !r:'a ring. PrincipalIdealRing r ==> !p. atom p ==> rprime p
10305Proof
10306  rw[ring_prime_def] >>
10307  `Ring r` by metis_tac[PrincipalIdealRing_def] >>
10308  `p IN R` by rw[irreducible_element] >>
10309  spose_not_then strip_assume_tac >>
10310  `~(<a> << <p>)` by rw[GSYM principal_ideal_sub_implies_divides] >>
10311  `<a> << r /\ <p> << r` by rw[principal_ideal_ideal] >>
10312  `~((<a> + <p>) << <p>)` by rw[ideal_sum_sub_ideal] >>
10313  `(<a> + <p>) << r` by rw[ideal_sum_ideal] >>
10314  `?u. u IN R /\ (<a> + <p> = <u>)` by metis_tac[PrincipalIdealRing_def] >>
10315  `p IN <p>.carrier` by rw[principal_ideal_has_element] >>
10316  `#0 IN <a>.carrier` by rw[ideal_has_zero] >>
10317  `p = #0 + p` by rw[] >>
10318  `p IN <u>.carrier` by metis_tac[ideal_sum_element] >>
10319  `?z. z IN R /\ (p = u * z)` by rw[GSYM principal_ideal_element] >>
10320  `unit z \/ unit u` by metis_tac[irreducible_def] >-
10321  metis_tac[principal_ideal_eq_principal_ideal, ideal_sub_itself] >>
10322  `u IN <u>.carrier` by rw[principal_ideal_has_element] >>
10323  `<u> = r` by metis_tac[ideal_with_unit] >>
10324  `#1 IN R` by rw[] >>
10325  `?x y. x IN <a>.carrier /\ y IN <p>.carrier /\ (#1 = x + y)` by rw[GSYM ideal_sum_element] >>
10326  `?h k. h IN R /\ k IN R /\ (#1 = a * h + p * k)` by metis_tac[principal_ideal_element] >>
10327  `?s. s IN R /\ (a * b = s * p)` by rw[GSYM ring_divides_def] >>
10328  `_ = p * s` by rw[ring_mult_comm] >>
10329  `b = b * #1` by rw[] >>
10330  `_ = b * (a * h + p * k)` by metis_tac[] >>
10331  `_ = b * (a * h) + b * (p * k)` by rw[ring_mult_radd] >>
10332  `_ = b * a * h + b * p * k` by rw[ring_mult_assoc] >>
10333  `_ = a * b * h + p * b * k` by rw[ring_mult_comm] >>
10334  `_ = p * s * h + p * b * k` by metis_tac[] >>
10335  `_ = p * (s * h) + p * (b * k)` by rw[ring_mult_assoc] >>
10336  `_ = p * (s * h + b * k)` by rw[ring_mult_radd] >>
10337  `_ = (s * h + b * k) * p` by rw[ring_mult_comm] >>
10338  `s * h + b * k IN R` by rw[] >>
10339  metis_tac[ring_divides_def]
10340QED
10341
10342(* Another proof: *)
10343(* Theorem: PrincipalIdealRing r ==> !p. atom p ==> rprime p *)
10344(* Proof:
10345   By ring_prime_def, this is to show:
10346   a IN R /\ b IN R /\ p rdivides a * b ==> p rdivides a \/ p rdivides b
10347   Since p rdivides a * b,
10348   ?s. s IN R /\ (a * b = s * p)    by ring_divides_def
10349   or  a * b = p * s                by ring_mult_comm
10350   By contradiction, assume ~(p rdivides a) /\ ~(p rdivides b).
10351       ~(p rdivides a)
10352   ==> ~(a IN <p>.carrier)          by principal_ideal_element_divides
10353   ==> <a> + <p> <> <p>             by principal_ideal_sum_equal_ideal
10354   ==> <a> + <p> = r                by principal_ideal_ring_ideal_maximal
10355   Since #1 IN R                    by ring_one_element
10356   ?x y. x IN <a>.carrier /\ y IN <p>.carrier /\ (#1 = x + y)   by ideal_sum_element
10357   ?h k. h IN R /\ k IN R /\ #1 = a * h + p * k                 by principal_ideal_element
10358   Multiply by b,
10359   b = b * #1                       by ring_mult_rone
10360     = b * (a * h + p * k)          by substitution
10361     = b * (a * h) + b * (p * k)    by ring_mult_radd
10362     = b * a * h + b * p * k        by ring_mult_assoc
10363     = a * b * h + p * b * k        by ring_mult_comm
10364     = p * s * h + p * b * k        by substitution, a * b = p * s
10365     = p * (s * h) + p * (b * k)    by ring_mult_assoc
10366     = p * (s * h + b * k)          by ring_mult_radd
10367     = (s * h + b * k) * p          by ring_mult_comm
10368   Hence p rdivides b               by ring_divides_def
10369   which contradicts ~(p rdivides b).
10370*)
10371Theorem principal_ideal_ring_irreducible_is_prime:
10372    !r:'a ring. PrincipalIdealRing r ==> !p. atom p ==> rprime p
10373Proof
10374  rw[ring_prime_def] >>
10375  `Ring r` by metis_tac[PrincipalIdealRing_def] >>
10376  `p IN R` by rw[irreducible_element] >>
10377  `<a> << r /\ <p> << r` by rw[principal_ideal_ideal] >>
10378  `(<a> + <p>) << r /\ <p> << (<a> + <p>)` by rw[ideal_sum_ideal, ideal_sum_has_ideal_comm] >>
10379  spose_not_then strip_assume_tac >>
10380  `~(a IN <p>.carrier)` by metis_tac[principal_ideal_element_divides] >>
10381  `<a> + <p> <> <p>` by metis_tac[principal_ideal_sum_equal_ideal] >>
10382  `<a> + <p> = r` by metis_tac[principal_ideal_ring_ideal_maximal, ideal_maximal_def] >>
10383  `?x y. x IN <a>.carrier /\ y IN <p>.carrier /\ (#1 = x + y)` by rw[GSYM ideal_sum_element] >>
10384  `?h k. h IN R /\ k IN R /\ (#1 = a * h + p * k)` by metis_tac[principal_ideal_element] >>
10385  `?s. s IN R /\ (a * b = s * p)` by rw[GSYM ring_divides_def] >>
10386  `_ = p * s` by rw[ring_mult_comm] >>
10387  `b = b * #1` by rw[] >>
10388  `_ = b * (a * h + p * k)` by metis_tac[] >>
10389  `_ = b * (a * h) + b * (p * k)` by rw[ring_mult_radd] >>
10390  `_ = b * a * h + b * p * k` by rw[ring_mult_assoc] >>
10391  `_ = a * b * h + p * b * k` by rw[ring_mult_comm] >>
10392  `_ = p * s * h + p * b * k` by metis_tac[] >>
10393  `_ = p * (s * h) + p * (b * k)` by rw[ring_mult_assoc] >>
10394  `_ = p * (s * h + b * k)` by rw[ring_mult_radd] >>
10395  `_ = (s * h + b * k) * p` by rw[ring_mult_comm] >>
10396  `s * h + b * k IN R` by rw[] >>
10397  metis_tac[ring_divides_def]
10398QED
10399
10400(* ------------------------------------------------------------------------- *)
10401(* Quotient Ring Documentation                                               *)
10402(* ------------------------------------------------------------------------- *)
10403(* Overloads:
10404   R/I     = CosetPartition r.sum i.sum
10405   gen x   = cogen r.sum i.sum x
10406   x + y   = ideal_coset_add r i x y
10407   x * y   = ideal_coset_mult r i x y
10408   r / i   = quotient_ring r i
10409*)
10410(* Definitions and Theorems (# are exported):
10411
10412   Ideal Coset:
10413   ideal_coset_add_def      |- !r i x y. x + y = (gen x + gen y) o I
10414   ideal_coset_mult_def     |- !r i x y. x * y = (gen x * gen y) o I
10415   ideal_coset_element      |- !r i x. Ring r /\ i << r /\ x IN R ==>
10416                               !z. z IN x o I <=> ?y. y IN I /\ (z = x + y)
10417
10418   Quotient Ring:
10419   quotient_ring_add_def    |- !r i. quotient_ring_add r i = <|carrier := R/I; id := I; op := $+ |>
10420   quotient_ring_mult_def   |- !r i. quotient_ring_mult r i = <|carrier := R/I; id := #1 o I; op := $* |>
10421   quotient_ring_def        |- !r i. r / i =
10422                                         <|carrier := R/I;
10423                                               sum := quotient_ring_add r i;
10424                                              prod := quotient_ring_mult r i
10425                                          |>
10426   quotient_ring_property   |- !r i. ((r / i).carrier = R/I) /\
10427                                     ((r / i).sum = quotient_ring_add r i) /\
10428                                     ((r / i).prod = quotient_ring_mult r i)
10429   ideal_cogen_property     |- !r i. Ring r /\ i << r ==> !x. x IN R/I ==> gen x IN R /\ (gen x o I = x)
10430   ideal_coset_property     |- !r i. Ring r /\ i << r ==> !x. x IN R ==> x o I IN R/I /\ (gen (x o I) o I = x o I)
10431   ideal_in_quotient_ring   |- !r i. Ring r /\ i << r ==> I IN R/I
10432   quotient_ring_has_ideal  |- !r i. Ring r /\ i << r ==> I IN R/I
10433   quotient_ring_element    |- !r i. Ring r /\ i << r ==> !z. z IN R/I <=> ?x. x IN R /\ (z = x o I)
10434   ideal_coset_has_gen_diff |- !r i. Ring r /\ i << r ==> !x. x IN R ==> gen (x o I) - x IN I
10435   ideal_coset_add          |- !r i. Ring r /\ i << r ==>
10436                               !x y. x IN R /\ y IN R ==> (x o I + y o I = (x + y) o I)
10437   ideal_coset_mult         |- !r i. Ring r /\ i << r ==>
10438                               !x y. x IN R /\ y IN R ==> (x o I * y o I = (x * y) o I)
10439   ideal_coset_neg          |- !r i. Ring r /\ i << r ==> !x. x IN R ==> (x o I + -x o I = I)
10440
10441   Quotient Ring Addition is a Abelian Group:
10442   quotient_ring_add_element  |- !r i. Ring r /\ i << r ==> !x y. x IN R/I /\ y IN R/I ==> x + y IN R/I
10443   quotient_ring_add_comm     |- !r i. Ring r /\ i << r ==> !x y. x IN R/I /\ y IN R/I ==> (x + y = y + x)
10444   quotient_ring_add_assoc    |- !r i. Ring r /\ i << r ==> !x y z. x IN R/I /\ y IN R/I /\ z IN R/I ==> (x + y + z = x + (y + z))
10445   quotient_ring_add_id       |- !r i. Ring r /\ i << r ==> !x. x IN R/I ==> (I + x = x)
10446   quotient_ring_add_inv      |- !r i. Ring r /\ i << r ==> !x. x IN R/I ==> ?y. y IN R/I /\ (y + x = I)
10447   quotient_ring_add_group    |- !r i. Ring r /\ i << r ==> Group (quotient_ring_add r i)
10448   quotient_ring_add_abelian_group  |- !r. Ring r /\ i << r ==> AbelianGroup (quotient_ring_add r i)
10449
10450   Quotient Ring Multiplication is an Abelian Monoid:
10451   quotient_ring_mult_element |- !r i. Ring r /\ i << r ==> !x y. x IN R/I /\ y IN R/I ==> x * y IN R/I
10452   quotient_ring_mult_comm    |- !r i. Ring r /\ i << r ==> !x y. x IN R/I /\ y IN R/I ==> (x * y = y * x)
10453   quotient_ring_mult_assoc   |- !r i. Ring r /\ i << r ==> !x y z. x IN R/I /\ y IN R/I /\ z IN R/I ==> (x * y * z = x * (y * z))
10454   quotient_ring_mult_id      |- !r i. Ring r /\ i << r ==> !x. x IN R/I ==> (#1 o I * x = x) /\ (x * #1 o I = x)
10455   quotient_ring_mult_monoid  |- !r i. Ring r /\ i << r ==> Monoid (quotient_ring_mult r i)
10456   quotient_ring_mult_abelian_monoid
10457                              |- !r. Ring r /\ i << r ==> AbelianMonoid (quotient_ring_mult r i)
10458
10459   Quotient Ring is a Ring:
10460   quotient_ring_mult_ladd    |- !r i. Ring r /\ i << r ==> !x y z. x IN R/I /\ y IN R/I /\ z IN R/I ==>
10461                                 (x * (y + z) = x * y + x * z)
10462   quotient_ring_ring         |- !r i. Ring r /\ i << r ==> Ring (r / i)
10463   quotient_ring_ring_sing    |- !r. Ring r ==> ((r / r).carrier = {R})
10464   quotient_ring_by_principal_ideal
10465                              |- !r. Ring r ==> !p. p IN R ==> Ring (r / <p>)
10466
10467   Quotient Ring Homomorphism:
10468   quotient_ring_homo         |- !r i. Ring r /\ i << r ==> RingHomo (\x. x o I) r (r / i)
10469   quotient_ring_homo_surj    |- !r i. Ring r /\ i << r ==> SURJ (\x. x o I) R R/I
10470   quotient_ring_homo_kernel  |- !r i. Ring r /\ i << r ==> (kernel (\x. x o I) r.sum (r / i).sum = I)
10471
10472   Kernel of Ring Homomorphism:
10473   kernel_ideal_def           |- !f r s. kernel_ideal f r s =
10474                                 <|carrier := kernel f r.sum s.sum;
10475                                       sum := <|carrier := kernel f r.sum s.sum; op := $+; id := #0|>;
10476                                      prod := <|carrier := kernel f r.sum s.sum; op := $*; id := #1|>
10477                                  |>
10478   kernel_ideal_sum_eqn       |- !r s f. (kernel_ideal f r s).sum = kernel_group f r.sum s.sum
10479   kernel_ideal_element       |- !r r_ f x. x IN (kernel_ideal f r r_).carrier <=>
10480                                            x IN r.sum.carrier /\ (f x = #0_)
10481   ring_homo_kernel_ideal     |- !f r s. Ring r /\ Ring s /\ RingHomo f r s ==> kernel_ideal f r s << r
10482   quotient_ring_homo_kernel_ideal
10483                              |- !r i. Ring r /\ i << r ==>
10484                                       RingHomo (\x. x o I) r (r / i) /\ (kernel_ideal (\x. x o I) r (r / i) = i)
10485
10486   First Isomorphism Theorem for Ring:
10487   kernel_ideal_gen_add_map    |- !r r_ f. (r ~r~ r_) f ==> (let i = kernel_ideal f r r_ in
10488                                  !x y. x IN R/I /\ y IN R/I ==>
10489                                   (f (gen ((gen x + gen y) o I)) = f (gen x) +_ f (gen y)))
10490   kernel_ideal_gen_mult_map   |- !r r_ f. (r ~r~ r_) f ==> (let i = kernel_ideal f r r_ in
10491                                  !x y. x IN R/I /\ y IN R/I ==>
10492                                   (f (gen ((gen x * gen y) o I)) = f (gen x) *_ f (gen y)))
10493   kernel_ideal_gen_id_map     |- !r r_ f. (r ~r~ r_) f ==>
10494                                  (let i = kernel_ideal f r r_ in f (gen (#1 o I)) = #1_)
10495   kernel_ideal_quotient_element_eq
10496                               |- !r r_ f. (r ~r~ r_) f ==> (let i = kernel_ideal f r r_ in
10497                                  !x y. x IN R/I /\ y IN R/I ==> (gen x - gen y IN I <=> (x = y)))
10498   kernel_ideal_quotient_inj   |- !r r_ f. (r ~r~ r_) f ==> (let i = kernel_ideal f r r_ in
10499                                           INJ (f o gen) R/I (IMAGE f R))
10500   kernel_ideal_quotient_surj  |- !r r_ f. (r ~r~ r_) f ==> (let i = kernel_ideal f r r_ in
10501                                           SURJ (f o gen) R/I (IMAGE f R))
10502   kernel_ideal_quotient_bij   |- !r r_ f. (r ~r~ r_) f ==> (let i = kernel_ideal f r r_ in
10503                                           BIJ (f o gen) R/I (IMAGE f R))
10504   kernel_ideal_quotient_homo  |- !r s f. (r ~r~ s) f ==> (let i = kernel_ideal f r s in
10505                                          RingHomo (f o gen) (r / i) (ring_homo_image f r s))
10506   kernel_ideal_quotient_iso   |- !r s f. (r ~r~ s) f ==> (let i = kernel_ideal f r s in
10507                                          RingIso (f o gen) (r / i) (ring_homo_image f r s))
10508   ring_first_isomorphism_thm  |- !r r_ f. (r ~r~ r_) f ==> (let i = kernel_ideal f r r_ in
10509                                           i << r /\ ring_homo_image f r r_ <= r_ /\
10510                                           RingIso (f o gen) (r / i) (ring_homo_image f r r_))
10511*)
10512
10513(* ------------------------------------------------------------------------- *)
10514(* Ideal Coset.                                                              *)
10515(* ------------------------------------------------------------------------- *)
10516
10517(* The carrier of Ideal = carrier of group i.sum *)
10518Overload I[local] = ``i.carrier``
10519(* The carrier of Ideal = carrier of group j.sum *)
10520Overload J[local] = ``j.carrier``
10521
10522(* Define carrier set of Quotient Ring (R/I) by overloading *)
10523Overload "R/I" = ``CosetPartition r.sum i.sum``
10524
10525(* Define cogen operation of Quotient Ring (R/I) by overloading *)
10526Overload gen = ``cogen r.sum i.sum``
10527
10528(* Define addition of ideal cosets *)
10529Definition ideal_coset_add_def[simp]:
10530  ideal_coset_add (r:'a ring) (i:'a ring) x y = (gen x + gen y) o I
10531End
10532
10533(* Define multiplication of ideal cosets *)
10534Definition ideal_coset_mult_def[simp]:
10535  ideal_coset_mult (r:'a ring) (i:'a ring) x y = (gen x * gen y) o I
10536End
10537
10538(* Overload operations *)
10539Overload "+" = ``ideal_coset_add r i``
10540Overload "*" = ``ideal_coset_mult r i``
10541
10542(*
10543> in_coset |> ISPEC ``r.sum`` |> ISPEC ``i.sum.carrier`` |> ISPEC ``x``;
10544val it = |- x IN r.sum.carrier ==>
10545           !x'. x' IN x o i.sum.carrier <=> ?y. y IN i.sum.carrier /\ (x' = x + y): thm
10546*)
10547
10548(* Theorem: Ring r /\ i << r /\ x IN R ==> !z. z IN x o I <=> ?y. y IN I /\ (z = x + y) *)
10549(* Proof:
10550     z IN x o I
10551   = z IN x * i.sum.carrier                  by notation
10552   = ?y. y IN i.sum.carrier /\ (z = x + y)   by in_coset
10553   = ?y. y IN I /\ (z = x + y)               by ring_carriers, ideal_carriers
10554*)
10555Theorem ideal_coset_element:
10556    !(r:'a ring) (i:'a ring) x. Ring r /\ i << r /\ x IN R ==>
10557   !z. z IN x o I <=> ?y. y IN I /\ (z = x + y)
10558Proof
10559  rw_tac std_ss[in_coset, ring_carriers, ideal_carriers]
10560QED
10561
10562(* ------------------------------------------------------------------------- *)
10563(* Quotient Ring.                                                            *)
10564(* ------------------------------------------------------------------------- *)
10565
10566(* Define addition group in Quotient Ring (R/I) *)
10567Definition quotient_ring_add_def:
10568  quotient_ring_add (r:'a ring) (i:'a ring) =
10569    <| carrier := R/I;
10570            id := I; (* will show: I = #0 o I *)
10571            op := ideal_coset_add r i
10572     |>
10573End
10574
10575(* Define multiplication monoid in Quotient Ring (R/I) *)
10576Definition quotient_ring_mult_def:
10577  quotient_ring_mult (r:'a ring) (i:'a ring) =
10578    <| carrier := R/I;
10579            id := #1 o I;
10580            op := ideal_coset_mult r i
10581     |>
10582End
10583
10584(* Define Quotient Ring (R/I) *)
10585Definition quotient_ring_def:
10586  quotient_ring (r:'a ring) (i:'a ring) =
10587    <| carrier := R/I;
10588           sum := quotient_ring_add r i;
10589          prod := quotient_ring_mult r i
10590     |>
10591End
10592
10593(* set overloading for Quotient Ring. *)
10594Overload "/" = ``quotient_ring``
10595
10596(* Theorem: Properties of quotient ring (r / i). *)
10597(* Proof: by quotient_ring_def *)
10598Theorem quotient_ring_property:
10599    !r:'a ring i:'a ring.
10600        ((r / i).carrier = R/I) /\
10601        ((r / i).sum = quotient_ring_add r i) /\
10602        ((r / i).prod = quotient_ring_mult r i)
10603Proof
10604  rw[quotient_ring_def]
10605QED
10606
10607(* Theorem: Ring r /\ (i << r) ==> !x. x IN R/I ==> gen x IN R /\ (gen x o I = x) *)
10608(* Proof:
10609   Since i << r,
10610   i.sum <= r.sum /\ i.sum.carrier = I   by ideal_def
10611   and r.sum.carrier = R                 by ring_add_group
10612   Since x IN R/I,
10613     gen x IN r.sum.carrier              by cogen_element
10614     gen x o I
10615   = (cogen r.sum i.sum x) o I           by rewrite of gen
10616   = x                                   by coset_cogen_property, i.sum <= r.sum
10617*)
10618Theorem ideal_cogen_property:
10619    !r i:'a ring. Ring r /\ (i << r) ==> !x. x IN R/I ==> gen x IN R /\ (gen x o I = x)
10620Proof
10621  metis_tac[ideal_def, ring_add_group, cogen_element, coset_cogen_property]
10622QED
10623
10624(* Theorem: Ring r /\ (i << r) ==> !x. x IN R ==> gen (x o I) + I = x o I  *)
10625(* Proof:
10626   Since i << r,
10627   i.sum <= r.sum /\ i.sum.carrier = I  by ideal_def
10628   and r.sum.carrier = R                by ring_add_group
10629   Hence x o I IN R/I                   by coset_partition_element
10630     gen (x o I) o I
10631   = gen (coset r.sum x I) o I          by ideal_coset rewrite
10632   = (coset r.sum x I)                  by coset_cogen_property
10633   = x o I                              by ideal_coset rewrite
10634*)
10635Theorem ideal_coset_property:
10636    !r i:'a ring. Ring r /\ (i << r) ==> !x. x IN R ==> x o I IN R/I /\ (gen (x o I) o I = x o I)
10637Proof
10638  metis_tac[ideal_def, ring_add_group, coset_partition_element, coset_cogen_property]
10639QED
10640
10641(* Theorem: Ring r /\ i << r ==> #0 o I = I *)
10642(* Proof:
10643   Since i << r,
10644   i.sum <= r.sum /\ i.sum.carrier = I     by ideal_def
10645   and   Group r.sum                       by ring_add_group
10646   This follows by coset_id_eq_subgroup.
10647*)
10648Theorem ideal_coset_zero:
10649    !r i:'a ring. Ring r /\ i << r ==> (#0 o I = I)
10650Proof
10651  metis_tac[ideal_def, coset_id_eq_subgroup, ring_add_group]
10652QED
10653
10654(* Theorem: Ring r /\ i << r ==> I IN R/I *)
10655(* Proof:
10656   Since #0 IN R, #0 o I IN R/I by ideal_coset_property.
10657   Hence true by By ideal_coset_zero.
10658*)
10659Theorem ideal_in_quotient_ring:
10660    !r i:'a ring. Ring r /\ i << r ==> I IN R/I
10661Proof
10662  metis_tac[ideal_coset_property, ring_zero_element, ideal_coset_zero]
10663QED
10664
10665(* Theorem alias *)
10666Theorem quotient_ring_has_ideal = ideal_in_quotient_ring;
10667
10668
10669(*
10670ideal_coset_property  |- !r i. Ring r /\ i << r ==> !x. x IN R ==> x o I IN R/I /\ (gen (x o I) o I = x o I)
10671ideal_cogen_property  |- !r i. Ring r /\ i << r ==> !x. x IN R/I ==> gen x IN R /\ (gen x o I = x)
10672
10673> coset_partition_element |> ISPEC ``r.sum`` |> ISPEC ``i.sum``;
10674val it = |- i.sum <= r.sum ==> !e. e IN R/I <=> ?a. a IN r.sum.carrier /\ (e = a o i.sum.carrier): thm
10675
10676In textbook, this is written as: (x + I) + (y + I) = (x + y) + I
10677*)
10678
10679(* Theorem: Ring r /\ i << r ==> !z. z IN R/I <=> ?x. x IN R /\ (z = x o I) *)
10680(* Proof:
10681   If part: z IN R/I ==> ?x. x IN R /\ (z = x o I)
10682      Note gen z IN R /\ (gen z) o I = z    by ideal_cogen_property
10683      Take x = gen z, the result is true.
10684   Only-if part: x IN R /\ (z = x o I) ==> z IN R/I
10685      This is true                          by ideal_coset_property
10686*)
10687Theorem quotient_ring_element:
10688    !(r:'a ring) (i:'a ring). Ring r /\ i << r ==> !z. z IN R/I <=> ?x. x IN R /\ (z = x o I)
10689Proof
10690  metis_tac[ideal_cogen_property, ideal_coset_property]
10691QED
10692
10693(* Theorem: Ring r /\ i << r ==> !x. x IN R ==> gen (x o I) - x IN I *)
10694(* Proof:
10695   Note x o I IN R/I               by ideal_coset_property
10696    and gen (x o I) o I = x o I    by ideal_coset_property
10697   Thus gen (x o I) IN R           by ideal_cogen_property
10698   Thus gen (x o I) - x IN I       by ideal_coset_eq
10699*)
10700Theorem ideal_coset_has_gen_diff:
10701    !(r:'a ring) (i:'a ring). Ring r /\ i << r ==> !x. x IN R ==> gen (x o I) - x IN I
10702Proof
10703  rw_tac std_ss[ideal_coset_property, ideal_cogen_property, GSYM ideal_coset_eq]
10704QED
10705
10706(* Theorem: Ring r /\ i << r ==> !x y. x IN R /\ y IN R ==> ((x o I) + (y o I) = (x + y) o I) *)
10707(* Proof:
10708   Let t = gen (x o I) + gen (y o I).
10709   Note x o I IN R/I /\ y o I IN R/I           by ideal_coset_property
10710   Thus gen (x o I) IN R /\ gen (y o I) IN R   by ideal_cogen_property
10711    and t IN R /\ (x + y) IN R                 by ring_add_element
10712
10713   Note (x o I) + (y o I) = t o I              by ideal_coset_add_def
10714    Now gen (x o I) - x IN I                   by ideal_coset_has_gen_diff
10715    and gen (y o I) - y IN I                   by ideal_coset_has_gen_diff
10716
10717        t - (x + y)
10718      = (gen (x o I) + gen (y o I)) - (x + y)  by notation
10719      = (gen (x o I) - x) + (gen (y o I) - y)  by ring_add_pair_sub
10720   Thus t - (x + y) IN I                       by ideal_has_sum
10721     or t o I = (x + y) o I                    by ideal_coset_eq
10722*)
10723Theorem ideal_coset_add:
10724    !(r:'a ring) (i:'a ring). Ring r /\ i << r ==>
10725   !x y. x IN R /\ y IN R ==> ((x o I) + (y o I) = (x + y) o I)
10726Proof
10727  rw_tac std_ss[ideal_coset_add_def] >>
10728  qabbrev_tac `t = gen (x o I) + gen (y o I)` >>
10729  `x o I IN R/I /\ y o I IN R/I` by rw[ideal_coset_property] >>
10730  `gen (x o I) IN R /\ gen (y o I) IN R` by rw[ideal_cogen_property] >>
10731  `t IN R /\ x + y IN R` by rw[Abbr`t`] >>
10732  rw_tac std_ss[ideal_coset_eq] >>
10733  `t - (x + y) = (gen (x o I) - x) + (gen (y o I) - y)` by rw[ring_add_pair_sub, Abbr`t`] >>
10734  metis_tac[ideal_coset_has_gen_diff, ideal_has_sum]
10735QED
10736
10737(* Theorem: Ring r /\ i << r ==> !x y. x IN R /\ y IN R ==> ((x o I) * (y o I) = (x * y) o I) *)
10738(* Proof:
10739   Let t = gen (x o I) * gen (y o I).
10740   Note x o I IN R/I /\ y o I IN R/I           by ideal_coset_property
10741   Thus gen (x o I) IN R /\ gen (y o I) IN R   by ideal_cogen_property
10742    and t IN R /\ (x * y) IN R                 by ring_mult_element
10743
10744   Note (x o I) * (y o I) = t o I              by ideal_coset_mult_def
10745    Now gen (x o I) - x IN I                   by ideal_coset_has_gen_diff
10746    and gen (y o I) - y IN I                   by ideal_coset_has_gen_diff
10747
10748        t - (x * y)
10749      = (gen (x o I) * gen (y o I)) - (x * y)  by notation
10750      = (gen (x o I) - x) * gen (y o I) + x * (gen (y o I) - y)  by ring_mult_pair_diff
10751      = (gen (x o I) - x) * gen (y o I) + (gen (y o I) - y) * x  by ring_mult_comm
10752   Note (gen (x o I) - x) * gen (y o I) IN I   by ideal_has_multiple
10753    and           (gen (y o I) - y) * x IN I   by ideal_has_multiple
10754   Thus t - (x * y) IN I                       by ideal_has_sum
10755     or t o I = (x * y) o I                    by ideal_coset_eq
10756*)
10757Theorem ideal_coset_mult:
10758    !(r:'a ring) (i:'a ring). Ring r /\ i << r ==>
10759   !x y. x IN R /\ y IN R ==> ((x o I) * (y o I) = (x * y) o I)
10760Proof
10761  rw_tac std_ss[ideal_coset_mult_def] >>
10762  qabbrev_tac `t = gen (x o I) * gen (y o I)` >>
10763  `x o I IN R/I /\ y o I IN R/I` by rw[ideal_coset_property] >>
10764  `gen (x o I) IN R /\ gen (y o I) IN R` by rw[ideal_cogen_property] >>
10765  `t IN R /\ x * y IN R` by rw[Abbr`t`] >>
10766  rw_tac std_ss[ideal_coset_eq] >>
10767  `t - (x * y) = (gen (x o I) - x) * gen (y o I) + x * (gen (y o I) - y)` by rw_tac std_ss[ring_mult_pair_diff, Abbr`t`] >>
10768  `_ = (gen (x o I) - x) * gen (y o I) + (gen (y o I) - y) * x` by rw_tac std_ss[ring_mult_comm, ring_sub_element] >>
10769  metis_tac[ideal_coset_has_gen_diff, ideal_has_multiple, ideal_has_sum]
10770QED
10771
10772(* Theorem: Ring r /\ i << r ==> !x. x IN R ==> (x o I + (-x) o I = I) *)
10773(* Proof:
10774   Note x IN R ==> -x IN R   by ring_neg_element
10775     x o I + (-x) o I
10776   = (x + (-x)) o I          by ideal_coset_add
10777   = #0 o I                  by ring_add_rneg
10778   = I                       by ideal_coset_zero
10779*)
10780Theorem ideal_coset_neg:
10781    !(r:'a ring) (i:'a ring). Ring r /\ i << r ==> !x. x IN R ==> (x o I + (-x) o I = I)
10782Proof
10783  rw_tac std_ss[ideal_coset_add, ideal_coset_zero, ring_neg_element, ring_add_rneg]
10784QED
10785
10786(* ------------------------------------------------------------------------- *)
10787(* Quotient Ring (R/I).sum is an Abelian Group.                              *)
10788(* ------------------------------------------------------------------------- *)
10789
10790(* Theorem: [Quotient Ring Add Closure]
10791   Ring r /\ (i << r) ==> !x y. x IN R/I /\ y IN R/I ==> x + y IN R/I *)
10792(* Proof:
10793   Since i << r,
10794   i.sum <= r.sum /\ i.sum.carrier = I            by ideal_def
10795   By Ring r, Group r.sum and r.sum.carrier = R   by ring_add_group
10796     x IN R/I ==> gen x IN r.sum.carrier          by cogen_element
10797     y IN R/I ==> gen y IN r.sum.carrier          by cogen_element
10798   Hence  gen x + gen y IN r.sum.carrier          by ring_add_element
10799      or  (gen x + gen y) o I IN R/I              by coset_partition_element, since i.sum <= r.sum.
10800*)
10801Theorem quotient_ring_add_element:
10802    !r i:'a ring. Ring r /\ (i << r) ==> !x y. x IN R/I /\ y IN R/I ==> x + y IN R/I
10803Proof
10804  rw[ideal_cogen_property, ideal_coset_property]
10805QED
10806
10807(* Theorem: [Quotient Ring Add Commutative] Ring r /\ (i << r) ==> !x y. x IN R/I /\ y IN R/I ==> x + y = y + x *)
10808(* Proof:
10809   First, gen x IN R and gen y IN R   by ideal_cogen_property
10810     x + y
10811   = (gen x + gen y) o I        by ideal_coset_add_def
10812   = (gen y + gen x) o I        by ring_add_comm
10813   = y + x                      by ideal_coset_add_def
10814*)
10815Theorem quotient_ring_add_comm:
10816    !r i:'a ring. Ring r /\ (i << r) ==> !x y. x IN R/I /\ y IN R/I ==> (x + y = y + x)
10817Proof
10818  rw[ring_add_comm, ideal_cogen_property]
10819QED
10820
10821(* Theorem: Ring r /\ i << r /\ x IN R/I /\ y IN R/I /\ z IN R/I ==> x + y + z = x + (y + z) *)
10822(* Proof:
10823   We have gen x IN R, gen y IN R and gen z IN R by ideal_cogen_property.
10824   Hence gen x + gen y IN R               by ring_add_element
10825     and gen ((gen x + gen y) o I) IN R   by ideal_coset_property, ideal_cogen_property
10826    Also gen y + gen z IN R               by ring_add_element
10827     and gen ((gen y + gen z) o I) IN R   by ideal_coset_property, ideal_cogen_property
10828
10829   First, show: x + y + z = (gen x + gen y + gen z) o I
10830   i.e.   x + y + z = (gen ((gen x + gen y) o I) + gen z) o I = (gen x + gen y + gen z) o I
10831   By ideal_coset_eq, this is true if
10832         (gen ((gen x + gen y) o I) + gen z) - (gen x + gen y + gen z) IN I
10833   Now   gen ((gen x + gen y) o I) o I = (gen x + gen y) o I   by ideal_coset_property
10834   hence gen ((gen x + gen y) o I) - (gen x + gen y) IN I      by ideal_coset_eq
10835   or   (gen ((gen x + gen y) o I) + gen z) - (gen x + gen y + gen z) IN I   by ring_sub_pair_reduce
10836   Hence true.
10837
10838   Next, show: x + (y + z) = (gen x + (gen y + gen z)) o I
10839   i.e. (gen x + gen ((gen y + gen z) o I)) o I = (gen x + (gen y + gen z)) o I
10840   By ideal_coset_eq, this is true if
10841        (gen x + gen ((gen y + gen z) o I)) - (gen x + (gen y + gen z)) IN I
10842   Now   gen ((gen y + gen z) o I) o I = (gen y + gen z) o I    by ideal_coset_property
10843   hence (gen ((gen y + gen z) o I)) - (gen y + gen z) IN I     by ideal_coset_eq
10844   or    (gen x + gen ((gen y + gen z) o I)) - (gen x + (gen y + gen z)) IN I  by ring_sub_pair_reduce, ring_add_comm
10845   Hence true.
10846
10847   Combining,
10848     x + y + z
10849   = (gen x + gen y + gen z) o I     by 1st result
10850   = (gen x + (gen y + gen z)) o I   by ring_add_assoc
10851   = x + (y + z)                     by 2nd result
10852*)
10853Theorem quotient_ring_add_assoc:
10854    !r i:'a ring. Ring r /\ (i << r) ==> !x y z. x IN R/I /\ y IN R/I /\ z IN R/I ==> (x + y + z = x + (y + z))
10855Proof
10856  rw_tac std_ss[ideal_coset_add_def] >>
10857  `gen x IN R /\ gen y IN R /\ gen z IN R` by rw_tac std_ss[ideal_cogen_property] >>
10858  `(gen ((gen x + gen y) o I) + gen z) o I = (gen x + gen y + gen z) o I` by
10859  (`gen x + gen y IN R` by rw[] >>
10860  `gen ((gen x + gen y) o I) IN R` by rw_tac std_ss[ideal_coset_property, ideal_cogen_property] >>
10861  `gen ((gen x + gen y) o I) - (gen x + gen y) IN I` by metis_tac[ideal_coset_eq, ideal_coset_property] >>
10862  `(gen ((gen x + gen y) o I) + gen z) - (gen x + gen y + gen z) IN I` by rw_tac std_ss[ring_sub_pair_reduce] >>
10863  rw_tac std_ss[ideal_coset_eq, ring_add_element]) >>
10864  `(gen x + gen ((gen y + gen z) o I)) o I = (gen x + (gen y + gen z)) o I` by
10865    (`gen y + gen z IN R` by rw[] >>
10866  `gen ((gen y + gen z) o I) IN R` by rw_tac std_ss[ideal_coset_property, ideal_cogen_property] >>
10867  `gen ((gen y + gen z) o I) - (gen y + gen z) IN I` by metis_tac[ideal_coset_eq, ideal_coset_property] >>
10868  `gen x + gen ((gen y + gen z) o I) - (gen x + (gen y + gen z)) IN I` by metis_tac[ring_sub_pair_reduce, ring_add_comm] >>
10869  rw_tac std_ss[ideal_coset_eq, ring_add_element]) >>
10870  rw_tac std_ss[ring_add_assoc]
10871QED
10872
10873(* Theorem: [Quotient Ring Add Identity] Ring r /\ i << r /\ x IN R/I ==> I + x = x *)
10874(* Proof:
10875   LHS = I + x = (gen I + gen x) o I        by ideal_coset_add_def
10876   RHS = x = gen x o I                      by ideal_cogen_property
10877   Since I IN R/I                           by ideal_in_quotient_ring
10878         I = gen I o I                      by ideal_cogen_property
10879   or gen I o I = I = #0 o I                by ideal_coset_zero
10880   Thus  gen I - #0 IN I                    by ideal_coset_eq
10881   But (gen I + gen x) - (#0 + gen x)
10882      = gen I - #0                          by ring_sub_pair_reduce
10883   Hence (gen I + gen x) - gen x IN I       by ring_add_lzero
10884   Thus LHS = RHS                           by ideal_coset_eq
10885*)
10886Theorem quotient_ring_add_id:
10887    !r i:'a ring. Ring r /\ i << r ==> !x. x IN R/I ==> (I + x = x)
10888Proof
10889  rw_tac std_ss[ideal_coset_add_def] >>
10890  `I IN R/I` by rw_tac std_ss[ideal_in_quotient_ring] >>
10891  `gen x IN R /\ gen I IN R /\ (gen x o I = x) /\ (gen I o I = I)` by rw_tac std_ss[ideal_cogen_property] >>
10892  `I = #0 o I` by rw_tac std_ss[ideal_coset_zero] >>
10893  `#0 IN R` by rw_tac std_ss[ring_zero_element] >>
10894  `(gen I + gen x) - gen x = gen I - #0` by metis_tac[ring_sub_pair_reduce, ring_add_lzero] >>
10895  metis_tac[ideal_coset_eq, ring_add_lzero, ring_add_element]
10896QED
10897
10898(* Theorem: [Quotient Ring Add Inverse] Ring r /\ i << r /\ x IN R/I ==> ?y. y IN R/I /\ (y + x = I) *)
10899(* Proof:
10900   Since x IN R/I, gen x IN R        by ideal_cogen_property
10901            hence -gen x IN R        by ring_neg_element
10902              and -gen x o I IN R/I  by ideal_coset_property
10903   Let y = - gen x o I, then y IN R/I, and it remains to show that:
10904         y + x = I
10905   or   (- gen x o I) + x = I
10906   i.e. gen (-gen x o I) + gen x o I = I
10907   Since #0 o I = I               by coset_id_eq_subgroup
10908   this is to show: gen (-gen x o I) + gen x o I = #0 o I
10909
10910   Now  gen (-gen x o I) IN R
10911    and (gen (-gen x o I) o I = (- gen x) o I)   by ideal_cogen_property
10912   Hence  gen (-gen x o I) - (- gen x) IN I      by ideal_coset_eq
10913     gen (-gen x o I) - (- gen x)
10914   = gen (-gen x o I) + gen x        by ring_sub_def, ring_neg_neg
10915   = gen (-gen x o I) + gen x - #0   by ring_sub_def, ring_neg_zero, ring_add_rzero, ring_add_element
10916   i.e. gen (-gen x o I) + gen x - #0 IN I
10917   Thus true by ideal_coset_eq.
10918*)
10919Theorem quotient_ring_add_inv:
10920    !r i:'a ring. Ring r /\ i << r ==> !x. x IN R/I ==> ?y. y IN R/I /\ (y + x = I)
10921Proof
10922  rw_tac std_ss[ideal_coset_add_def] >>
10923  `gen x IN R` by rw_tac std_ss[ideal_cogen_property] >>
10924  `- gen x IN R` by rw_tac std_ss[ring_neg_element] >>
10925  `- gen x o I IN R/I` by rw_tac std_ss[ideal_coset_property] >>
10926  qexists_tac `- gen x o I` >>
10927  rw_tac std_ss[] >>
10928  `gen (-gen x o I) IN R /\ (gen (-gen x o I) o I = (- gen x) o I)` by rw_tac std_ss[ideal_cogen_property] >>
10929  `gen (-gen x o I) - (- gen x) IN I` by metis_tac[ideal_coset_eq] >>
10930  `gen (-gen x o I) - (- gen x) = gen (-gen x o I) + gen x` by rw[] >>
10931  `_ = gen (-gen x o I) + gen x - #0` by rw[] >>
10932  `I = #0 o I` by rw_tac std_ss[ideal_coset_zero] >>
10933  metis_tac[ideal_coset_eq, ring_add_element, ring_zero_element]
10934QED
10935
10936(* Theorem: quotient_ring_add is a Group. *)
10937(* Proof:
10938   Check for each group property:
10939   Closure: by quotient_ring_add_element
10940   Associative: by quotient_ring_add_assoc
10941   Identity: by quotient_ring_add_id, and ideal_in_quotient_ring
10942   Inverse: by quotient_ring_add_inv
10943*)
10944Theorem quotient_ring_add_group:
10945    !r i:'a ring. Ring r /\ (i << r) ==> Group (quotient_ring_add r i)
10946Proof
10947  rw_tac std_ss[group_def_alt, quotient_ring_add_def] >| [
10948    rw_tac std_ss[quotient_ring_add_element],
10949    rw_tac std_ss[quotient_ring_add_assoc],
10950    rw_tac std_ss[ideal_in_quotient_ring],
10951    rw_tac std_ss[quotient_ring_add_id],
10952    rw_tac std_ss[quotient_ring_add_inv]
10953  ]
10954QED
10955
10956(* Theorem: quotient_ring_add is an Abelain Group. *)
10957(* Proof:
10958   By quotient_ring_add_group, and quotient_ring_add_comm.
10959*)
10960Theorem quotient_ring_add_abelian_group:
10961    !r:'a ring. Ring r /\ i << r ==> AbelianGroup (quotient_ring_add r i)
10962Proof
10963  rw_tac std_ss[AbelianGroup_def] >-
10964  rw_tac std_ss[quotient_ring_add_group] >>
10965  pop_assum mp_tac >>
10966  pop_assum mp_tac >>
10967  rw_tac std_ss[quotient_ring_add_def, quotient_ring_add_comm]
10968QED
10969
10970(* ------------------------------------------------------------------------- *)
10971(* Quotient Ring (R/I).prod is an Abelian Monoid.                            *)
10972(* ------------------------------------------------------------------------- *)
10973
10974(* Theorem: [Quotient Ring Mult Closure]
10975   Ring r /\ (i << r) ==> !x y. x IN R/I /\ y IN R/I ==> x * y IN R/I *)
10976(* Proof:
10977   Since   x * y = gen x * gen y o I
10978   and gen x IN R and gen y IN R    by ideal_cogen_property
10979   This is true by ideal_coset_property, ring_mult_element.
10980*)
10981Theorem quotient_ring_mult_element:
10982    !r i:'a ring. Ring r /\ (i << r) ==> !x y. x IN R/I /\ y IN R/I ==> x * y IN R/I
10983Proof
10984  rw[ideal_cogen_property, ideal_coset_property]
10985QED
10986
10987(* Theorem: [Quotient Ring Mult Commutative] Ring r /\ (i << r) ==> !x y. x IN R/I /\ y IN R/I ==> x * y = y * x *)
10988(* Proof:
10989   We have gen x IN R and gen y IN R    by ideal_cogen_property
10990     x * y
10991   = (gen x * gen y) o I     by ideal_coset_mult_def
10992   = (gen y * gen x) o I     by ring_mult_comm
10993   = y * x                   by ideal_coset_mult_def
10994*)
10995Theorem quotient_ring_mult_comm:
10996    !r i:'a ring. Ring r /\ (i << r) ==> !x y. x IN R/I /\ y IN R/I ==> (x * y = y * x)
10997Proof
10998  rw[ideal_cogen_property, ring_mult_comm]
10999QED
11000
11001(* Theorem: Ring r /\ i << r /\ x IN R/I /\ y IN R/I /\ z IN R/I ==> x * y * z = x * (y * z) *)
11002(* Proof:
11003   We have gen x IN R, gen y IN R and gen z IN R by ideal_cogen_property.
11004   Hence gen x * gen y IN R               by ring_mult_element
11005     and gen ((gen x * gen y) o I) IN R   by ideal_coset_property, ideal_cogen_property
11006    Also gen y * gen z IN R               by ring_mult_element
11007     and gen ((gen y * gen z) o I) IN R   by ideal_coset_property, ideal_cogen_property
11008
11009   First, show: x * y * z = (gen x * gen y * gen z) o I
11010   i.e.   x * y * z = (gen ((gen x * gen y) o I) * gen z) o I = (gen x * gen y * gen z) o I
11011   By ideal_coset_eq, this is true if
11012         (gen ((gen x * gen y) o I) * gen z) - (gen x * gen y * gen z) IN I
11013   Now   gen ((gen x * gen y) o I) o I = (gen x * gen y) o I   by ideal_coset_property
11014   hence gen ((gen x * gen y) o I) - (gen x * gen y) IN I      by ideal_coset_eq
11015   and   gen ((gen x * gen y) o I) - (gen x * gen y) * gen z IN I   by ideal_product_property
11016   or   (gen ((gen x * gen y) o I) * gen z) - (gen x * gen y * gen z) IN I   by ring_mult_lsub
11017   Hence true.
11018
11019   Next, show: x * (y * z) = (gen x * (gen y * gen z)) o I
11020   i.e. (gen x * gen ((gen y * gen z) o I)) o I = (gen x * (gen y * gen z)) o I
11021   By ideal_coset_eq, this is true if
11022        (gen x * gen ((gen y * gen z) o I)) - (gen x * (gen y * gen z)) IN I
11023   Now   gen ((gen y * gen z) o I) o I = (gen y * gen z) o I    by ideal_coset_property
11024   hence (gen ((gen y * gen z) o I)) - (gen y * gen z) IN I     by ideal_coset_eq
11025   and   gen x * (gen ((gen y * gen z) o I)) - (gen y * gen z) IN I  by ideal_product_property
11026   or    (gen x * gen ((gen y + gen z) o I)) - (gen x * (gen y * gen z)) IN I  by ring_mult_rsub
11027   Hence true.
11028
11029   Combining,
11030     x * y * z
11031   = (gen x * gen y * gen z) o I     by 1st result
11032   = (gen x * (gen y * gen z)) o I   by ring_mut_assoc
11033   = x * (y * z)                     by 2nd result
11034*)
11035Theorem quotient_ring_mult_assoc:
11036    !r i:'a ring. Ring r /\ (i << r) ==> !x y z. x IN R/I /\ y IN R/I /\ z IN R/I ==> (x * y * z = x * (y * z))
11037Proof
11038  rw_tac std_ss[ideal_coset_mult_def] >>
11039  `gen x IN R /\ gen y IN R /\ gen z IN R` by rw_tac std_ss[ideal_cogen_property] >>
11040  `(gen ((gen x * gen y) o I) * gen z) o I = (gen x * gen y * gen z) o I` by
11041  (`gen x * gen y IN R` by rw[] >>
11042  `gen ((gen x * gen y) o I) IN R` by rw_tac std_ss[ideal_coset_property, ideal_cogen_property] >>
11043  `gen ((gen x * gen y) o I) - (gen x * gen y) IN I` by metis_tac[ideal_coset_eq, ideal_coset_property] >>
11044  `(gen ((gen x * gen y) o I) - (gen x * gen y)) * gen z IN I` by rw_tac std_ss[ideal_product_property] >>
11045  `(gen ((gen x * gen y) o I) * gen z) - (gen x * gen y * gen z) IN I` by rw_tac std_ss[ring_mult_lsub] >>
11046  rw_tac std_ss[ideal_coset_eq, ring_mult_element]) >>
11047  `(gen x * gen ((gen y * gen z) o I)) o I = (gen x * (gen y * gen z)) o I` by
11048    (`gen y * gen z IN R` by rw[] >>
11049  `gen ((gen y * gen z) o I) IN R` by rw_tac std_ss[ideal_coset_property, ideal_cogen_property] >>
11050  `gen ((gen y * gen z) o I) - (gen y * gen z) IN I` by metis_tac[ideal_coset_eq, ideal_coset_property] >>
11051  `gen x * (gen ((gen y * gen z) o I) - (gen y * gen z)) IN I` by rw_tac std_ss[ideal_product_property] >>
11052  `gen x * gen ((gen y * gen z) o I) - (gen x * (gen y * gen z)) IN I` by rw_tac std_ss[ring_mult_rsub] >>
11053  rw_tac std_ss[ideal_coset_eq, ring_mult_element]) >>
11054  rw_tac std_ss[ring_mult_assoc]
11055QED
11056
11057(* Theorem: [Quotient Ring Mult Identity] Ring r /\ i << r ==> !x. x IN R/I ==> ((#1 o I) * x = x) /\ (x * (#1 o I) = x) *)
11058(* Proof:
11059   #1 IN R                            by ring_one_element
11060   #1 o I IN R/I                      by ideal_coset_property
11061   gen x IN R /\ gen (#1 o I) IN R    by ideal_cogen_property
11062   and x = gen x o I                  by ideal_cogen_property
11063   and gen (#1 o I) o I = #1 o I      by ideal_cogen_property
11064   or  gen (#1 o I) - #1 IN I         by ideal_coset_eq
11065
11066   Hence this is to show:
11067        gen (#1 o I) * gen x o I = x = gen x o I
11068   and  gen x * gen (#1 o I) o I = x = gen x o I
11069
11070   For the first case:
11071       gen (#1 o I) - #1 IN I
11072   ==> (gen (#1 o I) - #1) * gen x IN I        by ideal_product_property
11073   ==> gen (#1 o I) * gen x - #1 * gen x IN I  by ring_mult_lsub
11074   ==> gen (#1 o I) * gen x - gen x IN I       by ring_mult_lone
11075   Hence true by ideal_coset_eq.
11076
11077   For the second case:
11078       gen (#1 o I) - #1 IN I
11079   ==> gen x * (gen (#1 o I) - #1) IN I        by ideal_product_property
11080   ==> gen x * gen (#1 o I) - gen x * #1 IN I  by ring_mult_rsub
11081   ==> gen x * gen (#1 o I) - gen x IN I       by ring_mult_rone
11082   Hence true by ideal_coset_eq.
11083*)
11084Theorem quotient_ring_mult_id:
11085    !r i:'a ring. Ring r /\ i << r ==> !x. x IN R/I ==> ((#1 o I) * x = x) /\ (x * (#1 o I) = x)
11086Proof
11087  ntac 5 strip_tac >>
11088  `#1 IN R` by rw[] >>
11089  `#1 o I IN R/I` by rw_tac std_ss[ideal_coset_property] >>
11090  `gen x IN R /\ gen (#1 o I) IN R /\ (x = gen x o I) /\ (gen (#1 o I) o I = #1 o I)` by rw_tac std_ss[ideal_cogen_property] >>
11091  `gen (#1 o I) - #1 IN I` by metis_tac[ideal_coset_eq] >>
11092  rw_tac std_ss[ideal_coset_mult_def] >| [
11093    `(gen (#1 o I) - #1) * gen x IN I` by rw_tac std_ss[ideal_product_property] >>
11094    `gen (#1 o I) * gen x - #1 * gen x IN I` by rw_tac std_ss[ring_mult_lsub] >>
11095    `gen (#1 o I) * gen x - gen x IN I` by metis_tac[ring_mult_lone],
11096    `gen x * (gen (#1 o I) - #1) IN I` by rw_tac std_ss[ideal_product_property] >>
11097    `gen x * gen (#1 o I) - gen x * #1 IN I` by rw_tac std_ss[ring_mult_rsub] >>
11098    `gen x * gen (#1 o I) - gen x IN I` by metis_tac[ring_mult_rone]
11099  ] >>
11100  metis_tac[ideal_coset_eq, ring_mult_element]
11101QED
11102
11103(* Theorem: quotient_ring_mult is a Monoid. *)
11104(* Proof:
11105   Check for each monoid property:
11106   Closure: by quotient_ring_mult_element
11107   Associative: by quotient_ring_mult_assoc
11108   Identity: by quotient_ring_mult_id, and ideal_coset_property, ring_one_element
11109*)
11110Theorem quotient_ring_mult_monoid:
11111    !r i:'a ring. Ring r /\ (i << r) ==> Monoid (quotient_ring_mult r i)
11112Proof
11113  rw_tac std_ss[Monoid_def, quotient_ring_mult_def] >| [
11114    rw_tac std_ss[quotient_ring_mult_element],
11115    rw_tac std_ss[quotient_ring_mult_assoc],
11116    rw_tac std_ss[ideal_coset_property, ring_one_element],
11117    rw_tac std_ss[quotient_ring_mult_id],
11118    rw_tac std_ss[quotient_ring_mult_id]
11119  ]
11120QED
11121
11122(* Theorem: quotient_ring_mult is an Abelain Monoid. *)
11123(* Proof:
11124   By quotient_ring_mult_monoid, and quotient_ring_mult_comm.
11125*)
11126Theorem quotient_ring_mult_abelian_monoid:
11127    !r:'a ring. Ring r /\ i << r ==> AbelianMonoid (quotient_ring_mult r i)
11128Proof
11129  rw_tac std_ss[AbelianMonoid_def] >-
11130  rw_tac std_ss[quotient_ring_mult_monoid] >>
11131  pop_assum mp_tac >>
11132  pop_assum mp_tac >>
11133  rw_tac std_ss[quotient_ring_mult_def, quotient_ring_mult_comm]
11134QED
11135
11136(* ------------------------------------------------------------------------- *)
11137(* Quotient Ring (R/I) is a Ring.                                            *)
11138(* ------------------------------------------------------------------------- *)
11139
11140(* Theorem: Ring r /\ i << r ==> x * (y + z) = x * y + x * z *)
11141(* Proof:
11142   We have gen x IN R, gen y IN R, gen z IN R        by ideal_cogen_property
11143   Thus    gen y + gen z IN R                        by ring_add_element
11144   and     gen x * gen y IN R /\ gen x * gen z IN R  by ring_mult_element
11145
11146   First, show that: (gen x * gen ((gen y + gen z) o I)) o I = (gen x * (gen y + gen z)) o I
11147   Let t = gen y + gen z, t IN R  by ring_add_element
11148   Hence t o I IN R/I             by coset_partition_element
11149   and gen (t o I) IN R           by cogen_element
11150   Now the goal reduces to: (gen x * gen (t o I)) o I = (gen x * t) o I
11151   Since gen (t o I) o I = t o I  by ideal_cogen_property
11152         gen (t o I) - t IN I     by ideal_coset_eq
11153   hence gen x * (gen (t o I) - t) IN I         by ideal_product_property
11154      or gen x * gen (t o I) - gen x * t IN I   by ring_mult_rsub
11155   Hence true by ideal_coset_eq, ring_mult_element.
11156
11157   Next, show that: (gen ((gen x * gen y) o I) + gen ((gen x * gen z) o I)) o I = (gen x * gen y + gen x * gen z) o I
11158   Let p = gen x * gen y, p IN R  by ring_mult_element
11159   Let q = gen x * gen z, q IN R  by ring_mult_element
11160   Hence gen (p o I) IN R         by ideal_cogen_property
11161   and   gen (q o I) IN R         by ideal_cogen_property
11162   Now the goal reduces to: gen (p o I) + gen (q o I) o I = p + q o I
11163     gen (p o I) + gen (q o I) - (p + q)
11164   = (gen (p o I) - p) + (gen (q o I) - q)      by ring_add_pair_sub
11165   Since      gen (p o I) o I = p o I           by ideal_cogen_property
11166              gen (p o I) - p IN I              by ideal_coset_eq
11167   Similarly, gen (q o I) o I = q o I           by ideal_cogen_property
11168              gen (q o I) - q IN I              by ideal_coset_eq
11169   Now by subgroup_property,
11170     Group i.sum /\ (!x y. x IN I /\ y IN I ==> (i.sum.op x y = x + y))
11171   Thus gen (p o I) + gen (q o I) - (p + q) IN I by group_op_element.
11172   Hence true by ideal_coset_eq, ring_add_element.
11173
11174   Combining,
11175     gen x * gen (gen y + gen z o I) o I
11176   = (gen x * (gen y + gen z)) o I                          by 1st result
11177   = (gen x * gen y + gen x * gen z) o I                    by ring_mult_radd
11178   = gen (gen x * gen y o I) + gen (gen x * gen z o I) o I  by 2nd result
11179*)
11180Theorem quotient_ring_mult_ladd:
11181    !r i:'a ring. Ring r /\ i << r ==> !x y z. x IN R/I /\ y IN R/I /\ z IN R/I ==> (x * (y + z) = x * y + x * z)
11182Proof
11183  rw_tac std_ss[ideal_coset_add_def, ideal_coset_mult_def] >>
11184  `gen x IN R /\ gen y IN R /\ gen z IN R` by rw_tac std_ss[ideal_cogen_property] >>
11185  `gen y + gen z IN R /\ gen x * gen y IN R /\ gen x * gen z IN R` by rw[] >>
11186  `(gen x * gen ((gen y + gen z) o I)) o I = (gen x * (gen y + gen z)) o I` by
11187  (qabbrev_tac `t = gen y + gen z` >>
11188  `gen (t o I) IN R /\ (gen (t o I) o I = t o I)` by rw_tac std_ss[ideal_coset_property, ideal_cogen_property] >>
11189  `gen (t o I) - t IN I` by metis_tac[ideal_coset_eq] >>
11190  `gen x * (gen (t o I) - t) IN I` by rw_tac std_ss[ideal_product_property] >>
11191  `gen x * gen (t o I) - gen x * t IN I` by rw_tac std_ss[ring_mult_rsub] >>
11192  rw_tac std_ss[ideal_coset_eq, ring_mult_element]) >>
11193  `(gen ((gen x * gen y) o I) + gen ((gen x * gen z) o I)) o I = (gen x * gen y + gen x * gen z) o I` by
11194    (qabbrev_tac `p = gen x * gen y` >>
11195  qabbrev_tac `q = gen x * gen z` >>
11196  `gen (p o I) IN R /\ (gen (p o I) o I = p o I)` by rw_tac std_ss[ideal_coset_property, ideal_cogen_property] >>
11197  `gen (q o I) IN R /\ (gen (q o I) o I = q o I)` by rw_tac std_ss[ideal_coset_property, ideal_cogen_property] >>
11198  `gen (p o I) - p IN I` by metis_tac[ideal_coset_eq] >>
11199  `gen (q o I) - q IN I` by metis_tac[ideal_coset_eq] >>
11200  `gen (p o I) + gen (q o I) - (p + q) = (gen (p o I) - p) + (gen (q o I) - q)` by rw_tac std_ss[ring_add_pair_sub] >>
11201  `gen (p o I) + gen (q o I) - (p + q) IN I` by metis_tac[ideal_property] >>
11202  rw_tac std_ss[ideal_coset_eq, ring_add_element]) >>
11203  rw_tac std_ss[ring_mult_radd]
11204QED
11205
11206(* Theorem: Ring r /\ i << r ==> Ring (r/i) *)
11207(* Proof:
11208   Check for each ring property:
11209   Abelian Sum group: by quotient_ring_add_abelian_group
11210   Abelian Prod monoid: by quotient_ring_mult_abelian_monoid
11211   Distribution of sum over product: by quotient_ring_mult_ladd.
11212*)
11213Theorem quotient_ring_ring:
11214    !r i:'a ring. Ring r /\ i << r ==> Ring (r / i)
11215Proof
11216  rpt strip_tac >>
11217  rw_tac std_ss[Ring_def, quotient_ring_def] >| [
11218    rw_tac std_ss[quotient_ring_add_abelian_group],
11219    rw_tac std_ss[quotient_ring_mult_abelian_monoid],
11220    rw_tac std_ss[quotient_ring_add_def],
11221    rw_tac std_ss[quotient_ring_mult_def],
11222    rw_tac std_ss[quotient_ring_add_def, quotient_ring_mult_def, quotient_ring_mult_ladd]
11223  ]
11224QED
11225
11226(* Theorem: (r/r).carrier = {R} *)
11227(* Proof: by defintions, this is to show:
11228   (1) x'' IN x /\ !x''. (x'' IN x ==> x'' IN R /\ x'' IN x' o R) ==> x'' IN R
11229       True by implication.
11230   (2) x'' IN R /\ !x''. (x'' IN R /\ x'' IN x' o R ==> x'' IN x) ==> x'' IN x
11231       Since (x'' - x') IN R      by ring_sub_element
11232       and x'' = x'' - x' + x'    by ring_sub_add
11233               = x' + (x'' - x')  by ring_add_comm
11234       True by coset_def
11235   (3) !x'. (x' IN x ==> x' IN R) /\ (x' IN R ==> x' IN x) ==> ?x'. x' IN R /\ !x''. x'' IN x ==> x'' IN x' o R
11236       Let x' = #0, then #0 IN R         by ring_zero_element
11237       and !x''. x'' IN x ==> x'' IN R   by given implication
11238       Since r << r                      by ideal_refl
11239          x' o R = #0 o R = R            by ideal_coset_zero
11240       Hence true.
11241*)
11242Theorem quotient_ring_ring_sing:
11243    !r:'a ring. Ring r ==> ((r/r).carrier = {R})
11244Proof
11245  rw[quotient_ring_def, CosetPartition_def, partition_def, inCoset_def, EXTENSION] >>
11246  rw[EQ_IMP_THM] >| [
11247    metis_tac[],
11248    `!y z. y IN R /\ z IN R ==> (z = y + (z - y))` by metis_tac[ring_sub_add, ring_add_comm, ring_sub_element] >>
11249    `!x z. x IN R ==> (z IN x o R <=> ?y. y IN R /\ (z = x + y))` by (rw[coset_def] >> metis_tac[]) >>
11250    metis_tac[ring_sub_element],
11251    `#0 IN R /\ (#0 o R = R)` by rw[ideal_coset_zero, ideal_refl] >>
11252    metis_tac[]
11253  ]
11254QED
11255(* Michael's proof:
11256val quotient_ring_ring_sing = store_thm(
11257  "quotient_ring_ring_sing",
11258  ``!r:'a ring. Ring r ==> ((r/r).carrier = {R})``,
11259  rw[quotient_ring_def, CosetPartition_def, partition_def, inCoset_def, EXTENSION] >>
11260  rw[EQ_IMP_THM] >| [
11261    metis_tac[],
11262    qcase_tac `y o R` >>
11263    qcase_tac `_ IN R' ==> _` >>
11264    qcase_tac `z IN R'` >>
11265    `z = z - y + y` by rw[ring_sub_add] >>
11266    `_ = y + (z - y)` by rw[ring_add_comm] >>
11267    `!z. z IN y o R <=> ?y'. y' IN R /\ (z = y + y')` by rw[coset_def] >| [
11268      metis_tac[],
11269      metis_tac[ring_sub_element]
11270    ],
11271    `#0 IN R` by rw[] >>
11272    `#0 o R = R` by rw[ideal_coset_zero, ideal_refl] >>
11273    metis_tac[]
11274  ]);
11275*)
11276
11277(* ------------------------------------------------------------------------- *)
11278(* Quotient Ring by Principal Ideal                                          *)
11279(* ------------------------------------------------------------------------- *)
11280
11281(* Theorem: Ring (r / <p>) *)
11282(* Proof:
11283   by quotient_ring_ring, principal_ideal_ideal.
11284*)
11285Theorem quotient_ring_by_principal_ideal:
11286    !r:'a ring. Ring r ==> !p. p IN R ==> Ring (r / <p>)
11287Proof
11288  rw[quotient_ring_ring, principal_ideal_ideal]
11289QED
11290
11291(* ------------------------------------------------------------------------- *)
11292(* Quotient Ring Homomorphism                                                *)
11293(* ------------------------------------------------------------------------- *)
11294
11295(* Theorem: [Ring homomorphism to Quotient Ring] The map: x -> x o I is a homomorphism from R to (R/I). *)
11296(* Proof:
11297   This is to show:
11298   (1) Ring r /\ i << r /\ x IN R ==> x o I IN R/I
11299       True by ideal_coset_property
11300   (2) same as (1)
11301   (3) Ring r /\ i << r /\ x IN R /\ x' IN R ==> (x + x') o I = x o I + x' o I
11302       By ideal_coset_add_def, this is to show: (x + x') o I = (gen (x o I) + gen (x' o I)) o I
11303       Now   gen (x o I) IN R /\ gen (x o I) o I = x o I      by ideal_cogen_property, ideal_coset_property
11304       and   gen (x' o I) IN R /\ gen (x' o I) o I = x' o I   by ideal_cogen_property, ideal_coset_property
11305       Hence   gen (x o I) - x IN I     by ideal_coset_eq
11306       and     gen (x' o I) - x' IN I   by ideal_coset_eq
11307       But     gen (x o I) + gen (x' o I) - (x + x')
11308             = (gen (x o I) - x) + (gen (x' o I) - x')        by ring_add_pair_sub
11309       By ideal_property, each component is IN I.
11310       Hence true by ideal_coset_eq.
11311   (4) same as (1)
11312   (5) Ring r /\ i << r /\ x IN R /\ x' IN R ==> (x * x') o I = x o I * x' o I
11313       By ideal_coset_mult_def, this is to show: (x * x') o I = (gen (x o I) * gen (x' o I)) o I
11314       gen (x o I) * gen (x' o I) - (x * x')
11315       = (gen (x o I) - x) * (gen (x' o I) - x') +  (gen (x o I) - x) * x' + x * (gen (x' o I) - x')
11316             in I               in I                    in I           in R  in R  in I
11317       By ideal_product_property and ideal_property, each component is IN I.
11318       Hence true by ideal_coset_eq.
11319*)
11320Theorem quotient_ring_homo:
11321    !r i:'a ring. Ring r /\ i << r ==> RingHomo (\x. x o I) r (r / i)
11322Proof
11323  rw_tac std_ss[RingHomo_def, GroupHomo_def, MonoidHomo_def, quotient_ring_def, quotient_ring_add_def, quotient_ring_mult_def, ring_add_group, ring_mult_monoid] >-
11324  rw_tac std_ss[ideal_coset_property] >-
11325  rw_tac std_ss[ideal_coset_property] >-
11326 (rw_tac std_ss[ideal_coset_add_def] >>
11327  `gen (x o I) - x IN I` by metis_tac[ideal_cogen_property, ideal_coset_property, ideal_coset_eq] >>
11328  `gen (x' o I) - x' IN I` by metis_tac[ideal_cogen_property, ideal_coset_property, ideal_coset_eq] >>
11329  `gen (x o I) IN R /\ gen (x' o I) IN R` by metis_tac[ideal_cogen_property, ideal_coset_property] >>
11330  `gen (x o I) + gen (x' o I) - (x + x') = (gen (x o I) - x) + (gen (x' o I) - x')`
11331    by rw_tac std_ss[ring_add_pair_sub] >>
11332  `gen (x o I) + gen (x' o I) - (x + x') IN I` by metis_tac[ideal_property] >>
11333  metis_tac[ideal_coset_eq, ring_add_element]) >-
11334  rw_tac std_ss[ideal_coset_property] >>
11335  rw_tac std_ss[ideal_coset_mult_def] >>
11336  `gen (x o I) IN R /\ gen (x' o I) IN R` by metis_tac[ideal_cogen_property, ideal_coset_property] >>
11337  `gen (x o I) * gen (x' o I) - (x * x') =
11338   (gen (x o I) - x) * (gen (x' o I) - x') + (gen (x o I) - x) * x' + x * (gen (x' o I) - x')`
11339     by rw_tac std_ss[ring_mult_pair_sub] >>
11340  `gen (x o I) - x IN I` by metis_tac[ideal_cogen_property, ideal_coset_property, ideal_coset_eq] >>
11341  `gen (x' o I) - x' IN I` by metis_tac[ideal_cogen_property, ideal_coset_property, ideal_coset_eq] >>
11342  `gen (x o I) * gen (x' o I) - x * x' IN I` by metis_tac[ideal_property, ideal_product_property] >>
11343  metis_tac[ideal_coset_eq, ring_mult_element]
11344QED
11345
11346(* Theorem: The quotient ring homomorphism is surjective. *)
11347(* Proof: by SURJ_DEF, this is to show:
11348   (1) x IN R ==> x o I IN R/I
11349       True by ideal_coset_property
11350   (2) x IN R/I ==> ?x'. x' IN R /\ (x' o I = x)
11351       Since  i.sum <= r.sum   by ideal_def
11352       r.sum.carrier = R       by Ring_def
11353       i.sum.carrier = I       by ideal_def
11354       True by coset_partition_element.
11355*)
11356Theorem quotient_ring_homo_surj:
11357    !(r:'a ring) (i:'a ring). Ring r /\ i << r ==> SURJ (\x. x o I) R R/I
11358Proof
11359  rw[SURJ_DEF] >| [
11360    rw[ideal_coset_property],
11361    `i.sum <= r.sum` by metis_tac[ideal_def] >>
11362    `r.sum.carrier = R` by rw[] >>
11363    `i.sum.carrier = I` by metis_tac[ideal_def] >>
11364    metis_tac[coset_partition_element]
11365  ]
11366QED
11367
11368(* Theorem: In the ring homomorphism x -> x o I, its kernel = I *)
11369(* Proof:
11370   This is to show: {x | x IN R /\ (x o I = I)} = I
11371   If x IN R /\ (x o I = I),
11372      Since I = #0 o I       by ideal_coset_zero
11373      we have x o I = #0 o I
11374      or  x - #0 IN I        by ideal_coset_eq
11375      i.e. x IN I            by ring_sub_zero
11376   If x IN I
11377      then x IN R            by ideal_element_property
11378      and since x - #0 IN I  by ring_sub_zero
11379      x o I = #0 o I         by ideal_coset_eq
11380            = I              by ideal_coset_zero
11381*)
11382Theorem quotient_ring_homo_kernel:
11383    !r i:'a ring. Ring r /\ i << r ==> (kernel (\x. x o I) r.sum (r / i).sum = I)
11384Proof
11385  rw_tac std_ss[kernel_def, preimage_def, quotient_ring_def, quotient_ring_add_def, ring_add_group] >>
11386  `#0 o I = I` by rw_tac std_ss[ideal_coset_zero] >>
11387  rw[Once EXTENSION, EQ_IMP_THM] >| [
11388    metis_tac[ideal_coset_eq, ring_zero_element, ring_sub_zero],
11389    metis_tac[ideal_element_property],
11390    metis_tac[ideal_coset_eq, ring_sub_zero, ideal_element_property, ring_zero_element]
11391  ]
11392QED
11393
11394(* ------------------------------------------------------------------------- *)
11395(* Kernel of Ring Homomorphism.                                              *)
11396(* ------------------------------------------------------------------------- *)
11397
11398(* Define the Kernel Ideal of a ring homomorphism. *)
11399Definition kernel_ideal_def:
11400  kernel_ideal f (r:'a ring) (s:'b ring) =
11401    <| carrier := kernel f r.sum s.sum;  (* e.g. s = r / i *)
11402           sum := <| carrier := kernel f r.sum s.sum; op := r.sum.op; id := r.sum.id |>;
11403          prod := <| carrier := kernel f r.sum s.sum; op := r.prod.op; id := r.prod.id |>
11404     |>
11405End
11406
11407(* Theorem: (kernel_ideal f r s).sum = kernel_group f r.sum s.sum *)
11408(* Proof: kernel_ideal_def, kernel_group_def *)
11409Theorem kernel_ideal_sum_eqn:
11410    !(r:'a ring) (s:'b ring) f. (kernel_ideal f r s).sum = kernel_group f r.sum s.sum
11411Proof
11412  rw_tac std_ss[kernel_ideal_def, kernel_group_def]
11413QED
11414
11415(* Theorem: x IN (kernel_ideal f r r_).carrier <=> x IN r.sum.carrier /\ (f x = #0_) *)
11416(* Proof:
11417       x IN (kernel_ideal f r r_).carrier
11418   <=> x IN kernel f r.sum r_.sum           by kernel_ideal_def
11419   <=> x IN preimage f r.sum.carrier #0_    by kernel_def
11420   <=> x IN r.sum.carrier /\ (f x = #0_)    by in_preimage
11421*)
11422Theorem kernel_ideal_element:
11423    !(r:'a ring) (r_:'b ring) f x.
11424     x IN (kernel_ideal f r r_).carrier <=> x IN r.sum.carrier /\ (f x = #0_)
11425Proof
11426  rw_tac std_ss[kernel_ideal_def, kernel_def, in_preimage]
11427QED
11428
11429(*
11430CONJ_ASM1_TAC      A ==> B /\ C  to A ==> B,  A /\ B ==> C
11431CONJ_ASM2_TAC      A ==> B /\ C  to A ==> C,  A /\ C ==> B
11432*)
11433
11434(* Theorem: If f is a Ring homomorphism, kernel_ideal is an ideal. *)
11435(* Proof:
11436   Ring r, s ==> Group r.sum /\ Group s.sum     by ring_add_group
11437   RingHomo f r s ==> GroupHomo f r.sum s.sum   by RingHomo_def
11438   This is to show:
11439   (1) <|carrier := kernel f r.sum s.sum; op := $+; id := #0|> <= r.sum
11440       This splits into two:
11441       the first one is: Group <|carrier := kernel f r.sum s.sum; op := $+; id := #0|>
11442       This reduces to 7 subgoals:
11443       1. x IN R /\ y IN R ==> x + y IN R     true by ring_add_element
11444       2. f x = s.sum.id /\ f y = s.sum.id ==> f (x + y) = s.sum.id
11445          Since   f (x + y) = s.sum.op (f x) (f y))   by GroupHomo_def
11446          Hence true by group_id_id.
11447       3. x IN R /\ y IN R /\ z IN R ==> x + y + z = x + (y + z)   true by ring_add_assoc
11448       4. #0 IN R     true by ring_zero_element
11449       5. f #0 = s.sum.id
11450          Since  f (x + y) = s.sum.op (f x) (f y))   by GroupHomo_def, RingHomo_def, ring_add_group
11451          Using group_id_id,  f #0 = f (#0 + #0) = s.sum.op (f #0) (f #0)
11452          Hence f #0 = s.sum.id      by group_id_fix
11453       6. x IN R ==> #0 + x = x      true by ring_add_lzero
11454       7. x IN R /\ f x = s.sum.id ==> ?y. (y IN R /\ (f y = s.sum.id)) /\ (y + x = #0)
11455          x IN R ==> -x IN R         by ring_neg_element
11456          Let y = -x, then y IN R, and y + x = #0   by ring_add_lneg
11457          f y = s.sum.op ((f y) s.sum.id)      by group_rid
11458              = s.sum.op ((f y) (f x))         by given
11459              = f (y + x)                      by GroupHomo_def
11460              = f #0                           by above
11461              = s.sum.id                       by 5.
11462       The second is: kernel f r.sum s.sum SUBSET R
11463       True by kernel_def.
11464   (2) x IN kernel f r.sum s.sum /\ y IN R ==> x * y IN kernel f r.sum s.sum
11465       This reduces to 2 subgoals:
11466       1. x IN kernel f r.sum s.sum /\ y IN R ==> x * y IN R
11467          Since   kernel f r.sum s.sum SUBSET R  by (2)
11468          This is true by ring_mult_element and SUBSET_DEF.
11469       2. x IN kernel f r.sum s.sum /\ y IN R ==> f (x * y) = s.sum.id
11470          Since x IN kernel f r.sum s.sum, f x = s.sum.id    by kernel_def
11471          f (x * y) = s.prod.op (s.sum.id) (f y)             by MonoidHomo_def
11472                    = s.sum.id                               by ring_mult_lzero
11473   (3) x IN kernel f r.sum s.sum /\ y IN R ==> y * x IN kernel f r.sum s.sum
11474       Since kernel f r.sum s.sum SUBSET R     by kernel_def
11475       x IN R                                  by SUBSET_DEF
11476       Hence this follows from (2) by ring_mult_comm.
11477*)
11478Theorem ring_homo_kernel_ideal:
11479    !f (r:'a ring) (s:'b ring). Ring r /\ Ring s /\ RingHomo f r s ==> kernel_ideal f r s << r
11480Proof
11481  rpt strip_tac >>
11482  `GroupHomo f r.sum s.sum` by metis_tac[RingHomo_def] >>
11483  `MonoidHomo f r.prod s.prod` by metis_tac[RingHomo_def] >>
11484  `Group r.sum /\ Group s.sum /\ (r.sum.carrier = R) /\ (s.sum.carrier = s.carrier)` by rw_tac std_ss[ring_add_group] >>
11485  `Monoid r.prod /\ Monoid s.prod /\ (r.prod.carrier = R) /\ (s.prod.carrier = s.carrier)` by rw_tac std_ss[ring_mult_monoid] >>
11486  rw_tac std_ss[kernel_ideal_def, ideal_def] >| [
11487    rw_tac std_ss[Subgroup_def] >| [
11488      rw_tac std_ss[group_def_alt, kernel_def, preimage_def, GSPECIFICATION] >-
11489      rw_tac std_ss[ring_add_element] >-
11490      metis_tac[GroupHomo_def, group_id_id] >-
11491      rw_tac std_ss[ring_add_assoc] >-
11492      rw_tac std_ss[ring_zero_element] >-
11493      metis_tac[GroupHomo_def, group_id_id, group_id_fix, ring_zero_element] >-
11494      rw_tac std_ss[ring_add_lzero] >>
11495      `-x IN R /\ (-x + x = #0)` by rw_tac std_ss[ring_neg_element, ring_add_lneg] >>
11496      qexists_tac `-x` >>
11497      rw_tac std_ss[] >>
11498      metis_tac[GroupHomo_def, group_id_id, group_id_fix, ring_zero_element, ring_add_lneg, group_rid],
11499      rw[kernel_def, preimage_def, SUBSET_DEF]
11500    ],
11501    `kernel f r.sum s.sum SUBSET R` by rw[kernel_def, preimage_def, SUBSET_DEF] >>
11502    rw_tac std_ss[kernel_def, preimage_def, GSPECIFICATION] >-
11503    metis_tac[SUBSET_DEF, ring_mult_element] >>
11504    `x IN R` by metis_tac[SUBSET_DEF] >>
11505    `!x. x IN kernel f r.sum s.sum ==> (f x = s.sum.id)` by rw_tac std_ss[kernel_def, preimage_def, GSPECIFICATION] >>
11506    metis_tac[MonoidHomo_def, ring_mult_monoid, ring_mult_lzero],
11507    `kernel f r.sum s.sum SUBSET R` by rw[kernel_def, preimage_def, SUBSET_DEF] >>
11508    rw_tac std_ss[kernel_def, preimage_def, GSPECIFICATION] >-
11509    metis_tac[SUBSET_DEF, ring_mult_element] >>
11510    `x IN R` by metis_tac[SUBSET_DEF] >>
11511    `!x. x IN kernel f r.sum s.sum ==> (f x = s.sum.id)` by rw_tac std_ss[kernel_def, preimage_def, GSPECIFICATION] >>
11512    metis_tac[MonoidHomo_def, ring_mult_monoid, ring_mult_rzero]
11513  ]
11514QED
11515
11516(* Theorem: Any ideal will induce a ring homomorphism f from r to (r / i) such that kernel_ideal f = i *)
11517(* Proof:
11518   We have shown: Ring r /\ i << r ==> RingHomo (\x. x o I) r (r / i)   by quotient_ring_homo
11519   And we have: Ring r /\ i << r ==> (kernel (\x. x o I) r.sum (r / i).sum = I  by quotient_ring_homo_kernel
11520   The remaining cases are:
11521   (1) <|carrier := kernel (\x. x o I) r.sum (r / i).sum; op := $+; id := #0|> = i.sum
11522       kernel (\x. x o I) r.sum (r / i).sum = I    by quotient_ring_homo_kernel
11523       i.sum.carrier = I                           by ideal_def
11524       i.sum.op = r.sum.op                         by ideal_ops
11525       i.sum.id = #0                               by subgroup_id
11526       Hence true by monoid_component_equality.
11527   (2) <|carrier := kernel (\x. x o I) r.sum (r / i).sum; op := $*; id := #1|> = i.prod
11528       kernel (\x. x o I) r.sum (r / i).sum = I    by quotient_ring_homo_kernel
11529       i.prod.carrier = I                          by ideal_def
11530       i.prod.op = r.prod.op                       by ideal_def
11531       i.prod.id = #1                              by ideal_def
11532
11533*)
11534Theorem quotient_ring_homo_kernel_ideal:
11535    !r i:'a ring. Ring r /\ i << r ==> RingHomo (\x. x o I) r (r / i) /\ (kernel_ideal (\x. x o I) r (r / i) = i)
11536Proof
11537  rw_tac std_ss[quotient_ring_homo] >>
11538  rw_tac std_ss[kernel_ideal_def] >>
11539  `kernel (\x. x o I) r.sum (r / i).sum = I` by rw_tac std_ss[quotient_ring_homo_kernel] >>
11540  rw_tac std_ss[ring_component_equality] >| [
11541    `i.sum <= r.sum /\ (i.sum.carrier = I) /\ (i.sum.op = r.sum.op)` by metis_tac[ideal_def, ideal_ops] >>
11542    `i.sum.id = #0` by rw_tac std_ss[subgroup_id],
11543    `(i.prod.carrier = I) /\ (i.prod.op = r.prod.op) /\ (i.prod.id = #1)` by metis_tac[ideal_def]
11544  ] >>
11545  rw_tac std_ss[monoid_component_equality]
11546QED
11547
11548(* ------------------------------------------------------------------------- *)
11549(* First Isomorphism Theorem for Ring.                                       *)
11550(* ------------------------------------------------------------------------- *)
11551
11552(* Theorem: (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in
11553            !x y. x IN R/I /\ y IN R/I ==> (f (gen ((gen x + gen y) o I)) = (f (gen x)) +_ (f (gen y))) *)
11554(* Proof:
11555   Let t = gen x + gen y.
11556   The goal becomes: f (gen (t o I)) = f (gen x) +_ f (gen y)
11557   Note i << r                           by ring_homo_kernel_ideal
11558    ==> gen x IN R /\ gen y IN R         by ideal_cogen_property
11559     so t IN R                           by ring_add_element
11560    ==> t o I IN R/I                     by ideal_coset_property, t IN R
11561     so gen (t o I) IN R                 by ideal_cogen_property
11562   Thus f (gen (t o I)) IN R_            by ring_homo_element
11563    and f (gen x) IN R_                  by ring_homo_element
11564    and f (gen y) IN R_                  by ring_homo_element
11565     so (f (gen x) +_ f (gen y)) IN R_   by ring_add_element
11566
11567   Note gen (t o I) - t IN I             by ideal_coset_has_gen_diff
11568
11569        f (gen (t o I)) -_ (f (gen x) +_ f (gen y))
11570      = f (gen (t o I)) -_ (f t)         by ring_homo_add
11571      = f (gen (t o I) - t)              by ring_homo_sub
11572      = #0_                              by kernel_ideal_element
11573
11574   Thus f (gen (t o I)) = f (gen x) +_ f (gen y)   by ring_sub_eq_zero
11575*)
11576Theorem kernel_ideal_gen_add_map:
11577    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in
11578    !x y. x IN R/I /\ y IN R/I ==> (f (gen ((gen x + gen y) o I)) = (f (gen x)) +_ (f (gen y)))
11579Proof
11580  rw_tac std_ss[] >>
11581  qabbrev_tac `t = gen x + gen y` >>
11582  `i << r` by rw[ring_homo_kernel_ideal, Abbr`i`] >>
11583  `gen x IN R /\ gen y IN R` by rw[ideal_cogen_property] >>
11584  `t IN R` by rw[Abbr`t`] >>
11585  `t o I IN R/I` by rw[ideal_coset_property] >>
11586  `gen (t o I) IN R` by rw[ideal_cogen_property] >>
11587  `f (gen (t o I)) IN R_ /\ f (gen x) IN R_ /\ f (gen y) IN R_` by metis_tac[ring_homo_element] >>
11588  `(f (gen x) +_ f (gen y)) IN R_` by rw[] >>
11589  `gen (t o I) - t IN I` by rw[ideal_coset_has_gen_diff] >>
11590  `f (gen (t o I)) -_ (f (gen x) +_ f (gen y)) = f (gen (t o I)) -_ f t` by metis_tac[ring_homo_add] >>
11591  `_ = f (gen (t o I) - t)` by rw[ring_homo_sub] >>
11592  `_ = #0_` by metis_tac[kernel_ideal_element] >>
11593  metis_tac[ring_sub_eq_zero]
11594QED
11595
11596(* Theorem: (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in
11597            !x y. x IN R/I /\ y IN R/I ==> (f (gen ((gen x * gen y) o I)) = (f (gen x)) *_ (f (gen y))) *)
11598(* Proof:
11599   Let t = gen x * gen y.
11600   The goal becomes: f (gen (t o I)) = f (gen x) *_ f (gen y)
11601   Note i << r                           by ring_homo_kernel_ideal
11602    ==> gen x IN R /\ gen y IN R         by ideal_cogen_property
11603     so t IN R                           by ring_add_element
11604    ==> t o I IN R/I                     by ideal_coset_property, t IN R
11605     so gen (t o I) IN R                 by ideal_cogen_property
11606   Thus f (gen (t o I)) IN R_            by ring_homo_element
11607    and f (gen x) IN R_                  by ring_homo_element
11608    and f (gen y) IN R_                  by ring_homo_element
11609     so (f (gen x) *_ f (gen y)) IN R_   by ring_mult_element
11610
11611   Note gen (t o I) - t IN I             by ideal_coset_has_gen_diff
11612
11613        f (gen (t o I)) -_ (f (gen x) *_ f (gen y))
11614      = f (gen (t o I)) -_ (f t)         by ring_homo_mult
11615      = f (gen (t o I) - t)              by ring_homo_sub
11616      = #0_                              by kernel_ideal_element
11617
11618   Thus f (gen (t o I)) = f (gen x) *_ f (gen y)   by ring_sub_eq_zero
11619*)
11620Theorem kernel_ideal_gen_mult_map:
11621    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in
11622    !x y. x IN R/I /\ y IN R/I ==> (f (gen ((gen x * gen y) o I)) = (f (gen x)) *_ (f (gen y)))
11623Proof
11624  rw_tac std_ss[] >>
11625  qabbrev_tac `t = gen x * gen y` >>
11626  `i << r` by rw[ring_homo_kernel_ideal, Abbr`i`] >>
11627  `gen x IN R /\ gen y IN R` by rw[ideal_cogen_property] >>
11628  `t IN R` by rw[Abbr`t`] >>
11629  `t o I IN R/I` by rw[ideal_coset_property] >>
11630  `gen (t o I) IN R` by rw[ideal_cogen_property] >>
11631  `f (gen (t o I)) IN R_ /\ f (gen x) IN R_ /\ f (gen y) IN R_` by metis_tac[ring_homo_element] >>
11632  `(f (gen x) *_ f (gen y)) IN R_` by rw[] >>
11633  `gen (t o I) - t IN I` by rw[ideal_coset_has_gen_diff] >>
11634  `f (gen (t o I)) -_ (f (gen x) *_ f (gen y)) = f (gen (t o I)) -_ f t` by metis_tac[ring_homo_mult] >>
11635  `_ = f (gen (t o I) - t)` by rw[ring_homo_sub] >>
11636  `_ = #0_` by metis_tac[kernel_ideal_element] >>
11637  metis_tac[ring_sub_eq_zero]
11638QED
11639
11640(* Theorem: (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in
11641            !x y. x IN R/I /\ y IN R/I ==> (f (gen (#1 o I)) = #1_) *)
11642(* Proof:
11643   Note i << r                           by ring_homo_kernel_ideal
11644    and #1 IN R /\ #1_ IN R_             by ring_add_element
11645    ==> #1 o I IN R/I                    by ideal_coset_property, #1 IN R
11646     so gen (#1 o I) IN R                by ideal_cogen_property
11647   Thus f (gen (#1 o I)) IN R_           by ring_homo_element
11648
11649   Note gen (#1 o I) - #1 IN I           by ideal_coset_has_gen_diff
11650
11651        f (gen (#1 o I)) -_ #1_
11652      = f (gen (#1 o I)) -_ (f #1)       by ring_homo_ids
11653      = f (gen (#1 o I) - #1)            by ring_homo_sub
11654      = #0_                              by kernel_ideal_element
11655
11656   Thus f (gen (#1 o I)) = #1_           by ring_sub_eq_zero
11657*)
11658Theorem kernel_ideal_gen_id_map:
11659    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in f (gen (#1 o I)) = #1_
11660Proof
11661  rw_tac std_ss[] >>
11662  `i << r` by rw[ring_homo_kernel_ideal, Abbr`i`] >>
11663  `#1 IN R /\ #1_ IN R_` by rw[] >>
11664  `#1 o I IN R/I` by rw[ideal_coset_property] >>
11665  `gen (#1 o I) IN R` by rw[ideal_cogen_property] >>
11666  `gen (#1 o I) - #1 IN I` by rw[ideal_coset_has_gen_diff] >>
11667  `f (gen (#1 o I)) IN R_` by metis_tac[ring_homo_element] >>
11668  `f (gen (#1 o I)) -_ #1_ = f (gen (#1 o I)) -_ f #1` by metis_tac[ring_homo_ids] >>
11669  `_ = f (gen (#1 o I) - #1)` by rw[ring_homo_sub] >>
11670  `_ = #0_` by metis_tac[kernel_ideal_element] >>
11671  metis_tac[ring_sub_eq_zero]
11672QED
11673
11674(* Theorem: (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in
11675            !x y. x IN R/I /\ y IN R/I ==> ((gen x - gen y) IN I <=> (x = y)) *)
11676(* Proof:
11677   Let i = kernel_ideal f r r_.
11678   Note i << r                          by ring_homo_kernel_ideal, (r ~r~ s) f
11679    ==> gen x IN R /\ (gen x o I = x)   by ideal_cogen_property
11680    and gen y IN R /\ (gen y o I = y)   by ideal_cogen_property
11681   If part: (gen x - gen y) IN I ==> (x = y)
11682      By EXTENSION, this is to show:
11683      (1) z IN x ==> z IN y
11684          Note z IN (gen x) o I                by above
11685           ==> ?u. u IN I /\ (z = gen x + u)   by ideal_coset_element
11686            so u IN R                          by ideal_element_property
11687               z = gen x + u
11688                 = gen x + #0 + u                    by ring_add_rzero
11689                 = gen x + (-(gen y) + gen y) + u    by ring_add_lneg
11690                 = (gen x - gen y) + gen y + u       by ring_add_assoc
11691                 = gen y + (gen x - gen y) + u       by ring_add_comm
11692                 = gen y + ((gen x - gen y) + u)     by ring_add_assoc, ring_sub_element
11693           Now (gen x - gen y) + u IN I              by ideal_has_sum
11694          Thus z IN y                                by ideal_coset_element
11695      (2) z IN y ==> z IN x
11696          Note z IN (gen y) o I                by above
11697           ==> ?v. v IN I /\ (z = gen y + v)   by ideal_coset_element
11698            so v IN R                          by ideal_element_property
11699               z = gen x + u
11700                 = gen y + #0 + v                    by ring_add_rzero
11701                 = gen y + (-(gen x) + gen x) + v    by ring_add_lneg
11702                 = (gen y - gen x) + gen x + v       by ring_add_assoc
11703                 = gen x + (gen y - gen x) + v       by ring_add_comm
11704                 = gen x + ((gen y - gen x) + v)     by ring_add_assoc, ring_sub_element
11705                 = gen x + (-(gen x - gen y) + v)    by ring_neg_sub
11706           Now -(gen x - gen y) IN I                 by ideal_has_neg
11707            so -(gen x - gen y) + v IN I             by ideal_has_sum
11708           Thus z IN x                               by ideal_coset_element
11709   Only-if part: (x = y) ==> (gen x - gen y) IN I
11710      Note gen x - gen y = gen x - gen x       by x = y
11711                         = #0                  by ring_sub_eq_zero
11712       and #0 IN I                             by ideal_has_zero
11713*)
11714Theorem kernel_ideal_quotient_element_eq:
11715    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in
11716   !x y. x IN R/I /\ y IN R/I ==> ((gen x - gen y) IN I <=> (x = y))
11717Proof
11718  rw_tac std_ss[] >>
11719  `i << r` by rw[ring_homo_kernel_ideal, Abbr`i`] >>
11720  `gen x IN R /\ (gen x o I = x)` by rw[ideal_cogen_property] >>
11721  `gen y IN R /\ (gen y o I = y)` by rw[ideal_cogen_property] >>
11722  rw_tac std_ss[EQ_IMP_THM] >| [
11723    rw[EXTENSION, EQ_IMP_THM] >| [
11724      `?u. u IN I /\ (x' = gen x + u)` by rw[GSYM ideal_coset_element] >>
11725      `_ = gen x + #0 + u` by rw[] >>
11726      `_ = gen x + (-(gen y) + gen y) + u` by rw[] >>
11727      `_ = (gen x - gen y) + gen y + u` by rw[ring_add_assoc] >>
11728      `_ = gen y + (gen x - gen y) + u` by rw[ring_add_comm] >>
11729      `_ = gen y + ((gen x - gen y) + u)` by prove_tac[ring_add_assoc, ring_sub_element, ideal_element_property] >>
11730      metis_tac[ideal_coset_element, ideal_has_sum],
11731      `?v. v IN I /\ (x' = gen y + v)` by rw[GSYM ideal_coset_element] >>
11732      `_ = gen y + #0 + v` by rw[] >>
11733      `_ = gen y + (-(gen x) + gen x) + v` by rw[] >>
11734      `_ = (gen y - gen x) + gen x + v` by rw[ring_add_assoc] >>
11735      `_ = gen x + (gen y - gen x) + v` by rw[ring_add_comm] >>
11736      `_ = gen x + ((gen y - gen x) + v)` by prove_tac[ring_add_assoc, ring_sub_element, ideal_element_property] >>
11737      `_ = gen x + (-(gen x - gen y) + v)` by rw[ring_neg_sub] >>
11738      metis_tac[ideal_coset_element, ideal_has_sum, ideal_has_neg]
11739    ],
11740    `gen x - gen x = #0` by rw[] >>
11741    metis_tac[ideal_has_zero]
11742  ]
11743QED
11744
11745(* Theorem: (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in INJ (f o gen) R/I (IMAGE f R) *)
11746(* Proof:
11747   Let i = kernel_ideal f r r_.
11748   Note i << r                         by ring_homo_kernel_ideal, (r ~r~ r_) f
11749   By INJ_DEF, this is to show:
11750   (1) x IN R/I ==> f (gen x) IN IMAGE f R
11751       Note gen x IN R                 by ideal_cogen_property
11752       Thus f (gen x) IN IMAGE f R     by IN_IMAGE
11753   (2) x IN R/I /\ y IN R/I /\ (f (gen x) = f (gen y)) ==> (x = y)
11754       Note gen x IN R /\ gen y IN R   by ideal_cogen_property
11755       Thus gen x - gen y IN R         by ring_sub_element
11756       also r.sum.carrier = R          by ring_carriers
11757       Note f (gen x) IN R_            by ring_homo_element
11758        and f (gen y) IN R_            by ring_homo_element
11759            f (gen x - gen y)
11760          = f (gen x) -_ f (gen y)     by ring_homo_sub
11761          = f (gen x) -_ f (gen x)     by f (gen x) = f (gen y)
11762          = #0_                        by ring_sub_eq_zero
11763       Thus (gen x - gen y) IN I       by kernel_ideal_element
11764        ==> x = y                      by kernel_ideal_quotient_element_eq
11765*)
11766Theorem kernel_ideal_quotient_inj:
11767    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==>
11768     let i = kernel_ideal f r r_ in INJ (f o gen) R/I (IMAGE f R)
11769Proof
11770  rw_tac std_ss[] >>
11771  `i << r` by rw[ring_homo_kernel_ideal, Abbr`i`] >>
11772  rw_tac std_ss[INJ_DEF] >-
11773  rw[ideal_cogen_property] >>
11774  `gen x IN R /\ gen y IN R` by rw[ideal_cogen_property] >>
11775  `gen x - gen y IN R /\ (r.sum.carrier = R)` by rw[] >>
11776  `f (gen x) IN R_ /\ f (gen y) IN R_` by metis_tac[ring_homo_element] >>
11777  `f (gen x - gen y) = #0_` by metis_tac[ring_homo_sub, ring_sub_eq_zero] >>
11778  `(gen x - gen y) IN I` by rw[kernel_ideal_element, Abbr`i`] >>
11779  metis_tac[kernel_ideal_quotient_element_eq]
11780QED
11781
11782(* Theorem: (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in SURJ (f o gen) R/I (IMAGE f R) *)
11783(* Proof:
11784   Let i = kernel_ideal f r r_.
11785   Note i << r                         by ring_homo_kernel_ideal, (r ~r~ r_) f
11786   By SURJ_DEF, this is to show:
11787   (1) x IN R/I ==> f (gen x) IN IMAGE f R
11788       Note gen x IN R                 by ideal_cogen_property
11789       Thus f (gen x) IN IMAGE f R     by IN_IMAGE
11790   (2) x IN IMAGE f R ==> ?y. y IN R/I /\ (f (gen y) = x)
11791       Note ?z. (x = f z) /\ z IN R    by IN_IMAGE
11792       Thus z o I IN R/I               by ideal_coset_property
11793        ==> gen (z o I) IN R           by ideal_cogen_property
11794       Note gen (z o I) - z IN I       by ideal_coset_has_gen_diff, z IN R
11795        ==> #0_ = f (gen (z o I) - z)       by kernel_ideal_element
11796                = f (gen (z o I)) -_ f z    by ring_homo_sub
11797        ==> f (gen (z o I)) = f z           by ring_sub_eq_zero, ring_homo_element
11798       Take y = z o I, the result follows.
11799*)
11800Theorem kernel_ideal_quotient_surj:
11801    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==>
11802     let i = kernel_ideal f r r_ in SURJ (f o gen) R/I (IMAGE f R)
11803Proof
11804  rw_tac std_ss[] >>
11805  `i << r` by rw[ring_homo_kernel_ideal, Abbr`i`] >>
11806  rw_tac std_ss[SURJ_DEF] >-
11807  rw[ideal_cogen_property] >>
11808  `?z. (x = f z) /\ z IN R` by rw[GSYM IN_IMAGE] >>
11809  `z o I IN R/I` by rw[ideal_coset_property] >>
11810  `gen (z o I) IN R` by rw[ideal_cogen_property] >>
11811  `gen (z o I) - z IN I` by rw[ideal_coset_has_gen_diff] >>
11812  `#0_ = f (gen (z o I) - z)` by metis_tac[kernel_ideal_element] >>
11813  `_ = f (gen (z o I)) -_ f z` by rw[ring_homo_sub] >>
11814  prove_tac[ring_sub_eq_zero, ring_homo_element]
11815QED
11816
11817(* Theorem: (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in BIJ (f o gen) R/I (IMAGE f R) *)
11818(* Proof:
11819   By BIJ_DEF, this is to show:
11820   (1) INJ (f o gen) R/I (IMAGE f R)
11821       This is true by kernel_ideal_quotient_inj
11822   (2) SURJ (f o gen) R/I (IMAGE f R)
11823       This is true by kernel_ideal_quotient_surj
11824*)
11825Theorem kernel_ideal_quotient_bij:
11826    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==>
11827    let i = kernel_ideal f r r_ in BIJ (f o gen) R/I (IMAGE f R)
11828Proof
11829  metis_tac[BIJ_DEF, kernel_ideal_quotient_inj, kernel_ideal_quotient_surj]
11830QED
11831
11832(* Theorem: (r ~r~ s) f ==>
11833            let i = kernel_ideal f r s in RingHomo (f o gen) (r / i) (ring_homo_image f r s) *)
11834(* Proof:
11835   Let i = kernel_ideal f r s, r_ = ring_homo_image f r s.
11836   The goal is to show: RingHomo (f o gen) (r / i) r_
11837   Note Ring r_              by ring_homo_image_ring, by (r ~r~ s) f
11838    and i << r               by ring_homo_kernel_ideal, by (r ~r~ s) f
11839    ==> Ring (r / i)         by quotient_ring_ring, i << r
11840
11841   Claim: !x. x IN (r / i).carrier ==> f (gen x) IN R_
11842   Proof: By quotient_ring_def, ring_homo_image_def, this is to show:
11843          !x. x IN R/I ==> ?z. (f (gen x) = f z) /\ z IN R
11844          Note x IN R/I ==> gen x IN R           by ideal_cogen_property
11845          Take z = gen x, the result is true.
11846
11847   By RingHomo_def, this is to show:
11848   (1) x IN (r / i).carrier ==> f (gen x) IN R_, true by Claim.
11849   (2) GroupHomo (f o gen) (r / i).sum r_.sum
11850       By GroupHomo_def, ring_carriers, this is to show:
11851          x IN (r / i).carrier /\ y IN (r / i).carrier ==>
11852          f (gen ((r / i).sum.op x y)) = f (gen x) +_ f (gen y)
11853       By quotient_ring_def, quotient_ring_add_def, ring_homo_image_def, homo_image_def,
11854       the goal is:
11855           x IN R/I /\ y IN R/I ==> f (gen ((gen x + gen y) o I)) = s.sum.op (f (gen x)) (f (gen y))
11856       This is true by kernel_ideal_gen_add_map.
11857   (3) MonoidHomo (f o gen) (r / i).prod r_.prod
11858       By MonoidHomo_def, ring_carriers, this is to show:
11859       (1) x IN (r / i).carrier /\ y IN (r / i).carrier ==>
11860           f (gen ((r / i).prod.op x y)) = f (gen x) *_ f (gen y)
11861           By quotient_ring_def, quotient_ring_mult_def, ring_homo_image_def, homo_image_def,
11862           the goal is:
11863               x IN R/I /\ y IN R/I ==> f (gen ((gen x * gen y) o I)) = s.prod.op (f (gen x)) (f (gen y))
11864           This is true by kernel_ideal_gen_mult_map.
11865       (2) f (gen (r / i).prod.id) = #1_
11866           By quotient_ring_def, quotient_ring_mult_def, ring_homo_image_def, homo_image_def,
11867           the goal is: f (gen (#1 o I)) = s.prod.id
11868           This is true by kernel_ideal_gen_id_map.
11869*)
11870Theorem kernel_ideal_quotient_homo:
11871    !(r:'a ring) (s:'b ring) f. (r ~r~ s) f ==>
11872   let i = kernel_ideal f r s in RingHomo (f o gen) (r / i) (ring_homo_image f r s)
11873Proof
11874  rw_tac std_ss[] >>
11875  qabbrev_tac `r_ = ring_homo_image f r s` >>
11876  `Ring r_` by rw[ring_homo_image_ring, Abbr`r_`] >>
11877  `i << r` by rw[ring_homo_kernel_ideal, Abbr`i`] >>
11878  `Ring (r / i)` by rw[quotient_ring_ring] >>
11879  `!x. x IN (r / i).carrier ==> f (gen x) IN R_` by
11880  (fs[quotient_ring_def, ring_homo_image_def, Abbr`r_`] >>
11881  metis_tac[ideal_cogen_property]) >>
11882  rw_tac std_ss[RingHomo_def] >| [
11883    rw_tac std_ss[GroupHomo_def, ring_carriers] >>
11884    fs[quotient_ring_def, quotient_ring_add_def, ring_homo_image_def, homo_image_def, Abbr`r_`] >>
11885    metis_tac[kernel_ideal_gen_add_map],
11886    rw_tac std_ss[MonoidHomo_def, ring_carriers] >| [
11887      fs[quotient_ring_def, quotient_ring_mult_def, ring_homo_image_def, homo_image_def, Abbr`r_`] >>
11888      metis_tac[kernel_ideal_gen_mult_map],
11889      fs[quotient_ring_def, quotient_ring_mult_def, ring_homo_image_def, homo_image_def, Abbr`r_`] >>
11890      metis_tac[kernel_ideal_gen_id_map]
11891    ]
11892  ]
11893QED
11894
11895(* Theorem: (r ~r~ s) f ==> let i = kernel_ideal f r s in
11896            RingIso (f o gen) (r / i) (ring_homo_image f r s) *)
11897(* Proof:
11898   By RingIso_def, this is to show:
11899   (1) RingHomo (f o gen) (r / i) (ring_homo_image f r s)
11900       This is true by kernel_ideal_quotient_homo
11901   (2) BIJ (f o gen) (r / i).carrier (ring_homo_image f r s).carrier
11902       Note (r / i).carrier = R/I                         by quotient_ring_def
11903        and (ring_homo_image f r s).carrier = IMAGE f R   by ring_homo_image_def
11904       Hence true by kernel_ideal_quotient_bij
11905*)
11906Theorem kernel_ideal_quotient_iso:
11907    !(r:'a ring) (s:'b ring) f. (r ~r~ s) f ==> let i = kernel_ideal f r s in
11908         RingIso (f o gen) (r / i) (ring_homo_image f r s)
11909Proof
11910  rw_tac std_ss[RingIso_def] >-
11911  metis_tac[kernel_ideal_quotient_homo] >>
11912  `(r / i).carrier = R/I` by rw[quotient_ring_def] >>
11913  `(ring_homo_image f r s).carrier = IMAGE f R` by rw[ring_homo_image_def] >>
11914  metis_tac[kernel_ideal_quotient_bij]
11915QED
11916
11917(* Theorem: (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in
11918            (i << r) /\ (ring_homo_image f r r_ <= r_) /\
11919            RingIso (f o gen) (r / i) (ring_homo_image f r r_) *)
11920(* Proof:
11921   Let i = kernel_ideal f r r_.
11922   This is to show:
11923   (1) i << r, true by ring_homo_kernel_ideal
11924   (2) ring_homo_image f r r_ <= r_, true by ring_homo_image_subring
11925   (3) RingIso (f o gen) (r / i) (ring_homo_image f r r_)
11926       This is true by kernel_ideal_quotient_iso
11927*)
11928Theorem ring_first_isomorphism_thm:
11929    !(r:'a ring) (r_:'b ring) f. (r ~r~ r_) f ==> let i = kernel_ideal f r r_ in
11930    (i << r) /\ (ring_homo_image f r r_ <= r_) /\ RingIso (f o gen) (r / i) (ring_homo_image f r r_)
11931Proof
11932  rw_tac std_ss[ring_homo_image_subring] >-
11933  rw_tac std_ss[ring_homo_kernel_ideal, Abbr`i`] >>
11934  metis_tac[kernel_ideal_quotient_iso]
11935QED
11936
11937(* This is a significant milestone theorem! *)
11938
11939(* ------------------------------------------------------------------------- *)
11940(* Ring Instances Documentation                                              *)
11941(* ------------------------------------------------------------------------- *)
11942(* Ring Data type:
11943   The generic symbol for ring data is r.
11944   r.carrier = Carrier set of Ring, overloaded as R.
11945   r.sum     = Addition component of Ring, binary operation overloaded as +.
11946   r.prod    = Multiplication component of Ring, binary operation overloaded as *.
11947*)
11948(* Overloading:
11949   ordz n m  = order (ZN n).prod m
11950
11951*)
11952(* Definitions and Theorems (# are exported, ! in computeLib):
11953
11954   The Trivial Ring (#1 = #0):
11955   trivial_ring_def       |- !z. trivial_ring z =
11956                                 <|carrier := {z};
11957                                       sum := <|carrier := {z}; id := z; op := (\x y. z)|>;
11958                                      prod := <|carrier := {z}; id := z; op := (\x y. z)|>
11959                                  |>
11960   trivial_ring           |- !z. FiniteRing (trivial_ring z)
11961   trivial_char           |- !z. char (trivial_ring z) = 1
11962
11963   Arithmetic Modulo n:
11964   ZN_def                 |- !n. ZN n = <|carrier := count n; sum := add_mod n; prod := times_mod n|>
11965!  ZN_eval                |- !n. ((ZN n).carrier = count n) /\
11966                                 ((ZN n).sum = add_mod n) /\ ((ZN n).prod = times_mod n)
11967   ZN_property            |- !n. (!x. x IN (ZN n).carrier <=> x < n) /\ ((ZN n).sum.id = 0) /\
11968                                 ((ZN n).prod.id = if n = 1 then 0 else 1) /\
11969                                 (!x y. (ZN n).sum.op x y = (x + y) MOD n) /\
11970                                 (!x y. (ZN n).rr.op x y = (x * y) MOD n) /\
11971                                 FINITE (ZN n).carrier /\ (CARD (ZN n).carrier = n)
11972   ZN_ids                 |- !n. 0 < n ==> ((ZN n).sum.id = 0) /\ ((ZN n).prod.id = 1 MOD n)
11973   ZN_ids_alt             |- !n. 1 < n ==> ((ZN n).sum.id = 0) /\ ((ZN n).prod.id = 1)
11974   ZN_finite              |- !n. FINITE (ZN n).carrier
11975   ZN_card                |- !n. CARD (ZN n).carrier = n
11976   ZN_ring                |- !n. 0 < n ==> Ring (ZN n)
11977   ZN_char                |- !n. 0 < n ==> (char (ZN n) = n)
11978   ZN_exp                 |- !n. 0 < n ==> !x k. (ZN n).prod.exp x k = x ** k MOD n
11979   ZN_num                 |- !n. 0 < n ==> !k. (ZN n).sum.exp 1 k = k MOD n
11980   ZN_num_1               |- !n. (ZN n).sum.exp (ZN n).prod.id 1 = 1 MOD n
11981   ZN_num_0               |- !n c. 0 < n ==> (ZN n).sum.exp 0 c = 0
11982   ZN_num_mod             |- !n c. 0 < n ==> (ZN n).sum.exp (ZN n).prod.id c = c MOD n
11983   ZN_finite_ring         |- !n. 0 < n ==> FiniteRing (ZN n)
11984   ZN_invertibles_group   |- !n. 0 < n ==> Group (Invertibles (ZN n).prod)
11985   ZN_invertibles_finite_group   |- !n. 0 < n ==> FiniteGroup (Invertibles (ZN n).prod)
11986
11987   ZN Inverse:
11988   ZN_mult_inv_coprime      |- !n. 0 < n ==> !x y. ((x * y) MOD n = 1) ==> coprime x n
11989   ZN_mult_inv_coprime_iff  |- !n. 1 < n ==> !x. coprime x n <=> ?y. (x * y) MOD n = 1
11990   ZN_coprime_invertible    |- !m n. 1 < m /\ coprime m n ==> n MOD m IN (Invertibles (ZN m).prod).carrier
11991   ZN_invertibles           |- !n. 1 < n ==> (Invertibles (ZN n).prod = Estar n)
11992
11993   ZN Order:
11994   ZN_1_exp               |- !n k. (ZN 1).prod.exp n k = 0
11995   ZN_order_mod_1         |- !n. ordz 1 n = 1
11996   ZN_order_mod           |- !m n. 0 < m ==> (ordz m (n MOD m) = ordz m n)
11997   ZN_invertibles_order   |- !m n. 0 < m ==> (order (Invertibles (ZN m).prod) (n MOD m) = ordz m n)
11998   ZN_order_0             |- !n. 0 < n ==> (ordz n 0 = if n = 1 then 1 else 0)
11999   ZN_order_1             |- !n. 0 < n ==> (ordz n 1 = 1)
12000   ZN_order_eq_1          |- !m n. 0 < m ==> ((ordz m n = 1) <=> (n MOD m = 1 MOD m))
12001   ZN_order_eq_1_alt      |- !m n. 1 < m ==> (ordz m n = 1 <=> n MOD m = 1)
12002   ZN_order_property      |- !m n. 0 < m ==> (n ** ordz m n MOD m = 1 MOD m)
12003   ZN_order_property_alt  |- !m n. 1 < m ==> (n ** ordz m n MOD m = 1)
12004   ZN_order_divisibility  |- !m n. 0 < m ==> m divides n ** ordz m n - 1
12005   ZN_coprime_euler_element         |- !m n. 1 < m /\ coprime m n ==> n MOD m IN Euler m
12006   ZN_coprime_order                 |- !m n. 0 < m /\ coprime m n ==> 0 < ordz m n /\ (n ** ordz m n MOD m = 1 MOD m)
12007   ZN_coprime_order_alt             |- !m n. 1 < m /\ coprime m n ==> 0 < ordz m n /\ (n ** ordz m n MOD m = 1)
12008   ZN_coprime_order_divides_totient |- !m n. 0 < m /\ coprime m n ==> ordz m n divides totient m
12009   ZN_coprime_order_divides_phi     |- !m n. 0 < m /\ coprime m n ==> ordz m n divides phi m
12010   ZN_coprime_order_lt              |- !m n. 1 < m /\ coprime m n ==> ordz m n < m
12011   ZN_coprime_exp_mod               |- !m n. 0 < m /\ coprime m n ==> !k. n ** k MOD m = n ** (k MOD ordz m n) MOD m
12012   ZN_order_eq_1_by_prime_factors   |- !m n. 0 < m /\ coprime m n /\
12013                                       (!p. prime p /\ p divides n ==> (ordz m p = 1)) ==> (ordz m n = 1)
12014   ZN_order_nonzero_iff   |- !m n. 1 < m ==> (ordz m n <> 0 <=> ?k. 0 < k /\ (n ** k MOD m = 1))
12015   ZN_order_eq_0_iff      |- !m n. 1 < m ==> (ordz m n = 0 <=> !k. 0 < k ==> n ** k MOD m <> 1)
12016   ZN_order_nonzero       |- !m n. 0 < m ==> (ordz m n <> 0 <=> coprime m n)
12017   ZN_order_eq_0          |- !m n. 0 < m ==> ((ordz m n = 0) <=> gcd m n <> 1)
12018   ZN_not_coprime         |- !m n. 0 < m /\ gcd m n <> 1 ==> !k. 0 < k ==> n ** k MOD m <> 1
12019   ZN_order_gt_1_property |- !m n. 0 < m /\ 1 < ordz m n ==> ?p. prime p /\ p divides n /\ 1 < ordz m p
12020   ZN_order_divides_exp   |- !m n k. 1 < m /\ 0 < k ==> ((n ** k MOD m = 1) <=> ordz m n divides k)
12021   ZN_order_divides_phi   |- !m n. 0 < m /\ 0 < ordz m n ==> ordz m n divides phi m
12022   ZN_order_upper         |- !m n. 0 < m ==> ordz m n <= phi m
12023   ZN_order_le            |- !m n. 0 < m ==> ordz m n <= m
12024   ZN_order_lt            |- !k n m. 0 < k /\ k < m ==> ordz k n < m
12025   ZN_order_minimal       |- !m n k. 0 < m /\ 0 < k /\ k < ordz m n ==> n ** k MOD m <> 1
12026   ZN_coprime_order_gt_1  |- !m n. 1 < m /\ 1 < n MOD m /\ coprime m n ==> 1 < ordz m
12027   ZN_order_with_coprime_1|- !m n. 1 < n /\ coprime m n /\ 1 < ordz m n ==> 1 < m
12028   ZN_order_with_coprime_2|- !m n k. 1 < m /\ m divides n /\ 1 < ordz k m /\ coprime k n ==>
12029                                     1 < n /\ 1 < k
12030   ZN_order_eq_0_test     |- !m n. 1 < m ==>
12031                             ((ordz m n = 0) <=> !j. 0 < j /\ j < m ==> n ** j MOD m <> 1)
12032   ZN_order_divides_tops_index
12033                          |- !n j k. 1 < n /\ 0 < j /\ 1 < k ==>
12034                                     (k divides tops n j <=> ordz k n divides j)
12035   ZN_order_le_tops_index |- !n j k. 1 < n /\ 0 < j /\ 1 < k /\ k divides tops n j ==>
12036                                     ordz k n <= j
12037
12038   ZN Order Candidate:
12039   ZN_order_test_propery  |- !m n k. 1 < m /\ 0 < k /\ (n ** k MOD m = 1) /\
12040                            (!j. 0 < j /\ j < k /\ j divides phi m ==> n ** j MOD m <> 1) ==>
12041                             !j. 0 < j /\ j < k /\ ~(j divides phi m) ==>
12042                                 (ordz m n = k) \/ n ** j MOD m <> 1
12043   ZN_order_test_1        |- !m n k. 1 < m /\ 0 < k ==> ((ordz m n = k) <=>
12044                              (n ** k MOD m = 1) /\ !j. 0 < j /\ j < k ==> n ** j MOD m <> 1)
12045   ZN_order_test_2        |- !m n k. 1 < m /\ 0 < k ==> ((ordz m n = k) <=>
12046                              (n ** k MOD m = 1) /\
12047                              !j. 0 < j /\ j < k /\ j divides phi m ==> n ** j MOD m <> 1)
12048   ZN_order_test_3        |- !m n k. 1 < m /\ 0 < k ==> ((ordz m n = k) <=>
12049                              k divides phi m /\ (n ** k MOD m = 1) /\
12050                              !j. 0 < j /\ j < k /\ j divides phi m ==> n ** j MOD m <> 1)
12051   ZN_order_test_4        |- !m n k. 1 < m ==> ((ordz m n = k) <=> (n ** k MOD m = 1) /\
12052                             !j. 0 < j /\ j < (if k = 0 then m else k) ==> n ** j MOD m <> 1)
12053
12054   ZN Homomorphism:
12055   ZN_to_ZN_element          |- !n m x. 0 < m /\ x IN (ZN n).carrier ==> x MOD m IN (ZN m).carrier
12056   ZN_to_ZN_sum_group_homo   |- !n m. 0 < n /\ m divides n ==>
12057                                      GroupHomo (\x. x MOD m) (ZN n).sum (ZN m).sum
12058   ZN_to_ZN_prod_monoid_homo |- !n m. 0 < n /\ m divides n ==>
12059                                      MonoidHomo (\x. x MOD m) (ZN n).prod (ZN m).prod
12060   ZN_to_ZN_ring_homo        |- !n m. 0 < n /\ m divides n ==>
12061                                      RingHomo (\x. x MOD m) (ZN n) (ZN m)
12062
12063   Ring from Sets:
12064   symdiff_set_inter_def  |- symdiff_set_inter =
12065                             <|carrier := univ(:'a -> bool); sum := symdiff_set; prod := set_inter|>
12066   symdiff_set_inter_ring |- Ring symdiff_set_inter
12067   symdiff_set_inter_char |- char symdiff_set_inter = 2
12068!  symdiff_eval           |- (symdiff_set.carrier = univ(:'a -> bool)) /\
12069                             (!x y. symdiff_set.op x y = x UNION y DIFF x INTER y) /\
12070                             (symdiff_set.id = {})
12071
12072   Order Computation using a WHILE loop:
12073   compute_ordz_def      |- !m n. compute_ordz m n =
12074                                       if m = 0 then ordz 0 n
12075                                  else if m = 1 then 1
12076                                  else if coprime m n then WHILE (\i. (n ** i) MOD m <> 1) SUC 1
12077                                  else 0
12078   WHILE_RULE_PRE_POST   |- (!x. Invariant x /\ Guard x ==> f (Cmd x) < f x) /\
12079                            (!x. Precond x ==> Invariant x) /\
12080                            (!x. Invariant x /\ ~Guard x ==> Postcond x) /\
12081                            HOARE_SPEC (\x. Invariant x /\ Guard x) Cmd Invariant ==>
12082                            HOARE_SPEC Precond (WHILE Guard Cmd) Postcond
12083   compute_ordz_hoare    |- !m n. 1 < m /\ coprime m n ==>
12084                                  HOARE_SPEC (\i. 0 < i /\ i <= ordz m n)
12085                                             (WHILE (\i. (n ** i) MOD m <> 1) SUC)
12086                                             (\i. i = ordz m n)
12087   compute_ordz_by_while |- !m n. 1 < m /\ coprime m n ==> !j. 0 < j /\ j <= ordz m n ==>
12088                                  (WHILE (\i. (n ** i) MOD m <> 1) SUC j = ordz m n)
12089
12090   Correctness of computing ordz m n:
12091   compute_ordz_0      |- !n. compute_ordz 0 n = ordz 0
12092   compute_ordz_1      |- !n. compute_ordz 1 n = 1
12093   compute_ordz_eqn    |- !m n. compute_ordz m n = ordz m n
12094!  ordz_eval           |- !m n. order (times_mod m) n = compute_ordz m n
12095
12096*)
12097(* ------------------------------------------------------------------------- *)
12098(* The Trivial Ring = {|0|}.                                                 *)
12099(* ------------------------------------------------------------------------- *)
12100
12101Definition trivial_ring_def:
12102  (trivial_ring z) : 'a ring =
12103   <| carrier := {z};
12104      sum := <| carrier := {z};
12105                id := z;
12106                op := (\x y. z) |>;
12107      prod := <| carrier := {z};
12108                id := z;
12109                op := (\x y. z) |>
12110    |>
12111End
12112
12113(* Theorem: {|0|} is indeed a ring. *)
12114(* Proof: by definition, the field tables are:
12115
12116   +    |0|          *  |0|
12117   ------------     -----------
12118   |0|  |0|         |0| |0|
12119*)
12120Theorem trivial_ring:
12121    !z. FiniteRing (trivial_ring z)
12122Proof
12123  rw_tac std_ss[FiniteRing_def] >| [
12124    rw_tac std_ss[trivial_ring_def, Ring_def, AbelianGroup_def, group_def_alt, IN_SING, RES_FORALL_THM, RES_EXISTS_THM] >>
12125    rw_tac std_ss[AbelianMonoid_def, Monoid_def, IN_SING],
12126    rw_tac std_ss[trivial_ring_def, FINITE_SING]
12127  ]
12128QED
12129
12130(* |- !z. Ring (trivial_ring z), added for ringLibTheory by Chun Tian *)
12131Theorem trivial_ring_thm =
12132        trivial_ring |> REWRITE_RULE [FiniteRing_def] |> cj 1
12133
12134(* Theorem: char (trivial_ring z) = 1 *)
12135(* Proof:
12136   By fiddling with properties of OLEAST.
12137   This is to show:
12138   (case OLEAST n. 0 < n /\ (FUNPOW (\y. z) n z = z) of NONE => 0 | SOME n => n) = 1
12139   If NONE, 0 = 1 is impossible, so SOME must be true, i.e. to show:
12140   ?n. 0 < n /\ (FUNPOW (\y. z) n z = z), and then that n must be 1.
12141   First part is simple:
12142   let n = 1, then FUNPOW (\y. z) 1 z = (\y. z) z = z   by FUNPOW
12143   Second part is to show:
12144   0 < n /\ (FUNPOW (\y. z) n z = z) /\ !m. m < n ==> ~(0 < m) \/ FUNPOW (\y. z) m z <> z ==> n = 1
12145   By contradiction, assume n <> 1,
12146   then 0 < n /\ n <> 1 ==> 1 < n,
12147   since 0 < 1, this means FUNPOW (\y. z) 1 z <> z,
12148   but FUNPOW (\y. z) 1 z = z by FUNPOW, hence a contradiction.
12149*)
12150Theorem trivial_char:
12151  !z. char (trivial_ring z) = 1
12152Proof
12153  strip_tac >>
12154  `FiniteRing (trivial_ring z)` by rw_tac std_ss[trivial_ring] >>
12155  rw[char_def] >>
12156  rw_tac std_ss[order_def, period_def, trivial_ring_def, monoid_exp_def] >>
12157  DEEP_INTRO_TAC OLEAST_INTRO >>
12158  rw_tac std_ss[] >>
12159  spose_not_then strip_assume_tac >>
12160  `1 < n /\ 0 < 1` by decide_tac >>
12161  `FUNPOW (\y. z) 1 z <> z` by metis_tac[DECIDE “~(0 < 0)”] >>
12162  full_simp_tac (srw_ss()) []
12163QED
12164
12165(* ------------------------------------------------------------------------- *)
12166(* Z_n, Arithmetic in Modulo n.                                              *)
12167(* ------------------------------------------------------------------------- *)
12168
12169(* Integer Modulo Ring *)
12170Definition ZN_def[nocompute]:
12171  ZN n : num ring =
12172    <| carrier := count n;
12173           sum := add_mod n;
12174          prod := times_mod n
12175     |>
12176End
12177(*
12178Note: add_mod is defined in groupInstancesTheory.
12179times_mod is defined in monoidInstancesTheory.
12180*)
12181(* Use of zDefine to avoid incorporating into computeLib, by default. *)
12182
12183(*
12184- type_of ``ZN n``;
12185> val it = ``:num ring`` : hol_type
12186*)
12187
12188(* Theorem: Evaluation of ZN component fields. *)
12189(* Proof: by ZN_def *)
12190Theorem ZN_eval[compute]:
12191    !n. ((ZN n).carrier = count n) /\
12192       ((ZN n).sum = add_mod n) /\
12193       ((ZN n).prod = times_mod n)
12194Proof
12195  rw_tac std_ss[ZN_def]
12196QED
12197(* Put into computeLib, and later with ordz_eval for order computation. *)
12198
12199(* Theorem: property of ZN Ring *)
12200(* Proof: by ZN_def, add_mod_def, times_mod_def. *)
12201Theorem ZN_property:
12202    !n. (!x. x IN (ZN n).carrier <=> x < n) /\
12203       ((ZN n).sum.id = 0) /\
12204       ((ZN n).prod.id = if n = 1 then 0 else 1) /\
12205       (!x y. (ZN n).sum.op x y = (x + y) MOD n) /\
12206       (!x y. (ZN n).prod.op x y = (x * y) MOD n) /\
12207       FINITE (ZN n).carrier /\
12208       (CARD (ZN n).carrier = n)
12209Proof
12210  rw[ZN_def, add_mod_def, times_mod_def]
12211QED
12212
12213(* Theorem: 0 < n ==> ((ZN n).sum.id = 0) /\ ((ZN n).prod.id = 1 MOD n) *)
12214(* Proof: by ZN_property *)
12215Theorem ZN_ids:
12216    !n. 0 < n ==> ((ZN n).sum.id = 0) /\ ((ZN n).prod.id = 1 MOD n)
12217Proof
12218  rw[ZN_property]
12219QED
12220
12221(* Theorem: 1 < n ==> ((ZN n).sum.id = 0) /\ ((ZN n).prod.id = 1) *)
12222(* Proof: by ZN_ids, ONE_MOD *)
12223Theorem ZN_ids_alt:
12224    !n. 1 < n ==> ((ZN n).sum.id = 0) /\ ((ZN n).prod.id = 1)
12225Proof
12226  rw[ZN_ids]
12227QED
12228
12229(* Theorem: (ZN n).carrier is FINITE. *)
12230(* Proof: by ZN_ring and FINITE_COUNT. *)
12231Theorem ZN_finite:
12232    !n. FINITE (ZN n).carrier
12233Proof
12234  rw[ZN_def]
12235QED
12236
12237(* Theorem: CARD (ZN n).carrier = n *)
12238(* Proof: by ZN_property. *)
12239Theorem ZN_card:
12240    !n. CARD (ZN n).carrier = n
12241Proof
12242  rw[ZN_property]
12243QED
12244
12245(* Theorem: For n > 0, (ZN n) is a Ring. *)
12246(* Proof: by checking definitions.
12247   For distribution: (x * (y + z) MOD n) MOD n = ((x * y) MOD n + (x * z) MOD n) MOD n
12248   LHS = (x * (y + z) MOD n) MOD n
12249       = (x MOD n * ((y + z) MOD n) MOD n        by LESS_MOD
12250       = (x * (y + z)) MOD n                     by MOD_TIMES2
12251       = (x * y + x * z) MOD n                   by LEFT_ADD_DISTRIB
12252       = ((x * y) MOD n + (x + y) MOD n) MOD n   by MOD_PLUS
12253       = RHS
12254*)
12255Theorem ZN_ring:
12256    !n. 0 < n ==> Ring (ZN n)
12257Proof
12258  rpt strip_tac >>
12259  `!x. x IN count n <=> x < n` by rw[] >>
12260  rw_tac std_ss[ZN_def, Ring_def] >-
12261  rw_tac std_ss[add_mod_abelian_group] >-
12262  rw_tac std_ss[times_mod_abelian_monoid] >-
12263  rw_tac std_ss[add_mod_def, count_def] >-
12264  rw_tac std_ss[times_mod_def] >>
12265  rw_tac std_ss[add_mod_def, times_mod_def] >>
12266  metis_tac[LEFT_ADD_DISTRIB, MOD_PLUS, MOD_TIMES2, LESS_MOD]
12267QED
12268
12269(* Theorem: !m n. 0 < n /\ m <= n ==> (FUNPOW (\j. (j + 1) MOD n) m 0 = m MOD n) *)
12270(* Proof: by induction on m.
12271   Base case: !n. 0 < n /\ 0 <= n ==> (FUNPOW (\j. (j + 1) MOD n) 0 0 = 0 MOD n)
12272   By FUNPOW, !f x. FUNPOW f 0 x = x,
12273   hence this is true by 0 = 0 MOD n.
12274   Step case: !n. 0 < n /\ m <= n ==> (FUNPOW (\j. (j + 1) MOD n) m 0 = m MOD n) ==>
12275              !n. 0 < n /\ SUC m <= n ==> (FUNPOW (\j. (j + 1) MOD n) (SUC m) 0 = SUC m MOD n)
12276   By FUNPOW_SUC, !f n x. FUNPOW f (SUC n) x = f (FUNPOW f n x)
12277   hence  (FUNPOW (\j. (j + 1) MOD n) (SUC n) 0
12278         = (\j. (j + 1) MOD n) (FUNPOW (\j. (j + 1) MOD n) n  0)   by FUNPOW_SUC
12279         = (\j. (j + 1) MOD n) (m MOD n)                           by induction hypothesis
12280         = ((m MOD n) + 1) MOD n
12281         = (m + 1) MOD n    since m < n
12282         = SUC m MOD n      by ADD1
12283*)
12284Theorem ZN_lemma1[local]:
12285    !m n. 0 < n /\ m <= n ==> (FUNPOW (\j. (j + 1) MOD n) m 0 = m MOD n)
12286Proof
12287  Induct_on `m`  >-
12288  srw_tac[ARITH_ss][] >>
12289  srw_tac[ARITH_ss][FUNPOW_SUC, ADD1]
12290QED
12291
12292(* Theorem: 0 < n ==> FUNPOW (\j. (j + 1) MOD n) n 0 = 0 *)
12293(* Proof:
12294   Put m = n in ZN_lemma1:
12295   FUNPOW (\j. (j + 1) MOD n) n 0 = n MOD n = 0  by DIVMOD_ID.
12296*)
12297Theorem ZN_lemma2[local]:
12298    !n. 0 < n ==> (FUNPOW (\j. (j + 1) MOD n) n 0 = 0)
12299Proof
12300  rw_tac std_ss[ZN_lemma1]
12301QED
12302
12303(* Theorem: 0 < n ==> char (ZN n) = n *)
12304(* Proof:
12305   Depends on the "ZN_lemma":
12306    0 < m /\ n <= m ==> FUNPOW (\j. (j + 1) MOD m) n 0 = n MOD m
12307   which is proved by induction on n.
12308   This is to show:
12309   (case OLEAST n'. 0 < n' /\ (FUNPOW (\j. (1 + j) MOD n) n' 0 = 0) of NONE => 0 | SOME n => n) = n
12310   If SOME, n = n is trivial.
12311   If NONE, need to show impossible for 0 < n: 0 < n' /\ (FUNPOW (\j. (1 + j) MOD n) n' 0 = 0
12312   Since (FUNPOW (\j. (1 + j) MOD n) n' 0 = n MOD n' = 0  by by ZN_lemma1
12313   and 0 < n' /\ 0 < n ==> n MOD n' <> 0, a contradiction with n MOD n' = 0.
12314*)
12315Theorem ZN_char:
12316  !n. 0 < n ==> char (ZN n) = n
12317Proof
12318  rw_tac std_ss[char_def, order_def, period_def] >>
12319  DEEP_INTRO_TAC OLEAST_INTRO >>
12320  simp[Excl "lift_disj_eq", ZN_def, add_mod_def, times_mod_def,
12321       monoid_exp_def] >>
12322  rw[Excl "lift_disj_eq"] >| [ (* avoid srw_tac simplication *)
12323    qexists_tac `1` >> rw[],
12324    metis_tac[ZN_lemma2, DECIDE “~(0 < 0)”],
12325    rename [‘0 < m’] >> spose_not_then strip_assume_tac >>
12326    `1 < m` by decide_tac >>
12327    `FUNPOW (\j. 0) 1 0 = 0` by rw[] >>
12328    metis_tac[DECIDE “1 <> 0”],
12329
12330    rename [‘m = n’, ‘n <> 1’] >>
12331    ‘FUNPOW (\j. (j + 1) MOD n) n 0 = 0’ by rw_tac std_ss[ZN_lemma2] >>
12332    ‘~(n < m)’ by metis_tac[DECIDE “~(0 < 0)”] >>
12333    ‘~(m < n)’ suffices_by decide_tac >>
12334    strip_tac >>
12335    full_simp_tac (srw_ss() ++ ARITH_ss) [ZN_lemma1]
12336  ]
12337QED
12338
12339(* Better proof *)
12340
12341(* Theorem: 0 < n ==> char (ZN n) = n *)
12342(* Proof:
12343   If n = 1, (ZN 1).carrier = count 1 = {0}
12344   this is to show: n = 1 iff (FUNPOW (\j. 0) n 0 = 0) /\ !m. 0 < m /\ m < n ==> FUNPOW (\j. 0) m 0 <> 0
12345   which is true, since FUNPOW (\j. 0) m 0 = 0 for all m, so to falsify 0 < m /\ m < n, n must be 1.
12346   If n <> 1, 1 < n,
12347   Ring (ZN n)    by ZN_ring
12348     (ZN n).sum.exp 1 n
12349   = FUNPOW (\j. (1 + j) MOD n) n 0   by monoid_exp_def
12350   = n MOD n = 0                      by ZN_lemma2
12351   Hence (ZN n).sum.exp 1 n = 0
12352   meaning  char (ZN n) n divides     by ring_char_divides
12353   Let m = char (ZN n),
12354   then m <= n                        by DIVIDES_LE
12355     (ZN n).sum.exp 1 m
12356   = FUNPOW (\j. (1 + j) MOD n) m 0   by monoid_exp_def
12357   = m MOD n                          by ZN_lemma1
12358   = 0                                by char_property
12359   But m MOD n = 0 means n divides m  by DIVIDES_MOD_0
12360   Therefore m = n                    by DIVIDES_ANTISYM
12361*)
12362Theorem ZN_char[allow_rebind]:
12363  !n. 0 < n ==> (char (ZN n) = n)
12364Proof
12365  rpt strip_tac >>
12366  ‘Ring (ZN n)’ by rw_tac std_ss [ZN_ring] >>
12367  ‘(ZN n).sum.id = 0’ by rw[ZN_def, add_mod_def] >>
12368  ‘(ZN n).sum.exp 1 n = 0’ by rw[ZN_lemma2, ZN_def, add_mod_def, times_mod_def, monoid_exp_def, ADD_COMM] >>
12369  Cases_on ‘n = 1’ >| [
12370    ‘(ZN n).prod.id = 0’ by rw[ZN_def, times_mod_def] >>
12371    ‘(char (ZN n)) divides n’ by rw[GSYM ring_char_divides] >>
12372    metis_tac[DIVIDES_ONE],
12373    ‘(ZN n).prod.id = 1’ by rw[ZN_def, times_mod_def] >>
12374    ‘(ZN n).sum.exp 1 n = 0’ by rw[ZN_lemma2, ZN_def, add_mod_def, times_mod_def, monoid_exp_def, ADD_COMM] >>
12375    ‘(char (ZN n)) divides n’ by rw[GSYM ring_char_divides] >>
12376    ‘(char (ZN n)) <= n’ by rw[DIVIDES_LE] >>
12377    qabbrev_tac ‘m = char (ZN n)’ >>
12378    ‘(ZN n).sum.exp 1 m = FUNPOW (\j. (j + 1) MOD n) m 0’ by rw[ZN_def, add_mod_def, times_mod_def, monoid_exp_def, ADD_COMM] >>
12379    ‘_ = m MOD n’ by rw[ZN_lemma1] >>
12380    ‘n divides m’ by metis_tac[char_property, DIVIDES_MOD_0] >>
12381    metis_tac [DIVIDES_ANTISYM]
12382  ]
12383QED
12384
12385(* Theorem: 0 < n ==> !x k. (ZN n).prod.exp x k = (x ** k) MOD n *)
12386(* Proof:
12387     (ZN n).prod.exp x k
12388   = (times_mod n).exp x k     by ZN_def
12389   = (x MOD n) ** k MOD n      by times_mod_exp, 0 < n
12390   = (x ** k) MOD n            by EXP_MOD, 0 < n
12391*)
12392Theorem ZN_exp:
12393    !n. 0 < n ==> !x k. (ZN n).prod.exp x k = (x ** k) MOD n
12394Proof
12395  rw[ZN_def, times_mod_exp]
12396QED
12397
12398(* Theorem: 0 < n ==> !k. (ZN n).sum.exp 1 k = k MOD n *)
12399(* Proof:
12400     (ZN n).sum.exp 1 k
12401   = (add_mod n).exp 1 k   by ZN_def
12402   = (1 * k) MOD n         by add_mod_exp, 0 < n
12403   = k MOD n               by MULT_LEFT_1
12404*)
12405Theorem ZN_num:
12406    !n. 0 < n ==> !k. (ZN n).sum.exp 1 k = k MOD n
12407Proof
12408  rw[ZN_def, add_mod_exp]
12409QED
12410
12411(* Theorem: (ZN n).sum.exp (ZN n).prod.id 1 = 1 MOD n *)
12412(* Proof:
12413   If n = 0,
12414        (ZN 0).sum.exp (ZN 0).prod.id 1
12415      = (ZN 0).sum.exp 1 1              by ZN_property, n <> 1
12416      = (ZN 0).sum 0 1                  by monoid_exp_def
12417      = 1 MOD 0                         by ZN_property
12418   If n = 1.
12419        (ZN 1).sum.exp (ZN 1).prod.id 1
12420      = (ZN 1).sum.exp 0 1              by ZN_property, n = 1
12421      = (ZN 1).sum 0 0                  by monoid_exp_def
12422      = 0 MOD 1 = 0                     by ZN_property
12423                = 1 MOD 1               by DIVMOD_ID, n <> 0
12424   Otherwise, 1 < n.
12425        (ZN n).sum.exp (ZN n).prod.id 1
12426      = (ZN n).sum.exp 1 1              by ZN_property, n <> 1
12427      = 1 MOD n                         by ZN_num, 0 < n
12428*)
12429Theorem ZN_num_1:
12430    !n. (ZN n).sum.exp (ZN n).prod.id 1 = 1 MOD n
12431Proof
12432  rpt strip_tac >>
12433  Cases_on `n = 0` >| [
12434    `(ZN 0).sum.exp (ZN 0).prod.id 1 = 1 MOD 0` by EVAL_TAC >>
12435    rw[],
12436    rw[ZN_num, ZN_property] >>
12437    EVAL_TAC
12438  ]
12439QED
12440
12441(* Theorem: 0 < n ==> ((ZN n).sum.exp 0 c = 0) *)
12442(* Proof:
12443   By induction on c.
12444   Base: (ZN n).sum.exp 0 0 = 0
12445         (ZN n).sum.exp 0 0
12446       = (ZN n).sum.id          by monoid_exp_0
12447       = 0                      by ZN_property
12448   Step: (ZN n).sum.exp 0 c = 0 ==> (ZN n).sum.exp 0 (SUC c) = 0
12449         (ZN n).sum.exp 0 (SUC c)
12450       = (ZN n).sum.op 0 ((ZN n).sum.exp 0 c)
12451                                by monoid_exp_SUC
12452       = (ZN n).sum.op 0 0      by induction hypothesis
12453       = (ZN n).sum.id          by monoid_exp_0
12454       = 0                      by ZN_property
12455*)
12456Theorem ZN_num_0:
12457    !n c. 0 < n ==> ((ZN n).sum.exp 0 c = 0)
12458Proof
12459  strip_tac >>
12460  Induct >-
12461  rw[ZN_property] >>
12462  rw[ZN_property, monoid_exp_def]
12463QED
12464
12465(* Theorem: 0 < n ==> ((ZN n).sum.exp (ZN n).prod.id c = c MOD n) *)
12466(* Proof:
12467   If n = 1,
12468        (ZN 1).sum.exp (ZN 1).prod.id c
12469      = (ZN 1).sum.exp 0 c            by ZN_property, n = 1
12470      = 0                             by ZN_num_0
12471      = c MOD 1                       by MOD_1
12472   If n <> 1,
12473        (ZN n).sum.exp (ZN n).prod.id c
12474      = (ZN n).sum.exp 1 c            by ZN_property, n <> 1
12475      = c MOD n                       by ZN_num, 0 < n.
12476*)
12477Theorem ZN_num_mod:
12478    !n c. 0 < n ==> ((ZN n).sum.exp (ZN n).prod.id c = c MOD n)
12479Proof
12480  rpt strip_tac >>
12481  rw[ZN_num, ZN_property] >>
12482  rw[ZN_num_0]
12483QED
12484
12485(* Theorem: For n > 0, (ZN n) is a FINITE Ring. *)
12486(* Proof: by ZN_ring and ZN_finite. *)
12487Theorem ZN_finite_ring:
12488    !n. 0 < n ==> FiniteRing (ZN n)
12489Proof
12490  rw_tac std_ss[ZN_ring, ZN_finite, FiniteRing_def]
12491QED
12492
12493(* Theorem: FiniteGroup (Invertibles (ZN n).prod) *)
12494(* Proof:
12495   Note Ring (ZN n)                                by ZN_ring
12496     so Monoid (ZN n).prod                         by ring_mult_monoid
12497   Thus Group (Invertibles (ZN n).prod)            by monoid_invertibles_is_group
12498*)
12499Theorem ZN_invertibles_group:
12500    !n. 0 < n ==> Group (Invertibles (ZN n).prod)
12501Proof
12502  rw[ZN_ring, monoid_invertibles_is_group]
12503QED
12504
12505(* Theorem: FiniteGroup (Invertibles (ZN n).prod) *)
12506(* Proof:
12507   By FiniteGroup_def, this is to show:
12508   (1) Group (Invertibles (ZN n).prod), true            by ZN_invertibles_group
12509   (2) FINITE (Invertibles (ZN n).prod).carrier
12510       Note Ring (ZN n)                                 by ZN_ring
12511       Since FINITE (ZN n).carrier                      by ZN_finite
12512       Hence FINITE (Invertibles (ZN n).prod).carrier   by Invertibles_subset, SUBSET_FINITE
12513*)
12514Theorem ZN_invertibles_finite_group:
12515    !n. 0 < n ==> FiniteGroup (Invertibles (ZN n).prod)
12516Proof
12517  rw[FiniteGroup_def] >-
12518  rw[ZN_invertibles_group] >>
12519  metis_tac[ZN_finite, Invertibles_subset, SUBSET_FINITE, ZN_ring, ring_carriers]
12520QED
12521
12522(* ------------------------------------------------------------------------- *)
12523(* ZN Inverse                                                                *)
12524(* ------------------------------------------------------------------------- *)
12525
12526(* Theorem: 0 < n ==> !x y. ((x * y) MOD n = 1) ==> coprime x n *)
12527(* Proof:
12528       (x * y) MOD n = 1
12529   ==> ?k. x * y = k * n + 1             by MOD_EQN
12530   Let d = gcd x n,
12531   Since d divides x                     by GCD_IS_GREATEST_COMMON_DIVISOR
12532      so d divides x * y                 by DIVIDES_MULT
12533    Also d divides n                     by GCD_IS_GREATEST_COMMON_DIVISOR
12534      so d divides k * n                 by DIVIDES_MULTIPLE
12535    Thus d divides gcd (k * n) (x * y)   by GCD_IS_GREATEST_COMMON_DIVISOR
12536     But gcd (k * n) (x * y)
12537       = gcd (k * n) (k * n + 1)         by above
12538       = 1                               by coprime_SUC
12539      so d divides 1, or d = 1           by DIVIDES_ONE
12540*)
12541Theorem ZN_mult_inv_coprime:
12542    !n. 0 < n ==> !x y. ((x * y) MOD n = 1) ==> coprime x n
12543Proof
12544  rpt strip_tac >>
12545  `?k. x * y = k * n + 1` by metis_tac[MOD_EQN] >>
12546  qabbrev_tac `d = gcd x n` >>
12547  `d divides x * y` by rw[DIVIDES_MULT, GCD_IS_GREATEST_COMMON_DIVISOR, Abbr`d`] >>
12548  `d divides k * n` by rw[DIVIDES_MULTIPLE, GCD_IS_GREATEST_COMMON_DIVISOR, Abbr`d`] >>
12549  `d divides gcd (k * n) (x * y)` by rw[GCD_IS_GREATEST_COMMON_DIVISOR] >>
12550  metis_tac[coprime_SUC, DIVIDES_ONE]
12551QED
12552
12553(* Theorem: 1 < n ==> !x. coprime x n <=> ?y. (x * y) MOD n = 1 *)
12554(* Proof:
12555   If part: coprime x n ==> ?y. (x * y) MOD n = 1
12556      This is true           by GCD_ONE_PROPERTY
12557   Only-if part: (x * y) MOD n = 1 ==> coprime x n
12558      This is true           by ZN_mult_inv_coprime, 0 < n
12559*)
12560Theorem ZN_mult_inv_coprime_iff:
12561    !n. 1 < n ==> !x. coprime x n <=> ?y. (x * y) MOD n = 1
12562Proof
12563  rpt strip_tac >>
12564  `0 < n` by decide_tac >>
12565  rw[EQ_IMP_THM] >-
12566  metis_tac[GCD_ONE_PROPERTY, GCD_SYM, MULT_COMM] >>
12567  metis_tac[ZN_mult_inv_coprime]
12568QED
12569
12570(* Theorem: 1 < m /\ coprime m n ==> (n MOD m) IN (Invertibles (ZN m).prod).carrier *)
12571(* Proof:
12572   Expanding by Invertibles_def, ZN_def, this is to show:
12573   (1) n MOD m < m
12574       Since 1 < m ==> 0 < m, true    by MOD_LESS.
12575   (2) ?y. y < m /\ ((n MOD m * y) MOD m = 1) /\ ((y * n MOD m) MOD m = 1)
12576       Since  n MOD m < m             by MOD_LESS
12577       ?y. 0 < y /\ y < m /\ coprime n y /\
12578          ((y * (n MOD m)) MOD m = 1) by GCD_MOD_MULT_INV
12579       The result follows             by MULT_COMM
12580*)
12581Theorem ZN_coprime_invertible:
12582  !m n. 1 < m /\ coprime m n ==> (n MOD m) IN (Invertibles (ZN m).prod).carrier
12583Proof
12584  rpt strip_tac >>
12585  `0 < n /\ 0 < n MOD m` by metis_tac[MOD_NONZERO_WHEN_GCD_ONE] >>
12586  `0 < m` by decide_tac >>
12587  rw_tac std_ss[Invertibles_def, monoid_invertibles_def, ZN_def, times_mod_def,
12588                GSPECIFICATION, IN_COUNT] >>
12589  metis_tac[MOD_LESS, coprime_mod, GCD_MOD_MULT_INV, MULT_COMM]
12590QED
12591
12592(* Same result with a different proof. *)
12593
12594(* Theorem: 1 < m ==> coprime m n ==> n IN (Invertibles (ZN m).prod) *)
12595(* Proof:
12596   Expanding by definitions, this is to show:
12597   (1) n MOD m < m
12598       True by MOD_LESS
12599   (2) ?y. y < m /\ ((n MOD m * y) MOD m = 1) /\ ((y * n MOD m) MOD m = 1)
12600       We have  n MOD m) < m          by MOD_LESS
12601           and  0 < (n MOD m)         by MOD_NONZERO_WHEN_GCD_ONE
12602          also  coprime m (n MOD m)   by coprime_mod
12603       Hence ?y. 0 < y /\ y < m /\
12604           (y * (n MOD m)) MOD m = 1  by GCD_MOD_MULT_INV
12605       and ((n MOD m) * y) MOD m = 1  by MULT_COMM
12606*)
12607Theorem ZN_coprime_invertible[allow_rebind]:
12608  !m n. 1 < m /\ coprime m n ==> (n MOD m) IN (Invertibles (ZN m).prod).carrier
12609Proof
12610  rw_tac std_ss[Invertibles_def, monoid_invertibles_def, ZN_def, times_mod_def,
12611                GSPECIFICATION, IN_COUNT]
12612  >- rw[] >>
12613  ‘0 < m’ by decide_tac >>
12614  ‘(n MOD m) < m’ by rw[] >>
12615  metis_tac[MOD_NONZERO_WHEN_GCD_ONE, GCD_MOD_MULT_INV, coprime_mod, MULT_COMM]
12616QED
12617
12618(* Theorem: 1 < n ==> (Invertibles (ZN n).prod = Estar n) *)
12619(* Proof:
12620   Note 1 < n ==> 0 < n /\ n <> 1
12621    and (ZN n).prod.carrier = (ZN n).carrier         by ZN_ring, ring_carriers, 0 < n
12622   By Invertibles_def, Estar_def, this is to show:
12623   (1) monoid_invertibles (ZN n).prod = Euler n
12624       By monoid_invertibles_def, Euler_def, EXTENSION, ZN_property, this is to show:
12625          x < n /\ (?y. y < n /\ ((x * y) MOD n = 1)) <=> 0 < x /\ x < n /\ coprime n x
12626       That is:
12627       (1) (x * y) MOD n = 1 ==> 0 < x
12628           By contradiction, suppose x = 0.
12629           Then  0 MOD n = 1                         by MULT
12630             or        0 = 1                         by ZERO_MOD
12631           which is a contradiction.
12632       (2) (x * y) MOD n = 1 ==> coprime n x, true   by ZN_mult_inv_coprime
12633       (3) coprime n x ==> ?y. y IN (ZN n).prod.carrier /\ ((x * y) MOD n = 1)
12634           Note ?z. (x * z) MOD n = 1                by ZN_mult_inv_coprime_iff
12635           Let y = z MOD n.
12636           Then y < n                                by MOD_LESS
12637             so y IN (ZN n).prod.carrier             by ZN_property
12638               (x * y) MOD n
12639             = (x * (z MOD n)) MOD n                 by y = z MOD n
12640             = (x * z) MOD n                         by MOD_TIMES2, MOD_MOD
12641             = 1                                     by above
12642   (2) (ZN n).prod.op = (\i j. (i * j) MOD n), true  by FUN_EQ_THM, ZN_property
12643   (3) (ZN n).prod.id = 1, true                      by ZN_property, n <> 1
12644*)
12645Theorem ZN_invertibles:
12646    !n. 1 < n ==> (Invertibles (ZN n).prod = Estar n)
12647Proof
12648  rpt strip_tac >>
12649  `0 < n /\ n <> 1` by decide_tac >>
12650  `(ZN n).prod.carrier = (ZN n).carrier` by rw[ZN_ring, ring_carriers] >>
12651  rw[Invertibles_def, Estar_def] >| [
12652    rw[monoid_invertibles_def, Euler_def, EXTENSION, ZN_property] >>
12653    rw[EQ_IMP_THM] >| [
12654      spose_not_then strip_assume_tac >>
12655      `(x = 0) /\ (1 <> 0)` by decide_tac >>
12656      metis_tac[MULT, ZERO_MOD],
12657      metis_tac[ZN_mult_inv_coprime, coprime_sym],
12658      `?z. (x * z) MOD n = 1` by rw[GSYM ZN_mult_inv_coprime_iff, coprime_sym] >>
12659      qexists_tac `z MOD n` >>
12660      rpt strip_tac >-
12661      rw[MOD_LESS] >>
12662      metis_tac[MOD_TIMES2, MOD_MOD]
12663    ],
12664    rw[FUN_EQ_THM, ZN_property],
12665    rw[ZN_property]
12666  ]
12667QED
12668
12669(* ------------------------------------------------------------------------- *)
12670(* ZN Order                                                                  *)
12671(* ------------------------------------------------------------------------- *)
12672
12673(* Overload for order of m in (ZN n).prod *)
12674Overload ordz = ``\n m. order (ZN n).prod m``
12675
12676(* Order for MOD 1:
12677
12678I thought ordz m n is only defined for 1 < m,
12679as (x ** j) MOD 1 = 0 by MOD_1, or (x ** j) MOD 1 <> 1.
12680However, Ring (ZN 1) by ZN_ring.
12681In fact (ZN 1) = {0} is trivial ring, or 1 = 0.
12682Thus (x ** j = 1) MOD 1, and the least j is 1.
12683
12684*)
12685
12686(* Theorem: (ZN 1).prod.exp n k = 0 *)
12687(* Proof:
12688   By monoid_exp_def, ZN_property, this is to show:
12689      FUNPOW ((ZN 1).prod.op n) k 0 = 0
12690   Note (ZN 1).prod.op n = K 0         by ZN_property, FUN_EQ_THM
12691   Thus the goal is: FUNPOW (K 0) k 0 = 0
12692
12693   By induction on k.
12694   Base: FUNPOW (K 0) 0 0 = 0, true    by FUNPOW
12695   Step: FUNPOW (K 0) k 0 = 0 ==> FUNPOW (K 0) (SUC k) 0 = 0
12696           FUNPOW (K 0) (SUC k) 0
12697         = FUNPOW (K 0) k ((K 0) 0)    by FUNPOW
12698         = FUNPOW (K 0) k 0            by K_THM
12699         = 0                           by induction hypothesis
12700*)
12701Theorem ZN_1_exp:
12702    !n k. (ZN 1).prod.exp n k = 0
12703Proof
12704  rw[monoid_exp_def, ZN_property] >>
12705  `(ZN 1).prod.op n = K 0` by rw[ZN_property, FUN_EQ_THM] >>
12706  rw[] >>
12707  Induct_on `k` >>
12708  rw[FUNPOW]
12709QED
12710
12711(* Theorem: ordz 1 n = 1 *)
12712(* Proof:
12713   By order_def, period_def, and ZN_property, this is to show:
12714      (case OLEAST k. 0 < k /\ ((ZN 1).prod.exp n k = 0) of NONE => 0 | SOME k => k) = 1
12715   Note (ZN 1).prod.exp n k = 0   by ZN_1_exp
12716   The goal becomes: (case OLEAST k. 0 < k of NONE => 0 | SOME k => k) = 1
12717   or 0 < n /\ !m. m < n ==> (m = 0) ==> n = 1      by OLEAST_INTRO
12718   By contradiction, suppose n <> 1.
12719   Then 1 < n                                       by n <> 0, n <> 1
12720   By implication, 1 = 0, which is a contradiction.
12721*)
12722Theorem ZN_order_mod_1:
12723    !n. ordz 1 n = 1
12724Proof
12725  rw[order_def, period_def, ZN_property] >>
12726  rw[ZN_1_exp] >>
12727  DEEP_INTRO_TAC OLEAST_INTRO >>
12728  rw[] >>
12729  spose_not_then strip_assume_tac >>
12730  `1 < n /\ 1 <> 0` by decide_tac >>
12731  metis_tac[]
12732QED
12733
12734(* Theorem: 0 < m ==> ordz m (n MOD m) = ordz m n *)
12735(* Proof:
12736   Since (ZN m).prod = times_mod m                                  by ZN_def
12737     and !k. (times_mod m).exp (n MOD m) k = (times_mod m).exp n k  by times_mod_exp, MOD_MOD
12738   Expanding by order_def, period_def, this is trivially true.
12739*)
12740Theorem ZN_order_mod:
12741    !m n. 0 < m ==> (ordz m (n MOD m) = ordz m n)
12742Proof
12743  rw[ZN_def, times_mod_exp, order_def, period_def]
12744QED
12745
12746(* Theorem: 0 < m ==> (order (Invertibles (ZN m).prod) (n MOD m) = ordz m n) *)
12747(* Proof:
12748        order (Invertibles (ZN m).prod) (n MOD m)
12749      = ordz m (n MOD m)          by Invertibles_order
12750      = ordz m n                  by ZN_order_mod, 0 < m
12751*)
12752Theorem ZN_invertibles_order:
12753    !m n. 0 < m ==> (order (Invertibles (ZN m).prod) (n MOD m) = ordz m n)
12754Proof
12755  rw[Invertibles_order, ZN_order_mod]
12756QED
12757
12758(*
12759> order_thm |> ISPEC ``(ZN n).prod`` |> SPEC ``0`` |> SPEC ``1``;
12760val it = |- 0 < 1 ==> ((ordz n 0 = 1) <=>
12761    ((ZN n).prod.exp 0 1 = (ZN n).prod.id) /\
12762    !m. 0 < m /\ m < 1 ==> (ZN n).prod.exp 0 m <> (ZN n).prod.id): thm
12763> order_eq_0 |> ISPEC ``(ZN n).prod`` |> SPEC ``0``;
12764val it = |- (ordz n 0 = 0) <=> !n'. 0 < n' ==> (ZN n).prod.exp 0 n' <> (ZN n).prod.id: thm
12765> monoid_order_eq_1 |> ISPEC ``(ZN n).prod``;
12766val it = |- Monoid (ZN n).prod ==> !x. x IN (ZN n).prod.carrier ==> ((ordz n x = 1) <=> (x = (ZN n).prod.id)): thm
12767*)
12768
12769(* Theorem: 0 < n ==> (ordz n 0 = if n = 1 then 1 else 0) *)
12770(* Proof:
12771   If n = 1,
12772      to show: 0 < n ==> ordz 1 0 = 1.
12773      Let g = (ZN 1).prod
12774      Then Monoid g        by ZN_ring, ring_mult_monoid, 0 < n
12775       and g.id = 0        by ZN_def, times_mod_def
12776      Note 0 IN g.carrier  by monoid_id_element
12777      Thus ordz 1 0 = 1    by monoid_order_eq_1
12778   If n <> 1,
12779      to show: 0 < n /\ n <> 1 ==> ordz 1 0 = 0.
12780      By order_eq_0, this is
12781      to show: !k. 0 < k ==> (ZN n).prod.exp 0 k <> (ZN n).prod.id
12782           or: !k. 0 < k ==> (0 ** k) MOD n <> 1      by ZN_property, ZN_exp
12783           or: 0 <> 1                                 by ZERO_EXP, 0 < k
12784      which is true.
12785*)
12786Theorem ZN_order_0:
12787    !n. 0 < n ==> (ordz n 0 = if n = 1 then 1 else 0)
12788Proof
12789  rw[] >| [
12790    `(ZN 1).prod.id = 0` by rw[ZN_def, times_mod_def] >>
12791    `Monoid (ZN 1).prod` by rw[ZN_ring, ring_mult_monoid] >>
12792    metis_tac[monoid_order_eq_1, monoid_id_element],
12793    rw[order_eq_0, ZN_property, ZN_exp, ZERO_EXP]
12794  ]
12795QED
12796
12797(* Theorem: 0 < n ==> (ordz n 1 = 1) *)
12798(* Proof:
12799   If n = 1,
12800      to show: ordz 1 1 = 1, true   by ZN_order_mod_1
12801   If n <> 1,
12802      Note Ring (ZN n)              by ZN_ring, 0 < n
12803        so Monoid (ZN n).prod       by ring_mult_monoid
12804       and (ZN n).prod.id = 1       by ZN_property, n <> 1
12805       ==> ordz n 1 = 1             by monoid_order_id
12806*)
12807Theorem ZN_order_1:
12808    !n. 0 < n ==> (ordz n 1 = 1)
12809Proof
12810  rpt strip_tac >>
12811  Cases_on `n = 1` >-
12812  rw[ZN_order_mod_1] >>
12813  `0 < n /\ n <> 1` by decide_tac >>
12814  `Ring (ZN n)` by rw[ZN_ring] >>
12815  `Monoid (ZN n).prod` by rw[ring_mult_monoid] >>
12816  `(ZN n).prod.id = 1` by rw[ZN_property] >>
12817  metis_tac[monoid_order_id]
12818QED
12819
12820(* Theorem: 0 < m ==> ((ordz m n = 1) <=> (n MOD m = 1 MOD m)) *)
12821(* Proof:
12822   First, Ring (ZN m)                             by ZN_ring, 0 < m
12823      so  Monoid (ZN m).prod                      by ring_mult_monoid
12824     and  (ZN m).prod.carrier = (ZN m).carrier    by ring_carriers
12825    with  (ZN m).prod.id = 1 MOD m                by ZN_property
12826
12827    Now,  n MOD m IN (ZN m).carrier               by ZN_property
12828     and  ordz m n = ordz m (n MOD m)             by ZN_order_mod, 1 < m
12829    Thus  n MOD m = 1 MOD m                       by monoid_order_eq_1
12830*)
12831Theorem ZN_order_eq_1:
12832    !m n. 0 < m ==> ((ordz m n = 1) <=> (n MOD m = 1 MOD m))
12833Proof
12834  rpt strip_tac >>
12835  `Ring (ZN m)` by rw[ZN_ring] >>
12836  `Monoid (ZN m).prod` by rw[] >>
12837  `ordz m n = ordz m (n MOD m)` by rw[ZN_order_mod] >>
12838  rw[monoid_order_eq_1, ZN_property]
12839QED
12840
12841(* Theorem: 1 < m ==> ((ordz m n = 1) <=> (n MOD m = 1)) *)
12842(* Proof: ZN_order_eq_1, ONE_MOD *)
12843Theorem ZN_order_eq_1_alt:
12844    !m n. 1 < m ==> ((ordz m n = 1) <=> (n MOD m = 1))
12845Proof
12846  rw[ZN_order_eq_1]
12847QED
12848
12849(* Theorem: 0 < m ==> (n ** ordz m n MOD m = 1 MOD m) *)
12850(* Proof:
12851   Let k = ordz m n.
12852   To show: n ** k MOD m = 1
12853      n ** k MOD m
12854    = (ZN m).prod.exp n k        by ZN_exp, 0 < m
12855    = (ZN m).prod.id             by order_property
12856    = 1 MOD m                    by ZN_property
12857*)
12858Theorem ZN_order_property:
12859    !m n. 0 < m ==> (n ** ordz m n MOD m = 1 MOD m)
12860Proof
12861  rw[order_property, ZN_property, GSYM ZN_exp]
12862QED
12863
12864(* Theorem: 1 < m ==> (n ** ordz m n MOD m = 1) *)
12865(* Proof: by ZN_order_property, ONE_MOD *)
12866Theorem ZN_order_property_alt:
12867    !m n. 1 < m ==> (n ** ordz m n MOD m = 1)
12868Proof
12869  rw[ZN_order_property]
12870QED
12871
12872(* Theorem: 0 < m ==> m divides (n ** ordz m n - 1) *)
12873(* Proof:
12874   If m = 1, true                   by ONE_DIVIDES_ALL
12875   If m <> 1, then 1 < m            by 0 < m, m <> 1
12876   Let k = ordz m n, to show:  m divides n ** k - 1.
12877   Since n ** k MOD m = 1           by ZN_order_property, 0 < m
12878      or n ** k MOD m = 1 MOD m     by ONE_MOD, 1 < m
12879      so (n ** k - 1) MOD m = 0     by MOD_EQ_DIFF, 0 < m
12880   Hence m divides (n ** k - 1)     by DIVIDES_MOD_0, 0 < m
12881*)
12882Theorem ZN_order_divisibility:
12883    !m n. 0 < m ==> m divides (n ** ordz m n - 1)
12884Proof
12885  rpt strip_tac >>
12886  Cases_on `m = 1` >-
12887  rw[] >>
12888  rw[DIVIDES_MOD_0, MOD_EQ_DIFF, ONE_MOD, ZN_order_property]
12889QED
12890
12891(* Theorem: 1 < m /\ coprime m n ==> (n MOD m) IN Euler m *)
12892(* Proof:
12893   By Euler_def, this is to show:
12894   (1) 0 < n MOD m.
12895       Note 0 < n                    by GCD_0, m <> 1
12896       Thus true                     by MOD_NONZERO_WHEN_GCD_ONE
12897   (2) coprime m (n MOD m), true     by MOD_WITH_GCD_ONE, 0 < m.
12898*)
12899Theorem ZN_coprime_euler_element:
12900    !m n. 1 < m /\ coprime m n ==> (n MOD m) IN Euler m
12901Proof
12902  rw[Euler_def] >| [
12903    `n <> 0` by metis_tac[GCD_0, LESS_NOT_EQ] >>
12904    rw[MOD_NONZERO_WHEN_GCD_ONE],
12905    rw[MOD_WITH_GCD_ONE]
12906  ]
12907QED
12908
12909(* Theorem: 0 < m /\ coprime m n ==> 0 < ordz m n /\ (n ** ordz m n MOD m = 1 MOD m) *)
12910(* Proof:
12911   If m = 1,
12912      Then ordz 1 n = 1  > 0              by ZN_order_mod_1
12913       and n ** ordz m n MOD 1 = 1 MOD 1  by MOD_1
12914   If m <> 1,
12915      Then 1 < m                          by m <> 1, m <> 0
12916       and 1 MOD m = 1                    by ONE_MOD, 1 < m
12917      also (n MOD m) IN (Invertibles (ZN m).prod).carrier        by ZN_coprime_invertible, 1 < m
12918      Now, FiniteGroup (Invertibles (ZN m).prod)                 by ZN_invertibles_finite_group, 0 < m
12919       and order (Invertibles (ZN m).prod) (n MOD m) = ordz m n  by ZN_invertibles_order, 0 < m
12920       and (ZN m).prod.id = 1                                    by ZN_property, m <> 1
12921     Hence 0 < ordz m n                            by group_order_property
12922       and n ** (ordz m n) = (ZN m).prod.id = 1    by Invertibles_property, ZN_exp, EXP_MOD
12923*)
12924Theorem ZN_coprime_order:
12925    !m n. 0 < m /\ coprime m n ==> 0 < ordz m n /\ (n ** ordz m n MOD m = 1 MOD m)
12926Proof
12927  ntac 3 strip_tac >>
12928  Cases_on `m = 1` >-
12929  rw[ZN_order_mod_1] >>
12930  `FiniteGroup (Invertibles (ZN m).prod)` by rw[ZN_invertibles_finite_group] >>
12931  `(n MOD m) IN (Invertibles (ZN m).prod).carrier` by rw[ZN_coprime_invertible] >>
12932  `order (Invertibles (ZN m).prod) (n MOD m) = ordz m n` by rw[ZN_invertibles_order] >>
12933  `(ZN m).prod.id = 1` by rw[ZN_property] >>
12934  `1 MOD m = 1` by rw[] >>
12935  metis_tac[group_order_property, Invertibles_property, ZN_exp, EXP_MOD]
12936QED
12937
12938(* This is slightly better than the next: ZN_coprime_order_alt *)
12939
12940(* Theorem: 1 < m /\ coprime m n ==> 0 < ordz m n /\ (n ** (ordz m n) = 1) *)
12941(* Proof: by ZN_coprime_order, ONE_MOD *)
12942Theorem ZN_coprime_order_alt:
12943    !m n. 1 < m /\ coprime m n ==> 0 < ordz m n /\ ((n ** (ordz m n)) MOD m = 1)
12944Proof
12945  rw[ZN_coprime_order]
12946QED
12947
12948(* Theorem: 0 < m /\ coprime m n ==> (ordz m n) divides (totient m) *)
12949(* Proof:
12950   If m = 1,
12951      Then ordz 1 n = 1                 by ZN_order_mod_1
12952       and 1 divides (totient 1)        by ONE_DIVIDES_ALL
12953   If m <> 1, then 1 < m                by 0 < m, m <> 1
12954   Let x = n MOD m
12955   Step 1: show x IN (Estar m).carrier, apply Euler_Fermat_thm
12956   Since coprime m n ==> ~(m divides n) by coprime_not_divides
12957      so x <> 0                         by DIVIDES_MOD_0
12958   hence 0 < x /\ x < m                 by MOD_LESS, 0 < m
12959     and coprime m x                    by coprime_mod, 0 < m
12960    Thus x IN (Estar m).carrier         by Estar_element
12961     ==> x ** (totient m) MOD m = 1     by Euler_Fermat_eqn (1)
12962   Step 2: show x IN (ZN m).prod.carrier, apply monoid_order_condition
12963    Now, Ring (ZN m)                    by ZN_ring, 0 < m
12964     ==> Monoid (ZN m).prod             by ring_mult_monoid
12965     and (ZN m).prod.id = 1             by ZN_property, m <> 1
12966   hence x IN (ZN m).prod.carrier       by ZN_property, MOD_LESS, 0 < m
12967    Thus ordz m x = ordz m n            by ZN_order_mod, 1 < m
12968   and (1) becomes
12969           (ZN m).prod.exp x (totient m) = (ZN m).prod.id  by ZN_exp
12970   Therefore   (ordz m n) divides (totient m)              by monoid_order_condition
12971*)
12972Theorem ZN_coprime_order_divides_totient:
12973    !m n. 0 < m /\ coprime m n ==> (ordz m n) divides (totient m)
12974Proof
12975  rpt strip_tac >>
12976  Cases_on `m = 1` >-
12977  rw[ZN_order_mod_1] >>
12978  qabbrev_tac `x = n MOD m` >>
12979  `x < m` by rw[Abbr`x`] >>
12980  `~(m divides n)` by rw[coprime_not_divides] >>
12981  `x <> 0` by rw[GSYM DIVIDES_MOD_0, Abbr`x`] >>
12982  `0 < x` by decide_tac >>
12983  `coprime m x` by metis_tac[coprime_mod] >>
12984  `x IN (Estar m).carrier` by rw[Estar_element] >>
12985  `x ** (totient m) MOD m = 1` by rw[Euler_Fermat_eqn] >>
12986  `Ring (ZN m)` by rw[ZN_ring] >>
12987  `Monoid (ZN m).prod` by rw[ring_mult_monoid] >>
12988  `m <> 1` by decide_tac >>
12989  `(ZN m).prod.id = 1` by rw[ZN_property] >>
12990  `x IN (ZN m).prod.carrier` by rw[ZN_property, MOD_LESS, Abbr`x`] >>
12991  metis_tac[monoid_order_condition, ZN_exp, ZN_order_mod]
12992QED
12993
12994(* Theorem: 0 < m /\ coprime m n ==> (ordz m n) divides (phi m) *)
12995(* Proof:
12996   If m = 1, then ordz 1 n = 1       by ZN_order_mod_1
12997              and 1 divides (phi 1)  by ONE_DIVIDES_ALL
12998   If m <> 1, then 1 < m             by 0 < m, m <> 1
12999                so phi m = totient m           by phi_eq_totient, 1 < m
13000              thus (ordz m n) divides (phi m)  by ZN_coprime_order_divides_totient
13001*)
13002Theorem ZN_coprime_order_divides_phi:
13003    !m n. 0 < m /\ coprime m n ==> (ordz m n) divides (phi m)
13004Proof
13005  rpt strip_tac >>
13006  Cases_on `m = 1` >-
13007  rw[ZN_order_mod_1] >>
13008  rw[ZN_coprime_order_divides_totient, phi_eq_totient]
13009QED
13010
13011(* Theorem: 1 < m /\ coprime m n ==> ordz m n < m *)
13012(* Proof:
13013   Note ordz m n divides phi m   by ZN_coprime_order_divides_phi, 0 < m
13014    and 0 < phi m                by phi_pos, 0 < m
13015   Thus ordz m n <= phi m        by DIVIDES_LE, 0 < phi m
13016                  < m            by phi_lt, 1 < m
13017*)
13018Theorem ZN_coprime_order_lt:
13019    !m n. 1 < m /\ coprime m n ==> ordz m n < m
13020Proof
13021  rpt strip_tac >>
13022  `0 < phi m /\ phi m < m` by rw[phi_pos, phi_lt] >>
13023  `ordz m n <= phi m` by rw[ZN_coprime_order_divides_phi, DIVIDES_LE] >>
13024  decide_tac
13025QED
13026
13027(* Theorem: 0 < m /\ coprime m n ==> !k. (n ** k) MOD m = (n ** (k MOD (ordz m n))) MOD m *)
13028(* Proof:
13029   If m = 1, true since ordz 1 n = 1    by ZN_order_mod_1
13030   If m <> 1, then 1 < m                by 0 < m, m <> 1
13031   Let z = ordz m n.
13032   Note 1 < m ==> 0 < m          by arithmetic
13033    and 0 < z                    by ZN_coprime_order_alt, 1 < m, coprime m n
13034   Let g = Invertibles (ZN m).prod, the Euler group.
13035   Then FiniteGroup g            by ZN_invertibles_finite_group, 0 < m
13036    ==> n MOD m IN g.carrier     by ZN_coprime_invertible, 1 < n, coprime m n
13037   Note z = ordz m n  by ZN_order_mod, 1 < m
13038          = order g (n MOD m)    by ZN_invertibles_order, 1 < m, coprime m n
13039
13040    Let x = n MOD m
13041   Then x IN g.carrier                              by above
13042    and 0 < order g x                               by above, 0 < z
13043   Note !x k. g.exp x k = (ZN m).prod.exp x k       by Invertibles_property
13044    and !x k.(ZN m).prod.exp x k = (x ** k) MOD m   by ZN_exp
13045
13046       (n ** k) MOD m
13047     = ((n MOD m) ** k) MOD m          by EXP_MOD, 0 < m
13048     = ((n MOD m) ** (k MOD z)) MOD m  by group_exp_mod_order, n MOD m IN g.carrier, 0 < z
13049     = ((n ** (k MOD z)) MOD m)        by EXP_MOD, 0 < m
13050*)
13051Theorem ZN_coprime_exp_mod:
13052    !m n. 0 < m /\ coprime m n ==> !k. (n ** k) MOD m = (n ** (k MOD (ordz m n))) MOD m
13053Proof
13054  rpt strip_tac >>
13055  Cases_on `m = 1` >-
13056  rw[ZN_order_mod_1] >>
13057  qabbrev_tac `z = ordz m n` >>
13058  `0 < m` by decide_tac >>
13059  `0 < z` by rw[ZN_coprime_order_alt, Abbr`z`] >>
13060  qabbrev_tac `g = Invertibles (ZN m).prod` >>
13061  `FiniteGroup g` by rw[ZN_invertibles_finite_group, Abbr`g`] >>
13062  `n MOD m IN g.carrier` by rw[ZN_coprime_invertible, Abbr`g`] >>
13063  `z = ordz m n` by rw[ZN_order_mod, Abbr`z`] >>
13064  `_ = order g (n MOD m)` by rw[ZN_invertibles_order, Abbr`g`] >>
13065  `Group g` by rw[finite_group_is_group] >>
13066  `(n ** k) MOD m = ((n MOD m) ** k) MOD m` by metis_tac[EXP_MOD] >>
13067  `_ = ((n MOD m) ** (k MOD z)) MOD m` by metis_tac[group_exp_mod_order, Invertibles_property, ZN_exp] >>
13068  `_ = ((n ** (k MOD z)) MOD m)` by metis_tac[EXP_MOD] >>
13069  rw[]
13070QED
13071
13072(* Theorem: 0 < m /\ coprime m n /\ (!p. prime p /\ p divides n ==> (ordz m p = 1)) ==> (ordz m n = 1) *)
13073(* Proof:
13074   If m = 1, true since ordz 1 n = 1             by ZN_order_mod_1
13075   If m <> 1, then 1 < m                         by 0 < m, m <> 1
13076               and 1 MOD m = 1                   by ONE_MOD
13077   If n = 1, true                                by ZN_order_1
13078   If n <> 1,
13079      Since m <> 1, coprime m n ==> n <> 0       by GCD_0R
13080      Thus 0 < n and 1 < n                       by n <> 1
13081
13082      Claim: !p. prime p /\ p divides n ==> (p MOD m = 1)
13083      Proof: prime p /\ p divides n
13084         ==> coprime m n ==> coprime m p         by coprime_prime_factor_coprime, GCD_SYM, 1 < m
13085         and ordz m p = 1                        by implication
13086         ==> p MOD m = 1                         by ZN_order_eq_1
13087
13088      Thus n MOD m = 1                           by ALL_PRIME_FACTORS_MOD_EQ_1
13089       ==> ordz m p = 1                          by ZN_order_eq_1
13090*)
13091Theorem ZN_order_eq_1_by_prime_factors:
13092    !m n. 0 < m /\ coprime m n /\ (!p. prime p /\ p divides n ==> (ordz m p = 1)) ==> (ordz m n = 1)
13093Proof
13094  rpt strip_tac >>
13095  Cases_on `m = 1` >-
13096  rw[ZN_order_mod_1] >>
13097  Cases_on `n = 1` >-
13098  rw[ZN_order_1] >>
13099  `n <> 0` by metis_tac[GCD_0R] >>
13100  `0 < n /\ 1 < n /\ 1 < m` by decide_tac >>
13101  `!p. prime p /\ p divides n ==> (p MOD m = 1)` by
13102  (rpt strip_tac >>
13103  `coprime m p` by metis_tac[coprime_prime_factor_coprime, GCD_SYM] >>
13104  metis_tac[ZN_order_eq_1, ONE_MOD]) >>
13105  `n MOD m = 1` by rw[ALL_PRIME_FACTORS_MOD_EQ_1] >>
13106  rw[ZN_order_eq_1]
13107QED
13108
13109(*
13110> order_eq_0 |> ISPEC ``(ZN m).prod`` |> ISPEC ``n:num``;
13111val it = |- (ordz m n = 0) <=> !n'. 0 < n' ==> (ZN m).prod.exp n n' <> (ZN m).prod.id: thm
13112*)
13113
13114(* Theorem: 1 < m ==> (ordz m n <> 0 <=> ?k. 0 < k /\ (n ** k MOD m = 1)) *)
13115(* Proof:
13116   By order_eq_0,
13117      (ordz m n = 0) <=> !k. 0 < k ==> (ZN m).prod.exp n k <> (ZN m).prod.id
13118   or (ordz m n = 0) <=> !k. 0 < k ==> n ** k MOD m <> 1    by ZN_exp, ZN_ids_alt, 0 < m, 1 < m
13119   The result follows by taking negation of both sides.
13120*)
13121Theorem ZN_order_nonzero_iff:
13122    !m n. 1 < m ==> (ordz m n <> 0 <=> ?k. 0 < k /\ (n ** k MOD m = 1))
13123Proof
13124  rw[order_eq_0, ZN_exp, ZN_ids_alt]
13125QED
13126
13127(* Theorem: 1 < m ==> ((ordz m n = 0) <=> (!k. 0 < k ==> n ** k MOD m <> 1)) *)
13128(* Proof: by ZN_order_nonzero_iff *)
13129Theorem ZN_order_eq_0_iff:
13130    !m n. 1 < m ==> ((ordz m n = 0) <=> (!k. 0 < k ==> n ** k MOD m <> 1))
13131Proof
13132  metis_tac[ZN_order_nonzero_iff]
13133QED
13134
13135(* Theorem: 0 < m ==> ((ordz m n <> 0) <=> coprime m n) *)
13136(* Proof:
13137   If m = 1, true since ordz 1 n = 1 <> 0        by ZN_order_mod_1
13138                    and coprime 1 n              by GCD_1
13139   If m <> 1, then 1 < m                         by 0 < m, m <> 1
13140               and 1 MOD m = 1                   by ONE_MOD
13141   If part: ordz m n <> 0 ==> coprime m n
13142      Let x = n MOD m.
13143      Then ordz m n = ordz m x     by ZN_order_mod, 0 < m
13144      Note Ring (ZN m)             by ZN_ring, 0 < m
13145        so Monoid (ZN m).prod      by ring_mult_monoid
13146       and (ZN m).prod.carrier = (ZN m).carrier   by ring_carriers
13147      Note x < n                   by MOD_LESS, 0 < m
13148      Thus x IN (ZN m).carrier     by ZN_property
13149       Now 0 < ordz m x            by 0 < ordz m n = ordz m x
13150       ==> x IN (Invertibles (ZN m).prod).carrier   by monoid_order_nonzero, Invertibles_carrier
13151        or x IN (Estar m).carrier                   by ZN_invertibles, 1 < m
13152     Hence coprime m x             by Estar_element
13153        or coprime m n             by coprime_mod_iff. 0 < m
13154
13155   Only-if part: coprime m n ==> ordz m n <> 0
13156     This is true                  by ZN_coprime_order, 0 < m
13157*)
13158Theorem ZN_order_nonzero:
13159    !m n. 0 < m ==> ((ordz m n <> 0) <=> coprime m n)
13160Proof
13161  rpt strip_tac >>
13162  Cases_on `m = 1` >-
13163  rw[ZN_order_mod_1] >>
13164  rw[EQ_IMP_THM] >| [
13165    qabbrev_tac `x = n MOD m` >>
13166    `ordz m n = ordz m x` by rw[ZN_order_mod, Abbr`x`] >>
13167    `Monoid (ZN m).prod` by rw[ZN_ring, ring_mult_monoid] >>
13168    `(ZN m).prod.carrier = (ZN m).carrier` by rw[ZN_ring, ring_carriers] >>
13169    `x IN (ZN m).carrier` by rw[ZN_property, MOD_LESS, Abbr`x`] >>
13170    `x IN (Invertibles (ZN m).prod).carrier` by rw[monoid_order_nonzero, Invertibles_carrier] >>
13171    `x IN (Estar m).carrier` by rw[GSYM ZN_invertibles] >>
13172    `coprime m x` by metis_tac[Estar_element] >>
13173    rw[Once coprime_mod_iff],
13174    metis_tac[ZN_coprime_order, NOT_ZERO_LT_ZERO]
13175  ]
13176QED
13177
13178(* Theorem: 0 < m ==> ((ordz m n = 0) <=> ~(coprime m n)) *)
13179(* Proof: by ZN_order_nonzero *)
13180Theorem ZN_order_eq_0:
13181    !m n. 0 < m ==> ((ordz m n = 0) <=> ~(coprime m n))
13182Proof
13183  metis_tac[ZN_order_nonzero]
13184QED
13185
13186(* Theorem: 0 < m /\ ~coprime m n ==> !k. 0 < k ==> n ** k MOD m <> 1 *)
13187(* Proof:
13188   Note m <> 1                              by GCD_1
13189    and ~coprime m n ==> ordz m n = 0       by ZN_order_eq_0, 0 < m
13190    ==> !k. 0 < k ==> (n ** k) MOD m <> 1   by ZN_order_eq_0_iff, 1 < m
13191*)
13192Theorem ZN_not_coprime:
13193    !m n. 0 < m /\ ~coprime m n ==> !k. 0 < k ==> n ** k MOD m <> 1
13194Proof
13195  rpt strip_tac >>
13196  `m <> 1` by metis_tac[GCD_1] >>
13197  `ordz m n = 0` by rw[ZN_order_eq_0] >>
13198  `1 < m` by decide_tac >>
13199  metis_tac[ZN_order_eq_0_iff]
13200QED
13201
13202(* Note: "Since ord k n > 1, there must exist a prime divisor p of n such that ord k p > 1." *)
13203
13204(* Theorem: 0 < m /\ 1 < ordz m n ==> ?p. prime p /\ p divides n /\ 1 < ordz m p *)
13205(* Proof:
13206   By contradiction, suppose !p. prime p /\ p divides n /\ ~(1 < ordz m p).
13207   Note ordz m n <> 0          by 1 < ordz m n
13208    ==> coprime m n            by ZN_order_eq_0, 0 < m
13209    ==> ?p. prime p /\ p divides n /\ (ordz m p <> 1)
13210                               by ZN_order_eq_1_by_prime_factors, ordz m n <> 1
13211   Thus ordz m p = 0           by ~(1 < x) <=> (x = 0) \/ (x = 1)
13212    ==> p divides m            by ZN_order_eq_0, PRIME_GCD, coprime_sym
13213    ==> p divides 1            by GCD_PROPERTY, coprime m n
13214    ==> p = 1                  by DIVIDES_ONE
13215    ==> F                      by NOT_PRIME_1
13216*)
13217Theorem ZN_order_gt_1_property:
13218    !m n. 0 < m /\ 1 < ordz m n ==> ?p. prime p /\ p divides n /\ 1 < ordz m p
13219Proof
13220  spose_not_then strip_assume_tac >>
13221  `coprime m n` by metis_tac[ZN_order_eq_0, DECIDE``1 < x ==> x <> 0``] >>
13222  `?p. prime p /\ p divides n /\ (ordz m p <> 1)` by metis_tac[ZN_order_eq_1_by_prime_factors, LESS_NOT_EQ] >>
13223  `ordz m p = 0` by metis_tac[DECIDE``~(1 < x) <=> (x = 0) \/ (x = 1)``] >>
13224  `p divides m` by metis_tac[ZN_order_eq_0, PRIME_GCD, coprime_sym] >>
13225  `p divides 1` by metis_tac[GCD_PROPERTY] >>
13226  metis_tac[DIVIDES_ONE, NOT_PRIME_1]
13227QED
13228
13229(*
13230> group_order_divides_exp |> ISPEC ``Invertibles (ZN m).prod``;
13231val it = |- Group (Invertibles (ZN m).prod) ==>
13232            !x. x IN (Invertibles (ZN m).prod).carrier ==>
13233            !n. ((Invertibles (ZN m).prod).exp x n = (Invertibles (ZN m).prod).id) <=>
13234                 order (Invertibles (ZN m).prod) x divides n: thm
13235*)
13236
13237(* Theorem: 1 < m /\ 0 < k ==> ((n ** k MOD m = 1) <=> (ordz m n) divides k) *)
13238(* Proof:
13239   Let g = Invertibles (ZN m).prod.
13240   Note g = Estar m           by ZN_invertibles
13241   Thus FiniteGroup g         by Estar_finite_group
13242    and Group g               by finite_group_is_group
13243    Let x = n MOD m.
13244   Then x < m                 by MOD_LESS, 0 < m
13245
13246   If part: n ** k MOD m = 1 ==> (ordz m n) divides k
13247      Note x ** n MOD m = 1      by given
13248       ==> ordz m n <> 0         by ZN_order_nonzero_iff, 1 < m
13249       ==> coprime m n           by ZN_order_eq_0, 1 < m
13250       ==> coprime m x           by coprime_mod_iff, 0 < m
13251       Now 0 < x                 by GCD_0, coprime m x, 1 < m
13252      Thus x IN g.carrier        by Estar_element, 0 < x, x < m, coprime m x
13253      Note x ** k MOD m = 1      by EXP_MOD, n ** k MOD m = 1
13254        or (Invertibles (ZN m).prod).exp x n = (Invertibles (ZN m).prod).id  by Estar_exp, Estar_property
13255       ==> order (Invertibles (ZN m).prod) x divides k          by group_order_divides_exp
13256        or ordz m n divides k    by ZN_invertibles_order
13257
13258   Only-if part: (ordz m n) divides k ==> n ** k MOD m = 1
13259      Note (ordz m n) divides k  by given
13260       ==> ordz m n <> 0         by ZERO_DIVIDES, 0 < k
13261       ==> coprime m n           by ZN_order_eq_0, 1 < m
13262       ==> coprime m x           by coprime_mod_iff, 0 < m
13263       Now 0 < x                 by GCD_0, coprime m x, 1 < m
13264      Thus x IN g.carrier        by Estar_element, 0 < x, x < m, coprime m x
13265      Note ordz m x = ordz m n   by ZN_order_mod, 1 < m
13266        or order (Invertibles (ZN n).prod) x divides k                 by ZN_invertibles_order, coprime m n
13267       ==> (Invertibles (ZN n).prod).exp x k = (Invertibles (ZN n).prod).id)  by group_order_divides_exp
13268        or x ** k MOD m = 1      by Estar_exp, Estar_property
13269        or n ** k MOD m = 1      by EXP_MOD, 0 < m
13270*)
13271Theorem ZN_order_divides_exp:
13272    !m n k. 1 < m /\ 0 < k ==> ((n ** k MOD m = 1) <=> (ordz m n) divides k)
13273Proof
13274  rpt strip_tac >>
13275  `0 < m` by decide_tac >>
13276  qabbrev_tac `g = Invertibles (ZN m).prod` >>
13277  `g = Estar m` by rw[ZN_invertibles, Abbr`g`] >>
13278  `FiniteGroup g` by rw[Estar_finite_group] >>
13279  `Group g` by rw[finite_group_is_group] >>
13280  qabbrev_tac `x = n MOD m` >>
13281  `x < m` by rw[Abbr`x`] >>
13282  rewrite_tac[EQ_IMP_THM] >>
13283  rpt strip_tac >| [
13284    `ordz m n <> 0` by metis_tac[ZN_order_nonzero_iff] >>
13285    `coprime m n` by metis_tac[ZN_order_eq_0] >>
13286    `coprime m x` by rw[GSYM coprime_mod_iff, Abbr`x`] >>
13287    `0 < x` by metis_tac[GCD_0, NOT_ZERO_LT_ZERO, DECIDE``1 < n ==> n <> 1``] >>
13288    `x IN g.carrier` by rw[Estar_element] >>
13289    `x ** k MOD m = 1` by rw[EXP_MOD, Abbr`x`] >>
13290    `order (Invertibles (ZN m).prod) x divides k` by rw[GSYM group_order_divides_exp, Estar_exp, Estar_property] >>
13291    metis_tac[ZN_invertibles_order],
13292    `ordz m n <> 0` by metis_tac[ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
13293    `coprime m n` by metis_tac[ZN_order_eq_0] >>
13294    `coprime m x` by rw[GSYM coprime_mod_iff, Abbr`x`] >>
13295    `0 < x` by metis_tac[GCD_0, NOT_ZERO_LT_ZERO, DECIDE``1 < n ==> n <> 1``] >>
13296    `x IN g.carrier` by rw[Estar_element] >>
13297    `ordz m x = ordz m n` by rw[ZN_order_mod, Abbr`x`] >>
13298    `x ** k MOD m = 1` by metis_tac[group_order_divides_exp, ZN_invertibles_order, Estar_exp, Estar_property] >>
13299    rw[GSYM EXP_MOD, Abbr`x`]
13300  ]
13301QED
13302
13303(* Theorem: 0 < m /\ 0 < ordz m n ==> (ordz m n) divides (phi m) *)
13304(* Proof:
13305   Note 0 < ordz m n ==> coprime m n    by ZN_order_nonzero, 0 < m
13306   Thus (ordz m n) divides (phi m)      by ZN_coprime_order_divides_phi, 0 < m
13307*)
13308Theorem ZN_order_divides_phi:
13309    !m n. 0 < m /\ 0 < ordz m n ==> (ordz m n) divides (phi m)
13310Proof
13311  rpt strip_tac >>
13312  `coprime m n` by metis_tac[ZN_order_nonzero, NOT_ZERO_LT_ZERO] >>
13313  rw[ZN_coprime_order_divides_phi]
13314QED
13315
13316(* Theorem: 0 < m ==> ordz m n <= phi m *)
13317(* Proof:
13318   If ordz m n = 0, then trivially true.
13319   Otherwise, 0 < ordz m n.
13320   Note ordz m n divides phi m       by ZN_order_divides_phi, 0 < m /\ 0 < ordz m n
13321    and 0 < phi m                    by phi_pos, 0 < m
13322     so ordz m n <= phi m            by DIVIDES_LE, 0 < phi m
13323*)
13324Theorem ZN_order_upper:
13325    !m n. 0 < m ==> ordz m n <= phi m
13326Proof
13327  rpt strip_tac >>
13328  Cases_on `ordz m n = 0` >-
13329  rw[] >>
13330  `ordz m n divides phi m` by rw[ZN_order_divides_phi] >>
13331  `0 < phi m` by rw[phi_pos] >>
13332  rw[DIVIDES_LE]
13333QED
13334
13335(* Theorem: 0 < m ==> ordz m n <= m *)
13336(* Proof:
13337   Note ordz m n <= phi m            by ZN_order_upper, 0 < m
13338   Also phi m <= m                   by phi_le
13339   Thus ordz m n <= m                by LESS_EQ_TRANS
13340*)
13341Theorem ZN_order_le:
13342    !m n. 0 < m ==> ordz m n <= m
13343Proof
13344  rpt strip_tac >>
13345  `ordz m n <= phi m` by rw[ZN_order_upper] >>
13346  `phi m <= m` by rw[phi_le] >>
13347  decide_tac
13348QED
13349
13350(* Theorem: 0 < k /\ k < m ==> ordz k n < m *)
13351(* Proof:
13352   Note ordz k n <= k      by ZN_order_le, 0 < k
13353    and             k < m  by given
13354   Thus ordz k n < m       by LESS_EQ_LESS_TRANS
13355*)
13356Theorem ZN_order_lt:
13357    !k n m. 0 < k /\ k < m ==> ordz k n < m
13358Proof
13359  rpt strip_tac >>
13360  `ordz k n <= k` by rw[ZN_order_le] >>
13361  decide_tac
13362QED
13363(* Therefore, in the search for k such that m <= ordz k n, start with k = m *)
13364
13365(*
13366val ZN_order_minimal =
13367  order_minimal |> ISPEC ``(ZN n).prod`` |> ADD_ASSUM ``1 < n`` |> DISCH_ALL
13368                |> SIMP_RULE (srw_ss() ++ numSimps.ARITH_ss) [ZN_property, ZN_exp];
13369
13370val ZN_order_minimal = |- 1 < n ==> !x n'. 0 < n' /\ n' < ordz n x ==> x ** n' MOD n <> 1: thm
13371*)
13372
13373(* Theorem: 0 < m /\ 0 < k /\ k < ordz m n ==> n ** k MOD m <> 1 *)
13374(* Proof:
13375   Note (ZN m).prod.exp n k <> (ZN m).prod.id    by order_minimal, 0 < k, k < ordz m n
13376    But (ZN m).prod.exp n k = n ** k MOD n       by ZN_exp, 0 < m
13377    and m <> 1  since !k. 0 < k /\ k < 1 = F     by ZN_order_mod_1, 0 < m
13378     so (ZN m).prod.id = 1                       by ZN_property, m <> 1
13379   Thus n ** k MOD m <> 1                        by above
13380*)
13381Theorem ZN_order_minimal:
13382    !m n k. 0 < m /\ 0 < k /\ k < ordz m n ==> n ** k MOD m <> 1
13383Proof
13384  metis_tac[order_minimal, ZN_order_mod_1, ZN_property, ZN_exp, DECIDE``(0 < k /\ k < 1) = F``]
13385QED
13386
13387(* Theorem: 1 < m /\ 1 < n MOD m /\ coprime m n ==> 1 < ordz m n *)
13388(* Proof:
13389   Let x = n MOD m.
13390   Then ordz m x = ordz m n             by ZN_order_mod, 0 < m
13391    and ordz m n <> 0                   by ZN_order_nonzero, coprime m n
13392    and ordz m n <> 1                   by ZN_order_eq_1_alt, 1 < m
13393   Thus ordz 1 < ordz m n               by arithmetic
13394*)
13395Theorem ZN_coprime_order_gt_1:
13396    !m n. 1 < m /\ 1 < n MOD m /\ coprime m n ==> 1 < ordz m n
13397Proof
13398  rpt strip_tac >>
13399  qabbrev_tac `x = n MOD m` >>
13400  `ordz m x = ordz m n` by rw[ZN_order_mod, Abbr`x`] >>
13401  `ordz m n <> 0` by rw[ZN_order_nonzero] >>
13402  `ordz m n <> 1` by rw[ZN_order_eq_1_alt, Abbr`x`] >>
13403  decide_tac
13404QED
13405
13406(* Note: 1 < n MOD m cannot be replaced by 1 < n. A counterexample:
13407   1 < m /\ 1 < n /\ coprime m n ==> 1 < ordz m n
13408   1 < 7 /\ 1 < 43 /\ coprime 7 43, but ordz 7 43 = ordz 7 (43 MOD 7) = ordz 7 1 = 1.
13409*)
13410
13411(* Theorem: 1 < n /\ coprime m n /\ 1 < ordz m n ==> 1 < m *)
13412(* Proof:
13413   Note m <> 0     by GCD_0, 1 < n
13414    and m <> 1     by ZN_order_mod_1, 1 < ordz m n
13415   Thus 1 < m
13416*)
13417Theorem ZN_order_with_coprime_1:
13418    !m n. 1 < n /\ coprime m n /\ 1 < ordz m n ==> 1 < m
13419Proof
13420  rpt strip_tac >>
13421  `m <> 0` by metis_tac[GCD_0, LESS_NOT_EQ] >>
13422  `m <> 1` by metis_tac[ZN_order_mod_1, LESS_NOT_EQ] >>
13423  decide_tac
13424QED
13425
13426(* Theorem: 1 < m /\ m divides n /\ 1 < ordz k m /\ coprime k n ==> 1 < n /\ 1 < k *)
13427(* Proof:
13428   Note k <> 1             by ZN_order_mod_1, 1 < ordz k m, 1 < m
13429    and n <> 1             by DIVIDES_ONE, m divides n, 1 < m
13430   also k <> 0 /\ n <> 0   by coprime_0L, coprime_0R
13431     so 1 < n /\ 1 < k     by both not 0, not 1.
13432*)
13433Theorem ZN_order_with_coprime_2:
13434    !m n k. 1 < m /\ m divides n /\ 1 < ordz k m /\ coprime k n ==> 1 < n /\ 1 < k
13435Proof
13436  ntac 4 strip_tac >>
13437  `k <> 1` by metis_tac[ZN_order_mod_1, LESS_NOT_EQ] >>
13438  `n <> 1` by metis_tac[DIVIDES_ONE, LESS_NOT_EQ] >>
13439  `k <> 0 /\ n <> 0` by metis_tac[coprime_0L, coprime_0R] >>
13440  decide_tac
13441QED
13442
13443(* Theorem: 1 < m ==> ((ordz m n = 0) <=> (!j. 0 < j /\ j < m ==> n ** j MOD m <> 1)) *)
13444(* Proof:
13445   If part: ordz m n = 0 ==> !j. 0 < j /\ j < m ==> n ** j MOD m <> 1
13446      Note !j. 0 < j ==> n ** j MOD m <> 1       by ZN_order_eq_0_iff
13447      Thus n ** j MOD m <> 1                     by just 0 < j
13448   Only-of part: !j. 0 < j /\ j < m ==> n ** j MOD m <> 1 ==> ordz m n = 0
13449      By contradiction, suppose ordz m n <> 0.
13450      Then coprime m n                           by ZN_order_eq_0
13451      Let k = ord z m.
13452      Then k < m                                 by ZN_order_lt, 0 < m, coprime m n
13453       and n ** k MOD m = 1                      by ZN_order_property_alt, 1 < m
13454      This contradicts n ** k MOD m <> 1         by implication
13455*)
13456Theorem ZN_order_eq_0_test:
13457    !m n. 1 < m ==> ((ordz m n = 0) <=> (!j. 0 < j /\ j < m ==> n ** j MOD m <> 1))
13458Proof
13459  rw[EQ_IMP_THM] >-
13460  metis_tac[ZN_order_eq_0_iff] >>
13461  spose_not_then strip_assume_tac >>
13462  `0 < ordz m n /\ 0 < m` by decide_tac >>
13463  `coprime m n` by metis_tac[ZN_order_eq_0] >>
13464  `ordz m n < m` by rw[ZN_coprime_order_lt] >>
13465  metis_tac[ZN_order_property_alt]
13466QED
13467
13468(* Theorem: 1 < n /\ 0 < j /\ 1 < k ==>
13469            (k divides (n ** j - 1) <=> (ordz k n) divides j) *)
13470(* Proof:
13471   Note 1 < n ** j                  by ONE_LT_EXP, 1 < n, 0 < j
13472       k divides (n ** j - 1)
13473   <=> (n ** j - 1) MOD k = 0       by DIVIDES_MOD_0, 0 < k
13474   <=> n ** j MOD k = 1 MOD k       by MOD_EQ, 1 < n ** j, 0 < k
13475                    = 1             by ONE_MOD, 1 < k
13476   <=> (ordz k n) divides j         by ZN_order_divides_exp, 0 < j, 1 < k
13477*)
13478Theorem ZN_order_divides_tops_index:
13479    !n j k. 1 < n /\ 0 < j /\ 1 < k ==>
13480       (k divides (n ** j - 1) <=> (ordz k n) divides j)
13481Proof
13482  rpt strip_tac >>
13483  `1 < n ** j` by rw[ONE_LT_EXP] >>
13484  `k divides (n ** j - 1) <=> ((n ** j - 1) MOD k = 0)` by rw[DIVIDES_MOD_0] >>
13485  `_ = (n ** j MOD k = 1 MOD k)` by rw[MOD_EQ] >>
13486  `_ = (n ** j MOD k = 1)` by rw[ONE_MOD] >>
13487  `_ = (ordz k n) divides j` by rw[ZN_order_divides_exp] >>
13488  metis_tac[]
13489QED
13490
13491(* Theorem: 1 < n /\ 0 < j /\ 1 < k /\ k divides (n ** j - 1) ==> (ordz k n) <= j *)
13492(* Proof:
13493   Note (ordz k n) divides j      by ZN_order_divides_tops_index
13494   Thus (ordz k n) <= j           by DIVIDES_LE, 0 < j
13495*)
13496Theorem ZN_order_le_tops_index:
13497    !n j k. 1 < n /\ 0 < j /\ 1 < k /\ k divides (n ** j - 1) ==> (ordz k n) <= j
13498Proof
13499  rw[GSYM ZN_order_divides_tops_index, DIVIDES_LE]
13500QED
13501
13502(* ------------------------------------------------------------------------- *)
13503(* ZN Order Test                                                             *)
13504(* ------------------------------------------------------------------------- *)
13505
13506(* Theorem: 1 < m /\ 0 < k /\ (n ** k MOD m = 1) /\
13507            (!j. 0 < j /\ j < k /\ j divides phi m ==> n ** j MOD m <> 1) ==>
13508            !j. 0 < j /\ j < k /\ ~(j divides phi m) ==> (ordz m n = k) \/ n ** j MOD m <> 1 *)
13509(* Proof:
13510   By contradiction, suppose (ordz m n <> k) /\ (n ** j MOD m = 1).
13511   Let z = ordz m n.
13512   Then z divides j /\ z divides k        by ZN_order_divides_exp
13513     so z <= k                            by DIVIDES_LE, 0 < k
13514     or z < k                             by z <> k (from contradiction assumption)
13515   Also 0 < z                             by ZERO_DIVIDES, z divides j, 0 < j
13516    and z divides (phi m)                 by ZN_order_divides_phi, 0 < z
13517    Put j = z in implication gives: n ** z MOD m <> 1
13518    This contradicts n ** z MOD m = 1     by ZN_order_property_alt, 1 < m
13519*)
13520Theorem ZN_order_test_propery:
13521    !m n k. 1 < m /\ 0 < k /\ (n ** k MOD m = 1) /\
13522   (!j. 0 < j /\ j < k /\ j divides phi m ==> n ** j MOD m <> 1) ==>
13523   !j. 0 < j /\ j < k /\ ~(j divides phi m) ==> (ordz m n = k) \/ n ** j MOD m <> 1
13524Proof
13525  rpt strip_tac >>
13526  spose_not_then strip_assume_tac >>
13527  qabbrev_tac `z = ordz m n` >>
13528  `z divides j /\ z divides k` by rw[GSYM ZN_order_divides_exp, Abbr`z`] >>
13529  `z <= k` by rw[DIVIDES_LE] >>
13530  `z < k` by decide_tac >>
13531  `0 < z` by metis_tac[ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
13532  `z divides (phi m)` by rw[ZN_order_divides_phi, Abbr`z`] >>
13533  metis_tac[ZN_order_property_alt]
13534QED
13535
13536(*
13537> order_thm |> GEN_ALL |> ISPEC ``(ZN m).prod`` |> ISPEC ``n:num`` |> ISPEC ``k:num``;
13538val it = |- 0 < k ==> ((ordz m n = k) <=>
13539    ((ZN m).prod.exp n k = (ZN m).prod.id) /\
13540    !m'. 0 < m' /\ m' < k ==> (ZN m).prod.exp n m' <> (ZN m).prod.id): thm
13541*)
13542
13543(* Theorem: 1 < m /\ 0 < k ==>
13544            ((ordz m n = k) <=> ((n ** k) MOD m = 1) /\ !j. 0 < j /\ j < k ==> (n ** j) MOD m <> 1) *)
13545(* Proof:
13546   By order_thm, 0 < k ==>
13547   ((ordz m n = k) <=> ((ZN m).prod.exp n k = (ZN m).prod.id) /\
13548                       !j. 0 < j /\ j < k ==> (ZN m).prod.exp n j <> (ZN m).prod.id)
13549   Now (ZN m).prod.exp n k = (n ** k) MOD m    by ZN_exp, 0 < m
13550   and (ZN m).prod.id = 1                      by ZN_property, m <> 1
13551   Thus the result follows.
13552*)
13553Theorem ZN_order_test_1:
13554    !m n k. 1 < m /\ 0 < k ==>
13555   ((ordz m n = k) <=> ((n ** k) MOD m = 1) /\ !j. 0 < j /\ j < k ==> (n ** j) MOD m <> 1)
13556Proof
13557  metis_tac[order_thm, ZN_exp, ZN_ids_alt, DECIDE``1 < m ==> 0 < m``]
13558QED
13559
13560(* Theorem: 1 < m /\ 0 < k ==> ((ordz m n = k) <=>
13561            (n ** k MOD m = 1) /\ !j. 0 < j /\ j < k /\ j divides (phi m) ==> n ** j MOD m <> 1) *)
13562(* Proof:
13563   If part: ordz m n = k ==> (n ** k MOD m = 1) /\ !j. 0 < j /\ j < k /\ j divides (phi m) ==> n ** j MOD m <> 1)
13564      This is to show:
13565      (1) n ** (ordz m n) MOD m = 1, true   by ZN_order_property, 1 < m.
13566      (2) !j. 0 < j /\ j < (ordz m n) /\ j divides (phi m) ==> n ** j MOD m <> 1)
13567          This is true                      by ZN_order_minimal, 1 < m.
13568   Only-if part: (n ** k MOD m = 1) /\
13569                 !j. 0 < j /\ j < k /\ j divides (phi m) ==> n ** j MOD m <> 1) ==> ordz m n = k
13570      Note the conditions give:
13571      !j. 0 < j /\ j < k /\ ~(j divides phi m)
13572          ==> (ordz m n = k) \/ n ** j MOD m <> 1    by ZN_order_test_propery
13573      Combining both implications,
13574      !j. 0 < j /\ j < k  ==> n ** j MOD m <> 1
13575      Thus ordz m n = k                     by ZN_order_test_1
13576*)
13577Theorem ZN_order_test_2:
13578    !m n k. 1 < m /\ 0 < k ==>
13579     ((ordz m n = k) <=>
13580      (n ** k MOD m = 1) /\ !j. 0 < j /\ j < k /\ j divides (phi m) ==> n ** j MOD m <> 1)
13581Proof
13582  rw[EQ_IMP_THM] >-
13583  rw[ZN_order_property] >-
13584  rw[ZN_order_minimal] >>
13585  `!j. 0 < j /\ j < k /\ ~(j divides phi m) ==>
13586       (ordz m n = k) \/ n ** j MOD m <> 1` by rw[ZN_order_test_propery] >>
13587  metis_tac[ZN_order_test_1]
13588QED
13589
13590(* Theorem: 1 < m /\ 0 < k ==> ((ordz m n = k) <=>
13591   (k divides phi m) /\ (n ** k MOD m = 1) /\ !j. 0 < j /\ j < k /\ j divides (phi m) ==> n ** j MOD m <> 1) *)
13592(* Proof:
13593   If part: ordz m n = k ==> (k divides phi m) /\
13594            (n ** k MOD m = 1) /\ !j. 0 < j /\ j < k /\ j divides (phi m) ==> n ** j MOD m <> 1)
13595      This is to show:
13596      (1) (ordz m n) divides phi m, true    by ZN_order_divides_phi, 1 < m.
13597      (2) n ** (ordz m n) MOD m = 1, true   by ZN_order_property, 1 < m.
13598      (3) !j. 0 < j /\ j < (ordz m n) /\ j divides (phi m) ==> n ** j MOD m <> 1)
13599          This is true                      by ZN_order_minimal, 1 < m.
13600   Only-if part: (k divides phi m) /\ (n ** k MOD m = 1) /\
13601                 !j. 0 < j /\ j < k /\ j divides (phi m) ==> n ** j MOD m <> 1) ==> ordz m n = k
13602      Note the conditions give:
13603      !j. 0 < j /\ j < k /\ ~(j divides phi m)
13604          ==> (ordz m n = k) \/ n ** j MOD m <> 1    by ZN_order_test_propery
13605      Combining both implications,
13606      !j. 0 < j /\ j < k  ==> n ** j MOD m <> 1
13607      Thus ordz m n = k                     by ZN_order_test_1
13608*)
13609Theorem ZN_order_test_3:
13610    !m n k. 1 < m /\ 0 < k ==>
13611     ((ordz m n = k) <=>
13612      (k divides phi m) /\ (n ** k MOD m = 1) /\ !j. 0 < j /\ j < k /\ j divides (phi m) ==> n ** j MOD m <> 1)
13613Proof
13614  rw[EQ_IMP_THM] >-
13615  rw[ZN_order_divides_phi] >-
13616  rw[ZN_order_property] >-
13617  rw[ZN_order_minimal] >>
13618  `!j. 0 < j /\ j < k /\ ~(j divides phi m) ==>
13619       (ordz m n = k) \/ n ** j MOD m <> 1` by rw[ZN_order_test_propery] >>
13620  metis_tac[ZN_order_test_1]
13621QED
13622
13623(* Theorem: 1 < m ==> (ordz m n = k <=> n ** k MOD m = 1 /\
13624           !j. 0 < j /\ j < (if k = 0 then m else k) ==> n ** j MOD m <> 1) *)
13625(* Proof:
13626   If k = 0,
13627      Note n ** 0 MOD m
13628         = 1 MOD m                       by EXP_0
13629         = 1                             by ONE_MOD, 1 < m
13630      The result follows                 by ZN_order_eq_0_test
13631   If k <> 0, the result follows         by ZN_order_test_1
13632*)
13633Theorem ZN_order_test_4:
13634    !m n k. 1 < m ==> ((ordz m n = k) <=> ((n ** k MOD m = 1) /\
13635    !j. 0 < j /\ j < (if k = 0 then m else k) ==> n ** j MOD m <> 1))
13636Proof
13637  rpt strip_tac >>
13638  (Cases_on `k = 0` >> simp[]) >| [
13639    `n ** 0 MOD m = 1` by rw[EXP_0] >>
13640    metis_tac[ZN_order_eq_0_test],
13641    rw[ZN_order_test_1]
13642  ]
13643QED
13644
13645(* ------------------------------------------------------------------------- *)
13646(* ZN Homomorphism                                                           *)
13647(* ------------------------------------------------------------------------- *)
13648
13649(* Theorem: 0 < m /\ x IN (ZN n).carrier ==> x MOD m IN (ZN m).carrier *)
13650(* Proof:
13651   Expand by definitions, this is to show:
13652   x < n ==> x MOD m < m, true by MOD_LESS.
13653*)
13654Theorem ZN_to_ZN_element:
13655    !n m x. 0 < m /\ x IN (ZN n).carrier ==> x MOD m IN (ZN m).carrier
13656Proof
13657  rw[ZN_def]
13658QED
13659
13660(* Theorem: 0 < n /\ m divides n ==> GroupHomo (\x. x MOD m) (ZN n).sum (ZN m).sum *)
13661(* Proof:
13662   Note 0 < m                     by ZERO_DIVIDES, 0 < n
13663   Expand by definitions, this is to show:
13664      x < n /\ x' < n ==> (x + x') MOD n MOD m = (x MOD m + x' MOD m) MOD m
13665     (x + x') MOD n MOD m
13666   = (x + x') MOD m               by DIVIDES_MOD_MOD, 0 < n
13667   = (x MOD m + x' MOD m) MOD m   by MOD_PLUS, 0 < m
13668*)
13669Theorem ZN_to_ZN_sum_group_homo:
13670    !n m. 0 < n /\ m divides n ==> GroupHomo (\x. x MOD m) (ZN n).sum (ZN m).sum
13671Proof
13672  rpt strip_tac >>
13673  `0 < m` by metis_tac[ZERO_DIVIDES, NOT_ZERO] >>
13674  rw[ZN_def, GroupHomo_def, DIVIDES_MOD_MOD, MOD_PLUS]
13675QED
13676
13677(* Theorem: 0 < n /\ m divides n ==> MonoidHomo (\x. x MOD m) (ZN n).prod (ZN m).prod *)
13678(* Proof:
13679   Note 0 < m                           by ZERO_DIVIDES, 0 < n
13680   Expand by definitions, this is to show:
13681   (1) x < n /\ x' < n ==> (x * x') MOD n MOD m = (x MOD m * x' MOD m) MOD m
13682         (x * x') MOD n MOD m
13683       = (x * x') MOD m                 by DIVIDES_MOD_MOD, 0 < n
13684       = (x MOD m * x' MOD m) MOD m     by MOD_TIMES2, 0 < m
13685   (2) 0 < m /\ m <> 1 ==> 1 < m, trivially true.
13686*)
13687Theorem ZN_to_ZN_prod_monoid_homo:
13688    !n m. 0 < n /\ m divides n ==> MonoidHomo (\x. x MOD m) (ZN n).prod (ZN m).prod
13689Proof
13690  rpt strip_tac >>
13691  `0 < m` by metis_tac[ZERO_DIVIDES, NOT_ZERO] >>
13692  rw[ZN_def, MonoidHomo_def, times_mod_def, DIVIDES_MOD_MOD] >>
13693  fs[DIVIDES_ONE]
13694QED
13695
13696(* Theorem: 0 < n /\ m divides n ==> RingHomo (\x. x MOD m) (ZN n) (ZN m) *)
13697(* Proof:
13698   By RingHomo_def, this is to show:
13699   (1) x IN (ZN n).carrier ==> x MOD m IN (ZN m).carrier
13700       Note 0 < m                           by ZERO_DIVIDES, 0 < n
13701       Hence true                           by ZN_to_ZN_element, 0 < m.
13702   (2) GroupHomo (\x. x MOD m) (ZN n).sum (ZN m).sum, true by ZN_to_ZN_sum_group_homo.
13703   (3) MonoidHomo (\x. x MOD m) (ZN n).prod (ZN m).prod, true by ZN_to_ZN_prod_monoid_homo.
13704*)
13705Theorem ZN_to_ZN_ring_homo:
13706    !n m. 0 < n /\ m divides n ==> RingHomo (\x. x MOD m) (ZN n) (ZN m)
13707Proof
13708  rw[RingHomo_def] >-
13709  metis_tac[ZN_to_ZN_element, ZERO_DIVIDES, NOT_ZERO] >-
13710  rw[ZN_to_ZN_sum_group_homo] >>
13711  rw[ZN_to_ZN_prod_monoid_homo]
13712QED
13713
13714(* ------------------------------------------------------------------------- *)
13715(* A Ring from Sets.                                                         *)
13716(* ------------------------------------------------------------------------- *)
13717
13718(* The Ring from Group (symdiff_set) and Monoid (set_inter). *)
13719Definition symdiff_set_inter_def:
13720  symdiff_set_inter = <| carrier := UNIV;
13721                             sum := symdiff_set;
13722                            prod := set_inter |>
13723End
13724(* Evaluation is given later in symdiff_eval. *)
13725
13726(* Theorem: symdiff_set_inter is a Ring. *)
13727(* Proof: check definitions.
13728   For the distribution law:
13729   x INTER (y SYM z) = (x INTER y) SYM (x INTER z)
13730   first verify by Venn Diagram.
13731*)
13732Theorem symdiff_set_inter_ring:
13733  Ring symdiff_set_inter
13734Proof
13735  rw_tac std_ss[Ring_def, symdiff_set_inter_def] >>
13736  rw[symdiff_set_def, set_inter_def] >>
13737  rw[EXTENSION, symdiff_def] >>
13738  metis_tac[]
13739QED
13740
13741(* Theorem: symdiff UNIV UNIV = EMPTY` *)
13742(* Proof: by definition. *)
13743Theorem symdiff_univ_univ_eq_empty:
13744    symdiff UNIV UNIV = EMPTY
13745Proof
13746  rw[symdiff_def]
13747QED
13748
13749(* Note: symdiff_set_inter has carrier infinite, but characteristics 2. *)
13750
13751(* Theorem: char symdiff_set_inter = 2 *)
13752(* Proof:
13753   By definition, and making use of FUNPOW_2.
13754   First to show:
13755   ?n. 0 < n /\ (FUNPOW (symdiff univ(:'a)) n {} = {})
13756   Put n = 2, and apply FUNPOW_2 and symdiff_def.
13757   Second to show:
13758   0 < n /\ FUNPOW (symdiff univ(:'a)) n {} = {} /\
13759   !m. m < n ==> ~(0 < m) \/ FUNPOW (symdiff univ(:'a)) m {} <> {} ==> n = 2
13760   By contradiction. Assume n <> 2, then n < 2 or 2 < n.
13761   If n < 2, then 0 < n < 2 means n = 1,
13762   but FUNPOW (symdiff univ(:'a)) 1 {} = symdiff univ(:'a) {} = univ(:'a) <> {}, a contradiction.
13763   If 2 < n, then FUNPOW (symdiff univ(:'a)) 2 {} <> {}, contradicting FUNPOW_2 and symdiff_def.
13764*)
13765Theorem symdiff_set_inter_char:
13766  char symdiff_set_inter = 2
13767Proof
13768  simp[char_def, order_def, period_def, symdiff_set_inter_def,
13769       monoid_exp_def, symdiff_set_def, set_inter_def] >>
13770  `FUNPOW (symdiff univ(:'a)) 2 {} = {}` by rw[FUNPOW_2, symdiff_def] >>
13771  DEEP_INTRO_TAC OLEAST_INTRO >>
13772  rw[] >>
13773  `~(n < 2) /\ ~(2 < n)` suffices_by decide_tac >>
13774  spose_not_then strip_assume_tac >>
13775  ‘~(2 < n)’ by metis_tac[DECIDE “2 <> 0”] >> gs[] >>
13776  `n = 1` by decide_tac >>
13777  gs[symdiff_def]
13778QED
13779
13780(* Theorem: evaluation for symdiff dields. *)
13781(* Proof: by definitions. *)
13782Theorem symdiff_eval[compute]:
13783  ((symdiff_set).carrier = UNIV) /\
13784  (!x y. (symdiff_set).op x y = (x UNION y) DIFF (x INTER y)) /\
13785  ((symdiff_set).id = EMPTY)
13786Proof
13787  rw_tac std_ss[symdiff_set_def, symdiff_def]
13788QED
13789(*
13790EVAL ``order (symdiff_set) EMPTY``;
13791> val it = |- order symdiff_set {} = 1 : thm
13792*)
13793
13794(* ------------------------------------------------------------------------- *)
13795(* Order Computation using a WHILE loop                                      *)
13796(* ------------------------------------------------------------------------- *)
13797
13798(* ------------------------------------------------------------------------- *)
13799(* A Small Example of WHILE loop invariant                                   *)
13800(* ------------------------------------------------------------------------- *)
13801
13802(* Pseudocode: search through all indexes from 1.
13803
13804Input: m, n with 1 < m, 0 < n
13805Output: ordz m n, the least index j such that (n ** j = 1) (mod m)
13806
13807if ~(coprime m n) return 0    // initial check
13808// For coprime m n, search the least index j such that (n ** j = 1) (mod m).
13809// Search upwards for least index j
13810j <- 1                        // initial index
13811while ((n ** i) MOD m <> 1) j <- j + 1  // increment j
13812return j                      // the least index j.
13813
13814*)
13815
13816(* Compute ordz m n = order (ZN m).prod n = ordz m n *)
13817Definition compute_ordz_def:
13818    compute_ordz m n =
13819         if m = 0 then ordz 0 n
13820    else if m = 1 then 1 (* ordz 1 n = 1 *)
13821    else if coprime m n then
13822         WHILE (\i. (n ** i) MOD m <> 1) SUC 1  (* i = 1, WHILE (n ** i (MOD m) <> 1) i <- SUC i) *)
13823    else 0  (* ordz m n = 0 when ~(coprime m n) *)
13824End
13825
13826(* Examples:
13827> EVAL ``compute_ordz 10 3``; --> 4
13828> EVAL ``compute_ordz 10 4``; --> 0
13829> EVAL ``compute_ordz 10 7``; --> 4
13830> EVAL ``compute_ordz 10 19``; --> 2
13831
13832> EVAL ``phi 10``; --> 4
13833
13834Indeed, (ordz m n) is a divisor of (phi m).
13835Since phi(10) = 4, ordz 10 n is a divisior of 4.
13836
13837> EVAL ``compute_ordz 1 19``; --> 1;
13838
13839> EVAL ``MAP (compute_ordz 7) [1 .. 6]``; = [1; 3; 6; 3; 6; 2]
13840> EVAL ``MAP (combin$C compute_ordz 10) [2 .. 13]``; = [0; 1; 0; 0; 0; 6; 0; 1; 0; 2; 0; 6]
13841  shows that, in decimals (base 10), 1/2 is finite, 1/3 has period 1, 1/7 has period 6,
13842                                     1/9 has period 1, 1/11 has period 2, 1/13 has period 6.
13843*)
13844
13845(*
13846> EVAL ``WHILE (\i. i <= 4) SUC 1``;
13847val it = |- WHILE (\i. i <= 4) SUC 1 = 5: thm
13848*)
13849
13850(*
13851For WHILE Guard Cmd,
13852we want to show:
13853   {Pre-condition} WHILE Guard Cmd {Post-condition}
13854
13855> WHILE_RULE;
13856val it = |- !R B C. WF R /\ (!s. B s ==> R (C s) s) ==>
13857     HOARE_SPEC (\s. P s /\ B s) C P ==>
13858     HOARE_SPEC P (WHILE B C) (\s. P s /\ ~B s): thm
13859
13860> HOARE_SPEC_DEF;
13861val it = |- !P C Q. HOARE_SPEC P C Q <=> !s. P s ==> Q (C s): thm
13862*)
13863
13864(* Theorem: (!x. Invariant x /\ Guard x ==> f (Cmd x) < f x) /\
13865            (!x. Precond x ==> Invariant x) /\
13866            (!x. Invariant x /\ ~Guard x ==> Postcond x) /\
13867            HOARE_SPEC (\x. Invariant x /\ Guard x) Cmd Invariant ==>
13868            HOARE_SPEC Precond (WHILE Guard Cmd) Postcond *)
13869(* Proof:
13870   By HOARE_SPEC_DEF, change the goal to show:
13871      !s. Invariant s ==> Postcond (WHILE Guard Cmd s)
13872   By complete induction on (f s).
13873   After rewrite by WHILE, this is to show:
13874      Postcond (if Guard s then WHILE Guard Cmd (Cmd s) else s)
13875   If Guard s,
13876      With Invariant s,
13877       ==> Postcond (WHILE Guard Cmd (Cmd s))   by induction hypothesis
13878   If ~(Guard s),
13879      With Invariant s,
13880       ==> Postcond s                           by given
13881*)
13882Theorem WHILE_RULE_PRE_POST:
13883    (!x. Invariant x /\ Guard x ==> f (Cmd x) < f x) /\
13884   (!x. Precond x ==> Invariant x) /\
13885   (!x. Invariant x /\ ~Guard x ==> Postcond x) /\
13886   HOARE_SPEC (\x. Invariant x /\ Guard x) Cmd Invariant ==>
13887   HOARE_SPEC Precond (WHILE Guard Cmd) Postcond
13888Proof
13889  simp[HOARE_SPEC_DEF] >>
13890  rpt strip_tac >>
13891  `!s. Invariant s ==> Postcond (WHILE Guard Cmd s)` suffices_by metis_tac[] >>
13892  Q.UNDISCH_THEN `Precond s` (K ALL_TAC) >>
13893  rpt strip_tac >>
13894  completeInduct_on `f s` >>
13895  rpt strip_tac >>
13896  fs[PULL_FORALL] >>
13897  first_x_assum (qspec_then `f` assume_tac) >>
13898  rfs[] >>
13899  ONCE_REWRITE_TAC[WHILE] >>
13900  Cases_on `Guard s` >>
13901  simp[]
13902QED
13903(* Michael's version:
13904val WHILE_RULE_PRE_POST = Q.store_thm(
13905  "WHILE_RULE_PRE_POST",
13906  `(!x. Invariant x /\ Guard x ==> f (Cmd x) < f x) /\
13907   (!x. Precond x ==> Invariant x) /\
13908   (!x. Invariant x /\ ~Guard x ==> Postcond x) /\
13909   HOARE_SPEC (\x. Invariant x /\ Guard x) Cmd Invariant ==>
13910   HOARE_SPEC Precond (WHILE Guard Cmd) Postcond`,
13911  simp[HOARE_SPEC_DEF] >>
13912  rpt strip_tac >>
13913  `!s. Invariant s ==> Postcond (WHILE Guard Cmd s)`
13914     suffices_by metis_tac[] >>
13915  Q.UNDISCH_THEN `Precond s` (K ALL_TAC) >>
13916  rpt strip_tac >>
13917  completeInduct_on `f s` >>
13918  rpt strip_tac >>
13919  fs[PULL_FORALL] >>
13920  first_x_assum (qspec_then `f` assume_tac) >>
13921  rfs[] >>
13922  ONCE_REWRITE_TAC[WHILE] >>
13923  Cases_on `Guard s` >> simp[]
13924)
13925*)
13926
13927(* Theorem: 1 < m /\ coprime m n ==>
13928            HOARE_SPEC (\i. 0 < i /\ i <= ordz m n)
13929                       (WHILE (\i. (n ** i) MOD m <> 1) SUC)
13930                       (\i. i = ordz m n) *)
13931(* Proof:
13932   By WHILE_RULE_PRE_POST, this is to show:
13933      ?Invariant f. (!x. (\i. 0 < i /\ i <= ordz m n) x ==> Invariant x) /\
13934                    (!x. Invariant x /\ (\i. (n ** i) MOD m <> 1) x ==> f (SUC x) < f x) /\
13935                    (!x. Invariant x /\ ~(\i. (n ** i) MOD m <> 1) x ==> (\i. i = ordz m n) x) /\
13936                    HOARE_SPEC (\x. Invariant x /\ (\i. (n ** i) MOD m <> 1) x) SUC Invariant
13937   By looking at the first requirement, and peeking at the second,
13938   let Invariant = \i. 0 < i /\ i <= ordz m n, f = \i. ordz m n - i.
13939   This is to show:
13940   (1) 1 < m /\ coprime m n /\ 0 < x /\ x <= ordz m n /\ n ** x MOD m <> 1 ==> 0 < ordz m n - x
13941       If x = ordz m n, then this is true                  by ZN_coprime_order_alt
13942       Otherwise, x <> ordz m n, hence 0 < ordz m n - x    by arithmetic
13943   (2) 1 < m /\ coprime m n /\ 0 < x /\ x <= ordz m n /\ n ** x MOD m = 1 ==> x = ordz m n
13944       If x = ordz m n, then this is true trivially.
13945       Otherwise, x <> ordz m n,
13946       or x < ordz m n, and 0 < m, but n ** x MOD m = 1, contradicts  ZN_order_minimal.
13947   (3) 1 < m /\ coprime m n ==>
13948       HOARE_SPEC (\x. (0 < x /\ x <= ordz m n) /\ n ** x MOD m <> 1) SUC (\i. 0 < i /\ i <= ordz m n)
13949       By HOARE_SPEC_DEF, this is to show:
13950          1 < m /\ coprime m n /\ 0 < x /\ x <= ordz m n /\ n ** x MOD m <> 1 ==> SUC x <= ordz m n
13951       or 1 < m /\ coprime m n /\ 0 < x /\ x <= ordz m n /\ n ** x MOD m <> 1 ==> x < ordz m n
13952       By contradiction, suppose x = ordz m n.
13953       Then n ** x MOD m = 1, a contradiction         by ZN_coprime_order_alt, 1 < m
13954*)
13955Theorem compute_ordz_hoare:
13956    !m n. 1 < m /\ coprime m n ==>
13957         HOARE_SPEC (\i. 0 < i /\ i <= ordz m n)
13958                    (WHILE (\i. (n ** i) MOD m <> 1) SUC)
13959                    (\i. i = ordz m n)
13960Proof
13961  rpt strip_tac >>
13962  irule WHILE_RULE_PRE_POST >>
13963  qexists_tac `\i. 0 < i /\ i <= ordz m n` >>
13964  qexists_tac `\i. ordz m n - i` >>
13965  rw[] >| [
13966    Cases_on `x = ordz m n` >| [
13967      rw[] >>
13968      rfs[ZN_coprime_order_alt],
13969      decide_tac
13970    ],
13971    Cases_on `x = ordz m n` >-
13972    simp[] >>
13973    rfs[] >>
13974    `x < ordz m n /\ 0 < m` by decide_tac >>
13975    metis_tac[ZN_order_minimal],
13976    rw[HOARE_SPEC_DEF] >>
13977    `x < ordz m n` suffices_by decide_tac >>
13978    spose_not_then strip_assume_tac >>
13979    `x = ordz m n` by decide_tac >>
13980    rw[] >>
13981    rfs[ZN_coprime_order_alt]
13982  ]
13983QED
13984(* Michael's version:
13985val compute_ordz_hoare = prove(
13986  ``1 < m /\ coprime m n ==>
13987    HOARE_SPEC
13988      (\i. 0 < i /\ i <= ordz m n)
13989               (WHILE (\i. (n ** i) MOD m <> 1) SUC)
13990      (\i. i = ordz m n)``,
13991  strip_tac >>
13992  irule WHILE_RULE_PRE_POST >>
13993  qexists_tac `\i. 0 < i /\ i <= ordz m n` >>
13994  qexists_tac `\i. ordz m n - i` >>
13995  rw[] >| [
13996    (* Case 1 *)
13997    reverse (Cases_on `x = ordz m n`) >- decide_tac >>
13998    rw[] >>
13999    rfs[ZN_coprime_order_alt],
14000
14001    (* Case 2 *)
14002    Cases_on `x = ordz m n` >- simp[] >>
14003    rfs[] >>
14004    `x < ordz m n /\ 0 < m` by decide_tac >>
14005    metis_tac[ZN_order_minimal],
14006
14007    (* Case 3 *)
14008    rw[HOARE_SPEC_DEF] >>
14009    `x < ordz m n` suffices_by decide_tac >>
14010    spose_not_then assume_tac >>
14011    `x = ordz m n` by decide_tac >> rw[] >>
14012    rfs[ZN_coprime_order_alt]
14013  ]);
14014*)
14015
14016(*
14017val compute_ordz_hoare =
14018   |- 1 < m /\ coprime m n ==> HOARE_SPEC (\i. 0 < i /\ i <= ordz m n)
14019      (WHILE (\i. (n ** i) MOD m <> 1) SUC) (\i. i = ordz m n): thm
14020
14021SIMP_RULE (srw_ss()) [HOARE_SPEC_DEF] compute_ordz_hoare;
14022val it = |- 1 < m /\ coprime m n ==>
14023            !i. 0 < i /\ i <= ordz m n ==> (WHILE (\i. (n ** i) MOD m <> 1) SUC i = ordz m n): thm
14024*)
14025
14026(* Theorem: 1 < m /\ coprime m n ==>
14027            !j. 0 < j /\ j <= ordz m n ==> (WHILE (\i. (n ** i) MOD m <> 1) SUC j = ordz m n) *)
14028(* Proof:
14029   By compute_ordz_hoare, we have the loop-invariant:
14030   HOARE_SPEC (\i. 0 < i /\ i <= ordz m n)
14031              (WHILE (\i. (n ** i) MOD m <> 1) SUC)
14032              (\i. i = ordz m n)
14033   Let Px = \i. 0 < i /\ i <= ordz m n                   be the pre-condition
14034       Cx = WHILE (\i. (n ** i) MOD m <> 1) SUC   be the command body
14035       Qx = \i. i = ordz m n                             be the post-condition
14036   ==> HOARE_SPEC Px Cx Qx                               by above
14037   Apply HOARE_SPEC_DEF, |- HOARE_SPEC P C Q <=> !s. P s ==> Q (C s)
14038   Thus !j. P j ==> Qx (Cx j)
14039     or !j. 0 < j /\ j <= ordz m n ==>
14040        (WHILE (\i. (n ** i) MOD m <> 1) SUC j = ordz m n)
14041*)
14042Theorem compute_ordz_by_while[local]:
14043    !m n. 1 < m /\ coprime m n ==>
14044   !j. 0 < j /\ j <= ordz m n ==> (WHILE (\i. (n ** i) MOD m <> 1) SUC j = ordz m n)
14045Proof
14046  rpt strip_tac >>
14047  `HOARE_SPEC
14048      (\i. 0 < i /\ i <= ordz m n)
14049      (WHILE (\i. (n ** i) MOD m <> 1) SUC)
14050      (\i. i = ordz m n)` by rw[compute_ordz_hoare] >>
14051  fs[HOARE_SPEC_DEF]
14052QED
14053
14054(* ------------------------------------------------------------------------- *)
14055(* Correctness of computing ordz m n.                                        *)
14056(* ------------------------------------------------------------------------- *)
14057
14058(* Theorem: compute_ordz 0 n = ordz 0 n *)
14059(* Proof: by compute_ordz_def *)
14060Theorem compute_ordz_0:
14061    !n. compute_ordz 0 n = ordz 0 n
14062Proof
14063  rw[compute_ordz_def]
14064QED
14065
14066(* Theorem: compute_ordz 1 n = 1 *)
14067(* Proof: by compute_ordz_def *)
14068Theorem compute_ordz_1:
14069    !n. compute_ordz 1 n = 1
14070Proof
14071  rw[compute_ordz_def]
14072QED
14073
14074(* Theorem: compute_ordz m n = ordz m n *)
14075(* Proof:
14076   If m = 0,
14077      Then compute_ordz 0 n = ordz 0 n     by compute_ordz_0
14078   If m = 1,
14079      Then compute_ordz 1 n = 1            by compute_ordz_1
14080                            = ordz 1 n     by ZN_order_mod_1
14081   If m <> 0, m <> 1,
14082      Then 1 < m                           by arithmetic
14083      If ordz m n = 0,
14084         Then ~coprime m n                 by ZN_order_eq_0
14085              compute_ordz m n
14086            = 0                            by compute_ordz_def
14087            = ordz m n                     by ordz m n = 0
14088      If ordz m n <> 0,
14089         Then coprime m n                  by ZN_order_eq_0
14090          and 1 <= ordz m n                by arithmetic
14091              compute_ordz m n
14092            = WHILE (\i. (n ** i) MOD m <> 1) SUC 1   by compute_ordz_def
14093            = ordz m n                                       by compute_ordz_by_while, put j = 1.
14094*)
14095Theorem compute_ordz_eqn:
14096    !m n. compute_ordz m n = ordz m n
14097Proof
14098  rpt strip_tac >>
14099  Cases_on `m = 0` >-
14100  rw[compute_ordz_0] >>
14101  `0 < m` by decide_tac >>
14102  Cases_on `m = 1` >-
14103  rw[compute_ordz_1, ZN_order_mod_1] >>
14104  Cases_on `ordz m n = 0` >| [
14105    `~coprime m n` by rw[GSYM ZN_order_eq_0] >>
14106    rw[compute_ordz_def],
14107    `coprime m n` by metis_tac[ZN_order_eq_0] >>
14108    `1 < m` by decide_tac >>
14109    rw[compute_ordz_def, compute_ordz_by_while]
14110  ]
14111QED
14112
14113(* Theorem: order (times_mod m) n = compute_ordz m n *)
14114(* Proof: by compute_ordz_eqn *)
14115Theorem ordz_eval[compute]:
14116    !m n. order (times_mod m) n = compute_ordz m n
14117Proof
14118  rw[ZN_eval, compute_ordz_eqn]
14119QED
14120(* Put in computeLib for simplifier. *)
14121
14122(*
14123> EVAL ``ordz 7 10``;
14124val it = |- ordz 7 10 = 6: thm
14125*)
14126
14127(* ------------------------------------------------------------------------- *)
14128(* Integer Ring Documentation                                                *)
14129(* ------------------------------------------------------------------------- *)
14130(* Overloads:
14131   Z*      = Z_ideal
14132*)
14133(* Definitions and Theorems (# are exported):
14134
14135   Integer Ring:
14136   Z_add_def             |- Z_add = <|carrier := univ(:int); op := (\x y. x + y); id := 0|>
14137   Z_mult_def            |- Z_mult = <|carrier := univ(:int); op := (\x y. x * y); id := 1|>
14138   Z_def                 |- Z = <|carrier := univ(:int); sum := Z_add; prod := Z_mult|>
14139
14140   Z_add_group           |- Group Z_add
14141   Z_add_abelian_group   |- AbelianGroup Z_add
14142   Z_mult_monoid         |- Monoid Z_mult
14143   Z_mult_abelian_monoid |- AbelianMonoid Z_mult
14144   Z_ring                |- Ring
14145
14146   Ideals in Integer Ring:
14147   Z_multiple_def        |- !n. Z_multiple n = {&n * z | z IN univ(:int)}
14148   Z_ideal_def           |- !n. Z* n = <|carrier := Z_multiple n;
14149                                             sum := <|carrier := Z_multiple n; op := Z.sum.op; id := Z.sum.id|>;
14150                                            prod := <|carrier := Z_multiple n; op := Z.prod.op;
14151                                              id := Z.prod.id|>
14152                                        |>
14153
14154   Z_ideal_sum_group     |- !n. Group (Z* n).sum
14155   Z_ideal_sum_subgroup  |- !n. (Z* n).sum <= Z.sum
14156   Z_ideal_sum_normal    |- !n. (Z* n).sum << Z.sum
14157   Z_ideal_thm           |- !n. Z* n << Z
14158
14159   Integer Quotient Ring isomorphic to Integer Modulo:
14160   Z_add_inv               |- !z. z IN Z_add.carrier ==> (Z_add.inv z = -z)
14161   Z_sum_cogen             |- !n. 0 < n ==> !x. x IN Z.sum.carrier ==>
14162                              ?y. cogen Z.sum (Z* n).sum (coset Z.sum x (Z* n).sum.carrier) = x + &n * y
14163   Z_sum_coset_eq          |- !n. 0 < n ==> !p. coset Z.sum p (Z* n).sum.carrier = coset Z.sum (p % &n) (Z* n).sum.carrier
14164   Z_multiple_less_neg_eq  |- !n x y. 0 < n /\ x < n /\ y < n /\ -&x + &y IN Z_multiple n ==> (x = y)
14165
14166   Z_ideal_map_element     |- !n j. 0 < n /\ j IN (ZN n).carrier ==> coset Z.sum (&j) (Z* n).sum.carrier IN (Z / Z* n).carrier
14167   Z_ideal_map_group_homo  |- !n. 0 < n ==> GroupHomo (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).sum (Z / Z* n).sum
14168   Z_ideal_map_monoid_homo |- !n. 0 < n ==> MonoidHomo (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).prod (Z / Z* n).prod
14169   Z_ideal_map_bij         |- !n. 0 < n ==> BIJ (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).carrier (Z / Z* n).carrier
14170   Z_quotient_iso_ZN       |- !n. 0 < n ==> RingIso (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n) (Z / Z* n)
14171
14172   Integer as Euclidean Ring:
14173   Z_euclid_ring           |- EuclideanRing Z (Num o ABS)
14174   Z_principal_ideal_ring  |- PrincipalIdealRing Z
14175*)
14176
14177(* ------------------------------------------------------------------------- *)
14178(* Integer Ring                                                              *)
14179(* ------------------------------------------------------------------------- *)
14180
14181(* Integer Additive Group *)
14182Definition Z_add_def:
14183  Z_add = <| carrier := univ(:int);
14184                  op := \(x:int) (y:int). x + y;
14185                  id := (0:int)
14186           |>
14187End
14188
14189(* Integer Multiplicative Monoid *)
14190Definition Z_mult_def:
14191  Z_mult = <| carrier := univ(:int);
14192                   op := \(x:int) (y:int). x * y;
14193                   id := (1:int)
14194            |>
14195End
14196
14197(* Integer Ring *)
14198Definition Z_def:
14199  Z = <| carrier := univ(:int);
14200             sum := Z_add;
14201            prod := Z_mult
14202       |>
14203End
14204
14205(* Theorem: Z_add is a Group. *)
14206(* Proof: check group axioms:
14207   (1) x + y IN univ(:int), true.
14208   (2) x + y + z = x + (y + z), true by INT_ADD_ASSOC.
14209   (3) 0 IN univ(:int), true.
14210   (4) 0 + x = x, true by INT_ADD_LID.
14211   (5) !x. x IN univ(:int) ==> ?y. y IN univ(:int) /\ (y + x = 0)
14212       Let y = -x, apply INT_ADD_LINV.
14213*)
14214Theorem Z_add_group:
14215    Group Z_add
14216Proof
14217  rw_tac std_ss[Z_add_def, group_def_alt] >| [
14218    rw[],
14219    rw[INT_ADD_ASSOC],
14220    rw[],
14221    rw[],
14222    qexists_tac `-x` >>
14223    rw[]
14224  ]
14225QED
14226
14227(* Theorem: Z_add is an Abelian Group. *)
14228(* Proof: by Group Z_add and INT_ADD_COMM. *)
14229Theorem Z_add_abelian_group:
14230    AbelianGroup Z_add
14231Proof
14232  rw[AbelianGroup_def, Z_add_group, Z_add_def, INT_ADD_COMM]
14233QED
14234
14235(* Theorem: Z_mult is a Monoid. *)
14236(* Proof: check monoid axioms:
14237   (1) x * y IN univ(:int), true.
14238   (2) x * y * z = x * (y * z), true by INT_MUL_ASSOC.
14239   (3) 1 IN univ(:int), true.
14240   (4) 1 * x = x, true by INT_MUL_LID.
14241   (5) x * 1 = x, true by INT_MUL_RID.
14242*)
14243Theorem Z_mult_monoid:
14244    Monoid Z_mult
14245Proof
14246  rw_tac std_ss [Z_mult_def, Monoid_def] >>
14247  rw[INT_MUL_ASSOC]
14248QED
14249
14250(* Theorem: Z_mult is an Abelian Monoid. *)
14251(* Proof: by Monoid Z_mult and INT_MUL_COMM. *)
14252Theorem Z_mult_abelian_monoid:
14253    AbelianMonoid Z_mult
14254Proof
14255  rw[AbelianMonoid_def, Z_mult_monoid, Z_mult_def, INT_MUL_COMM]
14256QED
14257
14258(* Theorem: Z is a Ring. *)
14259(* Proof: check ring axioms.
14260   (1) AbelianGroup Z_add, true by Z_add_abelian_group.
14261   (2) AbelianMonoid Z_mult, true by Z_mult_abelian_monoid.
14262   (3) Z_add.carrier = univ(:int), true by Z_add_def.
14263   (4) Z_mult.carrier = univ(:int), true by Z_mult_def.
14264   (5) Z_mult.op x (Z_add.op y z) = Z_add.op (Z_mult.op x y) (Z_mult.op x z)
14265       or x * (y + z) = x * y + x * z, true by INT_LDISTRIB.
14266*)
14267Theorem Z_ring:
14268    Ring Z
14269Proof
14270  rw_tac std_ss [Ring_def, Z_def] >| [
14271    rw[Z_add_abelian_group],
14272    rw[Z_mult_abelian_monoid],
14273    rw[Z_add_def],
14274    rw[Z_mult_def],
14275    rw[Z_add_def, Z_mult_def, INT_LDISTRIB]
14276  ]
14277QED
14278
14279(* ------------------------------------------------------------------------- *)
14280(* Ideals in Integer Ring                                                    *)
14281(* ------------------------------------------------------------------------- *)
14282
14283(* Integer Multiples *)
14284Definition Z_multiple_def:   Z_multiple (n:num) = {&n * z | z IN univ(:int)}
14285End
14286
14287(* Integer Ring Ideals are multiples *)
14288Definition Z_ideal_def:
14289  Z_ideal (n:num) = <| carrier := Z_multiple n;
14290                           sum := <| carrier := Z_multiple n; op := Z.sum.op; id := Z.sum.id |>;
14291                          prod := <| carrier := Z_multiple n; op := Z.prod.op; id := Z.prod.id |>
14292                     |>
14293End
14294
14295(* set overloading *)
14296Overload "Z*" = ``Z_ideal``
14297
14298(* Theorem: Group (Z* n).sum *)
14299(* Proof: check group axioms:
14300   (1) x + y IN Z_multiple n
14301       &n * x' + &n * y' = &n * (x' + y') by INT_LDISTRIB, hence true.
14302   (2) x + y + z = x + (y + z)
14303       Since t IN Z_multiple n ==> t IN univ(:int),
14304       this is true by INT_ADD_ASSOC.
14305   (3) 0 IN Z_multiple n
14306       true by INT_MUL_RZERO.
14307   (4) 0 + x = x
14308       true by INT_ADD_LID.
14309   (5) ?y. y IN Z_multiple n /\ (y + x = 0)
14310       Since x = &n * x'
14311       Let y = &n * (-x')
14312       Then y IN Z_multiple n,
14313       y + x = &n * (-x' + x') = 0   by INT_LDISTRIB, INT_ADD_LINV, hence true.
14314*)
14315Theorem Z_ideal_sum_group:
14316    !n. Group (Z* n).sum
14317Proof
14318  rpt strip_tac >>
14319  `!t. t IN Z_multiple n ==> t IN univ(:int)` by rw[Z_multiple_def] >>
14320  rw_tac std_ss[group_def_alt, Z_ideal_def, Z_def, Z_add_def] >| [
14321    `!t. t IN Z_multiple n <=> ?(t':int). t = &n * t'` by rw[Z_multiple_def] >>
14322    metis_tac[INT_LDISTRIB],
14323    rw[INT_ADD_ASSOC],
14324    `!t. t IN Z_multiple n <=> ?(t':int). t = &n * t'` by rw[Z_multiple_def] >>
14325    metis_tac[INT_MUL_RZERO],
14326    rw[],
14327    `!t. t IN Z_multiple n <=> ?(t':int). t = &n * t'` by rw[Z_multiple_def] >>
14328    `?x'. x = &n * x'` by metis_tac[] >>
14329    qexists_tac `&n * (-x')` >>
14330    `-x' IN univ(:int)` by rw[] >>
14331    `&n * -x' + &n * x' = &n * (-x' + x')` by rw[INT_LDISTRIB] >>
14332    `_ = 0` by rw[INT_ADD_LINV] >>
14333    metis_tac[]
14334  ]
14335QED
14336
14337(* Theorem: Monoid (Z* n).prod *)
14338(* Not true: 1 IN Z_multiple n is FALSE. *)
14339(* Note: Ideal is not a sub-ring. *)
14340
14341(* Theorem: (Z* n).sum <= Z.sum *)
14342(* Proof:
14343   (1) Group (Z* n).sum     true by Z_ideal_sum_group
14344   (2) Group Z.sum          true by Z_ring, Ring_def
14345   (3) (Z* n).sum.carrier SUBSET Z.sum.carrier   true by definitions
14346   (4) (Z* n).sum.op x y = Z.sum.op x y          true by Z_ideal_def
14347*)
14348Theorem Z_ideal_sum_subgroup:
14349    !n. (Z* n).sum <= Z.sum
14350Proof
14351  rw_tac std_ss[Subgroup_def] >| [
14352    rw[Z_ideal_sum_group],
14353    rw[Z_ring, Ring_def, AbelianGroup_def],
14354    rw[Z_ideal_def, Z_def, Z_add_def],
14355    rw[Z_ideal_def]
14356  ]
14357QED
14358
14359(* Theorem: (Z* n).sum << Z.sum *)
14360(* Proof:
14361   (1) (Z* n).sum <= Z.sum
14362       true by Z_ideal_sum_subgroup.
14363   (2) !a. a IN Z.sum.carrier ==> coset Z.sum a (Z* n).sum.carrier = right_coset Z.sum (Z* n).sum.carrier a
14364       i.e. IMAGE (\z. a + z) (Z_multiple n) = IMAGE (\z. z + a) (Z_multiple n)
14365       true by INT_ADD_COMM.
14366*)
14367Theorem Z_ideal_sum_normal:
14368    !n. (Z* n).sum << Z.sum
14369Proof
14370  rw[normal_subgroup_alt, coset_def, right_coset_def] >| [
14371    rw[Z_ideal_sum_subgroup],
14372    pop_assum mp_tac >>
14373    rw_tac std_ss[Z_ideal_def, Z_def, Z_add_def] >>
14374    rw[INT_ADD_COMM]
14375  ]
14376QED
14377
14378(* Theorem: Z* n is an ideal of Z *)
14379(* Proof:
14380   (1) (Z* n).sum <= Z.sum
14381       true by Z_ideal_sum_subgroup.
14382   (2) x IN Z_multiple n ==> x * y IN Z_multiple n
14383       (&n * x') * y = &n * (x' * y)  by INT_MUL_ASSOC, hence true.
14384   (3) x IN Z_multiple n ==> y * x IN Z_multiple n
14385       y * (&n * x') = &n * (y * x')  by INT_MUL_ASSOC, INT_MUL_COMM, hence true.
14386*)
14387Theorem Z_ideal_thm:
14388    !n. (Z* n) << Z
14389Proof
14390  rw_tac std_ss[ideal_def, Z_ideal_def, Z_def, Z_mult_def] >| [
14391    `Z.sum = Z_add` by rw[Z_def] >>
14392    `(Z* n).sum = <|carrier := Z_multiple n; op := Z_add.op; id := Z_add.id|>` by rw[Z_ideal_def] >>
14393    metis_tac[Z_ideal_sum_subgroup],
14394    `!t. t IN Z_multiple n <=> ?(t':int). t = &n * t'` by rw[Z_multiple_def] >>
14395    metis_tac[INT_MUL_ASSOC],
14396    `!t. t IN Z_multiple n <=> ?(t':int). t = &n * t'` by rw[Z_multiple_def] >>
14397    metis_tac[INT_MUL_ASSOC, INT_MUL_COMM]
14398  ]
14399QED
14400
14401(* ------------------------------------------------------------------------- *)
14402(* Integer Quotient Ring isomorphic to Integer Modulo                        *)
14403(* ------------------------------------------------------------------------- *)
14404
14405(* Theorem: Z_add.inv z = -z *)
14406(* Proof:
14407   Since -z + z = 0,
14408   this follows by group_linv_unique.
14409*)
14410Theorem Z_add_inv:
14411    !z. z IN Z_add.carrier ==> (Z_add.inv z = -z)
14412Proof
14413  rpt strip_tac >>
14414  `Group Z_add` by rw[Z_add_group] >>
14415  `-z IN Z_add.carrier /\ (Z_add.op (-z) z = Z_add.id)` by rw[Z_add_def] >>
14416  metis_tac[group_linv_unique]
14417QED
14418
14419(* Theorem: cogen Z.sum (Z* n).sum (coset Z.sum x (Z* n).sum.carrier) = x + &n * y  for some y. *)
14420(* Proof:
14421   (Z* n).sum <= Z.sum   by Z_ideal_sum_subgroup
14422   hence  (coset Z.sum x (Z* n).sum.carrier) IN CosetPartition Z.sum (Z* n).sum  by definitions
14423   By cogen_def, putting m = cogen Z.sum (Z* n).sum (coset Z.sum x (Z* n).sum.carrier)
14424         m IN Z.sum.carrier,
14425   and   coset Z.sum x (Z* n).sum.carrier = coset Z.sum m (Z* n).sum.carrier
14426   Hence -x + m IN (Z* n).sum.carrier  by subgroup_coset_eq
14427   or    -x + m IN Z_multiple n        by Z_ideal_def
14428   or    -x + m = &n * y               by Z_multiple_def
14429   or    m = x + &n * y
14430*)
14431Theorem Z_sum_cogen:
14432    !n. 0 < n ==> !x. x IN Z.sum.carrier ==> ? y:int. cogen Z.sum (Z* n).sum (coset Z.sum x (Z* n).sum.carrier) = x + &n * y
14433Proof
14434  rpt strip_tac >>
14435  `(Z* n).sum <= Z.sum` by rw[Z_ideal_sum_subgroup] >>
14436  `(coset Z.sum x (Z* n).sum.carrier) IN CosetPartition Z.sum (Z* n).sum` by
14437  (rw[CosetPartition_def, partition_def, inCoset_def] >>
14438  qexists_tac `x` >>
14439  rw[EXTENSION] >>
14440  metis_tac[subgroup_coset_subset]) >>
14441  `cogen Z.sum (Z* n).sum (coset Z.sum x (Z* n).sum.carrier) IN Z.sum.carrier /\
14442   (coset Z.sum x (Z* n).sum.carrier = coset Z.sum (cogen Z.sum (Z* n).sum (coset Z.sum x (Z* n).sum.carrier)) (Z* n).sum.carrier)` by rw[cogen_def] >>
14443  `Z.sum.op (Z.sum.inv x) (cogen Z.sum (Z* n).sum (coset Z.sum x (Z* n).sum.carrier)) IN (Z* n).sum.carrier` by rw[GSYM subgroup_coset_eq] >>
14444  `Z.sum = Z_add` by rw[Z_def] >>
14445  `(Z* n).sum.carrier = Z_multiple n` by rw[Z_ideal_def] >>
14446  qabbrev_tac `m = (cogen Z.sum (Z* n).sum (coset Z.sum x (Z* n).sum.carrier))` >>
14447  `Z_add.op (- x) m IN Z_multiple n` by metis_tac[Z_add_inv] >>
14448  `Z_add.op (- x) m = (- x) + m` by rw[Z_add_def] >>
14449  `!y. y IN Z_multiple n ==> ?k. y = &n * k` by rw[Z_multiple_def] >>
14450  `?k. -x + m = &n * k` by metis_tac[] >>
14451  `x + &n * k = x + (-x + m)` by rw[] >>
14452  `_ = (x + -x) + m` by rw[INT_ADD_ASSOC] >>
14453  `_ = m` by rw[] >>
14454  metis_tac[]
14455QED
14456
14457(* Theorem: coset Z.sum p (Z* n).sum.carrier = coset Z.sum (p % &n) (Z* n).sum.carrier *)
14458(* Proof:
14459   Since (Z* n).sum <= Z.sum   by Z_ideal_sum_subgroup
14460   By subgroup_coset_eq, this is to show:
14461       Z.sum.op (Z.sum.inv (p % &n)) p IN (Z* n).sum.carrier
14462   or  -(p % &n) + p IN Z_multiple n
14463     -(p % &n) + p
14464   = -(p % &n) + ((p / &n) * &n + p % &n)   by INT_DIVISION
14465   = -(p % &n) + (p % &n + (p / &n) * &n)   by INT_ADD_COMM
14466   = -(p % &n) + p % &n + (p / &n) * &n     by INT_ADD_ASSOC
14467   = (p / &n) * &n                          by INT_ADD_LINV, INT_ADD_LID
14468   = &n * (p / &n)                          by INT_MUL_COMM
14469   hence in Z_multiple n.
14470*)
14471Theorem Z_sum_coset_eq:
14472    !n. 0 < n ==> !p. coset Z.sum p (Z* n).sum.carrier = coset Z.sum (p % &n) (Z* n).sum.carrier
14473Proof
14474  rpt strip_tac >>
14475  `n <> 0` by decide_tac >>
14476  `&n <> (0 :int)` by rw[INT_INJ] >>
14477  `(Z* n).sum <= Z.sum` by rw[Z_ideal_sum_subgroup] >>
14478  `p IN Z.sum.carrier /\ p % &n IN Z.sum.carrier` by rw[Z_def, Z_add_def] >>
14479  `Z.sum.op (Z.sum.inv (p % &n)) p IN (Z* n).sum.carrier` suffices_by rw[subgroup_coset_eq] >>
14480  `Z.sum = Z_add` by rw[Z_def] >>
14481  `Z.sum.op (- (p % &n)) p IN (Z* n).sum.carrier` suffices_by metis_tac[Z_add_inv] >>
14482  `-(p % &n) + p IN Z_multiple n` suffices_by rw_tac std_ss[Z_def, Z_add_def, Z_ideal_def] >>
14483  `-(p % &n) + p = -(p % &n) + ((p / &n) * &n + p % &n)` by metis_tac[INT_DIVISION] >>
14484  `_ = -(p % &n) + (p % &n + (p / &n) * &n)` by rw[INT_ADD_COMM] >>
14485  `_ = -(p % &n) + p % &n + (p / &n) * &n` by rw[INT_ADD_ASSOC] >>
14486  `_ = (p / &n) * &n` by rw[INT_ADD_LINV, INT_ADD_LID] >>
14487  `_ = &n * (p / &n)` by rw[INT_MUL_COMM] >>
14488  rw[Z_multiple_def]
14489QED
14490
14491(* Theorem: x < n /\ y < n /\ -&x + &y IN Z_multiple n ==> (x = y) *)
14492(* Proof:
14493   By Z_multiple_def, this is to show:
14494      -&x + &y = &n * z ==> x = y
14495   or  &y = &n * z + &x ==> x = y
14496   If z = 0,
14497      &y = &n * z + &x
14498         = 0 + &x         by INT_MUL_RZERO
14499         = &x             by INT_ADD_LID
14500      hence y = x         by INT_INJ
14501   If z < 0,
14502      z < -1 + 1          by INT_ADD_LINV, -1 + 1 = 0
14503   or z <= -1             by INT_LE_LT1
14504   &n * z <= &n * -1      by INT_LE_MONO
14505           = - &n         by INT_NEG_RMUL, INT_MUL_RID
14506   Now
14507    x < n means &x < &n    by INT_INJ
14508   i.e. -&n < -&x          by INT_LT_NEG
14509   Combining inequalities,
14510      &n * z <= -&n < -&x  by INT_LET_TRANS
14511      &n * z < 0 - &x      by INT_SUB_LZERO
14512   or &n * z + &x < 0      by INT_LT_SUB_LADD
14513   i.e.        &y < 0
14514   which contradicts ~(y < 0), y being :num.
14515   If z > 0,
14516      0 < z
14517   or 1 - 1 < z            by INT_SUB_REFL
14518   or 1 < z + 1            by INT_LT_SUB_RADD
14519   or 1 <= z               by INT_LE_LT1
14520      &n * 1 <= &n * z     by INT_LE_MONO
14521          &n <= &n * z     by INT_MUL_RID
14522     &n + &x <= &y         by INT_LE_RADD
14523   Now
14524     &n <= &n + &x
14525   Combining inequalities
14526     &n <= &y              by INT_LE_TRANS
14527      n <= y               by INT_LE
14528   but this contradicts y < n
14529*)
14530Theorem Z_multiple_less_neg_eq:
14531    !n x y. 0 < n /\ x < n /\ y < n /\ -&x + &y IN Z_multiple n ==> (x = y)
14532Proof
14533  rw[Z_multiple_def] >>
14534  `-&x + &y + &x = &n * z + &x` by rw[] >>
14535  `--&x = &x` by rw[INT_NEGNEG] >>
14536  `&y = &n * z + &x` by metis_tac[INT_ADD_SUB, int_sub] >>
14537  Cases_on `z = 0` >| [
14538    `&y = (&x) :int` by metis_tac[INT_MUL_RZERO, INT_ADD_LID] >>
14539    metis_tac[INT_INJ],
14540    Cases_on `z < 0` >| [
14541      `z < -1 + 1` by rw[INT_ADD_LINV] >>
14542      `z <= -1` by rw[INT_LE_LT1] >>
14543      `&n * z <= &n * -1` by rw[INT_LE_MONO] >>
14544      `&n * z <= - (&n * 1)` by rw[INT_NEG_RMUL] >>
14545      `&n * z <= - &n` by metis_tac[INT_MUL_RID] >>
14546      `- &n < - &x` by rw[] >>
14547      `&n * z < - &x` by metis_tac[INT_LET_TRANS] >>
14548      `&n * z < 0 - &x` by rw[INT_SUB_LZERO] >>
14549      `&n * z + &x < 0` by rw[GSYM INT_LT_SUB_LADD] >>
14550      `y < 0` by metis_tac[INT_LT] >>
14551      decide_tac,
14552      `0 <= z` by rw[GSYM INT_NOT_LT] >>
14553      `0 < z` by metis_tac[INT_LE_LT] >>
14554      `1 - 1 < z` by rw[INT_SUB_REFL] >>
14555      `1 < z + 1` by rw[INT_LT_SUB_RADD] >>
14556      `1 <= z` by rw[INT_LE_LT1] >>
14557      `&n * 1 <= &n * z` by rw[INT_LE_MONO] >>
14558      `&n <= &n * z` by metis_tac[INT_MUL_RID] >>
14559      `&n + &x <= (&y) :int` by rw[INT_LE_RADD] >>
14560      `&n <= &n + (&x) :int` by rw[] >>
14561      `&n <= (&y) :int` by metis_tac[INT_LE_TRANS] >>
14562      `n <= y` by rw[GSYM INT_LE] >>
14563      decide_tac
14564    ]
14565  ]
14566QED
14567
14568(* Theorem: j IN (ZN n).carrier ==> coset Z.sum (&j) (Z* n).sum.carrier IN (Z / Z* n).carrier *)
14569(* Proof: by definitions,
14570   this is to show: 0 < n /\ j < n ==>
14571   ?x. IMAGE (\z. &j + z) (Z_multiple n) = {y | ?z. (y = x + z) /\ z IN Z_multiple n}
14572   Just take x = &j.
14573*)
14574Theorem Z_ideal_map_element:
14575    !n j. 0 < n /\ j IN (ZN n).carrier ==> coset Z.sum (&j) (Z* n).sum.carrier IN (Z / Z* n).carrier
14576Proof
14577  rw_tac std_ss[quotient_ring_def, coset_def, ZN_def, Z_ideal_def, Z_def, Z_add_def,
14578     CosetPartition_def, partition_def, inCoset_def, IN_COUNT] >>
14579  rw[] >>
14580  qexists_tac `&j` >>
14581  rw[EXTENSION]
14582QED
14583
14584(* Theorem: GroupHomo (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).sum (Z / Z* n).sum *)
14585(* Proof: by GroupHomo_def, this is to show
14586   (1) j IN (ZN n).sum.carrier ==> coset Z.sum (&j) (Z* n).sum.carrier IN (Z / Z* n).sum.carrier
14587       Since
14588       (ZN n).sum.carrier = (ZN n).carrier         by Ring_def, and Ring (ZN n)        by ZN_ring
14589       (Z / Z* n).sum.carrier = (Z / Z* n).carrier by Ring_def, and Ring (Z / (Z* n))  by quotient_ring_ring
14590       Hence true by Z_ideal_map_element.
14591   (2) j IN (ZN n).sum.carrier /\ j' IN (ZN n).sum.carrier ==>
14592       coset Z.sum (&(ZN n).sum.op j j') (Z* n).sum.carrier =
14593       (Z / Z* n).sum.op (coset Z.sum (&j) (Z* n).sum.carrier) (coset Z.sum (&j') (Z* n).sum.carrier)
14594       After expanding by definitions, this is to show:
14595       coset Z.sum (&(ZN n).sum.op j j') (Z* n).sum.carrier =
14596       coset Z.sum (Z.sum.op (cogen Z.sum (Z* n).sum (coset Z.sum (&j) (Z* n).sum.carrier))
14597                             (cogen Z.sum (Z* n).sum (coset Z.sum (&j') (Z* n).sum.carrier))) (Z* n).carrier
14598       Since (Z* n).sum << Z.sum     by Z_ideal_sum_normal
14599       applying normal_coset_property:
14600       coset Z.sum (Z.sum.op (cogen Z.sum (Z* n).sum (coset Z.sum (&j) (Z* n).sum.carrier))
14601                             (cogen Z.sum (Z* n).sum (coset Z.sum (&j') (Z* n).sum.carrier))) (Z* n).carrier =
14602       coset Z.sum (Z.sum.op (&j) (&j')) (Z* n).sum.carrier
14603       So this is to show:
14604       coset Z.sum (Z.sum.op (&j) (&j')) (Z* n).sum.carrier = coset Z.sum (&(ZN n).sum.op j j') (Z* n).sum.carrier
14605       By subgroup_coset_eq, this is to show:
14606       Z.sum.op (Z.sum.inv (Z.sum.op (&j) (&j'))) (&(ZN n).sum.op j j') IN  (Z* n).sum.carrier
14607       or  -(&j + &j') + &((j + j') MOD n) IN Z_multiple n
14608         -(&j + &j') + &((j + j') MOD n)
14609       = -&(j + j') + &((j + j') MOD n)     by INT_ADD
14610       = -&(j + j') + &(j + j') % &n        by INT_MOD
14611       = -((&(j + j') / &n) * &n + (&(j + j') % &n)) + (&(j + j') % &n)   by INT_DIVISION
14612       = -((&(j + j') / &n) * &n) - (&(j + j') % &n) + (&(j + j') % &n)   by INT_SUB_LNEG
14613       = -((&(j + j') / &n) * &n)           by INT_SUB_ADD
14614       = -(&(j + j') / &n) * &n             by INT_NEG_LMUL
14615       = &n * -(&(j + j') / &n)             by INT_MUL_COMM]
14616       Hence in Z_multiple n.
14617*)
14618Theorem Z_ideal_map_group_homo:
14619    !n. 0 < n ==> GroupHomo (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).sum (Z / Z* n).sum
14620Proof
14621  rpt strip_tac >>
14622  `!r. Ring r ==> (r.sum.carrier = R)` by rw_tac std_ss[Ring_def] >>
14623  rw[GroupHomo_def] >| [
14624    `Ring (ZN n)` by rw[ZN_ring] >>
14625    `(Z* n) << Z` by rw[Z_ideal_thm] >>
14626    `Ring Z` by rw[Z_ring] >>
14627    `Ring (Z / (Z* n))` by rw[quotient_ring_ring] >>
14628    `(ZN n).sum.carrier = (ZN n).carrier` by rw[] >>
14629    `(Z / Z* n).sum.carrier = (Z / Z* n).carrier` by rw[] >>
14630    metis_tac[Z_ideal_map_element],
14631    rw[quotient_ring_def, quotient_ring_add_def] >>
14632    `(Z* n).sum << Z.sum` by rw[Z_ideal_sum_normal] >>
14633    `Ring Z` by rw[Z_ring] >>
14634    `Ring (ZN n)` by rw[ZN_ring] >>
14635    `(ZN n).sum.carrier = (ZN n).carrier` by rw[] >>
14636    `Z.sum.carrier = Z.carrier` by rw[] >>
14637    `!k. k IN (ZN n).carrier ==> &k IN Z.carrier` by rw[ZN_def, Z_def] >>
14638    `&j IN Z.sum.carrier /\ &j' IN Z.sum.carrier` by metis_tac[] >>
14639    `(Z* n).carrier = (Z* n).sum.carrier` by rw[Z_ideal_def] >>
14640    `coset Z.sum (Z.sum.op (cogen Z.sum (Z* n).sum (coset Z.sum (&j) (Z* n).sum.carrier))
14641                          (cogen Z.sum (Z* n).sum (coset Z.sum (&j') (Z* n).sum.carrier))) (Z* n).carrier =
14642    coset Z.sum (Z.sum.op (&j) (&j')) (Z* n).sum.carrier` by rw[normal_coset_property] >>
14643    `coset Z.sum (Z.sum.op (&j) (&j')) (Z* n).sum.carrier =
14644     coset Z.sum (&(ZN n).sum.op j j') (Z* n).sum.carrier` suffices_by rw[] >>
14645    `(Z* n).sum <= Z.sum` by rw[Z_ideal_sum_subgroup] >>
14646    `(Z.sum.op (&j) (&j')) IN Z.sum.carrier` by rw[ring_add_group] >>
14647    `&(ZN n).sum.op j j' IN Z.sum.carrier` by rw[Z_def] >>
14648    `Z.sum.op (Z.sum.inv (Z.sum.op (&j) (&j'))) (&(ZN n).sum.op j j') IN  (Z* n).sum.carrier`
14649      suffices_by metis_tac[subgroup_coset_eq] >>
14650    pop_assum mp_tac >>
14651    pop_assum mp_tac >>
14652    `(Z.sum = Z_add)` by rw[Z_def] >>
14653    `Z.sum.op (&j) (&j') IN Z_add.carrier` by rw[Z_def, Z_add_def] >>
14654    `Z.sum.op (&j) (&j') IN Z.sum.carrier ==>
14655    &(ZN n).sum.op j j' IN Z.sum.carrier ==>
14656    Z.sum.op (-(Z.sum.op (&j) (&j'))) (&(ZN n).sum.op j j') IN (Z* n).sum.carrier` suffices_by metis_tac[Z_add_inv] >>
14657    rw_tac std_ss[Z_def, Z_add_def, ZN_def, add_mod_def, Z_ideal_def] >>
14658    `n <> 0` by decide_tac >>
14659    `-(&j + &j') + &((j + j') MOD n) = -&(j + j') + &((j + j') MOD n)` by rw[INT_ADD] >>
14660    `_ = -&(j + j') + &(j + j') % &n` by rw[INT_MOD] >>
14661    `_ = -((&(j + j') / &n) * &n + (&(j + j') % &n)) + (&(j + j') % &n)` by rw[INT_DIVISION] >>
14662    `_ = -((&(j + j') / &n) * &n) - (&(j + j') % &n) + (&(j + j') % &n)` by rw[INT_SUB_LNEG] >>
14663    `_ = -((&(j + j') / &n) * &n)` by rw[INT_SUB_ADD] >>
14664    `_ = -(&(j + j') / &n) * &n` by rw[INT_NEG_LMUL] >>
14665    `_ = &n * -(&(j + j') / &n)` by rw[INT_MUL_COMM] >>
14666    rw[Z_multiple_def]
14667  ]
14668QED
14669
14670(* Theorem: MonoidHomo (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).prod (Z / Z* n).prod *)
14671(* Proof: by MonoidHomo_def, this is to show:
14672   (1) j IN (ZN n).prod.carrier ==> coset Z.sum (&j) (Z* n).sum.carrier IN (Z / Z* n).prod.carrier
14673       Since (ZN n).prod.carrier = (ZN n).carrier          by Ring_def
14674             (Z / Z* n).prod.carrier = (Z / Z* n).carrier  by Ring_def
14675       true by Z_ideal_map_element.
14676   (2) j IN (ZN n).prod.carrier /\ j' IN (ZN n).prod.carrier ==>
14677       coset Z.sum (&(ZN n).prod.op j j') (Z* n).sum.carrier =
14678       (Z / Z* n).prod.op (coset Z.sum (&j) (Z* n).sum.carrier) (coset Z.sum (&j') (Z* n).sum.carrier)
14679       Since (Z* n).sum <= Z.sum    by Z_ideal_sum_subgroup
14680       and   ?k. cogen Z.sum (Z* n).sum (coset Z.sum (&j) (Z* n).sum.carrier) = &j + &n * k      by Z_sum_cogen
14681       and   ?k'. cogen Z.sum (Z* n).sum (coset Z.sum (&j') (Z* n).sum.carrier) = &j' + &n * k'  by Z_sum_cogen
14682       By subgroup_coset_eq, this reduces to:
14683       Z.sum.op (Z.sum.inv (&(ZN n).prod.op j j')) (Z.prod.op (&j + &n * k) (&j' + &n * k')) IN (Z* n).sum.carrier
14684       Now (Z* n).sum.carrier = (Z* n).carrier = Z_multiple n,
14685         Z.prod.op (&j + &n * k) (&j' + &n * k')
14686       = (&j + &n * k) * (&j' + &n * k')
14687       = (&j) * (&j') + &n * h   for some h, by INT_LDISTRIB
14688       = &(j * j') + &n * h      by INT_MUL
14689       Hence the difference with &(ZN n).prod.op j j') = &((j * j') MOD n) = &(j * j') % &n
14690       is a multiple of n, i.e. in (Z* n).sum.carrier.
14691   (3) coset Z.sum (&(ZN n).prod.id) (Z* n).sum.carrier = (Z / Z* n).prod.id
14692       Since (Z* n).sum <= Z.sum     by Z_ideal_sum_subgroup
14693       expand by definition, this is to show:
14694       coset Z.sum (&(ZN n).prod.id) (Z* n).sum.carrier = coset Z.sum Z.prod.id (Z* n).carrier
14695       and by subgroup_coset_eq, this is to show:
14696       Z.sum.op (- Z.prod.id) (&(ZN n).prod.id) IN (Z* n).sum.carrier
14697       or    - 1 + &(ZN n).prod.id IN (Z* n).sum.carrier
14698       Since (ZN n).prod.id = if n = 1 then 0 else 1, two cases:
14699       If n = 1, to show -1 in (Z* 1).sum.carrier = Z_multiple 1, true.
14700       If n <> 1, to show 0 in (Z* n).sum.carrier = Z_multiple n, true.
14701*)
14702Theorem Z_ideal_map_monoid_homo:
14703    !n. 0 < n ==> MonoidHomo (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).prod (Z / Z* n).prod
14704Proof
14705  rpt strip_tac >>
14706  rw[MonoidHomo_def] >| [
14707    `Ring (ZN n)` by rw[ZN_ring] >>
14708    `(Z* n) << Z` by rw[Z_ideal_thm] >>
14709    `Ring Z` by rw[Z_ring] >>
14710    `Ring (Z / (Z* n))` by rw[quotient_ring_ring] >>
14711    `(ZN n).prod.carrier = (ZN n).carrier` by metis_tac[Ring_def] >>
14712    `(Z / Z* n).prod.carrier = (Z / Z* n).carrier` by metis_tac[Ring_def] >>
14713    `(ZN n).sum.carrier = (ZN n).carrier` by metis_tac[Ring_def] >>
14714    metis_tac[Z_ideal_map_element],
14715    rw[quotient_ring_def, quotient_ring_mult_def] >>
14716    `(Z* n).sum <= Z.sum` by rw[Z_ideal_sum_subgroup] >>
14717    `&j IN Z.sum.carrier /\ &j' IN Z.sum.carrier` by rw[Z_def, Z_add_def] >>
14718    `?k. cogen Z.sum (Z* n).sum (coset Z.sum (&j) (Z* n).sum.carrier) = &j + &n * k` by rw[Z_sum_cogen] >>
14719    `?k'. cogen Z.sum (Z* n).sum (coset Z.sum (&j') (Z* n).sum.carrier) = &j' + &n * k'` by rw[Z_sum_cogen] >>
14720    `(Z* n).sum.carrier = (Z* n).carrier` by rw[Z_ideal_def] >>
14721    `coset Z.sum (&(ZN n).prod.op j j') (Z* n).sum.carrier =
14722     coset Z.sum (Z.prod.op (&j + &n * k) (&j' + &n * k')) (Z* n).sum.carrier` suffices_by metis_tac[] >>
14723    `&(ZN n).prod.op j j' IN Z.sum.carrier` by rw[Z_def, Z_add_def] >>
14724    `Z.prod.op (&j + &n * k) (&j' + &n * k') IN Z.sum.carrier` by rw[Z_def, Z_add_def] >>
14725    `Z.sum.op (Z.sum.inv (&(ZN n).prod.op j j')) (Z.prod.op (&j + &n * k) (&j' + &n * k')) IN (Z* n).sum.carrier`
14726      suffices_by rw[GSYM subgroup_coset_eq] >>
14727    `Z.sum = Z_add` by rw[Z_def] >>
14728    `Z.sum.op (- (&(ZN n).prod.op j j')) (Z.prod.op (&j + &n * k) (&j' + &n * k')) IN (Z* n).sum.carrier`
14729      suffices_by metis_tac[Z_add_inv] >>
14730    rw_tac std_ss[Z_def, Z_add_def, Z_mult_def, ZN_def, times_mod_def, Z_ideal_def] >>
14731    `n <> 0` by decide_tac >>
14732    `-&((j * j') MOD n) + (&j + &n * k) * (&j' + &n * k') = -(&(j * j') % &n) + (&j + &n * k) * (&j' + &n * k')` by rw[INT_MOD] >>
14733    `_ = -(&(j * j') % &n) + (&j * (&j' + &n * k') + &n * k * (&j' + &n * k'))` by rw[INT_RDISTRIB] >>
14734    `_ = -(&(j * j') % &n) + (&j * &j' + &j * (&n * k') + &n * k * (&j' + &n * k'))` by rw[INT_LDISTRIB] >>
14735    `_ = -(&(j * j') % &n) + (&j * &j' + &n * k' * &j + &n * k * (&j' + &n * k'))` by rw[INT_MUL_COMM] >>
14736    `_ = -(&(j * j') % &n) + (&j * &j' + (&n * k' * &j + &n * k * (&j' + &n * k')))` by rw[INT_ADD_ASSOC] >>
14737    `_ = -(&(j * j') % &n) + (&j * &j' + (&n * (k' * &j) + &n * (k * (&j' + &n * k'))))` by rw[INT_MUL_ASSOC] >>
14738    `_ = -(&(j * j') % &n) + (&j * &j' + &n * (k' * &j + k * (&j' + &n * k')))` by rw[GSYM INT_LDISTRIB] >>
14739    `_ = -(&(j * j') % &n) + &j * &j' + &n * (k' * &j + k * (&j' + &n * k'))` by rw[INT_ADD_ASSOC] >>
14740    `_ = -(&(j * j') % &n) + &(j * j') + &n * (k' * &j + k * (&j' + &n * k'))` by rw[INT_MUL] >>
14741    `_ = -(&(j * j') % &n) + (&(j * j') / &n * &n + &(j * j') % &n) + &n * (k' * &j + k * (&j' + &n * k'))` by rw[INT_DIVISION] >>
14742    `_ = -(&(j * j') % &n) + (&(j * j') % &n + &(j * j') / &n * &n) + &n * (k' * &j + k * (&j' + &n * k'))` by rw[INT_ADD_COMM] >>
14743    `_ = -(&(j * j') % &n) + &(j * j') % &n + &(j * j') / &n * &n + &n * (k' * &j + k * (&j' + &n * k'))` by rw[INT_ADD_ASSOC] >>
14744    `_ = &(j * j') / &n * &n + &n * (k' * &j + k * (&j' + &n * k'))` by rw[INT_ADD_LINV] >>
14745    `_ = &n * (&(j * j') / &n) + &n * (k' * &j + k * (&j' + &n * k'))` by rw[INT_MUL_COMM] >>
14746    `_ = &n * (&(j * j') / &n + (k' * &j + k * (&j' + &n * k')))` by rw[INT_LDISTRIB] >>
14747    rw[Z_multiple_def],
14748    rw[quotient_ring_def, quotient_ring_mult_def] >>
14749    `(Z* n).sum <= Z.sum` by rw[Z_ideal_sum_subgroup] >>
14750    `(Z* n).sum.carrier = (Z* n).carrier` by rw[Z_ideal_def] >>
14751    `&(ZN n).prod.id IN Z.sum.carrier` by rw[Z_def, Z_add_def, ZN_def, times_mod_def] >>
14752    `Z.prod.id IN Z.sum.carrier` by rw[Z_def, Z_add_def, Z_mult_def] >>
14753    `Z.sum.op (Z.sum.inv Z.prod.id) &(ZN n).prod.id IN (Z* n).sum.carrier` suffices_by rw[GSYM subgroup_coset_eq] >>
14754    `Z.sum = Z_add` by rw[Z_def] >>
14755    `Z.sum.op (- Z.prod.id) (&(ZN n).prod.id) IN (Z* n).sum.carrier` suffices_by metis_tac[Z_add_inv] >>
14756    `n <> 0` by decide_tac >>
14757    rw[Z_def, Z_add_def, Z_mult_def, ZN_def, times_mod_def] >-
14758    rw[Z_ideal_def, Z_multiple_def] >>
14759    rw[Z_ideal_def, Z_multiple_def]
14760  ]
14761QED
14762
14763(* Theorem: BIJ (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).carrier (Z / Z* n).carrier *)
14764(* Proof:
14765   (1) j IN (ZN n).carrier ==> coset Z.sum (&j) (Z* n).sum.carrier IN (Z / Z* n).carrier
14766       true by Z_ideal_map_element.
14767   (2) coset Z.sum (&j) (Z* n).sum.carrier = coset Z.sum (&j') (Z* n).sum.carrier ==> j = j'
14768       &j - &j' = multiple of n, but j < n and j' < n, hence j = j'.
14769       true by Z_multiple_less_neg_eq.
14770   (3) same as (1)
14771   (4) x IN (Z / Z* n).carrier ==> ?j. j IN (ZN n).carrier /\ (coset Z.sum (&j) (Z* n).sum.carrier = x)
14772       Expanding by definition, this is to show:
14773       x IN CosetPartition Z.sum (Z* n).sum ==> ?j. j IN (ZN n).carrier /\ (coset Z.sum (&j) (Z* n).sum.carrier = x)
14774       Let p = (cogen Z.sum (Z* n).sum x, then
14775            p IN Z.sum.carrier     by cogen_element
14776       thus p IN univ(:int)        by Z_def, Z_add_def
14777       By coset_cogen_property, we have:  coset Z.sum p (Z* n).sum.carrier = x
14778       So it is just choosing j, depending on p, to satisfy: j IN (ZN n).carrier
14779       If p = 0, take j = 0, then 0 IN (ZN n).carrier,
14780       If p <> 0, since by Z_sum_coset_eq,
14781          coset Z.sum p (Z* n).sum.carrier = coset Z.sum (p % &n) (Z* n).sum.carrier
14782       If p > 0, choose j = p MOD n,
14783       then &j = &(p MOD n) = &p % &n, so true by INT_MOD
14784       If p < 0, choose j = (n + (p MOD n)) MOD n,
14785       then &j = &((n + (p MOD n)) MOD n)
14786               = &(n + (p MOD n)) % &n      by INT_MOD
14787               = (&n % &n + &(p MOD n) % &n) % &n   by INT_ADD
14788               = &(p MOD n)                 by INT_MOD_ID, INT_MOD_MOD
14789               = &p % &n                    by INT_MOD
14790*)
14791Theorem Z_ideal_map_bij:
14792    !n. 0 < n ==> BIJ (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).carrier (Z / Z* n).carrier
14793Proof
14794  rw[BIJ_DEF, INJ_DEF, SURJ_DEF] >| [
14795    rw[Z_ideal_map_element],
14796    `(Z* n).sum <= Z.sum` by rw[Z_ideal_sum_subgroup] >>
14797    `&j IN Z.sum.carrier` by rw[Z_def, Z_add_def] >>
14798    `&j' IN Z.sum.carrier` by rw[Z_def, Z_add_def] >>
14799    `Z.sum.op (Z.sum.inv &j) &j' IN (Z* n).sum.carrier` by rw[GSYM subgroup_coset_eq] >>
14800    `Z.sum = Z_add` by rw[Z_def] >>
14801    `Z.sum.op (- &j) &j' IN (Z* n).sum.carrier` by metis_tac[Z_add_inv] >>
14802    `(Z* n).sum.carrier = Z_multiple n` by rw[Z_ideal_def] >>
14803    `!x y. Z.sum.op x y = x + y` by rw[Z_def, Z_add_def] >>
14804    `(- &j) +  &j' IN Z_multiple n` by metis_tac[] >>
14805    `!x. x IN (ZN n).carrier ==> x < n` by rw[ZN_def] >>
14806    metis_tac[Z_multiple_less_neg_eq],
14807    rw[Z_ideal_map_element],
14808    pop_assum mp_tac >>
14809    rw[quotient_ring_def, quotient_ring_mult_def] >>
14810    `(Z* n).sum <= Z.sum` by rw[Z_ideal_sum_subgroup] >>
14811    `(cogen Z.sum (Z* n).sum x) IN Z.sum.carrier` by rw[cogen_element] >>
14812    `(cogen Z.sum (Z* n).sum x) IN univ(:int)` by rw[Z_def, Z_add_def] >>
14813    qabbrev_tac `p = (cogen Z.sum (Z* n).sum x)` >>
14814    `coset Z.sum p (Z* n).sum.carrier = x` by rw[coset_cogen_property, Abbr`p`] >>
14815    `!x. x IN (ZN n).carrier <=> x < n` by rw[ZN_def] >>
14816    Cases_on `p = 0` >| [
14817      qexists_tac `0` >>
14818      rw[],
14819      `n <> 0` by decide_tac >>
14820      `&n <> 0` by rw[INT_INJ] >>
14821      `coset Z.sum p (Z* n).sum.carrier = coset Z.sum (p % &n) (Z* n).sum.carrier` by rw[GSYM Z_sum_coset_eq] >>
14822      Cases_on `0 <= p` >| [
14823        `?k. p = &k` by metis_tac[NUM_POSINT] >>
14824        qexists_tac `k MOD n` >>
14825        rw[MOD_LESS, INT_MOD],
14826        `p < 0` by rw[GSYM INT_NOT_LE] >>
14827        `?k. p = -&k` by metis_tac[NUM_NEGINT_EXISTS, INT_LT_IMP_LE] >>
14828        `k MOD n < n` by rw[MOD_LESS] >>
14829        `p % &n = (- &k) % &n` by rw[] >>
14830        `_ = (&n - &k) % &n` by rw[INT_MOD_NEG_NUMERATOR] >>
14831        `_ = (&n % &n - &k % &n) % &n` by rw[INT_MOD_SUB] >>
14832        `_ = (&n % &n - &k % &n % &n) % &n` by rw[INT_MOD_MOD] >>
14833        `_ = (&n % &n - &(k MOD n) % &n) % &n` by rw[INT_MOD] >>
14834        `_ = (&n  - &(k MOD n)) % &n` by rw[INT_MOD_SUB] >>
14835        `_ = &(n - k MOD n) % &n` by rw[INT_SUB, LESS_IMP_LESS_OR_EQ] >>
14836        `_ = &((n - k MOD n) MOD n)` by rw[INT_MOD] >>
14837        qexists_tac `(n - k MOD n) MOD n` >>
14838        rw[MOD_LESS]
14839      ]
14840    ]
14841  ]
14842QED
14843
14844(* Theorem: (ZN n) isomorphic to Z / (Z* n) *)
14845(* Proof:
14846   The bijection is: j IN (ZN n) -> coset (Z* n).sum (&j) (Z* n).sum.carrier
14847   where (Z* n).sum.carrier = Z_multiple n
14848   (1) j IN (ZN n).carrier ==> coset Z.sum (&j) (Z* n).sum.carrier IN (Z / Z* n).carrier
14849       true by Z_ideal_map_element.
14850   (2) GroupHomo (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).sum (Z / Z* n).sum
14851       true by Z_ideal_map_group_homo.
14852   (3) MonoidHomo (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).prod (Z / Z* n).prod
14853       true by Z_ideal_map_monoid_homo.
14854   (4) BIJ (\j. coset Z.sum (&j) (Z* n).sum.carrier) (ZN n).carrier (Z / Z* n).carrier
14855       true by Z_ideal_map_bij.
14856*)
14857Theorem Z_quotient_iso_ZN:
14858    !n. 0 < n ==> RingIso (\(j:num). coset Z.sum (&j) (Z* n).sum.carrier) (ZN n) (Z / (Z* n))
14859Proof
14860  rw[RingIso_def, RingHomo_def] >-
14861  rw[Z_ideal_map_element] >-
14862  rw[Z_ideal_map_group_homo] >-
14863  rw[Z_ideal_map_monoid_homo] >>
14864  rw[Z_ideal_map_bij]
14865QED
14866
14867(* ------------------------------------------------------------------------- *)
14868(* Integer as Euclidean Ring.                                                *)
14869(* ------------------------------------------------------------------------- *)
14870
14871(* Theorem: EuclideanRing Z *)
14872(* Proof:
14873   By EuclideanRing_def, this is to show:
14874   (1) Ring Z, true       by Z_ring
14875   (2) (Num (ABS x) = 0) <=> (x = 0)
14876       If part: Num (ABS x) = 0 ==> x = 0
14877       If ABS x = &n, n <> 0, Num (&n) = n  by NUM_OF_INT, or n = 0, contradicts n <> 0.
14878       If ABS x = -&n, n <> 0, then -&n < 0, contradicts ~(ABS x < 0) by INT_ABS_LT0.
14879       If ABS x = 0, this means ABS x <= 0, hence x = 0 by INT_ABS_LE0.
14880       Only-if part: x = 0 ==> Num (ABS x) = 0
14881       i.e to show: Num (ABS 0) = 0
14882         Num (ABS 0)
14883       = Num 0            by INT_ABS_EQ0, ABS 0 = 0
14884       = 0                by NUM_OF_INT, Num (&n) = n
14885   (3) !x y. y <> 0 ==> ?q t. (x = q * y + t) /\ Num (ABS t) < Num (ABS y)
14886       Let q = x / y, t = x % y.
14887       Then by INT_DIVISION,
14888       (x = q * y + t) /\ if y < 0 then (y < t /\ t <= 0) else (0 <= t /\ t < y)
14889       If y = &n, n <> 0, then ~(y < 0), hence 0 <= t /\ t < y
14890       0 <= t ==> ?k. t = &k       by NUM_POSINT
14891       So   Num (ABS t) = k        by INT_ABS_NUM, NUM_OF_INT
14892       and  Num (ABS y) = n        by INT_ABS_NUM, NUM_OF_INT
14893       and  &k < &n ==> k < n      by INT_LT
14894       If y = -&n, n <> 0, then y < 0, hence y < t /\ t <= 0
14895       t <= 0 ==> ?k. t = -&k      by NUM_NEGINT_EXISTS
14896       But  Num (ABS t) = k        by INT_ABS_NEG, INT_ABS_NUM, NUM_OF_INT
14897       and  Num (ABS y) = n        by INT_ABS_NEG, INT_ABS_NUM, NUM_OF_INT
14898       and  -&n < -&k
14899         ==> &k < &n               by INT_LT_CALCULATE
14900         ==> k < n                 by INT_LT (or INT_LT_CALCULATE)
14901*)
14902
14903Theorem Z_euclid_ring: EuclideanRing Z Num
14904Proof
14905  rw[EuclideanRing_def]
14906  >- rw[Z_ring]
14907  >- rw[Z_def, Z_add_def] >>
14908  pop_assum mp_tac >>
14909  pop_assum mp_tac >>
14910  pop_assum mp_tac >>
14911  rw[Z_def, Z_add_def, Z_mult_def] >>
14912  qexists_tac ‘x / y’ >>
14913  qexists_tac ‘x % y’ >>
14914  ‘(x = x / y * y + x % y) /\
14915   if y < 0 then (y < x % y /\ x % y <= 0) else (0 <= x % y /\ x % y < y)’
14916    by rw[INT_DIVISION] >>
14917  qabbrev_tac ‘q = x / y’ >>
14918  qabbrev_tac ‘t = x % y’ >>
14919  ‘(?n. (y = &n) /\ n <> 0) \/ (?n. (y = -&n) /\ n <> 0) \/ (y = 0)’
14920    by rw[INT_NUM_CASES]
14921  >- (‘~(y < 0)’ by rw[] >>
14922      ‘0 <= t /\ t < y’ by metis_tac[] >>
14923      ‘?k. t = &k’ by metis_tac[NUM_POSINT] >>
14924      gvs[]) >>
14925  ‘y < 0’ by rw[] >>
14926  ‘y < t /\ t <= 0’ by metis_tac[] >>
14927  ‘?k. t = -&k’ by metis_tac[NUM_NEGINT_EXISTS] >>
14928  gvs[]
14929QED
14930
14931(* Theorem: PrincipalIdealRing Z *)
14932(* Proof:
14933   Since EuclideanRing Z (Num o ABS)   by Z_euclid_ring
14934   hence PrincipalIdealRing Z          by euclid_ring_principal_ideal_ring
14935*)
14936Theorem Z_principal_ideal_ring:
14937    PrincipalIdealRing Z
14938Proof
14939  metis_tac[Z_euclid_ring, euclid_ring_principal_ideal_ring]
14940QED
14941
14942(* ------------------------------------------------------------------------- *)
14943(* Integral Domain Documentation                                             *)
14944(* ------------------------------------------------------------------------- *)
14945(* An Integral Domains is a Ring with two additional properties:
14946   a. distinct identities: #1 <> #0
14947   b. no #0 divisors: x * y = #0 <=> x = 0 \/ y = 0
14948
14949   This implies:
14950   1. The nonzero elements are closed under (ring) multiplication,
14951      i.e. besides the multiplicative monoid with carrier = all elements,
14952      there is also a multiplicative monoid with carrier = nonzero elements.
14953   2. Every integral domain has at least two elements: #0 and #1.
14954      The smallest integral domain is isomorphic to Z_2 = {0, 1}.
14955      The typical integral domain is Z = {0, +/-1, +/-2, ... }
14956   3. Finite integral domains are (finite) fields:
14957      For any nonzero x, the sequence x, x^2, x^3, .... must wrap around, hence invertible.
14958*)
14959(* Data type:
14960   The generic symbol for ring data is r.
14961   r.carrier = Carrier set of Ring, overloaded as R.
14962   r.sum     = Addition component of Ring, binary operation overloaded as +.
14963   r.prod    = Multiplication component of Ring, binary operation overloaded as *.
14964
14965   Overloading:
14966   +    = r.sum.op
14967   #0   = r.sum.id
14968   ##   = r.sum.exp
14969   -    = r.sum.inv
14970
14971   *    = r.prod.op
14972   #1   = r.prod.id
14973   **   = r.prod.exp
14974
14975   R    = r.carrier
14976   R+   = ring_nonzero r
14977*)
14978(* Definitions and Theorems (# are exported):
14979
14980   Definitions:
14981   IntegralDomain_def       |- !r. IntegralDomain r <=>  Ring r /\ #1 <> #0 /\
14982                                                         !x y. x IN R /\ y IN R ==> ((x * y = #0) <=> (x = #0) \/ (y = #0))
14983   FiniteIntegralDomain_def |- !r. FiniteIntegralDomain r <=> IntegralDomain r /\ FINITE R
14984
14985   Simple theorems:
14986   integral_domain_is_ring       |- !r. IntegralDomain r ==> Ring r
14987#  integral_domain_one_ne_zero   |- !r. IntegralDomain r ==> #1 <> #0
14988   integral_domain_mult_eq_zero  |- !r. IntegralDomain r ==> !x y. x IN R /\ y IN R ==> ((x * y = #0) <=> (x = #0) \/ (y = #0))
14989   integral_domain_zero_product  |- !r. IntegralDomain r ==> !x y. x IN R /\ y IN R ==> ((x * y = #0) <=> (x = #0) \/ (y = #0))
14990   integral_domain_zero_not_unit |- !r. IntegralDomain r ==> #0 NOTIN R*
14991   integral_domain_one_nonzero   |- !r. IntegralDomain r ==> #1 IN R+
14992   integral_domain_mult_nonzero  |- !r. IntegralDomain r ==> !x y. x IN R+ /\ y IN R+ ==> x * y IN R+
14993   integral_domain_nonzero_mult_carrier  |- !r. IntegralDomain r ==> (F* = R+)
14994   integral_domain_nonzero_mult_property |- !r. IntegralDomain r ==> (F* = R+) /\ (f*.id = #1) /\
14995                                                                     (f*.op = $* ) /\ (f*.exp = $** )
14996   integral_domain_nonzero_monoid       |- !r. IntegralDomain r ==> Monoid f*
14997
14998   Left and Right Multiplicative Cancellation:
14999   integral_domain_mult_lcancel  |- !r. IntegralDomain r ==> !x y z. x IN R /\ y IN R /\ z IN R ==>
15000                                        ((x * y = x * z) <=> (x = #0) \/ (y = z))
15001   integral_domain_mult_rcancel  |- !r. IntegralDomain r ==> !x y z.  x IN R /\ y IN R /\ z IN R ==>
15002                                        ((y * x = z * x) <=> (x = #0) \/ (y = z))
15003
15004   Non-zero multiplications form a Monoid:
15005   monoid_of_ring_nonzero_mult_def         |- !r. monoid_of_ring_nonzero_mult r = <|carrier := R+; op := $*; id := #1|>
15006   integral_domain_nonzero_mult_is_monoid  |- !r. IntegralDomain r ==> Monoid (monoid_of_ring_nonzero_mult r)
15007
15008   Theorems from Ring exponentiation:
15009   integral_domain_exp_nonzero  |- !r. IntegralDomain r ==> !x. x IN R+ ==> !n. x ** n IN R+
15010   integral_domain_exp_eq_zero  |- !r. IntegralDomain r ==> !x. x IN R ==> !n. (x ** n = #0) <=> n <> 0 /\ (x = #0)
15011   integral_domain_exp_eq       |- !r. IntegralDomain r ==> !x. x IN R+ ==>
15012                                                            !m n. m < n /\ (x ** m = x ** n) ==> (x ** (n - m) = #1)
15013
15014   Finite Integral Domain:
15015   finite_integral_domain_period_exists
15016                                |- !r. FiniteIntegralDomain r ==> !x. x IN R+ ==> ?k. 0 < k /\ (x ** k = #1)
15017   finite_integral_domain_nonzero_invertible
15018                                |- !r. FiniteIntegralDomain r ==> (monoid_invertibles r.prod = R+ )
15019   finite_integral_domain_nonzero_invertible_alt
15020                                |- !r. FiniteIntegralDomain r ==> (monoid_invertibles f* = F* )
15021   finite_integral_domain_nonzero_group
15022                                |- !r. FiniteIntegralDomain r ==> Group f*
15023
15024   Integral Domain Element Order:
15025   integral_domain_nonzero_order  |- !r. IntegralDomain r ==> !x. order r.prod x = order f* x
15026   integral_domain_order_zero     |- !r. IntegralDomain r ==> (order f* #0 = 0)
15027   integral_domain_order_nonzero  |- !r. FiniteIntegralDomain r ==> !x. x IN R+ ==> order f* x <> 0
15028   integral_domain_order_eq_0     |- !r. FiniteIntegralDomain r ==> !x. x IN R ==> ((order f* x = 0) <=> (x = #0))
15029
15030   Integral Domain Characteristic:
15031   integral_domain_char         |- !r. IntegralDomain r ==> (char r = 0) \/ prime (char r)
15032
15033   Principal Ideals in Integral Domain:
15034   principal_ideal_equal_principal_ideal  |- !r. IntegralDomain r ==>
15035                                             !p q. p IN R /\ q IN R ==> ((<p> = <q>) <=> ?u. unit u /\ (p = q * u))
15036*)
15037(* ------------------------------------------------------------------------- *)
15038(* Basic Definitions                                                         *)
15039(* ------------------------------------------------------------------------- *)
15040
15041(* Integral Domain Definition:
15042   An Integral Domain is a record r with elements of type 'a ring, such that
15043   . r is a Ring
15044   . #1 <> #0
15045   . !x y IN R, x * y = #0 <=> x = #0 or y = #0
15046*)
15047Definition IntegralDomain_def:
15048  IntegralDomain (r:'a ring) <=>
15049    Ring r /\
15050    #1 <> #0 /\
15051    (!x y. x IN R /\ y IN R ==> ((x * y = #0) <=> (x = #0) \/ (y = #0)))
15052End
15053
15054Definition FiniteIntegralDomain_def:
15055  FiniteIntegralDomain (r:'a ring) <=> IntegralDomain r /\ FINITE R
15056End
15057
15058(* ------------------------------------------------------------------------- *)
15059(* Simple Theorems                                                           *)
15060(* ------------------------------------------------------------------------- *)
15061
15062(* Theorem: Integral Domain is Ring. *)
15063(* Proof: by definition. *)
15064Theorem integral_domain_is_ring =
15065  IntegralDomain_def |> SPEC_ALL |> EQ_IMP_RULE |> #1 |> UNDISCH |> CONJUNCT1 |> DISCH_ALL |> GEN_ALL;
15066(* > val integral_domain_is_ring = |- !r. IntegralDomain r ==> Ring r : thm *)
15067
15068(* Theorem: Integral Domain has #1 <> #0 *)
15069(* Proof: by definition *)
15070Theorem integral_domain_one_ne_zero[simp] =
15071  IntegralDomain_def |> SPEC_ALL |> EQ_IMP_RULE |> #1 |> UNDISCH |> CONJUNCT2 |> CONJUNCT1 |> DISCH_ALL |> GEN_ALL;
15072(* > val integral_domain_one_ne_zero = |- !r. IntegralDomain r ==> #1 <> #0 : thm *)
15073
15074
15075(* Theorem: No zero divisor in integral domain. *)
15076(* Proof: by definition. *)
15077Theorem integral_domain_mult_eq_zero =
15078  IntegralDomain_def |> SPEC_ALL |> EQ_IMP_RULE |> #1 |> UNDISCH |> CONJUNCT2 |> CONJUNCT2 |> DISCH_ALL |> GEN_ALL;
15079(* > val integral_domain_mult_eq_zero =
15080     |- !r. IntegralDomain r ==> !x y. x IN R /\ y IN R ==> ((x * y = #0) <=> (x = #0) \/ (y = #0)) : thm *)
15081
15082(* Alternative name for export *)
15083Theorem integral_domain_zero_product = integral_domain_mult_eq_zero;
15084(* > val integral_domain_zero_product =
15085    |- !r. IntegralDomain r ==> !x y. x IN R /\ y IN R ==> ((x * y = #0) <=> (x = #0) \/ (y = #0)) : thm *)
15086
15087(* Theorem: #0 is not a unit of integral domain. *)
15088(* Proof: by ring_units_has_zero *)
15089Theorem integral_domain_zero_not_unit:
15090    !r:'a ring. IntegralDomain r ==> ~ (#0 IN R*)
15091Proof
15092  rw[ring_units_has_zero, IntegralDomain_def]
15093QED
15094
15095(* Theorem: #1 IN R+ for integral domain. *)
15096(* Proof: by #1 <> #0 and ring_nonzero_eq. *)
15097Theorem integral_domain_one_nonzero:
15098    !r:'a ring. IntegralDomain r ==> #1 IN R+
15099Proof
15100  rw[integral_domain_is_ring, ring_nonzero_eq]
15101QED
15102
15103(* Theorem: x IN R+ /\ y IN R+ <=> (x * y) IN R+ *)
15104(* Proof: by definitions. *)
15105Theorem integral_domain_mult_nonzero:
15106    !r:'a ring. IntegralDomain r ==> !x y. x IN R+ /\ y IN R+ ==> (x * y) IN R+
15107Proof
15108  rw[integral_domain_zero_product, integral_domain_is_ring, ring_nonzero_eq]
15109QED
15110
15111(* Theorem: IntegralDomain r ==> (F* = R+) *)
15112(* Proof: by integral_domain_is_ring, ring_nonzero_mult_carrier *)
15113Theorem integral_domain_nonzero_mult_carrier:
15114    !r:'a ring. IntegralDomain r ==> (F* = R+)
15115Proof
15116  rw_tac std_ss[integral_domain_is_ring, ring_nonzero_mult_carrier]
15117QED
15118
15119(* Theorem: properties of f*. *)
15120(* Proof:
15121   By IntegralDomain_def, excluding_def
15122   For F* = R+
15123         F*
15124       = r.prod.carrier DIFF {#0}
15125       = R DIFF {#0}            by ring_carriers
15126       = R+                     by ring_nonzero_def
15127   For f*.exp = r.prod.exp
15128       This is true             by monoid_exp_def, FUN_EQ_THM
15129*)
15130Theorem integral_domain_nonzero_mult_property:
15131    !r:'a ring. IntegralDomain r ==>
15132               (F* = R+) /\ (f*.id = #1) /\ (f*.op = r.prod.op) /\ (f*.exp = r.prod.exp)
15133Proof
15134  rw_tac std_ss[IntegralDomain_def, excluding_def, ring_carriers, ring_nonzero_def, monoid_exp_def, FUN_EQ_THM]
15135QED
15136
15137(* Theorem: IntegralDomain r ==> Monoid f* *)
15138(* Proof:
15139   Note IntegralDomain r ==> Ring r                by IntegralDomain_def
15140   By Monoid_def, excluding_def, IN_DIFF, IN_SING, ring_carriers, this is to show:
15141   (1) x IN R /\ y IN R ==> x * y IN R, true       by ring_mult_element
15142   (2) x IN R /\ y IN R /\ z IN R ==> x * y * z = x * (y * z), true by ring_mult_assoc
15143   (3) #1 IN R, true                               by ring_one_element
15144   (4) x IN R ==> #1 * x = x, true                 by ring_mult_lone
15145   (5) x IN R ==> x * #1 = x, true                 by ring_mult_rone
15146*)
15147Theorem integral_domain_nonzero_monoid:
15148    !r:'a ring. IntegralDomain r ==> Monoid f*
15149Proof
15150  rw_tac std_ss[IntegralDomain_def] >>
15151  rw_tac std_ss[Monoid_def, excluding_def, IN_DIFF, IN_SING, ring_carriers] >>
15152  rw[ring_mult_assoc]
15153QED
15154
15155(* Another proof of the same result. *)
15156
15157(* Theorem: IntegralDomain r ==> Monoid f* *)
15158(* Proof:
15159   By IntegralDomain_def, Monoid_def, integral_domain_nonzero_mult_property, this is to show:
15160   (1) x IN R+ /\ y IN R+ ==> x * y IN R+, true by ring_mult_element, ring_nonzero_eq
15161   (2) x IN R+ /\ y IN R+ /\ z IN R+ ==> x * y * z = x * (y * z), true by ring_mult_assoc, ring_nonzero_eq
15162   (3) #1 IN R+, true                       by ring_one_element, ring_nonzero_eq
15163   (4) x IN R+ ==> #1 * x = x, true         by ring_mult_lone, ring_nonzero_eq
15164   (5) x IN R+ ==> x * #1 = x, true         by ring_mult_rone, ring_nonzero_eq
15165*)
15166Theorem integral_domain_nonzero_monoid[allow_rebind]:
15167  !r:'a ring. IntegralDomain r ==> Monoid f*
15168Proof
15169  rw_tac std_ss[IntegralDomain_def, Monoid_def,
15170                integral_domain_nonzero_mult_property] >>
15171  fs[ring_nonzero_eq, ring_mult_assoc]
15172QED
15173
15174(* ring isomorphisms preserve domain properties *)
15175
15176Theorem integral_domain_ring_iso:
15177  IntegralDomain r /\ Ring s /\ RingIso f r s ==> IntegralDomain s
15178Proof
15179  simp[IntegralDomain_def]
15180  \\ strip_tac
15181  \\ drule_then (drule_then drule) ring_iso_sym
15182  \\ simp[RingIso_def, RingHomo_def]
15183  \\ strip_tac
15184  \\ qmatch_assum_abbrev_tac`BIJ g s.carrier r.carrier`
15185  \\ `Group s.sum /\ Group r.sum` by metis_tac[Ring_def, AbelianGroup_def]
15186  \\ `g s.sum.id = r.sum.id` by metis_tac[group_homo_id]
15187  \\ conj_asm1_tac >- metis_tac[monoid_homo_id]
15188  \\ rw[]
15189  \\ first_x_assum(qspecl_then[`g x`,`g y`]mp_tac)
15190  \\ impl_keep_tac >- metis_tac[BIJ_DEF, INJ_DEF]
15191  \\ fs[MonoidHomo_def]
15192  \\ `s.prod.carrier = s.carrier` by metis_tac[ring_carriers] \\ fs[]
15193  \\ first_x_assum(qspecl_then[`x`,`y`]mp_tac)
15194  \\ simp[]
15195  \\ `s.sum.id IN s.carrier` by simp[]
15196  \\ `s.prod.op x y IN s.carrier` by simp[]
15197  \\ PROVE_TAC[BIJ_DEF, INJ_DEF]
15198QED
15199
15200(* ------------------------------------------------------------------------- *)
15201(* Left and Right Multiplicative Cancellation                                *)
15202(* ------------------------------------------------------------------------- *)
15203
15204(* Theorem: IntegeralDomain r ==> x * y = x * z <=> x = #0 \/ y = z  *)
15205(* Proof:
15206        x * y = x * z
15207   <=>  x * y - x * z = #0       by ring_sub_eq_zero
15208   <=>  x * (y - z) = #0         by ring_mult_rsub
15209   <=>  x = #0 or (y - z) = #0   by integral_domain_zero_product
15210   <=>  x = #0 or y = z          by ring_sub_eq_zero
15211*)
15212Theorem integral_domain_mult_lcancel:
15213    !r:'a ring. IntegralDomain r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((x * y = x * z) <=> (x = #0) \/ (y = z))
15214Proof
15215  rpt strip_tac >>
15216  `Ring r` by rw[integral_domain_is_ring] >>
15217  `(x * y = x * z) <=> (x * y - x * z = #0)` by rw[ring_sub_eq_zero] >>
15218  `_ = (x * (y - z) = #0)` by rw_tac std_ss[ring_mult_rsub] >>
15219  `_ = ((x = #0) \/ (y - z = #0))` by rw[integral_domain_zero_product] >>
15220  `_ = ((x = #0) \/ (y = z))` by rw[ring_sub_eq_zero] >>
15221  rw[]
15222QED
15223
15224(* Theorem: IntegeralDomain r ==> y * x = z * x <=> x = #0 \/ y = z  *)
15225(* Proof: by integral_domain_mult_lcancel, ring_mult_comm. *)
15226Theorem integral_domain_mult_rcancel:
15227    !r:'a ring. IntegralDomain r ==> !x y z. x IN R /\ y IN R /\ z IN R ==> ((y * x = z * x) <=> (x = #0) \/ (y = z))
15228Proof
15229  rw[integral_domain_mult_lcancel, ring_mult_comm, integral_domain_is_ring]
15230QED
15231
15232(* ------------------------------------------------------------------------- *)
15233(* Non-zero multiplications form a Monoid.                                   *)
15234(* ------------------------------------------------------------------------- *)
15235
15236(* Define monoid of ring nonzero multiplication. *)
15237Definition monoid_of_ring_nonzero_mult_def:
15238  monoid_of_ring_nonzero_mult (r:'a ring) :'a monoid  =
15239  <| carrier := R+;
15240          op := r.prod.op;
15241          id := #1
15242    |>
15243End
15244(*
15245- type_of ``monoid_of_ring_nonzero_mult r``;
15246> val it = ``:'a monoid`` : hol_type
15247*)
15248
15249(* Theorem: Integral nonzero multiplication form a Monoid. *)
15250(* Proof: by checking definition. *)
15251Theorem integral_domain_nonzero_mult_is_monoid:
15252    !r:'a ring. IntegralDomain r ==> Monoid (monoid_of_ring_nonzero_mult r)
15253Proof
15254  rpt strip_tac >>
15255  `Ring r` by rw_tac std_ss[integral_domain_is_ring] >>
15256  rw_tac std_ss[Monoid_def, monoid_of_ring_nonzero_mult_def, RES_FORALL_THM] >-
15257  rw_tac std_ss[integral_domain_mult_nonzero] >-
15258  rw[ring_mult_assoc, ring_nonzero_element] >-
15259  rw_tac std_ss[integral_domain_one_nonzero] >-
15260  rw[ring_nonzero_element] >>
15261  rw[ring_nonzero_element]
15262QED
15263
15264(* ------------------------------------------------------------------------- *)
15265(* Theorems from Ring exponentiation.                                        *)
15266(* ------------------------------------------------------------------------- *)
15267
15268(* Theorem: For integral domain: x ** n IN R+ *)
15269(* Proof: by induction on n.
15270   Base case: x ** 0 IN R+
15271      since x ** 0 = #1  by ring_exp_0
15272      hence true by integral_domain_one_nonzero.
15273   Step case: x ** n IN R+ ==> x ** SUC n IN R+
15274      since x ** SUC n = x * x ** n   by ring_exp_SUC
15275      hence true by integral_domain_mult_nonzero, by induction hypothesis.
15276*)
15277Theorem integral_domain_exp_nonzero:
15278    !r:'a ring. IntegralDomain r ==> !x. x IN R+ ==> !n. x ** n IN R+
15279Proof
15280  rpt strip_tac >>
15281  `Ring r` by rw_tac std_ss[integral_domain_is_ring] >>
15282  Induct_on `n` >| [
15283    rw[integral_domain_one_nonzero, ring_nonzero_element],
15284    rw_tac std_ss[ring_exp_SUC, integral_domain_mult_nonzero, ring_nonzero_element]
15285  ]
15286QED
15287
15288(* Theorem: For integral domain, x ** n = #0 <=> n <> 0 /\ x = #0 *)
15289(* Proof: by integral_domain_exp_nonzero and ring_zero_exp. *)
15290Theorem integral_domain_exp_eq_zero:
15291    !r:'a ring. IntegralDomain r ==> !x. x IN R ==> !n. (x ** n = #0) <=> n <> 0 /\ (x = #0)
15292Proof
15293  rpt strip_tac >>
15294  `Ring r /\ (#1 <> #0)` by rw[integral_domain_is_ring] >>
15295  metis_tac[integral_domain_exp_nonzero, ring_nonzero_eq, ring_zero_exp, ring_exp_element]
15296QED
15297
15298(* Theorem: For m < n, x IN R+ /\ x ** m = x ** n ==> x ** (n-m) = #1 *)
15299(* Proof:
15300     x ** (n-m) * x ** m
15301   = x ** ((n-m) + m)         by ring_exp_add
15302   = x ** n                   by arithmetic, m < n
15303   = x ** m                   by given
15304   = #1 * x ** m              by ring_mult_lone
15305
15306   Hence (x ** (n-m) - #1) * x ** m = #0  by ring_mult_ladd
15307   By no-zero-divisor property of Integral Domain,
15308   x ** (n-m) - #1 = 0, or x ** (n-m) = #1.
15309*)
15310Theorem integral_domain_exp_eq:
15311    !r:'a ring. IntegralDomain r ==> !x. x IN R+ ==> !m n. m < n /\ (x ** m = x ** n) ==> (x ** (n-m) = #1)
15312Proof
15313  rpt strip_tac >>
15314  `Ring r` by rw_tac std_ss[integral_domain_is_ring] >>
15315  `#1 IN R+ /\ !k. x ** k IN R+` by rw_tac std_ss[integral_domain_one_nonzero, integral_domain_exp_nonzero] >>
15316  `!z. z IN R+ ==> z IN R` by rw_tac std_ss[ring_nonzero_element] >>
15317  `(n-m) + m = n` by decide_tac >>
15318  `x ** (n-m) * x ** m = x ** ((n-m) + m)` by rw_tac std_ss[ring_exp_add] >>
15319  `_ = #1 * x ** m` by rw_tac std_ss[ring_mult_lone] >>
15320  `x ** (n - m) * x ** m - #1 * x ** m = #0` by rw_tac std_ss[ring_sub_eq_zero, ring_mult_element] >>
15321  `x ** (n - m) * x ** m + (-#1) * x ** m = #0` by metis_tac[ring_sub_def, ring_neg_mult] >>
15322  `(x ** (n-m) + (-#1)) * x ** m = #0` by rw_tac std_ss[ring_mult_ladd, ring_neg_element] >>
15323  `(x ** (n-m) - #1) * x ** m = #0` by metis_tac[ring_sub_def] >>
15324  `(x ** (n-m) - #1) IN R` by rw_tac std_ss[ring_sub_element] >>
15325  metis_tac[ring_sub_eq_zero, integral_domain_zero_product, ring_nonzero_eq]
15326QED
15327
15328(* ------------------------------------------------------------------------- *)
15329(* Finite Integral Domain.                                                   *)
15330(* ------------------------------------------------------------------------- *)
15331
15332(* Theorem: FINITE IntegralDomain r ==> !x in R+, ?k. 0 < k /\ (x ** k = #1) *)
15333(* Proof: by finite_monoid_exp_not_distinct and integral_domain_exp_eq. *)
15334Theorem finite_integral_domain_period_exists:
15335    !r:'a ring. FiniteIntegralDomain r ==> !x. x IN R+ ==> ?k. 0 < k /\ (x ** k = #1)
15336Proof
15337  rpt strip_tac >>
15338  `IntegralDomain r /\ FINITE R /\ Ring r` by metis_tac[FiniteIntegralDomain_def, IntegralDomain_def] >>
15339  `Monoid r.prod /\ (r.prod.carrier = R)` by rw_tac std_ss[ring_mult_monoid] >>
15340  `!z. z IN R+ ==> z IN R` by rw_tac std_ss[ring_nonzero_element] >>
15341  `?h k. (x ** h = x ** k) /\ (h <> k)` by rw_tac std_ss[finite_monoid_exp_not_distinct, FiniteMonoid_def] >>
15342  Cases_on `h < k` >| [
15343    `0 < k - h` by decide_tac,
15344    `k < h /\ 0 < h - k` by decide_tac
15345  ] >> metis_tac[integral_domain_exp_eq]
15346QED
15347
15348(* Theorem: FINITE IntegralDomain r ==> all x IN R+ are invertible. *)
15349(* Proof:
15350   Eventually this reduces to:
15351   (1) x * y = #1 /\ y * x = #1 ==> x <> #0
15352       By contradiction.
15353       If x = #0, then x * y = #0    by ring_mult_lzero
15354       but contradicts x * y = #1    by given
15355       as #1 <> #0 for Integral Domains.
15356   (2) x <> #0 ==> ?y. y IN R /\ (x * y = #1) /\ (y * x = #1)
15357       Since FINITE IntegralDomain r,
15358       ?k. 0 < k /\ (x ** k = #1)    by finite_integral_domain_period_exists
15359       i.e. 1 <= k, or 0 <= (k-1).
15360       Let h = k - 1, then
15361       x ** h * x = x ** k = #1      by ring_exp_add, and
15362       x * x ** h = x ** k = #1      by ring_exp_add,
15363       so just take y = x ** h.
15364*)
15365Theorem finite_integral_domain_nonzero_invertible:
15366    !r:'a ring. FiniteIntegralDomain r ==> (monoid_invertibles r.prod = R+ )
15367Proof
15368  rpt strip_tac >>
15369  `IntegralDomain r` by metis_tac[FiniteIntegralDomain_def] >>
15370  `Ring r /\ (#1 <> #0)` by rw[integral_domain_is_ring] >>
15371  `Monoid r.prod /\ (r.prod.carrier = R) /\ (#1 = #1)` by rw[ring_mult_monoid] >>
15372  rw_tac std_ss[monoid_invertibles_def, ring_nonzero_eq, EXTENSION, EQ_IMP_THM, GSPECIFICATION] >| [
15373    metis_tac[ring_mult_lzero],
15374    `x IN R+ /\ (x ** 1 = x)` by rw_tac std_ss[ring_nonzero_eq, ring_exp_1] >>
15375    `?k. 0 < k /\ (x ** k = #1)` by rw_tac std_ss[finite_integral_domain_period_exists] >>
15376    qexists_tac `x ** (k-1)` >>
15377    `(1 + (k-1) = k) /\ ((k - 1) + 1 = k)` by decide_tac >>
15378    metis_tac[ring_exp_add, ring_exp_element]
15379  ]
15380QED
15381
15382(* Theorem: FiniteIntegralDomain r ==> (F* = monoid_invertibles f* *)
15383(* Proof:
15384   Note Ring r                               by integral_domain_is_ring
15385    and #0 NOTIN R+                          by ring_nonzero_eq
15386    But monoid_invertibles r.prod = R+       by finite_integral_domain_nonzero_invertible [1]
15387   Thus #0 NOTIN monoid_invertibles r.prod   by above [2]
15388   with AbelianMonoid r.prod                 by ring_mult_abelian_monoid, Ring r
15389        F*
15390      = R+                                   by ring_nonzero_mult_carrier
15391      = monoid_invertibles r.prod            by above [1]
15392      = monoid_invertibles f*                by abelian_monoid_invertible_excluding, [2]
15393*)
15394Theorem finite_integral_domain_nonzero_invertible_alt:
15395    !r:'a ring. FiniteIntegralDomain r ==> (monoid_invertibles f* = F* )
15396Proof
15397  rpt (stripDup[FiniteIntegralDomain_def]) >>
15398  `Ring r` by rw[integral_domain_is_ring] >>
15399  `#0 NOTIN R+` by rw[ring_nonzero_eq] >>
15400  `monoid_invertibles r.prod = R+` by rw_tac std_ss[finite_integral_domain_nonzero_invertible] >>
15401  `AbelianMonoid r.prod` by rw[ring_mult_abelian_monoid] >>
15402  `monoid_invertibles f* = monoid_invertibles r.prod` by rw[abelian_monoid_invertible_excluding] >>
15403  rw[ring_nonzero_mult_carrier]
15404QED
15405
15406(* Theorem: FiniteIntegralDomain r ==> Group f* *)
15407(* Proof:
15408   By Group_def, this is to show:
15409   (1) Monoid f*, true                  by integral_domain_nonzero_monoid
15410   (2) monoid_invertibles f* = F*, true by finite_integral_domain_nonzero_invertible_alt
15411*)
15412Theorem finite_integral_domain_nonzero_group:
15413    !r:'a ring. FiniteIntegralDomain r ==> Group f*
15414Proof
15415  rpt (stripDup[FiniteIntegralDomain_def]) >>
15416  rw_tac std_ss[Group_def] >-
15417  rw[integral_domain_nonzero_monoid] >>
15418  rw[finite_integral_domain_nonzero_invertible_alt]
15419QED
15420
15421(* ------------------------------------------------------------------------- *)
15422(* Integral Domain Element Order                                             *)
15423(* ------------------------------------------------------------------------- *)
15424
15425(* Theorem: IntegralDomain r ==> !x. order r.prod x = order f* x *)
15426(* Proof:
15427      forder x
15428    = order f* x                                                        by notation
15429    = case OLEAST k. period f* x k of NONE => 0 | SOME k => k           by order_def
15430    = case OLEAST k. 0 < k /\ (f*.exp x k = f*.id) of NONE => 0 | SOME k => k  by period_def
15431    = case OLEAST k. 0 < k /\ (x ** k = #1) of NONE => 0 | SOME k => k  by integral_domain_nonzero_mult_property
15432    = case OLEAST k. period r.prod x k of NONE => 0 | SOME k => k       by period_def
15433    = order r.prod x                                                    by order_def
15434*)
15435Theorem integral_domain_nonzero_order:
15436    !r:'a ring. IntegralDomain r ==> !x. order r.prod x = order f* x
15437Proof
15438  rw_tac std_ss[order_def, period_def, integral_domain_nonzero_mult_property]
15439QED
15440
15441(* Theorem: IntegralDomain r ==> (order f* #0 = 0) *)
15442(* Proof:
15443   By order_def, period_def, integral_domain_nonzero_mult_property, this is to show that:
15444      ((n = 0) \/ #0 ** n <> #1) \/ ?m. m < n /\ m <> 0 /\ (#0 ** m = #1)
15445   By contradiction, suppose n <> 0 /\ #0 ** n = #1.
15446   Note Ring r /\ #1 <> #0        by IntegralDomain_def
15447   Thus #0 ** n = #0              by ring_zero_exp
15448   This gives #0 = #1, contradicting #1 <> #0.
15449*)
15450Theorem integral_domain_order_zero:
15451  !r:'a ring. IntegralDomain r ==> (order f* #0 = 0)
15452Proof
15453  rw_tac std_ss[order_def, period_def] >>
15454  DEEP_INTRO_TAC OLEAST_INTRO >>
15455  rw[] >>
15456  rfs[integral_domain_nonzero_mult_property] >>
15457  spose_not_then strip_assume_tac >>
15458  fs[IntegralDomain_def] >> rfs[ring_zero_exp, AllCaseEqs()]
15459QED
15460
15461(* Theorem: FiniteIntegralDomain r ==> !x. x IN R+ ==> (order f* x <> 0) *)
15462(* Proof:
15463   Note ?n. 0 < n /\ (n ** k = #1)           by finite_integral_domain_period_exists
15464     or ?n. n <> 0 /\ (f*.exp x n = f*.id)   by integral_domain_nonzero_mult_property
15465     or forder x <> 0                        by order_def, period_def
15466*)
15467Theorem integral_domain_order_nonzero:
15468    !r:'a ring. FiniteIntegralDomain r ==> !x. x IN R+ ==> (order f* x <> 0)
15469Proof
15470  rw_tac std_ss[order_def, period_def] >>
15471  DEEP_INTRO_TAC OLEAST_INTRO >>
15472  rw[] >>
15473  `IntegralDomain r` by fs[FiniteIntegralDomain_def] >>
15474  metis_tac[finite_integral_domain_period_exists, integral_domain_nonzero_mult_property, NOT_ZERO_LT_ZERO]
15475QED
15476
15477(* Theorem: FiniteIntegralDomain r ==> !x. x IN R ==> ((order f* x = 0) <=> (x = #0)) *)
15478(* Proof:
15479   If part: x IN R /\ forder x = 0 ==> x = #0
15480      By contradiction, suppose x <> #0.
15481      Then x IN R+                      by ring_nonzero_eq
15482       and forder x <> 0                by integral_domain_order_nonzero
15483      This contradicts forder x = 0.
15484   Only-if part: forder #0 = 0, true    by integral_domain_order_zero
15485*)
15486Theorem integral_domain_order_eq_0:
15487    !r:'a ring. FiniteIntegralDomain r ==> !x. x IN R ==> ((order f* x = 0) <=> (x = #0))
15488Proof
15489  rpt (stripDup[FiniteIntegralDomain_def]) >>
15490  rw[EQ_IMP_THM] >-
15491  metis_tac[integral_domain_order_nonzero, ring_nonzero_eq] >>
15492  rw[integral_domain_order_zero]
15493QED
15494
15495(* ------------------------------------------------------------------------- *)
15496(* Integral Domain Characteristic.                                           *)
15497(* ------------------------------------------------------------------------- *)
15498
15499(* Theorem: IntegralDomain r ==> (char r = 0) \/ prime (char r) *)
15500(* Proof:
15501   If char r = 0, it is trivial.
15502   If char r <> 0,
15503   first note that  #1 <> #0      by integral_domain_one_ne_zero
15504   Hence char r <> 1              by char_property
15505   Now proceed by contradication.
15506   Let p be a prime that divides (char r), 1 < p < (char r).
15507   i.e.  char r = k * p           with k < (char r).
15508   then  ##(char r) = #0          by char_property
15509   means  ##(k * p) = #0          by substitution
15510   or   ## k * ## p = #0          by ring_num_mult
15511   ==>  ## k = #0  or ## p = #0   by integral_domain_zero_product
15512   Either case, this violates the minimality of (char r) given by char_minimal.
15513*)
15514Theorem integral_domain_char:
15515    !r:'a ring. IntegralDomain r ==> (char r = 0) \/ (prime (char r))
15516Proof
15517  rpt strip_tac >>
15518  Cases_on `char r = 0` >-
15519  rw_tac std_ss[] >>
15520  rw_tac std_ss[] >>
15521  `Ring r /\ #1 <> #0` by rw[integral_domain_is_ring] >>
15522  `char r <> 1` by metis_tac[char_property, ring_num_1] >>
15523  (spose_not_then strip_assume_tac) >>
15524  `?p. prime p /\ p divides (char r)` by rw_tac std_ss[PRIME_FACTOR] >>
15525  `?k. char r = k * p` by rw_tac std_ss[GSYM divides_def] >>
15526  `k divides (char r)` by metis_tac[divides_def, MULT_COMM] >>
15527  `0 < p /\ 1 < p` by rw_tac std_ss[PRIME_POS, ONE_LT_PRIME] >>
15528  `0 <> k` by metis_tac[MULT] >>
15529  `0 < k /\ p <> 1` by decide_tac >>
15530  `p <= char r /\ k <= char r` by rw_tac std_ss[DIVIDES_LE] >>
15531  `p <> char r` by metis_tac[] >>
15532  `k <> char r` by metis_tac[MULT_EQ_ID, MULT_COMM] >>
15533  `p < char r /\ k < char r /\ 0 < char r` by decide_tac >>
15534  `#0 = ##(char r)` by rw_tac std_ss[char_property] >>
15535  `_ = ## k * ## p` by rw_tac std_ss[ring_num_mult] >>
15536  metis_tac[integral_domain_zero_product, char_minimal, ring_num_element]
15537QED
15538
15539(* ------------------------------------------------------------------------- *)
15540(* Primes are irreducible in an Integral Domain                              *)
15541(* ------------------------------------------------------------------------- *)
15542
15543Theorem prime_is_irreducible:
15544  !r p. IntegralDomain r /\ p IN r.carrier /\ ring_prime r p
15545        /\ p <> r.sum.id /\ ~Unit r p
15546        ==> irreducible r p
15547Proof
15548  rw[ring_prime_def]
15549  \\ simp[irreducible_def, ring_nonzero_def]
15550  \\ `Ring r` by fs[IntegralDomain_def]
15551  \\ rw[]
15552  \\ fs[ring_divides_def, PULL_EXISTS]
15553  \\ simp[Invertibles_carrier, monoid_invertibles_element]
15554  \\ Cases_on`x = #0` \\ gs[]
15555  \\ Cases_on`y = #0` \\ gs[]
15556  \\ first_x_assum(qspecl_then[`x`,`y`,`#1`]mp_tac)
15557  \\ simp[] \\ strip_tac
15558  >- (
15559    `x = x * (s * y)` by metis_tac[ring_mult_assoc, ring_mult_comm]
15560    \\ `#1 * x = x /\ x * #1 = x` by metis_tac[ring_mult_rone, ring_mult_lone]
15561    \\ `x = (s * y) * x` by metis_tac[ring_mult_comm, ring_mult_element]
15562    \\ qspec_then`r`mp_tac integral_domain_mult_lcancel
15563    \\ impl_tac >- simp[]
15564    \\ disch_then(qspecl_then[`x`,`#1`,`s * y`]mp_tac) \\ simp[]
15565    \\ metis_tac[ring_mult_comm] )
15566  >- (
15567    `y = y * (s * x)` by metis_tac[ring_mult_assoc, ring_mult_comm]
15568    \\ `#1 * y = y /\ y * #1 = y` by metis_tac[ring_mult_rone, ring_mult_lone]
15569    \\ `y = (s * x) * y` by metis_tac[ring_mult_comm, ring_mult_element]
15570    \\ qspec_then`r`mp_tac integral_domain_mult_lcancel
15571    \\ impl_tac >- simp[]
15572    \\ disch_then(qspecl_then[`y`,`#1`,`s * x`]mp_tac) \\ simp[]
15573    \\ metis_tac[ring_mult_comm] )
15574QED
15575
15576(* ------------------------------------------------------------------------- *)
15577(* Prime factorizations are unique (up to order and associates)              *)
15578(* ------------------------------------------------------------------------- *)
15579
15580Theorem integral_domain_divides_prime:
15581  !r p x. IntegralDomain r /\ x IN r.carrier /\ p IN r.carrier /\
15582          p <> r.sum.id /\ ring_prime r p /\ ~Unit r p /\ ~Unit r x /\
15583          ring_divides r x p
15584          ==>
15585          ring_associates r x p
15586Proof
15587  rw[ring_associates_def]
15588  \\ `Ring r` by metis_tac[IntegralDomain_def]
15589  \\ drule_then (drule_then drule) prime_is_irreducible
15590  \\ simp[]
15591  \\ rw[irreducible_def]
15592  \\ fs[ring_divides_def]
15593  \\ `Unit r s` by metis_tac[]
15594  \\ pop_assum mp_tac
15595  \\ simp[ring_unit_property]
15596  \\ simp[PULL_EXISTS]
15597  \\ rpt strip_tac
15598  \\ qexists_tac`v`
15599  \\ qexists_tac`s`
15600  \\ simp[]
15601  \\ simp[Once ring_mult_comm]
15602  \\ simp[GSYM ring_mult_assoc]
15603  \\ metis_tac[ring_mult_comm, ring_mult_lone]
15604QED
15605
15606Theorem integral_domain_prime_factors_unique:
15607  IntegralDomain r ==>
15608  !l1 l2.
15609  (!m. MEM m l1 ==>
15610       m IN r.carrier /\ ring_prime r m /\ m <> r.sum.id /\ ~Unit r m) /\
15611  (!m. MEM m l2 ==>
15612       m IN r.carrier /\ ring_prime r m /\ m <> r.sum.id /\ ~Unit r m) /\
15613  ring_associates r
15614    (GBAG r.prod (LIST_TO_BAG l1))
15615    (GBAG r.prod (LIST_TO_BAG l2)) ==>
15616  ?l3. PERM l2 l3 /\ LIST_REL (ring_associates r) l1 l3
15617Proof
15618  strip_tac
15619  \\ `Ring r` by metis_tac[IntegralDomain_def]
15620  \\ Induct \\ simp[]
15621  >- (
15622    Cases \\ rw[]
15623    \\ spose_not_then strip_assume_tac
15624    \\ pop_assum mp_tac
15625    \\ DEP_REWRITE_TAC[GBAG_INSERT]
15626    \\ simp[SUBSET_DEF, IN_LIST_TO_BAG]
15627    \\ conj_asm1_tac >- metis_tac[Ring_def]
15628    \\ simp[ring_associates_def]
15629    \\ rpt strip_tac
15630    \\ qmatch_asmsub_abbrev_tac`GBAG r.prod b0`
15631    \\ `GBAG r.prod b0 IN r.prod.carrier`
15632    by ( irule GBAG_in_carrier \\ simp[SUBSET_DEF, Abbr`b0`, IN_LIST_TO_BAG] )
15633    \\ `!v. v IN r.carrier ==> r.prod.id <> r.prod.op h v`
15634    by metis_tac[ring_unit_property]
15635    \\ first_x_assum(qspec_then`r.prod.op s (GBAG r.prod b0)`mp_tac)
15636    \\ rfs[]
15637    \\ metis_tac[ring_unit_property, ring_mult_comm, ring_mult_assoc] )
15638  \\ rpt strip_tac
15639  \\ pop_assum mp_tac
15640  \\ DEP_REWRITE_TAC[GBAG_INSERT]
15641  \\ simp[SUBSET_DEF, IN_LIST_TO_BAG]
15642  \\ conj_asm1_tac >- metis_tac[Ring_def]
15643  \\ `GBAG r.prod (LIST_TO_BAG l1) IN r.prod.carrier`
15644  by ( irule GBAG_in_carrier \\ simp[SUBSET_DEF, IN_LIST_TO_BAG] )
15645  \\ `GBAG r.prod (LIST_TO_BAG l2) IN r.prod.carrier`
15646  by ( irule GBAG_in_carrier \\ simp[SUBSET_DEF, IN_LIST_TO_BAG] )
15647  \\ strip_tac
15648  \\ `ring_divides r h (GBAG r.prod (LIST_TO_BAG l2))`
15649  by (
15650    simp[ring_divides_def] \\ rfs[ring_associates_def]
15651    \\ pop_assum mp_tac \\ simp[ring_unit_property]
15652    \\ strip_tac
15653    \\ qexists_tac`r.prod.op (GBAG r.prod (LIST_TO_BAG l1)) v`
15654    \\ simp[]
15655    \\ last_x_assum(mp_tac o Q.AP_TERM`r.prod.op v`)
15656    \\ simp[GSYM ring_mult_assoc]
15657    \\ simp[Once ring_mult_comm]
15658    \\ simp[GSYM ring_mult_assoc]
15659    \\ metis_tac[ring_mult_comm, ring_mult_lone])
15660  \\ simp[PULL_EXISTS]
15661  \\ `SET_OF_BAG (LIST_TO_BAG l2) SUBSET r.carrier`
15662  by simp[SUBSET_DEF, IN_LIST_TO_BAG]
15663  \\ `?q. BAG_IN q (LIST_TO_BAG l2) /\ ring_divides r h q`
15664  by metis_tac[ring_prime_divides_product, FINITE_LIST_TO_BAG]
15665  \\ fs[IN_LIST_TO_BAG]
15666  \\ `ring_associates r h q` by metis_tac[integral_domain_divides_prime]
15667  \\ qmatch_assum_rename_tac`ring_divides r p q`
15668  \\ drule (#1(EQ_IMP_RULE MEM_SPLIT_APPEND_first))
15669  \\ strip_tac
15670  \\ `PERM l2 (q::(pfx++sfx))`
15671  by (
15672    simp[Once PERM_SYM]
15673    \\ rewrite_tac[GSYM APPEND_ASSOC, APPEND]
15674    \\ irule CONS_PERM
15675    \\ simp[] )
15676  \\ `LIST_TO_BAG l2 = LIST_TO_BAG (q::(pfx++sfx))`
15677  by simp[PERM_LIST_TO_BAG]
15678  \\ `GBAG r.prod (LIST_TO_BAG l2) =
15679      r.prod.op q (GBAG r.prod (LIST_TO_BAG (pfx++sfx)))`
15680  by (
15681    simp[]
15682    \\ DEP_REWRITE_TAC[GBAG_INSERT]
15683    \\ fs[SUBSET_DEF] )
15684  \\ `?s. Unit r s /\ p = s * q` by metis_tac[ring_associates_def]
15685  \\ qmatch_asmsub_abbrev_tac`r.prod.op p p1`
15686  \\ qmatch_assum_abbrev_tac`rassoc (p * p1) p2`
15687  \\ `?s2. Unit r s2 /\ p * p1 = s2 * p2` by metis_tac[ring_associates_def]
15688  \\ qmatch_asmsub_abbrev_tac`q * q1`
15689  \\ `q1 IN r.prod.carrier`
15690  by ( qunabbrev_tac`q1` \\ irule GBAG_in_carrier \\ fs[SUBSET_DEF] )
15691  \\ `s IN r.carrier /\ s2 IN r.carrier` by metis_tac[ring_unit_property]
15692  \\ `r.prod.carrier = r.carrier` by simp[]
15693  \\ `?s3. s3 IN r.carrier /\ s * s3 = #1` by metis_tac[ring_unit_property]
15694  \\ `s3 * (s * q * p1) = s3 * (s2 * q * q1)` by metis_tac[ring_mult_assoc]
15695  \\ `q IN r.carrier` by fs[SUBSET_DEF]
15696  \\ `s3 * s * q * p1 = s3 * s2 * q * q1` by (
15697    fs[] \\ rfs[ring_mult_assoc] )
15698  \\ `s3 * s = #1` by simp[ring_mult_comm]
15699  \\ `q * p1 = s3 * s2 * q * q1` by metis_tac[ring_mult_lone]
15700  \\ `unit (s3 * s2)` by metis_tac[ring_unit_mult_eq_unit, ring_unit_property]
15701  \\ `q * p1 = q * (s3 * s2) * q1` by metis_tac[ring_mult_comm, ring_mult_assoc]
15702  \\ `q * p1 = q * ((s3 * s2) * q1)` by rfs[ring_mult_assoc]
15703  \\ qmatch_assum_abbrev_tac`unit u`
15704  \\ `ring_sub r (q * p1) (q * (u * q1)) = #0`
15705  by metis_tac[ring_sub_eq_zero, ring_mult_element]
15706  \\ `q * (ring_sub r p1 (u * q1)) = #0`
15707  by (
15708    DEP_REWRITE_TAC[GSYM ring_mult_rsub]
15709    \\ simp[] \\ fs[] )
15710  \\ `MEM q l2` by simp[]
15711  \\ `ring_prime r q /\ q <> #0 /\ ~Unit r q` by metis_tac[]
15712  \\ `u IN r.carrier` by metis_tac[ring_unit_property]
15713  \\ `u * q1 IN r.carrier` by metis_tac[ring_mult_element]
15714  \\ `ring_sub r p1 (u * q1) = #0`
15715  by metis_tac[IntegralDomain_def, ring_sub_element]
15716  \\ `p1 = u * q1` by metis_tac[ring_sub_eq_zero]
15717  \\ qexists_tac`q`
15718  \\ first_x_assum(qspec_then`pfx ++ sfx`mp_tac)
15719  \\ impl_tac
15720  >- (
15721    conj_tac >- (fs[] \\ metis_tac[])
15722    \\ metis_tac[ring_associates_def] )
15723  \\ strip_tac
15724  \\ qexists_tac`l3`
15725  \\ reverse conj_tac >- simp[]
15726  \\ irule PERM_TRANS
15727  \\ goal_assum(first_assum o mp_then Any mp_tac)
15728  \\ irule PERM_MONO
15729  \\ simp[]
15730QED
15731
15732(* ------------------------------------------------------------------------- *)
15733(* Principal Ideals in Integral Domain                                       *)
15734(* ------------------------------------------------------------------------- *)
15735
15736(* Theorem: Two principal ideals are equal iff the elements are associates:
15737            p IN R /\ q IN R ==> (<p> = <q> <=> ?u. unit u /\ (p = q * u) *)
15738(* Proof:
15739   If part: <p> = <q> ==> ?u. unit u /\ (p = q * u)
15740   This part requires an integral domain, not just a ring.
15741   <p> = <q> ==> <p>.carrier = <q>.carrier                        by principal_ideal_ideal, ideal_eq_ideal
15742   p IN <p>.carrier = <q>.carrier ==> ?u. u IN R /\ (p = q * u)   by principal_ideal_element
15743   q IN <q>.carrier = <p>.carrier ==> ?v. y IN R /\ (q = p * v)   by principal_ideal_element
15744   Hence q = p * v = q * u * v.
15745   In an integral domain, left-cancellation gives: q = #0 or #1 = u * v, hence u is a unit.
15746   The case q = #0 means p = q * u = #0, and u can take #1.
15747   Only-if part:
15748   True by principal_ideal_eq_principal_ideal.
15749*)
15750Theorem principal_ideal_equal_principal_ideal:
15751    !r:'a ring. IntegralDomain r ==> !p q. p IN R /\ q IN R ==> ((<p> = <q>) <=> ?u. unit u /\ (p = q * u))
15752Proof
15753  rewrite_tac[EQ_IMP_THM] >>
15754  ntac 2 strip_tac >>
15755  `Ring r` by rw[integral_domain_is_ring] >>
15756  rpt strip_tac >| [
15757    `<p> << r /\ <q> << r` by rw[principal_ideal_ideal] >>
15758    `<p>.carrier = <q>.carrier` by rw[ideal_eq_ideal] >>
15759    `?u. u IN R /\ (p = q * u)` by metis_tac[principal_ideal_has_element, principal_ideal_element] >>
15760    `?v. v IN R /\ (q = p * v)` by metis_tac[principal_ideal_has_element, principal_ideal_element] >>
15761    `#1 IN R /\ u * v IN R` by rw[] >>
15762    `q * #1 = q` by rw[] >>
15763    `_ = q * u * v` by metis_tac[] >>
15764    `_ = q * (u * v)` by rw[ring_mult_assoc] >>
15765    `(q = #0) \/ (u * v = #1)` by metis_tac[integral_domain_mult_lcancel] >| [
15766      `p = #0` by rw[] >>
15767      `unit #1` by rw[] >>
15768      metis_tac[ring_mult_rone],
15769      metis_tac[ring_unit_property]
15770    ],
15771    metis_tac[principal_ideal_eq_principal_ideal]
15772  ]
15773QED
15774
15775(* ------------------------------------------------------------------------- *)
15776(* Integral Domain Instances Documentation                                   *)
15777(* ------------------------------------------------------------------------- *)
15778(* Integral Domain is a special type of Ring, with data type:
15779   The generic symbol for ring data is r.
15780   r.carrier = Carrier set of Ring, overloaded as R.
15781   r.sum     = Addition component of Ring, binary operation overloaded as +.
15782   r.prod    = Multiplication component of Ring, binary operation overloaded as *.
15783*)
15784(* Definitions and Theorems (# are exported):
15785
15786   The Trivial Integral Domain (GF 2):
15787   trivial_integal_domain_def |- !e0 e1. trivial_integal_domain e0 e1 =
15788         <|carrier := {e0; e1};
15789               sum :=  <|carrier := {e0; e1};
15790                              id := e0;
15791                              op := (\x y. if x = e0 then y else if y = e0 then x else e0)|>;
15792              prod := <|carrier := {e0; e1};
15793                             id := e1;
15794                             op := (\x y. if x = e0 then e0 else if y = e0 then e0 else e1)|> |>
15795   trivial_integral_domain    |- !e0 e1. e0 <> e1 ==> FiniteIntegralDomain (trivial_integal_domain e0 e1)
15796
15797   Multiplication in Modulo of prime p:
15798   ZP_def                     |- !p. ZP p = <|carrier := count p; sum := add_mod p; prod := times_mod p|>
15799   ZP_integral_domain         |- !p. prime p ==> IntegralDomain (ZP p)
15800   ZP_finite                  |- !p. FINITE (ZP p).carrier
15801   ZP_finite_integral_domain  |- !p. prime p ==> FiniteIntegralDomain (ZP p)
15802*)
15803(* ------------------------------------------------------------------------- *)
15804(* The Trivial Integral Domain = GF(2) = {|0|, |1|}.                         *)
15805(* ------------------------------------------------------------------------- *)
15806
15807Definition trivial_integal_domain_def[nocompute]:
15808  (trivial_integal_domain e0 e1) : 'a ring =
15809   <| carrier := {e0; e1};
15810      sum := <| carrier := {e0; e1};
15811                id := e0;
15812                op := (\x y. if x = e0 then y
15813                             else if y = e0 then x
15814                             else e0) |>;
15815      prod := <| carrier := {e0; e1};
15816                id := e1;
15817                op := (\x y. if x = e0 then e0
15818                                else if y = e0 then e0
15819                                else e1) |>
15820    |>
15821End
15822
15823(* Theorem: {|0|, |1|} is indeed a integral domain. *)
15824(* Proof: by definition, the integral domain tables are:
15825
15826   +    |0| |1|          *  |0| |1|
15827   ------------         -----------
15828   |0|  |0| |1|         |0| |0| |0|
15829   |1|  |1| |0|         |1| |0| |1|
15830
15831*)
15832Theorem trivial_integral_domain:
15833    !e0 e1. e0 <> e1 ==> FiniteIntegralDomain (trivial_integal_domain e0 e1)
15834Proof
15835  rw_tac std_ss[FiniteIntegralDomain_def] THENL [
15836    `!x a b. x IN {a; b} <=> ((x = a) \/ (x = b))` by rw[] THEN
15837    rw_tac std_ss[IntegralDomain_def, Ring_def] THENL [
15838      rw_tac std_ss[AbelianGroup_def, group_def_alt, trivial_integal_domain_def] THEN
15839      metis_tac[],
15840      rw_tac std_ss[AbelianMonoid_def, Monoid_def, trivial_integal_domain_def] THEN
15841      rw_tac std_ss[],
15842      rw_tac std_ss[trivial_integal_domain_def],
15843      rw_tac std_ss[trivial_integal_domain_def],
15844      (rw_tac std_ss[trivial_integal_domain_def] THEN metis_tac[]),
15845      rw_tac std_ss[trivial_integal_domain_def],
15846      rw_tac std_ss[trivial_integal_domain_def]
15847    ],
15848    rw[trivial_integal_domain_def]
15849  ]
15850QED
15851
15852(* ------------------------------------------------------------------------- *)
15853(* Z_p - Multiplication in Modulo of prime p.                                *)
15854(* ------------------------------------------------------------------------- *)
15855
15856(* Multiplication in Modulo of prime p *)
15857Definition ZP_def[nocompute]:
15858  ZP p :num ring =
15859   <| carrier := count p;
15860          sum := add_mod p;
15861         prod := times_mod p
15862    |>
15863End
15864(*
15865- type_of ``ZP p``;
15866> val it = ``:num ring`` : hol_type
15867*)
15868
15869(* Theorem: ZP p is an integral domain for prime p. *)
15870(* Proof: check definitions.
15871   The no-zero divisor property is given by EUCLID_LEMMA for prime p.
15872*)
15873Theorem ZP_integral_domain:
15874    !p. prime p ==> IntegralDomain (ZP p)
15875Proof
15876  rpt strip_tac >>
15877  `0 < p /\ 1 < p` by rw_tac std_ss[PRIME_POS, ONE_LT_PRIME] >>
15878  rw_tac std_ss[IntegralDomain_def, Ring_def] >-
15879  rw_tac std_ss[ZP_def, add_mod_abelian_group] >-
15880  rw_tac std_ss[ZP_def, times_mod_abelian_monoid] >-
15881  rw_tac std_ss[ZP_def, add_mod_def, count_def] >-
15882  rw_tac std_ss[ZP_def, times_mod_def] >-
15883 (pop_assum mp_tac >>
15884  pop_assum mp_tac >>
15885  pop_assum mp_tac >>
15886  rw_tac std_ss[ZP_def, add_mod_def, times_mod_def, count_def, GSPECIFICATION] >>
15887  metis_tac[LEFT_ADD_DISTRIB, MOD_PLUS, MOD_TIMES2, LESS_MOD, MOD_MOD]) >-
15888 (rw_tac std_ss[ZP_def, add_mod_def, times_mod_def] >>
15889  decide_tac) >>
15890  pop_assum mp_tac >>
15891  pop_assum mp_tac >>
15892  rw_tac std_ss[ZP_def, add_mod_def, times_mod_def, count_def, GSPECIFICATION] >>
15893  rw_tac std_ss[EUCLID_LEMMA, LESS_MOD]
15894QED
15895
15896(* Theorem: (ZP p).carrier is FINITE. *)
15897(* Proof: by FINITE_COUNT. *)
15898Theorem ZP_finite:
15899    !p. FINITE (ZP p).carrier
15900Proof
15901  rw[ZP_def]
15902QED
15903
15904(* Theorem: ZP p is a FINITE Integral Domain for prime p. *)
15905(* Proof: by ZP_integral_domain and ZP_finite. *)
15906Theorem ZP_finite_integral_domain:
15907    !p. prime p ==> FiniteIntegralDomain (ZP p)
15908Proof
15909  rw_tac std_ss[ZP_integral_domain, ZP_finite, FiniteIntegralDomain_def]
15910QED
15911
15912(* ------------------------------------------------------------------------- *)
15913(* Integers Z is the prototype Integral Domain.                              *)
15914(* ------------------------------------------------------------------------- *)
15915
15916(* ------------------------------------------------------------------------- *)