6177 shows finite_roots_unity: "finite {z::'a. z^n = 1}" |
6177 shows finite_roots_unity: "finite {z::'a. z^n = 1}" |
6178 and card_roots_unity: "card {z::'a. z^n = 1} \<le> n" |
6178 and card_roots_unity: "card {z::'a. z^n = 1} \<le> n" |
6179 using polyfun_rootbound [of "\<lambda>i. if i = 0 then -1 else if i=n then 1 else 0" n n] assms(2) |
6179 using polyfun_rootbound [of "\<lambda>i. if i = 0 then -1 else if i=n then 1 else 0" n n] assms(2) |
6180 by (auto simp add: root_polyfun [OF assms(2)]) |
6180 by (auto simp add: root_polyfun [OF assms(2)]) |
6181 |
6181 |
|
6182 |
|
6183 |
|
6184 subsection \<open>Simprocs for root and power literals\<close> |
|
6185 |
|
6186 lemma numeral_powr_numeral_real [simp]: |
|
6187 "numeral m powr numeral n = (numeral m ^ numeral n :: real)" |
|
6188 by (simp add: powr_numeral) |
|
6189 |
|
6190 context |
|
6191 begin |
|
6192 |
|
6193 private lemma sqrt_numeral_simproc_aux: |
|
6194 assumes "m * m \<equiv> n" |
|
6195 shows "sqrt (numeral n :: real) \<equiv> numeral m" |
|
6196 proof - |
|
6197 have "numeral n \<equiv> numeral m * (numeral m :: real)" by (simp add: assms [symmetric]) |
|
6198 moreover have "sqrt \<dots> \<equiv> numeral m" by (subst real_sqrt_abs2) simp |
|
6199 ultimately show "sqrt (numeral n :: real) \<equiv> numeral m" by simp |
|
6200 qed |
|
6201 |
|
6202 private lemma root_numeral_simproc_aux: |
|
6203 assumes "Num.pow m n \<equiv> x" |
|
6204 shows "root (numeral n) (numeral x :: real) \<equiv> numeral m" |
|
6205 by (subst assms [symmetric], subst numeral_pow, subst real_root_pos2) simp_all |
|
6206 |
|
6207 private lemma powr_numeral_simproc_aux: |
|
6208 assumes "Num.pow y n = x" |
|
6209 shows "numeral x powr (m / numeral n :: real) \<equiv> numeral y powr m" |
|
6210 by (subst assms [symmetric], subst numeral_pow, subst powr_numeral [symmetric]) |
|
6211 (simp, subst powr_powr, simp_all) |
|
6212 |
|
6213 private lemma numeral_powr_inverse_eq: |
|
6214 "numeral x powr (inverse (numeral n)) = numeral x powr (1 / numeral n :: real)" |
|
6215 by simp |
|
6216 |
|
6217 |
|
6218 ML \<open> |
|
6219 |
|
6220 signature ROOT_NUMERAL_SIMPROC = sig |
|
6221 |
|
6222 val sqrt : int option -> int -> int option |
|
6223 val sqrt' : int option -> int -> int option |
|
6224 val nth_root : int option -> int -> int -> int option |
|
6225 val nth_root' : int option -> int -> int -> int option |
|
6226 val sqrt_simproc : Proof.context -> cterm -> thm option |
|
6227 val root_simproc : int * int -> Proof.context -> cterm -> thm option |
|
6228 val powr_simproc : int * int -> Proof.context -> cterm -> thm option |
|
6229 |
6182 end |
6230 end |
|
6231 |
|
6232 structure Root_Numeral_Simproc : ROOT_NUMERAL_SIMPROC = struct |
|
6233 |
|
6234 fun iterate NONE p f x = |
|
6235 let |
|
6236 fun go x = if p x then x else go (f x) |
|
6237 in |
|
6238 SOME (go x) |
|
6239 end |
|
6240 | iterate (SOME threshold) p f x = |
|
6241 let |
|
6242 fun go (threshold, x) = |
|
6243 if p x then SOME x else if threshold = 0 then NONE else go (threshold - 1, f x) |
|
6244 in |
|
6245 go (threshold, x) |
|
6246 end |
|
6247 |
|
6248 |
|
6249 fun nth_root _ 1 x = SOME x |
|
6250 | nth_root _ _ 0 = SOME 0 |
|
6251 | nth_root _ _ 1 = SOME 1 |
|
6252 | nth_root threshold n x = |
|
6253 let |
|
6254 fun newton_step y = ((n - 1) * y + x div Integer.pow (n - 1) y) div n |
|
6255 fun is_root y = Integer.pow n y <= x andalso x < Integer.pow n (y + 1) |
|
6256 in |
|
6257 if x < n then |
|
6258 SOME 1 |
|
6259 else if x < Integer.pow n 2 then |
|
6260 SOME 1 |
|
6261 else |
|
6262 let |
|
6263 val y = Real.floor (Math.pow (Real.fromInt x, Real.fromInt 1 / Real.fromInt n)) |
|
6264 in |
|
6265 if is_root y then |
|
6266 SOME y |
|
6267 else |
|
6268 iterate threshold is_root newton_step ((x + n - 1) div n) |
|
6269 end |
|
6270 end |
|
6271 |
|
6272 fun nth_root' _ 1 x = SOME x |
|
6273 | nth_root' _ _ 0 = SOME 0 |
|
6274 | nth_root' _ _ 1 = SOME 1 |
|
6275 | nth_root' threshold n x = if x < n then NONE else if x < Integer.pow n 2 then NONE else |
|
6276 case nth_root threshold n x of |
|
6277 NONE => NONE |
|
6278 | SOME y => if Integer.pow n y = x then SOME y else NONE |
|
6279 |
|
6280 fun sqrt _ 0 = SOME 0 |
|
6281 | sqrt _ 1 = SOME 1 |
|
6282 | sqrt threshold n = |
|
6283 let |
|
6284 fun aux (a, b) = if n >= b * b then aux (b, b * b) else (a, b) |
|
6285 val (lower_root, lower_n) = aux (1, 2) |
|
6286 fun newton_step x = (x + n div x) div 2 |
|
6287 fun is_sqrt r = r*r <= n andalso n < (r+1)*(r+1) |
|
6288 val y = Real.floor (Math.sqrt (Real.fromInt n)) |
|
6289 in |
|
6290 if is_sqrt y then |
|
6291 SOME y |
|
6292 else |
|
6293 Option.mapPartial (iterate threshold is_sqrt newton_step o (fn x => x * lower_root)) |
|
6294 (sqrt threshold (n div lower_n)) |
|
6295 end |
|
6296 |
|
6297 fun sqrt' threshold x = |
|
6298 case sqrt threshold x of |
|
6299 NONE => NONE |
|
6300 | SOME y => if y * y = x then SOME y else NONE |
|
6301 |
|
6302 fun sqrt_simproc ctxt ct = |
|
6303 let |
|
6304 val n = ct |> Thm.term_of |> dest_comb |> snd |> dest_comb |> snd |> HOLogic.dest_numeral |
|
6305 in |
|
6306 case sqrt' (SOME 10000) n of |
|
6307 NONE => NONE |
|
6308 | SOME m => |
|
6309 SOME (Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt o HOLogic.mk_numeral) [m, n]) |
|
6310 @{thm sqrt_numeral_simproc_aux}) |
|
6311 end |
|
6312 |
|
6313 fun root_simproc (threshold1, threshold2) ctxt ct = |
|
6314 let |
|
6315 val [n, x] = |
|
6316 ct |> Thm.term_of |> strip_comb |> snd |> map (dest_comb #> snd #> HOLogic.dest_numeral) |
|
6317 in |
|
6318 if n > threshold1 orelse x > threshold2 then NONE else |
|
6319 case nth_root' (SOME 100) n x of |
|
6320 NONE => NONE |
|
6321 | SOME m => |
|
6322 SOME (Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt o HOLogic.mk_numeral) [m, n, x]) |
|
6323 @{thm root_numeral_simproc_aux}) |
|
6324 end |
|
6325 |
|
6326 fun powr_simproc (threshold1, threshold2) ctxt ct = |
|
6327 let |
|
6328 val eq_thm = Conv.try_conv (Conv.rewr_conv @{thm numeral_powr_inverse_eq}) ct |
|
6329 val ct = Thm.dest_equals_rhs (Thm.cprop_of eq_thm) |
|
6330 val (_, [x, t]) = strip_comb (Thm.term_of ct) |
|
6331 val (_, [m, n]) = strip_comb t |
|
6332 val [x, n] = map (dest_comb #> snd #> HOLogic.dest_numeral) [x, n] |
|
6333 in |
|
6334 if n > threshold1 orelse x > threshold2 then NONE else |
|
6335 case nth_root' (SOME 100) n x of |
|
6336 NONE => NONE |
|
6337 | SOME y => |
|
6338 let |
|
6339 val [y, n, x] = map HOLogic.mk_numeral [y, n, x] |
|
6340 val thm = Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt) [y, n, x, m]) |
|
6341 @{thm powr_numeral_simproc_aux} |
|
6342 in |
|
6343 SOME (@{thm transitive} OF [eq_thm, thm]) |
|
6344 end |
|
6345 end |
|
6346 |
|
6347 end |
|
6348 \<close> |
|
6349 |
|
6350 end |
|
6351 |
|
6352 simproc_setup sqrt_numeral ("sqrt (numeral n)") = |
|
6353 \<open>K Root_Numeral_Simproc.sqrt_simproc\<close> |
|
6354 |
|
6355 simproc_setup root_numeral ("root (numeral n) (numeral x)") = |
|
6356 \<open>K (Root_Numeral_Simproc.root_simproc (200, Integer.pow 200 2))\<close> |
|
6357 |
|
6358 simproc_setup powr_divide_numeral |
|
6359 ("numeral x powr (m / numeral n :: real)" | "numeral x powr (inverse (numeral n) :: real)") = |
|
6360 \<open>K (Root_Numeral_Simproc.powr_simproc (200, Integer.pow 200 2))\<close> |
|
6361 |
|
6362 |
|
6363 lemma "root 100 1267650600228229401496703205376 = 2" |
|
6364 by simp |
|
6365 |
|
6366 lemma "sqrt 196 = 14" |
|
6367 by simp |
|
6368 |
|
6369 lemma "256 powr (7 / 4 :: real) = 16384" |
|
6370 by simp |
|
6371 |
|
6372 lemma "27 powr (inverse 3) = (3::real)" |
|
6373 by simp |
|
6374 |
|
6375 end |