src/HOL/Library/Float.thy
changeset 63596 24d329f666c5
parent 63356 77332fed33c3
child 63599 f560147710fb
equal deleted inserted replaced
63592:64db21931bcb 63596:24d329f666c5
   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 -