src/HOL/Number_Theory/Euclidean_Algorithm.thy
changeset 64177 006f303fb173
parent 64164 38c407446400
child 64240 eabf80376aab
equal deleted inserted replaced
64176:35644caa62a7 64177:006f303fb173
   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]