111 also from assms have "(1 div a) * (a * b) = b" |
111 also from assms have "(1 div a) * (a * b) = b" |
112 by (simp add: algebra_simps unit_div_mult_swap) |
112 by (simp add: algebra_simps unit_div_mult_swap) |
113 finally show "euclidean_size (a * b) \<le> euclidean_size b" . |
113 finally show "euclidean_size (a * b) \<le> euclidean_size b" . |
114 qed |
114 qed |
115 |
115 |
116 lemma euclidean_size_unit: "is_unit x \<Longrightarrow> euclidean_size x = euclidean_size 1" |
116 lemma euclidean_size_unit: "is_unit a \<Longrightarrow> euclidean_size a = euclidean_size 1" |
117 using euclidean_size_times_unit[of x 1] by simp |
117 using euclidean_size_times_unit[of a 1] by simp |
118 |
118 |
119 lemma unit_iff_euclidean_size: |
119 lemma unit_iff_euclidean_size: |
120 "is_unit x \<longleftrightarrow> euclidean_size x = euclidean_size 1 \<and> x \<noteq> 0" |
120 "is_unit a \<longleftrightarrow> euclidean_size a = euclidean_size 1 \<and> a \<noteq> 0" |
121 proof safe |
121 proof safe |
122 assume A: "x \<noteq> 0" and B: "euclidean_size x = euclidean_size 1" |
122 assume A: "a \<noteq> 0" and B: "euclidean_size a = euclidean_size 1" |
123 show "is_unit x" by (rule dvd_euclidean_size_eq_imp_dvd[OF A _ B]) simp_all |
123 show "is_unit a" by (rule dvd_euclidean_size_eq_imp_dvd[OF A _ B]) simp_all |
124 qed (auto intro: euclidean_size_unit) |
124 qed (auto intro: euclidean_size_unit) |
125 |
125 |
126 lemma euclidean_size_times_nonunit: |
126 lemma euclidean_size_times_nonunit: |
127 assumes "a \<noteq> 0" "b \<noteq> 0" "\<not>is_unit a" |
127 assumes "a \<noteq> 0" "b \<noteq> 0" "\<not>is_unit a" |
128 shows "euclidean_size b < euclidean_size (a * b)" |
128 shows "euclidean_size b < euclidean_size (a * b)" |
136 with \<open>b \<noteq> 0\<close> have "is_unit a" by (subst (asm) dvd_times_right_cancel_iff) |
136 with \<open>b \<noteq> 0\<close> have "is_unit a" by (subst (asm) dvd_times_right_cancel_iff) |
137 with assms(3) show False by contradiction |
137 with assms(3) show False by contradiction |
138 qed |
138 qed |
139 |
139 |
140 lemma dvd_imp_size_le: |
140 lemma dvd_imp_size_le: |
141 assumes "x dvd y" "y \<noteq> 0" |
141 assumes "a dvd b" "b \<noteq> 0" |
142 shows "euclidean_size x \<le> euclidean_size y" |
142 shows "euclidean_size a \<le> euclidean_size b" |
143 using assms by (auto elim!: dvdE simp: size_mult_mono) |
143 using assms by (auto elim!: dvdE simp: size_mult_mono) |
144 |
144 |
145 lemma dvd_proper_imp_size_less: |
145 lemma dvd_proper_imp_size_less: |
146 assumes "x dvd y" "\<not>y dvd x" "y \<noteq> 0" |
146 assumes "a dvd b" "\<not>b dvd a" "b \<noteq> 0" |
147 shows "euclidean_size x < euclidean_size y" |
147 shows "euclidean_size a < euclidean_size b" |
148 proof - |
148 proof - |
149 from assms(1) obtain z where "y = x * z" by (erule dvdE) |
149 from assms(1) obtain c where "b = a * c" by (erule dvdE) |
150 hence z: "y = z * x" by (simp add: mult.commute) |
150 hence z: "b = c * a" by (simp add: mult.commute) |
151 from z assms have "\<not>is_unit z" by (auto simp: mult.commute mult_unit_dvd_iff) |
151 from z assms have "\<not>is_unit c" by (auto simp: mult.commute mult_unit_dvd_iff) |
152 with z assms show ?thesis |
152 with z assms show ?thesis |
153 by (auto intro!: euclidean_size_times_nonunit simp: ) |
153 by (auto intro!: euclidean_size_times_nonunit simp: ) |
154 qed |
154 qed |
155 |
155 |
156 function gcd_eucl :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" |
156 function gcd_eucl :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" |
333 fixes lcm :: "'a set \<Rightarrow> 'a" |
333 fixes lcm :: "'a set \<Rightarrow> 'a" |
334 assumes "\<And>A a. a \<in> A \<Longrightarrow> a dvd lcm A" and "\<And>A c. (\<And>a. a \<in> A \<Longrightarrow> a dvd c) \<Longrightarrow> lcm A dvd c" |
334 assumes "\<And>A a. a \<in> A \<Longrightarrow> a dvd lcm A" and "\<And>A c. (\<And>a. a \<in> A \<Longrightarrow> a dvd c) \<Longrightarrow> lcm A dvd c" |
335 "\<And>A. normalize (lcm A) = lcm A" shows "lcm = Lcm_eucl" |
335 "\<And>A. normalize (lcm A) = lcm A" shows "lcm = Lcm_eucl" |
336 by (intro ext, rule associated_eqI) (auto simp: assms intro: Lcm_eucl_least) |
336 by (intro ext, rule associated_eqI) (auto simp: assms intro: Lcm_eucl_least) |
337 |
337 |
338 lemma Gcd_eucl_dvd: "x \<in> A \<Longrightarrow> Gcd_eucl A dvd x" |
338 lemma Gcd_eucl_dvd: "a \<in> A \<Longrightarrow> Gcd_eucl A dvd a" |
339 unfolding Gcd_eucl_def by (auto intro: Lcm_eucl_least) |
339 unfolding Gcd_eucl_def by (auto intro: Lcm_eucl_least) |
340 |
340 |
341 lemma Gcd_eucl_greatest: "(\<And>x. x \<in> A \<Longrightarrow> d dvd x) \<Longrightarrow> d dvd Gcd_eucl A" |
341 lemma Gcd_eucl_greatest: "(\<And>x. x \<in> A \<Longrightarrow> d dvd x) \<Longrightarrow> d dvd Gcd_eucl A" |
342 unfolding Gcd_eucl_def by auto |
342 unfolding Gcd_eucl_def by auto |
343 |
343 |
468 termination by (relation "measure (\<lambda>(_,b,_,_,_,_). euclidean_size b)") (simp_all add: mod_size_less) |
468 termination by (relation "measure (\<lambda>(_,b,_,_,_,_). euclidean_size b)") (simp_all add: mod_size_less) |
469 |
469 |
470 declare euclid_ext_aux.simps [simp del] |
470 declare euclid_ext_aux.simps [simp del] |
471 |
471 |
472 lemma euclid_ext_aux_correct: |
472 lemma euclid_ext_aux_correct: |
473 assumes "gcd_eucl r' r = gcd_eucl x y" |
473 assumes "gcd_eucl r' r = gcd_eucl a b" |
474 assumes "s' * x + t' * y = r'" |
474 assumes "s' * a + t' * b = r'" |
475 assumes "s * x + t * y = r" |
475 assumes "s * a + t * b = r" |
476 shows "case euclid_ext_aux r' r s' s t' t of (a,b,c) \<Rightarrow> |
476 shows "case euclid_ext_aux r' r s' s t' t of (x,y,c) \<Rightarrow> |
477 a * x + b * y = c \<and> c = gcd_eucl x y" (is "?P (euclid_ext_aux r' r s' s t' t)") |
477 x * a + y * b = c \<and> c = gcd_eucl a b" (is "?P (euclid_ext_aux r' r s' s t' t)") |
478 using assms |
478 using assms |
479 proof (induction r' r s' s t' t rule: euclid_ext_aux.induct) |
479 proof (induction r' r s' s t' t rule: euclid_ext_aux.induct) |
480 case (1 r' r s' s t' t) |
480 case (1 r' r s' s t' t) |
481 show ?case |
481 show ?case |
482 proof (cases "r = 0") |
482 proof (cases "r = 0") |
484 hence "euclid_ext_aux r' r s' s t' t = |
484 hence "euclid_ext_aux r' r s' s t' t = |
485 (s' div unit_factor r', t' div unit_factor r', normalize r')" |
485 (s' div unit_factor r', t' div unit_factor r', normalize r')" |
486 by (subst euclid_ext_aux.simps) (simp add: Let_def) |
486 by (subst euclid_ext_aux.simps) (simp add: Let_def) |
487 also have "?P \<dots>" |
487 also have "?P \<dots>" |
488 proof safe |
488 proof safe |
489 have "s' div unit_factor r' * x + t' div unit_factor r' * y = |
489 have "s' div unit_factor r' * a + t' div unit_factor r' * b = |
490 (s' * x + t' * y) div unit_factor r'" |
490 (s' * a + t' * b) div unit_factor r'" |
491 by (cases "r' = 0") (simp_all add: unit_div_commute) |
491 by (cases "r' = 0") (simp_all add: unit_div_commute) |
492 also have "s' * x + t' * y = r'" by fact |
492 also have "s' * a + t' * b = r'" by fact |
493 also have "\<dots> div unit_factor r' = normalize r'" by simp |
493 also have "\<dots> div unit_factor r' = normalize r'" by simp |
494 finally show "s' div unit_factor r' * x + t' div unit_factor r' * y = normalize r'" . |
494 finally show "s' div unit_factor r' * a + t' div unit_factor r' * b = normalize r'" . |
495 next |
495 next |
496 from "1.prems" True show "normalize r' = gcd_eucl x y" by (simp add: gcd_eucl_0) |
496 from "1.prems" True show "normalize r' = gcd_eucl a b" by (simp add: gcd_eucl_0) |
497 qed |
497 qed |
498 finally show ?thesis . |
498 finally show ?thesis . |
499 next |
499 next |
500 case False |
500 case False |
501 hence "euclid_ext_aux r' r s' s t' t = |
501 hence "euclid_ext_aux r' r s' s t' t = |
502 euclid_ext_aux r (r' mod r) s (s' - r' div r * s) t (t' - r' div r * t)" |
502 euclid_ext_aux r (r' mod r) s (s' - r' div r * s) t (t' - r' div r * t)" |
503 by (subst euclid_ext_aux.simps) (simp add: Let_def) |
503 by (subst euclid_ext_aux.simps) (simp add: Let_def) |
504 also from "1.prems" False have "?P \<dots>" |
504 also from "1.prems" False have "?P \<dots>" |
505 proof (intro "1.IH") |
505 proof (intro "1.IH") |
506 have "(s' - r' div r * s) * x + (t' - r' div r * t) * y = |
506 have "(s' - r' div r * s) * a + (t' - r' div r * t) * b = |
507 (s' * x + t' * y) - r' div r * (s * x + t * y)" by (simp add: algebra_simps) |
507 (s' * a + t' * b) - r' div r * (s * a + t * b)" by (simp add: algebra_simps) |
508 also have "s' * x + t' * y = r'" by fact |
508 also have "s' * a + t' * b = r'" by fact |
509 also have "s * x + t * y = r" by fact |
509 also have "s * a + t * b = r" by fact |
510 also have "r' - r' div r * r = r' mod r" using mod_div_equality [of r' r] |
510 also have "r' - r' div r * r = r' mod r" using mod_div_equality [of r' r] |
511 by (simp add: algebra_simps) |
511 by (simp add: algebra_simps) |
512 finally show "(s' - r' div r * s) * x + (t' - r' div r * t) * y = r' mod r" . |
512 finally show "(s' - r' div r * s) * a + (t' - r' div r * t) * b = r' mod r" . |
513 qed (auto simp: gcd_eucl_non_0 algebra_simps div_mod_equality') |
513 qed (auto simp: gcd_eucl_non_0 algebra_simps div_mod_equality') |
514 finally show ?thesis . |
514 finally show ?thesis . |
515 qed |
515 qed |
516 qed |
516 qed |
517 |
517 |
525 lemma euclid_ext_left_0: |
525 lemma euclid_ext_left_0: |
526 "euclid_ext 0 a = (0, 1 div unit_factor a, normalize a)" |
526 "euclid_ext 0 a = (0, 1 div unit_factor a, normalize a)" |
527 by (simp add: euclid_ext_def euclid_ext_aux.simps) |
527 by (simp add: euclid_ext_def euclid_ext_aux.simps) |
528 |
528 |
529 lemma euclid_ext_correct': |
529 lemma euclid_ext_correct': |
530 "case euclid_ext x y of (a,b,c) \<Rightarrow> a * x + b * y = c \<and> c = gcd_eucl x y" |
530 "case euclid_ext a b of (x,y,c) \<Rightarrow> x * a + y * b = c \<and> c = gcd_eucl a b" |
531 unfolding euclid_ext_def by (rule euclid_ext_aux_correct) simp_all |
531 unfolding euclid_ext_def by (rule euclid_ext_aux_correct) simp_all |
532 |
532 |
533 lemma euclid_ext_gcd_eucl: |
533 lemma euclid_ext_gcd_eucl: |
534 "(case euclid_ext x y of (a,b,c) \<Rightarrow> c) = gcd_eucl x y" |
534 "(case euclid_ext a b of (x,y,c) \<Rightarrow> c) = gcd_eucl a b" |
535 using euclid_ext_correct'[of x y] by (simp add: case_prod_unfold) |
535 using euclid_ext_correct'[of a b] by (simp add: case_prod_unfold) |
536 |
536 |
537 definition euclid_ext' where |
537 definition euclid_ext' where |
538 "euclid_ext' x y = (case euclid_ext x y of (a, b, _) \<Rightarrow> (a, b))" |
538 "euclid_ext' a b = (case euclid_ext a b of (x, y, _) \<Rightarrow> (x, y))" |
539 |
539 |
540 lemma euclid_ext'_correct': |
540 lemma euclid_ext'_correct': |
541 "case euclid_ext' x y of (a,b) \<Rightarrow> a * x + b * y = gcd_eucl x y" |
541 "case euclid_ext' a b of (x,y) \<Rightarrow> x * a + y * b = gcd_eucl a b" |
542 using euclid_ext_correct'[of x y] by (simp add: case_prod_unfold euclid_ext'_def) |
542 using euclid_ext_correct'[of a b] by (simp add: case_prod_unfold euclid_ext'_def) |
543 |
543 |
544 lemma euclid_ext'_0: "euclid_ext' a 0 = (1 div unit_factor a, 0)" |
544 lemma euclid_ext'_0: "euclid_ext' a 0 = (1 div unit_factor a, 0)" |
545 by (simp add: euclid_ext'_def euclid_ext_0) |
545 by (simp add: euclid_ext'_def euclid_ext_0) |
546 |
546 |
547 lemma euclid_ext'_left_0: "euclid_ext' 0 a = (0, 1 div unit_factor a)" |
547 lemma euclid_ext'_left_0: "euclid_ext' 0 a = (0, 1 div unit_factor a)" |
685 lemma euclid_ext_gcd' [simp]: |
685 lemma euclid_ext_gcd' [simp]: |
686 "euclid_ext a b = (r, s, t) \<Longrightarrow> t = gcd a b" |
686 "euclid_ext a b = (r, s, t) \<Longrightarrow> t = gcd a b" |
687 by (insert euclid_ext_gcd[of a b], drule (1) subst, simp) |
687 by (insert euclid_ext_gcd[of a b], drule (1) subst, simp) |
688 |
688 |
689 lemma euclid_ext_correct: |
689 lemma euclid_ext_correct: |
690 "case euclid_ext x y of (a,b,c) \<Rightarrow> a * x + b * y = c \<and> c = gcd x y" |
690 "case euclid_ext a b of (x,y,c) \<Rightarrow> x * a + y * b = c \<and> c = gcd a b" |
691 using euclid_ext_correct'[of x y] |
691 using euclid_ext_correct'[of a b] |
692 by (simp add: gcd_gcd_eucl case_prod_unfold) |
692 by (simp add: gcd_gcd_eucl case_prod_unfold) |
693 |
693 |
694 lemma euclid_ext'_correct: |
694 lemma euclid_ext'_correct: |
695 "fst (euclid_ext' a b) * a + snd (euclid_ext' a b) * b = gcd a b" |
695 "fst (euclid_ext' a b) * a + snd (euclid_ext' a b) * b = gcd a b" |
696 using euclid_ext_correct'[of a b] |
696 using euclid_ext_correct'[of a b] |