# HG changeset patch # User nipkow # Date 1731874826 -3600 # Node ID 3fab5b28027d6917aac7f48ff15ae38256932368 # Parent bb82ebb18b5dc3384ee72a5881cd07e57802b213 renamed Discrete -> Discrete_Functions to avoid name clashes; new function names floor_log/sqrt to avoid long Discrete_Functions.log/sqrt diff -r bb82ebb18b5d -r 3fab5b28027d NEWS --- a/NEWS Sun Nov 17 09:50:54 2024 +0100 +++ b/NEWS Sun Nov 17 21:20:26 2024 +0100 @@ -185,6 +185,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 bb82ebb18b5d -r 3fab5b28027d src/HOL/Analysis/Summation_Tests.thy --- a/src/HOL/Analysis/Summation_Tests.thy Sun Nov 17 09:50:54 2024 +0100 +++ b/src/HOL/Analysis/Summation_Tests.thy Sun Nov 17 21:20:26 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 bb82ebb18b5d -r 3fab5b28027d src/HOL/Computational_Algebra/Nth_Powers.thy --- a/src/HOL/Computational_Algebra/Nth_Powers.thy Sun Nov 17 09:50:54 2024 +0100 +++ b/src/HOL/Computational_Algebra/Nth_Powers.thy Sun Nov 17 21:20:26 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 bb82ebb18b5d -r 3fab5b28027d src/HOL/Library/Discrete.thy --- a/src/HOL/Library/Discrete.thy Sun Nov 17 09:50:54 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 bb82ebb18b5d -r 3fab5b28027d src/HOL/Library/Discrete_Functions.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Library/Discrete_Functions.thy Sun Nov 17 21:20:26 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 bb82ebb18b5d -r 3fab5b28027d src/HOL/Library/Library.thy --- a/src/HOL/Library/Library.thy Sun Nov 17 09:50:54 2024 +0100 +++ b/src/HOL/Library/Library.thy Sun Nov 17 21:20:26 2024 +0100 @@ -21,7 +21,7 @@ Countable_Set_Type Debug Diagonal_Subsequence - Discrete + Discrete_Functions Disjoint_Sets Disjoint_FSets Dlist diff -r bb82ebb18b5d -r 3fab5b28027d src/HOL/ex/Function_Growth.thy --- a/src/HOL/ex/Function_Growth.thy Sun Nov 17 09:50:54 2024 +0100 +++ b/src/HOL/ex/Function_Growth.thy Sun Nov 17 21:20:26 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