# HG changeset patch # User wenzelm # Date 1665665355 -7200 # Node ID e381884c09d4f47e5b7d28c1dd43361fe82abd1c # Parent 2d4ff8c166d299d3b16e63fe6084567964584d3b# Parent cee0b9fccf6f075e3083f4cb4df30c1e128ce697 merged diff -r 2d4ff8c166d2 -r e381884c09d4 Admin/components/components.sha1 --- a/Admin/components/components.sha1 Thu Oct 13 11:22:32 2022 +0200 +++ b/Admin/components/components.sha1 Thu Oct 13 14:49:15 2022 +0200 @@ -374,6 +374,8 @@ 33568f69ce813b7405386ddbefa14ad0342bb8f0 polyml-test-a3cfdf648da.tar.gz 4bedaac4f1fb9a9199aa63695735063c47059003 polyml-test-a444f281ccec.tar.gz f3031692edcc5d8028a42861e4e40779f0f9d3e1 polyml-test-b68438d33c69.tar.gz +b2901b604124cfe46a6c28041f47c5a3bd3673f0 polyml-test-bafe319bc3a6-1.tar.gz +3ac7e916832c07accebeada9a81b301c299e1930 polyml-test-bafe319bc3a6.tar.gz cb2318cff6ea9293cd16a4435a4fe28ad9dbe0b8 polyml-test-cf46747fee61.tar.gz 67ffed2f98864721bdb1e87f0ef250e4c69e6160 polyml-test-d68c6736402e.tar.gz b4ceeaac47f3baae41c2491a8368b03217946166 polyml-test-e7a662f8f9c4.tar.gz diff -r 2d4ff8c166d2 -r e381884c09d4 CONTRIBUTORS --- a/CONTRIBUTORS Thu Oct 13 11:22:32 2022 +0200 +++ b/CONTRIBUTORS Thu Oct 13 14:49:15 2022 +0200 @@ -3,6 +3,10 @@ listed as an author in one of the source files of this Isabelle distribution. +Contributions to this Isabelle version +-------------------------------------- + + Contributions to Isabelle2022 ----------------------------- diff -r 2d4ff8c166d2 -r e381884c09d4 NEWS --- a/NEWS Thu Oct 13 11:22:32 2022 +0200 +++ b/NEWS Thu Oct 13 14:49:15 2022 +0200 @@ -4,6 +4,38 @@ (Note: Isabelle/jEdit shows a tree-view of the NEWS file in Sidekick.) +New in this Isabelle version +---------------------------- + +*** HOL *** + +* Theory "HOL.Relation": + - Strengthened lemma total_on_singleton. Minor INCOMPATIBILITY. + - Added lemmas. + antisym_if_asymp + antisymp_ge[simp] + antisymp_greater[simp] + antisymp_if_asymp + antisymp_le[simp] + antisymp_less[simp] + irreflD + irreflpD + reflp_ge[simp] + reflp_le[simp] + totalp_on_singleton[simp] + +* Theory "HOL.Wellfounded": + - Added lemmas. + wfP_if_convertible_to_nat + wfP_if_convertible_to_wfP + wf_if_convertible_to_wf + +* Theory "HOL-Library.FSet": + - Added lemmas. + fimage_strict_mono + inj_on_strict_fsubset + + New in Isabelle2022 (October 2022) ---------------------------------- diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/Computational_Algebra/Polynomial.thy --- a/src/HOL/Computational_Algebra/Polynomial.thy Thu Oct 13 11:22:32 2022 +0200 +++ b/src/HOL/Computational_Algebra/Polynomial.thy Thu Oct 13 14:49:15 2022 +0200 @@ -3985,9 +3985,9 @@ by simp next case False - then show ?thesis - by (cases y \smult a (x div y)\ \smult a (x mod y)\ \smult a x\ rule: euclidean_relation_polyI) - (simp_all add: dvd_smult_iff degree_mod_less_degree flip: smult_add_right) + show ?thesis + by (rule euclidean_relation_polyI) + (use False in \simp_all add: dvd_smult_iff degree_mod_less_degree flip: smult_add_right\) qed then show ?Q and ?R by simp_all @@ -4006,7 +4006,7 @@ for x y z :: \'a::field poly\ proof - have \((x + y) div z, (x + y) mod z) = (x div z + y div z, x mod z + y mod z)\ - proof (cases z \x div z + y div z\ \x mod z + y mod z\ \x + y\ rule: euclidean_relation_polyI) + proof (induction rule: euclidean_relation_polyI) case by0 then show ?case by simp next @@ -4045,7 +4045,7 @@ and mod_smult_right: \x mod smult a y = (if a = 0 then x else x mod y)\ (is ?R) proof - have \(x div smult a y, x mod smult a y) = (smult (inverse a) (x div y), (if a = 0 then x else x mod y))\ - proof (cases \smult a y\ \smult (inverse a) (x div y)\ \(if a = 0 then x else x mod y)\ x rule: euclidean_relation_polyI) + proof (induction rule: euclidean_relation_polyI) case by0 then show ?case by auto next @@ -4077,7 +4077,7 @@ for x y z :: \'a::field poly\ proof - have \(x div (y * z), x mod (y * z)) = ((x div y) div z, y * (x div y mod z) + x mod y)\ - proof (cases \y * z\ \(x div y) div z\ \y * (x div y mod z) + x mod y\ x rule: euclidean_relation_polyI) + proof (induction rule: euclidean_relation_polyI) case by0 then show ?case by auto next @@ -4143,7 +4143,7 @@ define b where \b = coeff (pCons a (p mod q)) (degree q) / lead_coeff q\ have \(pCons a p div q, pCons a p mod q) = (pCons b (p div q), (pCons a (p mod q) - smult b q))\ (is \_ = (?q, ?r)\) - proof (cases q ?q ?r \pCons a p\ rule: euclidean_relation_polyI) + proof (induction rule: euclidean_relation_polyI) case by0 with \q \ 0\ show ?case by simp next diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/Euclidean_Division.thy --- a/src/HOL/Euclidean_Division.thy Thu Oct 13 11:22:32 2022 +0200 +++ b/src/HOL/Euclidean_Division.thy Thu Oct 13 14:49:15 2022 +0200 @@ -672,7 +672,7 @@ 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 (cases b \c + a div b\ \a mod b\ \a + c * b\ rule: euclidean_relationI) + proof (induction rule: euclidean_relationI) case by0 with \b \ 0\ show ?case @@ -698,7 +698,7 @@ 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 (cases \c * b\ \a div b\ \c * (a mod b)\ \c * a\ rule: euclidean_relationI) + proof (induction rule: euclidean_relationI) case by0 with \c \ 0\ show ?case by simp @@ -745,7 +745,7 @@ next assume \euclidean_size a < euclidean_size b\ have \(a div b, a mod b) = (0, a)\ - proof (cases b 0 a a rule: euclidean_relationI) + proof (induction rule: euclidean_relationI) case by0 show ?case by simp @@ -783,7 +783,7 @@ 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 (cases c \a * (b div c) + a * (b mod c) div c\ \(a * b) mod c\ \a * b\ rule: euclidean_relationI) + proof (induction rule: euclidean_relationI) case by0 then show ?case by simp next @@ -817,7 +817,7 @@ 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 (cases c \a div c + b div c + (a mod c + b mod c) div c\ \(a + b) mod c\ \a + b\ rule: euclidean_relationI) + proof (induction rule: euclidean_relationI) case by0 then show ?case by simp @@ -978,7 +978,7 @@ \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 (cases n q \m - n * q\ m rule: euclidean_relation_natI) + proof (induction rule: euclidean_relation_natI) case by0 with that show ?case by simp @@ -1004,7 +1004,7 @@ \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 (cases n \(m - r) div n\ r m rule: euclidean_relation_natI) + proof (induction rule: euclidean_relation_natI) case by0 with that show ?case by simp @@ -1268,7 +1268,7 @@ 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 (cases \n * q\ \(m div n) div q\ \n * (m div n mod q) + m mod n\ m rule: euclidean_relation_natI) + proof (induction rule: euclidean_relation_natI) case by0 then show ?case by auto @@ -1411,7 +1411,7 @@ 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)\ (is "_ = ?rhs") + \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 @@ -1419,34 +1419,15 @@ case False then have \n > 1\ by simp - then have *: \Suc 0 div n = 0\ - by (simp add: div_eq_0_iff) - have \(m + 1) div n = ?rhs\ + 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 True - then obtain q where \Suc m = n * q\ .. - then have m: \m = n * q - 1\ - by simp - have \q > 0\ by (rule ccontr) - (use \Suc m = n * q\ in simp) - from m have \m mod n = (n * q - 1) mod n\ - by simp - also have \\ = (n * q - 1 + n) mod n\ - by simp - also have \n * q - 1 + n = n * q + (n - 1)\ - using \n > 1\ \q > 0\ by (simp add: algebra_simps) - finally have \m mod n = (n - 1) mod n\ - by simp - with \n > 1\ have \m mod n = n - 1\ - by simp - with True \n > 1\ show ?thesis - by (subst div_add1_eq) auto - next case False - have \Suc (m mod n) \ n\ + moreover have \Suc (m mod n) \ n\ proof (rule ccontr) assume \\ Suc (m mod n) \ n\ - then have \m mod n = n - 1\ + 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 @@ -1456,28 +1437,35 @@ qed moreover have \Suc (m mod n) \ n\ using \n > 1\ by (simp add: Suc_le_eq) - ultimately have \Suc (m mod n) < n\ + 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 - with False \n > 1\ show ?thesis - by (subst div_add1_eq) (auto simp add: div_eq_0_iff mod_greater_zero_iff_not_dvd) qed - then show ?thesis - by simp + 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))\ (is "_ = ?rhs") -proof (cases "n = 0") + \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 - have "Suc m mod n = Suc (m mod n) mod n" + moreover have \Suc m mod n = Suc (m mod n) mod n\ by (simp add: mod_simps) - also have "\ = ?rhs" - using False by (auto intro!: mod_nat_eqI intro: neq_le_trans simp add: Suc_le_eq) - finally show ?thesis . + ultimately show ?thesis + by (auto intro!: mod_nat_eqI intro: neq_le_trans simp add: Suc_le_eq) qed lemma Suc_times_mod_eq: @@ -1948,7 +1936,7 @@ 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 (cases l q r k rule: euclidean_relationI) +proof (induction rule: euclidean_relationI) case by0 then show ?case by (rule by0') @@ -2274,7 +2262,7 @@ from that have \l < 0\ by simp have \(k div l, k mod l) = (- 1, k + l)\ - proof (cases l \- 1 :: int\ \k + l\ k rule: euclidean_relation_intI) + proof (induction rule: euclidean_relation_intI) case by0 with \l < 0\ show ?case by simp @@ -2316,9 +2304,9 @@ and int_mod_pos_eq: \a mod b = r\ (is ?R) proof - - from assms have \(a div b, a mod b) = (q, r)\ - by (cases b q r a rule: euclidean_relation_intI) - (auto simp add: ac_simps dvd_add_left_iff sgn_1_pos le_less dest: zdvd_imp_le) + 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 @@ -2868,7 +2856,7 @@ 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 (cases \2 * a\ \b div a\ \1 + 2 * (b mod a)\ \1 + 2 * b\ rule: euclidean_relation_intI) + proof (induction rule: euclidean_relation_intI) case by0 then show ?case by simp @@ -2908,7 +2896,7 @@ 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 (cases \2 * a\ \(b + 1) div a\ \2 * ((b + 1) mod a) - 1\ \1 + 2 * b\ rule: euclidean_relation_intI) + proof (induction rule: euclidean_relation_intI) case by0 then show ?case by simp diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/Examples/Gauss_Numbers.thy --- a/src/HOL/Examples/Gauss_Numbers.thy Thu Oct 13 11:22:32 2022 +0200 +++ b/src/HOL/Examples/Gauss_Numbers.thy Thu Oct 13 14:49:15 2022 +0200 @@ -311,18 +311,94 @@ \Re (x div y) = (Re x * Re y + Im x * Im y) rdiv ((Re y)\<^sup>2 + (Im y)\<^sup>2)\ | \Im (x div y) = (Im x * Re y - Re x * Im y) rdiv ((Re y)\<^sup>2 + (Im y)\<^sup>2)\ -definition modulo_gauss :: \gauss \ gauss \ gauss\ +primcorec modulo_gauss :: \gauss \ gauss \ gauss\ where - \x mod y = x - x div y * y\ for x y :: gauss + \Re (x mod y) = Re x - + ((Re x * Re y + Im x * Im y) rdiv ((Re y)\<^sup>2 + (Im y)\<^sup>2) * Re y - + (Im x * Re y - Re x * Im y) rdiv ((Re y)\<^sup>2 + (Im y)\<^sup>2) * Im y)\ + | \Im (x mod y) = Im x - + ((Re x * Re y + Im x * Im y) rdiv ((Re y)\<^sup>2 + (Im y)\<^sup>2) * Im y + + (Im x * Re y - Re x * Im y) rdiv ((Re y)\<^sup>2 + (Im y)\<^sup>2) * Re y)\ + +instance proof + fix x y :: gauss + show \x div 0 = 0\ + by (simp add: gauss_eq_iff) + show \x * y div y = x\ if \y \ 0\ + proof - + define Y where \Y = (Re y)\<^sup>2 + (Im y)\<^sup>2\ + moreover have \Y > 0\ + using that by (simp add: gauss_eq_0 less_le Y_def) + have *: \Im y * (Im y * Re x) + Re x * (Re y * Re y) = Re x * Y\ + \Im x * (Im y * Im y) + Im x * (Re y * Re y) = Im x * Y\ + \(Im y)\<^sup>2 + (Re y)\<^sup>2 = Y\ + by (simp_all add: power2_eq_square algebra_simps Y_def) + from \Y > 0\ show ?thesis + by (simp add: gauss_eq_iff algebra_simps) (simp add: * nonzero_mult_rdiv_cancel_right) + qed + show \x div y * y + x mod y = x\ + by (simp add: gauss_eq_iff) +qed + +end + +instantiation gauss :: euclidean_ring +begin + +definition euclidean_size_gauss :: \gauss \ nat\ + where \euclidean_size x = nat ((Re x)\<^sup>2 + (Im x)\<^sup>2)\ -instance - apply standard - apply (simp_all add: modulo_gauss_def) - apply (auto simp add: gauss_eq_iff algebra_simps power2_eq_square) - apply (simp_all only: flip: mult.assoc distrib_right) - apply (simp_all only: mult.assoc [of \Im k\ \Re l\ \Re r\ for k l r]) - apply (simp_all add: sum_squares_eq_zero_iff mult.commute nonzero_mult_rdiv_cancel_right flip: distrib_left) - done +instance proof + show \euclidean_size (0::gauss) = 0\ + by (simp add: euclidean_size_gauss_def) + show \euclidean_size (x mod y) < euclidean_size y\ if \y \ 0\ for x y :: gauss + proof- + define X and Y and R and I + where \X = (Re x)\<^sup>2 + (Im x)\<^sup>2\ and \Y = (Re y)\<^sup>2 + (Im y)\<^sup>2\ + and \R = Re x * Re y + Im x * Im y\ and \I = Im x * Re y - Re x * Im y\ + with that have \0 < Y\ and rhs: \int (euclidean_size y) = Y\ + by (simp_all add: gauss_neq_0 euclidean_size_gauss_def) + have \X * Y = R\<^sup>2 + I\<^sup>2\ + by (simp add: R_def I_def X_def Y_def power2_eq_square algebra_simps) + let ?lhs = \X - I * (I rdiv Y) - R * (R rdiv Y) + - I rdiv Y * (I rmod Y) - R rdiv Y * (R rmod Y)\ + have \?lhs = X + Y * (R rdiv Y) * (R rdiv Y) + Y * (I rdiv Y) * (I rdiv Y) + - 2 * (R rdiv Y * R + I rdiv Y * I)\ + by (simp flip: minus_rmod_eq_mult_rdiv add: algebra_simps) + also have \\ = (Re (x mod y))\<^sup>2 + (Im (x mod y))\<^sup>2\ + by (simp add: X_def Y_def R_def I_def algebra_simps power2_eq_square) + finally have lhs: \int (euclidean_size (x mod y)) = ?lhs\ + by (simp add: euclidean_size_gauss_def) + have \?lhs * Y = (I rmod Y)\<^sup>2 + (R rmod Y)\<^sup>2\ + apply (simp add: algebra_simps power2_eq_square \X * Y = R\<^sup>2 + I\<^sup>2\) + apply (simp flip: mult.assoc add.assoc minus_rmod_eq_mult_rdiv) + apply (simp add: algebra_simps) + done + also have \\ \ (Y div 2)\<^sup>2 + (Y div 2)\<^sup>2\ + by (rule add_mono) (use \Y > 0\ abs_rmod_less_equal [of Y] in \simp_all add: power2_le_iff_abs_le\) + also have \\ < Y\<^sup>2\ + using \Y > 0\ by (cases \Y = 1\) (simp_all add: power2_eq_square mult_le_less_imp_less flip: mult.assoc) + finally have \?lhs * Y < Y\<^sup>2\ . + with \Y > 0\ have \?lhs < Y\ + by (simp add: power2_eq_square) + then have \int (euclidean_size (x mod y)) < int (euclidean_size y)\ + by (simp only: lhs rhs) + then show ?thesis + by simp + qed + show \euclidean_size x \ euclidean_size (x * y)\ if \y \ 0\ for x y :: gauss + proof - + from that have \euclidean_size y > 0\ + by (simp add: euclidean_size_gauss_def gauss_neq_0) + then have \euclidean_size x \ euclidean_size x * euclidean_size y\ + by simp + also have \\ = nat (((Re x)\<^sup>2 + (Im x)\<^sup>2) * ((Re y)\<^sup>2 + (Im y)\<^sup>2))\ + by (simp add: euclidean_size_gauss_def nat_mult_distrib) + also have \\ = euclidean_size (x * y)\ + by (simp add: euclidean_size_gauss_def eq_nat_nat_iff) (simp add: algebra_simps power2_eq_square) + finally show ?thesis . + qed +qed end diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/Fun.thy --- a/src/HOL/Fun.thy Thu Oct 13 11:22:32 2022 +0200 +++ b/src/HOL/Fun.thy Thu Oct 13 14:49:15 2022 +0200 @@ -208,7 +208,7 @@ lemma bij_id[simp]: "bij id" by (simp add: bij_betw_def) -lemma bij_uminus: "bij (uminus :: 'a \ 'a::ab_group_add)" +lemma bij_uminus: "bij (uminus :: 'a \ 'a::group_add)" unfolding bij_betw_def inj_on_def by (force intro: minus_minus [symmetric]) @@ -591,9 +591,6 @@ lemma inj_on_vimage_singleton: "inj_on f A \ f -` {a} \ A \ {THE x. x \ A \ f x = a}" by (auto simp add: inj_on_def intro: the_equality [symmetric]) -lemma (in ordered_ab_group_add) inj_uminus[simp, intro]: "inj_on uminus A" - by (auto intro!: inj_onI) - lemma bij_betw_byWitness: assumes left: "\a \ A. f' (f a) = a" and right: "\a' \ A'. f (f' a') = a'" @@ -696,7 +693,7 @@ qed -subsubsection \Important examples\ +subsubsection \Inj/surj/bij of Algebraic Operations\ context cancel_semigroup_add begin @@ -705,10 +702,6 @@ "inj_on ((+) a) A" by (rule inj_onI) simp -lemma inj_add_left: - \inj ((+) a)\ - by simp - lemma inj_on_add' [simp]: "inj_on (\b. b + a) A" by (rule inj_onI) simp @@ -719,26 +712,89 @@ end -context ab_group_add +context group_add begin +lemma diff_left_imp_eq: "a - b = a - c \ b = c" +unfolding add_uminus_conv_diff[symmetric] +by(drule local.add_left_imp_eq) simp + +lemma inj_uminus[simp, intro]: "inj_on uminus A" + by (auto intro!: inj_onI) + +lemma surj_uminus[simp]: "surj uminus" +using surjI minus_minus by blast + lemma surj_plus [simp]: "surj ((+) a)" - by (auto intro!: range_eqI [of b "(+) a" "b - a" for b]) (simp add: algebra_simps) +proof (standard, simp, standard, simp) + fix x + have "x = a + (-a + x)" by (simp add: add.assoc) + thus "x \ range ((+) a)" by blast +qed + +lemma surj_plus_right [simp]: + "surj (\b. b+a)" +proof (standard, simp, standard, simp) + fix b show "b \ range (\b. b+a)" + using diff_add_cancel[of b a, symmetric] by blast +qed -lemma inj_diff_right [simp]: - \inj (\b. b - a)\ -proof - - have \inj ((+) (- a))\ - by (fact inj_add_left) - also have \(+) (- a) = (\b. b - a)\ - by (simp add: fun_eq_iff) - finally show ?thesis . +lemma inj_on_diff_left [simp]: + \inj_on ((-) a) A\ +by (auto intro: inj_onI dest!: diff_left_imp_eq) + +lemma inj_on_diff_right [simp]: + \inj_on (\b. b - a) A\ +by (auto intro: inj_onI simp add: algebra_simps) + +lemma surj_diff [simp]: + "surj ((-) a)" +proof (standard, simp, standard, simp) + fix x + have "x = a - (- x + a)" by (simp add: algebra_simps) + thus "x \ range ((-) a)" by blast qed lemma surj_diff_right [simp]: "surj (\x. x - a)" - using surj_plus [of "- a"] by (simp cong: image_cong_simp) +proof (standard, simp, standard, simp) + fix x + have "x = x + a - a" by simp + thus "x \ range (\x. x - a)" by fast +qed + +lemma shows bij_plus: "bij ((+) a)" and bij_plus_right: "bij (\x. x + a)" + and bij_uminus: "bij uminus" + and bij_diff: "bij ((-) a)" and bij_diff_right: "bij (\x. x - a)" +by(simp_all add: bij_def) + +lemma translation_subtract_Compl: + "(\x. x - a) ` (- t) = - ((\x. x - a) ` t)" +by(rule bij_image_Compl_eq) + (auto simp add: bij_def surj_def inj_def diff_eq_eq intro!: add_diff_cancel[symmetric]) + +lemma translation_diff: + "(+) a ` (s - t) = ((+) a ` s) - ((+) a ` t)" + by auto + +lemma translation_subtract_diff: + "(\x. x - a) ` (s - t) = ((\x. x - a) ` s) - ((\x. x - a) ` t)" +by(rule image_set_diff)(simp add: inj_on_def diff_eq_eq) + +lemma translation_Int: + "(+) a ` (s \ t) = ((+) a ` s) \ ((+) a ` t)" + by auto + +lemma translation_subtract_Int: + "(\x. x - a) ` (s \ t) = ((\x. x - a) ` s) \ ((\x. x - a) ` t)" +by(rule image_Int)(simp add: inj_on_def diff_eq_eq) + +end + +(* TODO: prove in group_add *) +context ab_group_add +begin lemma translation_Compl: "(+) a ` (- t) = - ((+) a ` t)" @@ -748,26 +804,6 @@ by (auto simp: image_iff algebra_simps intro!: bexI [of _ "b - a"]) qed -lemma translation_subtract_Compl: - "(\x. x - a) ` (- t) = - ((\x. x - a) ` t)" - using translation_Compl [of "- a" t] by (simp cong: image_cong_simp) - -lemma translation_diff: - "(+) a ` (s - t) = ((+) a ` s) - ((+) a ` t)" - by auto - -lemma translation_subtract_diff: - "(\x. x - a) ` (s - t) = ((\x. x - a) ` s) - ((\x. x - a) ` t)" - using translation_diff [of "- a"] by (simp cong: image_cong_simp) - -lemma translation_Int: - "(+) a ` (s \ t) = ((+) a ` s) \ ((+) a ` t)" - by auto - -lemma translation_subtract_Int: - "(\x. x - a) ` (s \ t) = ((\x. x - a) ` s) \ ((\x. x - a) ` t)" - using translation_Int [of " -a"] by (simp cong: image_cong_simp) - end @@ -918,20 +954,6 @@ using that UNIV_I by (rule the_inv_into_f_f) -subsection \Cantor's Paradox\ - -theorem Cantors_paradox: "\f. f ` A = Pow A" -proof - assume "\f. f ` A = Pow A" - then obtain f where f: "f ` A = Pow A" .. - let ?X = "{a \ A. a \ f a}" - have "?X \ Pow A" by blast - then have "?X \ f ` A" by (simp only: f) - then obtain x where "x \ A" and "f x = ?X" by blast - then show False by blast -qed - - subsection \Monotonicity\ definition monotone_on :: "'a set \ ('a \ 'a \ bool) \ ('b \ 'b \ bool) \ ('a \ 'b) \ bool" diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/Library/FSet.thy --- a/src/HOL/Library/FSet.thy Thu Oct 13 11:22:32 2022 +0200 +++ b/src/HOL/Library/FSet.thy Thu Oct 13 14:49:15 2022 +0200 @@ -556,6 +556,31 @@ lemma subset_fimage_iff: "(B |\| f|`|A) = (\ AA. AA |\| A \ B = f|`|AA)" by transfer (metis mem_Collect_eq rev_finite_subset subset_image_iff) +lemma fimage_strict_mono: + assumes "inj_on f (fset B)" and "A |\| B" + shows "f |`| A |\| f |`| B" + \ \TODO: Configure transfer framework to lift @{thm Fun.inj_on_strict_subset}.\ +proof (rule pfsubsetI) + from \A |\| B\ have "A |\| B" + by (rule pfsubset_imp_fsubset) + thus "f |`| A |\| f |`| B" + by (rule fimage_mono) +next + from \A |\| B\ have "A |\| B" and "A \ B" + by (simp_all add: pfsubset_eq) + + have "fset A \ fset B" + using \A \ B\ + by (simp add: fset_cong) + hence "f ` fset A \ f ` fset B" + using \A |\| B\ + by (simp add: inj_on_image_eq_iff[OF \inj_on f (fset B)\] less_eq_fset.rep_eq) + hence "fset (f |`| A) \ fset (f |`| B)" + by (simp add: fimage.rep_eq) + thus "f |`| A \ f |`| B" + by (simp add: fset_cong) +qed + subsubsection \bounded quantification\ @@ -745,6 +770,15 @@ end +subsubsection \@{term fsubset}\ + +lemma wfP_pfsubset: "wfP (|\|)" +proof (rule wfP_if_convertible_to_nat) + show "\x y. x |\| y \ fcard x < fcard y" + by (rule pfsubset_fcard_mono) +qed + + subsubsection \Group operations\ locale comm_monoid_fset = comm_monoid diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/Library/Rounded_Division.thy --- a/src/HOL/Library/Rounded_Division.thy Thu Oct 13 11:22:32 2022 +0200 +++ b/src/HOL/Library/Rounded_Division.thy Thu Oct 13 14:49:15 2022 +0200 @@ -1,21 +1,30 @@ (* Author: Florian Haftmann, TU Muenchen *) -subsection \Rounded division: modulus centered towars zero.\ +subsection \Rounded division: modulus centered towards zero.\ theory Rounded_Division imports Main begin +lemma off_iff_abs_mod_2_eq_one: + \odd l \ \l\ mod 2 = 1\ for l :: int + by (simp flip: odd_iff_mod_2_eq_one) + definition rounded_divide :: \int \ int \ int\ (infixl \rdiv\ 70) - where \k rdiv l = (k + l div 2 + of_bool (l < 0)) div l\ + where \k rdiv l = sgn l * ((k + \l\ div 2) div \l\)\ definition rounded_modulo :: \int \ int \ int\ (infixl \rmod\ 70) - where \k rmod l = k - k rdiv l * l\ + where \k rmod l = (k + \l\ div 2) mod \l\ - \l\ div 2\ lemma rdiv_mult_rmod_eq: \k rdiv l * l + k rmod l = k\ - by (simp add: rounded_divide_def rounded_modulo_def) +proof - + have *: \l * (sgn l * j) = \l\ * j\ for j + by (simp add: ac_simps abs_sgn) + show ?thesis + by (simp add: rounded_divide_def rounded_modulo_def algebra_simps *) +qed lemma mult_rdiv_rmod_eq: \l * (k rdiv l) + k rmod l = k\ @@ -67,11 +76,32 @@ lemma zero_rmod_eq [simp]: \0 rmod k = 0\ + by (auto simp add: rounded_modulo_def not_less zmod_trivial_iff) + +lemma rdiv_minus_eq: + \k rdiv - l = - (k rdiv l)\ + by (simp add: rounded_divide_def) + +lemma rmod_minus_eq [simp]: + \k rmod - l = k rmod l\ + by (simp add: rounded_modulo_def) + +lemma rdiv_abs_eq: + \k rdiv \l\ = sgn l * (k rdiv l)\ + by (simp add: rounded_divide_def) + +lemma rmod_abs_eq [simp]: + \k rmod \l\ = k rmod l\ by (simp add: rounded_modulo_def) lemma nonzero_mult_rdiv_cancel_right: \k * l rdiv l = k\ if \l \ 0\ - using that by (auto simp add: rounded_divide_def ac_simps) +proof - + have \sgn l * k * \l\ rdiv l = k\ + using that by (simp add: rounded_divide_def) + with that show ?thesis + by (simp add: ac_simps abs_sgn) +qed lemma rdiv_self_eq [simp]: \k rdiv k = 1\ if \k \ 0\ @@ -79,6 +109,53 @@ lemma rmod_self_eq [simp]: \k rmod k = 0\ - by (cases \k = 0\) (simp_all add: rounded_modulo_def) +proof - + have \(sgn k * \k\ + \k\ div 2) mod \k\ = \k\ div 2\ + by (auto simp add: zmod_trivial_iff) + also have \sgn k * \k\ = k\ + by (simp add: abs_sgn) + finally show ?thesis + by (simp add: rounded_modulo_def algebra_simps) +qed + +lemma signed_take_bit_eq_rmod: + \signed_take_bit n k = k rmod (2 ^ Suc n)\ + by (simp only: rounded_modulo_def power_abs abs_numeral flip: take_bit_eq_mod) + (simp add: signed_take_bit_eq_take_bit_shift) + +lemma rmod_less_divisor: + \k rmod l < \l\ - \l\ div 2\ if \l \ 0\ + using that pos_mod_bound [of \\l\\] by (simp add: rounded_modulo_def) + +lemma rmod_less_equal_divisor: + \k rmod l \ \l\ div 2\ if \l \ 0\ +proof - + from that rmod_less_divisor [of l k] + have \k rmod l < \l\ - \l\ div 2\ + by simp + also have \\l\ - \l\ div 2 = \l\ div 2 + of_bool (odd l)\ + by auto + finally show ?thesis + by (cases \even l\) simp_all +qed + +lemma divisor_less_equal_rmod': + \\l\ div 2 - \l\ \ k rmod l\ if \l \ 0\ +proof - + have \0 \ (k + \l\ div 2) mod \l\\ + using that pos_mod_sign [of \\l\\] by simp + then show ?thesis + by (simp_all add: rounded_modulo_def) +qed + +lemma divisor_less_equal_rmod: + \- (\l\ div 2) \ k rmod l\ if \l \ 0\ + using that divisor_less_equal_rmod' [of l k] + by (simp add: rounded_modulo_def) + +lemma abs_rmod_less_equal: + \\k rmod l\ \ \l\ div 2\ if \l \ 0\ + using that divisor_less_equal_rmod [of l k] + by (simp add: abs_le_iff rmod_less_equal_divisor) end diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/Number_Theory/Gauss.thy --- a/src/HOL/Number_Theory/Gauss.thy Thu Oct 13 11:22:32 2022 +0200 +++ b/src/HOL/Number_Theory/Gauss.thy Thu Oct 13 14:49:15 2022 +0200 @@ -163,12 +163,6 @@ by (auto simp add: B_def inj_on_def A_def) metis qed -lemma inj_on_pminusx_E: "inj_on (\x. p - x) E" - apply (auto simp add: E_def C_def B_def A_def) - apply (rule inj_on_inverseI [where g = "(-) (int p)"]) - apply auto - done - lemma nonzero_mod_p: "0 < x \ x < int p \ [x \ 0](mod p)" for x :: int by (simp add: cong_def) @@ -241,7 +235,7 @@ by (simp add: B_card_eq_A A_card_eq) lemma F_card_eq_E: "card F = card E" - using finite_E by (simp add: F_def inj_on_pminusx_E card_image) + using finite_E by (simp add: F_def card_image) lemma C_card_eq_B: "card C = card B" proof - @@ -312,11 +306,7 @@ lemma prod_F_zcong: "[prod id F = ((-1) ^ (card E)) * prod id E] (mod p)" proof - have FE: "prod id F = prod ((-) p) E" - apply (auto simp add: F_def) - apply (insert finite_E inj_on_pminusx_E) - apply (drule prod.reindex) - apply auto - done + using finite_E prod.reindex[OF inj_on_diff_left] by (auto simp add: F_def) then have "\x \ E. [(p-x) mod p = - x](mod p)" by (metis cong_def minus_mod_self1 mod_mod_trivial) then have "[prod ((\x. x mod p) \ ((-) p)) E = prod (uminus) E](mod p)" @@ -356,7 +346,7 @@ by simp then have "[prod id A = ((-1)^(card E) * a^(card A) * prod id A)](mod p)" by (rule cong_trans) - (simp add: cong_scalar_left cong_scalar_right finite_A prod_constant ac_simps) + (simp add: cong_scalar_left cong_scalar_right finite_A ac_simps) then have a: "[prod id A * (-1)^(card E) = ((-1)^(card E) * a^(card A) * prod id A * (-1)^(card E))](mod p)" by (rule cong_scalar_right) diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/Relation.thy --- a/src/HOL/Relation.thy Thu Oct 13 11:22:32 2022 +0200 +++ b/src/HOL/Relation.thy Thu Oct 13 14:49:15 2022 +0200 @@ -173,7 +173,7 @@ unfolding refl_on_def by (iprover intro!: ballI) lemma reflp_onI: - "(\x y. x \ A \ R x x) \ reflp_on A R" + "(\x. x \ A \ R x x) \ reflp_on A R" by (simp add: reflp_on_def) lemma reflpI[intro?]: "(\x. R x x) \ reflp R" @@ -256,6 +256,12 @@ lemma reflp_mono: "reflp R \ (\x y. R x y \ Q x y) \ reflp Q" by (rule reflp_on_mono[of UNIV R Q]) simp_all +lemma (in preorder) reflp_le[simp]: "reflp (\)" + by (simp add: reflpI) + +lemma (in preorder) reflp_ge[simp]: "reflp (\)" + by (simp add: reflpI) + subsubsection \Irreflexivity\ @@ -274,6 +280,12 @@ lemma irreflpI [intro?]: "(\a. \ R a a) \ irreflp R" by (fact irreflI [to_pred]) +lemma irreflD: "irrefl r \ (x, x) \ r" + unfolding irrefl_def by simp + +lemma irreflpD: "irreflp R \ \ R x x" + unfolding irreflp_def by simp + lemma irrefl_distinct [code]: "irrefl r \ (\(a, b) \ r. a \ b)" by (auto simp add: irrefl_def) @@ -423,6 +435,24 @@ "antisym {x}" by (blast intro: antisymI) +lemma antisym_if_asym: "asym r \ antisym r" + by (auto intro: antisymI elim: asym.cases) + +lemma antisymp_if_asymp: "asymp R \ antisymp R" + by (rule antisym_if_asym[to_pred]) + +lemma (in preorder) antisymp_less[simp]: "antisymp (<)" + by (rule antisymp_if_asymp[OF asymp_less]) + +lemma (in preorder) antisymp_greater[simp]: "antisymp (>)" + by (rule antisymp_if_asymp[OF asymp_greater]) + +lemma (in order) antisymp_le[simp]: "antisymp (\)" + by (simp add: antisympI) + +lemma (in order) antisymp_ge[simp]: "antisymp (\)" + by (simp add: antisympI) + subsubsection \Transitivity\ @@ -555,10 +585,13 @@ by (simp add: total_on_def) lemma totalp_on_empty [simp]: "totalp_on {} R" - by (auto intro: totalp_onI) + by (simp add: totalp_on_def) -lemma total_on_singleton [simp]: "total_on {x} {(x, x)}" - unfolding total_on_def by blast +lemma total_on_singleton [simp]: "total_on {x} r" + by (simp add: total_on_def) + +lemma totalp_on_singleton [simp]: "totalp_on {x} R" + by (simp add: totalp_on_def) subsubsection \Single valued relations\ diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/Set.thy --- a/src/HOL/Set.thy Thu Oct 13 11:22:32 2022 +0200 +++ b/src/HOL/Set.thy Thu Oct 13 14:49:15 2022 +0200 @@ -952,6 +952,16 @@ lemma image_add_0 [simp]: "(+) (0::'a::comm_monoid_add) ` S = S" by auto +theorem Cantors_paradox: "\f. f ` A = Pow A" +proof + assume "\f. f ` A = Pow A" + then obtain f where f: "f ` A = Pow A" .. + let ?X = "{a \ A. a \ f a}" + have "?X \ Pow A" by blast + then have "?X \ f ` A" by (simp only: f) + then obtain x where "x \ A" and "f x = ?X" by blast + then show False by blast +qed text \\<^medskip> Range of a function -- just an abbreviation for image!\ diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/Wellfounded.thy --- a/src/HOL/Wellfounded.thy Thu Oct 13 11:22:32 2022 +0200 +++ b/src/HOL/Wellfounded.thy Thu Oct 13 14:49:15 2022 +0200 @@ -772,7 +772,35 @@ by (clarsimp simp: inv_image_def wf_eq_minimal) qed -text \Measure functions into \<^typ>\nat\\ + +subsubsection \Conversion to a known well-founded relation\ + +lemma wf_if_convertible_to_wf: + fixes r :: "'a rel" and s :: "'b rel" and f :: "'a \ 'b" + assumes "wf s" and convertible: "\x y. (x, y) \ r \ (f x, f y) \ s" + shows "wf r" +proof (rule wfI_min[of r]) + fix x :: 'a and Q :: "'a set" + assume "x \ Q" + then obtain y where "y \ Q" and "\z. (f z, f y) \ s \ z \ Q" + by (auto elim: wfE_min[OF wf_inv_image[of s f, OF \wf s\], unfolded in_inv_image]) + thus "\z \ Q. \y. (y, z) \ r \ y \ Q" + by (auto intro: convertible) +qed + +lemma wfP_if_convertible_to_wfP: "wfP S \ (\x y. R x y \ S (f x) (f y)) \ wfP R" + using wf_if_convertible_to_wf[to_pred, of S R f] by simp + +text \Converting to @{typ nat} is a very common special case that might be found more easily by + Sledgehammer.\ + +lemma wfP_if_convertible_to_nat: + fixes f :: "_ \ nat" + shows "(\x y. R x y \ f x < f y) \ wfP R" + by (rule wfP_if_convertible_to_wfP[of "(<) :: nat \ nat \ bool", simplified]) + + +subsubsection \Measure functions into \<^typ>\nat\\ definition measure :: "('a \ nat) \ ('a \ 'a) set" where "measure = inv_image less_than" diff -r 2d4ff8c166d2 -r e381884c09d4 src/HOL/ex/Note_on_signed_division_on_words.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/ex/Note_on_signed_division_on_words.thy Thu Oct 13 14:49:15 2022 +0200 @@ -0,0 +1,50 @@ +theory Note_on_signed_division_on_words + imports "HOL-Library.Word" "HOL-Library.Rounded_Division" +begin + +unbundle bit_operations_syntax + +context semiring_bit_operations +begin + +lemma take_bit_Suc_from_most: + \take_bit (Suc n) a = 2 ^ n * of_bool (bit a n) OR take_bit n a\ + by (rule bit_eqI) (auto simp add: bit_simps less_Suc_eq) + +end + +context ring_bit_operations +begin + +lemma signed_take_bit_exp_eq_int: + \signed_take_bit m (2 ^ n) = + (if n < m then 2 ^ n else if n = m then - (2 ^ n) else 0)\ + by (rule bit_eqI) (auto simp add: bit_simps simp flip: mask_eq_exp_minus_1) + +end + +lift_definition signed_divide_word :: \'a::len word \ 'a word \ 'a word\ (infixl \wdiv\ 70) + is \\a b. signed_take_bit (LENGTH('a) - Suc 0) a rdiv signed_take_bit (LENGTH('a) - Suc 0) b\ + by (simp flip: signed_take_bit_decr_length_iff) + +lift_definition signed_modulo_word :: \'a::len word \ 'a word \ 'a word\ (infixl \wmod\ 70) + is \\a b. signed_take_bit (LENGTH('a) - Suc 0) a rmod signed_take_bit (LENGTH('a) - Suc 0) b\ + by (simp flip: signed_take_bit_decr_length_iff) + +lemma signed_take_bit_eq_wmod: + \signed_take_bit n w = w wmod (2 ^ Suc n)\ +proof (transfer fixing: n) + show \take_bit LENGTH('a) (signed_take_bit n (take_bit LENGTH('a) k)) = + take_bit LENGTH('a) (signed_take_bit (LENGTH('a) - Suc 0) k rmod signed_take_bit (LENGTH('a) - Suc 0) (2 ^ Suc n))\ for k :: int + proof (cases \LENGTH('a) = Suc (Suc n)\) + case True + then show ?thesis + by (simp add: signed_take_bit_exp_eq_int signed_take_bit_take_bit rmod_minus_eq flip: power_Suc signed_take_bit_eq_rmod) + next + case False + then show ?thesis + by (auto simp add: signed_take_bit_exp_eq_int signed_take_bit_take_bit take_bit_signed_take_bit simp flip: power_Suc signed_take_bit_eq_rmod) + qed +qed + +end diff -r 2d4ff8c166d2 -r e381884c09d4 src/Pure/Admin/isabelle_cronjob.scala --- a/src/Pure/Admin/isabelle_cronjob.scala Thu Oct 13 11:22:32 2022 +0200 +++ b/src/Pure/Admin/isabelle_cronjob.scala Thu Oct 13 14:49:15 2022 +0200 @@ -344,7 +344,7 @@ options = "-m32 -M4 -t skip_proofs -p pide_session=false", args = "-a -o skip_proofs", detect = Build_Log.Prop.build_tags.toString + " = " + SQL.string("skip_proofs"))), List( - Remote_Build("macOS 10.15 Catalina", "monterey", user = "makarius", + Remote_Build("macOS 12 Monterey", "monterey", user = "makarius", options = "-m32 -M4 -e ISABELLE_GHC_SETUP=true -p pide_session=false", args = "-a -d '~~/src/Benchmarks'")), List(