232 end |
232 end |
233 |
233 |
234 class euclidean_ring = euclidean_semiring + idom |
234 class euclidean_ring = euclidean_semiring + idom |
235 begin |
235 begin |
236 |
236 |
237 function euclid_ext :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<times> 'a \<times> 'a" where |
237 function euclid_ext_aux :: "'a \<Rightarrow> _" where |
238 "euclid_ext a b = |
238 "euclid_ext_aux r' r s' s t' t = ( |
239 (if b = 0 then |
239 if r = 0 then let c = 1 div unit_factor r' in (s' * c, t' * c, normalize r') |
240 (1 div unit_factor a, 0, normalize a) |
240 else let q = r' div r |
241 else |
241 in euclid_ext_aux r (r' mod r) s (s' - q * s) t (t' - q * t))" |
242 case euclid_ext b (a mod b) of |
242 by auto |
243 (s, t, c) \<Rightarrow> (t, s - t * (a div b), c))" |
243 termination by (relation "measure (\<lambda>(_,b,_,_,_,_). euclidean_size b)") (simp_all add: mod_size_less) |
244 by pat_completeness simp |
244 |
245 termination |
245 declare euclid_ext_aux.simps [simp del] |
246 by (relation "measure (euclidean_size \<circ> snd)") (simp_all add: mod_size_less) |
246 |
247 |
247 lemma euclid_ext_aux_correct: |
248 declare euclid_ext.simps [simp del] |
248 assumes "gcd_eucl r' r = gcd_eucl x y" |
|
249 assumes "s' * x + t' * y = r'" |
|
250 assumes "s * x + t * y = r" |
|
251 shows "case euclid_ext_aux r' r s' s t' t of (a,b,c) \<Rightarrow> |
|
252 a * x + b * y = c \<and> c = gcd_eucl x y" (is "?P (euclid_ext_aux r' r s' s t' t)") |
|
253 using assms |
|
254 proof (induction r' r s' s t' t rule: euclid_ext_aux.induct) |
|
255 case (1 r' r s' s t' t) |
|
256 show ?case |
|
257 proof (cases "r = 0") |
|
258 case True |
|
259 hence "euclid_ext_aux r' r s' s t' t = |
|
260 (s' div unit_factor r', t' div unit_factor r', normalize r')" |
|
261 by (subst euclid_ext_aux.simps) (simp add: Let_def) |
|
262 also have "?P \<dots>" |
|
263 proof safe |
|
264 have "s' div unit_factor r' * x + t' div unit_factor r' * y = |
|
265 (s' * x + t' * y) div unit_factor r'" |
|
266 by (cases "r' = 0") (simp_all add: unit_div_commute) |
|
267 also have "s' * x + t' * y = r'" by fact |
|
268 also have "\<dots> div unit_factor r' = normalize r'" by simp |
|
269 finally show "s' div unit_factor r' * x + t' div unit_factor r' * y = normalize r'" . |
|
270 next |
|
271 from "1.prems" True show "normalize r' = gcd_eucl x y" by (simp add: gcd_eucl_0) |
|
272 qed |
|
273 finally show ?thesis . |
|
274 next |
|
275 case False |
|
276 hence "euclid_ext_aux r' r s' s t' t = |
|
277 euclid_ext_aux r (r' mod r) s (s' - r' div r * s) t (t' - r' div r * t)" |
|
278 by (subst euclid_ext_aux.simps) (simp add: Let_def) |
|
279 also from "1.prems" False have "?P \<dots>" |
|
280 proof (intro "1.IH") |
|
281 have "(s' - r' div r * s) * x + (t' - r' div r * t) * y = |
|
282 (s' * x + t' * y) - r' div r * (s * x + t * y)" by (simp add: algebra_simps) |
|
283 also have "s' * x + t' * y = r'" by fact |
|
284 also have "s * x + t * y = r" by fact |
|
285 also have "r' - r' div r * r = r' mod r" using mod_div_equality[of r' r] |
|
286 by (simp add: algebra_simps) |
|
287 finally show "(s' - r' div r * s) * x + (t' - r' div r * t) * y = r' mod r" . |
|
288 qed (auto simp: gcd_eucl_non_0 algebra_simps div_mod_equality') |
|
289 finally show ?thesis . |
|
290 qed |
|
291 qed |
|
292 |
|
293 definition euclid_ext where |
|
294 "euclid_ext a b = euclid_ext_aux a b 1 0 0 1" |
249 |
295 |
250 lemma euclid_ext_0: |
296 lemma euclid_ext_0: |
251 "euclid_ext a 0 = (1 div unit_factor a, 0, normalize a)" |
297 "euclid_ext a 0 = (1 div unit_factor a, 0, normalize a)" |
252 by (simp add: euclid_ext.simps [of a 0]) |
298 by (simp add: euclid_ext_def euclid_ext_aux.simps) |
253 |
299 |
254 lemma euclid_ext_left_0: |
300 lemma euclid_ext_left_0: |
255 "euclid_ext 0 a = (0, 1 div unit_factor a, normalize a)" |
301 "euclid_ext 0 a = (0, 1 div unit_factor a, normalize a)" |
256 by (simp add: euclid_ext_0 euclid_ext.simps [of 0 a]) |
302 by (simp add: euclid_ext_def euclid_ext_aux.simps) |
257 |
303 |
258 lemma euclid_ext_non_0: |
304 lemma euclid_ext_correct': |
259 "b \<noteq> 0 \<Longrightarrow> euclid_ext a b = (case euclid_ext b (a mod b) of |
305 "case euclid_ext x y of (a,b,c) \<Rightarrow> a * x + b * y = c \<and> c = gcd_eucl x y" |
260 (s, t, c) \<Rightarrow> (t, s - t * (a div b), c))" |
306 unfolding euclid_ext_def by (rule euclid_ext_aux_correct) simp_all |
261 by (simp add: euclid_ext.simps [of a b] euclid_ext.simps [of b 0]) |
307 |
262 |
308 definition euclid_ext' where |
263 lemma euclid_ext_code [code]: |
309 "euclid_ext' x y = (case euclid_ext x y of (a, b, _) \<Rightarrow> (a, b))" |
264 "euclid_ext a b = (if b = 0 then (1 div unit_factor a, 0, normalize a) |
310 |
265 else let (s, t, c) = euclid_ext b (a mod b) in (t, s - t * (a div b), c))" |
311 lemma euclid_ext'_correct': |
266 by (simp add: euclid_ext.simps [of a b] euclid_ext.simps [of b 0]) |
312 "case euclid_ext' x y of (a,b) \<Rightarrow> a * x + b * y = gcd_eucl x y" |
267 |
313 using euclid_ext_correct'[of x y] by (simp add: case_prod_unfold euclid_ext'_def) |
268 lemma euclid_ext_correct: |
|
269 "case euclid_ext a b of (s, t, c) \<Rightarrow> s * a + t * b = c" |
|
270 proof (induct a b rule: gcd_eucl_induct) |
|
271 case (zero a) then show ?case |
|
272 by (simp add: euclid_ext_0 ac_simps) |
|
273 next |
|
274 case (mod a b) |
|
275 obtain s t c where stc: "euclid_ext b (a mod b) = (s,t,c)" |
|
276 by (cases "euclid_ext b (a mod b)") blast |
|
277 with mod have "c = s * b + t * (a mod b)" by simp |
|
278 also have "... = t * ((a div b) * b + a mod b) + (s - t * (a div b)) * b" |
|
279 by (simp add: algebra_simps) |
|
280 also have "(a div b) * b + a mod b = a" using mod_div_equality . |
|
281 finally show ?case |
|
282 by (subst euclid_ext.simps) (simp add: stc mod ac_simps) |
|
283 qed |
|
284 |
|
285 definition euclid_ext' :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<times> 'a" |
|
286 where |
|
287 "euclid_ext' a b = (case euclid_ext a b of (s, t, _) \<Rightarrow> (s, t))" |
|
288 |
314 |
289 lemma euclid_ext'_0: "euclid_ext' a 0 = (1 div unit_factor a, 0)" |
315 lemma euclid_ext'_0: "euclid_ext' a 0 = (1 div unit_factor a, 0)" |
290 by (simp add: euclid_ext'_def euclid_ext_0) |
316 by (simp add: euclid_ext'_def euclid_ext_0) |
291 |
317 |
292 lemma euclid_ext'_left_0: "euclid_ext' 0 a = (0, 1 div unit_factor a)" |
318 lemma euclid_ext'_left_0: "euclid_ext' 0 a = (0, 1 div unit_factor a)" |
293 by (simp add: euclid_ext'_def euclid_ext_left_0) |
319 by (simp add: euclid_ext'_def euclid_ext_left_0) |
294 |
|
295 lemma euclid_ext'_non_0: "b \<noteq> 0 \<Longrightarrow> euclid_ext' a b = (snd (euclid_ext' b (a mod b)), |
|
296 fst (euclid_ext' b (a mod b)) - snd (euclid_ext' b (a mod b)) * (a div b))" |
|
297 by (simp add: euclid_ext'_def euclid_ext_non_0 split_def) |
|
298 |
320 |
299 end |
321 end |
300 |
322 |
301 class euclidean_semiring_gcd = euclidean_semiring + gcd + Gcd + |
323 class euclidean_semiring_gcd = euclidean_semiring + gcd + Gcd + |
302 assumes gcd_gcd_eucl: "gcd = gcd_eucl" and lcm_lcm_eucl: "lcm = lcm_eucl" |
324 assumes gcd_gcd_eucl: "gcd = gcd_eucl" and lcm_lcm_eucl: "lcm = lcm_eucl" |
410 subclass euclidean_ring .. |
432 subclass euclidean_ring .. |
411 subclass ring_gcd .. |
433 subclass ring_gcd .. |
412 |
434 |
413 lemma euclid_ext_gcd [simp]: |
435 lemma euclid_ext_gcd [simp]: |
414 "(case euclid_ext a b of (_, _ , t) \<Rightarrow> t) = gcd a b" |
436 "(case euclid_ext a b of (_, _ , t) \<Rightarrow> t) = gcd a b" |
415 by (induct a b rule: gcd_eucl_induct) |
437 using euclid_ext_correct'[of a b] by (simp add: case_prod_unfold Let_def gcd_gcd_eucl) |
416 (simp_all add: euclid_ext_0 euclid_ext_non_0 ac_simps split: prod.split prod.split_asm) |
|
417 |
438 |
418 lemma euclid_ext_gcd' [simp]: |
439 lemma euclid_ext_gcd' [simp]: |
419 "euclid_ext a b = (r, s, t) \<Longrightarrow> t = gcd a b" |
440 "euclid_ext a b = (r, s, t) \<Longrightarrow> t = gcd a b" |
420 by (insert euclid_ext_gcd[of a b], drule (1) subst, simp) |
441 by (insert euclid_ext_gcd[of a b], drule (1) subst, simp) |
|
442 |
|
443 lemma euclid_ext_correct: |
|
444 "case euclid_ext x y of (a,b,c) \<Rightarrow> a * x + b * y = c \<and> c = gcd x y" |
|
445 using euclid_ext_correct'[of x y] |
|
446 by (simp add: gcd_gcd_eucl case_prod_unfold) |
421 |
447 |
422 lemma euclid_ext'_correct: |
448 lemma euclid_ext'_correct: |
423 "fst (euclid_ext' a b) * a + snd (euclid_ext' a b) * b = gcd a b" |
449 "fst (euclid_ext' a b) * a + snd (euclid_ext' a b) * b = gcd a b" |
424 proof- |
450 using euclid_ext_correct'[of a b] |
425 obtain s t c where "euclid_ext a b = (s,t,c)" |
451 by (simp add: gcd_gcd_eucl case_prod_unfold euclid_ext'_def) |
426 by (cases "euclid_ext a b", blast) |
|
427 with euclid_ext_correct[of a b] euclid_ext_gcd[of a b] |
|
428 show ?thesis unfolding euclid_ext'_def by simp |
|
429 qed |
|
430 |
452 |
431 lemma bezout: "\<exists>s t. s * a + t * b = gcd a b" |
453 lemma bezout: "\<exists>s t. s * a + t * b = gcd a b" |
432 using euclid_ext'_correct by blast |
454 using euclid_ext'_correct by blast |
433 |
455 |
434 end |
456 end |