src/HOL/Data_Structures/Array_Braun.thy
changeset 72550 1d0ae7e578a0
parent 71846 1a884605a08b
child 78653 7ed1759fe1bd
equal deleted inserted replaced
72549:726d17b280ea 72550:1d0ae7e578a0
   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)