# HG changeset patch # User wenzelm # Date 1732303296 -3600 # Node ID 60696404b40a29d6011ecc6a1b5afc3a21740ee8 # Parent 53e61087bc6f4f5b3bd568fa58d67c508bbe2c0e# Parent d421a7c58530e71c15bd143bd114d7fcaffdc1f0 merged diff -r d421a7c58530 -r 60696404b40a Admin/build/TUM.toml --- a/Admin/build/TUM.toml Thu Nov 21 23:07:06 2024 +0100 +++ b/Admin/build/TUM.toml Fri Nov 22 20:21:36 2024 +0100 @@ -1,11 +1,11 @@ # Build cluster resources at TUM [host.lxbroy10] -hostname = "lxbroy10.informatik.tu-muenchen.de" +hostname = "lxbroy10.in.tum.de" numa = true [host.vmnipkow9] -hostname = "vmnipkow9.informatik.tu-muenchen.de" +hostname = "vmnipkow9.in.tum.de" [host.mini1] hostname = "131.159.47.71" diff -r d421a7c58530 -r 60696404b40a Admin/etc/options --- a/Admin/etc/options Thu Nov 21 23:07:06 2024 +0100 +++ b/Admin/etc/options Fri Nov 22 20:21:36 2024 +0100 @@ -2,7 +2,7 @@ section "Admin tools" -option isabelle_components_server : string = "lxbroy10.informatik.tu-muenchen.de" +option isabelle_components_server : string = "lxbroy10.in.tum.de" -- "user@host for SSH connection" option isabelle_components_dir : string = "/p/home/isabelle/components" diff -r d421a7c58530 -r 60696404b40a NEWS --- a/NEWS Thu Nov 21 23:07:06 2024 +0100 +++ b/NEWS Fri Nov 22 20:21:36 2024 +0100 @@ -187,6 +187,11 @@ This outputs a suggestion with instantiations of the facts using the "of" attribute (e.g. "assms(1)[of x]"). +* Theory "HOL-Library/Discrete" has been renamed "HOL-Library/Discrete_Functions" + Discrete.log -> floor_log + Discrete.sqrt -> floor_sqrt + Renamed lemmas accordingly (...log/sqrt... -> ...floor_log/sqrt...) + * Theory "HOL.Wellfounded": - Removed lemma wellorder.wfP_less. Use wellorder.wfp_on_less instead. Minor INCOMPATIBILITY. diff -r d421a7c58530 -r 60696404b40a src/HOL/Analysis/Cartesian_Space.thy --- a/src/HOL/Analysis/Cartesian_Space.thy Thu Nov 21 23:07:06 2024 +0100 +++ b/src/HOL/Analysis/Cartesian_Space.thy Fri Nov 22 20:21:36 2024 +0100 @@ -353,11 +353,6 @@ shows "invertible (transpose A)" by (meson assms invertible_def matrix_left_right_inverse right_invertible_transpose) -lemma vector_matrix_mul_assoc: - fixes v :: "('a::comm_semiring_1)^'n" - shows "(v v* M) v* N = v v* (M ** N)" - by (metis (no_types, opaque_lifting) matrix_transpose_mul matrix_vector_mul_assoc transpose_matrix_vector) - lemma matrix_scaleR_vector_ac: fixes A :: "real^('m::finite)^'n" shows "A *v (k *\<^sub>R v) = k *\<^sub>R A *v v" diff -r d421a7c58530 -r 60696404b40a src/HOL/Analysis/Finite_Cartesian_Product.thy --- a/src/HOL/Analysis/Finite_Cartesian_Product.thy Thu Nov 21 23:07:06 2024 +0100 +++ b/src/HOL/Analysis/Finite_Cartesian_Product.thy Fri Nov 22 20:21:36 2024 +0100 @@ -986,7 +986,7 @@ definition\<^marker>\tag important\ vector_matrix_mult :: "'a ^ 'm \ ('a::semiring_1) ^'n^'m \ 'a ^'n " (infixl \v*\ 70) - where "v v* m == (\ j. sum (\i. ((m$i)$j) * (v$i)) (UNIV :: 'm set)) :: 'a^'n" + where "v v* m == (\ j. sum (\i. ((v$i) * (m$i)$j)) (UNIV :: 'm set)) :: 'a^'n" definition\<^marker>\tag unimportant\ "(mat::'a::zero => 'a ^'n^'n) k = (\ i j. if i = j then k else 0)" definition\<^marker>\tag unimportant\ transpose where @@ -1018,25 +1018,26 @@ unfolding matrix_matrix_mult_def mat_def by (auto simp: if_distrib if_distribR sum.delta'[OF finite] cong: if_cong) -proposition matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C" +lemma matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C" apply (vector matrix_matrix_mult_def sum_distrib_left sum_distrib_right mult.assoc) - apply (subst sum.swap) - apply simp - done + using sum.swap by fastforce -proposition matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x" +lemma matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x" apply (vector matrix_matrix_mult_def matrix_vector_mult_def sum_distrib_left sum_distrib_right mult.assoc) - apply (subst sum.swap) - apply simp - done + using sum.swap by fastforce -proposition scalar_matrix_assoc: +lemma vector_matrix_mul_assoc: "(x v* A) v* B = x v* (A**B)" + apply (vector matrix_matrix_mult_def vector_matrix_mult_def + sum_distrib_left sum_distrib_right mult.assoc) + using sum.swap by fastforce + +lemma scalar_matrix_assoc: fixes A :: "('a::real_algebra_1)^'m^'n" shows "k *\<^sub>R (A ** B) = (k *\<^sub>R A) ** B" by (simp add: matrix_matrix_mult_def sum_distrib_left mult_ac vec_eq_iff scaleR_sum_right) -proposition matrix_scalar_ac: +lemma matrix_scalar_ac: fixes A :: "('a::real_algebra_1)^'m^'n" shows "A ** (k *\<^sub>R B) = k *\<^sub>R A ** B" by (simp add: matrix_matrix_mult_def sum_distrib_left mult_ac vec_eq_iff) @@ -1046,6 +1047,13 @@ apply (simp add: if_distrib if_distribR cong del: if_weak_cong) done +lemma vector_matrix_mul_rid [simp]: + fixes v :: "('a::semiring_1)^'n" + shows "v v* mat 1 = v" + apply (vector vector_matrix_mult_def mat_def) + apply (simp add: if_distrib if_distribR cong del: if_weak_cong) + done + lemma matrix_transpose_mul: "transpose(A ** B) = transpose B ** transpose (A::'a::comm_semiring_1^_^_)" by (simp add: matrix_matrix_mult_def transpose_def vec_eq_iff mult.commute) @@ -1139,6 +1147,11 @@ unfolding vector_matrix_mult_def by (simp add: algebra_simps sum.distrib vec_eq_iff) +lemma vector_matrix_mult_diff_distrib [algebra_simps]: + fixes A :: "'a::ring_1^'n^'m" + shows "(x - y) v* A = x v* A - y v* A" + by (vector vector_matrix_mult_def sum_subtractf left_diff_distrib) + lemma matrix_vector_right_distrib [algebra_simps]: "A *v (x + y) = A *v x + A *v y" by (vector matrix_vector_mult_def sum.distrib distrib_left) @@ -1168,6 +1181,15 @@ shows "(A - B) *v x = (A *v x) - (B *v x)" by (vector matrix_vector_mult_def sum_subtractf left_diff_distrib) +lemma vector_matrix_mult_add_rdistrib [algebra_simps]: + "x v* (A + B) = (x v* A) + (x v* B)" + by (vector vector_matrix_mult_def sum.distrib distrib_left) + +lemma vector_matrix_mult_diff_rdistrib [algebra_simps]: + fixes A :: "'a :: ring_1^'n^'m" + shows "x v* (A - B) = (x v* A) - (x v* B)" + by (vector vector_matrix_mult_def sum_subtractf right_diff_distrib) + lemma matrix_vector_column: "(A::'a::comm_semiring_1^'n^_) *v x = sum (\i. (x$i) *s ((transpose A)$i)) (UNIV:: 'n set)" by (simp add: matrix_vector_mult_def transpose_def vec_eq_iff mult.commute) @@ -1201,19 +1223,19 @@ unfolding invertible_def by auto qed -proposition scalar_invertible_iff: +lemma scalar_invertible_iff: fixes A :: "('a::real_algebra_1)^'m^'n" assumes "k \ 0" and "invertible A" shows "invertible (k *\<^sub>R A) \ k \ 0 \ invertible A" by (simp add: assms scalar_invertible) -lemma vector_transpose_matrix [simp]: "x v* transpose A = A *v x" +lemma vector_transpose_matrix [simp]: "x v* transpose A = A *v (x:: 'a::{comm_semiring_1}^'n)" unfolding transpose_def vector_matrix_mult_def matrix_vector_mult_def - by simp + by (simp add: mult.commute) -lemma transpose_matrix_vector [simp]: "transpose A *v x = x v* A" +lemma transpose_matrix_vector [simp]: "transpose A *v x = x v* (A:: 'a::{comm_semiring_1}^'m^'n)" unfolding transpose_def vector_matrix_mult_def matrix_vector_mult_def - by simp + by (simp add: mult.commute) lemma vector_scalar_commute: fixes A :: "'a::{field}^'m^'n" @@ -1231,23 +1253,17 @@ lemma vector_matrix_mult_0_right [simp]: "x v* 0 = 0" unfolding vector_matrix_mult_def by (simp add: zero_vec_def) -lemma vector_matrix_mul_rid [simp]: - fixes v :: "('a::semiring_1)^'n" - shows "v v* mat 1 = v" - by (metis matrix_vector_mul_lid transpose_mat vector_transpose_matrix) - lemma scaleR_vector_matrix_assoc: fixes k :: real and x :: "real^'n" and A :: "real^'m^'n" shows "(k *\<^sub>R x) v* A = k *\<^sub>R (x v* A)" by (metis matrix_vector_mult_scaleR transpose_matrix_vector) -proposition vector_scaleR_matrix_ac: +lemma vector_scaleR_matrix_ac: fixes k :: real and x :: "real^'n" and A :: "real^'m^'n" shows "x v* (k *\<^sub>R A) = k *\<^sub>R (x v* A)" proof - have "x v* (k *\<^sub>R A) = (k *\<^sub>R x) v* A" - unfolding vector_matrix_mult_def - by (simp add: algebra_simps) + by (simp add: vector_matrix_mult_def algebra_simps) with scaleR_vector_matrix_assoc show "x v* (k *\<^sub>R A) = k *\<^sub>R (x v* A)" by auto diff -r d421a7c58530 -r 60696404b40a src/HOL/Analysis/Summation_Tests.thy --- a/src/HOL/Analysis/Summation_Tests.thy Thu Nov 21 23:07:06 2024 +0100 +++ b/src/HOL/Analysis/Summation_Tests.thy Fri Nov 22 20:21:36 2024 +0100 @@ -7,7 +7,7 @@ theory Summation_Tests imports Complex_Main - "HOL-Library.Discrete" + "HOL-Library.Discrete_Functions" "HOL-Library.Extended_Real" "HOL-Library.Liminf_Limsup" Extended_Real_Limits @@ -135,33 +135,33 @@ private lemma condensation_inequality: assumes mono: "\m n. 0 < m \ m \ n \ f n \ f m" - shows "(\k=1.. (\k=1..k=1.. (\k=1..k=1.. (\k=1..k=1.. (\k=1..k=1..<2^n. f (2 ^ Discrete.log k)) = (\kk=1..<2^n. f (2 ^ floor_log k)) = (\k {2^n..<(2^Suc n :: nat)}" by auto - also have "(\k\\. f (2 ^ Discrete.log k)) = - (\kk = 2^n..<2^Suc n. f (2^Discrete.log k))" + also have "(\k\\. f (2 ^ floor_log k)) = + (\kk = 2^n..<2^Suc n. f (2^floor_log k))" by (subst sum.union_disjoint) (insert Suc, auto) - also have "Discrete.log k = n" if "k \ {2^n..<2^Suc n}" for k using that by (intro Discrete.log_eqI) simp_all - hence "(\k = 2^n..<2^Suc n. f (2^Discrete.log k)) = (\(_::nat) = 2^n..<2^Suc n. f (2^n))" + also have "floor_log k = n" if "k \ {2^n..<2^Suc n}" for k using that by (intro floor_log_eqI) simp_all + hence "(\k = 2^n..<2^Suc n. f (2^floor_log k)) = (\(_::nat) = 2^n..<2^Suc n. f (2^n))" by (intro sum.cong) simp_all also have "\ = 2^n * f (2^n)" by (simp) finally show ?case by simp qed simp -private lemma condensation_condense2: "(\k=1..<2^n. f (2 * 2 ^ Discrete.log k)) = (\kk=1..<2^n. f (2 * 2 ^ floor_log k)) = (\k {2^n..<(2^Suc n :: nat)}" by auto - also have "(\k\\. f (2 * 2 ^ Discrete.log k)) = - (\kk = 2^n..<2^Suc n. f (2 * 2^Discrete.log k))" + also have "(\k\\. f (2 * 2 ^ floor_log k)) = + (\kk = 2^n..<2^Suc n. f (2 * 2^floor_log k))" by (subst sum.union_disjoint) (insert Suc, auto) - also have "Discrete.log k = n" if "k \ {2^n..<2^Suc n}" for k using that by (intro Discrete.log_eqI) simp_all - hence "(\k = 2^n..<2^Suc n. f (2*2^Discrete.log k)) = (\(_::nat) = 2^n..<2^Suc n. f (2^Suc n))" + also have "floor_log k = n" if "k \ {2^n..<2^Suc n}" for k using that by (intro floor_log_eqI) simp_all + hence "(\k = 2^n..<2^Suc n. f (2*2^floor_log k)) = (\(_::nat) = 2^n..<2^Suc n. f (2^Suc n))" by (intro sum.cong) simp_all also have "\ = 2^n * f (2^Suc n)" by (simp) finally show ?case by simp diff -r d421a7c58530 -r 60696404b40a src/HOL/Computational_Algebra/Nth_Powers.thy --- a/src/HOL/Computational_Algebra/Nth_Powers.thy Thu Nov 21 23:07:06 2024 +0100 +++ b/src/HOL/Computational_Algebra/Nth_Powers.thy Fri Nov 22 20:21:36 2024 +0100 @@ -155,7 +155,7 @@ by (auto simp: is_nth_power_nat_def is_nth_power_def power_eq_iff_eq_base self_le_power) -(* TODO: Harmonise with Discrete.sqrt *) +(* TODO: Harmonise with Discrete_Functions.floor_sqrt *) subsection \The $n$-root of a natural number\ diff -r d421a7c58530 -r 60696404b40a src/HOL/Hilbert_Choice.thy --- a/src/HOL/Hilbert_Choice.thy Thu Nov 21 23:07:06 2024 +0100 +++ b/src/HOL/Hilbert_Choice.thy Fri Nov 22 20:21:36 2024 +0100 @@ -147,6 +147,34 @@ qed +subsection \Getting an element of a nonempty set\ + +definition some_elem :: "'a set \ 'a" + where "some_elem A = (SOME x. x \ A)" + +lemma some_elem_eq [simp]: "some_elem {x} = x" + by (simp add: some_elem_def) + +lemma some_elem_nonempty: "A \ {} \ some_elem A \ A" + unfolding some_elem_def by (auto intro: someI) + +lemma is_singleton_some_elem: "is_singleton A \ A = {some_elem A}" + by (auto simp: is_singleton_def) + +lemma some_elem_image_unique: + assumes "A \ {}" + and *: "\y. y \ A \ f y = a" + shows "some_elem (f ` A) = a" + unfolding some_elem_def +proof (rule some1_equality) + from \A \ {}\ obtain y where "y \ A" by auto + with * \y \ A\ have "a \ f ` A" by blast + then show "a \ f ` A" by auto + with * show "\!x. x \ f ` A" + by auto +qed + + subsection \Function Inverse\ lemma inv_def: "inv f = (\y. SOME x. f x = y)" diff -r d421a7c58530 -r 60696404b40a src/HOL/Library/Discrete.thy --- a/src/HOL/Library/Discrete.thy Thu Nov 21 23:07:06 2024 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,349 +0,0 @@ -(* Author: Florian Haftmann, TU Muenchen *) - -section \Common discrete functions\ - -theory Discrete -imports Complex_Main -begin - -subsection \Discrete logarithm\ - -context -begin - -qualified fun log :: "nat \ nat" - where [simp del]: "log n = (if n < 2 then 0 else Suc (log (n div 2)))" - -lemma log_induct [consumes 1, case_names one double]: - fixes n :: nat - assumes "n > 0" - assumes one: "P 1" - assumes double: "\n. n \ 2 \ P (n div 2) \ P n" - shows "P n" -using \n > 0\ proof (induct n rule: log.induct) - fix n - assume "\ n < 2 \ - 0 < n div 2 \ P (n div 2)" - then have *: "n \ 2 \ P (n div 2)" by simp - assume "n > 0" - show "P n" - proof (cases "n = 1") - case True - with one show ?thesis by simp - next - case False - with \n > 0\ have "n \ 2" by auto - with * have "P (n div 2)" . - with \n \ 2\ show ?thesis by (rule double) - qed -qed - -lemma log_zero [simp]: "log 0 = 0" - by (simp add: log.simps) - -lemma log_one [simp]: "log 1 = 0" - by (simp add: log.simps) - -lemma log_Suc_zero [simp]: "log (Suc 0) = 0" - using log_one by simp - -lemma log_rec: "n \ 2 \ log n = Suc (log (n div 2))" - by (simp add: log.simps) - -lemma log_twice [simp]: "n \ 0 \ log (2 * n) = Suc (log n)" - by (simp add: log_rec) - -lemma log_half [simp]: "log (n div 2) = log n - 1" -proof (cases "n < 2") - case True - then have "n = 0 \ n = 1" by arith - then show ?thesis by (auto simp del: One_nat_def) -next - case False - then show ?thesis by (simp add: log_rec) -qed - -lemma log_power [simp]: "log (2 ^ n) = n" - by (induct n) simp_all - -lemma log_mono: "mono log" -proof - fix m n :: nat - assume "m \ n" - then show "log m \ log n" - proof (induct m arbitrary: n rule: log.induct) - case (1 m) - then have mn2: "m div 2 \ n div 2" by arith - show "log m \ log n" - proof (cases "m \ 2") - case False - then have "m = 0 \ m = 1" by arith - then show ?thesis by (auto simp del: One_nat_def) - next - case True then have "\ m < 2" by simp - with mn2 have "n \ 2" by arith - from True have m2_0: "m div 2 \ 0" by arith - with mn2 have n2_0: "n div 2 \ 0" by arith - from \\ m < 2\ "1.hyps" mn2 have "log (m div 2) \ log (n div 2)" by blast - with m2_0 n2_0 have "log (2 * (m div 2)) \ log (2 * (n div 2))" by simp - with m2_0 n2_0 \m \ 2\ \n \ 2\ show ?thesis by (simp only: log_rec [of m] log_rec [of n]) simp - qed - qed -qed - -lemma log_exp2_le: - assumes "n > 0" - shows "2 ^ log n \ n" - using assms -proof (induct n rule: log_induct) - case one - then show ?case by simp -next - case (double n) - with log_mono have "log n \ Suc 0" - by (simp add: log.simps) - assume "2 ^ log (n div 2) \ n div 2" - with \n \ 2\ have "2 ^ (log n - Suc 0) \ n div 2" by simp - then have "2 ^ (log n - Suc 0) * 2 ^ 1 \ n div 2 * 2" by simp - with \log n \ Suc 0\ have "2 ^ log n \ n div 2 * 2" - unfolding power_add [symmetric] by simp - also have "n div 2 * 2 \ n" by (cases "even n") simp_all - finally show ?case . -qed - -lemma log_exp2_gt: "2 * 2 ^ log n > n" -proof (cases "n > 0") - case True - thus ?thesis - proof (induct n rule: log_induct) - case (double n) - thus ?case - by (cases "even n") (auto elim!: evenE oddE simp: field_simps log.simps) - qed simp_all -qed simp_all - -lemma log_exp2_ge: "2 * 2 ^ log n \ n" - using log_exp2_gt[of n] by simp - -lemma log_le_iff: "m \ n \ log m \ log n" - by (rule monoD [OF log_mono]) - -lemma log_eqI: - assumes "n > 0" "2^k \ n" "n < 2 * 2^k" - shows "log n = k" -proof (rule antisym) - from \n > 0\ have "2 ^ log n \ n" by (rule log_exp2_le) - also have "\ < 2 ^ Suc k" using assms by simp - finally have "log n < Suc k" by (subst (asm) power_strict_increasing_iff) simp_all - thus "log n \ k" by simp -next - have "2^k \ n" by fact - also have "\ < 2^(Suc (log n))" by (simp add: log_exp2_gt) - finally have "k < Suc (log n)" by (subst (asm) power_strict_increasing_iff) simp_all - thus "k \ log n" by simp -qed - -lemma log_altdef: "log n = (if n = 0 then 0 else nat \Transcendental.log 2 (real_of_nat n)\)" -proof (cases "n = 0") - case False - have "\Transcendental.log 2 (real_of_nat n)\ = int (log n)" - proof (rule floor_unique) - from False have "2 powr (real (log n)) \ real n" - by (simp add: powr_realpow log_exp2_le) - hence "Transcendental.log 2 (2 powr (real (log n))) \ Transcendental.log 2 (real n)" - using False by (subst Transcendental.log_le_cancel_iff) simp_all - also have "Transcendental.log 2 (2 powr (real (log n))) = real (log n)" by simp - finally show "real_of_int (int (log n)) \ Transcendental.log 2 (real n)" by simp - next - have "real n < real (2 * 2 ^ log n)" - by (subst of_nat_less_iff) (rule log_exp2_gt) - also have "\ = 2 powr (real (log n) + 1)" - by (simp add: powr_add powr_realpow) - finally have "Transcendental.log 2 (real n) < Transcendental.log 2 \" - using False by (subst Transcendental.log_less_cancel_iff) simp_all - also have "\ = real (log n) + 1" by simp - finally show "Transcendental.log 2 (real n) < real_of_int (int (log n)) + 1" by simp - qed - thus ?thesis by simp -qed simp_all - - -subsection \Discrete square root\ - -qualified definition sqrt :: "nat \ nat" - where "sqrt n = Max {m. m\<^sup>2 \ n}" - -lemma sqrt_aux: - fixes n :: nat - shows "finite {m. m\<^sup>2 \ n}" and "{m. m\<^sup>2 \ n} \ {}" -proof - - have **: "m \ n" if "m\<^sup>2 \ n" for m - using that by (cases m) (simp_all add: power2_eq_square) - then have "{m. m\<^sup>2 \ n} \ {m. m \ n}" by auto - then show "finite {m. m\<^sup>2 \ n}" by (rule finite_subset) rule - have "0\<^sup>2 \ n" by simp - then show *: "{m. m\<^sup>2 \ n} \ {}" by blast -qed - -lemma sqrt_unique: - assumes "m^2 \ n" "n < (Suc m)^2" - shows "Discrete.sqrt n = m" -proof - - have "m' \ m" if "m'^2 \ n" for m' - proof - - note that - also note assms(2) - finally have "m' < Suc m" by (rule power_less_imp_less_base) simp_all - thus "m' \ m" by simp - qed - with \m^2 \ n\ sqrt_aux[of n] show ?thesis unfolding Discrete.sqrt_def - by (intro antisym Max.boundedI Max.coboundedI) simp_all -qed - - -lemma sqrt_code[code]: "sqrt n = Max (Set.filter (\m. m\<^sup>2 \ n) {0..n})" -proof - - from power2_nat_le_imp_le [of _ n] have "{m. m \ n \ m\<^sup>2 \ n} = {m. m\<^sup>2 \ n}" by auto - then show ?thesis by (simp add: sqrt_def Set.filter_def) -qed - -lemma sqrt_inverse_power2 [simp]: "sqrt (n\<^sup>2) = n" -proof - - have "{m. m \ n} \ {}" by auto - then have "Max {m. m \ n} \ n" by auto - then show ?thesis - by (auto simp add: sqrt_def power2_nat_le_eq_le intro: antisym) -qed - -lemma sqrt_zero [simp]: "sqrt 0 = 0" - using sqrt_inverse_power2 [of 0] by simp - -lemma sqrt_one [simp]: "sqrt 1 = 1" - using sqrt_inverse_power2 [of 1] by simp - -lemma mono_sqrt: "mono sqrt" -proof - fix m n :: nat - have *: "0 * 0 \ m" by simp - assume "m \ n" - then show "sqrt m \ sqrt n" - by (auto intro!: Max_mono \0 * 0 \ m\ finite_less_ub simp add: power2_eq_square sqrt_def) -qed - -lemma mono_sqrt': "m \ n \ Discrete.sqrt m \ Discrete.sqrt n" - using mono_sqrt unfolding mono_def by auto - -lemma sqrt_greater_zero_iff [simp]: "sqrt n > 0 \ n > 0" -proof - - have *: "0 < Max {m. m\<^sup>2 \ n} \ (\a\{m. m\<^sup>2 \ n}. 0 < a)" - by (rule Max_gr_iff) (fact sqrt_aux)+ - show ?thesis - proof - assume "0 < sqrt n" - then have "0 < Max {m. m\<^sup>2 \ n}" by (simp add: sqrt_def) - with * show "0 < n" by (auto dest: power2_nat_le_imp_le) - next - assume "0 < n" - then have "1\<^sup>2 \ n \ 0 < (1::nat)" by simp - then have "\q. q\<^sup>2 \ n \ 0 < q" .. - with * have "0 < Max {m. m\<^sup>2 \ n}" by blast - then show "0 < sqrt n" by (simp add: sqrt_def) - qed -qed - -lemma sqrt_power2_le [simp]: "(sqrt n)\<^sup>2 \ n" (* FIXME tune proof *) -proof (cases "n > 0") - case False then show ?thesis by simp -next - case True then have "sqrt n > 0" by simp - then have "mono (times (Max {m. m\<^sup>2 \ n}))" by (auto intro: mono_times_nat simp add: sqrt_def) - then have *: "Max {m. m\<^sup>2 \ n} * Max {m. m\<^sup>2 \ n} = Max (times (Max {m. m\<^sup>2 \ n}) ` {m. m\<^sup>2 \ n})" - using sqrt_aux [of n] by (rule mono_Max_commute) - have "\a. a * a \ n \ Max {m. m * m \ n} * a \ n" - proof - - fix q - assume "q * q \ n" - show "Max {m. m * m \ n} * q \ n" - proof (cases "q > 0") - case False then show ?thesis by simp - next - case True then have "mono (times q)" by (rule mono_times_nat) - then have "q * Max {m. m * m \ n} = Max (times q ` {m. m * m \ n})" - using sqrt_aux [of n] by (auto simp add: power2_eq_square intro: mono_Max_commute) - then have "Max {m. m * m \ n} * q = Max (times q ` {m. m * m \ n})" by (simp add: ac_simps) - moreover have "finite ((*) q ` {m. m * m \ n})" - by (metis (mono_tags) finite_imageI finite_less_ub le_square) - moreover have "\x. x * x \ n" - by (metis \q * q \ n\) - ultimately show ?thesis - by simp (metis \q * q \ n\ le_cases mult_le_mono1 mult_le_mono2 order_trans) - qed - qed - then have "Max ((*) (Max {m. m * m \ n}) ` {m. m * m \ n}) \ n" - apply (subst Max_le_iff) - apply (metis (mono_tags) finite_imageI finite_less_ub le_square) - apply auto - apply (metis le0 mult_0_right) - done - with * show ?thesis by (simp add: sqrt_def power2_eq_square) -qed - -lemma sqrt_le: "sqrt n \ n" - using sqrt_aux [of n] by (auto simp add: sqrt_def intro: power2_nat_le_imp_le) - -text \Additional facts about the discrete square root, thanks to Julian Biendarra, Manuel Eberl\ - -lemma Suc_sqrt_power2_gt: "n < (Suc (Discrete.sqrt n))^2" - using Max_ge[OF Discrete.sqrt_aux(1), of "Discrete.sqrt n + 1" n] - by (cases "n < (Suc (Discrete.sqrt n))^2") (simp_all add: Discrete.sqrt_def) - -lemma le_sqrt_iff: "x \ Discrete.sqrt y \ x^2 \ y" -proof - - have "x \ Discrete.sqrt y \ (\z. z\<^sup>2 \ y \ x \ z)" - using Max_ge_iff[OF Discrete.sqrt_aux, of x y] by (simp add: Discrete.sqrt_def) - also have "\ \ x^2 \ y" - proof safe - fix z assume "x \ z" "z ^ 2 \ y" - thus "x^2 \ y" by (intro le_trans[of "x^2" "z^2" y]) (simp_all add: power2_nat_le_eq_le) - qed auto - finally show ?thesis . -qed - -lemma le_sqrtI: "x^2 \ y \ x \ Discrete.sqrt y" - by (simp add: le_sqrt_iff) - -lemma sqrt_le_iff: "Discrete.sqrt y \ x \ (\z. z^2 \ y \ z \ x)" - using Max.bounded_iff[OF Discrete.sqrt_aux] by (simp add: Discrete.sqrt_def) - -lemma sqrt_leI: - "(\z. z^2 \ y \ z \ x) \ Discrete.sqrt y \ x" - by (simp add: sqrt_le_iff) - -lemma sqrt_Suc: - "Discrete.sqrt (Suc n) = (if \m. Suc n = m^2 then Suc (Discrete.sqrt n) else Discrete.sqrt n)" -proof cases - assume "\ m. Suc n = m^2" - then obtain m where m_def: "Suc n = m^2" by blast - then have lhs: "Discrete.sqrt (Suc n) = m" by simp - from m_def sqrt_power2_le[of n] - have "(Discrete.sqrt n)^2 < m^2" by linarith - with power2_less_imp_less have lt_m: "Discrete.sqrt n < m" by blast - from m_def Suc_sqrt_power2_gt[of "n"] - have "m^2 \ (Suc(Discrete.sqrt n))^2" - by linarith - with power2_nat_le_eq_le have "m \ Suc (Discrete.sqrt n)" by blast - with lt_m have "m = Suc (Discrete.sqrt n)" by simp - with lhs m_def show ?thesis by fastforce -next - assume asm: "\ (\ m. Suc n = m^2)" - hence "Suc n \ (Discrete.sqrt (Suc n))^2" by simp - with sqrt_power2_le[of "Suc n"] - have "Discrete.sqrt (Suc n) \ Discrete.sqrt n" by (intro le_sqrtI) linarith - moreover have "Discrete.sqrt (Suc n) \ Discrete.sqrt n" - by (intro monoD[OF mono_sqrt]) simp_all - ultimately show ?thesis using asm by simp -qed - -end - -end diff -r d421a7c58530 -r 60696404b40a src/HOL/Library/Discrete_Functions.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Library/Discrete_Functions.thy Fri Nov 22 20:21:36 2024 +0100 @@ -0,0 +1,344 @@ +(* Author: Florian Haftmann, TU Muenchen *) + +section \Common discrete functions\ + +theory Discrete_Functions +imports Complex_Main +begin + +subsection \Discrete logarithm\ + +fun floor_log :: "nat \ nat" + where [simp del]: "floor_log n = (if n < 2 then 0 else Suc (floor_log (n div 2)))" + +lemma floor_log_induct [consumes 1, case_names one double]: + fixes n :: nat + assumes "n > 0" + assumes one: "P 1" + assumes double: "\n. n \ 2 \ P (n div 2) \ P n" + shows "P n" +using \n > 0\ proof (induct n rule: floor_log.induct) + fix n + assume "\ n < 2 \ + 0 < n div 2 \ P (n div 2)" + then have *: "n \ 2 \ P (n div 2)" by simp + assume "n > 0" + show "P n" + proof (cases "n = 1") + case True + with one show ?thesis by simp + next + case False + with \n > 0\ have "n \ 2" by auto + with * have "P (n div 2)" . + with \n \ 2\ show ?thesis by (rule double) + qed +qed + +lemma floor_log_zero [simp]: "floor_log 0 = 0" + by (simp add: floor_log.simps) + +lemma floor_log_one [simp]: "floor_log 1 = 0" + by (simp add: floor_log.simps) + +lemma floor_log_Suc_zero [simp]: "floor_log (Suc 0) = 0" + using floor_log_one by simp + +lemma floor_log_rec: "n \ 2 \ floor_log n = Suc (floor_log (n div 2))" + by (simp add: floor_log.simps) + +lemma floor_log_twice [simp]: "n \ 0 \ floor_log (2 * n) = Suc (floor_log n)" + by (simp add: floor_log_rec) + +lemma floor_log_half [simp]: "floor_log (n div 2) = floor_log n - 1" +proof (cases "n < 2") + case True + then have "n = 0 \ n = 1" by arith + then show ?thesis by (auto simp del: One_nat_def) +next + case False + then show ?thesis by (simp add: floor_log_rec) +qed + +lemma floor_log_power [simp]: "floor_log (2 ^ n) = n" + by (induct n) simp_all + +lemma floor_log_mono: "mono floor_log" +proof + fix m n :: nat + assume "m \ n" + then show "floor_log m \ floor_log n" + proof (induct m arbitrary: n rule: floor_log.induct) + case (1 m) + then have mn2: "m div 2 \ n div 2" by arith + show "floor_log m \ floor_log n" + proof (cases "m \ 2") + case False + then have "m = 0 \ m = 1" by arith + then show ?thesis by (auto simp del: One_nat_def) + next + case True then have "\ m < 2" by simp + with mn2 have "n \ 2" by arith + from True have m2_0: "m div 2 \ 0" by arith + with mn2 have n2_0: "n div 2 \ 0" by arith + from \\ m < 2\ "1.hyps" mn2 have "floor_log (m div 2) \ floor_log (n div 2)" by blast + with m2_0 n2_0 have "floor_log (2 * (m div 2)) \ floor_log (2 * (n div 2))" by simp + with m2_0 n2_0 \m \ 2\ \n \ 2\ show ?thesis by (simp only: floor_log_rec [of m] floor_log_rec [of n]) simp + qed + qed +qed + +lemma floor_log_exp2_le: + assumes "n > 0" + shows "2 ^ floor_log n \ n" + using assms +proof (induct n rule: floor_log_induct) + case one + then show ?case by simp +next + case (double n) + with floor_log_mono have "floor_log n \ Suc 0" + by (simp add: floor_log.simps) + assume "2 ^ floor_log (n div 2) \ n div 2" + with \n \ 2\ have "2 ^ (floor_log n - Suc 0) \ n div 2" by simp + then have "2 ^ (floor_log n - Suc 0) * 2 ^ 1 \ n div 2 * 2" by simp + with \floor_log n \ Suc 0\ have "2 ^ floor_log n \ n div 2 * 2" + unfolding power_add [symmetric] by simp + also have "n div 2 * 2 \ n" by (cases "even n") simp_all + finally show ?case . +qed + +lemma floor_log_exp2_gt: "2 * 2 ^ floor_log n > n" +proof (cases "n > 0") + case True + thus ?thesis + proof (induct n rule: floor_log_induct) + case (double n) + thus ?case + by (cases "even n") (auto elim!: evenE oddE simp: field_simps floor_log.simps) + qed simp_all +qed simp_all + +lemma floor_log_exp2_ge: "2 * 2 ^ floor_log n \ n" + using floor_log_exp2_gt[of n] by simp + +lemma floor_log_le_iff: "m \ n \ floor_log m \ floor_log n" + by (rule monoD [OF floor_log_mono]) + +lemma floor_log_eqI: + assumes "n > 0" "2^k \ n" "n < 2 * 2^k" + shows "floor_log n = k" +proof (rule antisym) + from \n > 0\ have "2 ^ floor_log n \ n" by (rule floor_log_exp2_le) + also have "\ < 2 ^ Suc k" using assms by simp + finally have "floor_log n < Suc k" by (subst (asm) power_strict_increasing_iff) simp_all + thus "floor_log n \ k" by simp +next + have "2^k \ n" by fact + also have "\ < 2^(Suc (floor_log n))" by (simp add: floor_log_exp2_gt) + finally have "k < Suc (floor_log n)" by (subst (asm) power_strict_increasing_iff) simp_all + thus "k \ floor_log n" by simp +qed + +lemma floor_log_altdef: "floor_log n = (if n = 0 then 0 else nat \log 2 (real_of_nat n)\)" +proof (cases "n = 0") + case False + have "\log 2 (real_of_nat n)\ = int (floor_log n)" + proof (rule floor_unique) + from False have "2 powr (real (floor_log n)) \ real n" + by (simp add: powr_realpow floor_log_exp2_le) + hence "log 2 (2 powr (real (floor_log n))) \ log 2 (real n)" + using False by (subst log_le_cancel_iff) simp_all + also have "log 2 (2 powr (real (floor_log n))) = real (floor_log n)" by simp + finally show "real_of_int (int (floor_log n)) \ log 2 (real n)" by simp + next + have "real n < real (2 * 2 ^ floor_log n)" + by (subst of_nat_less_iff) (rule floor_log_exp2_gt) + also have "\ = 2 powr (real (floor_log n) + 1)" + by (simp add: powr_add powr_realpow) + finally have "log 2 (real n) < log 2 \" + using False by (subst log_less_cancel_iff) simp_all + also have "\ = real (floor_log n) + 1" by simp + finally show "log 2 (real n) < real_of_int (int (floor_log n)) + 1" by simp + qed + thus ?thesis by simp +qed simp_all + + +subsection \Discrete square root\ + +definition floor_sqrt :: "nat \ nat" + where "floor_sqrt n = Max {m. m\<^sup>2 \ n}" + +lemma floor_sqrt_aux: + fixes n :: nat + shows "finite {m. m\<^sup>2 \ n}" and "{m. m\<^sup>2 \ n} \ {}" +proof - + have **: "m \ n" if "m\<^sup>2 \ n" for m + using that by (cases m) (simp_all add: power2_eq_square) + then have "{m. m\<^sup>2 \ n} \ {m. m \ n}" by auto + then show "finite {m. m\<^sup>2 \ n}" by (rule finite_subset) rule + have "0\<^sup>2 \ n" by simp + then show *: "{m. m\<^sup>2 \ n} \ {}" by blast +qed + +lemma floor_sqrt_unique: + assumes "m^2 \ n" "n < (Suc m)^2" + shows "floor_sqrt n = m" +proof - + have "m' \ m" if "m'^2 \ n" for m' + proof - + note that + also note assms(2) + finally have "m' < Suc m" by (rule power_less_imp_less_base) simp_all + thus "m' \ m" by simp + qed + with \m^2 \ n\ floor_sqrt_aux[of n] show ?thesis unfolding floor_sqrt_def + by (intro antisym Max.boundedI Max.coboundedI) simp_all +qed + + +lemma floor_sqrt_code[code]: "floor_sqrt n = Max (Set.filter (\m. m\<^sup>2 \ n) {0..n})" +proof - + from power2_nat_le_imp_le [of _ n] have "{m. m \ n \ m\<^sup>2 \ n} = {m. m\<^sup>2 \ n}" by auto + then show ?thesis by (simp add: floor_sqrt_def Set.filter_def) +qed + +lemma floor_sqrt_inverse_power2 [simp]: "floor_sqrt (n\<^sup>2) = n" +proof - + have "{m. m \ n} \ {}" by auto + then have "Max {m. m \ n} \ n" by auto + then show ?thesis + by (auto simp add: floor_sqrt_def power2_nat_le_eq_le intro: antisym) +qed + +lemma floor_sqrt_zero [simp]: "floor_sqrt 0 = 0" + using floor_sqrt_inverse_power2 [of 0] by simp + +lemma floor_sqrt_one [simp]: "floor_sqrt 1 = 1" + using floor_sqrt_inverse_power2 [of 1] by simp + +lemma mono_floor_sqrt: "mono floor_sqrt" +proof + fix m n :: nat + have *: "0 * 0 \ m" by simp + assume "m \ n" + then show "floor_sqrt m \ floor_sqrt n" + by (auto intro!: Max_mono \0 * 0 \ m\ finite_less_ub simp add: power2_eq_square floor_sqrt_def) +qed + +lemma mono_floor_sqrt': "m \ n \ floor_sqrt m \ floor_sqrt n" + using mono_floor_sqrt unfolding mono_def by auto + +lemma floor_sqrt_greater_zero_iff [simp]: "floor_sqrt n > 0 \ n > 0" +proof - + have *: "0 < Max {m. m\<^sup>2 \ n} \ (\a\{m. m\<^sup>2 \ n}. 0 < a)" + by (rule Max_gr_iff) (fact floor_sqrt_aux)+ + show ?thesis + proof + assume "0 < floor_sqrt n" + then have "0 < Max {m. m\<^sup>2 \ n}" by (simp add: floor_sqrt_def) + with * show "0 < n" by (auto dest: power2_nat_le_imp_le) + next + assume "0 < n" + then have "1\<^sup>2 \ n \ 0 < (1::nat)" by simp + then have "\q. q\<^sup>2 \ n \ 0 < q" .. + with * have "0 < Max {m. m\<^sup>2 \ n}" by blast + then show "0 < floor_sqrt n" by (simp add: floor_sqrt_def) + qed +qed + +lemma floor_sqrt_power2_le [simp]: "(floor_sqrt n)\<^sup>2 \ n" (* FIXME tune proof *) +proof (cases "n > 0") + case False then show ?thesis by simp +next + case True then have "floor_sqrt n > 0" by simp + then have "mono (times (Max {m. m\<^sup>2 \ n}))" by (auto intro: mono_times_nat simp add: floor_sqrt_def) + then have *: "Max {m. m\<^sup>2 \ n} * Max {m. m\<^sup>2 \ n} = Max (times (Max {m. m\<^sup>2 \ n}) ` {m. m\<^sup>2 \ n})" + using floor_sqrt_aux [of n] by (rule mono_Max_commute) + have "\a. a * a \ n \ Max {m. m * m \ n} * a \ n" + proof - + fix q + assume "q * q \ n" + show "Max {m. m * m \ n} * q \ n" + proof (cases "q > 0") + case False then show ?thesis by simp + next + case True then have "mono (times q)" by (rule mono_times_nat) + then have "q * Max {m. m * m \ n} = Max (times q ` {m. m * m \ n})" + using floor_sqrt_aux [of n] by (auto simp add: power2_eq_square intro: mono_Max_commute) + then have "Max {m. m * m \ n} * q = Max (times q ` {m. m * m \ n})" by (simp add: ac_simps) + moreover have "finite ((*) q ` {m. m * m \ n})" + by (metis (mono_tags) finite_imageI finite_less_ub le_square) + moreover have "\x. x * x \ n" + by (metis \q * q \ n\) + ultimately show ?thesis + by simp (metis \q * q \ n\ le_cases mult_le_mono1 mult_le_mono2 order_trans) + qed + qed + then have "Max ((*) (Max {m. m * m \ n}) ` {m. m * m \ n}) \ n" + apply (subst Max_le_iff) + apply (metis (mono_tags) finite_imageI finite_less_ub le_square) + apply auto + apply (metis le0 mult_0_right) + done + with * show ?thesis by (simp add: floor_sqrt_def power2_eq_square) +qed + +lemma floor_sqrt_le: "floor_sqrt n \ n" + using floor_sqrt_aux [of n] by (auto simp add: floor_sqrt_def intro: power2_nat_le_imp_le) + +text \Additional facts about the discrete square root, thanks to Julian Biendarra, Manuel Eberl\ + +lemma Suc_floor_sqrt_power2_gt: "n < (Suc (floor_sqrt n))^2" + using Max_ge[OF floor_sqrt_aux(1), of "floor_sqrt n + 1" n] + by (cases "n < (Suc (floor_sqrt n))^2") (simp_all add: floor_sqrt_def) + +lemma le_floor_sqrt_iff: "x \ floor_sqrt y \ x^2 \ y" +proof - + have "x \ floor_sqrt y \ (\z. z\<^sup>2 \ y \ x \ z)" + using Max_ge_iff[OF floor_sqrt_aux, of x y] by (simp add: floor_sqrt_def) + also have "\ \ x^2 \ y" + proof safe + fix z assume "x \ z" "z ^ 2 \ y" + thus "x^2 \ y" by (intro le_trans[of "x^2" "z^2" y]) (simp_all add: power2_nat_le_eq_le) + qed auto + finally show ?thesis . +qed + +lemma le_floor_sqrtI: "x^2 \ y \ x \ floor_sqrt y" + by (simp add: le_floor_sqrt_iff) + +lemma floor_sqrt_le_iff: "floor_sqrt y \ x \ (\z. z^2 \ y \ z \ x)" + using Max.bounded_iff[OF floor_sqrt_aux] by (simp add: floor_sqrt_def) + +lemma floor_sqrt_leI: + "(\z. z^2 \ y \ z \ x) \ floor_sqrt y \ x" + by (simp add: floor_sqrt_le_iff) + +lemma floor_sqrt_Suc: + "floor_sqrt (Suc n) = (if \m. Suc n = m^2 then Suc (floor_sqrt n) else floor_sqrt n)" +proof cases + assume "\ m. Suc n = m^2" + then obtain m where m_def: "Suc n = m^2" by blast + then have lhs: "floor_sqrt (Suc n) = m" by simp + from m_def floor_sqrt_power2_le[of n] + have "(floor_sqrt n)^2 < m^2" by linarith + with power2_less_imp_less have lt_m: "floor_sqrt n < m" by blast + from m_def Suc_floor_sqrt_power2_gt[of "n"] + have "m^2 \ (Suc(floor_sqrt n))^2" + by linarith + with power2_nat_le_eq_le have "m \ Suc (floor_sqrt n)" by blast + with lt_m have "m = Suc (floor_sqrt n)" by simp + with lhs m_def show ?thesis by fastforce +next + assume asm: "\ (\ m. Suc n = m^2)" + hence "Suc n \ (floor_sqrt (Suc n))^2" by simp + with floor_sqrt_power2_le[of "Suc n"] + have "floor_sqrt (Suc n) \ floor_sqrt n" by (intro le_floor_sqrtI) linarith + moreover have "floor_sqrt (Suc n) \ floor_sqrt n" + by (intro monoD[OF mono_floor_sqrt]) simp_all + ultimately show ?thesis using asm by simp +qed + +end diff -r d421a7c58530 -r 60696404b40a src/HOL/Library/Library.thy --- a/src/HOL/Library/Library.thy Thu Nov 21 23:07:06 2024 +0100 +++ b/src/HOL/Library/Library.thy Fri Nov 22 20:21:36 2024 +0100 @@ -21,7 +21,7 @@ Countable_Set_Type Debug Diagonal_Subsequence - Discrete + Discrete_Functions Disjoint_Sets Disjoint_FSets Dlist diff -r d421a7c58530 -r 60696404b40a src/HOL/Set.thy --- a/src/HOL/Set.thy Thu Nov 21 23:07:06 2024 +0100 +++ b/src/HOL/Set.thy Fri Nov 22 20:21:36 2024 +0100 @@ -1834,14 +1834,13 @@ lemma the_elem_image_unique: assumes "A \ {}" - and *: "\y. y \ A \ f y = f x" - shows "the_elem (f ` A) = f x" + and *: "\y. y \ A \ f y = a" + shows "the_elem (f ` A) = a" unfolding the_elem_def proof (rule the1_equality) from \A \ {}\ obtain y where "y \ A" by auto - with * have "f x = f y" by simp - with \y \ A\ have "f x \ f ` A" by blast - with * show "f ` A = {f x}" by auto + with * \y \ A\ have "a \ f ` A" by blast + with * show "f ` A = {a}" by auto then show "\!x. f ` A = {x}" by auto qed diff -r d421a7c58530 -r 60696404b40a src/HOL/Tools/try0.ML --- a/src/HOL/Tools/try0.ML Thu Nov 21 23:07:06 2024 +0100 +++ b/src/HOL/Tools/try0.ML Fri Nov 22 20:21:36 2024 +0100 @@ -48,8 +48,11 @@ datatype modifier = Use | Simp | Intro | Elim | Dest fun string_of_xthm (xref, args) = - (case xref of Facts.Fact literal => cartouche literal | _ => Facts.string_of_ref xref) ^ - implode (map (enclose "[" "]" o Pretty.unformatted_string_of o Token.pretty_src \<^context>) args) + (case xref of + Facts.Fact literal => literal |> Symbol_Pos.explode0 |> Symbol_Pos.implode |> cartouche + | _ => + Facts.string_of_ref xref) ^ implode + (map (enclose "[" "]" o Pretty.unformatted_string_of o Token.pretty_src \<^context>) args) fun add_attr_text tagged (tag, src) s = let @@ -74,19 +77,16 @@ val ctxt = Proof.context_of st - val using_text = - (K (Method.insert (Attrib.eval_thms ctxt unused))) - |> Method.Basic - val text = name ^ attrs |> parse_method ctxt |> Method.method_cmd ctxt |> Method.Basic |> (fn m => Method.Combinator (Method.no_combinator_info, Method.Select_Goals 1, [m])) - |> (fn m => Method.Combinator (Method.no_combinator_info, Method.Then, [using_text, m])) - val apply = text |> Proof.refine #> Seq.filter_results + val apply = + Proof.using [Attrib.eval_thms ctxt unused |> map (rpair [] o single)] + #> Proof.refine text #> Seq.filter_results val num_before = num_goals st val multiple_goals = all_goals andalso num_before > 1 val (time, st') = apply_recursive multiple_goals Time.zeroTime timeout_opt apply st diff -r d421a7c58530 -r 60696404b40a src/HOL/ex/Function_Growth.thy --- a/src/HOL/ex/Function_Growth.thy Thu Nov 21 23:07:06 2024 +0100 +++ b/src/HOL/ex/Function_Growth.thy Fri Nov 22 20:21:36 2024 +0100 @@ -7,7 +7,7 @@ imports Main "HOL-Library.Preorder" - "HOL-Library.Discrete" + "HOL-Library.Discrete_Functions" begin subsection \Motivation\ @@ -23,7 +23,7 @@ \f \ g \ f \ O(g)\. From a didactic point of view, this does not only avoid the notational oddities mentioned above but also emphasizes the key insight of a growth hierarchy of functions: - \(\n. 0) \ (\n. k) \ Discrete.log \ Discrete.sqrt \ id \ \\. + \(\n. 0) \ (\n. k) \ floor_log \ floor_sqrt \ id \ \\. \ subsection \Model\ @@ -365,46 +365,46 @@ by (rule less_fun_strongI) auto lemma - "(\_. k) \ Discrete.log" + "(\_. k) \ floor_log" proof (rule less_fun_strongI) fix c :: nat - have "\m>2 ^ (Suc (c * k)). c * k < Discrete.log m" + have "\m>2 ^ (Suc (c * k)). c * k < floor_log m" proof (rule allI, rule impI) fix m :: nat assume "2 ^ Suc (c * k) < m" then have "2 ^ Suc (c * k) \ m" by simp - with log_mono have "Discrete.log (2 ^ (Suc (c * k))) \ Discrete.log m" + with floor_log_mono have "floor_log (2 ^ (Suc (c * k))) \ floor_log m" by (blast dest: monoD) - moreover have "c * k < Discrete.log (2 ^ (Suc (c * k)))" by simp - ultimately show "c * k < Discrete.log m" by auto + moreover have "c * k < floor_log (2 ^ (Suc (c * k)))" by simp + ultimately show "c * k < floor_log m" by auto qed - then show "\n. \m>n. c * k < Discrete.log m" .. + then show "\n. \m>n. c * k < floor_log m" .. qed (*lemma - "Discrete.log \ Discrete.sqrt" + "floor_log \ floor_sqrt" proof (rule less_fun_strongI)*) -text \\<^prop>\Discrete.log \ Discrete.sqrt\\ +text \\<^prop>\floor_log \ floor_sqrt\\ lemma - "Discrete.sqrt \ id" + "floor_sqrt \ id" proof (rule less_fun_strongI) fix c :: nat assume "0 < c" - have "\m>(Suc c)\<^sup>2. c * Discrete.sqrt m < id m" + have "\m>(Suc c)\<^sup>2. c * floor_sqrt m < id m" proof (rule allI, rule impI) fix m assume "(Suc c)\<^sup>2 < m" then have "(Suc c)\<^sup>2 \ m" by simp - with mono_sqrt have "Discrete.sqrt ((Suc c)\<^sup>2) \ Discrete.sqrt m" by (rule monoE) - then have "Suc c \ Discrete.sqrt m" by simp - then have "c < Discrete.sqrt m" by simp - moreover from \(Suc c)\<^sup>2 < m\ have "Discrete.sqrt m > 0" by simp - ultimately have "c * Discrete.sqrt m < Discrete.sqrt m * Discrete.sqrt m" by simp + with mono_floor_sqrt have "floor_sqrt ((Suc c)\<^sup>2) \ floor_sqrt m" by (rule monoE) + then have "Suc c \ floor_sqrt m" by simp + then have "c < floor_sqrt m" by simp + moreover from \(Suc c)\<^sup>2 < m\ have "floor_sqrt m > 0" by simp + ultimately have "c * floor_sqrt m < floor_sqrt m * floor_sqrt m" by simp also have "\ \ m" by (simp add: power2_eq_square [symmetric]) - finally show "c * Discrete.sqrt m < id m" by simp + finally show "c * floor_sqrt m < id m" by simp qed - then show "\n. \m>n. c * Discrete.sqrt m < id m" .. + then show "\n. \m>n. c * floor_sqrt m < id m" .. qed lemma