442 declare brauns.simps[simp del] |
442 declare brauns.simps[simp del] |
443 |
443 |
444 definition brauns1 :: "'a list \<Rightarrow> 'a tree" where |
444 definition brauns1 :: "'a list \<Rightarrow> 'a tree" where |
445 "brauns1 xs = (if xs = [] then Leaf else brauns 0 xs ! 0)" |
445 "brauns1 xs = (if xs = [] then Leaf else brauns 0 xs ! 0)" |
446 |
446 |
447 fun t_brauns :: "nat \<Rightarrow> 'a list \<Rightarrow> nat" where |
447 fun T_brauns :: "nat \<Rightarrow> 'a list \<Rightarrow> nat" where |
448 "t_brauns k xs = (if xs = [] then 0 else |
448 "T_brauns k xs = (if xs = [] then 0 else |
449 let ys = take (2^k) xs; |
449 let ys = take (2^k) xs; |
450 zs = drop (2^k) xs; |
450 zs = drop (2^k) xs; |
451 ts = brauns (k+1) zs |
451 ts = brauns (k+1) zs |
452 in 4 * min (2^k) (length xs) + t_brauns (k+1) zs)" |
452 in 4 * min (2^k) (length xs) + T_brauns (k+1) zs)" |
453 |
453 |
454 |
454 |
455 paragraph "Functional correctness" |
455 paragraph "Functional correctness" |
456 |
456 |
457 text \<open>The proof is originally due to Thomas Sewell.\<close> |
457 text \<open>The proof is originally due to Thomas Sewell.\<close> |
496 by (simp add: brauns1_def braun_list_eq take_nths_00) |
496 by (simp add: brauns1_def braun_list_eq take_nths_00) |
497 |
497 |
498 |
498 |
499 paragraph "Running Time Analysis" |
499 paragraph "Running Time Analysis" |
500 |
500 |
501 theorem t_brauns: |
501 theorem T_brauns: |
502 "t_brauns k xs = 4 * length xs" |
502 "T_brauns k xs = 4 * length xs" |
503 proof (induction xs arbitrary: k rule: measure_induct_rule[where f = length]) |
503 proof (induction xs arbitrary: k rule: measure_induct_rule[where f = length]) |
504 case (less xs) |
504 case (less xs) |
505 show ?case |
505 show ?case |
506 proof cases |
506 proof cases |
507 assume "xs = []" |
507 assume "xs = []" |
508 thus ?thesis by(simp) |
508 thus ?thesis by(simp) |
509 next |
509 next |
510 assume "xs \<noteq> []" |
510 assume "xs \<noteq> []" |
511 let ?zs = "drop (2^k) xs" |
511 let ?zs = "drop (2^k) xs" |
512 have "t_brauns k xs = t_brauns (k+1) ?zs + 4 * min (2^k) (length xs)" |
512 have "T_brauns k xs = T_brauns (k+1) ?zs + 4 * min (2^k) (length xs)" |
513 using \<open>xs \<noteq> []\<close> by(simp) |
513 using \<open>xs \<noteq> []\<close> by(simp) |
514 also have "\<dots> = 4 * length ?zs + 4 * min (2^k) (length xs)" |
514 also have "\<dots> = 4 * length ?zs + 4 * min (2^k) (length xs)" |
515 using less[of ?zs "k+1"] \<open>xs \<noteq> []\<close> |
515 using less[of ?zs "k+1"] \<open>xs \<noteq> []\<close> |
516 by (simp) |
516 by (simp) |
517 also have "\<dots> = 4 * length xs" |
517 also have "\<dots> = 4 * length xs" |
553 declare list_fast_rec.simps[simp del] |
553 declare list_fast_rec.simps[simp del] |
554 |
554 |
555 definition list_fast :: "'a tree \<Rightarrow> 'a list" where |
555 definition list_fast :: "'a tree \<Rightarrow> 'a list" where |
556 "list_fast t = list_fast_rec [t]" |
556 "list_fast t = list_fast_rec [t]" |
557 |
557 |
558 function t_list_fast_rec :: "'a tree list \<Rightarrow> nat" where |
558 function T_list_fast_rec :: "'a tree list \<Rightarrow> nat" where |
559 "t_list_fast_rec ts = (let us = filter (\<lambda>t. t \<noteq> Leaf) ts |
559 "T_list_fast_rec ts = (let us = filter (\<lambda>t. t \<noteq> Leaf) ts |
560 in length ts + (if us = [] then 0 else |
560 in length ts + (if us = [] then 0 else |
561 5 * length us + t_list_fast_rec (map left us @ map right us)))" |
561 5 * length us + T_list_fast_rec (map left us @ map right us)))" |
562 by (pat_completeness, auto) |
562 by (pat_completeness, auto) |
563 |
563 |
564 termination |
564 termination |
565 apply (relation "measure (sum_list o map size)") |
565 apply (relation "measure (sum_list o map size)") |
566 apply simp |
566 apply simp |
567 apply (simp add: list_fast_rec_term) |
567 apply (simp add: list_fast_rec_term) |
568 done |
568 done |
569 |
569 |
570 declare t_list_fast_rec.simps[simp del] |
570 declare T_list_fast_rec.simps[simp del] |
571 |
571 |
572 paragraph "Functional Correctness" |
572 paragraph "Functional Correctness" |
573 |
573 |
574 lemma list_fast_rec_all_Leaf: |
574 lemma list_fast_rec_all_Leaf: |
575 "\<forall>t \<in> set ts. t = Leaf \<Longrightarrow> list_fast_rec ts = []" |
575 "\<forall>t \<in> set ts. t = Leaf \<Longrightarrow> list_fast_rec ts = []" |
635 |
635 |
636 lemma sum_tree_list_children: "\<forall>t \<in> set ts. t \<noteq> Leaf \<Longrightarrow> |
636 lemma sum_tree_list_children: "\<forall>t \<in> set ts. t \<noteq> Leaf \<Longrightarrow> |
637 (\<Sum>t\<leftarrow>ts. k * size t) = (\<Sum>t \<leftarrow> map left ts @ map right ts. k * size t) + k * length ts" |
637 (\<Sum>t\<leftarrow>ts. k * size t) = (\<Sum>t \<leftarrow> map left ts @ map right ts. k * size t) + k * length ts" |
638 by(induction ts)(auto simp add: neq_Leaf_iff algebra_simps) |
638 by(induction ts)(auto simp add: neq_Leaf_iff algebra_simps) |
639 |
639 |
640 theorem t_list_fast_rec_ub: |
640 theorem T_list_fast_rec_ub: |
641 "t_list_fast_rec ts \<le> sum_list (map (\<lambda>t. 7*size t + 1) ts)" |
641 "T_list_fast_rec ts \<le> sum_list (map (\<lambda>t. 7*size t + 1) ts)" |
642 proof (induction ts rule: measure_induct_rule[where f="sum_list o map size"]) |
642 proof (induction ts rule: measure_induct_rule[where f="sum_list o map size"]) |
643 case (less ts) |
643 case (less ts) |
644 let ?us = "filter (\<lambda>t. t \<noteq> Leaf) ts" |
644 let ?us = "filter (\<lambda>t. t \<noteq> Leaf) ts" |
645 show ?case |
645 show ?case |
646 proof cases |
646 proof cases |
647 assume "?us = []" |
647 assume "?us = []" |
648 thus ?thesis using t_list_fast_rec.simps[of ts] |
648 thus ?thesis using T_list_fast_rec.simps[of ts] |
649 by(simp add: sum_list_Suc) |
649 by(simp add: sum_list_Suc) |
650 next |
650 next |
651 assume "?us \<noteq> []" |
651 assume "?us \<noteq> []" |
652 let ?children = "map left ?us @ map right ?us" |
652 let ?children = "map left ?us @ map right ?us" |
653 have "t_list_fast_rec ts = t_list_fast_rec ?children + 5 * length ?us + length ts" |
653 have "T_list_fast_rec ts = T_list_fast_rec ?children + 5 * length ?us + length ts" |
654 using \<open>?us \<noteq> []\<close> t_list_fast_rec.simps[of ts] by(simp) |
654 using \<open>?us \<noteq> []\<close> T_list_fast_rec.simps[of ts] by(simp) |
655 also have "\<dots> \<le> (\<Sum>t\<leftarrow>?children. 7 * size t + 1) + 5 * length ?us + length ts" |
655 also have "\<dots> \<le> (\<Sum>t\<leftarrow>?children. 7 * size t + 1) + 5 * length ?us + length ts" |
656 using less[of "?children"] list_fast_rec_term[of "?us"] \<open>?us \<noteq> []\<close> |
656 using less[of "?children"] list_fast_rec_term[of "?us"] \<open>?us \<noteq> []\<close> |
657 by (simp) |
657 by (simp) |
658 also have "\<dots> = (\<Sum>t\<leftarrow>?children. 7*size t) + 7 * length ?us + length ts" |
658 also have "\<dots> = (\<Sum>t\<leftarrow>?children. 7*size t) + 7 * length ?us + length ts" |
659 by(simp add: sum_list_Suc o_def) |
659 by(simp add: sum_list_Suc o_def) |