diff --git a/src/HOL/Divides.thy b/src/HOL/Divides.thy --- a/src/HOL/Divides.thy +++ b/src/HOL/Divides.thy @@ -1,134 +1,129 @@ (* Title: HOL/Divides.thy *) section \Misc lemmas on division, to be sorted out finally\ theory Divides imports Parity begin class unique_euclidean_semiring_numeral = unique_euclidean_semiring_with_nat + linordered_semidom + assumes div_less [no_atp]: "0 \ a \ a < b \ a div b = 0" and mod_less [no_atp]: " 0 \ a \ a < b \ a mod b = a" and div_positive [no_atp]: "0 < b \ b \ a \ a div b > 0" and mod_less_eq_dividend [no_atp]: "0 \ a \ a mod b \ a" and pos_mod_bound [no_atp]: "0 < b \ a mod b < b" and pos_mod_sign [no_atp]: "0 < b \ 0 \ a mod b" and mod_mult2_eq [no_atp]: "0 \ c \ a mod (b * c) = b * (a div b mod c) + a mod b" and div_mult2_eq [no_atp]: "0 \ c \ a div (b * c) = a div b div c" assumes discrete [no_atp]: "a < b \ a + 1 \ b" hide_fact (open) div_less mod_less mod_less_eq_dividend mod_mult2_eq div_mult2_eq context unique_euclidean_semiring_numeral begin -context -begin - lemma divmod_digit_1 [no_atp]: assumes "0 \ a" "0 < b" and "b \ a mod (2 * b)" shows "2 * (a div (2 * b)) + 1 = a div b" (is "?P") and "a mod (2 * b) - b = a mod b" (is "?Q") proof - from assms mod_less_eq_dividend [of a "2 * b"] have "b \ a" by (auto intro: trans) with \0 < b\ have "0 < a div b" by (auto intro: div_positive) then have [simp]: "1 \ a div b" by (simp add: discrete) with \0 < b\ have mod_less: "a mod b < b" by (simp add: pos_mod_bound) define w where "w = a div b mod 2" then have w_exhaust: "w = 0 \ w = 1" by auto have mod_w: "a mod (2 * b) = a mod b + b * w" by (simp add: w_def mod_mult2_eq ac_simps) from assms w_exhaust have "w = 1" using mod_less by (auto simp add: mod_w) with mod_w have mod: "a mod (2 * b) = a mod b + b" by simp have "2 * (a div (2 * b)) = a div b - w" by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps) with \w = 1\ have div: "2 * (a div (2 * b)) = a div b - 1" by simp then show ?P and ?Q by (simp_all add: div mod add_implies_diff [symmetric]) qed lemma divmod_digit_0 [no_atp]: assumes "0 < b" and "a mod (2 * b) < b" shows "2 * (a div (2 * b)) = a div b" (is "?P") and "a mod (2 * b) = a mod b" (is "?Q") proof - define w where "w = a div b mod 2" then have w_exhaust: "w = 0 \ w = 1" by auto have mod_w: "a mod (2 * b) = a mod b + b * w" by (simp add: w_def mod_mult2_eq ac_simps) moreover have "b \ a mod b + b" proof - from \0 < b\ pos_mod_sign have "0 \ a mod b" by blast then have "0 + b \ a mod b + b" by (rule add_right_mono) then show ?thesis by simp qed moreover note assms w_exhaust ultimately have "w = 0" by auto with mod_w have mod: "a mod (2 * b) = a mod b" by simp have "2 * (a div (2 * b)) = a div b - w" by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps) with \w = 0\ have div: "2 * (a div (2 * b)) = a div b" by simp then show ?P and ?Q by (simp_all add: div mod) qed -lemma mod_double_modulus: \\This is actually useful and should be transferred to a suitable type class\ +lemma mod_double_modulus [no_atp]: assumes "m > 0" "x \ 0" shows "x mod (2 * m) = x mod m \ x mod (2 * m) = x mod m + m" proof (cases "x mod (2 * m) < m") case True thus ?thesis using assms using divmod_digit_0(2)[of m x] by auto next case False hence *: "x mod (2 * m) - m = x mod m" using assms by (intro divmod_digit_1) auto hence "x mod (2 * m) = x mod m + m" by (subst * [symmetric], subst le_add_diff_inverse2) (use False in auto) thus ?thesis by simp qed end -end - instance nat :: unique_euclidean_semiring_numeral by standard (auto simp add: div_greater_zero_iff div_mult2_eq mod_mult2_eq) instance int :: unique_euclidean_semiring_numeral by standard (auto intro: zmod_le_nonneg_dividend simp add: pos_imp_zdiv_pos_iff zmod_zmult2_eq zdiv_zmult2_eq) (* REVISIT: should this be generalized to all semiring_div types? *) lemma zmod_eq_0D [dest!]: "\q. m = d * q" if "m mod d = 0" for m d :: int using that by auto lemma div_geq [no_atp]: "m div n = Suc ((m - n) div n)" if "0 < n" and " \ m < n" for m n :: nat by (rule le_div_geq) (use that in \simp_all add: not_less\) lemma mod_geq [no_atp]: "m mod n = (m - n) mod n" if "\ m < n" for m n :: nat by (rule le_mod_geq) (use that in \simp add: not_less\) lemma mod_eq_0D [no_atp]: "\q. m = d * q" if "m mod d = 0" for m d :: nat using that by (auto simp add: mod_eq_0_iff_dvd) lemma pos_mod_conj [no_atp]: "0 < b \ 0 \ a mod b \ a mod b < b" for a b :: int by simp lemma neg_mod_conj [no_atp]: "b < 0 \ a mod b \ 0 \ b < a mod b" for a b :: int by simp lemma zmod_eq_0_iff [no_atp]: "m mod d = 0 \ (\q. m = d * q)" for m d :: int by (auto simp add: mod_eq_0_iff_dvd) lemma div_positive_int [no_atp]: "k div l > 0" if "k \ l" and "l > 0" for k l :: int using that by (simp add: nonneg1_imp_zdiv_pos_iff) code_identifier code_module Divides \ (SML) Arith and (OCaml) Arith and (Haskell) Arith end diff --git a/src/HOL/Euclidean_Rings.thy b/src/HOL/Euclidean_Rings.thy --- a/src/HOL/Euclidean_Rings.thy +++ b/src/HOL/Euclidean_Rings.thy @@ -1,2740 +1,2739 @@ (* Title: HOL/Euclidean_Rgins.thy Author: Manuel Eberl, TU Muenchen Author: Florian Haftmann, TU Muenchen *) section \Division in euclidean (semi)rings\ theory Euclidean_Rings imports Int Lattices_Big begin subsection \Euclidean (semi)rings with explicit division and remainder\ class euclidean_semiring = semidom_modulo + fixes euclidean_size :: "'a \ nat" assumes size_0 [simp]: "euclidean_size 0 = 0" assumes mod_size_less: "b \ 0 \ euclidean_size (a mod b) < euclidean_size b" assumes size_mult_mono: "b \ 0 \ euclidean_size a \ euclidean_size (a * b)" begin lemma euclidean_size_eq_0_iff [simp]: "euclidean_size b = 0 \ b = 0" proof assume "b = 0" then show "euclidean_size b = 0" by simp next assume "euclidean_size b = 0" show "b = 0" proof (rule ccontr) assume "b \ 0" with mod_size_less have "euclidean_size (b mod b) < euclidean_size b" . with \euclidean_size b = 0\ show False by simp qed qed lemma euclidean_size_greater_0_iff [simp]: "euclidean_size b > 0 \ b \ 0" using euclidean_size_eq_0_iff [symmetric, of b] by safe simp lemma size_mult_mono': "b \ 0 \ euclidean_size a \ euclidean_size (b * a)" by (subst mult.commute) (rule size_mult_mono) lemma dvd_euclidean_size_eq_imp_dvd: assumes "a \ 0" and "euclidean_size a = euclidean_size b" and "b dvd a" shows "a dvd b" proof (rule ccontr) assume "\ a dvd b" hence "b mod a \ 0" using mod_0_imp_dvd [of b a] by blast then have "b mod a \ 0" by (simp add: mod_eq_0_iff_dvd) from \b dvd a\ have "b dvd b mod a" by (simp add: dvd_mod_iff) then obtain c where "b mod a = b * c" unfolding dvd_def by blast with \b mod a \ 0\ have "c \ 0" by auto with \b mod a = b * c\ have "euclidean_size (b mod a) \ euclidean_size b" using size_mult_mono by force moreover from \\ a dvd b\ and \a \ 0\ have "euclidean_size (b mod a) < euclidean_size a" using mod_size_less by blast ultimately show False using \euclidean_size a = euclidean_size b\ by simp qed lemma euclidean_size_times_unit: assumes "is_unit a" shows "euclidean_size (a * b) = euclidean_size b" proof (rule antisym) from assms have [simp]: "a \ 0" by auto thus "euclidean_size (a * b) \ euclidean_size b" by (rule size_mult_mono') from assms have "is_unit (1 div a)" by simp hence "1 div a \ 0" by (intro notI) simp_all hence "euclidean_size (a * b) \ euclidean_size ((1 div a) * (a * b))" by (rule size_mult_mono') also from assms have "(1 div a) * (a * b) = b" by (simp add: algebra_simps unit_div_mult_swap) finally show "euclidean_size (a * b) \ euclidean_size b" . qed lemma euclidean_size_unit: "is_unit a \ euclidean_size a = euclidean_size 1" using euclidean_size_times_unit [of a 1] by simp lemma unit_iff_euclidean_size: "is_unit a \ euclidean_size a = euclidean_size 1 \ a \ 0" proof safe assume A: "a \ 0" and B: "euclidean_size a = euclidean_size 1" show "is_unit a" by (rule dvd_euclidean_size_eq_imp_dvd [OF A B]) simp_all qed (auto intro: euclidean_size_unit) lemma euclidean_size_times_nonunit: assumes "a \ 0" "b \ 0" "\ is_unit a" shows "euclidean_size b < euclidean_size (a * b)" proof (rule ccontr) assume "\euclidean_size b < euclidean_size (a * b)" with size_mult_mono'[OF assms(1), of b] have eq: "euclidean_size (a * b) = euclidean_size b" by simp have "a * b dvd b" by (rule dvd_euclidean_size_eq_imp_dvd [OF _ eq]) (use assms in simp_all) hence "a * b dvd 1 * b" by simp with \b \ 0\ have "is_unit a" by (subst (asm) dvd_times_right_cancel_iff) with assms(3) show False by contradiction qed lemma dvd_imp_size_le: assumes "a dvd b" "b \ 0" shows "euclidean_size a \ euclidean_size b" using assms by (auto simp: size_mult_mono) lemma dvd_proper_imp_size_less: assumes "a dvd b" "\ b dvd a" "b \ 0" shows "euclidean_size a < euclidean_size b" proof - from assms(1) obtain c where "b = a * c" by (erule dvdE) hence z: "b = c * a" by (simp add: mult.commute) from z assms have "\is_unit c" by (auto simp: mult.commute mult_unit_dvd_iff) with z assms show ?thesis by (auto intro!: euclidean_size_times_nonunit) qed lemma unit_imp_mod_eq_0: "a mod b = 0" if "is_unit b" using that by (simp add: mod_eq_0_iff_dvd unit_imp_dvd) lemma mod_eq_self_iff_div_eq_0: "a mod b = a \ a div b = 0" (is "?P \ ?Q") proof assume ?P with div_mult_mod_eq [of a b] show ?Q by auto next assume ?Q with div_mult_mod_eq [of a b] show ?P by simp qed lemma coprime_mod_left_iff [simp]: "coprime (a mod b) b \ coprime a b" if "b \ 0" by (rule iffI; rule coprimeI) (use that in \auto dest!: dvd_mod_imp_dvd coprime_common_divisor simp add: dvd_mod_iff\) lemma coprime_mod_right_iff [simp]: "coprime a (b mod a) \ coprime a b" if "a \ 0" using that coprime_mod_left_iff [of a b] by (simp add: ac_simps) end class euclidean_ring = idom_modulo + euclidean_semiring begin lemma dvd_diff_commute [ac_simps]: "a dvd c - b \ a dvd b - c" proof - have "a dvd c - b \ a dvd (c - b) * - 1" by (subst dvd_mult_unit_iff) simp_all then show ?thesis by simp qed end subsection \Euclidean (semi)rings with cancel rules\ class euclidean_semiring_cancel = euclidean_semiring + assumes div_mult_self1 [simp]: "b \ 0 \ (a + c * b) div b = c + a div b" and div_mult_mult1 [simp]: "c \ 0 \ (c * a) div (c * b) = a div b" begin lemma div_mult_self2 [simp]: assumes "b \ 0" shows "(a + b * c) div b = c + a div b" using assms div_mult_self1 [of b a c] by (simp add: mult.commute) lemma div_mult_self3 [simp]: assumes "b \ 0" shows "(c * b + a) div b = c + a div b" using assms by (simp add: add.commute) lemma div_mult_self4 [simp]: assumes "b \ 0" shows "(b * c + a) div b = c + a div b" using assms by (simp add: add.commute) lemma mod_mult_self1 [simp]: "(a + c * b) mod b = a mod b" proof (cases "b = 0") case True then show ?thesis by simp next case False have "a + c * b = (a + c * b) div b * b + (a + c * b) mod b" by (simp add: div_mult_mod_eq) also from False div_mult_self1 [of b a c] have "\ = (c + a div b) * b + (a + c * b) mod b" by (simp add: algebra_simps) finally have "a = a div b * b + (a + c * b) mod b" by (simp add: add.commute [of a] add.assoc distrib_right) then have "a div b * b + (a + c * b) mod b = a div b * b + a mod b" by (simp add: div_mult_mod_eq) then show ?thesis by simp qed lemma mod_mult_self2 [simp]: "(a + b * c) mod b = a mod b" by (simp add: mult.commute [of b]) lemma mod_mult_self3 [simp]: "(c * b + a) mod b = a mod b" by (simp add: add.commute) lemma mod_mult_self4 [simp]: "(b * c + a) mod b = a mod b" by (simp add: add.commute) lemma mod_mult_self1_is_0 [simp]: "b * a mod b = 0" using mod_mult_self2 [of 0 b a] by simp lemma mod_mult_self2_is_0 [simp]: "a * b mod b = 0" using mod_mult_self1 [of 0 a b] by simp lemma div_add_self1: assumes "b \ 0" shows "(b + a) div b = a div b + 1" using assms div_mult_self1 [of b a 1] by (simp add: add.commute) lemma div_add_self2: assumes "b \ 0" shows "(a + b) div b = a div b + 1" using assms div_add_self1 [of b a] by (simp add: add.commute) lemma mod_add_self1 [simp]: "(b + a) mod b = a mod b" using mod_mult_self1 [of a 1 b] by (simp add: add.commute) lemma mod_add_self2 [simp]: "(a + b) mod b = a mod b" using mod_mult_self1 [of a 1 b] by simp lemma mod_div_trivial [simp]: "a mod b div b = 0" proof (cases "b = 0") assume "b = 0" thus ?thesis by simp next assume "b \ 0" hence "a div b + a mod b div b = (a mod b + a div b * b) div b" by (rule div_mult_self1 [symmetric]) also have "\ = a div b" by (simp only: mod_div_mult_eq) also have "\ = a div b + 0" by simp finally show ?thesis by (rule add_left_imp_eq) qed lemma mod_mod_trivial [simp]: "a mod b mod b = a mod b" proof - have "a mod b mod b = (a mod b + a div b * b) mod b" by (simp only: mod_mult_self1) also have "\ = a mod b" by (simp only: mod_div_mult_eq) finally show ?thesis . qed lemma mod_mod_cancel: assumes "c dvd b" shows "a mod b mod c = a mod c" proof - from \c dvd b\ obtain k where "b = c * k" by (rule dvdE) have "a mod b mod c = a mod (c * k) mod c" by (simp only: \b = c * k\) also have "\ = (a mod (c * k) + a div (c * k) * k * c) mod c" by (simp only: mod_mult_self1) also have "\ = (a div (c * k) * (c * k) + a mod (c * k)) mod c" by (simp only: ac_simps) also have "\ = a mod c" by (simp only: div_mult_mod_eq) finally show ?thesis . qed lemma div_mult_mult2 [simp]: "c \ 0 \ (a * c) div (b * c) = a div b" by (drule div_mult_mult1) (simp add: mult.commute) lemma div_mult_mult1_if [simp]: "(c * a) div (c * b) = (if c = 0 then 0 else a div b)" by simp_all lemma mod_mult_mult1: "(c * a) mod (c * b) = c * (a mod b)" proof (cases "c = 0") case True then show ?thesis by simp next case False from div_mult_mod_eq have "((c * a) div (c * b)) * (c * b) + (c * a) mod (c * b) = c * a" . with False have "c * ((a div b) * b + a mod b) + (c * a) mod (c * b) = c * a + c * (a mod b)" by (simp add: algebra_simps) with div_mult_mod_eq show ?thesis by simp qed lemma mod_mult_mult2: "(a * c) mod (b * c) = (a mod b) * c" using mod_mult_mult1 [of c a b] by (simp add: mult.commute) lemma mult_mod_left: "(a mod b) * c = (a * c) mod (b * c)" by (fact mod_mult_mult2 [symmetric]) lemma mult_mod_right: "c * (a mod b) = (c * a) mod (c * b)" by (fact mod_mult_mult1 [symmetric]) lemma dvd_mod: "k dvd m \ k dvd n \ k dvd (m mod n)" unfolding dvd_def by (auto simp add: mod_mult_mult1) lemma div_plus_div_distrib_dvd_left: "c dvd a \ (a + b) div c = a div c + b div c" by (cases "c = 0") auto lemma div_plus_div_distrib_dvd_right: "c dvd b \ (a + b) div c = a div c + b div c" using div_plus_div_distrib_dvd_left [of c b a] by (simp add: ac_simps) lemma sum_div_partition: \(\a\A. f a) div b = (\a\A \ {a. b dvd f a}. f a div b) + (\a\A \ {a. \ b dvd f a}. f a) div b\ if \finite A\ proof - have \A = A \ {a. b dvd f a} \ A \ {a. \ b dvd f a}\ by auto then have \(\a\A. f a) = (\a\A \ {a. b dvd f a} \ A \ {a. \ b dvd f a}. f a)\ by simp also have \\ = (\a\A \ {a. b dvd f a}. f a) + (\a\A \ {a. \ b dvd f a}. f a)\ using \finite A\ by (auto intro: sum.union_inter_neutral) finally have *: \sum f A = sum f (A \ {a. b dvd f a}) + sum f (A \ {a. \ b dvd f a})\ . define B where B: \B = A \ {a. b dvd f a}\ with \finite A\ have \finite B\ and \a \ B \ b dvd f a\ for a by simp_all then have \(\a\B. f a) div b = (\a\B. f a div b)\ and \b dvd (\a\B. f a)\ by induction (simp_all add: div_plus_div_distrib_dvd_left) then show ?thesis using * by (simp add: B div_plus_div_distrib_dvd_left) qed named_theorems mod_simps text \Addition respects modular equivalence.\ lemma mod_add_left_eq [mod_simps]: "(a mod c + b) mod c = (a + b) mod c" proof - have "(a + b) mod c = (a div c * c + a mod c + b) mod c" by (simp only: div_mult_mod_eq) also have "\ = (a mod c + b + a div c * c) mod c" by (simp only: ac_simps) also have "\ = (a mod c + b) mod c" by (rule mod_mult_self1) finally show ?thesis by (rule sym) qed lemma mod_add_right_eq [mod_simps]: "(a + b mod c) mod c = (a + b) mod c" using mod_add_left_eq [of b c a] by (simp add: ac_simps) lemma mod_add_eq: "(a mod c + b mod c) mod c = (a + b) mod c" by (simp add: mod_add_left_eq mod_add_right_eq) lemma mod_sum_eq [mod_simps]: "(\i\A. f i mod a) mod a = sum f A mod a" proof (induct A rule: infinite_finite_induct) case (insert i A) then have "(\i\insert i A. f i mod a) mod a = (f i mod a + (\i\A. f i mod a)) mod a" by simp also have "\ = (f i + (\i\A. f i mod a) mod a) mod a" by (simp add: mod_simps) also have "\ = (f i + (\i\A. f i) mod a) mod a" by (simp add: insert.hyps) finally show ?case by (simp add: insert.hyps mod_simps) qed simp_all lemma mod_add_cong: assumes "a mod c = a' mod c" assumes "b mod c = b' mod c" shows "(a + b) mod c = (a' + b') mod c" proof - have "(a mod c + b mod c) mod c = (a' mod c + b' mod c) mod c" unfolding assms .. then show ?thesis by (simp add: mod_add_eq) qed text \Multiplication respects modular equivalence.\ lemma mod_mult_left_eq [mod_simps]: "((a mod c) * b) mod c = (a * b) mod c" proof - have "(a * b) mod c = ((a div c * c + a mod c) * b) mod c" by (simp only: div_mult_mod_eq) also have "\ = (a mod c * b + a div c * b * c) mod c" by (simp only: algebra_simps) also have "\ = (a mod c * b) mod c" by (rule mod_mult_self1) finally show ?thesis by (rule sym) qed lemma mod_mult_right_eq [mod_simps]: "(a * (b mod c)) mod c = (a * b) mod c" using mod_mult_left_eq [of b c a] by (simp add: ac_simps) lemma mod_mult_eq: "((a mod c) * (b mod c)) mod c = (a * b) mod c" by (simp add: mod_mult_left_eq mod_mult_right_eq) lemma mod_prod_eq [mod_simps]: "(\i\A. f i mod a) mod a = prod f A mod a" proof (induct A rule: infinite_finite_induct) case (insert i A) then have "(\i\insert i A. f i mod a) mod a = (f i mod a * (\i\A. f i mod a)) mod a" by simp also have "\ = (f i * ((\i\A. f i mod a) mod a)) mod a" by (simp add: mod_simps) also have "\ = (f i * ((\i\A. f i) mod a)) mod a" by (simp add: insert.hyps) finally show ?case by (simp add: insert.hyps mod_simps) qed simp_all lemma mod_mult_cong: assumes "a mod c = a' mod c" assumes "b mod c = b' mod c" shows "(a * b) mod c = (a' * b') mod c" proof - have "(a mod c * (b mod c)) mod c = (a' mod c * (b' mod c)) mod c" unfolding assms .. then show ?thesis by (simp add: mod_mult_eq) qed text \Exponentiation respects modular equivalence.\ lemma power_mod [mod_simps]: "((a mod b) ^ n) mod b = (a ^ n) mod b" proof (induct n) case 0 then show ?case by simp next case (Suc n) have "(a mod b) ^ Suc n mod b = (a mod b) * ((a mod b) ^ n mod b) mod b" by (simp add: mod_mult_right_eq) with Suc show ?case by (simp add: mod_mult_left_eq mod_mult_right_eq) qed lemma power_diff_power_eq: \a ^ m div a ^ n = (if n \ m then a ^ (m - n) else 1 div a ^ (n - m))\ if \a \ 0\ proof (cases \n \ m\) case True with that power_diff [symmetric, of a n m] show ?thesis by simp next case False then obtain q where n: \n = m + Suc q\ by (auto simp add: not_le dest: less_imp_Suc_add) then have \a ^ m div a ^ n = (a ^ m * 1) div (a ^ m * a ^ Suc q)\ by (simp add: power_add ac_simps) moreover from that have \a ^ m \ 0\ by simp ultimately have \a ^ m div a ^ n = 1 div a ^ Suc q\ by (subst (asm) div_mult_mult1) simp with False n show ?thesis by simp qed end class euclidean_ring_cancel = euclidean_ring + euclidean_semiring_cancel begin subclass idom_divide .. lemma div_minus_minus [simp]: "(- a) div (- b) = a div b" using div_mult_mult1 [of "- 1" a b] by simp lemma mod_minus_minus [simp]: "(- a) mod (- b) = - (a mod b)" using mod_mult_mult1 [of "- 1" a b] by simp lemma div_minus_right: "a div (- b) = (- a) div b" using div_minus_minus [of "- a" b] by simp lemma mod_minus_right: "a mod (- b) = - ((- a) mod b)" using mod_minus_minus [of "- a" b] by simp lemma div_minus1_right [simp]: "a div (- 1) = - a" using div_minus_right [of a 1] by simp lemma mod_minus1_right [simp]: "a mod (- 1) = 0" using mod_minus_right [of a 1] by simp text \Negation respects modular equivalence.\ lemma mod_minus_eq [mod_simps]: "(- (a mod b)) mod b = (- a) mod b" proof - have "(- a) mod b = (- (a div b * b + a mod b)) mod b" by (simp only: div_mult_mod_eq) also have "\ = (- (a mod b) + - (a div b) * b) mod b" by (simp add: ac_simps) also have "\ = (- (a mod b)) mod b" by (rule mod_mult_self1) finally show ?thesis by (rule sym) qed lemma mod_minus_cong: assumes "a mod b = a' mod b" shows "(- a) mod b = (- a') mod b" proof - have "(- (a mod b)) mod b = (- (a' mod b)) mod b" unfolding assms .. then show ?thesis by (simp add: mod_minus_eq) qed text \Subtraction respects modular equivalence.\ lemma mod_diff_left_eq [mod_simps]: "(a mod c - b) mod c = (a - b) mod c" using mod_add_cong [of a c "a mod c" "- b" "- b"] by simp lemma mod_diff_right_eq [mod_simps]: "(a - b mod c) mod c = (a - b) mod c" using mod_add_cong [of a c a "- b" "- (b mod c)"] mod_minus_cong [of "b mod c" c b] by simp lemma mod_diff_eq: "(a mod c - b mod c) mod c = (a - b) mod c" using mod_add_cong [of a c "a mod c" "- b" "- (b mod c)"] mod_minus_cong [of "b mod c" c b] by simp lemma mod_diff_cong: assumes "a mod c = a' mod c" assumes "b mod c = b' mod c" shows "(a - b) mod c = (a' - b') mod c" using assms mod_add_cong [of a c a' "- b" "- b'"] mod_minus_cong [of b c "b'"] by simp lemma minus_mod_self2 [simp]: "(a - b) mod b = a mod b" using mod_diff_right_eq [of a b b] by (simp add: mod_diff_right_eq) lemma minus_mod_self1 [simp]: "(b - a) mod b = - a mod b" using mod_add_self2 [of "- a" b] by simp lemma mod_eq_dvd_iff: "a mod c = b mod c \ c dvd a - b" (is "?P \ ?Q") proof assume ?P then have "(a mod c - b mod c) mod c = 0" by simp then show ?Q by (simp add: dvd_eq_mod_eq_0 mod_simps) next assume ?Q then obtain d where d: "a - b = c * d" .. then have "a = c * d + b" by (simp add: algebra_simps) then show ?P by simp qed lemma mod_eqE: assumes "a mod c = b mod c" obtains d where "b = a + c * d" proof - from assms have "c dvd a - b" by (simp add: mod_eq_dvd_iff) then obtain d where "a - b = c * d" .. then have "b = a + c * - d" by (simp add: algebra_simps) with that show thesis . qed lemma invertible_coprime: "coprime a c" if "a * b mod c = 1" by (rule coprimeI) (use that dvd_mod_iff [of _ c "a * b"] in auto) end subsection \Uniquely determined division\ class unique_euclidean_semiring = euclidean_semiring + assumes euclidean_size_mult: \euclidean_size (a * b) = euclidean_size a * euclidean_size b\ fixes division_segment :: \'a \ 'a\ assumes is_unit_division_segment [simp]: \is_unit (division_segment a)\ and division_segment_mult: \a \ 0 \ b \ 0 \ division_segment (a * b) = division_segment a * division_segment b\ and division_segment_mod: \b \ 0 \ \ b dvd a \ division_segment (a mod b) = division_segment b\ assumes div_bounded: \b \ 0 \ division_segment r = division_segment b \ euclidean_size r < euclidean_size b \ (q * b + r) div b = q\ begin lemma division_segment_not_0 [simp]: \division_segment a \ 0\ using is_unit_division_segment [of a] is_unitE [of \division_segment a\] by blast lemma euclidean_relationI [case_names by0 divides euclidean_relation]: \(a div b, a mod b) = (q, r)\ if by0: \b = 0 \ q = 0 \ r = a\ and divides: \b \ 0 \ b dvd a \ r = 0 \ a = q * b\ and euclidean_relation: \b \ 0 \ \ b dvd a \ division_segment r = division_segment b \ euclidean_size r < euclidean_size b \ a = q * b + r\ proof (cases \b = 0\) case True with by0 show ?thesis by simp next case False show ?thesis proof (cases \b dvd a\) case True with \b \ 0\ divides show ?thesis by simp next case False with \b \ 0\ euclidean_relation have \division_segment r = division_segment b\ \euclidean_size r < euclidean_size b\ \a = q * b + r\ by simp_all from \b \ 0\ \division_segment r = division_segment b\ \euclidean_size r < euclidean_size b\ have \(q * b + r) div b = q\ by (rule div_bounded) with \a = q * b + r\ have \q = a div b\ by simp from \a = q * b + r\ have \a div b * b + a mod b = q * b + r\ by (simp add: div_mult_mod_eq) with \q = a div b\ have \q * b + a mod b = q * b + r\ by simp then have \r = a mod b\ by simp with \q = a div b\ show ?thesis by simp qed qed subclass euclidean_semiring_cancel proof fix a b c assume \b \ 0\ have \((a + c * b) div b, (a + c * b) mod b) = (c + a div b, a mod b)\ proof (induction rule: euclidean_relationI) case by0 with \b \ 0\ show ?case by simp next case divides then show ?case by (simp add: algebra_simps dvd_add_left_iff) next case euclidean_relation then have \\ b dvd a\ by (simp add: dvd_add_left_iff) have \a mod b + (b * c + b * (a div b)) = b * c + ((a div b) * b + a mod b)\ by (simp add: ac_simps) with \b \ 0\ have *: \a mod b + (b * c + b * (a div b)) = b * c + a\ by (simp add: div_mult_mod_eq) from \\ b dvd a\ euclidean_relation show ?case by (simp_all add: algebra_simps division_segment_mod mod_size_less *) qed then show \(a + c * b) div b = c + a div b\ by simp next fix a b c assume \c \ 0\ have \((c * a) div (c * b), (c * a) mod (c * b)) = (a div b, c * (a mod b))\ proof (induction rule: euclidean_relationI) case by0 with \c \ 0\ show ?case by simp next case divides then show ?case by (auto simp add: algebra_simps) next case euclidean_relation then have \b \ 0\ \a mod b \ 0\ by (simp_all add: mod_eq_0_iff_dvd) have \c * (a mod b) + b * (c * (a div b)) = c * ((a div b) * b + a mod b)\ by (simp add: algebra_simps) with \b \ 0\ have *: \c * (a mod b) + b * (c * (a div b)) = c * a\ by (simp add: div_mult_mod_eq) from \b \ 0\ \c \ 0\ have \euclidean_size c * euclidean_size (a mod b) < euclidean_size c * euclidean_size b\ using mod_size_less [of b a] by simp with euclidean_relation \b \ 0\ \a mod b \ 0\ show ?case by (simp add: algebra_simps division_segment_mult division_segment_mod euclidean_size_mult *) qed then show \(c * a) div (c * b) = a div b\ by simp qed lemma div_eq_0_iff: \a div b = 0 \ euclidean_size a < euclidean_size b \ b = 0\ (is "_ \ ?P") if \division_segment a = division_segment b\ proof (cases \a = 0 \ b = 0\) case True then show ?thesis by auto next case False then have \a \ 0\ \b \ 0\ by simp_all have \a div b = 0 \ euclidean_size a < euclidean_size b\ proof assume \a div b = 0\ then have \a mod b = a\ using div_mult_mod_eq [of a b] by simp with \b \ 0\ mod_size_less [of b a] show \euclidean_size a < euclidean_size b\ by simp next assume \euclidean_size a < euclidean_size b\ have \(a div b, a mod b) = (0, a)\ proof (induction rule: euclidean_relationI) case by0 show ?case by simp next case divides with \euclidean_size a < euclidean_size b\ show ?case using dvd_imp_size_le [of b a] \a \ 0\ by simp next case euclidean_relation with \euclidean_size a < euclidean_size b\ that show ?case by simp qed then show \a div b = 0\ by simp qed with \b \ 0\ show ?thesis by simp qed lemma div_mult1_eq: \(a * b) div c = a * (b div c) + a * (b mod c) div c\ proof - have *: \(a * b) mod c + (a * (c * (b div c)) + c * (a * (b mod c) div c)) = a * b\ (is \?A + (?B + ?C) = _\) proof - have \?A = a * (b mod c) mod c\ by (simp add: mod_mult_right_eq) then have \?C + ?A = a * (b mod c)\ by (simp add: mult_div_mod_eq) then have \?B + (?C + ?A) = a * (c * (b div c) + (b mod c))\ by (simp add: algebra_simps) also have \\ = a * b\ by (simp add: mult_div_mod_eq) finally show ?thesis by (simp add: algebra_simps) qed have \((a * b) div c, (a * b) mod c) = (a * (b div c) + a * (b mod c) div c, (a * b) mod c)\ proof (induction rule: euclidean_relationI) case by0 then show ?case by simp next case divides with * show ?case by (simp add: algebra_simps) next case euclidean_relation with * show ?case by (simp add: division_segment_mod mod_size_less algebra_simps) qed then show ?thesis by simp qed lemma div_add1_eq: \(a + b) div c = a div c + b div c + (a mod c + b mod c) div c\ proof - have *: \(a + b) mod c + (c * (a div c) + (c * (b div c) + c * ((a mod c + b mod c) div c))) = a + b\ (is \?A + (?B + (?C + ?D)) = _\) proof - have \?A + (?B + (?C + ?D)) = ?A + ?D + (?B + ?C)\ by (simp add: ac_simps) also have \?A + ?D = (a mod c + b mod c) mod c + ?D\ by (simp add: mod_add_eq) also have \\ = a mod c + b mod c\ by (simp add: mod_mult_div_eq) finally have \?A + (?B + (?C + ?D)) = (a mod c + ?B) + (b mod c + ?C)\ by (simp add: ac_simps) then show ?thesis by (simp add: mod_mult_div_eq) qed have \((a + b) div c, (a + b) mod c) = (a div c + b div c + (a mod c + b mod c) div c, (a + b) mod c)\ proof (induction rule: euclidean_relationI) case by0 then show ?case by simp next case divides with * show ?case by (simp add: algebra_simps) next case euclidean_relation with * show ?case by (simp add: division_segment_mod mod_size_less algebra_simps) qed then show ?thesis by simp qed end class unique_euclidean_ring = euclidean_ring + unique_euclidean_semiring begin subclass euclidean_ring_cancel .. end subsection \Division on \<^typ>\nat\\ instantiation nat :: normalization_semidom begin definition normalize_nat :: \nat \ nat\ where [simp]: \normalize = (id :: nat \ nat)\ definition unit_factor_nat :: \nat \ nat\ where \unit_factor n = of_bool (n > 0)\ for n :: nat lemma unit_factor_simps [simp]: \unit_factor 0 = (0::nat)\ \unit_factor (Suc n) = 1\ by (simp_all add: unit_factor_nat_def) definition divide_nat :: \nat \ nat \ nat\ where \m div n = (if n = 0 then 0 else Max {k. k * n \ m})\ for m n :: nat instance by standard (auto simp add: divide_nat_def ac_simps unit_factor_nat_def intro: Max_eqI) end lemma coprime_Suc_0_left [simp]: "coprime (Suc 0) n" using coprime_1_left [of n] by simp lemma coprime_Suc_0_right [simp]: "coprime n (Suc 0)" using coprime_1_right [of n] by simp lemma coprime_common_divisor_nat: "coprime a b \ x dvd a \ x dvd b \ x = 1" for a b :: nat by (drule coprime_common_divisor [of _ _ x]) simp_all instantiation nat :: unique_euclidean_semiring begin definition euclidean_size_nat :: \nat \ nat\ where [simp]: \euclidean_size_nat = id\ definition division_segment_nat :: \nat \ nat\ where [simp]: \division_segment n = 1\ for n :: nat definition modulo_nat :: \nat \ nat \ nat\ where \m mod n = m - (m div n * n)\ for m n :: nat instance proof fix m n :: nat have ex: "\k. k * n \ l" for l :: nat by (rule exI [of _ 0]) simp have fin: "finite {k. k * n \ l}" if "n > 0" for l proof - from that have "{k. k * n \ l} \ {k. k \ l}" by (cases n) auto then show ?thesis by (rule finite_subset) simp qed have mult_div_unfold: "n * (m div n) = Max {l. l \ m \ n dvd l}" proof (cases "n = 0") case True moreover have "{l. l = 0 \ l \ m} = {0::nat}" by auto ultimately show ?thesis by simp next case False with ex [of m] fin have "n * Max {k. k * n \ m} = Max (times n ` {k. k * n \ m})" by (auto simp add: nat_mult_max_right intro: hom_Max_commute) also have "times n ` {k. k * n \ m} = {l. l \ m \ n dvd l}" by (auto simp add: ac_simps elim!: dvdE) finally show ?thesis using False by (simp add: divide_nat_def ac_simps) qed have less_eq: "m div n * n \ m" by (auto simp add: mult_div_unfold ac_simps intro: Max.boundedI) then show "m div n * n + m mod n = m" by (simp add: modulo_nat_def) assume "n \ 0" show "euclidean_size (m mod n) < euclidean_size n" proof - have "m < Suc (m div n) * n" proof (rule ccontr) assume "\ m < Suc (m div n) * n" then have "Suc (m div n) * n \ m" by (simp add: not_less) moreover from \n \ 0\ have "Max {k. k * n \ m} < Suc (m div n)" by (simp add: divide_nat_def) with \n \ 0\ ex fin have "\k. k * n \ m \ k < Suc (m div n)" by auto ultimately have "Suc (m div n) < Suc (m div n)" by blast then show False by simp qed with \n \ 0\ show ?thesis by (simp add: modulo_nat_def) qed show "euclidean_size m \ euclidean_size (m * n)" using \n \ 0\ by (cases n) simp_all fix q r :: nat show "(q * n + r) div n = q" if "euclidean_size r < euclidean_size n" proof - from that have "r < n" by simp have "k \ q" if "k * n \ q * n + r" for k proof (rule ccontr) assume "\ k \ q" then have "q < k" by simp then obtain l where "k = Suc (q + l)" by (auto simp add: less_iff_Suc_add) with \r < n\ that show False by (simp add: algebra_simps) qed with \n \ 0\ ex fin show ?thesis by (auto simp add: divide_nat_def Max_eq_iff) qed qed simp_all end lemma euclidean_relation_natI [case_names by0 divides euclidean_relation]: \(m div n, m mod n) = (q, r)\ if by0: \n = 0 \ q = 0 \ r = m\ and divides: \n > 0 \ n dvd m \ r = 0 \ m = q * n\ and euclidean_relation: \n > 0 \ \ n dvd m \ r < n \ m = q * n + r\ for m n q r :: nat by (rule euclidean_relationI) (use that in simp_all) lemma div_nat_eqI: \m div n = q\ if \n * q \ m\ and \m < n * Suc q\ for m n q :: nat proof - have \(m div n, m mod n) = (q, m - n * q)\ proof (induction rule: euclidean_relation_natI) case by0 with that show ?case by simp next case divides from \n dvd m\ obtain s where \m = n * s\ .. with \n > 0\ that have \s < Suc q\ by (simp only: mult_less_cancel1) with \m = n * s\ \n > 0\ that have \q = s\ by simp with \m = n * s\ show ?case by (simp add: ac_simps) next case euclidean_relation with that show ?case by (simp add: ac_simps) qed then show ?thesis by simp qed lemma mod_nat_eqI: \m mod n = r\ if \r < n\ and \r \ m\ and \n dvd m - r\ for m n r :: nat proof - have \(m div n, m mod n) = ((m - r) div n, r)\ proof (induction rule: euclidean_relation_natI) case by0 with that show ?case by simp next case divides from that dvd_minus_add [of r \m\ 1 n] have \n dvd m + (n - r)\ by simp with divides have \n dvd n - r\ by (simp add: dvd_add_right_iff) then have \n \ n - r\ by (rule dvd_imp_le) (use \r < n\ in simp) with \n > 0\ have \r = 0\ by simp with \n > 0\ that show ?case by simp next case euclidean_relation with that show ?case by (simp add: ac_simps) qed then show ?thesis by simp qed text \Tool support\ ML \ structure Cancel_Div_Mod_Nat = Cancel_Div_Mod ( val div_name = \<^const_name>\divide\; val mod_name = \<^const_name>\modulo\; val mk_binop = HOLogic.mk_binop; val dest_plus = HOLogic.dest_bin \<^const_name>\Groups.plus\ HOLogic.natT; val mk_sum = Arith_Data.mk_sum; fun dest_sum tm = if HOLogic.is_zero tm then [] else (case try HOLogic.dest_Suc tm of SOME t => HOLogic.Suc_zero :: dest_sum t | NONE => (case try dest_plus tm of SOME (t, u) => dest_sum t @ dest_sum u | NONE => [tm])); val div_mod_eqs = map mk_meta_eq @{thms cancel_div_mod_rules}; val prove_eq_sums = Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac @{thms add_0_left add_0_right ac_simps}) ) \ simproc_setup cancel_div_mod_nat ("(m::nat) + n") = \K Cancel_Div_Mod_Nat.proc\ lemma div_mult_self_is_m [simp]: "m * n div n = m" if "n > 0" for m n :: nat using that by simp lemma div_mult_self1_is_m [simp]: "n * m div n = m" if "n > 0" for m n :: nat using that by simp lemma mod_less_divisor [simp]: "m mod n < n" if "n > 0" for m n :: nat using mod_size_less [of n m] that by simp lemma mod_le_divisor [simp]: "m mod n \ n" if "n > 0" for m n :: nat using that by (auto simp add: le_less) lemma div_times_less_eq_dividend [simp]: "m div n * n \ m" for m n :: nat by (simp add: minus_mod_eq_div_mult [symmetric]) lemma times_div_less_eq_dividend [simp]: "n * (m div n) \ m" for m n :: nat using div_times_less_eq_dividend [of m n] by (simp add: ac_simps) lemma dividend_less_div_times: "m < n + (m div n) * n" if "0 < n" for m n :: nat proof - from that have "m mod n < n" by simp then show ?thesis by (simp add: minus_mod_eq_div_mult [symmetric]) qed lemma dividend_less_times_div: "m < n + n * (m div n)" if "0 < n" for m n :: nat using dividend_less_div_times [of n m] that by (simp add: ac_simps) lemma mod_Suc_le_divisor [simp]: "m mod Suc n \ n" using mod_less_divisor [of "Suc n" m] by arith lemma mod_less_eq_dividend [simp]: "m mod n \ m" for m n :: nat proof (rule add_leD2) from div_mult_mod_eq have "m div n * n + m mod n = m" . then show "m div n * n + m mod n \ m" by auto qed lemma div_less [simp]: "m div n = 0" and mod_less [simp]: "m mod n = m" if "m < n" for m n :: nat using that by (auto intro: div_nat_eqI mod_nat_eqI) lemma split_div: \P (m div n) \ (n = 0 \ P 0) \ (n \ 0 \ (\i j. j < n \ m = n * i + j \ P i))\ (is ?div) and split_mod: \Q (m mod n) \ (n = 0 \ Q m) \ (n \ 0 \ (\i j. j < n \ m = n * i + j \ Q j))\ (is ?mod) for m n :: nat proof - have *: \R (m div n) (m mod n) \ (n = 0 \ R 0 m) \ (n \ 0 \ (\i j. j < n \ m = n * i + j \ R i j))\ for R by (cases \n = 0\) auto from * [of \\q _. P q\] show ?div . from * [of \\_ r. Q r\] show ?mod . qed declare split_div [of _ _ \numeral n\, linarith_split] for n declare split_mod [of _ _ \numeral n\, linarith_split] for n lemma split_div': "P (m div n) \ n = 0 \ P 0 \ (\q. (n * q \ m \ m < n * Suc q) \ P q)" proof (cases "n = 0") case True then show ?thesis by simp next case False then have "n * q \ m \ m < n * Suc q \ m div n = q" for q by (auto intro: div_nat_eqI dividend_less_times_div) then show ?thesis by auto qed lemma le_div_geq: "m div n = Suc ((m - n) div n)" if "0 < n" and "n \ m" for m n :: nat proof - from \n \ m\ obtain q where "m = n + q" by (auto simp add: le_iff_add) with \0 < n\ show ?thesis by (simp add: div_add_self1) qed lemma le_mod_geq: "m mod n = (m - n) mod n" if "n \ m" for m n :: nat proof - from \n \ m\ obtain q where "m = n + q" by (auto simp add: le_iff_add) then show ?thesis by simp qed lemma div_if: "m div n = (if m < n \ n = 0 then 0 else Suc ((m - n) div n))" by (simp add: le_div_geq) lemma mod_if: "m mod n = (if m < n then m else (m - n) mod n)" for m n :: nat by (simp add: le_mod_geq) lemma div_eq_0_iff: "m div n = 0 \ m < n \ n = 0" for m n :: nat by (simp add: div_eq_0_iff) lemma div_greater_zero_iff: "m div n > 0 \ n \ m \ n > 0" for m n :: nat using div_eq_0_iff [of m n] by auto lemma mod_greater_zero_iff_not_dvd: "m mod n > 0 \ \ n dvd m" for m n :: nat by (simp add: dvd_eq_mod_eq_0) lemma div_by_Suc_0 [simp]: "m div Suc 0 = m" using div_by_1 [of m] by simp lemma mod_by_Suc_0 [simp]: "m mod Suc 0 = 0" using mod_by_1 [of m] by simp lemma div2_Suc_Suc [simp]: "Suc (Suc m) div 2 = Suc (m div 2)" by (simp add: numeral_2_eq_2 le_div_geq) lemma Suc_n_div_2_gt_zero [simp]: "0 < Suc n div 2" if "n > 0" for n :: nat using that by (cases n) simp_all lemma div_2_gt_zero [simp]: "0 < n div 2" if "Suc 0 < n" for n :: nat using that Suc_n_div_2_gt_zero [of "n - 1"] by simp lemma mod2_Suc_Suc [simp]: "Suc (Suc m) mod 2 = m mod 2" by (simp add: numeral_2_eq_2 le_mod_geq) lemma add_self_div_2 [simp]: "(m + m) div 2 = m" for m :: nat by (simp add: mult_2 [symmetric]) lemma add_self_mod_2 [simp]: "(m + m) mod 2 = 0" for m :: nat by (simp add: mult_2 [symmetric]) lemma mod2_gr_0 [simp]: "0 < m mod 2 \ m mod 2 = 1" for m :: nat proof - have "m mod 2 < 2" by (rule mod_less_divisor) simp then have "m mod 2 = 0 \ m mod 2 = 1" by arith then show ?thesis by auto qed lemma mod_Suc_eq [mod_simps]: "Suc (m mod n) mod n = Suc m mod n" proof - have "(m mod n + 1) mod n = (m + 1) mod n" by (simp only: mod_simps) then show ?thesis by simp qed lemma mod_Suc_Suc_eq [mod_simps]: "Suc (Suc (m mod n)) mod n = Suc (Suc m) mod n" proof - have "(m mod n + 2) mod n = (m + 2) mod n" by (simp only: mod_simps) then show ?thesis by simp qed lemma Suc_mod_mult_self1 [simp]: "Suc (m + k * n) mod n = Suc m mod n" and Suc_mod_mult_self2 [simp]: "Suc (m + n * k) mod n = Suc m mod n" and Suc_mod_mult_self3 [simp]: "Suc (k * n + m) mod n = Suc m mod n" and Suc_mod_mult_self4 [simp]: "Suc (n * k + m) mod n = Suc m mod n" by (subst mod_Suc_eq [symmetric], simp add: mod_simps)+ lemma Suc_0_mod_eq [simp]: "Suc 0 mod n = of_bool (n \ Suc 0)" by (cases n) simp_all lemma div_mult2_eq: \m div (n * q) = (m div n) div q\ (is ?Q) and mod_mult2_eq: \m mod (n * q) = n * (m div n mod q) + m mod n\ (is ?R) for m n q :: nat proof - have \(m div (n * q), m mod (n * q)) = ((m div n) div q, n * (m div n mod q) + m mod n)\ proof (induction rule: euclidean_relation_natI) case by0 then show ?case by auto next case divides from \n * q dvd m\ obtain t where \m = n * q * t\ .. with \n * q > 0\ show ?case by (simp add: algebra_simps) next case euclidean_relation then have \n > 0\ \q > 0\ by simp_all from \n > 0\ have \m mod n < n\ by (rule mod_less_divisor) from \q > 0\ have \m div n mod q < q\ by (rule mod_less_divisor) then obtain s where \q = Suc (m div n mod q + s)\ by (blast dest: less_imp_Suc_add) moreover have \m mod n + n * (m div n mod q) < n * Suc (m div n mod q + s)\ using \m mod n < n\ by (simp add: add_mult_distrib2) ultimately have \m mod n + n * (m div n mod q) < n * q\ by simp then show ?case by (simp add: algebra_simps flip: add_mult_distrib2) qed then show ?Q and ?R by simp_all qed lemma div_le_mono: "m div k \ n div k" if "m \ n" for m n k :: nat proof - from that obtain q where "n = m + q" by (auto simp add: le_iff_add) then show ?thesis by (simp add: div_add1_eq [of m q k]) qed text \Antimonotonicity of \<^const>\divide\ in second argument\ lemma div_le_mono2: "k div n \ k div m" if "0 < m" and "m \ n" for m n k :: nat using that proof (induct k arbitrary: m rule: less_induct) case (less k) show ?case proof (cases "n \ k") case False then show ?thesis by simp next case True have "(k - n) div n \ (k - m) div n" using less.prems by (blast intro: div_le_mono diff_le_mono2) also have "\ \ (k - m) div m" using \n \ k\ less.prems less.hyps [of "k - m" m] by simp finally show ?thesis using \n \ k\ less.prems by (simp add: le_div_geq) qed qed lemma div_le_dividend [simp]: "m div n \ m" for m n :: nat using div_le_mono2 [of 1 n m] by (cases "n = 0") simp_all lemma div_less_dividend [simp]: "m div n < m" if "1 < n" and "0 < m" for m n :: nat using that proof (induct m rule: less_induct) case (less m) show ?case proof (cases "n < m") case False with less show ?thesis by (cases "n = m") simp_all next case True then show ?thesis using less.hyps [of "m - n"] less.prems by (simp add: le_div_geq) qed qed lemma div_eq_dividend_iff: "m div n = m \ n = 1" if "m > 0" for m n :: nat proof assume "n = 1" then show "m div n = m" by simp next assume P: "m div n = m" show "n = 1" proof (rule ccontr) have "n \ 0" by (rule ccontr) (use that P in auto) moreover assume "n \ 1" ultimately have "n > 1" by simp with that have "m div n < m" by simp with P show False by simp qed qed lemma less_mult_imp_div_less: "m div n < i" if "m < i * n" for m n i :: nat proof - from that have "i * n > 0" by (cases "i * n = 0") simp_all then have "i > 0" and "n > 0" by simp_all have "m div n * n \ m" by simp then have "m div n * n < i * n" using that by (rule le_less_trans) with \n > 0\ show ?thesis by simp qed lemma div_less_iff_less_mult: \m div q < n \ m < n * q\ (is \?P \ ?Q\) if \q > 0\ for m n q :: nat proof assume ?Q then show ?P by (rule less_mult_imp_div_less) next assume ?P then obtain h where \n = Suc (m div q + h)\ using less_natE by blast moreover have \m < m + (Suc h * q - m mod q)\ using that by (simp add: trans_less_add1) ultimately show ?Q by (simp add: algebra_simps flip: minus_mod_eq_mult_div) qed lemma less_eq_div_iff_mult_less_eq: \m \ n div q \ m * q \ n\ if \q > 0\ for m n q :: nat using div_less_iff_less_mult [of q n m] that by auto lemma div_Suc: \Suc m div n = (if Suc m mod n = 0 then Suc (m div n) else m div n)\ proof (cases \n = 0 \ n = 1\) case True then show ?thesis by auto next case False then have \n > 1\ by simp then have \Suc m div n = m div n + Suc (m mod n) div n\ using div_add1_eq [of m 1 n] by simp also have \Suc (m mod n) div n = of_bool (n dvd Suc m)\ proof (cases \n dvd Suc m\) case False moreover have \Suc (m mod n) \ n\ proof (rule ccontr) assume \\ Suc (m mod n) \ n\ then have \m mod n = n - Suc 0\ by simp with \n > 1\ have \(m + 1) mod n = 0\ by (subst mod_add_left_eq [symmetric]) simp then have \n dvd Suc m\ by auto with False show False .. qed moreover have \Suc (m mod n) \ n\ using \n > 1\ by (simp add: Suc_le_eq) ultimately show ?thesis by (simp add: div_eq_0_iff) next case True then obtain q where q: \Suc m = n * q\ .. moreover have \q > 0\ by (rule ccontr) (use q in simp) ultimately have \m mod n = n - Suc 0\ using \n > 1\ mult_le_cancel1 [of n \Suc 0\ q] by (auto intro: mod_nat_eqI) with True \n > 1\ show ?thesis by simp qed finally show ?thesis by (simp add: mod_greater_zero_iff_not_dvd) qed lemma mod_Suc: \Suc m mod n = (if Suc (m mod n) = n then 0 else Suc (m mod n))\ proof (cases \n = 0\) case True then show ?thesis by simp next case False moreover have \Suc m mod n = Suc (m mod n) mod n\ by (simp add: mod_simps) ultimately show ?thesis by (auto intro!: mod_nat_eqI intro: neq_le_trans simp add: Suc_le_eq) qed lemma Suc_times_mod_eq: "Suc (m * n) mod m = 1" if "Suc 0 < m" using that by (simp add: mod_Suc) lemma Suc_times_numeral_mod_eq [simp]: "Suc (numeral k * n) mod numeral k = 1" if "numeral k \ (1::nat)" by (rule Suc_times_mod_eq) (use that in simp) lemma Suc_div_le_mono [simp]: "m div n \ Suc m div n" by (simp add: div_le_mono) text \These lemmas collapse some needless occurrences of Suc: at least three Sucs, since two and fewer are rewritten back to Suc again! We already have some rules to simplify operands smaller than 3.\ lemma div_Suc_eq_div_add3 [simp]: "m div Suc (Suc (Suc n)) = m div (3 + n)" by (simp add: Suc3_eq_add_3) lemma mod_Suc_eq_mod_add3 [simp]: "m mod Suc (Suc (Suc n)) = m mod (3 + n)" by (simp add: Suc3_eq_add_3) lemma Suc_div_eq_add3_div: "Suc (Suc (Suc m)) div n = (3 + m) div n" by (simp add: Suc3_eq_add_3) lemma Suc_mod_eq_add3_mod: "Suc (Suc (Suc m)) mod n = (3 + m) mod n" by (simp add: Suc3_eq_add_3) lemmas Suc_div_eq_add3_div_numeral [simp] = Suc_div_eq_add3_div [of _ "numeral v"] for v lemmas Suc_mod_eq_add3_mod_numeral [simp] = Suc_mod_eq_add3_mod [of _ "numeral v"] for v lemma (in field_char_0) of_nat_div: "of_nat (m div n) = ((of_nat m - of_nat (m mod n)) / of_nat n)" proof - have "of_nat (m div n) = ((of_nat (m div n * n + m mod n) - of_nat (m mod n)) / of_nat n :: 'a)" unfolding of_nat_add by (cases "n = 0") simp_all then show ?thesis by simp qed text \An ``induction'' law for modulus arithmetic.\ lemma mod_induct [consumes 3, case_names step]: "P m" if "P n" and "n < p" and "m < p" and step: "\n. n < p \ P n \ P (Suc n mod p)" using \m < p\ proof (induct m) case 0 show ?case proof (rule ccontr) assume "\ P 0" from \n < p\ have "0 < p" by simp from \n < p\ obtain m where "0 < m" and "p = n + m" by (blast dest: less_imp_add_positive) with \P n\ have "P (p - m)" by simp moreover have "\ P (p - m)" using \0 < m\ proof (induct m) case 0 then show ?case by simp next case (Suc m) show ?case proof assume P: "P (p - Suc m)" with \\ P 0\ have "Suc m < p" by (auto intro: ccontr) then have "Suc (p - Suc m) = p - m" by arith moreover from \0 < p\ have "p - Suc m < p" by arith with P step have "P ((Suc (p - Suc m)) mod p)" by blast ultimately show False using \\ P 0\ Suc.hyps by (cases "m = 0") simp_all qed qed ultimately show False by blast qed next case (Suc m) then have "m < p" and mod: "Suc m mod p = Suc m" by simp_all from \m < p\ have "P m" by (rule Suc.hyps) with \m < p\ have "P (Suc m mod p)" by (rule step) with mod show ?case by simp qed lemma funpow_mod_eq: \<^marker>\contributor \Lars Noschinski\\ \(f ^^ (m mod n)) x = (f ^^ m) x\ if \(f ^^ n) x = x\ proof - have \(f ^^ m) x = (f ^^ (m mod n + m div n * n)) x\ by simp also have \\ = (f ^^ (m mod n)) (((f ^^ n) ^^ (m div n)) x)\ by (simp only: funpow_add funpow_mult ac_simps) simp also have \((f ^^ n) ^^ q) x = x\ for q by (induction q) (use \(f ^^ n) x = x\ in simp_all) finally show ?thesis by simp qed lemma mod_eq_dvd_iff_nat: \m mod q = n mod q \ q dvd m - n\ (is \?P \ ?Q\) if \m \ n\ for m n q :: nat proof assume ?Q then obtain s where \m - n = q * s\ .. with that have \m = q * s + n\ by simp then show ?P by simp next assume ?P have \m - n = m div q * q + m mod q - (n div q * q + n mod q)\ by simp also have \\ = q * (m div q - n div q)\ by (simp only: algebra_simps \?P\) finally show ?Q .. qed lemma mod_eq_iff_dvd_symdiff_nat: \m mod q = n mod q \ q dvd nat \int m - int n\\ by (auto simp add: abs_if mod_eq_dvd_iff_nat nat_diff_distrib dest: sym intro: sym) lemma mod_eq_nat1E: fixes m n q :: nat assumes "m mod q = n mod q" and "m \ n" obtains s where "m = n + q * s" proof - from assms have "q dvd m - n" by (simp add: mod_eq_dvd_iff_nat) then obtain s where "m - n = q * s" .. with \m \ n\ have "m = n + q * s" by simp with that show thesis . qed lemma mod_eq_nat2E: fixes m n q :: nat assumes "m mod q = n mod q" and "n \ m" obtains s where "n = m + q * s" using assms mod_eq_nat1E [of n q m] by (auto simp add: ac_simps) lemma nat_mod_eq_iff: "(x::nat) mod n = y mod n \ (\q1 q2. x + n * q1 = y + n * q2)" (is "?lhs = ?rhs") proof assume H: "x mod n = y mod n" { assume xy: "x \ y" from H have th: "y mod n = x mod n" by simp from mod_eq_nat1E [OF th xy] obtain q where "y = x + n * q" . then have "x + n * q = y + n * 0" by simp then have "\q1 q2. x + n * q1 = y + n * q2" by blast } moreover { assume xy: "y \ x" from mod_eq_nat1E [OF H xy] obtain q where "x = y + n * q" . then have "x + n * 0 = y + n * q" by simp then have "\q1 q2. x + n * q1 = y + n * q2" by blast } ultimately show ?rhs using linear[of x y] by blast next assume ?rhs then obtain q1 q2 where q12: "x + n * q1 = y + n * q2" by blast hence "(x + n * q1) mod n = (y + n * q2) mod n" by simp thus ?lhs by simp qed - subsection \Division on \<^typ>\int\\ text \ The following specification of integer division rounds towards minus infinity and is advocated by Donald Knuth. See \cite{leijen01} for an overview and terminology of different possibilities to specify integer division; there division rounding towards minus infinitiy is named ``F-division''. \ subsubsection \Basic instantiation\ instantiation int :: "{normalization_semidom, idom_modulo}" begin definition normalize_int :: \int \ int\ where [simp]: \normalize = (abs :: int \ int)\ definition unit_factor_int :: \int \ int\ where [simp]: \unit_factor = (sgn :: int \ int)\ definition divide_int :: \int \ int \ int\ where \k div l = (sgn k * sgn l * int (nat \k\ div nat \l\) - of_bool (l \ 0 \ sgn k \ sgn l \ \ l dvd k))\ lemma divide_int_unfold: \(sgn k * int m) div (sgn l * int n) = (sgn k * sgn l * int (m div n) - of_bool ((k = 0 \ m = 0) \ l \ 0 \ n \ 0 \ sgn k \ sgn l \ \ n dvd m))\ by (simp add: divide_int_def sgn_mult nat_mult_distrib abs_mult sgn_eq_0_iff ac_simps) definition modulo_int :: \int \ int \ int\ where \k mod l = sgn k * int (nat \k\ mod nat \l\) + l * of_bool (sgn k \ sgn l \ \ l dvd k)\ lemma modulo_int_unfold: \(sgn k * int m) mod (sgn l * int n) = sgn k * int (m mod (of_bool (l \ 0) * n)) + (sgn l * int n) * of_bool ((k = 0 \ m = 0) \ sgn k \ sgn l \ \ n dvd m)\ by (auto simp add: modulo_int_def sgn_mult abs_mult) instance proof fix k :: int show "k div 0 = 0" by (simp add: divide_int_def) next fix k l :: int assume "l \ 0" obtain n m and s t where k: "k = sgn s * int n" and l: "l = sgn t * int m" by (blast intro: int_sgnE elim: that) then have "k * l = sgn (s * t) * int (n * m)" by (simp add: ac_simps sgn_mult) with k l \l \ 0\ show "k * l div l = k" by (simp only: divide_int_unfold) (auto simp add: algebra_simps sgn_mult sgn_1_pos sgn_0_0) next fix k l :: int obtain n m and s t where "k = sgn s * int n" and "l = sgn t * int m" by (blast intro: int_sgnE elim: that) then show "k div l * l + k mod l = k" by (simp add: divide_int_unfold modulo_int_unfold algebra_simps modulo_nat_def of_nat_diff) qed (auto simp add: sgn_mult mult_sgn_abs abs_eq_iff') end subsubsection \Algebraic foundations\ lemma coprime_int_iff [simp]: "coprime (int m) (int n) \ coprime m n" (is "?P \ ?Q") proof assume ?P show ?Q proof (rule coprimeI) fix q assume "q dvd m" "q dvd n" then have "int q dvd int m" "int q dvd int n" by simp_all with \?P\ have "is_unit (int q)" by (rule coprime_common_divisor) then show "is_unit q" by simp qed next assume ?Q show ?P proof (rule coprimeI) fix k assume "k dvd int m" "k dvd int n" then have "nat \k\ dvd m" "nat \k\ dvd n" by simp_all with \?Q\ have "is_unit (nat \k\)" by (rule coprime_common_divisor) then show "is_unit k" by simp qed qed lemma coprime_abs_left_iff [simp]: "coprime \k\ l \ coprime k l" for k l :: int using coprime_normalize_left_iff [of k l] by simp lemma coprime_abs_right_iff [simp]: "coprime k \l\ \ coprime k l" for k l :: int using coprime_abs_left_iff [of l k] by (simp add: ac_simps) lemma coprime_nat_abs_left_iff [simp]: "coprime (nat \k\) n \ coprime k (int n)" proof - define m where "m = nat \k\" then have "\k\ = int m" by simp moreover have "coprime k (int n) \ coprime \k\ (int n)" by simp ultimately show ?thesis by simp qed lemma coprime_nat_abs_right_iff [simp]: "coprime n (nat \k\) \ coprime (int n) k" using coprime_nat_abs_left_iff [of k n] by (simp add: ac_simps) lemma coprime_common_divisor_int: "coprime a b \ x dvd a \ x dvd b \ \x\ = 1" for a b :: int by (drule coprime_common_divisor [of _ _ x]) simp_all subsubsection \Basic conversions\ lemma div_abs_eq_div_nat: "\k\ div \l\ = int (nat \k\ div nat \l\)" by (auto simp add: divide_int_def) lemma div_eq_div_abs: \k div l = sgn k * sgn l * (\k\ div \l\) - of_bool (l \ 0 \ sgn k \ sgn l \ \ l dvd k)\ for k l :: int by (simp add: divide_int_def [of k l] div_abs_eq_div_nat) lemma div_abs_eq: \\k\ div \l\ = sgn k * sgn l * (k div l + of_bool (sgn k \ sgn l \ \ l dvd k))\ for k l :: int by (simp add: div_eq_div_abs [of k l] ac_simps) lemma mod_abs_eq_div_nat: "\k\ mod \l\ = int (nat \k\ mod nat \l\)" by (simp add: modulo_int_def) lemma mod_eq_mod_abs: \k mod l = sgn k * (\k\ mod \l\) + l * of_bool (sgn k \ sgn l \ \ l dvd k)\ for k l :: int by (simp add: modulo_int_def [of k l] mod_abs_eq_div_nat) lemma mod_abs_eq: \\k\ mod \l\ = sgn k * (k mod l - l * of_bool (sgn k \ sgn l \ \ l dvd k))\ for k l :: int by (auto simp: mod_eq_mod_abs [of k l]) lemma div_sgn_abs_cancel: fixes k l v :: int assumes "v \ 0" shows "(sgn v * \k\) div (sgn v * \l\) = \k\ div \l\" using assms by (simp add: sgn_mult abs_mult sgn_0_0 divide_int_def [of "sgn v * \k\" "sgn v * \l\"] flip: div_abs_eq_div_nat) lemma div_eq_sgn_abs: fixes k l v :: int assumes "sgn k = sgn l" shows "k div l = \k\ div \l\" using assms by (auto simp add: div_abs_eq) lemma div_dvd_sgn_abs: fixes k l :: int assumes "l dvd k" shows "k div l = (sgn k * sgn l) * (\k\ div \l\)" using assms by (auto simp add: div_abs_eq ac_simps) lemma div_noneq_sgn_abs: fixes k l :: int assumes "l \ 0" assumes "sgn k \ sgn l" shows "k div l = - (\k\ div \l\) - of_bool (\ l dvd k)" using assms by (auto simp add: div_abs_eq ac_simps sgn_0_0 dest!: sgn_not_eq_imp) subsubsection \Euclidean division\ instantiation int :: unique_euclidean_ring begin definition euclidean_size_int :: "int \ nat" where [simp]: "euclidean_size_int = (nat \ abs :: int \ nat)" definition division_segment_int :: "int \ int" where "division_segment_int k = (if k \ 0 then 1 else - 1)" lemma division_segment_eq_sgn: "division_segment k = sgn k" if "k \ 0" for k :: int using that by (simp add: division_segment_int_def) lemma abs_division_segment [simp]: "\division_segment k\ = 1" for k :: int by (simp add: division_segment_int_def) lemma abs_mod_less: "\k mod l\ < \l\" if "l \ 0" for k l :: int proof - obtain n m and s t where "k = sgn s * int n" and "l = sgn t * int m" by (blast intro: int_sgnE elim: that) with that show ?thesis by (auto simp add: modulo_int_unfold abs_mult mod_greater_zero_iff_not_dvd simp flip: right_diff_distrib dest!: sgn_not_eq_imp) (simp add: sgn_0_0) qed lemma sgn_mod: "sgn (k mod l) = sgn l" if "l \ 0" "\ l dvd k" for k l :: int proof - obtain n m and s t where "k = sgn s * int n" and "l = sgn t * int m" by (blast intro: int_sgnE elim: that) with that show ?thesis by (auto simp add: modulo_int_unfold sgn_mult mod_greater_zero_iff_not_dvd simp flip: right_diff_distrib dest!: sgn_not_eq_imp) qed instance proof fix k l :: int show "division_segment (k mod l) = division_segment l" if "l \ 0" and "\ l dvd k" using that by (simp add: division_segment_eq_sgn dvd_eq_mod_eq_0 sgn_mod) next fix l q r :: int obtain n m and s t where l: "l = sgn s * int n" and q: "q = sgn t * int m" by (blast intro: int_sgnE elim: that) assume \l \ 0\ with l have "s \ 0" and "n > 0" by (simp_all add: sgn_0_0) assume "division_segment r = division_segment l" moreover have "r = sgn r * \r\" by (simp add: sgn_mult_abs) moreover define u where "u = nat \r\" ultimately have "r = sgn l * int u" using division_segment_eq_sgn \l \ 0\ by (cases "r = 0") simp_all with l \n > 0\ have r: "r = sgn s * int u" by (simp add: sgn_mult) assume "euclidean_size r < euclidean_size l" with l r \s \ 0\ have "u < n" by (simp add: abs_mult) show "(q * l + r) div l = q" proof (cases "q = 0 \ r = 0") case True then show ?thesis proof assume "q = 0" then show ?thesis using l r \u < n\ by (simp add: divide_int_unfold) next assume "r = 0" from \r = 0\ have *: "q * l + r = sgn (t * s) * int (n * m)" using q l by (simp add: ac_simps sgn_mult) from \s \ 0\ \n > 0\ show ?thesis by (simp only: *, simp only: * q l divide_int_unfold) (auto simp add: sgn_mult ac_simps) qed next case False with q r have "t \ 0" and "m > 0" and "s \ 0" and "u > 0" by (simp_all add: sgn_0_0) moreover from \0 < m\ \u < n\ have "u \ m * n" using mult_le_less_imp_less [of 1 m u n] by simp ultimately have *: "q * l + r = sgn (s * t) * int (if t < 0 then m * n - u else m * n + u)" using l q r by (simp add: sgn_mult algebra_simps of_nat_diff) have "(m * n - u) div n = m - 1" if "u > 0" using \0 < m\ \u < n\ that by (auto intro: div_nat_eqI simp add: algebra_simps) moreover have "n dvd m * n - u \ n dvd u" using \u \ m * n\ dvd_diffD1 [of n "m * n" u] by auto ultimately show ?thesis using \s \ 0\ \m > 0\ \u > 0\ \u < n\ \u \ m * n\ by (simp only: *, simp only: l q divide_int_unfold) (auto simp add: sgn_mult sgn_0_0 sgn_1_pos algebra_simps dest: dvd_imp_le) qed qed (use mult_le_mono2 [of 1] in \auto simp add: division_segment_int_def not_le zero_less_mult_iff mult_less_0_iff abs_mult sgn_mult abs_mod_less sgn_mod nat_mult_distrib\) end lemma euclidean_relation_intI [case_names by0 divides euclidean_relation]: \(k div l, k mod l) = (q, r)\ if by0': \l = 0 \ q = 0 \ r = k\ and divides': \l \ 0 \ l dvd k \ r = 0 \ k = q * l\ and euclidean_relation': \l \ 0 \ \ l dvd k \ sgn r = sgn l \ \r\ < \l\ \ k = q * l + r\ for k l :: int proof (induction rule: euclidean_relationI) case by0 then show ?case by (rule by0') next case divides then show ?case by (rule divides') next case euclidean_relation with euclidean_relation' have \sgn r = sgn l\ \\r\ < \l\\ \k = q * l + r\ by simp_all from \sgn r = sgn l\ \l \ 0\ have \division_segment r = division_segment l\ by (simp add: division_segment_int_def sgn_if split: if_splits) with \\r\ < \l\\ \k = q * l + r\ show ?case by simp qed subsubsection \Trivial reduction steps\ lemma div_pos_pos_trivial [simp]: "k div l = 0" if "k \ 0" and "k < l" for k l :: int using that by (simp add: unique_euclidean_semiring_class.div_eq_0_iff division_segment_int_def) lemma mod_pos_pos_trivial [simp]: "k mod l = k" if "k \ 0" and "k < l" for k l :: int using that by (simp add: mod_eq_self_iff_div_eq_0) lemma div_neg_neg_trivial [simp]: "k div l = 0" if "k \ 0" and "l < k" for k l :: int using that by (cases "k = 0") (simp, simp add: unique_euclidean_semiring_class.div_eq_0_iff division_segment_int_def) lemma mod_neg_neg_trivial [simp]: "k mod l = k" if "k \ 0" and "l < k" for k l :: int using that by (simp add: mod_eq_self_iff_div_eq_0) lemma div_pos_neg_trivial: \k div l = - 1\ (is ?Q) and mod_pos_neg_trivial: \k mod l = k + l\ (is ?R) if \0 < k\ and \k + l \ 0\ for k l :: int proof - from that have \l < 0\ by simp have \(k div l, k mod l) = (- 1, k + l)\ proof (induction rule: euclidean_relation_intI) case by0 with \l < 0\ show ?case by simp next case divides from \l dvd k\ obtain j where \k = l * j\ .. with \l < 0\ \0 < k\ have \j < 0\ by (simp add: zero_less_mult_iff) moreover from \k + l \ 0\ \k = l * j\ have \l * (j + 1) \ 0\ by (simp add: algebra_simps) with \l < 0\ have \j + 1 \ 0\ by (simp add: mult_le_0_iff) with \j < 0\ have \j = - 1\ by simp with \k = l * j\ show ?case by simp next case euclidean_relation with \k + l \ 0\ have \k + l < 0\ by (auto simp add: less_le add_eq_0_iff) with \0 < k\ show ?case by simp qed then show ?Q and ?R by simp_all qed text \There is neither \div_neg_pos_trivial\ nor \mod_neg_pos_trivial\ because \<^term>\0 div l = 0\ would supersede it.\ subsubsection \More uniqueness rules\ lemma fixes a b q r :: int assumes \a = b * q + r\ \0 \ r\ \r < b\ shows int_div_pos_eq: \a div b = q\ (is ?Q) and int_mod_pos_eq: \a mod b = r\ (is ?R) proof - have \(a div b, a mod b) = (q, r)\ by (induction rule: euclidean_relation_intI) (use assms in \auto simp add: ac_simps dvd_add_left_iff sgn_1_pos le_less dest: zdvd_imp_le\) then show ?Q and ?R by simp_all qed lemma int_div_neg_eq: \a div b = q\ if \a = b * q + r\ \r \ 0\ \b < r\ for a b q r :: int using that int_div_pos_eq [of a \- b\ \- q\ \- r\] by simp_all lemma int_mod_neg_eq: \a mod b = r\ if \a = b * q + r\ \r \ 0\ \b < r\ for a b q r :: int using that int_div_neg_eq [of a b q r] by simp subsubsection \Laws for unary minus\ lemma zmod_zminus1_not_zero: fixes k l :: int shows "- k mod l \ 0 \ k mod l \ 0" by (simp add: mod_eq_0_iff_dvd) lemma zmod_zminus2_not_zero: fixes k l :: int shows "k mod - l \ 0 \ k mod l \ 0" by (simp add: mod_eq_0_iff_dvd) lemma zdiv_zminus1_eq_if: \(- a) div b = (if a mod b = 0 then - (a div b) else - (a div b) - 1)\ if \b \ 0\ for a b :: int using that sgn_not_eq_imp [of b \- a\] by (cases \a = 0\) (auto simp add: div_eq_div_abs [of \- a\ b] div_eq_div_abs [of a b] sgn_eq_0_iff) lemma zdiv_zminus2_eq_if: \a div (- b) = (if a mod b = 0 then - (a div b) else - (a div b) - 1)\ if \b \ 0\ for a b :: int using that by (auto simp add: zdiv_zminus1_eq_if div_minus_right) lemma zmod_zminus1_eq_if: \(- a) mod b = (if a mod b = 0 then 0 else b - (a mod b))\ for a b :: int by (cases \b = 0\) (auto simp flip: minus_div_mult_eq_mod simp add: zdiv_zminus1_eq_if algebra_simps) lemma zmod_zminus2_eq_if: \a mod (- b) = (if a mod b = 0 then 0 else (a mod b) - b)\ for a b :: int by (auto simp add: zmod_zminus1_eq_if mod_minus_right) subsubsection \Borders\ lemma pos_mod_bound [simp]: "k mod l < l" if "l > 0" for k l :: int proof - obtain m and s where "k = sgn s * int m" by (rule int_sgnE) moreover from that obtain n where "l = sgn 1 * int n" by (cases l) simp_all moreover from this that have "n > 0" by simp ultimately show ?thesis by (simp only: modulo_int_unfold) (auto simp add: mod_greater_zero_iff_not_dvd sgn_1_pos) qed lemma neg_mod_bound [simp]: "l < k mod l" if "l < 0" for k l :: int proof - obtain m and s where "k = sgn s * int m" by (rule int_sgnE) moreover from that obtain q where "l = sgn (- 1) * int (Suc q)" by (cases l) simp_all moreover define n where "n = Suc q" then have "Suc q = n" by simp ultimately show ?thesis by (simp only: modulo_int_unfold) (auto simp add: mod_greater_zero_iff_not_dvd sgn_1_neg) qed lemma pos_mod_sign [simp]: "0 \ k mod l" if "l > 0" for k l :: int proof - obtain m and s where "k = sgn s * int m" by (rule int_sgnE) moreover from that obtain n where "l = sgn 1 * int n" by (cases l) auto moreover from this that have "n > 0" by simp ultimately show ?thesis by (simp only: modulo_int_unfold) (auto simp add: sgn_1_pos) qed lemma neg_mod_sign [simp]: "k mod l \ 0" if "l < 0" for k l :: int proof - obtain m and s where "k = sgn s * int m" by (rule int_sgnE) moreover from that obtain q where "l = sgn (- 1) * int (Suc q)" by (cases l) simp_all moreover define n where "n = Suc q" then have "Suc q = n" by simp moreover have \int (m mod n) \ int n\ using \Suc q = n\ by simp then have \sgn s * int (m mod n) \ int n\ by (cases s \0::int\ rule: linorder_cases) simp_all ultimately show ?thesis by (simp only: modulo_int_unfold) auto qed subsubsection \Splitting Rules for div and mod\ lemma split_zdiv: \P (n div k) \ (k = 0 \ P 0) \ (0 < k \ (\i j. 0 \ j \ j < k \ n = k * i + j \ P i)) \ (k < 0 \ (\i j. k < j \ j \ 0 \ n = k * i + j \ P i))\ (is ?div) and split_zmod: \Q (n mod k) \ (k = 0 \ Q n) \ (0 < k \ (\i j. 0 \ j \ j < k \ n = k * i + j \ Q j)) \ (k < 0 \ (\i j. k < j \ j \ 0 \ n = k * i + j \ Q j))\ (is ?mod) for n k :: int proof - have *: \R (n div k) (n mod k) \ (k = 0 \ R 0 n) \ (0 < k \ (\i j. 0 \ j \ j < k \ n = k * i + j \ R i j)) \ (k < 0 \ (\i j. k < j \ j \ 0 \ n = k * i + j \ R i j))\ for R by (cases \k = 0\) (auto simp add: linorder_class.neq_iff) from * [of \\q _. P q\] show ?div . from * [of \\_ r. Q r\] show ?mod . qed text \Enable (lin)arith to deal with \<^const>\divide\ and \<^const>\modulo\ when these are applied to some constant that is of the form \<^term>\numeral k\:\ declare split_zdiv [of _ _ \numeral n\, linarith_split] for n declare split_zdiv [of _ _ \- numeral n\, linarith_split] for n declare split_zmod [of _ _ \numeral n\, linarith_split] for n declare split_zmod [of _ _ \- numeral n\, linarith_split] for n lemma zdiv_eq_0_iff: "i div k = 0 \ k = 0 \ 0 \ i \ i < k \ i \ 0 \ k < i" (is "?L = ?R") for i k :: int proof assume ?L moreover have "?L \ ?R" by (rule split_zdiv [THEN iffD2]) simp ultimately show ?R by blast next assume ?R then show ?L by auto qed lemma zmod_trivial_iff: fixes i k :: int shows "i mod k = i \ k = 0 \ 0 \ i \ i < k \ i \ 0 \ k < i" proof - have "i mod k = i \ i div k = 0" using div_mult_mod_eq [of i k] by safe auto with zdiv_eq_0_iff show ?thesis by simp qed subsubsection \Algebraic rewrites\ lemma zdiv_zmult2_eq: \a div (b * c) = (a div b) div c\ (is ?Q) and zmod_zmult2_eq: \a mod (b * c) = b * (a div b mod c) + a mod b\ (is ?P) if \c \ 0\ for a b c :: int proof - have *: \(a div (b * c), a mod (b * c)) = ((a div b) div c, b * (a div b mod c) + a mod b)\ if \b > 0\ for a b proof (induction rule: euclidean_relationI) case by0 then show ?case by auto next case divides then obtain d where \a = b * c * d\ by blast with divides that show ?case by (simp add: ac_simps) next case euclidean_relation with \b > 0\ \c \ 0\ have \0 < c\ \b > 0\ by simp_all then have \a mod b < b\ by simp moreover have \1 \ c - a div b mod c\ using \c > 0\ by (simp add: int_one_le_iff_zero_less) ultimately have \a mod b * 1 < b * (c - a div b mod c)\ by (rule mult_less_le_imp_less) (use \b > 0\ in simp_all) with \0 < b\ \0 < c\ show ?case by (simp add: division_segment_int_def algebra_simps flip: minus_mod_eq_mult_div) qed show ?Q proof (cases \b \ 0\) case True with * [of b a] show ?thesis by (cases \b = 0\) simp_all next case False with * [of \- b\ \- a\] show ?thesis by simp qed show ?P proof (cases \b \ 0\) case True with * [of b a] show ?thesis by (cases \b = 0\) simp_all next case False with * [of \- b\ \- a\] show ?thesis by simp qed qed lemma zdiv_zmult2_eq': \k div (l * j) = ((sgn j * k) div l) div \j\\ for k l j :: int proof - have \k div (l * j) = (sgn j * k) div (sgn j * (l * j))\ by (simp add: sgn_0_0) also have \sgn j * (l * j) = l * \j\\ by (simp add: mult.left_commute [of _ l] abs_sgn) (simp add: ac_simps) also have \(sgn j * k) div (l * \j\) = ((sgn j * k) div l) div \j\\ by (simp add: zdiv_zmult2_eq) finally show ?thesis . qed lemma half_nonnegative_int_iff [simp]: \k div 2 \ 0 \ k \ 0\ for k :: int by auto lemma half_negative_int_iff [simp]: \k div 2 < 0 \ k < 0\ for k :: int by auto subsubsection \Distributive laws for conversions.\ lemma zdiv_int: \int (m div n) = int m div int n\ by (cases \m = 0\) (auto simp add: divide_int_def) lemma zmod_int: \int (m mod n) = int m mod int n\ by (cases \m = 0\) (auto simp add: modulo_int_def) lemma nat_div_distrib: \nat (x div y) = nat x div nat y\ if \0 \ x\ using that by (simp add: divide_int_def sgn_if) lemma nat_div_distrib': \nat (x div y) = nat x div nat y\ if \0 \ y\ using that by (simp add: divide_int_def sgn_if) lemma nat_mod_distrib: \ \Fails if y<0: the LHS collapses to (nat z) but the RHS doesn't\ \nat (x mod y) = nat x mod nat y\ if \0 \ x\ \0 \ y\ using that by (simp add: modulo_int_def sgn_if) subsubsection \Monotonicity in the First Argument (Dividend)\ lemma zdiv_mono1: \a div b \ a' div b\ if \a \ a'\ \0 < b\ for a b b' :: int proof - from \a \ a'\ have \b * (a div b) + a mod b \ b * (a' div b) + a' mod b\ by simp then have \b * (a div b) \ (a' mod b - a mod b) + b * (a' div b)\ by (simp add: algebra_simps) moreover have \a' mod b < b + a mod b\ by (rule less_le_trans [of _ b]) (use \0 < b\ in simp_all) ultimately have \b * (a div b) < b * (1 + a' div b)\ by (simp add: distrib_left) with \0 < b\ have \a div b < 1 + a' div b\ by (simp add: mult_less_cancel_left) then show ?thesis by simp qed lemma zdiv_mono1_neg: \a' div b \ a div b\ if \a \ a'\ \b < 0\ for a a' b :: int using that zdiv_mono1 [of \- a'\ \- a\ \- b\] by simp subsubsection \Monotonicity in the Second Argument (Divisor)\ lemma zdiv_mono2: \a div b \ a div b'\ if \0 \ a\ \0 < b'\ \b' \ b\ for a b b' :: int proof - define q q' r r' where **: \q = a div b\ \q' = a div b'\ \r = a mod b\ \r' = a mod b'\ then have *: \b * q + r = b' * q' + r'\ \0 \ b' * q' + r'\ \r' < b'\ \0 \ r\ \0 < b'\ \b' \ b\ using that by simp_all have \0 < b' * (q' + 1)\ using * by (simp add: distrib_left) with * have \0 \ q'\ by (simp add: zero_less_mult_iff) moreover have \b * q = r' - r + b' * q'\ using * by linarith ultimately have \b * q < b * (q' + 1)\ using mult_right_mono * unfolding distrib_left by fastforce with * have \q \ q'\ by (simp add: mult_less_cancel_left_pos) with ** show ?thesis by simp qed lemma zdiv_mono2_neg: \a div b' \ a div b\ if \a < 0\ \0 < b'\ \b' \ b\ for a b b' :: int proof - define q q' r r' where **: \q = a div b\ \q' = a div b'\ \r = a mod b\ \r' = a mod b'\ then have *: \b * q + r = b' * q' + r'\ \b' * q' + r' < 0\ \r < b\ \0 \ r'\ \0 < b'\ \b' \ b\ using that by simp_all have \b' * q' < 0\ using * by linarith with * have \q' \ 0\ by (simp add: mult_less_0_iff) have \b * q' \ b' * q'\ by (simp add: \q' \ 0\ * mult_right_mono_neg) then have "b * q' < b * (q + 1)" using * by (simp add: distrib_left) then have \q' \ q\ using * by (simp add: mult_less_cancel_left) then show ?thesis by (simp add: **) qed subsubsection \Quotients of Signs\ lemma div_eq_minus1: \0 < b \ - 1 div b = - 1\ for b :: int by (simp add: divide_int_def) lemma zmod_minus1: \0 < b \ - 1 mod b = b - 1\ for b :: int by (auto simp add: modulo_int_def) lemma minus_mod_int_eq: \- k mod l = l - 1 - (k - 1) mod l\ if \l \ 0\ for k l :: int proof (cases \l = 0\) case True then show ?thesis by simp next case False with that have \l > 0\ by simp then show ?thesis proof (cases \l dvd k\) case True then obtain j where \k = l * j\ .. moreover have \(l * j mod l - 1) mod l = l - 1\ using \l > 0\ by (simp add: zmod_minus1) then have \(l * j - 1) mod l = l - 1\ by (simp only: mod_simps) ultimately show ?thesis by simp next case False moreover have 1: \0 < k mod l\ using \0 < l\ False le_less by fastforce moreover have 2: \k mod l < 1 + l\ using \0 < l\ pos_mod_bound[of l k] by linarith from 1 2 \l > 0\ have \(k mod l - 1) mod l = k mod l - 1\ by (simp add: zmod_trivial_iff) ultimately show ?thesis by (simp only: zmod_zminus1_eq_if) (simp add: mod_eq_0_iff_dvd algebra_simps mod_simps) qed qed lemma div_neg_pos_less0: \a div b < 0\ if \a < 0\ \0 < b\ for a b :: int proof - have "a div b \ - 1 div b" using zdiv_mono1 that by auto also have "... \ -1" by (simp add: that(2) div_eq_minus1) finally show ?thesis by force qed lemma div_nonneg_neg_le0: \a div b \ 0\ if \0 \ a\ \b < 0\ for a b :: int using that by (auto dest: zdiv_mono1_neg) lemma div_nonpos_pos_le0: \a div b \ 0\ if \a \ 0\ \0 < b\ for a b :: int using that by (auto dest: zdiv_mono1) text\Now for some equivalences of the form \a div b >=< 0 \ \\ conditional upon the sign of \a\ or \b\. There are many more. They should all be simp rules unless that causes too much search.\ lemma pos_imp_zdiv_nonneg_iff: \0 \ a div b \ 0 \ a\ if \0 < b\ for a b :: int proof assume \0 \ a div b\ show \0 \ a\ proof (rule ccontr) assume \\ 0 \ a\ then have \a < 0\ by simp then have \a div b < 0\ using that by (rule div_neg_pos_less0) with \0 \ a div b\ show False by simp qed next assume "0 \ a" then have "0 div b \ a div b" using zdiv_mono1 that by blast then show "0 \ a div b" by auto qed lemma neg_imp_zdiv_nonneg_iff: \0 \ a div b \ a \ 0\ if \b < 0\ for a b :: int using that pos_imp_zdiv_nonneg_iff [of \- b\ \- a\] by simp lemma pos_imp_zdiv_pos_iff: \0 < (i::int) div k \ k \ i\ if \0 < k\ for i k :: int using that pos_imp_zdiv_nonneg_iff [of k i] zdiv_eq_0_iff [of i k] by arith lemma pos_imp_zdiv_neg_iff: \a div b < 0 \ a < 0\ if \0 < b\ for a b :: int \ \But not \<^prop>\a div b \ 0 \ a \ 0\; consider \<^prop>\a = 1\, \<^prop>\b = 2\ when \<^prop>\a div b = 0\.\ using that by (simp add: pos_imp_zdiv_nonneg_iff flip: linorder_not_le) lemma neg_imp_zdiv_neg_iff: \ \But not \<^prop>\a div b \ 0 \ 0 \ a\; consider \<^prop>\a = - 1\, \<^prop>\b = - 2\ when \<^prop>\a div b = 0\.\ \a div b < 0 \ 0 < a\ if \b < 0\ for a b :: int using that by (simp add: neg_imp_zdiv_nonneg_iff flip: linorder_not_le) lemma nonneg1_imp_zdiv_pos_iff: \a div b > 0 \ a \ b \ b > 0\ if \0 \ a\ for a b :: int proof - have "0 < a div b \ b \ a" using div_pos_pos_trivial[of a b] that by arith moreover have "0 < a div b \ b > 0" using that div_nonneg_neg_le0[of a b] by (cases "b=0"; force) moreover have "b \ a \ 0 < b \ 0 < a div b" using int_one_le_iff_zero_less[of "a div b"] zdiv_mono1[of b a b] by simp ultimately show ?thesis by blast qed lemma zmod_le_nonneg_dividend: \m mod k \ m\ if \(m::int) \ 0\ for m k :: int proof - from that have \m > 0 \ m = 0\ by auto then show ?thesis proof assume \m = 0\ then show ?thesis by simp next assume \m > 0\ then show ?thesis proof (cases k \0::int\ rule: linorder_cases) case less moreover define l where \l = - k\ ultimately have \l > 0\ by simp with \m > 0\ have \int (nat m mod nat l) \ m\ by (simp flip: le_nat_iff) then have \int (nat m mod nat l) - l \ m\ using \l > 0\ by simp with \m > 0\ \l > 0\ show ?thesis by (simp add: modulo_int_def l_def flip: le_nat_iff) qed (simp_all add: modulo_int_def flip: le_nat_iff) qed qed lemma sgn_div_eq_sgn_mult: \sgn (k div l) = of_bool (k div l \ 0) * sgn (k * l)\ for k l :: int proof (cases \k div l = 0\) case True then show ?thesis by simp next case False have \0 \ \k\ div \l\\ by (cases \l = 0\) (simp_all add: pos_imp_zdiv_nonneg_iff) then have \\k\ div \l\ \ 0 \ 0 < \k\ div \l\\ by (simp add: less_le) also have \\ \ \k\ \ \l\\ using False nonneg1_imp_zdiv_pos_iff by auto finally have *: \\k\ div \l\ \ 0 \ \l\ \ \k\\ . show ?thesis using \0 \ \k\ div \l\\ False by (auto simp add: div_eq_div_abs [of k l] div_eq_sgn_abs [of k l] sgn_mult sgn_1_pos sgn_1_neg sgn_eq_0_iff nonneg1_imp_zdiv_pos_iff * dest: sgn_not_eq_imp) qed subsubsection \Further properties\ lemma div_int_pos_iff: "k div l \ 0 \ k = 0 \ l = 0 \ k \ 0 \ l \ 0 \ k < 0 \ l < 0" for k l :: int proof (cases "k = 0 \ l = 0") case False then have *: "k \ 0" "l \ 0" by auto then have "0 \ k div l \ \ k < 0 \ 0 \ l" by (meson neg_imp_zdiv_neg_iff not_le not_less_iff_gr_or_eq) then show ?thesis using * by (auto simp add: pos_imp_zdiv_nonneg_iff neg_imp_zdiv_nonneg_iff) qed auto lemma mod_int_pos_iff: \k mod l \ 0 \ l dvd k \ l = 0 \ k \ 0 \ l > 0\ for k l :: int proof (cases "l > 0") case False then show ?thesis by (simp add: dvd_eq_mod_eq_0) (use neg_mod_sign [of l k] in \auto simp add: le_less not_less\) qed auto lemma abs_div: \\x div y\ = \x\ div \y\\ if \y dvd x\ for x y :: int using that by (cases \y = 0\) (auto simp add: abs_mult) lemma int_power_div_base: \<^marker>\contributor \Matthias Daum\\ \k ^ m div k = k ^ (m - Suc 0)\ if \0 < m\ \0 < k\ for k :: int using that by (cases m) simp_all lemma int_div_less_self: \<^marker>\contributor \Matthias Daum\\ \x div k < x\ if \0 < x\ \1 < k\ for x k :: int proof - from that have \nat (x div k) = nat x div nat k\ by (simp add: nat_div_distrib) also from that have \nat x div nat k < nat x\ by simp finally show ?thesis by simp qed subsubsection \Computing \div\ and \mod\ by shifting\ lemma div_pos_geq: \k div l = (k - l) div l + 1\ if \0 < l\ \l \ k\ for k l :: int proof - have "k = (k - l) + l" by simp then obtain j where k: "k = j + l" .. with that show ?thesis by (simp add: div_add_self2) qed lemma mod_pos_geq: \k mod l = (k - l) mod l\ if \0 < l\ \l \ k\ for k l :: int proof - have "k = (k - l) + l" by simp then obtain j where k: "k = j + l" .. with that show ?thesis by simp qed lemma pos_zdiv_mult_2: \(1 + 2 * b) div (2 * a) = b div a\ (is ?Q) and pos_zmod_mult_2: \(1 + 2 * b) mod (2 * a) = 1 + 2 * (b mod a)\ (is ?R) if \0 \ a\ for a b :: int proof - have \((1 + 2 * b) div (2 * a), (1 + 2 * b) mod (2 * a)) = (b div a, 1 + 2 * (b mod a))\ proof (induction rule: euclidean_relation_intI) case by0 then show ?case by simp next case divides have \2 dvd (2 * a)\ by simp then have \2 dvd (1 + 2 * b)\ using \2 * a dvd 1 + 2 * b\ by (rule dvd_trans) then have \2 dvd (1 + b * 2)\ by (simp add: ac_simps) then have \is_unit (2 :: int)\ by simp then show ?case by simp next case euclidean_relation with that have \a > 0\ by simp moreover have \b mod a < a\ using \a > 0\ by simp then have \1 + 2 * (b mod a) < 2 * a\ by simp moreover have \2 * (b mod a) + a * (2 * (b div a)) = 2 * (b div a * a + b mod a)\ by (simp only: algebra_simps) moreover have \0 \ 2 * (b mod a)\ using \a > 0\ by simp ultimately show ?case by (simp add: algebra_simps) qed then show ?Q and ?R by simp_all qed lemma neg_zdiv_mult_2: \(1 + 2 * b) div (2 * a) = (b + 1) div a\ (is ?Q) and neg_zmod_mult_2: \(1 + 2 * b) mod (2 * a) = 2 * ((b + 1) mod a) - 1\ (is ?R) if \a \ 0\ for a b :: int proof - have \((1 + 2 * b) div (2 * a), (1 + 2 * b) mod (2 * a)) = ((b + 1) div a, 2 * ((b + 1) mod a) - 1)\ proof (induction rule: euclidean_relation_intI) case by0 then show ?case by simp next case divides have \2 dvd (2 * a)\ by simp then have \2 dvd (1 + 2 * b)\ using \2 * a dvd 1 + 2 * b\ by (rule dvd_trans) then have \2 dvd (1 + b * 2)\ by (simp add: ac_simps) then have \is_unit (2 :: int)\ by simp then show ?case by simp next case euclidean_relation with that have \a < 0\ by simp moreover have \(b + 1) mod a > a\ using \a < 0\ by simp then have \2 * ((b + 1) mod a) > 1 + 2 * a\ by simp moreover have \((1 + b) mod a) \ 0\ using \a < 0\ by simp then have \2 * ((1 + b) mod a) \ 0\ by simp moreover have \2 * ((1 + b) mod a) + a * (2 * ((1 + b) div a)) = 2 * ((1 + b) div a * a + (1 + b) mod a)\ by (simp only: algebra_simps) ultimately show ?case by (simp add: algebra_simps sgn_mult abs_mult) qed then show ?Q and ?R by simp_all qed lemma zdiv_numeral_Bit0 [simp]: \numeral (Num.Bit0 v) div numeral (Num.Bit0 w) = numeral v div (numeral w :: int)\ unfolding numeral.simps unfolding mult_2 [symmetric] by (rule div_mult_mult1) simp lemma zdiv_numeral_Bit1 [simp]: \numeral (Num.Bit1 v) div numeral (Num.Bit0 w) = (numeral v div (numeral w :: int))\ unfolding numeral.simps unfolding mult_2 [symmetric] add.commute [of _ 1] by (rule pos_zdiv_mult_2) simp lemma zmod_numeral_Bit0 [simp]: \numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) = (2::int) * (numeral v mod numeral w)\ unfolding numeral_Bit0 [of v] numeral_Bit0 [of w] unfolding mult_2 [symmetric] by (rule mod_mult_mult1) lemma zmod_numeral_Bit1 [simp]: \numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) = 2 * (numeral v mod numeral w) + (1::int)\ unfolding numeral_Bit1 [of v] numeral_Bit0 [of w] unfolding mult_2 [symmetric] add.commute [of _ 1] by (rule pos_zmod_mult_2) simp subsection \Code generation\ context begin qualified definition divmod_nat :: "nat \ nat \ nat \ nat" where "divmod_nat m n = (m div n, m mod n)" qualified lemma divmod_nat_if [code]: "divmod_nat m n = (if n = 0 \ m < n then (0, m) else let (q, r) = divmod_nat (m - n) n in (Suc q, r))" by (simp add: divmod_nat_def prod_eq_iff case_prod_beta not_less le_div_geq le_mod_geq) qualified lemma [code]: "m div n = fst (divmod_nat m n)" "m mod n = snd (divmod_nat m n)" by (simp_all add: divmod_nat_def) end code_identifier code_module Euclidean_Rings \ (SML) Arith and (OCaml) Arith and (Haskell) Arith end diff --git a/src/HOL/Number_Theory/Pocklington.thy b/src/HOL/Number_Theory/Pocklington.thy --- a/src/HOL/Number_Theory/Pocklington.thy +++ b/src/HOL/Number_Theory/Pocklington.thy @@ -1,1286 +1,1286 @@ (* Title: HOL/Number_Theory/Pocklington.thy Author: Amine Chaieb, Manuel Eberl *) section \Pocklington's Theorem for Primes\ theory Pocklington imports Residues begin subsection \Lemmas about previously defined terms\ lemma prime_nat_iff'': "prime (p::nat) \ p \ 0 \ p \ 1 \ (\m. 0 < m \ m < p \ coprime p m)" apply (auto simp add: prime_nat_iff) apply (rule coprimeI) apply (auto dest: nat_dvd_not_less simp add: ac_simps) apply (metis One_nat_def dvd_1_iff_1 dvd_pos_nat gcd_nat.order_iff is_unit_gcd linorder_neqE_nat nat_dvd_not_less) done lemma finite_number_segment: "card { m. 0 < m \ m < n } = n - 1" proof - have "{ m. 0 < m \ m < n } = {1..Some basic theorems about solving congruences\ lemma cong_solve: fixes n :: nat assumes an: "coprime a n" shows "\x. [a * x = b] (mod n)" proof (cases "a = 0") case True with an show ?thesis by (simp add: cong_def) next case False from bezout_add_strong_nat [OF this] obtain d x y where dxy: "d dvd a" "d dvd n" "a * x = n * y + d" by blast from dxy(1,2) have d1: "d = 1" using assms coprime_common_divisor [of a n d] by simp with dxy(3) have "a * x * b = (n * y + 1) * b" by simp then have "a * (x * b) = n * (y * b) + b" by (auto simp: algebra_simps) then have "a * (x * b) mod n = (n * (y * b) + b) mod n" by simp then have "a * (x * b) mod n = b mod n" by (simp add: mod_add_left_eq) then have "[a * (x * b) = b] (mod n)" by (simp only: cong_def) then show ?thesis by blast qed lemma cong_solve_unique: fixes n :: nat assumes an: "coprime a n" and nz: "n \ 0" shows "\!x. x < n \ [a * x = b] (mod n)" proof - from cong_solve[OF an] obtain x where x: "[a * x = b] (mod n)" by blast let ?P = "\x. x < n \ [a * x = b] (mod n)" let ?x = "x mod n" from x have *: "[a * ?x = b] (mod n)" by (simp add: cong_def mod_mult_right_eq[of a x n]) from mod_less_divisor[ of n x] nz * have Px: "?P ?x" by simp have "y = ?x" if Py: "y < n" "[a * y = b] (mod n)" for y proof - from Py(2) * have "[a * y = a * ?x] (mod n)" by (simp add: cong_def) then have "[y = ?x] (mod n)" by (metis an cong_mult_lcancel_nat) with mod_less[OF Py(1)] mod_less_divisor[ of n x] nz show ?thesis by (simp add: cong_def) qed with Px show ?thesis by blast qed lemma cong_solve_unique_nontrivial: fixes p :: nat assumes p: "prime p" and pa: "coprime p a" and x0: "0 < x" and xp: "x < p" shows "\!y. 0 < y \ y < p \ [x * y = a] (mod p)" proof - from pa have ap: "coprime a p" by (simp add: ac_simps) from x0 xp p have px: "coprime x p" by (auto simp add: prime_nat_iff'' ac_simps) obtain y where y: "y < p" "[x * y = a] (mod p)" "\z. z < p \ [x * z = a] (mod p) \ z = y" by (metis cong_solve_unique neq0_conv p prime_gt_0_nat px) have "y \ 0" proof assume "y = 0" with y(2) have "p dvd a" using cong_dvd_iff by auto with not_prime_1 p pa show False by (auto simp add: gcd_nat.order_iff) qed with y show ?thesis by blast qed lemma cong_unique_inverse_prime: fixes p :: nat assumes "prime p" and "0 < x" and "x < p" shows "\!y. 0 < y \ y < p \ [x * y = 1] (mod p)" by (rule cong_solve_unique_nontrivial) (use assms in simp_all) lemma chinese_remainder_coprime_unique: fixes a :: nat assumes ab: "coprime a b" and az: "a \ 0" and bz: "b \ 0" and ma: "coprime m a" and nb: "coprime n b" shows "\!x. coprime x (a * b) \ x < a * b \ [x = m] (mod a) \ [x = n] (mod b)" proof - let ?P = "\x. x < a * b \ [x = m] (mod a) \ [x = n] (mod b)" from binary_chinese_remainder_unique_nat[OF ab az bz] obtain x where x: "x < a * b" "[x = m] (mod a)" "[x = n] (mod b)" "\y. ?P y \ y = x" by blast from ma nb x have "coprime x a" "coprime x b" using cong_imp_coprime cong_sym by blast+ then have "coprime x (a*b)" by simp with x show ?thesis by blast qed subsection \Lucas's theorem\ lemma lucas_coprime_lemma: fixes n :: nat assumes m: "m \ 0" and am: "[a^m = 1] (mod n)" shows "coprime a n" proof - consider "n = 1" | "n = 0" | "n > 1" by arith then show ?thesis proof cases case 1 then show ?thesis by simp next case 2 with am m show ?thesis by simp next case 3 from m obtain m' where m': "m = Suc m'" by (cases m) blast+ have "d = 1" if d: "d dvd a" "d dvd n" for d proof - from am mod_less[OF \n > 1\] have am1: "a^m mod n = 1" by (simp add: cong_def) from dvd_mult2[OF d(1), of "a^m'"] have dam: "d dvd a^m" by (simp add: m') from dvd_mod_iff[OF d(2), of "a^m"] dam am1 show ?thesis by simp qed then show ?thesis by (auto intro: coprimeI) qed qed lemma lucas_weak: fixes n :: nat assumes n: "n \ 2" and an: "[a ^ (n - 1) = 1] (mod n)" and nm: "\m. 0 < m \ m < n - 1 \ \ [a ^ m = 1] (mod n)" shows "prime n" proof (rule totient_imp_prime) show "totient n = n - 1" proof (rule ccontr) have "[a ^ totient n = 1] (mod n)" by (rule euler_theorem, rule lucas_coprime_lemma [of "n - 1"]) (use n an in auto) moreover assume "totient n \ n - 1" then have "totient n > 0" "totient n < n - 1" using \n \ 2\ and totient_less[of n] by simp_all ultimately show False using nm by auto qed qed (use n in auto) lemma nat_exists_least_iff: "(\(n::nat). P n) \ (\n. P n \ (\m < n. \ P m))" by (metis ex_least_nat_le not_less0) lemma nat_exists_least_iff': "(\(n::nat). P n) \ P (Least P) \ (\m < (Least P). \ P m)" (is "?lhs \ ?rhs") proof show ?lhs if ?rhs using that by blast show ?rhs if ?lhs proof - from \?lhs\ obtain n where n: "P n" by blast let ?x = "Least P" have "\ P m" if "m < ?x" for m by (rule not_less_Least[OF that]) with LeastI_ex[OF \?lhs\] show ?thesis by blast qed qed theorem lucas: assumes n2: "n \ 2" and an1: "[a^(n - 1) = 1] (mod n)" and pn: "\p. prime p \ p dvd n - 1 \ [a^((n - 1) div p) \ 1] (mod n)" shows "prime n" proof- from n2 have n01: "n \ 0" "n \ 1" "n - 1 \ 0" by arith+ from mod_less_divisor[of n 1] n01 have onen: "1 mod n = 1" by simp from lucas_coprime_lemma[OF n01(3) an1] cong_imp_coprime an1 have an: "coprime a n" "coprime (a ^ (n - 1)) n" using \n \ 2\ by simp_all have False if H0: "\m. 0 < m \ m < n - 1 \ [a ^ m = 1] (mod n)" (is "\m. ?P m") proof - from H0[unfolded nat_exists_least_iff[of ?P]] obtain m where m: "0 < m" "m < n - 1" "[a ^ m = 1] (mod n)" "\k ?P k" by blast have False if nm1: "(n - 1) mod m > 0" proof - from mod_less_divisor[OF m(1)] have th0:"(n - 1) mod m < m" by blast let ?y = "a^ ((n - 1) div m * m)" note mdeq = div_mult_mod_eq[of "(n - 1)" m] have yn: "coprime ?y n" using an(1) by (cases "(n - Suc 0) div m * m = 0") auto have "?y mod n = (a^m)^((n - 1) div m) mod n" by (simp add: algebra_simps power_mult) also have "\ = (a^m mod n)^((n - 1) div m) mod n" using power_mod[of "a^m" n "(n - 1) div m"] by simp also have "\ = 1" using m(3)[unfolded cong_def onen] onen by (metis power_one) finally have *: "?y mod n = 1" . have **: "[?y * a ^ ((n - 1) mod m) = ?y* 1] (mod n)" using an1[unfolded cong_def onen] onen div_mult_mod_eq[of "(n - 1)" m, symmetric] by (simp add:power_add[symmetric] cong_def * del: One_nat_def) have "[a ^ ((n - 1) mod m) = 1] (mod n)" by (metis cong_mult_rcancel_nat mult.commute ** yn) with m(4)[rule_format, OF th0] nm1 less_trans[OF mod_less_divisor[OF m(1), of "n - 1"] m(2)] show ?thesis by blast qed then have "(n - 1) mod m = 0" by auto then have mn: "m dvd n - 1" by presburger then obtain r where r: "n - 1 = m * r" unfolding dvd_def by blast from n01 r m(2) have r01: "r \ 0" "r \ 1" by auto obtain p where p: "prime p" "p dvd r" by (metis prime_factor_nat r01(2)) then have th: "prime p \ p dvd n - 1" unfolding r by (auto intro: dvd_mult) from r have "(a ^ ((n - 1) div p)) mod n = (a^(m*r div p)) mod n" by (simp add: power_mult) also have "\ = (a^(m*(r div p))) mod n" using div_mult1_eq[of m r p] p(2)[unfolded dvd_eq_mod_eq_0] by simp also have "\ = ((a^m)^(r div p)) mod n" by (simp add: power_mult) also have "\ = ((a^m mod n)^(r div p)) mod n" using power_mod .. also from m(3) onen have "\ = 1" by (simp add: cong_def) finally have "[(a ^ ((n - 1) div p))= 1] (mod n)" using onen by (simp add: cong_def) with pn th show ?thesis by blast qed then have "\m. 0 < m \ m < n - 1 \ \ [a ^ m = 1] (mod n)" by blast then show ?thesis by (rule lucas_weak[OF n2 an1]) qed subsection \Definition of the order of a number mod \n\\ definition "ord n a = (if coprime n a then Least (\d. d > 0 \ [a ^d = 1] (mod n)) else 0)" text \This has the expected properties.\ lemma coprime_ord: fixes n::nat assumes "coprime n a" shows "ord n a > 0 \ [a ^(ord n a) = 1] (mod n) \ (\m. 0 < m \ m < ord n a \ [a^ m \ 1] (mod n))" proof- let ?P = "\d. 0 < d \ [a ^ d = 1] (mod n)" from bigger_prime[of a] obtain p where p: "prime p" "a < p" by blast from assms have o: "ord n a = Least ?P" by (simp add: ord_def) have ex: "\m>0. ?P m" proof (cases "n \ 2") case True moreover from assms have "coprime a n" by (simp add: ac_simps) then have "[a ^ totient n = 1] (mod n)" by (rule euler_theorem) ultimately show ?thesis by (auto intro: exI [where x = "totient n"]) next case False then have "n = 0 \ n = 1" by auto with assms show ?thesis by auto qed from nat_exists_least_iff'[of ?P] ex assms show ?thesis unfolding o[symmetric] by auto qed text \With the special value \0\ for non-coprime case, it's more convenient.\ lemma ord_works: "[a ^ (ord n a) = 1] (mod n) \ (\m. 0 < m \ m < ord n a \ \ [a^ m = 1] (mod n))" for n :: nat by (cases "coprime n a") (use coprime_ord[of n a] in \auto simp add: ord_def cong_def\) lemma ord: "[a^(ord n a) = 1] (mod n)" for n :: nat using ord_works by blast lemma ord_minimal: "0 < m \ m < ord n a \ \ [a^m = 1] (mod n)" for n :: nat using ord_works by blast lemma ord_eq_0: "ord n a = 0 \ \ coprime n a" for n :: nat by (cases "coprime n a") (simp add: coprime_ord, simp add: ord_def) lemma divides_rexp: "x dvd y \ x dvd (y ^ Suc n)" for x y :: nat by (simp add: dvd_mult2[of x y]) lemma ord_divides:"[a ^ d = 1] (mod n) \ ord n a dvd d" (is "?lhs \ ?rhs") for n :: nat proof assume ?rhs then obtain k where "d = ord n a * k" unfolding dvd_def by blast then have "[a ^ d = (a ^ (ord n a) mod n)^k] (mod n)" by (simp add : cong_def power_mult power_mod) also have "[(a ^ (ord n a) mod n)^k = 1] (mod n)" using ord[of a n, unfolded cong_def] by (simp add: cong_def power_mod) finally show ?lhs . next assume ?lhs show ?rhs proof (cases "coprime n a") case prem: False then have o: "ord n a = 0" by (simp add: ord_def) show ?thesis proof (cases d) case 0 with o prem show ?thesis by (simp add: cong_def) next case (Suc d') then have d0: "d \ 0" by simp from prem obtain p where p: "p dvd n" "p dvd a" "p \ 1" by (auto elim: not_coprimeE) from \?lhs\ obtain q1 q2 where q12: "a ^ d + n * q1 = 1 + n * q2" using prem d0 lucas_coprime_lemma by (auto elim: not_coprimeE simp add: ac_simps) then have "a ^ d + n * q1 - n * q2 = 1" by simp with dvd_diff_nat [OF dvd_add [OF divides_rexp]] dvd_mult2 Suc p have "p dvd 1" by metis with p(3) have False by simp then show ?thesis .. qed next case H: True let ?o = "ord n a" let ?q = "d div ord n a" let ?r = "d mod ord n a" have eqo: "[(a^?o)^?q = 1] (mod n)" using cong_pow ord_works by fastforce from H have onz: "?o \ 0" by (simp add: ord_eq_0) then have opos: "?o > 0" by simp from div_mult_mod_eq[of d "ord n a"] \?lhs\ have "[a^(?o*?q + ?r) = 1] (mod n)" by (simp add: cong_def mult.commute) then have "[(a^?o)^?q * (a^?r) = 1] (mod n)" by (simp add: cong_def power_mult[symmetric] power_add[symmetric]) then have th: "[a^?r = 1] (mod n)" using eqo mod_mult_left_eq[of "(a^?o)^?q" "a^?r" n] by (simp add: cong_def del: One_nat_def) (metis mod_mult_left_eq nat_mult_1) show ?thesis proof (cases "?r = 0") case True then show ?thesis by (simp add: dvd_eq_mod_eq_0) next case False with mod_less_divisor[OF opos, of d] have r0o:"?r >0 \ ?r < ?o" by simp from conjunct2[OF ord_works[of a n], rule_format, OF r0o] th show ?thesis by blast qed qed qed lemma order_divides_totient: "ord n a dvd totient n" if "coprime n a" using that euler_theorem [of a n] by (simp add: ord_divides [symmetric] ac_simps) lemma order_divides_expdiff: fixes n::nat and a::nat assumes na: "coprime n a" shows "[a^d = a^e] (mod n) \ [d = e] (mod (ord n a))" proof - have th: "[a^d = a^e] (mod n) \ [d = e] (mod (ord n a))" if na: "coprime n a" and ed: "(e::nat) \ d" for n a d e :: nat proof - from na ed have "\c. d = e + c" by presburger then obtain c where c: "d = e + c" .. from na have an: "coprime a n" by (simp add: ac_simps) then have aen: "coprime (a ^ e) n" by (cases "e > 0") simp_all from an have acn: "coprime (a ^ c) n" by (cases "c > 0") simp_all from c have "[a^d = a^e] (mod n) \ [a^(e + c) = a^(e + 0)] (mod n)" by simp also have "\ \ [a^e* a^c = a^e *a^0] (mod n)" by (simp add: power_add) also have "\ \ [a ^ c = 1] (mod n)" using cong_mult_lcancel_nat [OF aen, of "a^c" "a^0"] by simp also have "\ \ ord n a dvd c" by (simp only: ord_divides) also have "\ \ [e + c = e + 0] (mod ord n a)" by (auto simp add: cong_altdef_nat) finally show ?thesis using c by simp qed consider "e \ d" | "d \ e" by arith then show ?thesis proof cases case 1 with na show ?thesis by (rule th) next case 2 from th[OF na this] show ?thesis by (metis cong_sym) qed qed lemma ord_not_coprime [simp]: "\coprime n a \ ord n a = 0" by (simp add: ord_def) lemma ord_1 [simp]: "ord 1 n = 1" proof - have "(LEAST k. k > 0) = (1 :: nat)" by (rule Least_equality) auto thus ?thesis by (simp add: ord_def) qed lemma ord_1_right [simp]: "ord (n::nat) 1 = 1" using ord_divides[of 1 1 n] by simp lemma ord_Suc_0_right [simp]: "ord (n::nat) (Suc 0) = 1" using ord_divides[of 1 1 n] by simp lemma ord_0_nat [simp]: "ord 0 (n :: nat) = (if n = 1 then 1 else 0)" proof - have "(LEAST k. k > 0) = (1 :: nat)" by (rule Least_equality) auto thus ?thesis by (auto simp: ord_def) qed lemma ord_0_right_nat [simp]: "ord (n :: nat) 0 = (if n = 1 then 1 else 0)" proof - have "(LEAST k. k > 0) = (1 :: nat)" by (rule Least_equality) auto thus ?thesis by (auto simp: ord_def) qed lemma ord_divides': "[a ^ d = Suc 0] (mod n) = (ord n a dvd d)" using ord_divides[of a d n] by simp lemma ord_Suc_0 [simp]: "ord (Suc 0) n = 1" using ord_1[where 'a = nat] by (simp del: ord_1) lemma ord_mod [simp]: "ord n (k mod n) = ord n k" by (cases "n = 0") (auto simp add: ord_def cong_def power_mod) lemma ord_gt_0_iff [simp]: "ord (n::nat) x > 0 \ coprime n x" using ord_eq_0[of n x] by auto lemma ord_eq_Suc_0_iff: "ord n (x::nat) = Suc 0 \ [x = 1] (mod n)" using ord_divides[of x 1 n] by (auto simp: ord_divides') lemma ord_cong: assumes "[k1 = k2] (mod n)" shows "ord n k1 = ord n k2" proof - have "ord n (k1 mod n) = ord n (k2 mod n)" by (simp only: assms[unfolded cong_def]) thus ?thesis by simp qed lemma ord_nat_code [code_unfold]: "ord n a = (if n = 0 then if a = 1 then 1 else 0 else if coprime n a then Min (Set.filter (\k. [a ^ k = 1] (mod n)) {0<..n}) else 0)" proof (cases "coprime n a \ n > 0") case True define A where "A = {k\{0<..n}. [a ^ k = 1] (mod n)}" define k where "k = (LEAST k. k > 0 \ [a ^ k = 1] (mod n))" have totient: "totient n \ A" using euler_theorem[of a n] True by (auto simp: A_def coprime_commute intro!: Nat.gr0I totient_le) moreover have "finite A" by (auto simp: A_def) ultimately have *: "Min A \ A" and "\y. y \ A \ Min A \ y" by (auto intro: Min_in) have "k > 0 \ [a ^ k = 1] (mod n)" unfolding k_def by (rule LeastI[of _ "totient n"]) (use totient in \auto simp: A_def\) moreover have "k \ totient n" unfolding k_def by (intro Least_le) (use totient in \auto simp: A_def\) ultimately have "k \ A" using totient_le[of n] by (auto simp: A_def) hence "Min A \ k" by (intro Min_le) (auto simp: \finite A\) moreover from * have "k \ Min A" unfolding k_def by (intro Least_le) (auto simp: A_def) ultimately show ?thesis using True by (simp add: ord_def k_def A_def Set.filter_def) qed auto theorem ord_modulus_mult_coprime: fixes x :: nat assumes "coprime m n" shows "ord (m * n) x = lcm (ord m x) (ord n x)" proof (intro dvd_antisym) have "[x ^ lcm (ord m x) (ord n x) = 1] (mod (m * n))" using assms by (intro coprime_cong_mult_nat assms) (auto simp: ord_divides') thus "ord (m * n) x dvd lcm (ord m x) (ord n x)" by (simp add: ord_divides') next show "lcm (ord m x) (ord n x) dvd ord (m * n) x" proof (intro lcm_least) show "ord m x dvd ord (m * n) x" using cong_modulus_mult_nat[of "x ^ ord (m * n) x" 1 m n] assms by (simp add: ord_divides') show "ord n x dvd ord (m * n) x" using cong_modulus_mult_nat[of "x ^ ord (m * n) x" 1 n m] assms by (simp add: ord_divides' mult.commute) qed qed corollary ord_modulus_prod_coprime: assumes "finite A" "\i j. i \ A \ j \ A \ i \ j \ coprime (f i) (f j)" shows "ord (\i\A. f i :: nat) x = (LCM i\A. ord (f i) x)" using assms by (induction A rule: finite_induct) (simp, simp, subst ord_modulus_mult_coprime, auto intro!: prod_coprime_right) lemma ord_power_aux: fixes m x k a :: nat defines "l \ ord m a" shows "ord m (a ^ k) * gcd k l = l" proof (rule dvd_antisym) have "[a ^ lcm k l = 1] (mod m)" unfolding ord_divides by (simp add: l_def) also have "lcm k l = k * (l div gcd k l)" by (simp add: lcm_nat_def div_mult_swap) finally have "ord m (a ^ k) dvd l div gcd k l" unfolding ord_divides [symmetric] by (simp add: power_mult [symmetric]) thus "ord m (a ^ k) * gcd k l dvd l" by (cases "l = 0") (auto simp: dvd_div_iff_mult) have "[(a ^ k) ^ ord m (a ^ k) = 1] (mod m)" by (rule ord) also have "(a ^ k) ^ ord m (a ^ k) = a ^ (k * ord m (a ^ k))" by (simp add: power_mult) finally have "ord m a dvd k * ord m (a ^ k)" by (simp add: ord_divides') hence "l dvd gcd (k * ord m (a ^ k)) (l * ord m (a ^ k))" by (intro gcd_greatest dvd_triv_left) (auto simp: l_def ord_divides') also have "gcd (k * ord m (a ^ k)) (l * ord m (a ^ k)) = ord m (a ^ k) * gcd k l" by (subst gcd_mult_distrib_nat) (auto simp: mult_ac) finally show "l dvd ord m (a ^ k) * gcd k l" . qed theorem ord_power: "coprime m a \ ord m (a ^ k :: nat) = ord m a div gcd k (ord m a)" using ord_power_aux[of m a k] by (metis div_mult_self_is_m gcd_pos_nat ord_eq_0) lemma inj_power_mod: assumes "coprime n (a :: nat)" shows "inj_on (\k. a ^ k mod n) {.. {.. {.. = a ^ k * a ^ (l - k)" by (simp add: power_add) also have "[\ = a ^ l * a ^ (l - k)] (mod n)" using that by (intro cong_mult) auto finally have "[a ^ l * a ^ (l - k) = a ^ l * 1] (mod n)" by (simp add: cong_sym_eq) with assms have "[a ^ (l - k) = 1] (mod n)" by (subst (asm) cong_mult_lcancel_nat) (auto simp: coprime_commute) hence "ord n a dvd l - k" by (simp add: ord_divides') from dvd_imp_le[OF this] and \l < ord n a\ have "l - k = 0" by (cases "l - k = 0") auto with \k < l\ show "k = l" by simp qed from this[of k l] and this[of l k] and * show "k = l" by (cases k l rule: linorder_cases) (auto simp: cong_def) qed lemma ord_eq_2_iff: "ord n (x :: nat) = 2 \ [x \ 1] (mod n) \ [x\<^sup>2 = 1] (mod n)" proof assume x: "[x \ 1] (mod n) \ [x\<^sup>2 = 1] (mod n)" hence "coprime n x" by (metis coprime_commute lucas_coprime_lemma zero_neq_numeral) with x have "ord n x dvd 2" "ord n x \ 1" "ord n x > 0" by (auto simp: ord_divides' ord_eq_Suc_0_iff) thus "ord n x = 2" by (auto dest!: dvd_imp_le simp del: ord_gt_0_iff) qed (use ord_divides[of _ 2] ord_divides[of _ 1] in auto) lemma square_mod_8_eq_1_iff: "[x\<^sup>2 = 1] (mod 8) \ odd (x :: nat)" proof - have "[x\<^sup>2 = 1] (mod 8) \ ((x mod 8)\<^sup>2 mod 8 = 1)" by (simp add: power_mod cong_def) also have "\ \ x mod 8 \ {1, 3, 5, 7}" proof assume x: "(x mod 8)\<^sup>2 mod 8 = 1" have "x mod 8 \ {..<8}" by simp also have "{..<8} = {0, 1, 2, 3, 4, 5, 6, 7::nat}" by (simp add: lessThan_nat_numeral lessThan_Suc insert_commute) finally have x_cases: "x mod 8 \ {0, 1, 2, 3, 4, 5, 6, 7}" . from x have "x mod 8 \ {0, 2, 4, 6}" using x by (auto intro: Nat.gr0I) with x_cases show "x mod 8 \ {1, 3, 5, 7}" by simp qed auto also have "\ \ odd (x mod 8)" by (auto elim!: oddE) also have "\ \ odd x" by presburger finally show ?thesis . qed lemma ord_twopow_aux: assumes "k \ 3" and "odd (x :: nat)" shows "[x ^ (2 ^ (k - 2)) = 1] (mod (2 ^ k))" using assms(1) proof (induction k rule: dec_induct) case base from assms have "[x\<^sup>2 = 1] (mod 8)" by (subst square_mod_8_eq_1_iff) auto thus ?case by simp next case (step k) define k' where "k' = k - 2" have k: "k = Suc (Suc k')" using \k \ 3\ by (simp add: k'_def) from \k \ 3\ have "2 * k \ Suc k" by presburger from \odd x\ have "x > 0" by (intro Nat.gr0I) auto from step.IH have "2 ^ k dvd (x ^ (2 ^ (k - 2)) - 1)" by (rule cong_to_1_nat) then obtain t where "x ^ (2 ^ (k - 2)) - 1 = t * 2 ^ k" by auto hence "x ^ (2 ^ (k - 2)) = t * 2 ^ k + 1" by (metis \0 < x\ add.commute add_diff_inverse_nat less_one neq0_conv power_eq_0_iff) hence "(x ^ (2 ^ (k - 2))) ^ 2 = (t * 2 ^ k + 1) ^ 2" by (rule arg_cong) hence "[(x ^ (2 ^ (k - 2))) ^ 2 = (t * 2 ^ k + 1) ^ 2] (mod (2 ^ Suc k))" by simp also have "(x ^ (2 ^ (k - 2))) ^ 2 = x ^ (2 ^ (k - 1))" by (simp_all add: power_even_eq[symmetric] power_mult k ) also have "(t * 2 ^ k + 1) ^ 2 = t\<^sup>2 * 2 ^ (2 * k) + t * 2 ^ Suc k + 1" by (subst power2_eq_square) (auto simp: algebra_simps k power2_eq_square[of t] power_even_eq[symmetric] power_add [symmetric]) also have "[\ = 0 + 0 + 1] (mod 2 ^ Suc k)" using \2 * k \ Suc k\ by (intro cong_add) (auto simp: cong_0_iff intro: dvd_mult[OF le_imp_power_dvd] simp del: power_Suc) finally show ?case by simp qed lemma ord_twopow_3_5: assumes "k \ 3" "x mod 8 \ {3, 5 :: nat}" shows "ord (2 ^ k) x = 2 ^ (k - 2)" using assms(1) proof (induction k rule: less_induct) have "x mod 8 = 3 \ x mod 8 = 5" using assms by auto hence "odd x" by presburger case (less k) from \k \ 3\ consider "k = 3" | "k = 4" | "k \ 5" by force thus ?case proof cases case 1 thus ?thesis using assms by (auto simp: ord_eq_2_iff cong_def simp flip: power_mod[of x]) next case 2 from assms have "x mod 8 = 3 \ x mod 8 = 5" by auto then have x': "x mod 16 = 3 \ x mod 16 = 5 \ x mod 16 = 11 \ x mod 16 = 13" - using mod_double_modulus [of 8 x] by auto + using mod_double_nat [of x 8] by auto hence "[x ^ 4 = 1] (mod 16)" using assms by (auto simp: cong_def simp flip: power_mod[of x]) hence "ord 16 x dvd 2\<^sup>2" by (simp add: ord_divides') then obtain l where l: "ord 16 x = 2 ^ l" "l \ 2" by (subst (asm) divides_primepow_nat) auto have "[x ^ 2 \ 1] (mod 16)" using x' by (auto simp: cong_def simp flip: power_mod[of x]) hence "\ord 16 x dvd 2" by (simp add: ord_divides') with l have "l = 2" using le_imp_power_dvd[of l 1 2] by (cases "l \ 1") auto with l show ?thesis by (simp add: \k = 4\) next case 3 define k' where "k' = k - 2" have k': "k' \ 2" and [simp]: "k = Suc (Suc k')" using 3 by (simp_all add: k'_def) have IH: "ord (2 ^ k') x = 2 ^ (k' - 2)" "ord (2 ^ Suc k') x = 2 ^ (k' - 1)" using less.IH[of k'] less.IH[of "Suc k'"] 3 by simp_all from IH have cong: "[x ^ (2 ^ (k' - 2)) = 1] (mod (2 ^ k'))" by (simp_all add: ord_divides') have notcong: "[x ^ (2 ^ (k' - 2)) \ 1] (mod (2 ^ Suc k'))" proof assume "[x ^ (2 ^ (k' - 2)) = 1] (mod (2 ^ Suc k'))" hence "ord (2 ^ Suc k') x dvd 2 ^ (k' - 2)" by (simp add: ord_divides') also have "ord (2 ^ Suc k') x = 2 ^ (k' - 1)" using IH by simp finally have "k' - 1 \ k' - 2" by (rule power_dvd_imp_le) auto with \k' \ 2\ show False by simp qed have "2 ^ k' + 1 < 2 ^ k' + (2 ^ k' :: nat)" using one_less_power[of "2::nat" k'] k' by (intro add_strict_left_mono) auto with cong notcong have cong': "x ^ (2 ^ (k' - 2)) mod 2 ^ Suc k' = 1 + 2 ^ k'" - using mod_double_modulus [of "2 ^ k'" "x ^ 2 ^ (k' - 2)"] k' by (auto simp: cong_def) + using mod_double_nat [of \x ^ 2 ^ (k' - 2)\ \2 ^ k'\] k' by (auto simp: cong_def) hence "x ^ (2 ^ (k' - 2)) mod 2 ^ k = 1 + 2 ^ k' \ x ^ (2 ^ (k' - 2)) mod 2 ^ k = 1 + 2 ^ k' + 2 ^ Suc k'" - using mod_double_modulus [of "2 ^ Suc k'" "x ^ 2 ^ (k' - 2)"] by auto + using mod_double_nat [of \x ^ 2 ^ (k' - 2)\ \2 ^ Suc k'\] by auto hence eq: "[x ^ 2 ^ (k' - 1) = 1 + 2 ^ (k - 1)] (mod 2 ^ k)" proof assume *: "x ^ (2 ^ (k' - 2)) mod (2 ^ k) = 1 + 2 ^ k'" have "[x ^ (2 ^ (k' - 2)) = x ^ (2 ^ (k' - 2)) mod 2 ^ k] (mod 2 ^ k)" by simp also have "[x ^ (2 ^ (k' - 2)) mod (2 ^ k) = 1 + 2 ^ k'] (mod 2 ^ k)" by (subst *) auto finally have "[(x ^ 2 ^ (k' - 2)) ^ 2 = (1 + 2 ^ k') ^ 2] (mod 2 ^ k)" by (rule cong_pow) hence "[x ^ 2 ^ Suc (k' - 2) = (1 + 2 ^ k') ^ 2] (mod 2 ^ k)" by (simp add: power_mult [symmetric] power_Suc2 [symmetric] del: power_Suc) also have "Suc (k' - 2) = k' - 1" using k' by simp also have "(1 + 2 ^ k' :: nat)\<^sup>2 = 1 + 2 ^ (k - 1) + 2 ^ (2 * k')" by (subst power2_eq_square) (simp add: algebra_simps flip: power_add) also have "(2 ^ k :: nat) dvd 2 ^ (2 * k')" using k' by (intro le_imp_power_dvd) auto hence "[1 + 2 ^ (k - 1) + 2 ^ (2 * k') = 1 + 2 ^ (k - 1) + (0 :: nat)] (mod 2 ^ k)" by (intro cong_add) (auto simp: cong_0_iff) finally show "[x ^ 2 ^ (k' - 1) = 1 + 2 ^ (k - 1)] (mod 2 ^ k)" by simp next assume *: "x ^ (2 ^ (k' - 2)) mod 2 ^ k = 1 + 2 ^ k' + 2 ^ Suc k'" have "[x ^ (2 ^ (k' - 2)) = x ^ (2 ^ (k' - 2)) mod 2 ^ k] (mod 2 ^ k)" by simp also have "[x ^ (2 ^ (k' - 2)) mod (2 ^ k) = 1 + 3 * 2 ^ k'] (mod 2 ^ k)" by (subst *) auto finally have "[(x ^ 2 ^ (k' - 2)) ^ 2 = (1 + 3 * 2 ^ k') ^ 2] (mod 2 ^ k)" by (rule cong_pow) hence "[x ^ 2 ^ Suc (k' - 2) = (1 + 3 * 2 ^ k') ^ 2] (mod 2 ^ k)" by (simp add: power_mult [symmetric] power_Suc2 [symmetric] del: power_Suc) also have "Suc (k' - 2) = k' - 1" using k' by simp also have "(1 + 3 * 2 ^ k' :: nat)\<^sup>2 = 1 + 2 ^ (k - 1) + 2 ^ k + 9 * 2 ^ (2 * k')" by (subst power2_eq_square) (simp add: algebra_simps flip: power_add) also have "(2 ^ k :: nat) dvd 9 * 2 ^ (2 * k')" using k' by (intro dvd_mult le_imp_power_dvd) auto hence "[1 + 2 ^ (k - 1) + 2 ^ k + 9 * 2 ^ (2 * k') = 1 + 2 ^ (k - 1) + 0 + (0 :: nat)] (mod 2 ^ k)" by (intro cong_add) (auto simp: cong_0_iff) finally show "[x ^ 2 ^ (k' - 1) = 1 + 2 ^ (k - 1)] (mod 2 ^ k)" by simp qed have notcong': "[x ^ 2 ^ (k - 3) \ 1] (mod 2 ^ k)" proof assume "[x ^ 2 ^ (k - 3) = 1] (mod 2 ^ k)" hence "[x ^ 2 ^ (k' - 1) - x ^ 2 ^ (k' - 1) = 1 + 2 ^ (k - 1) - 1] (mod 2 ^ k)" by (intro cong_diff_nat eq) auto hence "[2 ^ (k - 1) = (0 :: nat)] (mod 2 ^ k)" by (simp add: cong_sym_eq) hence "2 ^ k dvd 2 ^ (k - 1)" by (simp add: cong_0_iff) hence "k \ k - 1" by (rule power_dvd_imp_le) auto thus False by simp qed have "[x ^ 2 ^ (k - 2) = 1] (mod 2 ^ k)" using ord_twopow_aux[of k x] \odd x\ \k \ 3\ by simp hence "ord (2 ^ k) x dvd 2 ^ (k - 2)" by (simp add: ord_divides') then obtain l where l: "l \ k - 2" "ord (2 ^ k) x = 2 ^ l" using divides_primepow_nat[of 2 "ord (2 ^ k) x" "k - 2"] by auto from notcong' have "\ord (2 ^ k) x dvd 2 ^ (k - 3)" by (simp add: ord_divides') with l have "l = k - 2" using le_imp_power_dvd[of l "k - 3" 2] by (cases "l \ k - 3") auto with l show ?thesis by simp qed qed lemma ord_4_3 [simp]: "ord 4 (3::nat) = 2" proof - have "[3 ^ 2 = (1 :: nat)] (mod 4)" by (simp add: cong_def) hence "ord 4 (3::nat) dvd 2" by (subst (asm) ord_divides) auto hence "ord 4 (3::nat) \ 2" by (intro dvd_imp_le) auto moreover have "ord 4 (3::nat) \ 1" by (auto simp: ord_eq_Suc_0_iff cong_def) moreover have "ord 4 (3::nat) \ 0" by (auto simp: gcd_non_0_nat coprime_iff_gcd_eq_1) ultimately show "ord 4 (3 :: nat) = 2" by linarith qed lemma elements_with_ord_1: "n > 0 \ {x\totatives n. ord n x = Suc 0} = {1}" by (auto simp: ord_eq_Suc_0_iff cong_def totatives_less) lemma residue_prime_has_primroot: fixes p :: nat assumes "prime p" shows "\a\totatives p. ord p a = p - 1" proof - from residue_prime_mult_group_has_gen[OF assms] obtain a where a: "a \ {1..p-1}" "{1..p-1} = {a ^ i mod p |i. i \ UNIV}" by blast from a have "coprime p a" using a assms by (intro prime_imp_coprime) (auto dest: dvd_imp_le) with a(1) have "a \ totatives p" by (auto simp: totatives_def coprime_commute) have "p - 1 = card {1..p-1}" by simp also have "{1..p-1} = {a ^ i mod p |i. i \ UNIV}" by fact also have "{a ^ i mod p |i. i \ UNIV} = (\i. a ^ i mod p) ` {.. {a ^ i mod p |i. i \ UNIV}" then obtain i where [simp]: "x = a ^ i mod p" by auto have "[a ^ i = a ^ (i mod ord p a)] (mod p)" using \coprime p a\ by (subst order_divides_expdiff) auto hence "\j. a ^ i mod p = a ^ j mod p \ j < ord p a" using \coprime p a\ by (intro exI[of _ "i mod ord p a"]) (auto simp: cong_def) thus "x \ (\i. a ^ i mod p) ` {.. = ord p a" using inj_power_mod[OF \coprime p a\] by (subst card_image) auto finally show ?thesis using \a \ totatives p\ by auto qed subsection \Another trivial primality characterization\ lemma prime_prime_factor: "prime n \ n \ 1 \ (\p. prime p \ p dvd n \ p = n)" (is "?lhs \ ?rhs") for n :: nat proof (cases "n = 0 \ n = 1") case True then show ?thesis by (metis bigger_prime dvd_0_right not_prime_1 not_prime_0) next case False show ?thesis proof assume "prime n" then show ?rhs by (metis not_prime_1 prime_nat_iff) next assume ?rhs with False show "prime n" by (auto simp: prime_nat_iff) (metis One_nat_def prime_factor_nat prime_nat_iff) qed qed lemma prime_divisor_sqrt: "prime n \ n \ 1 \ (\d. d dvd n \ d\<^sup>2 \ n \ d = 1)" for n :: nat proof - consider "n = 0" | "n = 1" | "n \ 0" "n \ 1" by blast then show ?thesis proof cases case 1 then show ?thesis by simp next case 2 then show ?thesis by simp next case n: 3 then have np: "n > 1" by arith { fix d assume d: "d dvd n" "d\<^sup>2 \ n" and H: "\m. m dvd n \ m = 1 \ m = n" from H d have d1n: "d = 1 \ d = n" by blast then have "d = 1" proof assume dn: "d = n" from n have "n\<^sup>2 > n * 1" by (simp add: power2_eq_square) with dn d(2) show ?thesis by simp qed } moreover { fix d assume d: "d dvd n" and H: "\d'. d' dvd n \ d'\<^sup>2 \ n \ d' = 1" from d n have "d \ 0" by (metis dvd_0_left_iff) then have dp: "d > 0" by simp from d[unfolded dvd_def] obtain e where e: "n= d*e" by blast from n dp e have ep:"e > 0" by simp from dp ep have "d\<^sup>2 \ n \ e\<^sup>2 \ n" by (auto simp add: e power2_eq_square mult_le_cancel_left) then have "d = 1 \ d = n" proof assume "d\<^sup>2 \ n" with H[rule_format, of d] d have "d = 1" by blast then show ?thesis .. next assume h: "e\<^sup>2 \ n" from e have "e dvd n" by (simp add: dvd_def mult.commute) with H[rule_format, of e] h have "e = 1" by simp with e have "d = n" by simp then show ?thesis .. qed } ultimately show ?thesis unfolding prime_nat_iff using np n(2) by blast qed qed lemma prime_prime_factor_sqrt: "prime (n::nat) \ n \ 0 \ n \ 1 \ (\p. prime p \ p dvd n \ p\<^sup>2 \ n)" (is "?lhs \?rhs") proof - consider "n = 0" | "n = 1" | "n \ 0" "n \ 1" by blast then show ?thesis proof cases case 1 then show ?thesis by (metis not_prime_0) next case 2 then show ?thesis by (metis not_prime_1) next case n: 3 show ?thesis proof assume ?lhs from this[unfolded prime_divisor_sqrt] n show ?rhs by (metis prime_prime_factor) next assume ?rhs { fix d assume d: "d dvd n" "d\<^sup>2 \ n" "d \ 1" then obtain p where p: "prime p" "p dvd d" by (metis prime_factor_nat) from d(1) n have dp: "d > 0" by (metis dvd_0_left neq0_conv) from mult_mono[OF dvd_imp_le[OF p(2) dp] dvd_imp_le[OF p(2) dp]] d(2) have "p\<^sup>2 \ n" unfolding power2_eq_square by arith with \?rhs\ n p(1) dvd_trans[OF p(2) d(1)] have False by blast } with n prime_divisor_sqrt show ?lhs by auto qed qed qed subsection \Pocklington theorem\ lemma pocklington_lemma: fixes p :: nat assumes n: "n \ 2" and nqr: "n - 1 = q * r" and an: "[a^ (n - 1) = 1] (mod n)" and aq: "\p. prime p \ p dvd q \ coprime (a ^ ((n - 1) div p) - 1) n" and pp: "prime p" and pn: "p dvd n" shows "[p = 1] (mod q)" proof - have p01: "p \ 0" "p \ 1" using pp by (auto intro: prime_gt_0_nat) obtain k where k: "a ^ (q * r) - 1 = n * k" by (metis an cong_to_1_nat dvd_def nqr) from pn[unfolded dvd_def] obtain l where l: "n = p * l" by blast have a0: "a \ 0" proof assume "a = 0" with n have "a^ (n - 1) = 0" by (simp add: power_0_left) with n an mod_less[of 1 n] show False by (simp add: power_0_left cong_def) qed with n nqr have aqr0: "a ^ (q * r) \ 0" by simp then have "(a ^ (q * r) - 1) + 1 = a ^ (q * r)" by simp with k l have "a ^ (q * r) = p * l * k + 1" by simp then have "a ^ (r * q) + p * 0 = 1 + p * (l * k)" by (simp add: ac_simps) then have odq: "ord p (a^r) dvd q" unfolding ord_divides[symmetric] power_mult[symmetric] by (metis an cong_dvd_modulus_nat mult.commute nqr pn) from odq[unfolded dvd_def] obtain d where d: "q = ord p (a^r) * d" by blast have d1: "d = 1" proof (rule ccontr) assume d1: "d \ 1" obtain P where P: "prime P" "P dvd d" by (metis d1 prime_factor_nat) from d dvd_mult[OF P(2), of "ord p (a^r)"] have Pq: "P dvd q" by simp from aq P(1) Pq have caP:"coprime (a^ ((n - 1) div P) - 1) n" by blast from Pq obtain s where s: "q = P*s" unfolding dvd_def by blast from P(1) have P0: "P \ 0" by (metis not_prime_0) from P(2) obtain t where t: "d = P*t" unfolding dvd_def by blast from d s t P0 have s': "ord p (a^r) * t = s" by (metis mult.commute mult_cancel1 mult.assoc) have "ord p (a^r) * t*r = r * ord p (a^r) * t" by (metis mult.assoc mult.commute) then have exps: "a^(ord p (a^r) * t*r) = ((a ^ r) ^ ord p (a^r)) ^ t" by (simp only: power_mult) then have "[((a ^ r) ^ ord p (a^r)) ^ t= 1] (mod p)" by (metis cong_pow ord power_one) then have pd0: "p dvd a^(ord p (a^r) * t*r) - 1" by (metis cong_to_1_nat exps) from nqr s s' have "(n - 1) div P = ord p (a^r) * t*r" using P0 by simp with caP have "coprime (a ^ (ord p (a ^ r) * t * r) - 1) n" by simp with p01 pn pd0 coprime_common_divisor [of _ n p] show False by auto qed with d have o: "ord p (a^r) = q" by simp from pp totient_prime [of p] have totient_eq: "totient p = p - 1" by simp { fix d assume d: "d dvd p" "d dvd a" "d \ 1" from pp[unfolded prime_nat_iff] d have dp: "d = p" by blast from n have "n \ 0" by simp then have False using d dp pn an by auto (metis One_nat_def Suc_lessI \1 < p \ (\m. m dvd p \ m = 1 \ m = p)\ \a ^ (q * r) = p * l * k + 1\ add_diff_cancel_left' dvd_diff_nat dvd_power dvd_triv_left gcd_nat.trans nat_dvd_not_less nqr zero_less_diff zero_less_one) } then have cpa: "coprime p a" by (auto intro: coprimeI) then have arp: "coprime (a ^ r) p" by (cases "r > 0") (simp_all add: ac_simps) from euler_theorem [OF arp, simplified ord_divides] o totient_eq have "q dvd (p - 1)" by simp then obtain d where d:"p - 1 = q * d" unfolding dvd_def by blast have "p \ 0" by (metis p01(1)) with d have "p + q * 0 = 1 + q * d" by simp then show ?thesis by (metis cong_iff_lin_nat mult.commute) qed theorem pocklington: assumes n: "n \ 2" and nqr: "n - 1 = q * r" and sqr: "n \ q\<^sup>2" and an: "[a^ (n - 1) = 1] (mod n)" and aq: "\p. prime p \ p dvd q \ coprime (a^ ((n - 1) div p) - 1) n" shows "prime n" unfolding prime_prime_factor_sqrt[of n] proof - let ?ths = "n \ 0 \ n \ 1 \ (\p. prime p \ p dvd n \ p\<^sup>2 \ n)" from n have n01: "n \ 0" "n \ 1" by arith+ { fix p assume p: "prime p" "p dvd n" "p\<^sup>2 \ n" from p(3) sqr have "p^(Suc 1) \ q^(Suc 1)" by (simp add: power2_eq_square) then have pq: "p \ q" by (metis le0 power_le_imp_le_base) from pocklington_lemma[OF n nqr an aq p(1,2)] have *: "q dvd p - 1" by (metis cong_to_1_nat) have "p - 1 \ 0" using prime_ge_2_nat [OF p(1)] by arith with pq * have False by (simp add: nat_dvd_not_less) } with n01 show ?ths by blast qed text \Variant for application, to separate the exponentiation.\ lemma pocklington_alt: assumes n: "n \ 2" and nqr: "n - 1 = q * r" and sqr: "n \ q\<^sup>2" and an: "[a^ (n - 1) = 1] (mod n)" and aq: "\p. prime p \ p dvd q \ (\b. [a^((n - 1) div p) = b] (mod n) \ coprime (b - 1) n)" shows "prime n" proof - { fix p assume p: "prime p" "p dvd q" from aq[rule_format] p obtain b where b: "[a^((n - 1) div p) = b] (mod n)" "coprime (b - 1) n" by blast have a0: "a \ 0" proof assume a0: "a = 0" from n an have "[0 = 1] (mod n)" unfolding a0 power_0_left by auto then show False using n by (simp add: cong_def dvd_eq_mod_eq_0[symmetric]) qed then have a1: "a \ 1" by arith from one_le_power[OF a1] have ath: "1 \ a ^ ((n - 1) div p)" . have b0: "b \ 0" proof assume b0: "b = 0" from p(2) nqr have "(n - 1) mod p = 0" by (metis mod_0 mod_mod_cancel mod_mult_self1_is_0) with div_mult_mod_eq[of "n - 1" p] have "(n - 1) div p * p= n - 1" by auto then have eq: "(a^((n - 1) div p))^p = a^(n - 1)" by (simp only: power_mult[symmetric]) have "p - 1 \ 0" using prime_ge_2_nat [OF p(1)] by arith then have pS: "Suc (p - 1) = p" by arith from b have d: "n dvd a^((n - 1) div p)" unfolding b0 by auto from divides_rexp[OF d, of "p - 1"] pS eq cong_dvd_iff [OF an] n show False by simp qed then have b1: "b \ 1" by arith from cong_imp_coprime[OF Cong.cong_diff_nat[OF cong_sym [OF b(1)] cong_refl [of 1] b1]] ath b1 b nqr have "coprime (a ^ ((n - 1) div p) - 1) n" by simp } then have "\p. prime p \ p dvd q \ coprime (a ^ ((n - 1) div p) - 1) n " by blast then show ?thesis by (rule pocklington[OF n nqr sqr an]) qed subsection \Prime factorizations\ (* FIXME some overlap with material in UniqueFactorization, class unique_factorization *) definition "primefact ps n \ foldr (*) ps 1 = n \ (\p\ set ps. prime p)" lemma primefact: fixes n :: nat assumes n: "n \ 0" shows "\ps. primefact ps n" proof - obtain xs where xs: "mset xs = prime_factorization n" using ex_mset [of "prime_factorization n"] by blast from assms have "n = prod_mset (prime_factorization n)" by (simp add: prod_mset_prime_factorization) also have "\ = prod_mset (mset xs)" by (simp add: xs) also have "\ = foldr (*) xs 1" by (induct xs) simp_all finally have "foldr (*) xs 1 = n" .. moreover from xs have "\p\#mset xs. prime p" by auto ultimately have "primefact xs n" by (auto simp: primefact_def) then show ?thesis .. qed lemma primefact_contains: fixes p :: nat assumes pf: "primefact ps n" and p: "prime p" and pn: "p dvd n" shows "p \ set ps" using pf p pn proof (induct ps arbitrary: p n) case Nil then show ?case by (auto simp: primefact_def) next case (Cons q qs) from Cons.prems[unfolded primefact_def] have q: "prime q" "q * foldr (*) qs 1 = n" "\p \set qs. prime p" and p: "prime p" "p dvd q * foldr (*) qs 1" by simp_all consider "p dvd q" | "p dvd foldr (*) qs 1" by (metis p prime_dvd_mult_eq_nat) then show ?case proof cases case 1 with p(1) q(1) have "p = q" unfolding prime_nat_iff by auto then show ?thesis by simp next case prem: 2 from q(3) have pqs: "primefact qs (foldr (*) qs 1)" by (simp add: primefact_def) from Cons.hyps[OF pqs p(1) prem] show ?thesis by simp qed qed lemma primefact_variant: "primefact ps n \ foldr (*) ps 1 = n \ list_all prime ps" by (auto simp add: primefact_def list_all_iff) text \Variant of Lucas theorem.\ lemma lucas_primefact: assumes n: "n \ 2" and an: "[a^(n - 1) = 1] (mod n)" and psn: "foldr (*) ps 1 = n - 1" and psp: "list_all (\p. prime p \ \ [a^((n - 1) div p) = 1] (mod n)) ps" shows "prime n" proof - { fix p assume p: "prime p" "p dvd n - 1" "[a ^ ((n - 1) div p) = 1] (mod n)" from psn psp have psn1: "primefact ps (n - 1)" by (auto simp add: list_all_iff primefact_variant) from p(3) primefact_contains[OF psn1 p(1,2)] psp have False by (induct ps) auto } with lucas[OF n an] show ?thesis by blast qed text \Variant of Pocklington theorem.\ lemma pocklington_primefact: assumes n: "n \ 2" and qrn: "q*r = n - 1" and nq2: "n \ q\<^sup>2" and arnb: "(a^r) mod n = b" and psq: "foldr (*) ps 1 = q" and bqn: "(b^q) mod n = 1" and psp: "list_all (\p. prime p \ coprime ((b^(q div p)) mod n - 1) n) ps" shows "prime n" proof - from bqn psp qrn have bqn: "a ^ (n - 1) mod n = 1" and psp: "list_all (\p. prime p \ coprime (a^(r *(q div p)) mod n - 1) n) ps" unfolding arnb[symmetric] power_mod by (simp_all add: power_mult[symmetric] algebra_simps) from n have n0: "n > 0" by arith from div_mult_mod_eq[of "a^(n - 1)" n] mod_less_divisor[OF n0, of "a^(n - 1)"] have an1: "[a ^ (n - 1) = 1] (mod n)" by (metis bqn cong_def mod_mod_trivial) have "coprime (a ^ ((n - 1) div p) - 1) n" if p: "prime p" "p dvd q" for p proof - from psp psq have pfpsq: "primefact ps q" by (auto simp add: primefact_variant list_all_iff) from psp primefact_contains[OF pfpsq p] have p': "coprime (a ^ (r * (q div p)) mod n - 1) n" by (simp add: list_all_iff) from p prime_nat_iff have p01: "p \ 0" "p \ 1" "p = Suc (p - 1)" by auto from div_mult1_eq[of r q p] p(2) have eq1: "r* (q div p) = (n - 1) div p" unfolding qrn[symmetric] dvd_eq_mod_eq_0 by (simp add: mult.commute) have ath: "a \ b \ a \ 0 \ 1 \ a \ 1 \ b" for a b :: nat by arith { assume "a ^ ((n - 1) div p) mod n = 0" then obtain s where s: "a ^ ((n - 1) div p) = n * s" by blast then have eq0: "(a^((n - 1) div p))^p = (n*s)^p" by simp from qrn[symmetric] have qn1: "q dvd n - 1" by (auto simp: dvd_def) from dvd_trans[OF p(2) qn1] have npp: "(n - 1) div p * p = n - 1" by simp with eq0 have "a ^ (n - 1) = (n * s) ^ p" by (simp add: power_mult[symmetric]) with bqn p01 have "1 = (n * s)^(Suc (p - 1)) mod n" by simp also have "\ = 0" by (simp add: mult.assoc) finally have False by simp } then have *: "a ^ ((n - 1) div p) mod n \ 0" by auto have "[a ^ ((n - 1) div p) mod n = a ^ ((n - 1) div p)] (mod n)" by (simp add: cong_def) with ath[OF mod_less_eq_dividend *] have "[a ^ ((n - 1) div p) mod n - 1 = a ^ ((n - 1) div p) - 1] (mod n)" by (simp add: cong_diff_nat) then show ?thesis by (metis cong_imp_coprime eq1 p') qed with pocklington[OF n qrn[symmetric] nq2 an1] show ?thesis by blast qed end diff --git a/src/HOL/Parity.thy b/src/HOL/Parity.thy --- a/src/HOL/Parity.thy +++ b/src/HOL/Parity.thy @@ -1,1379 +1,1389 @@ (* Title: HOL/Parity.thy Author: Jeremy Avigad Author: Jacques D. Fleuriot *) section \Parity in rings and semirings\ theory Parity imports Euclidean_Rings begin subsection \Ring structures with parity and \even\/\odd\ predicates\ class semiring_parity = comm_semiring_1 + semiring_modulo + assumes even_iff_mod_2_eq_zero: "2 dvd a \ a mod 2 = 0" and odd_iff_mod_2_eq_one: "\ 2 dvd a \ a mod 2 = 1" and odd_one [simp]: "\ 2 dvd 1" begin abbreviation even :: "'a \ bool" where "even a \ 2 dvd a" abbreviation odd :: "'a \ bool" where "odd a \ \ 2 dvd a" end class ring_parity = ring + semiring_parity begin subclass comm_ring_1 .. end instance nat :: semiring_parity by standard (simp_all add: dvd_eq_mod_eq_0) instance int :: ring_parity by standard (auto simp add: dvd_eq_mod_eq_0) context semiring_parity begin lemma parity_cases [case_names even odd]: assumes "even a \ a mod 2 = 0 \ P" assumes "odd a \ a mod 2 = 1 \ P" shows P using assms by (cases "even a") (simp_all add: even_iff_mod_2_eq_zero [symmetric] odd_iff_mod_2_eq_one [symmetric]) lemma odd_of_bool_self [simp]: \odd (of_bool p) \ p\ by (cases p) simp_all lemma not_mod_2_eq_0_eq_1 [simp]: "a mod 2 \ 0 \ a mod 2 = 1" by (cases a rule: parity_cases) simp_all lemma not_mod_2_eq_1_eq_0 [simp]: "a mod 2 \ 1 \ a mod 2 = 0" by (cases a rule: parity_cases) simp_all lemma evenE [elim?]: assumes "even a" obtains b where "a = 2 * b" using assms by (rule dvdE) lemma oddE [elim?]: assumes "odd a" obtains b where "a = 2 * b + 1" proof - have "a = 2 * (a div 2) + a mod 2" by (simp add: mult_div_mod_eq) with assms have "a = 2 * (a div 2) + 1" by (simp add: odd_iff_mod_2_eq_one) then show ?thesis .. qed lemma mod_2_eq_odd: "a mod 2 = of_bool (odd a)" by (auto elim: oddE simp add: even_iff_mod_2_eq_zero) lemma of_bool_odd_eq_mod_2: "of_bool (odd a) = a mod 2" by (simp add: mod_2_eq_odd) lemma even_mod_2_iff [simp]: \even (a mod 2) \ even a\ by (simp add: mod_2_eq_odd) lemma mod2_eq_if: "a mod 2 = (if even a then 0 else 1)" by (simp add: mod_2_eq_odd) lemma even_zero [simp]: "even 0" by (fact dvd_0_right) lemma odd_even_add: "even (a + b)" if "odd a" and "odd b" proof - from that obtain c d where "a = 2 * c + 1" and "b = 2 * d + 1" by (blast elim: oddE) then have "a + b = 2 * c + 2 * d + (1 + 1)" by (simp only: ac_simps) also have "\ = 2 * (c + d + 1)" by (simp add: algebra_simps) finally show ?thesis .. qed lemma even_add [simp]: "even (a + b) \ (even a \ even b)" by (auto simp add: dvd_add_right_iff dvd_add_left_iff odd_even_add) lemma odd_add [simp]: "odd (a + b) \ \ (odd a \ odd b)" by simp lemma even_plus_one_iff [simp]: "even (a + 1) \ odd a" by (auto simp add: dvd_add_right_iff intro: odd_even_add) lemma even_mult_iff [simp]: "even (a * b) \ even a \ even b" (is "?P \ ?Q") proof assume ?Q then show ?P by auto next assume ?P show ?Q proof (rule ccontr) assume "\ (even a \ even b)" then have "odd a" and "odd b" by auto then obtain r s where "a = 2 * r + 1" and "b = 2 * s + 1" by (blast elim: oddE) then have "a * b = (2 * r + 1) * (2 * s + 1)" by simp also have "\ = 2 * (2 * r * s + r + s) + 1" by (simp add: algebra_simps) finally have "odd (a * b)" by simp with \?P\ show False by auto qed qed lemma even_numeral [simp]: "even (numeral (Num.Bit0 n))" proof - have "even (2 * numeral n)" unfolding even_mult_iff by simp then have "even (numeral n + numeral n)" unfolding mult_2 . then show ?thesis unfolding numeral.simps . qed lemma odd_numeral [simp]: "odd (numeral (Num.Bit1 n))" proof assume "even (numeral (num.Bit1 n))" then have "even (numeral n + numeral n + 1)" unfolding numeral.simps . then have "even (2 * numeral n + 1)" unfolding mult_2 . then have "2 dvd numeral n * 2 + 1" by (simp add: ac_simps) then have "2 dvd 1" using dvd_add_times_triv_left_iff [of 2 "numeral n" 1] by simp then show False by simp qed lemma odd_numeral_BitM [simp]: \odd (numeral (Num.BitM w))\ by (cases w) simp_all lemma even_power [simp]: "even (a ^ n) \ even a \ n > 0" by (induct n) auto lemma even_prod_iff: \even (prod f A) \ (\a\A. even (f a))\ if \finite A\ using that by (induction A) simp_all lemma mask_eq_sum_exp: \2 ^ n - 1 = (\m\{q. q < n}. 2 ^ m)\ proof - have *: \{q. q < Suc m} = insert m {q. q < m}\ for m by auto have \2 ^ n = (\m\{q. q < n}. 2 ^ m) + 1\ by (induction n) (simp_all add: ac_simps mult_2 *) then have \2 ^ n - 1 = (\m\{q. q < n}. 2 ^ m) + 1 - 1\ by simp then show ?thesis by simp qed lemma (in -) mask_eq_sum_exp_nat: \2 ^ n - Suc 0 = (\m\{q. q < n}. 2 ^ m)\ using mask_eq_sum_exp [where ?'a = nat] by simp end context ring_parity begin lemma even_minus: "even (- a) \ even a" by (fact dvd_minus_iff) lemma even_diff [simp]: "even (a - b) \ even (a + b)" using even_add [of a "- b"] by simp end subsection \Instance for \<^typ>\nat\\ lemma even_Suc_Suc_iff [simp]: "even (Suc (Suc n)) \ even n" using dvd_add_triv_right_iff [of 2 n] by simp lemma even_Suc [simp]: "even (Suc n) \ odd n" using even_plus_one_iff [of n] by simp lemma even_diff_nat [simp]: "even (m - n) \ m < n \ even (m + n)" for m n :: nat proof (cases "n \ m") case True then have "m - n + n * 2 = m + n" by (simp add: mult_2_right) moreover have "even (m - n) \ even (m - n + n * 2)" by simp ultimately have "even (m - n) \ even (m + n)" by (simp only:) then show ?thesis by auto next case False then show ?thesis by simp qed lemma odd_pos: "odd n \ 0 < n" for n :: nat by (auto elim: oddE) lemma Suc_double_not_eq_double: "Suc (2 * m) \ 2 * n" proof assume "Suc (2 * m) = 2 * n" moreover have "odd (Suc (2 * m))" and "even (2 * n)" by simp_all ultimately show False by simp qed lemma double_not_eq_Suc_double: "2 * m \ Suc (2 * n)" using Suc_double_not_eq_double [of n m] by simp lemma odd_Suc_minus_one [simp]: "odd n \ Suc (n - Suc 0) = n" by (auto elim: oddE) lemma even_Suc_div_two [simp]: "even n \ Suc n div 2 = n div 2" by auto lemma odd_Suc_div_two [simp]: "odd n \ Suc n div 2 = Suc (n div 2)" by (auto elim: oddE) lemma odd_two_times_div_two_nat [simp]: assumes "odd n" shows "2 * (n div 2) = n - (1 :: nat)" proof - from assms have "2 * (n div 2) + 1 = n" by (auto elim: oddE) then have "Suc (2 * (n div 2)) - 1 = n - 1" by simp then show ?thesis by simp qed lemma not_mod2_eq_Suc_0_eq_0 [simp]: "n mod 2 \ Suc 0 \ n mod 2 = 0" using not_mod_2_eq_1_eq_0 [of n] by simp lemma odd_card_imp_not_empty: \A \ {}\ if \odd (card A)\ using that by auto lemma nat_induct2 [case_names 0 1 step]: assumes "P 0" "P 1" and step: "\n::nat. P n \ P (n + 2)" shows "P n" proof (induct n rule: less_induct) case (less n) show ?case proof (cases "n < Suc (Suc 0)") case True then show ?thesis using assms by (auto simp: less_Suc_eq) next case False then obtain k where k: "n = Suc (Suc k)" by (force simp: not_less nat_le_iff_add) then have "kn mod (2 * m) = n mod m \ n mod (2 * m) = n mod m + m\ + for m n :: nat + by (cases \even (n div m)\) + (simp_all add: mod_mult2_eq ac_simps even_iff_mod_2_eq_zero) + context semiring_parity begin lemma even_sum_iff: \even (sum f A) \ even (card {a\A. odd (f a)})\ if \finite A\ using that proof (induction A) case empty then show ?case by simp next case (insert a A) moreover have \{b \ insert a A. odd (f b)} = (if odd (f a) then {a} else {}) \ {b \ A. odd (f b)}\ by auto ultimately show ?case by simp qed lemma even_mask_iff [simp]: \even (2 ^ n - 1) \ n = 0\ proof (cases \n = 0\) case True then show ?thesis by simp next case False then have \{a. a = 0 \ a < n} = {0}\ by auto then show ?thesis by (auto simp add: mask_eq_sum_exp even_sum_iff) qed lemma even_of_nat_iff [simp]: "even (of_nat n) \ even n" by (induction n) simp_all end subsection \Parity and powers\ context ring_1 begin lemma power_minus_even [simp]: "even n \ (- a) ^ n = a ^ n" by (auto elim: evenE) lemma power_minus_odd [simp]: "odd n \ (- a) ^ n = - (a ^ n)" by (auto elim: oddE) lemma uminus_power_if: "(- a) ^ n = (if even n then a ^ n else - (a ^ n))" by auto lemma neg_one_even_power [simp]: "even n \ (- 1) ^ n = 1" by simp lemma neg_one_odd_power [simp]: "odd n \ (- 1) ^ n = - 1" by simp lemma neg_one_power_add_eq_neg_one_power_diff: "k \ n \ (- 1) ^ (n + k) = (- 1) ^ (n - k)" by (cases "even (n + k)") auto lemma minus_one_power_iff: "(- 1) ^ n = (if even n then 1 else - 1)" by (induct n) auto end context linordered_idom begin lemma zero_le_even_power: "even n \ 0 \ a ^ n" by (auto elim: evenE) lemma zero_le_odd_power: "odd n \ 0 \ a ^ n \ 0 \ a" by (auto simp add: power_even_eq zero_le_mult_iff elim: oddE) lemma zero_le_power_eq: "0 \ a ^ n \ even n \ odd n \ 0 \ a" by (auto simp add: zero_le_even_power zero_le_odd_power) lemma zero_less_power_eq: "0 < a ^ n \ n = 0 \ even n \ a \ 0 \ odd n \ 0 < a" proof - have [simp]: "0 = a ^ n \ a = 0 \ n > 0" unfolding power_eq_0_iff [of a n, symmetric] by blast show ?thesis unfolding less_le zero_le_power_eq by auto qed lemma power_less_zero_eq [simp]: "a ^ n < 0 \ odd n \ a < 0" unfolding not_le [symmetric] zero_le_power_eq by auto lemma power_le_zero_eq: "a ^ n \ 0 \ n > 0 \ (odd n \ a \ 0 \ even n \ a = 0)" unfolding not_less [symmetric] zero_less_power_eq by auto lemma power_even_abs: "even n \ \a\ ^ n = a ^ n" using power_abs [of a n] by (simp add: zero_le_even_power) lemma power_mono_even: assumes "even n" and "\a\ \ \b\" shows "a ^ n \ b ^ n" proof - have "0 \ \a\" by auto with \\a\ \ \b\\ have "\a\ ^ n \ \b\ ^ n" by (rule power_mono) with \even n\ show ?thesis by (simp add: power_even_abs) qed lemma power_mono_odd: assumes "odd n" and "a \ b" shows "a ^ n \ b ^ n" proof (cases "b < 0") case True with \a \ b\ have "- b \ - a" and "0 \ - b" by auto then have "(- b) ^ n \ (- a) ^ n" by (rule power_mono) with \odd n\ show ?thesis by simp next case False then have "0 \ b" by auto show ?thesis proof (cases "a < 0") case True then have "n \ 0" and "a \ 0" using \odd n\ [THEN odd_pos] by auto then have "a ^ n \ 0" unfolding power_le_zero_eq using \odd n\ by auto moreover from \0 \ b\ have "0 \ b ^ n" by auto ultimately show ?thesis by auto next case False then have "0 \ a" by auto with \a \ b\ show ?thesis using power_mono by auto qed qed text \Simplify, when the exponent is a numeral\ lemma zero_le_power_eq_numeral [simp]: "0 \ a ^ numeral w \ even (numeral w :: nat) \ odd (numeral w :: nat) \ 0 \ a" by (fact zero_le_power_eq) lemma zero_less_power_eq_numeral [simp]: "0 < a ^ numeral w \ numeral w = (0 :: nat) \ even (numeral w :: nat) \ a \ 0 \ odd (numeral w :: nat) \ 0 < a" by (fact zero_less_power_eq) lemma power_le_zero_eq_numeral [simp]: "a ^ numeral w \ 0 \ (0 :: nat) < numeral w \ (odd (numeral w :: nat) \ a \ 0 \ even (numeral w :: nat) \ a = 0)" by (fact power_le_zero_eq) lemma power_less_zero_eq_numeral [simp]: "a ^ numeral w < 0 \ odd (numeral w :: nat) \ a < 0" by (fact power_less_zero_eq) lemma power_even_abs_numeral [simp]: "even (numeral w :: nat) \ \a\ ^ numeral w = a ^ numeral w" by (fact power_even_abs) end subsection \Instance for \<^typ>\int\\ lemma even_diff_iff: "even (k - l) \ even (k + l)" for k l :: int by (fact even_diff) lemma even_abs_add_iff: "even (\k\ + l) \ even (k + l)" for k l :: int by simp lemma even_add_abs_iff: "even (k + \l\) \ even (k + l)" for k l :: int by simp lemma even_nat_iff: "0 \ k \ even (nat k) \ even k" by (simp add: even_of_nat_iff [of "nat k", where ?'a = int, symmetric]) context assumes "SORT_CONSTRAINT('a::division_ring)" begin lemma power_int_minus_left: "power_int (-a :: 'a) n = (if even n then power_int a n else -power_int a n)" by (auto simp: power_int_def minus_one_power_iff even_nat_iff) lemma power_int_minus_left_even [simp]: "even n \ power_int (-a :: 'a) n = power_int a n" by (simp add: power_int_minus_left) lemma power_int_minus_left_odd [simp]: "odd n \ power_int (-a :: 'a) n = -power_int a n" by (simp add: power_int_minus_left) lemma power_int_minus_left_distrib: "NO_MATCH (-1) x \ power_int (-a :: 'a) n = power_int (-1) n * power_int a n" by (simp add: power_int_minus_left) lemma power_int_minus_one_minus: "power_int (-1 :: 'a) (-n) = power_int (-1) n" by (simp add: power_int_minus_left) lemma power_int_minus_one_diff_commute: "power_int (-1 :: 'a) (a - b) = power_int (-1) (b - a)" by (subst power_int_minus_one_minus [symmetric]) auto lemma power_int_minus_one_mult_self [simp]: "power_int (-1 :: 'a) m * power_int (-1) m = 1" by (simp add: power_int_minus_left) lemma power_int_minus_one_mult_self' [simp]: "power_int (-1 :: 'a) m * (power_int (-1) m * b) = b" by (simp add: power_int_minus_left) end subsection \Special case: euclidean rings containing the natural numbers\ class unique_euclidean_semiring_with_nat = semidom + semiring_char_0 + unique_euclidean_semiring + assumes of_nat_div: "of_nat (m div n) = of_nat m div of_nat n" and division_segment_of_nat [simp]: "division_segment (of_nat n) = 1" and division_segment_euclidean_size [simp]: "division_segment a * of_nat (euclidean_size a) = a" begin lemma division_segment_eq_iff: "a = b" if "division_segment a = division_segment b" and "euclidean_size a = euclidean_size b" using that division_segment_euclidean_size [of a] by simp lemma euclidean_size_of_nat [simp]: "euclidean_size (of_nat n) = n" proof - have "division_segment (of_nat n) * of_nat (euclidean_size (of_nat n)) = of_nat n" by (fact division_segment_euclidean_size) then show ?thesis by simp qed lemma of_nat_euclidean_size: "of_nat (euclidean_size a) = a div division_segment a" proof - have "of_nat (euclidean_size a) = division_segment a * of_nat (euclidean_size a) div division_segment a" by (subst nonzero_mult_div_cancel_left) simp_all also have "\ = a div division_segment a" by simp finally show ?thesis . qed lemma division_segment_1 [simp]: "division_segment 1 = 1" using division_segment_of_nat [of 1] by simp lemma division_segment_numeral [simp]: "division_segment (numeral k) = 1" using division_segment_of_nat [of "numeral k"] by simp lemma euclidean_size_1 [simp]: "euclidean_size 1 = 1" using euclidean_size_of_nat [of 1] by simp lemma euclidean_size_numeral [simp]: "euclidean_size (numeral k) = numeral k" using euclidean_size_of_nat [of "numeral k"] by simp lemma of_nat_dvd_iff: "of_nat m dvd of_nat n \ m dvd n" (is "?P \ ?Q") proof (cases "m = 0") case True then show ?thesis by simp next case False show ?thesis proof assume ?Q then show ?P by auto next assume ?P with False have "of_nat n = of_nat n div of_nat m * of_nat m" by simp then have "of_nat n = of_nat (n div m * m)" by (simp add: of_nat_div) then have "n = n div m * m" by (simp only: of_nat_eq_iff) then have "n = m * (n div m)" by (simp add: ac_simps) then show ?Q .. qed qed lemma of_nat_mod: "of_nat (m mod n) = of_nat m mod of_nat n" proof - have "of_nat m div of_nat n * of_nat n + of_nat m mod of_nat n = of_nat m" by (simp add: div_mult_mod_eq) also have "of_nat m = of_nat (m div n * n + m mod n)" by simp finally show ?thesis by (simp only: of_nat_div of_nat_mult of_nat_add) simp qed lemma one_div_two_eq_zero [simp]: "1 div 2 = 0" proof - from of_nat_div [symmetric] have "of_nat 1 div of_nat 2 = of_nat 0" by (simp only:) simp then show ?thesis by simp qed lemma one_mod_two_eq_one [simp]: "1 mod 2 = 1" proof - from of_nat_mod [symmetric] have "of_nat 1 mod of_nat 2 = of_nat 1" by (simp only:) simp then show ?thesis by simp qed lemma one_mod_2_pow_eq [simp]: "1 mod (2 ^ n) = of_bool (n > 0)" proof - have "1 mod (2 ^ n) = of_nat (1 mod (2 ^ n))" using of_nat_mod [of 1 "2 ^ n"] by simp also have "\ = of_bool (n > 0)" by simp finally show ?thesis . qed lemma one_div_2_pow_eq [simp]: "1 div (2 ^ n) = of_bool (n = 0)" using div_mult_mod_eq [of 1 "2 ^ n"] by auto lemma div_mult2_eq': \a div (of_nat m * of_nat n) = a div of_nat m div of_nat n\ proof (cases \m = 0 \ n = 0\) case True then show ?thesis by auto next case False then have \m > 0\ \n > 0\ by simp_all show ?thesis proof (cases \of_nat m * of_nat n dvd a\) case True then obtain b where \a = (of_nat m * of_nat n) * b\ .. then have \a = of_nat m * (of_nat n * b)\ by (simp add: ac_simps) then show ?thesis by simp next case False define q where \q = a div (of_nat m * of_nat n)\ define r where \r = a mod (of_nat m * of_nat n)\ from \m > 0\ \n > 0\ \\ of_nat m * of_nat n dvd a\ r_def have "division_segment r = 1" using division_segment_of_nat [of "m * n"] by (simp add: division_segment_mod) with division_segment_euclidean_size [of r] have "of_nat (euclidean_size r) = r" by simp have "a mod (of_nat m * of_nat n) div (of_nat m * of_nat n) = 0" by simp with \m > 0\ \n > 0\ r_def have "r div (of_nat m * of_nat n) = 0" by simp with \of_nat (euclidean_size r) = r\ have "of_nat (euclidean_size r) div (of_nat m * of_nat n) = 0" by simp then have "of_nat (euclidean_size r div (m * n)) = 0" by (simp add: of_nat_div) then have "of_nat (euclidean_size r div m div n) = 0" by (simp add: div_mult2_eq) with \of_nat (euclidean_size r) = r\ have "r div of_nat m div of_nat n = 0" by (simp add: of_nat_div) with \m > 0\ \n > 0\ q_def have "q = (r div of_nat m + q * of_nat n * of_nat m div of_nat m) div of_nat n" by simp moreover have \a = q * (of_nat m * of_nat n) + r\ by (simp add: q_def r_def div_mult_mod_eq) ultimately show \a div (of_nat m * of_nat n) = a div of_nat m div of_nat n\ using q_def [symmetric] div_plus_div_distrib_dvd_right [of \of_nat m\ \q * (of_nat m * of_nat n)\ r] by (simp add: ac_simps) qed qed lemma mod_mult2_eq': "a mod (of_nat m * of_nat n) = of_nat m * (a div of_nat m mod of_nat n) + a mod of_nat m" proof - have "a div (of_nat m * of_nat n) * (of_nat m * of_nat n) + a mod (of_nat m * of_nat n) = a div of_nat m div of_nat n * of_nat n * of_nat m + (a div of_nat m mod of_nat n * of_nat m + a mod of_nat m)" by (simp add: combine_common_factor div_mult_mod_eq) moreover have "a div of_nat m div of_nat n * of_nat n * of_nat m = of_nat n * of_nat m * (a div of_nat m div of_nat n)" by (simp add: ac_simps) ultimately show ?thesis by (simp add: div_mult2_eq' mult_commute) qed lemma div_mult2_numeral_eq: "a div numeral k div numeral l = a div numeral (k * l)" (is "?A = ?B") proof - have "?A = a div of_nat (numeral k) div of_nat (numeral l)" by simp also have "\ = a div (of_nat (numeral k) * of_nat (numeral l))" by (fact div_mult2_eq' [symmetric]) also have "\ = ?B" by simp finally show ?thesis . qed lemma numeral_Bit0_div_2: "numeral (num.Bit0 n) div 2 = numeral n" proof - have "numeral (num.Bit0 n) = numeral n + numeral n" by (simp only: numeral.simps) also have "\ = numeral n * 2" by (simp add: mult_2_right) finally have "numeral (num.Bit0 n) div 2 = numeral n * 2 div 2" by simp also have "\ = numeral n" by (rule nonzero_mult_div_cancel_right) simp finally show ?thesis . qed lemma numeral_Bit1_div_2: "numeral (num.Bit1 n) div 2 = numeral n" proof - have "numeral (num.Bit1 n) = numeral n + numeral n + 1" by (simp only: numeral.simps) also have "\ = numeral n * 2 + 1" by (simp add: mult_2_right) finally have "numeral (num.Bit1 n) div 2 = (numeral n * 2 + 1) div 2" by simp also have "\ = numeral n * 2 div 2 + 1 div 2" using dvd_triv_right by (rule div_plus_div_distrib_dvd_left) also have "\ = numeral n * 2 div 2" by simp also have "\ = numeral n" by (rule nonzero_mult_div_cancel_right) simp finally show ?thesis . qed lemma exp_mod_exp: \2 ^ m mod 2 ^ n = of_bool (m < n) * 2 ^ m\ proof - have \(2::nat) ^ m mod 2 ^ n = of_bool (m < n) * 2 ^ m\ (is \?lhs = ?rhs\) by (auto simp add: not_less monoid_mult_class.power_add dest!: le_Suc_ex) then have \of_nat ?lhs = of_nat ?rhs\ by simp then show ?thesis by (simp add: of_nat_mod) qed lemma mask_mod_exp: \(2 ^ n - 1) mod 2 ^ m = 2 ^ min m n - 1\ proof - have \(2 ^ n - 1) mod 2 ^ m = 2 ^ min m n - (1::nat)\ (is \?lhs = ?rhs\) proof (cases \n \ m\) case True then show ?thesis by (simp add: Suc_le_lessD) next case False then have \m < n\ by simp then obtain q where n: \n = Suc q + m\ by (auto dest: less_imp_Suc_add) then have \min m n = m\ by simp moreover have \(2::nat) ^ m \ 2 * 2 ^ q * 2 ^ m\ using mult_le_mono1 [of 1 \2 * 2 ^ q\ \2 ^ m\] by simp with n have \2 ^ n - 1 = (2 ^ Suc q - 1) * 2 ^ m + (2 ^ m - (1::nat))\ by (simp add: monoid_mult_class.power_add algebra_simps) ultimately show ?thesis by (simp only: euclidean_semiring_cancel_class.mod_mult_self3) simp qed then have \of_nat ?lhs = of_nat ?rhs\ by simp then show ?thesis by (simp add: of_nat_mod of_nat_diff) qed lemma of_bool_half_eq_0 [simp]: \of_bool b div 2 = 0\ by simp +lemma of_nat_mod_double: + \of_nat n mod (2 * of_nat m) = of_nat n mod of_nat m \ of_nat n mod (2 * of_nat m) = of_nat n mod of_nat m + of_nat m\ + by (simp add: mod_double_nat flip: of_nat_mod of_nat_add of_nat_mult of_nat_numeral) + end class unique_euclidean_ring_with_nat = ring + unique_euclidean_semiring_with_nat instance nat :: unique_euclidean_semiring_with_nat by standard (simp_all add: dvd_eq_mod_eq_0) instance int :: unique_euclidean_ring_with_nat by standard (auto simp add: divide_int_def division_segment_int_def elim: contrapos_np) context unique_euclidean_semiring_with_nat begin subclass semiring_parity proof show "2 dvd a \ a mod 2 = 0" for a by (fact dvd_eq_mod_eq_0) show "\ 2 dvd a \ a mod 2 = 1" for a proof assume "a mod 2 = 1" then show "\ 2 dvd a" by auto next assume "\ 2 dvd a" have eucl: "euclidean_size (a mod 2) = 1" proof (rule order_antisym) show "euclidean_size (a mod 2) \ 1" using mod_size_less [of 2 a] by simp show "1 \ euclidean_size (a mod 2)" using \\ 2 dvd a\ by (simp add: Suc_le_eq dvd_eq_mod_eq_0) qed from \\ 2 dvd a\ have "\ of_nat 2 dvd division_segment a * of_nat (euclidean_size a)" by simp then have "\ of_nat 2 dvd of_nat (euclidean_size a)" by (auto simp only: dvd_mult_unit_iff' is_unit_division_segment) then have "\ 2 dvd euclidean_size a" using of_nat_dvd_iff [of 2] by simp then have "euclidean_size a mod 2 = 1" by (simp add: semidom_modulo_class.dvd_eq_mod_eq_0) then have "of_nat (euclidean_size a mod 2) = of_nat 1" by simp then have "of_nat (euclidean_size a) mod 2 = 1" by (simp add: of_nat_mod) from \\ 2 dvd a\ eucl show "a mod 2 = 1" by (auto intro: division_segment_eq_iff simp add: division_segment_mod) qed show "\ is_unit 2" proof (rule notI) assume "is_unit 2" then have "of_nat 2 dvd of_nat 1" by simp then have "is_unit (2::nat)" by (simp only: of_nat_dvd_iff) then show False by simp qed qed lemma even_succ_div_two [simp]: "even a \ (a + 1) div 2 = a div 2" by (cases "a = 0") (auto elim!: evenE dest: mult_not_zero) lemma odd_succ_div_two [simp]: "odd a \ (a + 1) div 2 = a div 2 + 1" by (auto elim!: oddE simp add: add.assoc) lemma even_two_times_div_two: "even a \ 2 * (a div 2) = a" by (fact dvd_mult_div_cancel) lemma odd_two_times_div_two_succ [simp]: "odd a \ 2 * (a div 2) + 1 = a" using mult_div_mod_eq [of 2 a] by (simp add: even_iff_mod_2_eq_zero) lemma coprime_left_2_iff_odd [simp]: "coprime 2 a \ odd a" proof assume "odd a" show "coprime 2 a" proof (rule coprimeI) fix b assume "b dvd 2" "b dvd a" then have "b dvd a mod 2" by (auto intro: dvd_mod) with \odd a\ show "is_unit b" by (simp add: mod_2_eq_odd) qed next assume "coprime 2 a" show "odd a" proof (rule notI) assume "even a" then obtain b where "a = 2 * b" .. with \coprime 2 a\ have "coprime 2 (2 * b)" by simp moreover have "\ coprime 2 (2 * b)" by (rule not_coprimeI [of 2]) simp_all ultimately show False by blast qed qed lemma coprime_right_2_iff_odd [simp]: "coprime a 2 \ odd a" using coprime_left_2_iff_odd [of a] by (simp add: ac_simps) end context unique_euclidean_ring_with_nat begin subclass ring_parity .. lemma minus_1_mod_2_eq [simp]: "- 1 mod 2 = 1" by (simp add: mod_2_eq_odd) lemma minus_1_div_2_eq [simp]: "- 1 div 2 = - 1" proof - from div_mult_mod_eq [of "- 1" 2] have "- 1 div 2 * 2 = - 1 * 2" using add_implies_diff by fastforce then show ?thesis using mult_right_cancel [of 2 "- 1 div 2" "- 1"] by simp qed end context unique_euclidean_semiring_with_nat begin lemma even_mask_div_iff': \even ((2 ^ m - 1) div 2 ^ n) \ m \ n\ proof - have \even ((2 ^ m - 1) div 2 ^ n) \ even (of_nat ((2 ^ m - Suc 0) div 2 ^ n))\ by (simp only: of_nat_div) (simp add: of_nat_diff) also have \\ \ even ((2 ^ m - Suc 0) div 2 ^ n)\ by simp also have \\ \ m \ n\ proof (cases \m \ n\) case True then show ?thesis by (simp add: Suc_le_lessD) next case False then obtain r where r: \m = n + Suc r\ using less_imp_Suc_add by fastforce from r have \{q. q < m} \ {q. 2 ^ n dvd (2::nat) ^ q} = {q. n \ q \ q < m}\ by (auto simp add: dvd_power_iff_le) moreover from r have \{q. q < m} \ {q. \ 2 ^ n dvd (2::nat) ^ q} = {q. q < n}\ by (auto simp add: dvd_power_iff_le) moreover from False have \{q. n \ q \ q < m \ q \ n} = {n}\ by auto then have \odd ((\a\{q. n \ q \ q < m}. 2 ^ a div (2::nat) ^ n) + sum ((^) 2) {q. q < n} div 2 ^ n)\ by (simp_all add: euclidean_semiring_cancel_class.power_diff_power_eq semiring_parity_class.even_sum_iff not_less mask_eq_sum_exp_nat [symmetric]) ultimately have \odd (sum ((^) (2::nat)) {q. q < m} div 2 ^ n)\ by (subst euclidean_semiring_cancel_class.sum_div_partition) simp_all with False show ?thesis by (simp add: mask_eq_sum_exp_nat) qed finally show ?thesis . qed end subsection \Generic symbolic computations\ text \ The following type class contains everything necessary to formulate a division algorithm in ring structures with numerals, restricted to its positive segments. \ class unique_euclidean_semiring_with_nat_division = unique_euclidean_semiring_with_nat + fixes divmod :: \num \ num \ 'a \ 'a\ and divmod_step :: \'a \ 'a \ 'a \ 'a \ 'a\ \ \ These are conceptually definitions but force generated code to be monomorphic wrt. particular instances of this class which yields a significant speedup.\ assumes divmod_def: \divmod m n = (numeral m div numeral n, numeral m mod numeral n)\ and divmod_step_def [simp]: \divmod_step l (q, r) = (if euclidean_size l \ euclidean_size r then (2 * q + 1, r - l) else (2 * q, r))\ \ \ This is a formulation of one step (referring to one digit position) in school-method division: compare the dividend at the current digit position with the remainder from previous division steps and evaluate accordingly.\ begin lemma fst_divmod: \fst (divmod m n) = numeral m div numeral n\ by (simp add: divmod_def) lemma snd_divmod: \snd (divmod m n) = numeral m mod numeral n\ by (simp add: divmod_def) text \ Following a formulation of school-method division. If the divisor is smaller than the dividend, terminate. If not, shift the dividend to the right until termination occurs and then reiterate single division steps in the opposite direction. \ lemma divmod_divmod_step: \divmod m n = (if m < n then (0, numeral m) else divmod_step (numeral n) (divmod m (Num.Bit0 n)))\ proof (cases \m < n\) case True then show ?thesis by (simp add: prod_eq_iff fst_divmod snd_divmod flip: of_nat_numeral of_nat_div of_nat_mod) next case False define r s t where \r = (numeral m :: nat)\ \s = (numeral n :: nat)\ \t = 2 * s\ then have *: \numeral m = of_nat r\ \numeral n = of_nat s\ \numeral (num.Bit0 n) = of_nat t\ and \\ s \ r mod s\ by (simp_all add: not_le) have t: \2 * (r div t) = r div s - r div s mod 2\ \r mod t = s * (r div s mod 2) + r mod s\ by (simp add: Rings.minus_mod_eq_mult_div Groups.mult.commute [of 2] Euclidean_Rings.div_mult2_eq \t = 2 * s\) (use mod_mult2_eq [of r s 2] in \simp add: ac_simps \t = 2 * s\\) have rs: \r div s mod 2 = 0 \ r div s mod 2 = Suc 0\ by auto from \\ s \ r mod s\ have \s \ r mod t \ r div s = Suc (2 * (r div t)) \ r mod s = r mod t - s\ using rs by (auto simp add: t) moreover have \r mod t < s \ r div s = 2 * (r div t) \ r mod s = r mod t\ using rs by (auto simp add: t) ultimately show ?thesis by (simp add: divmod_def prod_eq_iff split_def Let_def not_less mod_eq_0_iff_dvd Rings.mod_eq_0_iff_dvd False not_le *) (simp add: flip: of_nat_numeral of_nat_mult add.commute [of 1] of_nat_div of_nat_mod of_nat_Suc of_nat_diff) qed text \The division rewrite proper -- first, trivial results involving \1\\ lemma divmod_trivial [simp]: "divmod m Num.One = (numeral m, 0)" "divmod num.One (num.Bit0 n) = (0, Numeral1)" "divmod num.One (num.Bit1 n) = (0, Numeral1)" using divmod_divmod_step [of "Num.One"] by (simp_all add: divmod_def) text \Division by an even number is a right-shift\ lemma divmod_cancel [simp]: \divmod (Num.Bit0 m) (Num.Bit0 n) = (case divmod m n of (q, r) \ (q, 2 * r))\ (is ?P) \divmod (Num.Bit1 m) (Num.Bit0 n) = (case divmod m n of (q, r) \ (q, 2 * r + 1))\ (is ?Q) proof - define r s where \r = (numeral m :: nat)\ \s = (numeral n :: nat)\ then have *: \numeral m = of_nat r\ \numeral n = of_nat s\ \numeral (num.Bit0 m) = of_nat (2 * r)\ \numeral (num.Bit0 n) = of_nat (2 * s)\ \numeral (num.Bit1 m) = of_nat (Suc (2 * r))\ by simp_all have **: \Suc (2 * r) div 2 = r\ by simp show ?P and ?Q by (simp_all add: divmod_def *) (simp_all flip: of_nat_numeral of_nat_div of_nat_mod of_nat_mult add.commute [of 1] of_nat_Suc add: Euclidean_Rings.mod_mult_mult1 div_mult2_eq [of _ 2] mod_mult2_eq [of _ 2] **) qed text \The really hard work\ lemma divmod_steps [simp]: "divmod (num.Bit0 m) (num.Bit1 n) = (if m \ n then (0, numeral (num.Bit0 m)) else divmod_step (numeral (num.Bit1 n)) (divmod (num.Bit0 m) (num.Bit0 (num.Bit1 n))))" "divmod (num.Bit1 m) (num.Bit1 n) = (if m < n then (0, numeral (num.Bit1 m)) else divmod_step (numeral (num.Bit1 n)) (divmod (num.Bit1 m) (num.Bit0 (num.Bit1 n))))" by (simp_all add: divmod_divmod_step) lemmas divmod_algorithm_code = divmod_trivial divmod_cancel divmod_steps text \Special case: divisibility\ definition divides_aux :: "'a \ 'a \ bool" where "divides_aux qr \ snd qr = 0" lemma divides_aux_eq [simp]: "divides_aux (q, r) \ r = 0" by (simp add: divides_aux_def) lemma dvd_numeral_simp [simp]: "numeral m dvd numeral n \ divides_aux (divmod n m)" by (simp add: divmod_def mod_eq_0_iff_dvd) text \Generic computation of quotient and remainder\ lemma numeral_div_numeral [simp]: "numeral k div numeral l = fst (divmod k l)" by (simp add: fst_divmod) lemma numeral_mod_numeral [simp]: "numeral k mod numeral l = snd (divmod k l)" by (simp add: snd_divmod) lemma one_div_numeral [simp]: "1 div numeral n = fst (divmod num.One n)" by (simp add: fst_divmod) lemma one_mod_numeral [simp]: "1 mod numeral n = snd (divmod num.One n)" by (simp add: snd_divmod) end instantiation nat :: unique_euclidean_semiring_with_nat_division begin definition divmod_nat :: "num \ num \ nat \ nat" where divmod'_nat_def: "divmod_nat m n = (numeral m div numeral n, numeral m mod numeral n)" definition divmod_step_nat :: "nat \ nat \ nat \ nat \ nat" where "divmod_step_nat l qr = (let (q, r) = qr in if r \ l then (2 * q + 1, r - l) else (2 * q, r))" instance by standard (simp_all add: divmod'_nat_def divmod_step_nat_def) end declare divmod_algorithm_code [where ?'a = nat, code] lemma Suc_0_div_numeral [simp]: \Suc 0 div numeral Num.One = 1\ \Suc 0 div numeral (Num.Bit0 n) = 0\ \Suc 0 div numeral (Num.Bit1 n) = 0\ by simp_all lemma Suc_0_mod_numeral [simp]: \Suc 0 mod numeral Num.One = 0\ \Suc 0 mod numeral (Num.Bit0 n) = 1\ \Suc 0 mod numeral (Num.Bit1 n) = 1\ by simp_all instantiation int :: unique_euclidean_semiring_with_nat_division begin definition divmod_int :: "num \ num \ int \ int" where "divmod_int m n = (numeral m div numeral n, numeral m mod numeral n)" definition divmod_step_int :: "int \ int \ int \ int \ int" where "divmod_step_int l qr = (let (q, r) = qr in if \l\ \ \r\ then (2 * q + 1, r - l) else (2 * q, r))" instance by standard (auto simp add: divmod_int_def divmod_step_int_def) end declare divmod_algorithm_code [where ?'a = int, code] context begin qualified definition adjust_div :: "int \ int \ int" where "adjust_div qr = (let (q, r) = qr in q + of_bool (r \ 0))" qualified lemma adjust_div_eq [simp, code]: "adjust_div (q, r) = q + of_bool (r \ 0)" by (simp add: adjust_div_def) qualified definition adjust_mod :: "num \ int \ int" where [simp]: "adjust_mod l r = (if r = 0 then 0 else numeral l - r)" lemma minus_numeral_div_numeral [simp]: "- numeral m div numeral n = - (adjust_div (divmod m n) :: int)" proof - have "int (fst (divmod m n)) = fst (divmod m n)" by (simp only: fst_divmod divide_int_def) auto then show ?thesis by (auto simp add: split_def Let_def adjust_div_def divides_aux_def divide_int_def) qed lemma minus_numeral_mod_numeral [simp]: "- numeral m mod numeral n = adjust_mod n (snd (divmod m n) :: int)" proof (cases "snd (divmod m n) = (0::int)") case True then show ?thesis by (simp add: mod_eq_0_iff_dvd divides_aux_def) next case False then have "int (snd (divmod m n)) = snd (divmod m n)" if "snd (divmod m n) \ (0::int)" by (simp only: snd_divmod modulo_int_def) auto then show ?thesis by (simp add: divides_aux_def adjust_div_def) (simp add: divides_aux_def modulo_int_def) qed lemma numeral_div_minus_numeral [simp]: "numeral m div - numeral n = - (adjust_div (divmod m n) :: int)" proof - have "int (fst (divmod m n)) = fst (divmod m n)" by (simp only: fst_divmod divide_int_def) auto then show ?thesis by (auto simp add: split_def Let_def adjust_div_def divides_aux_def divide_int_def) qed lemma numeral_mod_minus_numeral [simp]: "numeral m mod - numeral n = - adjust_mod n (snd (divmod m n) :: int)" proof (cases "snd (divmod m n) = (0::int)") case True then show ?thesis by (simp add: mod_eq_0_iff_dvd divides_aux_def) next case False then have "int (snd (divmod m n)) = snd (divmod m n)" if "snd (divmod m n) \ (0::int)" by (simp only: snd_divmod modulo_int_def) auto then show ?thesis by (simp add: divides_aux_def adjust_div_def) (simp add: divides_aux_def modulo_int_def) qed lemma minus_one_div_numeral [simp]: "- 1 div numeral n = - (adjust_div (divmod Num.One n) :: int)" using minus_numeral_div_numeral [of Num.One n] by simp lemma minus_one_mod_numeral [simp]: "- 1 mod numeral n = adjust_mod n (snd (divmod Num.One n) :: int)" using minus_numeral_mod_numeral [of Num.One n] by simp lemma one_div_minus_numeral [simp]: "1 div - numeral n = - (adjust_div (divmod Num.One n) :: int)" using numeral_div_minus_numeral [of Num.One n] by simp lemma one_mod_minus_numeral [simp]: "1 mod - numeral n = - adjust_mod n (snd (divmod Num.One n) :: int)" using numeral_mod_minus_numeral [of Num.One n] by simp lemma [code]: fixes k :: int shows "k div 0 = 0" "k mod 0 = k" "0 div k = 0" "0 mod k = 0" "k div Int.Pos Num.One = k" "k mod Int.Pos Num.One = 0" "k div Int.Neg Num.One = - k" "k mod Int.Neg Num.One = 0" "Int.Pos m div Int.Pos n = (fst (divmod m n) :: int)" "Int.Pos m mod Int.Pos n = (snd (divmod m n) :: int)" "Int.Neg m div Int.Pos n = - (adjust_div (divmod m n) :: int)" "Int.Neg m mod Int.Pos n = adjust_mod n (snd (divmod m n) :: int)" "Int.Pos m div Int.Neg n = - (adjust_div (divmod m n) :: int)" "Int.Pos m mod Int.Neg n = - adjust_mod n (snd (divmod m n) :: int)" "Int.Neg m div Int.Neg n = (fst (divmod m n) :: int)" "Int.Neg m mod Int.Neg n = - (snd (divmod m n) :: int)" by simp_all end lemma divmod_BitM_2_eq [simp]: \divmod (Num.BitM m) (Num.Bit0 Num.One) = (numeral m - 1, (1 :: int))\ by (cases m) simp_all subsubsection \Computation by simplification\ lemma euclidean_size_nat_less_eq_iff: \euclidean_size m \ euclidean_size n \ m \ n\ for m n :: nat by simp lemma euclidean_size_int_less_eq_iff: \euclidean_size k \ euclidean_size l \ \k\ \ \l\\ for k l :: int by auto simproc_setup numeral_divmod ("0 div 0 :: 'a :: unique_euclidean_semiring_with_nat_division" | "0 mod 0 :: 'a :: unique_euclidean_semiring_with_nat_division" | "0 div 1 :: 'a :: unique_euclidean_semiring_with_nat_division" | "0 mod 1 :: 'a :: unique_euclidean_semiring_with_nat_division" | "0 div - 1 :: int" | "0 mod - 1 :: int" | "0 div numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" | "0 mod numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" | "0 div - numeral b :: int" | "0 mod - numeral b :: int" | "1 div 0 :: 'a :: unique_euclidean_semiring_with_nat_division" | "1 mod 0 :: 'a :: unique_euclidean_semiring_with_nat_division" | "1 div 1 :: 'a :: unique_euclidean_semiring_with_nat_division" | "1 mod 1 :: 'a :: unique_euclidean_semiring_with_nat_division" | "1 div - 1 :: int" | "1 mod - 1 :: int" | "1 div numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" | "1 mod numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" | "1 div - numeral b :: int" |"1 mod - numeral b :: int" | "- 1 div 0 :: int" | "- 1 mod 0 :: int" | "- 1 div 1 :: int" | "- 1 mod 1 :: int" | "- 1 div - 1 :: int" | "- 1 mod - 1 :: int" | "- 1 div numeral b :: int" | "- 1 mod numeral b :: int" | "- 1 div - numeral b :: int" | "- 1 mod - numeral b :: int" | "numeral a div 0 :: 'a :: unique_euclidean_semiring_with_nat_division" | "numeral a mod 0 :: 'a :: unique_euclidean_semiring_with_nat_division" | "numeral a div 1 :: 'a :: unique_euclidean_semiring_with_nat_division" | "numeral a mod 1 :: 'a :: unique_euclidean_semiring_with_nat_division" | "numeral a div - 1 :: int" | "numeral a mod - 1 :: int" | "numeral a div numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" | "numeral a mod numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" | "numeral a div - numeral b :: int" | "numeral a mod - numeral b :: int" | "- numeral a div 0 :: int" | "- numeral a mod 0 :: int" | "- numeral a div 1 :: int" | "- numeral a mod 1 :: int" | "- numeral a div - 1 :: int" | "- numeral a mod - 1 :: int" | "- numeral a div numeral b :: int" | "- numeral a mod numeral b :: int" | "- numeral a div - numeral b :: int" | "- numeral a mod - numeral b :: int") = \ let val if_cong = the (Code.get_case_cong \<^theory> \<^const_name>\If\); fun successful_rewrite ctxt ct = let val thm = Simplifier.rewrite ctxt ct in if Thm.is_reflexive thm then NONE else SOME thm end; val simps = @{thms div_0 mod_0 div_by_0 mod_by_0 div_by_1 mod_by_1 one_div_numeral one_mod_numeral minus_one_div_numeral minus_one_mod_numeral one_div_minus_numeral one_mod_minus_numeral numeral_div_numeral numeral_mod_numeral minus_numeral_div_numeral minus_numeral_mod_numeral numeral_div_minus_numeral numeral_mod_minus_numeral div_minus_minus mod_minus_minus Parity.adjust_div_eq of_bool_eq one_neq_zero numeral_neq_zero neg_equal_0_iff_equal arith_simps arith_special divmod_trivial divmod_cancel divmod_steps divmod_step_def fst_conv snd_conv numeral_One case_prod_beta rel_simps Parity.adjust_mod_def div_minus1_right mod_minus1_right minus_minus numeral_times_numeral mult_zero_right mult_1_right euclidean_size_nat_less_eq_iff euclidean_size_int_less_eq_iff diff_nat_numeral nat_numeral} @ [@{lemma "0 = 0 \ True" by simp}]; val simpset = HOL_ss |> Simplifier.simpset_map \<^context> (Simplifier.add_cong if_cong #> fold Simplifier.add_simp simps); in K (fn ctxt => successful_rewrite (Simplifier.put_simpset simpset ctxt)) end \ \ \ There is space for improvement here: the calculation itself could be carried out outside the logic, and a generic simproc (simplifier setup) for generic calculation would be helpful. \ subsection \Computing congruences modulo \2 ^ q\\ context unique_euclidean_semiring_with_nat_division begin lemma cong_exp_iff_simps: "numeral n mod numeral Num.One = 0 \ True" "numeral (Num.Bit0 n) mod numeral (Num.Bit0 q) = 0 \ numeral n mod numeral q = 0" "numeral (Num.Bit1 n) mod numeral (Num.Bit0 q) = 0 \ False" "numeral m mod numeral Num.One = (numeral n mod numeral Num.One) \ True" "numeral Num.One mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q)) \ True" "numeral Num.One mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q)) \ False" "numeral Num.One mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q)) \ (numeral n mod numeral q) = 0" "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q)) \ False" "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q)) \ numeral m mod numeral q = (numeral n mod numeral q)" "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q)) \ False" "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q)) \ (numeral m mod numeral q) = 0" "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q)) \ False" "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q)) \ numeral m mod numeral q = (numeral n mod numeral q)" by (auto simp add: case_prod_beta dest: arg_cong [of _ _ even]) end code_identifier code_module Parity \ (SML) Arith and (OCaml) Arith and (Haskell) Arith lemmas even_of_nat = even_of_nat_iff end