src/HOL/Data_Structures/Selection.thy
author nipkow
Thu, 18 Jan 2024 14:30:27 +0100
changeset 79494 c7536609bb9b
parent 75501 426afab39a55
child 80093 c0d689c4fd15
permissions -rw-r--r--
translation to time functions now with canonical let.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
     1
(*
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
     2
  File:    Data_Structures/Selection.thy
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
     3
  Author:  Manuel Eberl, TU München
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
     4
*)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
     5
section \<open>The Median-of-Medians Selection Algorithm\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
     6
theory Selection
75501
426afab39a55 insort renamings
nipkow
parents: 73526
diff changeset
     7
  imports Complex_Main Time_Funs Sorting
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
     8
begin
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
     9
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    10
text \<open>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    11
  Note that there is significant overlap between this theory (which is intended mostly for the
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    12
  Functional Data Structures book) and the Median-of-Medians AFP entry.
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    13
\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    14
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    15
subsection \<open>Auxiliary material\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    16
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    17
lemma replicate_numeral: "replicate (numeral n) x = x # replicate (pred_numeral n) x"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    18
  by (simp add: numeral_eq_Suc)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    19
75501
426afab39a55 insort renamings
nipkow
parents: 73526
diff changeset
    20
lemma insort_correct: "insort xs = sort xs"
426afab39a55 insort renamings
nipkow
parents: 73526
diff changeset
    21
  using sorted_insort mset_insort by (metis properties_for_sort)
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    22
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    23
lemma sum_list_replicate [simp]: "sum_list (replicate n x) = n * x"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    24
  by (induction n) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    25
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    26
lemma mset_concat: "mset (concat xss) = sum_list (map mset xss)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    27
  by (induction xss) simp_all
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    28
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    29
lemma set_mset_sum_list [simp]: "set_mset (sum_list xs) = (\<Union>x\<in>set xs. set_mset x)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    30
  by (induction xs) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    31
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    32
lemma filter_mset_image_mset:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    33
  "filter_mset P (image_mset f A) = image_mset f (filter_mset (\<lambda>x. P (f x)) A)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    34
  by (induction A) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    35
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    36
lemma filter_mset_sum_list: "filter_mset P (sum_list xs) = sum_list (map (filter_mset P) xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    37
  by (induction xs) simp_all
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    38
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    39
lemma sum_mset_mset_mono: 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    40
  assumes "(\<And>x. x \<in># A \<Longrightarrow> f x \<subseteq># g x)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    41
  shows   "(\<Sum>x\<in>#A. f x) \<subseteq># (\<Sum>x\<in>#A. g x)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    42
  using assms by (induction A) (auto intro!: subset_mset.add_mono)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    43
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    44
lemma mset_filter_mono:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    45
  assumes "A \<subseteq># B" "\<And>x. x \<in># A \<Longrightarrow> P x \<Longrightarrow> Q x"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    46
  shows   "filter_mset P A \<subseteq># filter_mset Q B"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    47
  by (rule mset_subset_eqI) (insert assms, auto simp: mset_subset_eq_count count_eq_zero_iff)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    48
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    49
lemma size_mset_sum_mset_distrib: "size (sum_mset A :: 'a multiset) = sum_mset (image_mset size A)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    50
  by (induction A) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    51
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    52
lemma sum_mset_mono:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    53
  assumes "\<And>x. x \<in># A \<Longrightarrow> f x \<le> (g x :: 'a :: {ordered_ab_semigroup_add,comm_monoid_add})"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    54
  shows   "(\<Sum>x\<in>#A. f x) \<le> (\<Sum>x\<in>#A. g x)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    55
  using assms by (induction A) (auto intro!: add_mono)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    56
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    57
lemma filter_mset_is_empty_iff: "filter_mset P A = {#} \<longleftrightarrow> (\<forall>x. x \<in># A \<longrightarrow> \<not>P x)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    58
  by (auto simp: multiset_eq_iff count_eq_zero_iff)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    59
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    60
lemma sort_eq_Nil_iff [simp]: "sort xs = [] \<longleftrightarrow> xs = []"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    61
  by (metis set_empty set_sort)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    62
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    63
lemma sort_mset_cong: "mset xs = mset ys \<Longrightarrow> sort xs = sort ys"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    64
  by (metis sorted_list_of_multiset_mset)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    65
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    66
lemma Min_set_sorted: "sorted xs \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> Min (set xs) = hd xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    67
  by (cases xs; force intro: Min_insert2)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    68
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    69
lemma hd_sort:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    70
  fixes xs :: "'a :: linorder list"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    71
  shows "xs \<noteq> [] \<Longrightarrow> hd (sort xs) = Min (set xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    72
  by (subst Min_set_sorted [symmetric]) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    73
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    74
lemma length_filter_conv_size_filter_mset: "length (filter P xs) = size (filter_mset P (mset xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    75
  by (induction xs) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    76
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    77
lemma sorted_filter_less_subset_take:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    78
  assumes "sorted xs" and "i < length xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    79
  shows   "{#x \<in># mset xs. x < xs ! i#} \<subseteq># mset (take i xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    80
  using assms
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    81
proof (induction xs arbitrary: i rule: list.induct)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    82
  case (Cons x xs i)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    83
  show ?case
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    84
  proof (cases i)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    85
    case 0
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    86
    thus ?thesis using Cons.prems by (auto simp: filter_mset_is_empty_iff)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    87
  next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    88
    case (Suc i')
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    89
    have "{#y \<in># mset (x # xs). y < (x # xs) ! i#} \<subseteq># add_mset x {#y \<in># mset xs. y < xs ! i'#}"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    90
      using Suc Cons.prems by (auto)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    91
    also have "\<dots> \<subseteq># add_mset x (mset (take i' xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    92
      unfolding mset_subset_eq_add_mset_cancel using Cons.prems Suc
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    93
      by (intro Cons.IH) (auto)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    94
    also have "\<dots> = mset (take i (x # xs))" by (simp add: Suc)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    95
    finally show ?thesis .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    96
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    97
qed auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    98
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
    99
lemma sorted_filter_greater_subset_drop:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   100
  assumes "sorted xs" and "i < length xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   101
  shows   "{#x \<in># mset xs. x > xs ! i#} \<subseteq># mset (drop (Suc i) xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   102
  using assms
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   103
proof (induction xs arbitrary: i rule: list.induct)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   104
  case (Cons x xs i)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   105
  show ?case
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   106
  proof (cases i)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   107
    case 0
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   108
    thus ?thesis by (auto simp: sorted_append filter_mset_is_empty_iff)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   109
  next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   110
    case (Suc i')
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   111
    have "{#y \<in># mset (x # xs). y > (x # xs) ! i#} \<subseteq># {#y \<in># mset xs. y > xs ! i'#}"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   112
      using Suc Cons.prems by (auto simp: set_conv_nth)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   113
    also have "\<dots> \<subseteq># mset (drop (Suc i') xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   114
      using Cons.prems Suc by (intro Cons.IH) (auto)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   115
    also have "\<dots> = mset (drop (Suc i) (x # xs))" by (simp add: Suc)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   116
    finally show ?thesis .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   117
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   118
qed auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   119
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   120
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   121
subsection \<open>Chopping a list into equally-sized bits\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   122
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   123
fun chop :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list list" where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   124
  "chop 0 _  = []"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   125
| "chop _ [] = []"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   126
| "chop n xs = take n xs # chop n (drop n xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   127
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   128
lemmas [simp del] = chop.simps
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   129
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   130
text \<open>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   131
  This is an alternative induction rule for \<^const>\<open>chop\<close>, which is often nicer to use.
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   132
\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   133
lemma chop_induct' [case_names trivial reduce]:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   134
  assumes "\<And>n xs. n = 0 \<or> xs = [] \<Longrightarrow> P n xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   135
  assumes "\<And>n xs. n > 0 \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> P n (drop n xs) \<Longrightarrow> P n xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   136
  shows   "P n xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   137
  using assms
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   138
proof induction_schema
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   139
  show "wf (measure (length \<circ> snd))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   140
    by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   141
qed (blast | simp)+
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   142
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   143
lemma chop_eq_Nil_iff [simp]: "chop n xs = [] \<longleftrightarrow> n = 0 \<or> xs = []"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   144
  by (induction n xs rule: chop.induct; subst chop.simps) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   145
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   146
lemma chop_0 [simp]: "chop 0 xs = []"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   147
  by (simp add: chop.simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   148
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   149
lemma chop_Nil [simp]: "chop n [] = []"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   150
  by (cases n) (auto simp: chop.simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   151
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   152
lemma chop_reduce: "n > 0 \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> chop n xs = take n xs # chop n (drop n xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   153
  by (cases n; cases xs) (auto simp: chop.simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   154
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   155
lemma concat_chop [simp]: "n > 0 \<Longrightarrow> concat (chop n xs) = xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   156
  by (induction n xs rule: chop.induct; subst chop.simps) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   157
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   158
lemma chop_elem_not_Nil [dest]: "ys \<in> set (chop n xs) \<Longrightarrow> ys \<noteq> []"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   159
  by (induction n xs rule: chop.induct; subst (asm) chop.simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   160
     (auto simp: eq_commute[of "[]"] split: if_splits)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   161
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   162
lemma length_chop_part_le: "ys \<in> set (chop n xs) \<Longrightarrow> length ys \<le> n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   163
  by (induction n xs rule: chop.induct; subst (asm) chop.simps) (auto split: if_splits)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   164
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   165
lemma length_chop:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   166
  assumes "n > 0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   167
  shows   "length (chop n xs) = nat \<lceil>length xs / n\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   168
proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   169
  from \<open>n > 0\<close> have "real n * length (chop n xs) \<ge> length xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   170
    by (induction n xs rule: chop.induct; subst chop.simps) (auto simp: field_simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   171
  moreover from \<open>n > 0\<close> have "real n * length (chop n xs) < length xs + n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   172
    by (induction n xs rule: chop.induct; subst chop.simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   173
       (auto simp: field_simps split: nat_diff_split_asm)+
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   174
  ultimately have "length (chop n xs) \<ge> length xs / n" and "length (chop n xs) < length xs / n + 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   175
    using assms by (auto simp: field_simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   176
  thus ?thesis by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   177
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   178
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   179
lemma sum_msets_chop: "n > 0 \<Longrightarrow> (\<Sum>ys\<leftarrow>chop n xs. mset ys) = mset xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   180
  by (subst mset_concat [symmetric]) simp_all
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   181
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   182
lemma UN_sets_chop: "n > 0 \<Longrightarrow> (\<Union>ys\<in>set (chop n xs). set ys) = set xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   183
  by (simp only: set_concat [symmetric] concat_chop)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   184
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   185
lemma chop_append: "d dvd length xs \<Longrightarrow> chop d (xs @ ys) = chop d xs @ chop d ys"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   186
  by (induction d xs rule: chop_induct') (auto simp: chop_reduce dvd_imp_le)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   187
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   188
lemma chop_replicate [simp]: "d > 0 \<Longrightarrow> chop d (replicate d xs) = [replicate d xs]"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   189
  by (subst chop_reduce) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   190
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   191
lemma chop_replicate_dvd [simp]:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   192
  assumes "d dvd n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   193
  shows   "chop d (replicate n x) = replicate (n div d) (replicate d x)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   194
proof (cases "d = 0")
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   195
  case False
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   196
  from assms obtain k where k: "n = d * k"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   197
    by blast
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   198
  have "chop d (replicate (d * k) x) = replicate k (replicate d x)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   199
    using False by (induction k) (auto simp: replicate_add chop_append)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   200
  thus ?thesis using False by (simp add: k)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   201
qed auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   202
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   203
lemma chop_concat:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   204
  assumes "\<forall>xs\<in>set xss. length xs = d" and "d > 0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   205
  shows   "chop d (concat xss) = xss"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   206
  using assms 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   207
proof (induction xss)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   208
  case (Cons xs xss)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   209
  have "chop d (concat (xs # xss)) = chop d (xs @ concat xss)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   210
    by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   211
  also have "\<dots> = chop d xs @ chop d (concat xss)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   212
    using Cons.prems by (intro chop_append) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   213
  also have "chop d xs = [xs]"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   214
    using Cons.prems by (subst chop_reduce) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   215
  also have "chop d (concat xss) = xss"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   216
    using Cons.prems by (intro Cons.IH) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   217
  finally show ?case by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   218
qed auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   219
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   220
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   221
subsection \<open>Selection\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   222
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   223
definition select :: "nat \<Rightarrow> ('a :: linorder) list \<Rightarrow> 'a" where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   224
  "select k xs = sort xs ! k"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   225
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   226
lemma select_0: "xs \<noteq> [] \<Longrightarrow> select 0 xs = Min (set xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   227
  by (simp add: hd_sort select_def flip: hd_conv_nth)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   228
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   229
lemma select_mset_cong: "mset xs = mset ys \<Longrightarrow> select k xs = select k ys"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   230
  using sort_mset_cong[of xs ys] unfolding select_def by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   231
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   232
lemma select_in_set [intro,simp]:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   233
  assumes "k < length xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   234
  shows   "select k xs \<in> set xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   235
proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   236
  from assms have "sort xs ! k \<in> set (sort xs)" by (intro nth_mem) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   237
  also have "set (sort xs) = set xs" by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   238
  finally show ?thesis by (simp add: select_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   239
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   240
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   241
lemma
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   242
  assumes "n < length xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   243
  shows   size_less_than_select: "size {#y \<in># mset xs. y < select n xs#} \<le> n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   244
    and   size_greater_than_select: "size {#y \<in># mset xs. y > select n xs#} < length xs - n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   245
proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   246
  have "size {#y \<in># mset (sort xs). y < select n xs#} \<le> size (mset (take n (sort xs)))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   247
    unfolding select_def using assms
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   248
    by (intro size_mset_mono sorted_filter_less_subset_take) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   249
  thus "size {#y \<in># mset xs. y < select n xs#} \<le> n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   250
    by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   251
  have "size {#y \<in># mset (sort xs). y > select n xs#} \<le> size (mset (drop (Suc n) (sort xs)))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   252
    unfolding select_def using assms
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   253
    by (intro size_mset_mono sorted_filter_greater_subset_drop) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   254
  thus "size {#y \<in># mset xs. y > select n xs#} < length xs - n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   255
    using assms by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   256
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   257
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   258
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   259
subsection \<open>The designated median of a list\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   260
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   261
definition median where "median xs = select ((length xs - 1) div 2) xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   262
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   263
lemma median_in_set [intro, simp]: 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   264
  assumes "xs \<noteq> []"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   265
  shows   "median xs \<in> set xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   266
proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   267
  from assms have "length xs > 0" by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   268
  hence "(length xs - 1) div 2 < length xs" by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   269
  thus ?thesis by (simp add: median_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   270
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   271
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   272
lemma size_less_than_median: "size {#y \<in># mset xs. y < median xs#} \<le> (length xs - 1) div 2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   273
proof (cases "xs = []")
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   274
  case False
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   275
  hence "length xs > 0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   276
    by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   277
  hence less: "(length xs - 1) div 2 < length xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   278
    by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   279
  show "size {#y \<in># mset xs. y < median xs#} \<le> (length xs - 1) div 2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   280
    using size_less_than_select[OF less] by (simp add: median_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   281
qed auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   282
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   283
lemma size_greater_than_median: "size {#y \<in># mset xs. y > median xs#} \<le> length xs div 2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   284
proof (cases "xs = []")
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   285
  case False
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   286
  hence "length xs > 0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   287
    by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   288
  hence less: "(length xs - 1) div 2 < length xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   289
    by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   290
  have "size {#y \<in># mset xs. y > median xs#} < length xs - (length xs - 1) div 2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   291
    using size_greater_than_select[OF less] by (simp add: median_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   292
  also have "\<dots> = length xs div 2 + 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   293
    using \<open>length xs > 0\<close> by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   294
  finally show "size {#y \<in># mset xs. y > median xs#} \<le> length xs div 2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   295
    by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   296
qed auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   297
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   298
lemmas median_props = size_less_than_median size_greater_than_median
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   299
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   300
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   301
subsection \<open>A recurrence for selection\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   302
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   303
definition partition3 :: "'a \<Rightarrow> 'a :: linorder list \<Rightarrow> 'a list \<times> 'a list \<times> 'a list" where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   304
  "partition3 x xs = (filter (\<lambda>y. y < x) xs, filter (\<lambda>y. y = x) xs, filter (\<lambda>y. y > x) xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   305
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   306
lemma partition3_code [code]:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   307
  "partition3 x [] = ([], [], [])"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   308
  "partition3 x (y # ys) =
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   309
     (case partition3 x ys of (ls, es, gs) \<Rightarrow>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   310
        if y < x then (y # ls, es, gs) else if x = y then (ls, y # es, gs) else (ls, es, y # gs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   311
  by (auto simp: partition3_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   312
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   313
lemma sort_append:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   314
  assumes "\<forall>x\<in>set xs. \<forall>y\<in>set ys. x \<le> y"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   315
  shows   "sort (xs @ ys) = sort xs @ sort ys"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   316
  using assms by (intro properties_for_sort) (auto simp: sorted_append)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   317
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   318
lemma select_append:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   319
  assumes "\<forall>y\<in>set ys. \<forall>z\<in>set zs. y \<le> z"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   320
  shows   "k < length ys \<Longrightarrow> select k (ys @ zs) = select k ys"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   321
    and   "k \<in> {length ys..<length ys + length zs} \<Longrightarrow>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   322
             select k (ys @ zs) = select (k - length ys) zs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   323
  using assms by (simp_all add: select_def sort_append nth_append)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   324
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   325
lemma select_append':
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   326
  assumes "\<forall>y\<in>set ys. \<forall>z\<in>set zs. y \<le> z" and "k < length ys + length zs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   327
  shows   "select k (ys @ zs) = (if k < length ys then select k ys else select (k - length ys) zs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   328
  using assms by (auto intro!: select_append)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   329
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   330
theorem select_rec_partition:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   331
  assumes "k < length xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   332
  shows "select k xs = (
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   333
           let (ls, es, gs) = partition3 x xs
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   334
           in
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   335
             if k < length ls then select k ls 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   336
             else if k < length ls + length es then x
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   337
             else select (k - length ls - length es) gs
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   338
          )" (is "_ = ?rhs")
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   339
proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   340
  define ls es gs where "ls = filter (\<lambda>y. y < x) xs" and "es = filter (\<lambda>y. y = x) xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   341
                    and "gs = filter (\<lambda>y. y > x) xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   342
  define nl ne where [simp]: "nl = length ls" "ne = length es"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   343
  have mset_eq: "mset xs = mset ls + mset es + mset gs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   344
    unfolding ls_def es_def gs_def by (induction xs) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   345
  have length_eq: "length xs = length ls + length es + length gs"
73526
a3cc9fa1295d new automatic order prover: stateless, complete, verified
nipkow
parents: 73123
diff changeset
   346
    unfolding ls_def es_def gs_def 
a3cc9fa1295d new automatic order prover: stateless, complete, verified
nipkow
parents: 73123
diff changeset
   347
    using [[simp_depth_limit = 1]] by (induction xs) auto
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   348
  have [simp]: "select i es = x" if "i < length es" for i
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   349
  proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   350
    have "select i es \<in> set (sort es)" unfolding select_def
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   351
      using that by (intro nth_mem) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   352
    thus ?thesis
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   353
      by (auto simp: es_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   354
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   355
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   356
  have "select k xs = select k (ls @ (es @ gs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   357
    by (intro select_mset_cong) (simp_all add: mset_eq)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   358
  also have "\<dots> = (if k < nl then select k ls else select (k - nl) (es @ gs))" 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   359
    unfolding nl_ne_def using assms
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   360
    by (intro select_append') (auto simp: ls_def es_def gs_def length_eq)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   361
  also have "\<dots> = (if k < nl then select k ls else if k < nl + ne then x
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   362
                    else select (k - nl - ne) gs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   363
  proof (rule if_cong)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   364
    assume "\<not>k < nl"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   365
    have "select (k - nl) (es @ gs) =
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   366
                 (if k - nl < ne then select (k - nl) es else select (k - nl - ne) gs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   367
      unfolding nl_ne_def using assms \<open>\<not>k < nl\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   368
      by (intro select_append') (auto simp: ls_def es_def gs_def length_eq)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   369
    also have "\<dots> = (if k < nl + ne then x else select (k - nl - ne) gs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   370
      using \<open>\<not>k < nl\<close> by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   371
    finally show "select (k - nl) (es @ gs) = \<dots>" .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   372
  qed simp_all
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   373
  also have "\<dots> = ?rhs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   374
    by (simp add: partition3_def ls_def es_def gs_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   375
  finally show ?thesis .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   376
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   377
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   378
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   379
subsection \<open>The size of the lists in the recursive calls\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   380
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   381
text \<open>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   382
  We now derive an upper bound for the number of elements of a list that are smaller
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   383
  (resp. bigger) than the median of medians with chopping size 5. To avoid having to do the
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   384
  same proof twice, we do it generically for an operation \<open>\<prec>\<close> that we will later instantiate
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   385
  with either \<open><\<close> or \<open>>\<close>.
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   386
\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   387
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   388
context
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   389
  fixes xs :: "'a :: linorder list"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   390
  fixes M defines "M \<equiv> median (map median (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   391
begin
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   392
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   393
lemma size_median_of_medians_aux:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   394
  fixes R :: "'a :: linorder \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<prec>" 50)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   395
  assumes R: "R \<in> {(<), (>)}"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   396
  shows "size {#y \<in># mset xs. y \<prec> M#} \<le> nat \<lceil>0.7 * length xs + 3\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   397
proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   398
  define n and m where [simp]: "n = length xs" and "m = length (chop 5 xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   399
  text \<open>We define an abbreviation for the multiset of all the chopped-up groups:\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   400
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   401
  text \<open>We then split that multiset into those groups whose medians is less than @{term M}
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   402
        and the rest.\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   403
  define Y_small ("Y\<^sub>\<prec>") where "Y\<^sub>\<prec> = filter_mset (\<lambda>ys. median ys \<prec> M) (mset (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   404
  define Y_big ("Y\<^sub>\<succeq>") where "Y\<^sub>\<succeq> = filter_mset (\<lambda>ys. \<not>(median ys \<prec> M)) (mset (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   405
  have "m = size (mset (chop 5 xs))" by (simp add: m_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   406
  also have "mset (chop 5 xs) = Y\<^sub>\<prec> + Y\<^sub>\<succeq>" unfolding Y_small_def Y_big_def
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   407
    by (rule multiset_partition)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   408
  finally have m_eq: "m = size Y\<^sub>\<prec> + size Y\<^sub>\<succeq>" by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   409
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   410
  text \<open>At most half of the lists have a median that is smaller than the median of medians:\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   411
  have "size Y\<^sub>\<prec> = size (image_mset median Y\<^sub>\<prec>)" by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   412
  also have "image_mset median Y\<^sub>\<prec> = {#y \<in># mset (map median (chop 5 xs)). y \<prec> M#}"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   413
    unfolding Y_small_def by (subst filter_mset_image_mset [symmetric]) simp_all
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   414
  also have "size \<dots> \<le> (length (map median (chop 5 xs))) div 2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   415
    unfolding M_def using median_props[of "map median (chop 5 xs)"] R by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   416
  also have "\<dots> = m div 2" by (simp add: m_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   417
  finally have size_Y\<^sub>_small: "size Y\<^sub>\<prec> \<le> m div 2" .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   418
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   419
  text \<open>We estimate the number of elements less than @{term M} by grouping them into elements
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   420
      coming from @{term "Y\<^sub>\<prec>"} and elements coming from @{term "Y\<^sub>\<succeq>"}:\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   421
  have "{#y \<in># mset xs. y \<prec> M#} = {#y \<in># (\<Sum>ys\<leftarrow>chop 5 xs. mset ys). y \<prec> M#}"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   422
    by (subst sum_msets_chop) simp_all
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   423
  also have "\<dots> = (\<Sum>ys\<leftarrow>chop 5 xs. {#y \<in># mset ys. y \<prec> M#})"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   424
    by (subst filter_mset_sum_list) (simp add: o_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   425
  also have "\<dots> = (\<Sum>ys\<in>#mset (chop 5 xs). {#y \<in># mset ys. y \<prec> M#})"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   426
    by (subst sum_mset_sum_list [symmetric]) simp_all
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   427
  also have "mset (chop 5 xs) = Y\<^sub>\<prec> + Y\<^sub>\<succeq>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   428
    by (simp add: Y_small_def Y_big_def not_le)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   429
  also have "(\<Sum>ys\<in>#\<dots>. {#y \<in># mset ys. y \<prec> M#}) = 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   430
               (\<Sum>ys\<in>#Y\<^sub>\<prec>. {#y \<in># mset ys. y \<prec> M#}) + (\<Sum>ys\<in>#Y\<^sub>\<succeq>. {#y \<in># mset ys. y \<prec> M#})"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   431
    by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   432
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   433
  text \<open>Next, we overapproximate the elements contributed by @{term "Y\<^sub>\<prec>"}: instead of those elements
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   434
        that are smaller than the median, we take \<^emph>\<open>all\<close> the elements of each group.
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   435
        For the elements contributed by @{term "Y\<^sub>\<succeq>"}, we overapproximate by taking all those that
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   436
        are less than their median instead of only those that are less than @{term M}.\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   437
  also have "\<dots> \<subseteq># (\<Sum>ys\<in>#Y\<^sub>\<prec>. mset ys) + (\<Sum>ys\<in>#Y\<^sub>\<succeq>. {#y \<in># mset ys. y \<prec> median ys#})"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   438
    using R
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   439
    by (intro subset_mset.add_mono sum_mset_mset_mono mset_filter_mono) (auto simp: Y_big_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   440
  finally have "size {# y \<in># mset xs. y \<prec> M#} \<le> size \<dots>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   441
    by (rule size_mset_mono)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   442
  hence "size {# y \<in># mset xs. y \<prec> M#} \<le>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   443
           (\<Sum>ys\<in>#Y\<^sub>\<prec>. length ys) + (\<Sum>ys\<in>#Y\<^sub>\<succeq>. size {#y \<in># mset ys. y \<prec> median ys#})"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   444
    by (simp add: size_mset_sum_mset_distrib multiset.map_comp o_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   445
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   446
  text \<open>Next, we further overapproximate the first sum by noting that each group has
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   447
        at most size 5.\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   448
  also have "(\<Sum>ys\<in>#Y\<^sub>\<prec>. length ys) \<le> (\<Sum>ys\<in>#Y\<^sub>\<prec>. 5)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   449
    by (intro sum_mset_mono) (auto simp: Y_small_def length_chop_part_le)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   450
  also have "\<dots> = 5 * size Y\<^sub>\<prec>" by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   451
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   452
  text \<open>Next, we note that each group in @{term "Y\<^sub>\<succeq>"} can have at most 2 elements that are
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   453
        smaller than its median.\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   454
  also have "(\<Sum>ys\<in>#Y\<^sub>\<succeq>. size {#y \<in># mset ys. y \<prec> median ys#}) \<le>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   455
               (\<Sum>ys\<in>#Y\<^sub>\<succeq>. length ys div 2)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   456
  proof (intro sum_mset_mono, goal_cases)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   457
    fix ys assume "ys \<in># Y\<^sub>\<succeq>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   458
    hence "ys \<noteq> []"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   459
      by (auto simp: Y_big_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   460
    thus "size {#y \<in># mset ys. y \<prec> median ys#} \<le> length ys div 2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   461
      using R median_props[of ys] by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   462
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   463
  also have "\<dots> \<le> (\<Sum>ys\<in>#Y\<^sub>\<succeq>. 2)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   464
    by (intro sum_mset_mono div_le_mono diff_le_mono)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   465
       (auto simp: Y_big_def dest: length_chop_part_le)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   466
  also have "\<dots> = 2 * size Y\<^sub>\<succeq>" by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   467
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   468
  text \<open>Simplifying gives us the main result.\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   469
  also have "5 * size Y\<^sub>\<prec> + 2 * size Y\<^sub>\<succeq> = 2 * m + 3 * size Y\<^sub>\<prec>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   470
    by (simp add: m_eq)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   471
  also have "\<dots> \<le> 3.5 * m"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   472
    using \<open>size Y\<^sub>\<prec> \<le> m div 2\<close> by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   473
  also have "\<dots> = 3.5 * \<lceil>n / 5\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   474
    by (simp add: m_def length_chop)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   475
  also have "\<dots> \<le> 0.7 * n + 3.5"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   476
    by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   477
  finally have "size {#y \<in># mset xs. y \<prec> M#} \<le> 0.7 * n + 3.5"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   478
    by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   479
  thus "size {#y \<in># mset xs. y \<prec> M#} \<le> nat \<lceil>0.7 * n + 3\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   480
    by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   481
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   482
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   483
lemma size_less_than_median_of_medians:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   484
  "size {#y \<in># mset xs. y < M#} \<le> nat \<lceil>0.7 * length xs + 3\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   485
  using size_median_of_medians_aux[of "(<)"] by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   486
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   487
lemma size_greater_than_median_of_medians:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   488
  "size {#y \<in># mset xs. y > M#} \<le> nat \<lceil>0.7 * length xs + 3\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   489
  using size_median_of_medians_aux[of "(>)"] by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   490
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   491
end
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   492
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   493
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   494
subsection \<open>Efficient algorithm\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   495
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   496
text \<open>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   497
  We handle the base cases and computing the median for the chopped-up sublists of size 5
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   498
  using the naive selection algorithm where we sort the list using insertion sort.
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   499
\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   500
definition slow_select where
75501
426afab39a55 insort renamings
nipkow
parents: 73526
diff changeset
   501
  "slow_select k xs = insort xs ! k"
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   502
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   503
definition slow_median where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   504
  "slow_median xs = slow_select ((length xs - 1) div 2) xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   505
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   506
lemma slow_select_correct: "slow_select k xs = select k xs"
75501
426afab39a55 insort renamings
nipkow
parents: 73526
diff changeset
   507
  by (simp add: slow_select_def select_def insort_correct)
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   508
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   509
lemma slow_median_correct: "slow_median xs = median xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   510
  by (simp add: median_def slow_median_def slow_select_correct)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   511
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   512
text \<open>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   513
  The definition of the selection algorithm is complicated somewhat by the fact that its
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   514
  termination is contingent on its correctness: if the first recursive call were to return an
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   515
  element for \<open>x\<close> that is e.g. smaller than all list elements, the algorithm would not terminate.
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   516
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   517
  Therefore, we first prove partial correctness, then termination, and then combine the two
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   518
  to obtain total correctness.
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   519
\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   520
function mom_select where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   521
  "mom_select k xs = (
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   522
     if length xs \<le> 20 then
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   523
       slow_select k xs
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   524
     else
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   525
       let M = mom_select (((length xs + 4) div 5 - 1) div 2) (map slow_median (chop 5 xs));
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   526
           (ls, es, gs) = partition3 M xs
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   527
       in
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   528
         if k < length ls then mom_select k ls 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   529
         else if k < length ls + length es then M
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   530
         else mom_select (k - length ls - length es) gs
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   531
      )"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   532
  by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   533
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   534
text \<open>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   535
  If @{const "mom_select"} terminates, it agrees with @{const select}:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   536
\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   537
lemma mom_select_correct_aux:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   538
  assumes "mom_select_dom (k, xs)" and "k < length xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   539
  shows   "mom_select k xs = select k xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   540
  using assms
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   541
proof (induction rule: mom_select.pinduct)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   542
  case (1 k xs)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   543
  show "mom_select k xs = select k xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   544
  proof (cases "length xs \<le> 20")
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   545
    case True
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   546
    thus "mom_select k xs = select k xs" using "1.prems" "1.hyps"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   547
      by (subst mom_select.psimps) (auto simp: select_def slow_select_correct)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   548
  next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   549
    case False
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   550
    define x where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   551
      "x = mom_select (((length xs + 4) div 5 - 1) div 2) (map slow_median (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   552
    define ls es gs where "ls = filter (\<lambda>y. y < x) xs" and "es = filter (\<lambda>y. y = x) xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   553
                      and "gs = filter (\<lambda>y. y > x) xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   554
    define nl ne where "nl = length ls" and "ne = length es"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   555
    note defs = nl_def ne_def x_def ls_def es_def gs_def
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   556
    have tw: "(ls, es, gs) = partition3 x xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   557
      unfolding partition3_def defs One_nat_def ..
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   558
    have length_eq: "length xs = nl + ne + length gs"
73526
a3cc9fa1295d new automatic order prover: stateless, complete, verified
nipkow
parents: 73123
diff changeset
   559
      unfolding nl_def ne_def ls_def es_def gs_def
a3cc9fa1295d new automatic order prover: stateless, complete, verified
nipkow
parents: 73123
diff changeset
   560
      using [[simp_depth_limit = 1]] by (induction xs) auto
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   561
    note IH = "1.IH"(2,3)[OF False x_def tw refl refl]
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   562
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   563
    have "mom_select k xs = (if k < nl then mom_select k ls else if k < nl + ne then x
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   564
                                else mom_select (k - nl - ne) gs)" using "1.hyps" False
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   565
      by (subst mom_select.psimps) (simp_all add: partition3_def flip: defs One_nat_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   566
    also have "\<dots> = (if k < nl then select k ls else if k < nl + ne then x 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   567
                       else select (k - nl - ne) gs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   568
      using IH length_eq "1.prems" by (simp add: ls_def es_def gs_def nl_def ne_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   569
    also have "\<dots> = select k xs" using \<open>k < length xs\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   570
      by (subst (3) select_rec_partition[of _ _ x]) (simp_all add: nl_def ne_def flip: tw)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   571
    finally show "mom_select k xs = select k xs" .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   572
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   573
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   574
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   575
text \<open>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   576
  @{const mom_select} indeed terminates for all inputs:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   577
\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   578
lemma mom_select_termination: "All mom_select_dom"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   579
proof (relation "measure (length \<circ> snd)"; (safe)?)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   580
  fix k :: nat and xs :: "'a list"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   581
  assume "\<not> length xs \<le> 20"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   582
  thus "((((length xs + 4) div 5 - 1) div 2, map slow_median (chop 5 xs)), k, xs)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   583
           \<in> measure (length \<circ> snd)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   584
    by (auto simp: length_chop nat_less_iff ceiling_less_iff)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   585
next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   586
  fix k :: nat and xs ls es gs :: "'a list"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   587
  define x where "x = mom_select (((length xs + 4) div 5 - 1) div 2) (map slow_median (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   588
  assume A: "\<not> length xs \<le> 20" 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   589
            "(ls, es, gs) = partition3 x xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   590
            "mom_select_dom (((length xs + 4) div 5 - 1) div 2, 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   591
                             map slow_median (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   592
  have less: "((length xs + 4) div 5 - 1) div 2 < nat \<lceil>length xs / 5\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   593
    using A(1) by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   594
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   595
  text \<open>For termination, it suffices to prove that @{term x} is in the list.\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   596
  have "x = select (((length xs + 4) div 5 - 1) div 2) (map slow_median (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   597
    using less unfolding x_def by (intro mom_select_correct_aux A) (auto simp: length_chop)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   598
  also have "\<dots> \<in> set (map slow_median (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   599
    using less by (intro select_in_set) (simp_all add: length_chop)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   600
  also have "\<dots> \<subseteq> set xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   601
    unfolding set_map
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   602
  proof safe
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   603
    fix ys assume ys: "ys \<in> set (chop 5 xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   604
    hence "median ys \<in> set ys"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   605
      by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   606
    also have "set ys \<subseteq> \<Union>(set ` set (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   607
      using ys by blast
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   608
    also have "\<dots> = set xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   609
      by (rule UN_sets_chop) simp_all
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   610
    finally show "slow_median ys \<in> set xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   611
      by (simp add: slow_median_correct)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   612
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   613
  finally have "x \<in> set xs" .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   614
  thus "((k, ls), k, xs) \<in> measure (length \<circ> snd)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   615
   and "((k - length ls - length es, gs), k, xs) \<in> measure (length \<circ> snd)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   616
    using A(1,2) by (auto simp: partition3_def intro!: length_filter_less[of x])
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   617
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   618
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   619
termination mom_select by (rule mom_select_termination)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   620
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   621
lemmas [simp del] = mom_select.simps
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   622
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   623
lemma mom_select_correct: "k < length xs \<Longrightarrow> mom_select k xs = select k xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   624
  using mom_select_correct_aux and mom_select_termination by blast
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   625
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   626
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   627
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   628
subsection \<open>Running time analysis\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   629
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   630
fun T_partition3 :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   631
  "T_partition3 x [] = 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   632
| "T_partition3 x (y # ys) = T_partition3 x ys + 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   633
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   634
lemma T_partition3_eq: "T_partition3 x xs = length xs + 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   635
  by (induction x xs rule: T_partition3.induct) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   636
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   637
definition T_slow_select :: "nat \<Rightarrow> 'a :: linorder list \<Rightarrow> nat" where
75501
426afab39a55 insort renamings
nipkow
parents: 73526
diff changeset
   638
  "T_slow_select k xs = T_insort xs + T_nth (insort xs) k + 1"
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   639
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   640
definition T_slow_median :: "'a :: linorder list \<Rightarrow> nat" where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   641
  "T_slow_median xs = T_slow_select ((length xs - 1) div 2) xs + 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   642
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   643
lemma T_slow_select_le: "T_slow_select k xs \<le> length xs ^ 2 + 3 * length xs + 3"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   644
proof -
75501
426afab39a55 insort renamings
nipkow
parents: 73526
diff changeset
   645
  have "T_slow_select k xs \<le> (length xs + 1)\<^sup>2 + (length (insort xs) + 1) + 1"
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   646
    unfolding T_slow_select_def
75501
426afab39a55 insort renamings
nipkow
parents: 73526
diff changeset
   647
    by (intro add_mono T_insort_length) (auto simp: T_nth_eq)
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   648
  also have "\<dots> = length xs ^ 2 + 3 * length xs + 3"
75501
426afab39a55 insort renamings
nipkow
parents: 73526
diff changeset
   649
    by (simp add: insort_correct algebra_simps power2_eq_square)
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   650
  finally show ?thesis .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   651
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   652
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   653
lemma T_slow_median_le: "T_slow_median xs \<le> length xs ^ 2 + 3 * length xs + 4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   654
  unfolding T_slow_median_def using T_slow_select_le[of "(length xs - 1) div 2" xs] by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   655
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   656
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   657
fun T_chop :: "nat \<Rightarrow> 'a list \<Rightarrow> nat" where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   658
  "T_chop 0 _  = 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   659
| "T_chop _ [] = 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   660
| "T_chop n xs = T_take n xs + T_drop n xs + T_chop n (drop n xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   661
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   662
lemmas [simp del] = T_chop.simps
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   663
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   664
lemma T_chop_Nil [simp]: "T_chop d [] = 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   665
  by (cases d) (auto simp: T_chop.simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   666
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   667
lemma T_chop_0 [simp]: "T_chop 0 xs = 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   668
  by (auto simp: T_chop.simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   669
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   670
lemma T_chop_reduce:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   671
  "n > 0 \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> T_chop n xs = T_take n xs + T_drop n xs + T_chop n (drop n xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   672
  by (cases n; cases xs) (auto simp: T_chop.simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   673
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   674
lemma T_chop_le: "T_chop d xs \<le> 5 * length xs + 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   675
  by (induction d xs rule: T_chop.induct) (auto simp: T_chop_reduce T_take_eq T_drop_eq)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   676
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   677
text \<open>
73123
b4066bad7f76 avoid Unicode quotes;
wenzelm
parents: 73108
diff changeset
   678
  The option \<open>domintros\<close> here allows us to explicitly reason about where the function does and
73108
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   679
  does not terminate. With this, we can skip the termination proof this time because we can
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   680
  reuse the one for \<^const>\<open>mom_select\<close>.
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   681
\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   682
function (domintros) T_mom_select :: "nat \<Rightarrow> 'a :: linorder list \<Rightarrow> nat" where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   683
  "T_mom_select k xs = (
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   684
     if length xs \<le> 20 then
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   685
       T_slow_select k xs
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   686
     else
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   687
       let xss = chop 5 xs;
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   688
           ms = map slow_median xss;
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   689
           idx = (((length xs + 4) div 5 - 1) div 2);
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   690
           x = mom_select idx ms;
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   691
           (ls, es, gs) = partition3 x xs;
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   692
           nl = length ls;
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   693
           ne = length es
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   694
       in
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   695
         (if k < nl then T_mom_select k ls 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   696
          else if k < nl + ne then 0
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   697
          else T_mom_select (k - nl - ne) gs) +
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   698
         T_mom_select idx ms + T_chop 5 xs + T_map T_slow_median xss +
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   699
         T_partition3 x xs + T_length ls + T_length es + 1
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   700
      )"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   701
  by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   702
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   703
termination T_mom_select
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   704
proof (rule allI, safe)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   705
  fix k :: nat and xs :: "'a :: linorder list"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   706
  have "mom_select_dom (k, xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   707
    using mom_select_termination by blast
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   708
  thus "T_mom_select_dom (k, xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   709
    by (induction k xs rule: mom_select.pinduct)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   710
       (rule T_mom_select.domintros, simp_all)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   711
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   712
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   713
lemmas [simp del] = T_mom_select.simps
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   714
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   715
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   716
function T'_mom_select :: "nat \<Rightarrow> nat" where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   717
  "T'_mom_select n =
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   718
     (if n \<le> 20 then
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   719
        463
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   720
      else
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   721
        T'_mom_select (nat \<lceil>0.2*n\<rceil>) + T'_mom_select (nat \<lceil>0.7*n+3\<rceil>) + 17 * n + 50)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   722
  by force+
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   723
termination by (relation "measure id"; simp; linarith)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   724
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   725
lemmas [simp del] = T'_mom_select.simps
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   726
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   727
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   728
lemma T'_mom_select_ge: "T'_mom_select n \<ge> 463"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   729
  by (induction n rule: T'_mom_select.induct; subst T'_mom_select.simps) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   730
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   731
lemma T'_mom_select_mono:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   732
  "m \<le> n \<Longrightarrow> T'_mom_select m \<le> T'_mom_select n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   733
proof (induction n arbitrary: m rule: less_induct)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   734
  case (less n m)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   735
  show ?case
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   736
  proof (cases "m \<le> 20")
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   737
    case True
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   738
    hence "T'_mom_select m = 463"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   739
      by (subst T'_mom_select.simps) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   740
    also have "\<dots> \<le> T'_mom_select n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   741
      by (rule T'_mom_select_ge)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   742
    finally show ?thesis .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   743
  next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   744
    case False
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   745
    hence "T'_mom_select m =
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   746
             T'_mom_select (nat \<lceil>0.2*m\<rceil>) + T'_mom_select (nat \<lceil>0.7*m + 3\<rceil>) + 17 * m + 50"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   747
      by (subst T'_mom_select.simps) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   748
    also have "\<dots> \<le> T'_mom_select (nat \<lceil>0.2*n\<rceil>) + T'_mom_select (nat \<lceil>0.7*n + 3\<rceil>) + 17 * n + 50"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   749
      using \<open>m \<le> n\<close> and False by (intro add_mono less.IH; linarith)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   750
    also have "\<dots> = T'_mom_select n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   751
      using \<open>m \<le> n\<close> and False by (subst T'_mom_select.simps) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   752
    finally show ?thesis .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   753
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   754
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   755
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   756
lemma T_mom_select_le_aux: "T_mom_select k xs \<le> T'_mom_select (length xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   757
proof (induction k xs rule: T_mom_select.induct)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   758
  case (1 k xs)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   759
  define n where [simp]: "n = length xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   760
  define x where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   761
    "x = mom_select (((length xs + 4) div 5 - 1) div 2) (map slow_median (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   762
  define ls es gs where "ls = filter (\<lambda>y. y < x) xs" and "es = filter (\<lambda>y. y = x) xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   763
                    and "gs = filter (\<lambda>y. y > x) xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   764
  define nl ne where "nl = length ls" and "ne = length es"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   765
  note defs = nl_def ne_def x_def ls_def es_def gs_def
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   766
  have tw: "(ls, es, gs) = partition3 x xs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   767
    unfolding partition3_def defs One_nat_def ..
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   768
  note IH = "1.IH"(1,2,3)[OF _ refl refl refl x_def tw refl refl refl refl]
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   769
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   770
  show ?case
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   771
  proof (cases "length xs \<le> 20")
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   772
    case True \<comment> \<open>base case\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   773
    hence "T_mom_select k xs \<le> (length xs)\<^sup>2 + 3 * length xs + 3"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   774
      using T_slow_select_le[of k xs] by (subst T_mom_select.simps) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   775
    also have "\<dots> \<le> 20\<^sup>2 + 3 * 20 + 3"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   776
      using True by (intro add_mono power_mono) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   777
    also have "\<dots> \<le> 463"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   778
      by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   779
    also have "\<dots> = T'_mom_select (length xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   780
      using True by (simp add: T'_mom_select.simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   781
    finally show ?thesis by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   782
  next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   783
    case False \<comment> \<open>recursive case\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   784
    have "((n + 4) div 5 - 1) div 2 < nat \<lceil>n / 5\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   785
      using False unfolding n_def by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   786
    hence "x = select (((n + 4) div 5 - 1) div 2) (map slow_median (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   787
      unfolding x_def n_def by (intro mom_select_correct) (auto simp: length_chop)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   788
    also have "((n + 4) div 5 - 1) div 2 = (nat \<lceil>n / 5\<rceil> - 1) div 2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   789
      by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   790
    also have "select \<dots> (map slow_median (chop 5 xs)) = median (map slow_median (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   791
      by (auto simp: median_def length_chop)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   792
    finally have x_eq: "x = median (map slow_median (chop 5 xs))" .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   793
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   794
    text \<open>The cost of computing the medians of all the subgroups:\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   795
    define T_ms where "T_ms = T_map T_slow_median (chop 5 xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   796
    have "T_ms \<le> 9 * n + 45"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   797
    proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   798
      have "T_ms = (\<Sum>ys\<leftarrow>chop 5 xs. T_slow_median ys) + length (chop 5 xs) + 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   799
        by (simp add: T_ms_def T_map_eq)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   800
      also have "(\<Sum>ys\<leftarrow>chop 5 xs. T_slow_median ys) \<le> (\<Sum>ys\<leftarrow>chop 5 xs. 44)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   801
      proof (intro sum_list_mono)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   802
        fix ys assume "ys \<in> set (chop 5 xs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   803
        hence "length ys \<le> 5"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   804
          using length_chop_part_le by blast
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   805
        have "T_slow_median ys \<le> (length ys) ^ 2 + 3 * length ys + 4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   806
          by (rule T_slow_median_le)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   807
        also have "\<dots> \<le> 5 ^ 2 + 3 * 5 + 4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   808
          using \<open>length ys \<le> 5\<close> by (intro add_mono power_mono) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   809
        finally show "T_slow_median ys \<le> 44" by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   810
      qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   811
      also have "(\<Sum>ys\<leftarrow>chop 5 xs. 44) + length (chop 5 xs) + 1 =
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   812
                   45 * nat \<lceil>real n / 5\<rceil> + 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   813
        by (simp add: map_replicate_const length_chop)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   814
      also have "\<dots> \<le> 9 * n + 45"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   815
        by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   816
      finally show "T_ms \<le> 9 * n + 45" by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   817
    qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   818
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   819
    text \<open>The cost of the first recursive call (to compute the median of medians):\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   820
    define T_rec1 where
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   821
      "T_rec1 = T_mom_select (((length xs + 4) div 5 - 1) div 2) (map slow_median (chop 5 xs))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   822
    have "T_rec1 \<le> T'_mom_select (length (map slow_median (chop 5 xs)))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   823
      using False unfolding T_rec1_def by (intro IH(3)) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   824
    hence "T_rec1 \<le> T'_mom_select (nat \<lceil>0.2 * n\<rceil>)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   825
      by (simp add: length_chop)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   826
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   827
    text \<open>The cost of the second recursive call (to compute the final result):\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   828
    define T_rec2 where "T_rec2 = (if k < nl then T_mom_select k ls
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   829
                                 else if k < nl + ne then 0
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   830
                                 else T_mom_select (k - nl - ne) gs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   831
    consider "k < nl" | "k \<in> {nl..<nl+ne}" | "k \<ge> nl+ne"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   832
      by force
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   833
    hence "T_rec2 \<le> T'_mom_select (nat \<lceil>0.7 * n + 3\<rceil>)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   834
    proof cases
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   835
      assume "k < nl"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   836
      hence "T_rec2 = T_mom_select k ls"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   837
        by (simp add: T_rec2_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   838
      also have "\<dots> \<le> T'_mom_select (length ls)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   839
        by (rule IH(1)) (use \<open>k < nl\<close> False in \<open>auto simp: defs\<close>)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   840
      also have "length ls \<le> nat \<lceil>0.7 * n + 3\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   841
        unfolding ls_def using size_less_than_median_of_medians[of xs]
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   842
        by (auto simp: length_filter_conv_size_filter_mset slow_median_correct[abs_def] x_eq)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   843
      hence "T'_mom_select (length ls) \<le> T'_mom_select (nat \<lceil>0.7 * n + 3\<rceil>)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   844
        by (rule T'_mom_select_mono)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   845
      finally show ?thesis .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   846
    next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   847
      assume "k \<in> {nl..<nl + ne}"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   848
      hence "T_rec2 = 0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   849
        by (simp add: T_rec2_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   850
      thus ?thesis
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   851
        using T'_mom_select_ge[of "nat \<lceil>0.7 * n + 3\<rceil>"] by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   852
    next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   853
      assume "k \<ge> nl + ne"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   854
      hence "T_rec2 = T_mom_select (k - nl - ne) gs"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   855
        by (simp add: T_rec2_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   856
      also have "\<dots> \<le> T'_mom_select (length gs)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   857
        unfolding nl_def ne_def by (rule IH(2)) (use \<open>k \<ge> nl + ne\<close> False in \<open>auto simp: defs\<close>)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   858
      also have "length gs \<le> nat \<lceil>0.7 * n + 3\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   859
        unfolding gs_def using size_greater_than_median_of_medians[of xs]
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   860
        by (auto simp: length_filter_conv_size_filter_mset slow_median_correct[abs_def] x_eq)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   861
      hence "T'_mom_select (length gs) \<le> T'_mom_select (nat \<lceil>0.7 * n + 3\<rceil>)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   862
        by (rule T'_mom_select_mono)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   863
      finally show ?thesis .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   864
    qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   865
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   866
    text \<open>Now for the final inequality chain:\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   867
    have "T_mom_select k xs = T_rec2 + T_rec1 + T_ms + n + nl + ne + T_chop 5 xs + 4" using False
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   868
      by (subst T_mom_select.simps, unfold Let_def tw [symmetric] defs [symmetric])
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   869
         (simp_all add: nl_def ne_def T_rec1_def T_rec2_def T_partition3_eq
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   870
                        T_length_eq T_ms_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   871
    also have "nl \<le> n" by (simp add: nl_def ls_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   872
    also have "ne \<le> n" by (simp add: ne_def es_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   873
    also note \<open>T_ms \<le> 9 * n + 45\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   874
    also have "T_chop 5 xs \<le> 5 * n + 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   875
      using T_chop_le[of 5 xs] by simp 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   876
    also note \<open>T_rec1 \<le> T'_mom_select (nat \<lceil>0.2*n\<rceil>)\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   877
    also note \<open>T_rec2 \<le> T'_mom_select (nat \<lceil>0.7*n + 3\<rceil>)\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   878
    finally have "T_mom_select k xs \<le>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   879
                    T'_mom_select (nat \<lceil>0.7*n + 3\<rceil>) + T'_mom_select (nat \<lceil>0.2*n\<rceil>) + 17 * n + 50"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   880
      by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   881
    also have "\<dots> = T'_mom_select n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   882
      using False by (subst T'_mom_select.simps) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   883
    finally show ?thesis by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   884
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   885
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   886
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   887
subsection \<open>Akra--Bazzi Light\<close>
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   888
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   889
lemma akra_bazzi_light_aux1:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   890
  fixes a b :: real and n n0 :: nat
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   891
  assumes ab: "a > 0" "a < 1" "n > n0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   892
  assumes "n0 \<ge> (max 0 b + 1) / (1 - a)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   893
  shows "nat \<lceil>a*n+b\<rceil> < n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   894
proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   895
  have "a * real n + max 0 b \<ge> 0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   896
    using ab by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   897
  hence "real (nat \<lceil>a*n+b\<rceil>) \<le> a * n + max 0 b + 1"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   898
    by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   899
  also {
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   900
    have "n0 \<ge> (max 0 b + 1) / (1 - a)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   901
      by fact
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   902
    also have "\<dots> < real n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   903
      using assms by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   904
    finally have "a * real n + max 0 b + 1 < real n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   905
      using ab by (simp add: field_simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   906
  }
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   907
  finally show "nat \<lceil>a*n+b\<rceil> < n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   908
    using \<open>n > n0\<close> by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   909
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   910
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   911
lemma akra_bazzi_light_aux2:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   912
  fixes f :: "nat \<Rightarrow> real"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   913
  fixes n\<^sub>0 :: nat and a b c d :: real and C1 C2 C\<^sub>1 C\<^sub>2 :: real
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   914
  assumes bounds: "a > 0" "c > 0" "a + c < 1" "C\<^sub>1 \<ge> 0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   915
  assumes rec: "\<forall>n>n\<^sub>0. f n = f (nat \<lceil>a*n+b\<rceil>) + f (nat \<lceil>c*n+d\<rceil>) + C\<^sub>1 * n + C\<^sub>2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   916
  assumes ineqs: "n\<^sub>0 > (max 0 b + max 0 d + 2) / (1 - a - c)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   917
                 "C\<^sub>3 \<ge> C\<^sub>1 / (1 - a - c)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   918
                 "C\<^sub>3 \<ge> (C\<^sub>1 * n\<^sub>0 + C\<^sub>2 + C\<^sub>4) / ((1 - a - c) * n\<^sub>0 - max 0 b - max 0 d - 2)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   919
                 "\<forall>n\<le>n\<^sub>0. f n \<le> C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   920
  shows   "f n \<le> C\<^sub>3 * n + C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   921
proof (induction n rule: less_induct)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   922
  case (less n)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   923
  have "0 \<le> C\<^sub>1 / (1 - a - c)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   924
    using bounds by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   925
  also have "\<dots> \<le> C\<^sub>3"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   926
    by fact
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   927
  finally have "C\<^sub>3 \<ge> 0" .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   928
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   929
  show ?case
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   930
  proof (cases "n > n\<^sub>0")
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   931
    case False
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   932
    hence "f n \<le> C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   933
      using ineqs(4) by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   934
    also have "\<dots> \<le> C\<^sub>3 * real n + C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   935
      using bounds \<open>C\<^sub>3 \<ge> 0\<close> by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   936
    finally show ?thesis .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   937
  next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   938
    case True
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   939
    have nonneg: "a * n \<ge> 0" "c * n \<ge> 0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   940
      using bounds by simp_all
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   941
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   942
    have "(max 0 b + 1) / (1 - a) \<le> (max 0 b + max 0 d + 2) / (1 - a - c)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   943
      using bounds by (intro frac_le) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   944
    hence "n\<^sub>0 \<ge> (max 0 b + 1) / (1 - a)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   945
      using ineqs(1) by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   946
    hence rec_less1: "nat \<lceil>a*n+b\<rceil> < n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   947
      using bounds \<open>n > n\<^sub>0\<close> by (intro akra_bazzi_light_aux1[of _ n\<^sub>0]) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   948
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   949
    have "(max 0 d + 1) / (1 - c) \<le> (max 0 b + max 0 d + 2) / (1 - a - c)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   950
      using bounds by (intro frac_le) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   951
    hence "n\<^sub>0 \<ge> (max 0 d + 1) / (1 - c)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   952
      using ineqs(1) by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   953
    hence rec_less2: "nat \<lceil>c*n+d\<rceil> < n"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   954
      using bounds \<open>n > n\<^sub>0\<close> by (intro akra_bazzi_light_aux1[of _ n\<^sub>0]) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   955
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   956
    have "f n = f (nat \<lceil>a*n+b\<rceil>) + f (nat \<lceil>c*n+d\<rceil>) + C\<^sub>1 * n + C\<^sub>2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   957
      using \<open>n > n\<^sub>0\<close> by (subst rec) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   958
    also have "\<dots> \<le> (C\<^sub>3 * nat \<lceil>a*n+b\<rceil> + C\<^sub>4) + (C\<^sub>3 * nat \<lceil>c*n+d\<rceil> + C\<^sub>4) + C\<^sub>1 * n + C\<^sub>2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   959
      using rec_less1 rec_less2 by (intro add_mono less.IH) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   960
    also have "\<dots> \<le> (C\<^sub>3 * (a*n+max 0 b+1) + C\<^sub>4) + (C\<^sub>3 * (c*n+max 0 d+1) + C\<^sub>4) + C\<^sub>1 * n + C\<^sub>2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   961
      using bounds \<open>C\<^sub>3 \<ge> 0\<close> nonneg by (intro add_mono mult_left_mono order.refl; linarith)      
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   962
    also have "\<dots> = C\<^sub>3 * n  +  ((C\<^sub>3 * (max 0 b + max 0 d + 2) + 2 * C\<^sub>4 + C\<^sub>2) -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   963
                                 (C\<^sub>3 * (1 - a - c) - C\<^sub>1) * n)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   964
      by (simp add: algebra_simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   965
    also have "\<dots> \<le> C\<^sub>3 * n  +  ((C\<^sub>3 * (max 0 b + max 0 d + 2) + 2 * C\<^sub>4 + C\<^sub>2) -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   966
                                 (C\<^sub>3 * (1 - a - c) - C\<^sub>1) * n\<^sub>0)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   967
      using \<open>n > n\<^sub>0\<close> ineqs(2) bounds
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   968
      by (intro add_mono diff_mono order.refl mult_left_mono) (auto simp: field_simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   969
    also have "(C\<^sub>3 * (max 0 b + max 0 d + 2) + 2 * C\<^sub>4 + C\<^sub>2) - (C\<^sub>3 * (1 - a - c) - C\<^sub>1) * n\<^sub>0 \<le> C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   970
      using ineqs bounds by (simp add: field_simps)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   971
    finally show "f n \<le> C\<^sub>3 * real n + C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   972
      by (simp add: mult_right_mono)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   973
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   974
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   975
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   976
lemma akra_bazzi_light:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   977
  fixes f :: "nat \<Rightarrow> real"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   978
  fixes n\<^sub>0 :: nat and a b c d C\<^sub>1 C\<^sub>2 :: real
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   979
  assumes bounds: "a > 0" "c > 0" "a + c < 1" "C\<^sub>1 \<ge> 0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   980
  assumes rec: "\<forall>n>n\<^sub>0. f n = f (nat \<lceil>a*n+b\<rceil>) + f (nat \<lceil>c*n+d\<rceil>) + C\<^sub>1 * n + C\<^sub>2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   981
  shows "\<exists>C\<^sub>3 C\<^sub>4. \<forall>n. f n \<le> C\<^sub>3 * real n + C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   982
proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   983
  define n\<^sub>0' where "n\<^sub>0' = max n\<^sub>0 (nat \<lceil>(max 0 b + max 0 d + 2) / (1 - a - c) + 1\<rceil>)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   984
  define C\<^sub>4 where "C\<^sub>4 = Max (f ` {..n\<^sub>0'})"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   985
  define C\<^sub>3 where "C\<^sub>3 = max (C\<^sub>1 / (1 - a - c))
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   986
                         ((C\<^sub>1 * n\<^sub>0' + C\<^sub>2 + C\<^sub>4) / ((1 - a - c) * n\<^sub>0' - max 0 b - max 0 d - 2))"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   987
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   988
  have "f n \<le> C\<^sub>3 * n + C\<^sub>4" for n
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   989
  proof (rule akra_bazzi_light_aux2[OF bounds _])
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   990
    show "\<forall>n>n\<^sub>0'. f n = f (nat \<lceil>a*n+b\<rceil>) + f (nat \<lceil>c*n+d\<rceil>) + C\<^sub>1 * n + C\<^sub>2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   991
      using rec by (auto simp: n\<^sub>0'_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   992
  next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   993
    show "C\<^sub>3 \<ge> C\<^sub>1 / (1 - a - c)" 
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   994
     and "C\<^sub>3 \<ge> (C\<^sub>1 * n\<^sub>0' + C\<^sub>2 + C\<^sub>4) / ((1 - a - c) * n\<^sub>0' - max 0 b - max 0 d - 2)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   995
      by (simp_all add: C\<^sub>3_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   996
  next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   997
    have "(max 0 b + max 0 d + 2) / (1 - a - c) < nat \<lceil>(max 0 b + max 0 d + 2) / (1 - a - c) + 1\<rceil>"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   998
      by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
   999
    also have "\<dots> \<le> n\<^sub>0'"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1000
      by (simp add: n\<^sub>0'_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1001
    finally show "(max 0 b + max 0 d + 2) / (1 - a - c) < real n\<^sub>0'" .
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1002
  next
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1003
    show "\<forall>n\<le>n\<^sub>0'. f n \<le> C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1004
      by (auto simp: C\<^sub>4_def)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1005
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1006
  thus ?thesis by blast
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1007
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1008
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1009
lemma akra_bazzi_light_nat:
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1010
  fixes f :: "nat \<Rightarrow> nat"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1011
  fixes n\<^sub>0 :: nat and a b c d :: real and C\<^sub>1 C\<^sub>2 :: nat
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1012
  assumes bounds: "a > 0" "c > 0" "a + c < 1" "C\<^sub>1 \<ge> 0"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1013
  assumes rec: "\<forall>n>n\<^sub>0. f n = f (nat \<lceil>a*n+b\<rceil>) + f (nat \<lceil>c*n+d\<rceil>) + C\<^sub>1 * n + C\<^sub>2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1014
  shows "\<exists>C\<^sub>3 C\<^sub>4. \<forall>n. f n \<le> C\<^sub>3 * n + C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1015
proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1016
  have "\<exists>C\<^sub>3 C\<^sub>4. \<forall>n. real (f n) \<le> C\<^sub>3 * real n + C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1017
    using assms by (intro akra_bazzi_light[of a c C\<^sub>1 n\<^sub>0 f b d C\<^sub>2]) auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1018
  then obtain C\<^sub>3 C\<^sub>4 where le: "\<forall>n. real (f n) \<le> C\<^sub>3 * real n + C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1019
    by blast
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1020
  have "f n \<le> nat \<lceil>C\<^sub>3\<rceil> * n + nat \<lceil>C\<^sub>4\<rceil>" for n
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1021
  proof -
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1022
    have "real (f n) \<le> C\<^sub>3 * real n + C\<^sub>4"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1023
      using le by blast
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1024
    also have "\<dots> \<le> real (nat \<lceil>C\<^sub>3\<rceil>) * real n + real (nat \<lceil>C\<^sub>4\<rceil>)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1025
      by (intro add_mono mult_right_mono; linarith)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1026
    also have "\<dots> = real (nat \<lceil>C\<^sub>3\<rceil> * n + nat \<lceil>C\<^sub>4\<rceil>)"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1027
      by simp
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1028
    finally show ?thesis by linarith
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1029
  qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1030
  thus ?thesis by blast
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1031
qed
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1032
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1033
lemma T'_mom_select_le': "\<exists>C\<^sub>1 C\<^sub>2. \<forall>n. T'_mom_select n \<le> C\<^sub>1 * n + C\<^sub>2"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1034
proof (rule akra_bazzi_light_nat)
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1035
  show "\<forall>n>20. T'_mom_select n = T'_mom_select (nat \<lceil>0.2 * n + 0\<rceil>) +
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1036
                 T'_mom_select (nat \<lceil>0.7 * n + 3\<rceil>) + 17 * n + 50"
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1037
    using T'_mom_select.simps by auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1038
qed auto
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1039
981a383610df HOL-Data_Structures: added Selection and time functions for list functions
Manuel Eberl <eberlm@in.tum.de>
parents:
diff changeset
  1040
end