337 using mono add_mono by blast |
337 using mono add_mono by blast |
338 thus ?case by simp |
338 thus ?case by simp |
339 qed |
339 qed |
340 |
340 |
341 |
341 |
|
342 subsection \<open>Horner sums\<close> |
|
343 |
|
344 context comm_semiring_0 |
|
345 begin |
|
346 |
|
347 definition horner_sum :: \<open>('b \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'b list \<Rightarrow> 'a\<close> |
|
348 where horner_sum_foldr: \<open>horner_sum f a xs = foldr (\<lambda>x b. f x + a * b) xs 0\<close> |
|
349 |
|
350 lemma horner_sum_simps [simp]: |
|
351 \<open>horner_sum f a [] = 0\<close> |
|
352 \<open>horner_sum f a (x # xs) = f x + a * horner_sum f a xs\<close> |
|
353 by (simp_all add: horner_sum_foldr) |
|
354 |
|
355 lemma horner_sum_eq_sum_funpow: |
|
356 \<open>horner_sum f a xs = (\<Sum>n = 0..<length xs. ((*) a ^^ n) (f (xs ! n)))\<close> |
|
357 proof (induction xs) |
|
358 case Nil |
|
359 then show ?case |
|
360 by simp |
|
361 next |
|
362 case (Cons x xs) |
|
363 then show ?case |
|
364 by (simp add: sum.atLeast0_lessThan_Suc_shift sum_distrib_left del: sum.op_ivl_Suc) |
|
365 qed |
|
366 |
|
367 end |
|
368 |
|
369 context |
|
370 includes lifting_syntax |
|
371 begin |
|
372 |
|
373 lemma horner_sum_transfer [transfer_rule]: |
|
374 \<open>((B ===> A) ===> A ===> list_all2 B ===> A) horner_sum horner_sum\<close> |
|
375 if [transfer_rule]: \<open>A 0 0\<close> |
|
376 and [transfer_rule]: \<open>(A ===> A ===> A) (+) (+)\<close> |
|
377 and [transfer_rule]: \<open>(A ===> A ===> A) (*) (*)\<close> |
|
378 by (unfold horner_sum_foldr) transfer_prover |
|
379 |
|
380 end |
|
381 |
|
382 context comm_semiring_1 |
|
383 begin |
|
384 |
|
385 lemma horner_sum_eq_sum: |
|
386 \<open>horner_sum f a xs = (\<Sum>n = 0..<length xs. f (xs ! n) * a ^ n)\<close> |
|
387 proof - |
|
388 have \<open>(*) a ^^ n = (*) (a ^ n)\<close> for n |
|
389 by (induction n) (simp_all add: ac_simps) |
|
390 then show ?thesis |
|
391 by (simp add: horner_sum_eq_sum_funpow ac_simps) |
|
392 qed |
|
393 |
|
394 end |
|
395 |
|
396 context semiring_bit_shifts |
|
397 begin |
|
398 |
|
399 lemma horner_sum_bit_eq_take_bit: |
|
400 \<open>horner_sum of_bool 2 (map (bit a) [0..<n]) = take_bit n a\<close> |
|
401 proof (induction a arbitrary: n rule: bits_induct) |
|
402 case (stable a) |
|
403 moreover have \<open>bit a = (\<lambda>_. odd a)\<close> |
|
404 using stable by (simp add: stable_imp_bit_iff_odd fun_eq_iff) |
|
405 moreover have \<open>{q. q < n} = {0..<n}\<close> |
|
406 by auto |
|
407 ultimately show ?case |
|
408 by (simp add: stable_imp_take_bit_eq horner_sum_eq_sum mask_eq_sum_exp) |
|
409 next |
|
410 case (rec a b) |
|
411 show ?case |
|
412 proof (cases n) |
|
413 case 0 |
|
414 then show ?thesis |
|
415 by simp |
|
416 next |
|
417 case (Suc m) |
|
418 have \<open>map (bit (of_bool b + 2 * a)) [0..<Suc m] = b # map (bit (of_bool b + 2 * a)) [Suc 0..<Suc m]\<close> |
|
419 by (simp only: upt_conv_Cons) simp |
|
420 also have \<open>\<dots> = b # map (bit a) [0..<m]\<close> |
|
421 by (simp only: flip: map_Suc_upt) (simp add: bit_Suc rec.hyps) |
|
422 finally show ?thesis |
|
423 using Suc rec.IH [of m] by (simp add: take_bit_Suc rec.hyps, simp add: ac_simps mod_2_eq_odd) |
|
424 qed |
|
425 qed |
|
426 |
|
427 end |
|
428 |
|
429 context unique_euclidean_semiring_with_bit_shifts |
|
430 begin |
|
431 |
|
432 lemma bit_horner_sum_bit_iff: |
|
433 \<open>bit (horner_sum of_bool 2 bs) n \<longleftrightarrow> n < length bs \<and> bs ! n\<close> |
|
434 proof (induction bs arbitrary: n) |
|
435 case Nil |
|
436 then show ?case |
|
437 by simp |
|
438 next |
|
439 case (Cons b bs) |
|
440 show ?case |
|
441 proof (cases n) |
|
442 case 0 |
|
443 then show ?thesis |
|
444 by simp |
|
445 next |
|
446 case (Suc m) |
|
447 with bit_rec [of _ n] Cons.prems Cons.IH [of m] |
|
448 show ?thesis by simp |
|
449 qed |
|
450 qed |
|
451 |
|
452 lemma take_bit_horner_sum_bit_eq: |
|
453 \<open>take_bit n (horner_sum of_bool 2 bs) = horner_sum of_bool 2 (take n bs)\<close> |
|
454 by (auto simp add: bit_eq_iff bit_take_bit_iff bit_horner_sum_bit_iff) |
|
455 |
|
456 end |
|
457 |
|
458 |
342 subsection \<open>Further facts about \<^const>\<open>List.n_lists\<close>\<close> |
459 subsection \<open>Further facts about \<^const>\<open>List.n_lists\<close>\<close> |
343 |
460 |
344 lemma length_n_lists: "length (List.n_lists n xs) = length xs ^ n" |
461 lemma length_n_lists: "length (List.n_lists n xs) = length xs ^ n" |
345 by (induct n) (auto simp add: comp_def length_concat sum_list_triv) |
462 by (induct n) (auto simp add: comp_def length_concat sum_list_triv) |
346 |
463 |