879 end |
879 end |
880 |
880 |
881 definition floorlog :: "nat \<Rightarrow> nat \<Rightarrow> nat" |
881 definition floorlog :: "nat \<Rightarrow> nat \<Rightarrow> nat" |
882 where "floorlog b a = (if a > 0 \<and> b > 1 then nat \<lfloor>log b a\<rfloor> + 1 else 0)" |
882 where "floorlog b a = (if a > 0 \<and> b > 1 then nat \<lfloor>log b a\<rfloor> + 1 else 0)" |
883 |
883 |
884 lemma floorlog_nonneg: "0 \<le> floorlog b x" |
884 lemma floorlog_mono: "x \<le> y \<Longrightarrow> floorlog b x \<le> floorlog b y" |
885 proof - |
885 by(auto simp: floorlog_def floor_mono nat_mono) |
886 have "-1 < log b (-x)" if "0 > x" "b > 1" |
|
887 proof - |
|
888 have "-1 = log b (inverse b)" using that |
|
889 by (subst log_inverse) simp_all |
|
890 also have "\<dots> < log b (-x)" |
|
891 using \<open>0 > x\<close> by auto |
|
892 finally show ?thesis . |
|
893 qed |
|
894 then show ?thesis |
|
895 unfolding floorlog_def by (auto intro!: add_nonneg_nonneg) |
|
896 qed |
|
897 |
886 |
898 lemma floorlog_bounds: |
887 lemma floorlog_bounds: |
899 assumes "x > 0" "b > 1" |
888 assumes "x > 0" "b > 1" |
900 shows "b ^ (floorlog b x - 1) \<le> x \<and> x < b ^ (floorlog b x)" |
889 shows "b ^ (floorlog b x - 1) \<le> x \<and> x < b ^ (floorlog b x)" |
901 proof |
890 proof |
942 by arith |
931 by arith |
943 then show ?thesis using assms |
932 then show ?thesis using assms |
944 by (auto simp: floorlog_def log_mult powr_realpow[symmetric] nat_add_distrib) |
933 by (auto simp: floorlog_def log_mult powr_realpow[symmetric] nat_add_distrib) |
945 qed |
934 qed |
946 |
935 |
947 lemma |
936 lemma floor_log_add_eqI: |
948 floor_log_add_eqI: |
|
949 fixes a::nat and b::nat and r::real |
937 fixes a::nat and b::nat and r::real |
950 assumes "b > 1" |
938 assumes "b > 1" "a \<ge> 1" "0 \<le> r" "r < 1" |
951 assumes "a \<ge> 1" "0 \<le> r" "r < 1" |
|
952 shows "\<lfloor>log b (a + r)\<rfloor> = \<lfloor>log b a\<rfloor>" |
939 shows "\<lfloor>log b (a + r)\<rfloor> = \<lfloor>log b a\<rfloor>" |
953 proof (rule floor_eq2) |
940 proof (rule floor_eq2) |
954 have "log (real b) (real a) \<le> log (real b) (real a + r)" |
941 have "log (real b) (real a) \<le> log (real b) (real a + r)" |
955 using assms by force |
942 using assms by force |
956 then show "\<lfloor>log (real b) (real a)\<rfloor> \<le> log (real b) (real a + r)" |
943 then show "\<lfloor>log (real b) (real a)\<rfloor> \<le> log (real b) (real a + r)" |
975 also have "\<dots> = real_of_int \<lfloor>log b a\<rfloor> + 1" |
962 also have "\<dots> = real_of_int \<lfloor>log b a\<rfloor> + 1" |
976 using assms by (simp add: l_def_real) |
963 using assms by (simp add: l_def_real) |
977 finally show "log b (a + r) < real_of_int \<lfloor>log b a\<rfloor> + 1" . |
964 finally show "log b (a + r) < real_of_int \<lfloor>log b a\<rfloor> + 1" . |
978 qed |
965 qed |
979 |
966 |
980 lemma |
967 lemma divide_nat_diff_div_nat_less_one: |
981 divide_nat_diff_div_nat_less_one: |
|
982 fixes x b::nat shows "x / b - x div b < 1" |
968 fixes x b::nat shows "x / b - x div b < 1" |
983 by (metis One_nat_def add_diff_cancel_left' divide_1 divide_self_if floor_divide_of_nat_eq |
969 proof - |
984 less_eq_real_def mod_div_trivial nat.simps(3) of_nat_eq_0_iff real_of_nat_div3 real_of_nat_div_aux) |
970 have "int 0 \<noteq> \<lfloor>1::real\<rfloor>" by simp |
985 |
971 thus ?thesis |
986 context |
972 by (metis add_diff_cancel_left' floor_divide_of_nat_eq less_eq_real_def |
987 begin |
973 mod_div_trivial real_of_nat_div3 real_of_nat_div_aux) |
988 |
974 qed |
989 qualified lemma compute_floorlog[code]: |
975 |
|
976 lemma floor_log_div: |
|
977 fixes b x :: nat assumes "b > 1" "x > 0" "x div b > 0" |
|
978 shows "\<lfloor>log b x\<rfloor> = \<lfloor>log b (x div b)\<rfloor> + 1" |
|
979 proof- |
|
980 have "\<lfloor>log (real b) (real x)\<rfloor> = \<lfloor>log (real b) (x / b * b)\<rfloor>" |
|
981 using assms by simp |
|
982 also have "\<dots> = \<lfloor>log b (x / b) + log b b\<rfloor>" |
|
983 using assms by (subst log_mult) auto |
|
984 also have "\<dots> = \<lfloor>log b (x / b)\<rfloor> + 1" using assms by simp |
|
985 also have "\<lfloor>log b (x / b)\<rfloor> = \<lfloor>log b (x div b + (x / b - x div b))\<rfloor>" |
|
986 by simp |
|
987 also have "\<dots> = \<lfloor>log b (x div b)\<rfloor>" |
|
988 using assms real_of_nat_div4 divide_nat_diff_div_nat_less_one |
|
989 by (intro floor_log_add_eqI) auto |
|
990 finally show ?thesis . |
|
991 qed |
|
992 |
|
993 lemma compute_floorlog[code]: |
990 "floorlog b x = (if x > 0 \<and> b > 1 then floorlog b (x div b) + 1 else 0)" |
994 "floorlog b x = (if x > 0 \<and> b > 1 then floorlog b (x div b) + 1 else 0)" |
991 proof - |
995 by (auto simp: floorlog_def floor_log_div[of b x] div_eq_0_iff nat_add_distrib |
992 { |
996 intro!: floor_eq2) |
993 assume prems: "x > 0" "b > 1" "0 < x div b" |
997 |
994 have "\<lfloor>log (real b) (real x)\<rfloor> = \<lfloor>log (real b) (x / b * b)\<rfloor>" |
998 lemma floor_log_eq_if: |
995 using prems by simp |
999 fixes b x y :: nat |
996 also have "\<dots> = \<lfloor>log b (x / b) + log b b\<rfloor>" |
1000 assumes "x div b = y div b" "b > 1" "x > 0" "x div b \<ge> 1" |
997 using prems |
1001 shows "floor(log b x) = floor(log b y)" |
998 by (subst log_mult) auto |
1002 proof - |
999 also have "\<dots> = \<lfloor>log b (x / b)\<rfloor> + 1" using prems by simp |
1003 have "y > 0" using assms by(auto intro: ccontr) |
1000 also have "\<lfloor>log b (x / b)\<rfloor> = \<lfloor>log b (x div b + (x / b - x div b))\<rfloor>" |
1004 thus ?thesis using assms by (simp add: floor_log_div) |
1001 by simp |
1005 qed |
1002 also have "\<dots> = \<lfloor>log b (x div b)\<rfloor>" |
1006 |
1003 using prems real_of_nat_div4 divide_nat_diff_div_nat_less_one |
1007 lemma floorlog_eq_if: |
1004 by (intro floor_log_add_eqI) auto |
1008 fixes b x y :: nat |
1005 finally have ?thesis using prems by (simp add: floorlog_def nat_add_distrib) |
1009 assumes "x div b = y div b" "b > 1" "x > 0" "x div b \<ge> 1" |
1006 } then show ?thesis |
1010 shows "floorlog b x = floorlog b y" |
1007 by (auto simp: floorlog_def div_eq_0_iff intro!: floor_eq2) |
1011 proof - |
1008 qed |
1012 have "y > 0" using assms by(auto intro: ccontr) |
1009 |
1013 thus ?thesis using assms |
1010 end |
1014 by(auto simp add: floorlog_def eq_nat_nat_iff intro: floor_log_eq_if) |
|
1015 qed |
|
1016 |
1011 |
1017 |
1012 definition bitlen :: "int \<Rightarrow> int" where "bitlen a = floorlog 2 (nat a)" |
1018 definition bitlen :: "int \<Rightarrow> int" where "bitlen a = floorlog 2 (nat a)" |
1013 |
1019 |
1014 lemma bitlen_alt_def: "bitlen a = (if a > 0 then \<lfloor>log 2 a\<rfloor> + 1 else 0)" |
1020 lemma bitlen_alt_def: "bitlen a = (if a > 0 then \<lfloor>log 2 a\<rfloor> + 1 else 0)" |
1015 by (simp add: bitlen_def floorlog_def) |
1021 by (simp add: bitlen_def floorlog_def) |
1016 |
1022 |
1017 lemma bitlen_nonneg: "0 \<le> bitlen x" |
1023 lemma bitlen_nonneg: "0 \<le> bitlen x" |
1018 using floorlog_nonneg by (simp add: bitlen_def) |
1024 by (simp add: bitlen_def) |
1019 |
1025 |
1020 lemma bitlen_bounds: |
1026 lemma bitlen_bounds: |
1021 assumes "x > 0" |
1027 assumes "x > 0" |
1022 shows "2 ^ nat (bitlen x - 1) \<le> x \<and> x < 2 ^ nat (bitlen x)" |
1028 shows "2 ^ nat (bitlen x - 1) \<le> x \<and> x < 2 ^ nat (bitlen x)" |
1023 proof - |
1029 proof - |