(* File:   Akra_Bazzi_Asymptotics.thy
   Author: Manuel Eberl <eberlm@in.tum.de>

   Proofs for the four(ish) asymptotic inequalities required for proving the
   Akra Bazzi theorem with variation functions in the recursive calls.
*)

section \<open>Asymptotic bounds\<close>
theory Akra_Bazzi_Asymptotics
imports
  Complex_Main
  Akra_Bazzi_Library
  "HOL-Library.Landau_Symbols"
begin

locale akra_bazzi_asymptotics_bep =
  fixes b e p hb :: real
  assumes bep: "b > 0" "b < 1" "e > 0" "hb > 0"
begin

context
begin

text \<open>
  Functions that are negligible w.r.t. @{term "ln (b*x) powr (e/2 + 1)"}.
\<close>
private abbreviation (input) negl :: "(real \<Rightarrow> real) \<Rightarrow> bool" where
  "negl f \<equiv> f \<in> o(\<lambda>x. ln (b*x) powr (-(e/2 + 1)))"

private lemma neglD: "negl f \<Longrightarrow> c > 0 \<Longrightarrow> eventually (\<lambda>x. \<bar>f x\<bar> \<le> c / ln (b*x) powr (e/2+1)) at_top"
  by (drule (1) landau_o.smallD, subst (asm) powr_minus) (simp add: field_simps)

private lemma negl_mult: "negl f \<Longrightarrow> negl g \<Longrightarrow> negl (\<lambda>x. f x * g x)"
  by (erule landau_o.small_1_mult, rule landau_o.small_imp_big, erule landau_o.small_trans)
     (insert bep, simp)

private lemma ev4:
  assumes g: "negl g"
  shows   "eventually (\<lambda>x. ln (b*x) powr (-e/2) - ln x powr (-e/2) \<ge> g x) at_top"
proof (rule smallo_imp_le_real)
  define h1 where [abs_def]:
    "h1 x = (1 + ln b/ln x) powr (-e/2) - 1 + e/2 * (ln b/ln x)" for x
  define h2 where [abs_def]:
    "h2 x = ln x powr (- e / 2) * ((1 + ln b / ln x) powr (- e / 2) - 1)" for x
  from bep have "((\<lambda>x. ln b / ln x) \<longlongrightarrow> 0) at_top"
    by (simp add: tendsto_0_smallo_1)
  note one_plus_x_powr_Taylor2_bigo[OF this, of "-e/2"]
  also have "(\<lambda>x. (1 + ln b / ln x) powr (- e / 2) - 1 - - e / 2 * (ln b / ln x)) = h1"
    by (simp add: h1_def)
  finally have "h1 \<in> o(\<lambda>x. 1 / ln x)"
    by (rule landau_o.big_small_trans) (insert bep, simp add: power2_eq_square)
  with bep have "(\<lambda>x. h1 x - e/2 * (ln b / ln x)) \<in> \<Theta>(\<lambda>x. 1 / ln x)" by simp
  also have "(\<lambda>x. h1 x - e/2 * (ln b/ln x)) = (\<lambda>x. (1 + ln b/ ln x) powr (-e/2) - 1)"
    by (rule ext) (simp add: h1_def)
  finally have "h2 \<in> \<Theta>(\<lambda>x. ln x powr (-e/2) * (1 / ln x))" unfolding h2_def
    by (intro landau_theta.mult) simp_all
  also have "(\<lambda>x. ln x powr (-e/2) * (1 / ln x)) \<in> \<Theta>(\<lambda>x. ln x powr (-(e/2+1)))" by simp
  also from g bep have "(\<lambda>x. ln x powr (-(e/2+1))) \<in> \<omega>(g)" by (simp add: smallomega_iff_smallo)
  finally have "g \<in> o(h2)" by (simp add: smallomega_iff_smallo)
  also have "eventually (\<lambda>x. h2 x = ln (b*x) powr (-e/2) - ln x powr (-e/2)) at_top"
    using eventually_gt_at_top[of "1::real"] eventually_gt_at_top[of "1/b"]
    by eventually_elim (insert bep, simp add: field_simps powr_diff [symmetric]  h2_def
                                      ln_mult [symmetric] powr_divide del: ln_mult)
  hence "h2 \<in> \<Theta>(\<lambda>x. ln (b*x) powr (-e/2) - ln x powr (-e/2))" by (rule bigthetaI_cong)
  finally show "g \<in> o(\<lambda>x. ln (b * x) powr (- e / 2) - ln x powr (- e / 2))" .
next
  show "eventually (\<lambda>x. ln (b*x) powr (-e/2) - ln x powr (-e/2) \<ge> 0) at_top"
    using eventually_gt_at_top[of "1/b"] eventually_gt_at_top[of "1::real"]
    by eventually_elim (insert bep, auto intro!: powr_mono2' simp: field_simps simp del: ln_mult)
qed

private lemma ev1:
  "negl (\<lambda>x. (1 + c * inverse b * ln x powr (-(1+e))) powr p - 1)"
proof-
  from bep have "((\<lambda>x. c * inverse b * ln x powr (-(1+e))) \<longlongrightarrow> 0) at_top"
    by (simp add: tendsto_0_smallo_1)
  have "(\<lambda>x. (1 + c * inverse b * ln x powr (-(1+e))) powr p - 1)
           \<in> O(\<lambda>x. c * inverse b * ln x powr - (1 + e))"
    using bep by (intro one_plus_x_powr_Taylor1_bigo) (simp add: tendsto_0_smallo_1)
  also from bep have "negl (\<lambda>x. c * inverse b * ln x powr - (1 + e))" by simp
  finally show ?thesis .
qed

private lemma ev2_aux:
  defines "f \<equiv> \<lambda>x. (1 + 1/ln (b*x) * ln (1 + hb / b * ln x powr (-1-e))) powr (-e/2)"
  obtains h where "eventually (\<lambda>x. f x \<ge> 1 + h x) at_top" "h \<in> o(\<lambda>x. 1 / ln x)"
proof (rule that[of "\<lambda>x. f x - 1"])
  define g where [abs_def]: "g x = 1/ln (b*x) * ln (1 + hb / b * ln x powr (-1-e))" for x
  have lim: "((\<lambda>x. ln (1 + hb / b * ln x powr (- 1 - e))) \<longlongrightarrow> 0) at_top"
    by (rule tendsto_eq_rhs[OF tendsto_ln[OF tendsto_add[OF tendsto_const, of _ 0]]])
       (insert bep, simp_all add: tendsto_0_smallo_1)
  hence lim': "(g \<longlongrightarrow> 0) at_top" unfolding g_def
    by (intro tendsto_mult_zero) (insert bep, simp add: tendsto_0_smallo_1)
  from one_plus_x_powr_Taylor2_bigo[OF this, of "-e/2"]
    have "(\<lambda>x. (1 + g x) powr (-e/2) - 1 - - e/2 * g x) \<in> O(\<lambda>x. (g x)\<^sup>2)" .
  also from lim' have "(\<lambda>x. g x ^ 2) \<in> o(\<lambda>x. g x * 1)" unfolding power2_eq_square
    by (intro landau_o.big_small_mult smalloI_tendsto) simp_all
  also have "o(\<lambda>x. g x * 1) = o(g)" by simp
  also have "(\<lambda>x. (1 + g x) powr (-e/2) - 1 - - e/2 * g x) = (\<lambda>x. f x - 1 + e/2 * g x)"
    by (simp add: f_def g_def)
  finally have A: "(\<lambda>x. f x - 1 + e / 2 * g x) \<in> O(g)" by (rule landau_o.small_imp_big)
  hence "(\<lambda>x. f x - 1 + e/2 * g x - e/2 * g x) \<in> O(g)"
    by (rule sum_in_bigo) (insert bep, simp)
  also have "(\<lambda>x. f x - 1 + e/2 * g x - e/2 * g x) = (\<lambda>x. f x - 1)" by simp
  finally have "(\<lambda>x. f x - 1) \<in> O(g)" .
  also from bep lim have "g \<in> o(\<lambda>x. 1 / ln x)" unfolding g_def
    by (auto intro!: smallo_1_tendsto_0)
  finally show "(\<lambda>x. f x - 1) \<in> o(\<lambda>x. 1 / ln x)" .
qed simp_all

private lemma ev2:
  defines "f \<equiv> \<lambda>x. ln (b * x + hb * x / ln x powr (1 + e)) powr (-e/2)"
  obtains h where
    "negl h"
    "eventually (\<lambda>x. f x \<ge> ln (b * x) powr (-e/2) + h x) at_top"
    "eventually (\<lambda>x. \<bar>ln (b * x) powr (-e/2) + h x\<bar> < 1) at_top"
proof -
  define f'
    where "f' x = (1 + 1 / ln (b*x) * ln (1 + hb / b * ln x powr (-1-e))) powr (-e/2)" for x
  from ev2_aux obtain g where g: "eventually (\<lambda>x. 1 + g x \<le> f' x) at_top" "g \<in> o(\<lambda>x. 1 / ln x)"
    unfolding f'_def .
  define h where [abs_def]: "h x = ln (b*x) powr (-e/2) * g x" for x
  show ?thesis
  proof (rule that[of h])
    from bep g show "negl h" unfolding h_def
      by (auto simp: powr_diff elim: landau_o.small_big_trans)
  next
    from g(2) have "g \<in> o(\<lambda>x. 1)" by (rule landau_o.small_big_trans) simp
    with bep have "eventually (\<lambda>x. \<bar>ln (b*x) powr (-e/2) * (1 + g x)\<bar> < 1) at_top"
      by (intro smallo_imp_abs_less_real) simp_all
    thus "eventually (\<lambda>x. \<bar>ln (b*x) powr (-e/2) + h x\<bar> < 1) at_top"
      by (simp add: algebra_simps h_def)
  next
    from eventually_gt_at_top[of "1/b"] and g(1)
      show "eventually (\<lambda>x. f x \<ge> ln (b*x) powr (-e/2) + h x) at_top"
    proof eventually_elim
      case (elim x)
      from bep have "b * x + hb * x / ln x powr (1 + e) = b*x * (1 + hb / b * ln x powr (-1 - e))"
        by (simp add: field_simps powr_diff powr_add powr_minus)
      also from elim(1) bep
        have "ln \<dots> = ln (b*x) * (1 + 1/ln (b*x) * ln (1 + hb / b * ln x powr (-1-e)))"
        by (subst ln_mult) (simp_all add: add_pos_nonneg field_simps)
      also from elim(1) bep have "\<dots> powr (-e/2) = ln (b*x) powr (-e/2) * f' x"
        by (subst powr_mult) (simp_all add: field_simps f'_def)
      also from elim have "\<dots> \<ge> ln (b*x) powr (-e/2) * (1 + g x)"
        by (intro mult_left_mono) simp_all
      finally show "f x \<ge> ln (b*x) powr (-e/2) + h x"
        by (simp add: f_def h_def algebra_simps)
    qed
  qed
qed

private lemma ev21:
  obtains g where
    "negl g"
    "eventually (\<lambda>x. 1 + ln (b * x + hb * x / ln x powr (1 + e)) powr (-e/2) \<ge>
         1 + ln (b * x) powr (-e/2) + g x) at_top"
    "eventually (\<lambda>x. 1 + ln (b * x) powr (-e/2) + g x > 0) at_top"
proof-
  from ev2 guess g . note g = this
  from g(3) have "eventually (\<lambda>x. 1 + ln (b * x) powr (-e/2) + g x > 0) at_top"
    by eventually_elim simp
  with g(1,2) show ?thesis by (intro that[of g]) simp_all
qed

private lemma ev22:
  obtains g where
    "negl g"
    "eventually (\<lambda>x. 1 - ln (b * x + hb * x / ln x powr (1 + e)) powr (-e/2) \<le>
         1 - ln (b * x) powr (-e/2) - g x) at_top"
    "eventually (\<lambda>x. 1 - ln (b * x) powr (-e/2) - g x > 0) at_top"
proof-
  from ev2 guess g . note g = this
  from g(2) have "eventually (\<lambda>x. 1 - ln (b * x + hb * x / ln x powr (1 + e)) powr (-e/2) \<le>
                                      1 - ln (b * x) powr (-e/2) - g x) at_top"
    by eventually_elim simp
  moreover from g(3) have "eventually (\<lambda>x. 1 - ln (b * x) powr (-e/2) - g x > 0) at_top"
    by eventually_elim simp
  ultimately show ?thesis using g(1) by (intro that[of g]) simp_all
qed

lemma asymptotics1:
  shows "eventually (\<lambda>x.
             (1 + c * inverse b * ln x powr -(1+e)) powr p *
             (1 + ln (b * x + hb * x / ln x powr (1 + e)) powr (- e / 2)) \<ge>
             1 + (ln x powr (-e/2))) at_top"
proof-
  let ?f = "\<lambda>x. (1 + c * inverse b * ln x powr -(1+e)) powr p"
  let ?g = "\<lambda>x. 1 + ln (b * x + hb * x / ln x powr (1 + e)) powr (- e / 2)"
  define f where [abs_def]: "f x = 1 - ?f x" for x
  from ev1[of c] have "negl f" unfolding f_def
    by (subst landau_o.small.uminus_in_iff [symmetric]) simp
  from landau_o.smallD[OF this zero_less_one]
    have f: "eventually (\<lambda>x. f x \<le> ln (b*x) powr -(e/2+1)) at_top"
    by eventually_elim (simp add: f_def)

  from ev21 guess g . note g = this
  define h where [abs_def]: "h x = -g x + f x + f x * ln (b*x) powr (-e/2) + f x * g x" for x

  have A: "eventually (\<lambda>x. ?f x * ?g x \<ge> 1 + ln (b*x) powr (-e/2) - h x) at_top"
    using g(2,3) f
  proof eventually_elim
    case (elim x)
    let ?t = "ln (b*x) powr (-e/2)"
    have "1 + ?t - h x = (1 - f x) * (1 + ln (b*x) powr (-e/2) + g x)"
      by (simp add: algebra_simps h_def)
    also from elim have "?f x * ?g x \<ge> (1 - f x) * (1 + ln (b*x) powr (-e/2) + g x)"
      by (intro mult_mono[OF _ elim(1)]) (simp_all add: algebra_simps f_def)
    finally show "?f x * ?g x \<ge> 1 + ln (b*x) powr (-e/2) - h x" .
  qed
  from bep \<open>negl f\<close> g(1) have "negl h" unfolding h_def
    by (fastforce intro!: sum_in_smallo landau_o.small.mult simp: powr_diff
                  intro: landau_o.small_trans)+
  from ev4[OF this] A show ?thesis by eventually_elim simp
qed

lemma asymptotics2:
  shows "eventually (\<lambda>x.
             (1 + c * inverse b * ln x powr -(1+e)) powr p *
             (1 - ln (b * x + hb * x / ln x powr (1 + e)) powr (- e / 2)) \<le>
             1 - (ln x powr (-e/2))) at_top"
proof-
  let ?f = "\<lambda>x. (1 + c * inverse b * ln x powr -(1+e)) powr p"
  let ?g = "\<lambda>x. 1 - ln (b * x + hb * x / ln x powr (1 + e)) powr (- e / 2)"

  define f where [abs_def]: "f x = 1 - ?f x" for x
  from ev1[of c] have "negl f" unfolding f_def
    by (subst landau_o.small.uminus_in_iff [symmetric]) simp
  from landau_o.smallD[OF this zero_less_one]
    have f: "eventually (\<lambda>x. f x \<le> ln (b*x) powr -(e/2+1)) at_top"
    by eventually_elim (simp add: f_def)

  from ev22 guess g . note g = this
  define h where [abs_def]: "h x = -g x - f x + f x * ln (b*x) powr (-e/2) + f x * g x" for x
  have "((\<lambda>x. ln (b * x + hb * x / ln x powr (1 + e)) powr - (e / 2)) \<longlongrightarrow> 0) at_top"
    apply (insert bep, intro tendsto_neg_powr, simp)
    apply (rule filterlim_compose[OF ln_at_top])
    apply (rule filterlim_at_top_smallomega_1, simp)
    using eventually_gt_at_top[of "max 1 (1/b)"]
    apply (auto elim!: eventually_mono intro!: add_pos_nonneg simp: field_simps)
    done
  hence ev_g: "eventually (\<lambda>x. \<bar>1 - ?g x\<bar> < 1) at_top"
    by (intro smallo_imp_abs_less_real smalloI_tendsto) simp_all

  have A: "eventually (\<lambda>x. ?f x * ?g x \<le> 1 - ln (b*x) powr (-e/2) + h x) at_top"
    using g(2,3) ev_g f
  proof eventually_elim
    case (elim x)
    let ?t = "ln (b*x) powr (-e/2)"
    from elim have "?f x * ?g x \<le> (1 - f x) * (1 - ln (b*x) powr (-e/2) - g x)"
      by (intro mult_mono) (simp_all add: f_def)
    also have "... = 1 - ?t + h x" by (simp add: algebra_simps h_def)
    finally show "?f x * ?g x \<le> 1 - ln (b*x) powr (-e/2) + h x" .
  qed
  from bep \<open>negl f\<close> g(1) have "negl h" unfolding h_def
    by (fastforce intro!: sum_in_smallo landau_o.small.mult simp: powr_diff
                  intro: landau_o.small_trans)+
  from ev4[OF this] A show ?thesis by eventually_elim simp
qed

lemma asymptotics3: "eventually (\<lambda>x. (1 + (ln x powr (-e/2))) / 2 \<le> 1) at_top"
  (is "eventually (\<lambda>x. ?f x \<le> 1) _")
proof (rule eventually_mp[OF always_eventually], clarify)
  from bep have "(?f \<longlongrightarrow> 1/2) at_top"
    by (force intro: tendsto_eq_intros tendsto_neg_powr ln_at_top)
  hence "\<And>e. e>0 \<Longrightarrow> eventually (\<lambda>x. \<bar>?f x - 0.5\<bar> < e) at_top"
    by (subst (asm) tendsto_iff) (simp add: dist_real_def)
  from this[of "0.5"] show "eventually (\<lambda>x. \<bar>?f x - 0.5\<bar> < 0.5) at_top" by simp
  fix x assume "\<bar>?f x - 0.5\<bar> < 0.5"
  thus "?f x \<le> 1" by simp
qed

lemma asymptotics5: "eventually (\<lambda>x. ln (b*x - hb*x*ln x powr -(1+e)) powr (-e/2) < 1) at_top"
proof-
  from bep have "((\<lambda>x. b - hb * ln x powr -(1+e)) \<longlongrightarrow> b - 0) at_top"
    by (intro tendsto_intros tendsto_mult_right_zero tendsto_neg_powr ln_at_top) simp_all
  hence "LIM x at_top. (b - hb * ln x powr -(1+e)) * x :> at_top"
    by (rule filterlim_tendsto_pos_mult_at_top[OF _ _ filterlim_ident], insert bep) simp_all
  also have "(\<lambda>x. (b - hb * ln x powr -(1+e)) * x) = (\<lambda>x. b*x - hb*x*ln x powr -(1+e))"
    by (intro ext) (simp add: algebra_simps)
  finally have "filterlim ... at_top at_top" .
  with bep have "((\<lambda>x. ln (b*x - hb*x*ln x powr -(1+e)) powr -(e/2)) \<longlongrightarrow> 0) at_top"
    by (intro tendsto_neg_powr filterlim_compose[OF ln_at_top]) simp_all
  hence "eventually (\<lambda>x. \<bar>ln (b*x - hb*x*ln x powr -(1+e)) powr (-e/2)\<bar> < 1) at_top"
    by (subst (asm) tendsto_iff) (simp add: dist_real_def)
  thus ?thesis by simp
qed

lemma asymptotics6: "eventually (\<lambda>x. hb / ln x powr (1 + e) < b/2) at_top"
  and asymptotics7: "eventually (\<lambda>x. hb / ln x powr (1 + e) < (1 - b) / 2) at_top"
  and asymptotics8: "eventually (\<lambda>x. x*(1 - b - hb / ln x powr (1 + e)) > 1) at_top"
proof-
  from bep have A: "(\<lambda>x. hb / ln x powr (1 + e)) \<in> o(\<lambda>_. 1)" by simp
  from bep have B: "b/3 > 0" and C: "(1 - b)/3 > 0" by simp_all
  from landau_o.smallD[OF A B] show "eventually (\<lambda>x. hb / ln x powr (1+e) < b/2) at_top"
    by eventually_elim (insert bep, simp)
  from landau_o.smallD[OF A C] show "eventually (\<lambda>x. hb / ln x powr (1 + e) < (1 - b)/2) at_top"
    by eventually_elim (insert bep, simp)

  from bep have "(\<lambda>x. hb / ln x powr (1 + e)) \<in> o(\<lambda>_. 1)" "(1 - b) / 2 > 0" by simp_all
  from landau_o.smallD[OF this] eventually_gt_at_top[of "1::real"]
    have A: "eventually (\<lambda>x. 1 - b - hb / ln x powr (1 + e) > 0) at_top"
    by eventually_elim (insert bep, simp add: field_simps)
  from bep have "(\<lambda>x. x * (1 - b - hb / ln x powr (1+e))) \<in> \<omega>(\<lambda>_. 1)" "(0::real) < 2" by simp_all
  from landau_omega.smallD[OF this] A eventually_gt_at_top[of "0::real"]
    show "eventually (\<lambda>x. x*(1 - b - hb / ln x powr (1 + e)) > 1) at_top"
    by eventually_elim (simp_all add: abs_mult)
qed

end
end

definition "akra_bazzi_asymptotic1 b hb e p x \<longleftrightarrow>
  (1 - hb * inverse b * ln x powr -(1+e)) powr p * (1 + ln (b*x + hb*x/ln x powr (1+e)) powr (-e/2))
  \<ge> 1 + (ln x powr (-e/2) :: real)"
definition "akra_bazzi_asymptotic1' b hb e p x \<longleftrightarrow>
  (1 + hb * inverse b * ln x powr -(1+e)) powr p * (1 + ln (b*x + hb*x/ln x powr (1+e)) powr (-e/2))
  \<ge> 1 + (ln x powr (-e/2) :: real)"
definition "akra_bazzi_asymptotic2 b hb e p x \<longleftrightarrow>
  (1 + hb * inverse b * ln x powr -(1+e)) powr p * (1 - ln (b*x + hb*x/ln x powr (1+e)) powr (-e/2))
      \<le> 1 - ln x powr (-e/2 :: real)"
definition "akra_bazzi_asymptotic2' b hb e p x \<longleftrightarrow>
  (1 - hb * inverse b * ln x powr -(1+e)) powr p * (1 - ln (b*x + hb*x/ln x powr (1+e)) powr (-e/2))
      \<le> 1 - ln x powr (-e/2 :: real)"
definition "akra_bazzi_asymptotic3 e x \<longleftrightarrow> (1 + (ln x powr (-e/2))) / 2 \<le> (1::real)"
definition "akra_bazzi_asymptotic4 e x \<longleftrightarrow> (1 - (ln x powr (-e/2))) * 2 \<ge> (1::real)"
definition "akra_bazzi_asymptotic5 b hb e x \<longleftrightarrow>
  ln (b*x - hb*x*ln x powr -(1+e)) powr (-e/2::real) < 1"

definition "akra_bazzi_asymptotic6 b hb e x \<longleftrightarrow> hb / ln x powr (1 + e :: real) < b/2"
definition "akra_bazzi_asymptotic7 b hb e x \<longleftrightarrow> hb / ln x powr (1 + e :: real) < (1 - b) / 2"
definition "akra_bazzi_asymptotic8 b hb e x \<longleftrightarrow> x*(1 - b - hb / ln x powr (1 + e :: real)) > 1"

definition "akra_bazzi_asymptotics b hb e p x \<longleftrightarrow>
  akra_bazzi_asymptotic1 b hb e p x \<and> akra_bazzi_asymptotic1' b hb e p x \<and>
  akra_bazzi_asymptotic2 b hb e p x \<and> akra_bazzi_asymptotic2' b hb e p x \<and>
  akra_bazzi_asymptotic3 e x \<and> akra_bazzi_asymptotic4 e x \<and> akra_bazzi_asymptotic5 b hb e x \<and>
  akra_bazzi_asymptotic6 b hb e x \<and> akra_bazzi_asymptotic7 b hb e x \<and>
  akra_bazzi_asymptotic8 b hb e x"

lemmas akra_bazzi_asymptotic_defs =
  akra_bazzi_asymptotic1_def akra_bazzi_asymptotic1'_def
  akra_bazzi_asymptotic2_def akra_bazzi_asymptotic2'_def akra_bazzi_asymptotic3_def
  akra_bazzi_asymptotic4_def akra_bazzi_asymptotic5_def akra_bazzi_asymptotic6_def
  akra_bazzi_asymptotic7_def akra_bazzi_asymptotic8_def akra_bazzi_asymptotics_def

lemma akra_bazzi_asymptotics:
  assumes "\<And>b. b \<in> set bs \<Longrightarrow> b \<in> {0<..<1}"
  assumes "hb > 0" "e > 0"
  shows "eventually (\<lambda>x. \<forall>b\<in>set bs. akra_bazzi_asymptotics b hb e p x) at_top"
proof (intro eventually_ball_finite ballI)
  fix b assume "b \<in> set bs"
  with assms interpret akra_bazzi_asymptotics_bep b e p hb by unfold_locales auto
  show "eventually (\<lambda>x. akra_bazzi_asymptotics b hb e p x) at_top"
    unfolding akra_bazzi_asymptotic_defs
    using asymptotics1[of "-c" for c] asymptotics2[of "-c" for c]
    by (intro eventually_conj asymptotics1 asymptotics2 asymptotics3
              asymptotics4 asymptotics5 asymptotics6 asymptotics7 asymptotics8) simp_all
qed simp

end


(*  Title:      ZF/List.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1994  University of Cambridge
*)

section\<open>Lists in Zermelo-Fraenkel Set Theory\<close>

theory List imports Datatype ArithSimp begin

consts
  list       :: "i=>i"

datatype
  "list(A)" = Nil | Cons ("a \<in> A", "l \<in> list(A)")

syntax
 "_Nil" :: i  (\<open>[]\<close>)
 "_List" :: "is => i"  (\<open>[(_)]\<close>)

translations
  "[x, xs]"     == "CONST Cons(x, [xs])"
  "[x]"         == "CONST Cons(x, [])"
  "[]"          == "CONST Nil"

consts
  length :: "i=>i"
  hd     :: "i=>i"
  tl     :: "i=>i"

primrec
  "length([]) = 0"
  "length(Cons(a,l)) = succ(length(l))"

primrec
  "hd([]) = 0"
  "hd(Cons(a,l)) = a"

primrec
  "tl([]) = []"
  "tl(Cons(a,l)) = l"

consts
  map         :: "[i=>i, i] => i"
  set_of_list :: "i=>i"
  app         :: "[i,i]=>i"                        (infixr \<open>@\<close> 60)

(*map is a binding operator -- it applies to meta-level functions, not
object-level functions.  This simplifies the final form of term_rec_conv,
although complicating its derivation.*)
primrec
  "map(f,[]) = []"
  "map(f,Cons(a,l)) = Cons(f(a), map(f,l))"

primrec
  "set_of_list([]) = 0"
  "set_of_list(Cons(a,l)) = cons(a, set_of_list(l))"

primrec
  app_Nil:  "[] @ ys = ys"
  app_Cons: "(Cons(a,l)) @ ys = Cons(a, l @ ys)"

consts
  rev :: "i=>i"
  flat       :: "i=>i"
  list_add   :: "i=>i"

primrec
  "rev([]) = []"
  "rev(Cons(a,l)) = rev(l) @ [a]"

primrec
  "flat([]) = []"
  "flat(Cons(l,ls)) = l @ flat(ls)"

primrec
  "list_add([]) = 0"
  "list_add(Cons(a,l)) = a #+ list_add(l)"

consts
  drop       :: "[i,i]=>i"

primrec
  drop_0:    "drop(0,l) = l"
  drop_succ: "drop(succ(i), l) = tl (drop(i,l))"

(*** Thanks to Sidi Ehmety for the following ***)

definition
(* Function `take' returns the first n elements of a list *)
  take     :: "[i,i]=>i"  where
  "take(n, as) == list_rec(\<lambda>n\<in>nat. [],
                %a l r. \<lambda>n\<in>nat. nat_case([], %m. Cons(a, r`m), n), as)`n"

definition
  nth :: "[i, i]=>i"  where
  \<comment> \<open>returns the (n+1)th element of a list, or 0 if the
   list is too short.\<close>
  "nth(n, as) == list_rec(\<lambda>n\<in>nat. 0,
                          %a l r. \<lambda>n\<in>nat. nat_case(a, %m. r`m, n), as) ` n"

definition
  list_update :: "[i, i, i]=>i"  where
  "list_update(xs, i, v) == list_rec(\<lambda>n\<in>nat. Nil,
      %u us vs. \<lambda>n\<in>nat. nat_case(Cons(v, us), %m. Cons(u, vs`m), n), xs)`i"

consts
  filter :: "[i=>o, i] => i"
  upt :: "[i, i] =>i"

primrec
  "filter(P, Nil) = Nil"
  "filter(P, Cons(x, xs)) =
     (if P(x) then Cons(x, filter(P, xs)) else filter(P, xs))"

primrec
  "upt(i, 0) = Nil"
  "upt(i, succ(j)) = (if i \<le> j then upt(i, j)@[j] else Nil)"

definition
  min :: "[i,i] =>i"  where
    "min(x, y) == (if x \<le> y then x else y)"

definition
  max :: "[i, i] =>i"  where
    "max(x, y) == (if x \<le> y then y else x)"

(*** Aspects of the datatype definition ***)

declare list.intros [simp,TC]

(*An elimination rule, for type-checking*)
inductive_cases ConsE: "Cons(a,l) \<in> list(A)"

lemma Cons_type_iff [simp]: "Cons(a,l) \<in> list(A) \<longleftrightarrow> a \<in> A & l \<in> list(A)"
by (blast elim: ConsE)

(*Proving freeness results*)
lemma Cons_iff: "Cons(a,l)=Cons(a',l') \<longleftrightarrow> a=a' & l=l'"
by auto

lemma Nil_Cons_iff: "~ Nil=Cons(a,l)"
by auto

lemma list_unfold: "list(A) = {0} + (A * list(A))"
by (blast intro!: list.intros [unfolded list.con_defs]
          elim: list.cases [unfolded list.con_defs])

(**  Lemmas to justify using "list" in other recursive type definitions **)

lemma list_mono: "A<=B ==> list(A) \<subseteq> list(B)"
apply (unfold list.defs )
apply (rule lfp_mono)
apply (simp_all add: list.bnd_mono)
apply (assumption | rule univ_mono basic_monos)+
done

(*There is a similar proof by list induction.*)
lemma list_univ: "list(univ(A)) \<subseteq> univ(A)"
apply (unfold list.defs list.con_defs)
apply (rule lfp_lowerbound)
apply (rule_tac [2] A_subset_univ [THEN univ_mono])
apply (blast intro!: zero_in_univ Inl_in_univ Inr_in_univ Pair_in_univ)
done

(*These two theorems justify datatypes involving list(nat), list(A), ...*)
lemmas list_subset_univ = subset_trans [OF list_mono list_univ]

lemma list_into_univ: "[| l \<in> list(A);  A \<subseteq> univ(B) |] ==> l \<in> univ(B)"
by (blast intro: list_subset_univ [THEN subsetD])

lemma list_case_type:
    "[| l \<in> list(A);
        c \<in> C(Nil);
        !!x y. [| x \<in> A;  y \<in> list(A) |] ==> h(x,y): C(Cons(x,y))
     |] ==> list_case(c,h,l) \<in> C(l)"
by (erule list.induct, auto)

lemma list_0_triv: "list(0) = {Nil}"
apply (rule equalityI, auto)
apply (induct_tac x, auto)
done

(*** List functions ***)

lemma tl_type: "l \<in> list(A) ==> tl(l) \<in> list(A)"
apply (induct_tac "l")
apply (simp_all (no_asm_simp) add: list.intros)
done

(** drop **)

lemma drop_Nil [simp]: "i \<in> nat ==> drop(i, Nil) = Nil"
apply (induct_tac "i")
apply (simp_all (no_asm_simp))
done

lemma drop_succ_Cons [simp]: "i \<in> nat ==> drop(succ(i), Cons(a,l)) = drop(i,l)"
apply (rule sym)
apply (induct_tac "i")
apply (simp (no_asm))
apply (simp (no_asm_simp))
done

lemma drop_type [simp,TC]: "[| i \<in> nat; l \<in> list(A) |] ==> drop(i,l) \<in> list(A)"
apply (induct_tac "i")
apply (simp_all (no_asm_simp) add: tl_type)
done

declare drop_succ [simp del]

(** Type checking -- proved by induction, as usual **)

lemma list_rec_type [TC]:
    "[| l \<in> list(A);
        c \<in> C(Nil);
        !!x y r. [| x \<in> A;  y \<in> list(A);  r \<in> C(y) |] ==> h(x,y,r): C(Cons(x,y))
     |] ==> list_rec(c,h,l) \<in> C(l)"
by (induct_tac "l", auto)

(** map **)

lemma map_type [TC]:
    "[| l \<in> list(A);  !!x. x \<in> A ==> h(x): B |] ==> map(h,l) \<in> list(B)"
apply (simp add: map_list_def)
apply (typecheck add: list.intros list_rec_type, blast)
done

lemma map_type2 [TC]: "l \<in> list(A) ==> map(h,l) \<in> list({h(u). u \<in> A})"
apply (erule map_type)
apply (erule RepFunI)
done

(** length **)

lemma length_type [TC]: "l \<in> list(A) ==> length(l) \<in> nat"
by (simp add: length_list_def)

lemma lt_length_in_nat:
   "[|x < length(xs); xs \<in> list(A)|] ==> x \<in> nat"
by (frule lt_nat_in_nat, typecheck)

(** app **)

lemma app_type [TC]: "[| xs: list(A);  ys: list(A) |] ==> xs@ys \<in> list(A)"
by (simp add: app_list_def)

(** rev **)

lemma rev_type [TC]: "xs: list(A) ==> rev(xs) \<in> list(A)"
by (simp add: rev_list_def)

(** flat **)

lemma flat_type [TC]: "ls: list(list(A)) ==> flat(ls) \<in> list(A)"
by (simp add: flat_list_def)

(** set_of_list **)

lemma set_of_list_type [TC]: "l \<in> list(A) ==> set_of_list(l) \<in> Pow(A)"
apply (unfold set_of_list_list_def)
apply (erule list_rec_type, auto)
done

lemma set_of_list_append:
     "xs: list(A) ==> set_of_list (xs@ys) = set_of_list(xs) \<union> set_of_list(ys)"
apply (erule list.induct)
apply (simp_all (no_asm_simp) add: Un_cons)
done

(** list_add **)

lemma list_add_type [TC]: "xs: list(nat) ==> list_add(xs) \<in> nat"
by (simp add: list_add_list_def)

(*** theorems about map ***)

lemma map_ident [simp]: "l \<in> list(A) ==> map(%u. u, l) = l"
apply (induct_tac "l")
apply (simp_all (no_asm_simp))
done

lemma map_compose: "l \<in> list(A) ==> map(h, map(j,l)) = map(%u. h(j(u)), l)"
apply (induct_tac "l")
apply (simp_all (no_asm_simp))
done

lemma map_app_distrib: "xs: list(A) ==> map(h, xs@ys) = map(h,xs) @ map(h,ys)"
apply (induct_tac "xs")
apply (simp_all (no_asm_simp))
done

lemma map_flat: "ls: list(list(A)) ==> map(h, flat(ls)) = flat(map(map(h),ls))"
apply (induct_tac "ls")
apply (simp_all (no_asm_simp) add: map_app_distrib)
done

lemma list_rec_map:
     "l \<in> list(A) ==>
      list_rec(c, d, map(h,l)) =
      list_rec(c, %x xs r. d(h(x), map(h,xs), r), l)"
apply (induct_tac "l")
apply (simp_all (no_asm_simp))
done

(** theorems about list(Collect(A,P)) -- used in Induct/Term.thy **)

(* @{term"c \<in> list(Collect(B,P)) ==> c \<in> list"} *)
lemmas list_CollectD = Collect_subset [THEN list_mono, THEN subsetD]

lemma map_list_Collect: "l \<in> list({x \<in> A. h(x)=j(x)}) ==> map(h,l) = map(j,l)"
apply (induct_tac "l")
apply (simp_all (no_asm_simp))
done

(*** theorems about length ***)

lemma length_map [simp]: "xs: list(A) ==> length(map(h,xs)) = length(xs)"
by (induct_tac "xs", simp_all)

lemma length_app [simp]:
     "[| xs: list(A); ys: list(A) |]
      ==> length(xs@ys) = length(xs) #+ length(ys)"
by (induct_tac "xs", simp_all)

lemma length_rev [simp]: "xs: list(A) ==> length(rev(xs)) = length(xs)"
apply (induct_tac "xs")
apply (simp_all (no_asm_simp) add: length_app)
done

lemma length_flat:
     "ls: list(list(A)) ==> length(flat(ls)) = list_add(map(length,ls))"
apply (induct_tac "ls")
apply (simp_all (no_asm_simp) add: length_app)
done

(** Length and drop **)

(*Lemma for the inductive step of drop_length*)
lemma drop_length_Cons [rule_format]:
     "xs: list(A) ==>
           \<forall>x.  \<exists>z zs. drop(length(xs), Cons(x,xs)) = Cons(z,zs)"
by (erule list.induct, simp_all)

lemma drop_length [rule_format]:
     "l \<in> list(A) ==> \<forall>i \<in> length(l). (\<exists>z zs. drop(i,l) = Cons(z,zs))"
apply (erule list.induct, simp_all, safe)
apply (erule drop_length_Cons)
apply (rule natE)
apply (erule Ord_trans [OF asm_rl length_type Ord_nat], assumption, simp_all)
apply (blast intro: succ_in_naturalD length_type)
done

(*** theorems about app ***)

lemma app_right_Nil [simp]: "xs: list(A) ==> xs@Nil=xs"
by (erule list.induct, simp_all)

lemma app_assoc: "xs: list(A) ==> (xs@ys)@zs = xs@(ys@zs)"
by (induct_tac "xs", simp_all)

lemma flat_app_distrib: "ls: list(list(A)) ==> flat(ls@ms) = flat(ls)@flat(ms)"
apply (induct_tac "ls")
apply (simp_all (no_asm_simp) add: app_assoc)
done

(*** theorems about rev ***)

lemma rev_map_distrib: "l \<in> list(A) ==> rev(map(h,l)) = map(h,rev(l))"
apply (induct_tac "l")
apply (simp_all (no_asm_simp) add: map_app_distrib)
done

(*Simplifier needs the premises as assumptions because rewriting will not
  instantiate the variable ?A in the rules' typing conditions; note that
  rev_type does not instantiate ?A.  Only the premises do.
*)
lemma rev_app_distrib:
     "[| xs: list(A);  ys: list(A) |] ==> rev(xs@ys) = rev(ys)@rev(xs)"
apply (erule list.induct)
apply (simp_all add: app_assoc)
done

lemma rev_rev_ident [simp]: "l \<in> list(A) ==> rev(rev(l))=l"
apply (induct_tac "l")
apply (simp_all (no_asm_simp) add: rev_app_distrib)
done

lemma rev_flat: "ls: list(list(A)) ==> rev(flat(ls)) = flat(map(rev,rev(ls)))"
apply (induct_tac "ls")
apply (simp_all add: map_app_distrib flat_app_distrib rev_app_distrib)
done

(*** theorems about list_add ***)

lemma list_add_app:
     "[| xs: list(nat);  ys: list(nat) |]
      ==> list_add(xs@ys) = list_add(ys) #+ list_add(xs)"
apply (induct_tac "xs", simp_all)
done

lemma list_add_rev: "l \<in> list(nat) ==> list_add(rev(l)) = list_add(l)"
apply (induct_tac "l")
apply (simp_all (no_asm_simp) add: list_add_app)
done

lemma list_add_flat:
     "ls: list(list(nat)) ==> list_add(flat(ls)) = list_add(map(list_add,ls))"
apply (induct_tac "ls")
apply (simp_all (no_asm_simp) add: list_add_app)
done

(** New induction rules **)

lemma list_append_induct [case_names Nil snoc, consumes 1]:
    "[| l \<in> list(A);
        P(Nil);
        !!x y. [| x \<in> A;  y \<in> list(A);  P(y) |] ==> P(y @ [x])
     |] ==> P(l)"
apply (subgoal_tac "P(rev(rev(l)))", simp)
apply (erule rev_type [THEN list.induct], simp_all)
done

lemma list_complete_induct_lemma [rule_format]:
 assumes ih:
    "\<And>l. [| l \<in> list(A);
             \<forall>l' \<in> list(A). length(l') < length(l) \<longrightarrow> P(l')|]
          ==> P(l)"
  shows "n \<in> nat ==> \<forall>l \<in> list(A). length(l) < n \<longrightarrow> P(l)"
apply (induct_tac n, simp)
apply (blast intro: ih elim!: leE)
done

theorem list_complete_induct:
      "[| l \<in> list(A);
          \<And>l. [| l \<in> list(A);
                  \<forall>l' \<in> list(A). length(l') < length(l) \<longrightarrow> P(l')|]
               ==> P(l)
       |] ==> P(l)"
apply (rule list_complete_induct_lemma [of A])
   prefer 4 apply (rule le_refl, simp)
  apply blast
 apply simp
apply assumption
done

(*** Thanks to Sidi Ehmety for these results about min, take, etc. ***)

(** min FIXME: replace by Int! **)
(* Min theorems are also true for i, j ordinals *)
lemma min_sym: "[| i \<in> nat; j \<in> nat |] ==> min(i,j)=min(j,i)"
apply (unfold min_def)
apply (auto dest!: not_lt_imp_le dest: lt_not_sym intro: le_anti_sym)
done

lemma min_type [simp,TC]: "[| i \<in> nat; j \<in> nat |] ==> min(i,j):nat"
by (unfold min_def, auto)

lemma min_0 [simp]: "i \<in> nat ==> min(0,i) = 0"
apply (unfold min_def)
apply (auto dest: not_lt_imp_le)
done

lemma min_02 [simp]: "i \<in> nat ==> min(i, 0) = 0"
apply (unfold min_def)
apply (auto dest: not_lt_imp_le)
done

lemma lt_min_iff: "[| i \<in> nat; j \<in> nat; k \<in> nat |] ==> i<min(j,k) \<longleftrightarrow> i<j & i<k"
apply (unfold min_def)
apply (auto dest!: not_lt_imp_le intro: lt_trans2 lt_trans)
done

lemma min_succ_succ [simp]:
     "[| i \<in> nat; j \<in> nat |] ==>  min(succ(i), succ(j))= succ(min(i, j))"
apply (unfold min_def, auto)
done

(*** more theorems about lists ***)

(** filter **)

lemma filter_append [simp]:
     "xs:list(A) ==> filter(P, xs@ys) = filter(P, xs) @ filter(P, ys)"
by (induct_tac "xs", auto)

lemma filter_type [simp,TC]: "xs:list(A) ==> filter(P, xs):list(A)"
by (induct_tac "xs", auto)

lemma length_filter: "xs:list(A) ==> length(filter(P, xs)) \<le> length(xs)"
apply (induct_tac "xs", auto)
apply (rule_tac j = "length (l) " in le_trans)
apply (auto simp add: le_iff)
done

lemma filter_is_subset: "xs:list(A) ==> set_of_list(filter(P,xs)) \<subseteq> set_of_list(xs)"
by (induct_tac "xs", auto)

lemma filter_False [simp]: "xs:list(A) ==> filter(%p. False, xs) = Nil"
by (induct_tac "xs", auto)

lemma filter_True [simp]: "xs:list(A) ==> filter(%p. True, xs) = xs"
by (induct_tac "xs", auto)

(** length **)

lemma length_is_0_iff [simp]: "xs:list(A) ==> length(xs)=0 \<longleftrightarrow> xs=Nil"
by (erule list.induct, auto)

lemma length_is_0_iff2 [simp]: "xs:list(A) ==> 0 = length(xs) \<longleftrightarrow> xs=Nil"
by (erule list.induct, auto)

lemma length_tl [simp]: "xs:list(A) ==> length(tl(xs)) = length(xs) #- 1"
by (erule list.induct, auto)

lemma length_greater_0_iff: "xs:list(A) ==> 0<length(xs) \<longleftrightarrow> xs \<noteq> Nil"
by (erule list.induct, auto)

lemma length_succ_iff: "xs:list(A) ==> length(xs)=succ(n) \<longleftrightarrow> (\<exists>y ys. xs=Cons(y, ys) & length(ys)=n)"
by (erule list.induct, auto)

(** more theorems about append **)

lemma append_is_Nil_iff [simp]:
     "xs:list(A) ==> (xs@ys = Nil) \<longleftrightarrow> (xs=Nil & ys = Nil)"
by (erule list.induct, auto)

lemma append_is_Nil_iff2 [simp]:
     "xs:list(A) ==> (Nil = xs@ys) \<longleftrightarrow> (xs=Nil & ys = Nil)"
by (erule list.induct, auto)

lemma append_left_is_self_iff [simp]:
     "xs:list(A) ==> (xs@ys = xs) \<longleftrightarrow> (ys = Nil)"
by (erule list.induct, auto)

lemma append_left_is_self_iff2 [simp]:
     "xs:list(A) ==> (xs = xs@ys) \<longleftrightarrow> (ys = Nil)"
by (erule list.induct, auto)

(*TOO SLOW as a default simprule!*)
lemma append_left_is_Nil_iff [rule_format]:
     "[| xs:list(A); ys:list(A); zs:list(A) |] ==>
   length(ys)=length(zs) \<longrightarrow> (xs@ys=zs \<longleftrightarrow> (xs=Nil & ys=zs))"
apply (erule list.induct)
apply (auto simp add: length_app)
done

(*TOO SLOW as a default simprule!*)
lemma append_left_is_Nil_iff2 [rule_format]:
     "[| xs:list(A); ys:list(A); zs:list(A) |] ==>
   length(ys)=length(zs) \<longrightarrow> (zs=ys@xs \<longleftrightarrow> (xs=Nil & ys=zs))"
apply (erule list.induct)
apply (auto simp add: length_app)
done

lemma append_eq_append_iff [rule_format]:
     "xs:list(A) ==> \<forall>ys \<in> list(A).
      length(xs)=length(ys) \<longrightarrow> (xs@us = ys@vs) \<longleftrightarrow> (xs=ys & us=vs)"
apply (erule list.induct)
apply (simp (no_asm_simp))
apply clarify
apply (erule_tac a = ys in list.cases, auto)
done
declare append_eq_append_iff [simp]

lemma append_eq_append [rule_format]:
  "xs:list(A) ==>
   \<forall>ys \<in> list(A). \<forall>us \<in> list(A). \<forall>vs \<in> list(A).
   length(us) = length(vs) \<longrightarrow> (xs@us = ys@vs) \<longrightarrow> (xs=ys & us=vs)"
apply (induct_tac "xs")
apply (force simp add: length_app, clarify)
apply (erule_tac a = ys in list.cases, simp)
apply (subgoal_tac "Cons (a, l) @ us =vs")
 apply (drule rev_iffD1 [OF _ append_left_is_Nil_iff], simp_all, blast)
done

lemma append_eq_append_iff2 [simp]:
 "[| xs:list(A); ys:list(A); us:list(A); vs:list(A); length(us)=length(vs) |]
  ==>  xs@us = ys@vs \<longleftrightarrow> (xs=ys & us=vs)"
apply (rule iffI)
apply (rule append_eq_append, auto)
done

lemma append_self_iff [simp]:
     "[| xs:list(A); ys:list(A); zs:list(A) |] ==> xs@ys=xs@zs \<longleftrightarrow> ys=zs"
by simp

lemma append_self_iff2 [simp]:
     "[| xs:list(A); ys:list(A); zs:list(A) |] ==> ys@xs=zs@xs \<longleftrightarrow> ys=zs"
by simp

(* Can also be proved from append_eq_append_iff2,
but the proof requires two more hypotheses: x \<in> A and y \<in> A *)
lemma append1_eq_iff [rule_format]:
     "xs:list(A) ==> \<forall>ys \<in> list(A). xs@[x] = ys@[y] \<longleftrightarrow> (xs = ys & x=y)"
apply (erule list.induct)
 apply clarify
 apply (erule list.cases)
 apply simp_all
txt\<open>Inductive step\<close>
apply clarify
apply (erule_tac a=ys in list.cases, simp_all)
done
declare append1_eq_iff [simp]

lemma append_right_is_self_iff [simp]:
     "[| xs:list(A); ys:list(A) |] ==> (xs@ys = ys) \<longleftrightarrow> (xs=Nil)"
by (simp (no_asm_simp) add: append_left_is_Nil_iff)

lemma append_right_is_self_iff2 [simp]:
     "[| xs:list(A); ys:list(A) |] ==> (ys = xs@ys) \<longleftrightarrow> (xs=Nil)"
apply (rule iffI)
apply (drule sym, auto)
done

lemma hd_append [rule_format]:
     "xs:list(A) ==> xs \<noteq> Nil \<longrightarrow> hd(xs @ ys) = hd(xs)"
by (induct_tac "xs", auto)
declare hd_append [simp]

lemma tl_append [rule_format]:
     "xs:list(A) ==> xs\<noteq>Nil \<longrightarrow> tl(xs @ ys) = tl(xs)@ys"
by (induct_tac "xs", auto)
declare tl_append [simp]

(** rev **)
lemma rev_is_Nil_iff [simp]: "xs:list(A) ==> (rev(xs) = Nil \<longleftrightarrow> xs = Nil)"
by (erule list.induct, auto)

lemma Nil_is_rev_iff [simp]: "xs:list(A) ==> (Nil = rev(xs) \<longleftrightarrow> xs = Nil)"
by (erule list.induct, auto)

lemma rev_is_rev_iff [rule_format]:
     "xs:list(A) ==> \<forall>ys \<in> list(A). rev(xs)=rev(ys) \<longleftrightarrow> xs=ys"
apply (erule list.induct, force, clarify)
apply (erule_tac a = ys in list.cases, auto)
done
declare rev_is_rev_iff [simp]

lemma rev_list_elim [rule_format]:
     "xs:list(A) ==>
      (xs=Nil \<longrightarrow> P) \<longrightarrow> (\<forall>ys \<in> list(A). \<forall>y \<in> A. xs =ys@[y] \<longrightarrow>P)\<longrightarrow>P"
by (erule list_append_induct, auto)

(** more theorems about drop **)

lemma length_drop [rule_format]:
     "n \<in> nat ==> \<forall>xs \<in> list(A). length(drop(n, xs)) = length(xs) #- n"
apply (erule nat_induct)
apply (auto elim: list.cases)
done
declare length_drop [simp]

lemma drop_all [rule_format]:
     "n \<in> nat ==> \<forall>xs \<in> list(A). length(xs) \<le> n \<longrightarrow> drop(n, xs)=Nil"
apply (erule nat_induct)
apply (auto elim: list.cases)
done
declare drop_all [simp]

lemma drop_append [rule_format]:
     "n \<in> nat ==>
      \<forall>xs \<in> list(A). drop(n, xs@ys) = drop(n,xs) @ drop(n #- length(xs), ys)"
apply (induct_tac "n")
apply (auto elim: list.cases)
done

lemma drop_drop:
    "m \<in> nat ==> \<forall>xs \<in> list(A). \<forall>n \<in> nat. drop(n, drop(m, xs))=drop(n #+ m, xs)"
apply (induct_tac "m")
apply (auto elim: list.cases)
done

(** take **)

lemma take_0 [simp]: "xs:list(A) ==> take(0, xs) =  Nil"
apply (unfold take_def)
apply (erule list.induct, auto)
done

lemma take_succ_Cons [simp]:
    "n \<in> nat ==> take(succ(n), Cons(a, xs)) = Cons(a, take(n, xs))"
by (simp add: take_def)

(* Needed for proving take_all *)
lemma take_Nil [simp]: "n \<in> nat ==> take(n, Nil) = Nil"
by (unfold take_def, auto)

lemma take_all [rule_format]:
     "n \<in> nat ==> \<forall>xs \<in> list(A). length(xs) \<le> n  \<longrightarrow> take(n, xs) = xs"
apply (erule nat_induct)
apply (auto elim: list.cases)
done
declare take_all [simp]

lemma take_type [rule_format]:
     "xs:list(A) ==> \<forall>n \<in> nat. take(n, xs):list(A)"
apply (erule list.induct, simp, clarify)
apply (erule natE, auto)
done
declare take_type [simp,TC]

lemma take_append [rule_format]:
 "xs:list(A) ==>
  \<forall>ys \<in> list(A). \<forall>n \<in> nat. take(n, xs @ ys) =
                            take(n, xs) @ take(n #- length(xs), ys)"
apply (erule list.induct, simp, clarify)
apply (erule natE, auto)
done
declare take_append [simp]

lemma take_take [rule_format]:
   "m \<in> nat ==>
    \<forall>xs \<in> list(A). \<forall>n \<in> nat. take(n, take(m,xs))= take(min(n, m), xs)"
apply (induct_tac "m", auto)
apply (erule_tac a = xs in list.cases)
apply (auto simp add: take_Nil)
apply (erule_tac n=n in natE)
apply (auto intro: take_0 take_type)
done

(** nth **)

lemma nth_0 [simp]: "nth(0, Cons(a, l)) = a"
by (simp add: nth_def)

lemma nth_Cons [simp]: "n \<in> nat ==> nth(succ(n), Cons(a,l)) = nth(n,l)"
by (simp add: nth_def)

lemma nth_empty [simp]: "nth(n, Nil) = 0"
by (simp add: nth_def)

lemma nth_type [rule_format]:
     "xs:list(A) ==> \<forall>n. n < length(xs) \<longrightarrow> nth(n,xs) \<in> A"
apply (erule list.induct, simp, clarify)
apply (subgoal_tac "n \<in> nat")
 apply (erule natE, auto dest!: le_in_nat)
done
declare nth_type [simp,TC]

lemma nth_eq_0 [rule_format]:
     "xs:list(A) ==> \<forall>n \<in> nat. length(xs) \<le> n \<longrightarrow> nth(n,xs) = 0"
apply (erule list.induct, simp, clarify)
apply (erule natE, auto)
done

lemma nth_append [rule_format]:
  "xs:list(A) ==>
   \<forall>n \<in> nat. nth(n, xs @ ys) = (if n < length(xs) then nth(n,xs)
                                else nth(n #- length(xs), ys))"
apply (induct_tac "xs", simp, clarify)
apply (erule natE, auto)
done

lemma set_of_list_conv_nth:
    "xs:list(A)
     ==> set_of_list(xs) = {x \<in> A. \<exists>i\<in>nat. i<length(xs) & x = nth(i,xs)}"
apply (induct_tac "xs", simp_all)
apply (rule equalityI, auto)
apply (rule_tac x = 0 in bexI, auto)
apply (erule natE, auto)
done

(* Other theorems about lists *)

lemma nth_take_lemma [rule_format]:
 "k \<in> nat ==>
  \<forall>xs \<in> list(A). (\<forall>ys \<in> list(A). k \<le> length(xs) \<longrightarrow> k \<le> length(ys) \<longrightarrow>
      (\<forall>i \<in> nat. i<k \<longrightarrow> nth(i,xs) = nth(i,ys))\<longrightarrow> take(k,xs) = take(k,ys))"
apply (induct_tac "k")
apply (simp_all (no_asm_simp) add: lt_succ_eq_0_disj all_conj_distrib)
apply clarify
(*Both lists are non-empty*)
apply (erule_tac a=xs in list.cases, simp)
apply (erule_tac a=ys in list.cases, clarify)
apply (simp (no_asm_use) )
apply clarify
apply (simp (no_asm_simp))
apply (rule conjI, force)
apply (rename_tac y ys z zs)
apply (drule_tac x = zs and x1 = ys in bspec [THEN bspec], auto)
done

lemma nth_equalityI [rule_format]:
     "[| xs:list(A); ys:list(A); length(xs) = length(ys);
         \<forall>i \<in> nat. i < length(xs) \<longrightarrow> nth(i,xs) = nth(i,ys) |]
      ==> xs = ys"
apply (subgoal_tac "length (xs) \<le> length (ys) ")
apply (cut_tac k="length(xs)" and xs=xs and ys=ys in nth_take_lemma)
apply (simp_all add: take_all)
done

(*The famous take-lemma*)

lemma take_equalityI [rule_format]:
    "[| xs:list(A); ys:list(A); (\<forall>i \<in> nat. take(i, xs) = take(i,ys)) |]
     ==> xs = ys"
apply (case_tac "length (xs) \<le> length (ys) ")
apply (drule_tac x = "length (ys) " in bspec)
apply (drule_tac [3] not_lt_imp_le)
apply (subgoal_tac [5] "length (ys) \<le> length (xs) ")
apply (rule_tac [6] j = "succ (length (ys))" in le_trans)
apply (rule_tac [6] leI)
apply (drule_tac [5] x = "length (xs) " in bspec)
apply (simp_all add: take_all)
done

lemma nth_drop [rule_format]:
  "n \<in> nat ==> \<forall>i \<in> nat. \<forall>xs \<in> list(A). nth(i, drop(n, xs)) = nth(n #+ i, xs)"
apply (induct_tac "n", simp_all, clarify)
apply (erule list.cases, auto)
done

lemma take_succ [rule_format]:
  "xs\<in>list(A)
   ==> \<forall>i. i < length(xs) \<longrightarrow> take(succ(i), xs) = take(i,xs) @ [nth(i, xs)]"
apply (induct_tac "xs", auto)
apply (subgoal_tac "i\<in>nat")
apply (erule natE)
apply (auto simp add: le_in_nat)
done

lemma take_add [rule_format]:
     "[|xs\<in>list(A); j\<in>nat|]
      ==> \<forall>i\<in>nat. take(i #+ j, xs) = take(i,xs) @ take(j, drop(i,xs))"
apply (induct_tac "xs", simp_all, clarify)
apply (erule_tac n = i in natE, simp_all)
done

lemma length_take:
     "l\<in>list(A) ==> \<forall>n\<in>nat. length(take(n,l)) = min(n, length(l))"
apply (induct_tac "l", safe, simp_all)
apply (erule natE, simp_all)
done

subsection\<open>The function zip\<close>

text\<open>Crafty definition to eliminate a type argument\<close>

consts
  zip_aux        :: "[i,i]=>i"

primrec (*explicit lambda is required because both arguments of "un" vary*)
  "zip_aux(B,[]) =
     (\<lambda>ys \<in> list(B). list_case([], %y l. [], ys))"

  "zip_aux(B,Cons(x,l)) =
     (\<lambda>ys \<in> list(B).
        list_case(Nil, %y zs. Cons(<x,y>, zip_aux(B,l)`zs), ys))"

definition
  zip :: "[i, i]=>i"  where
   "zip(xs, ys) == zip_aux(set_of_list(ys),xs)`ys"

(* zip equations *)

lemma list_on_set_of_list: "xs \<in> list(A) ==> xs \<in> list(set_of_list(xs))"
apply (induct_tac xs, simp_all)
apply (blast intro: list_mono [THEN subsetD])
done

lemma zip_Nil [simp]: "ys:list(A) ==> zip(Nil, ys)=Nil"
apply (simp add: zip_def list_on_set_of_list [of _ A])
apply (erule list.cases, simp_all)
done

lemma zip_Nil2 [simp]: "xs:list(A) ==> zip(xs, Nil)=Nil"
apply (simp add: zip_def list_on_set_of_list [of _ A])
apply (erule list.cases, simp_all)
done

lemma zip_aux_unique [rule_format]:
     "[|B<=C;  xs \<in> list(A)|]
      ==> \<forall>ys \<in> list(B). zip_aux(C,xs) ` ys = zip_aux(B,xs) ` ys"
apply (induct_tac xs)
 apply simp_all
 apply (blast intro: list_mono [THEN subsetD], clarify)
apply (erule_tac a=ys in list.cases, auto)
apply (blast intro: list_mono [THEN subsetD])
done

lemma zip_Cons_Cons [simp]:
     "[| xs:list(A); ys:list(B); x \<in> A; y \<in> B |] ==>
      zip(Cons(x,xs), Cons(y, ys)) = Cons(<x,y>, zip(xs, ys))"
apply (simp add: zip_def, auto)
apply (rule zip_aux_unique, auto)
apply (simp add: list_on_set_of_list [of _ B])
apply (blast intro: list_on_set_of_list list_mono [THEN subsetD])
done

lemma zip_type [rule_format]:
     "xs:list(A) ==> \<forall>ys \<in> list(B). zip(xs, ys):list(A*B)"
apply (induct_tac "xs")
apply (simp (no_asm))
apply clarify
apply (erule_tac a = ys in list.cases, auto)
done
declare zip_type [simp,TC]

(* zip length *)
lemma length_zip [rule_format]:
     "xs:list(A) ==> \<forall>ys \<in> list(B). length(zip(xs,ys)) =
                                     min(length(xs), length(ys))"
apply (unfold min_def)
apply (induct_tac "xs", simp_all, clarify)
apply (erule_tac a = ys in list.cases, auto)
done
declare length_zip [simp]

lemma zip_append1 [rule_format]:
 "[| ys:list(A); zs:list(B) |] ==>
  \<forall>xs \<in> list(A). zip(xs @ ys, zs) =
                 zip(xs, take(length(xs), zs)) @ zip(ys, drop(length(xs),zs))"
apply (induct_tac "zs", force, clarify)
apply (erule_tac a = xs in list.cases, simp_all)
done

lemma zip_append2 [rule_format]:
 "[| xs:list(A); zs:list(B) |] ==> \<forall>ys \<in> list(B). zip(xs, ys@zs) =
       zip(take(length(ys), xs), ys) @ zip(drop(length(ys), xs), zs)"
apply (induct_tac "xs", force, clarify)
apply (erule_tac a = ys in list.cases, auto)
done

lemma zip_append [simp]:
 "[| length(xs) = length(us); length(ys) = length(vs);
     xs:list(A); us:list(B); ys:list(A); vs:list(B) |]
  ==> zip(xs@ys,us@vs) = zip(xs, us) @ zip(ys, vs)"
by (simp (no_asm_simp) add: zip_append1 drop_append diff_self_eq_0)

lemma zip_rev [rule_format]:
 "ys:list(B) ==> \<forall>xs \<in> list(A).
    length(xs) = length(ys) \<longrightarrow> zip(rev(xs), rev(ys)) = rev(zip(xs, ys))"
apply (induct_tac "ys", force, clarify)
apply (erule_tac a = xs in list.cases)
apply (auto simp add: length_rev)
done
declare zip_rev [simp]

lemma nth_zip [rule_format]:
   "ys:list(B) ==> \<forall>i \<in> nat. \<forall>xs \<in> list(A).
                    i < length(xs) \<longrightarrow> i < length(ys) \<longrightarrow>
                    nth(i,zip(xs, ys)) = <nth(i,xs),nth(i, ys)>"
apply (induct_tac "ys", force, clarify)
apply (erule_tac a = xs in list.cases, simp)
apply (auto elim: natE)
done
declare nth_zip [simp]

lemma set_of_list_zip [rule_format]:
     "[| xs:list(A); ys:list(B); i \<in> nat |]
      ==> set_of_list(zip(xs, ys)) =
          {<x, y>:A*B. \<exists>i\<in>nat. i < min(length(xs), length(ys))
          & x = nth(i, xs) & y = nth(i, ys)}"
by (force intro!: Collect_cong simp add: lt_min_iff set_of_list_conv_nth)

(** list_update **)

lemma list_update_Nil [simp]: "i \<in> nat ==>list_update(Nil, i, v) = Nil"
by (unfold list_update_def, auto)

lemma list_update_Cons_0 [simp]: "list_update(Cons(x, xs), 0, v)= Cons(v, xs)"
by (unfold list_update_def, auto)

lemma list_update_Cons_succ [simp]:
  "n \<in> nat ==>
    list_update(Cons(x, xs), succ(n), v)= Cons(x, list_update(xs, n, v))"
apply (unfold list_update_def, auto)
done

lemma list_update_type [rule_format]:
     "[| xs:list(A); v \<in> A |] ==> \<forall>n \<in> nat. list_update(xs, n, v):list(A)"
apply (induct_tac "xs")
apply (simp (no_asm))
apply clarify
apply (erule natE, auto)
done
declare list_update_type [simp,TC]

lemma length_list_update [rule_format]:
     "xs:list(A) ==> \<forall>i \<in> nat. length(list_update(xs, i, v))=length(xs)"
apply (induct_tac "xs")
apply (simp (no_asm))
apply clarify
apply (erule natE, auto)
done
declare length_list_update [simp]

lemma nth_list_update [rule_format]:
     "[| xs:list(A) |] ==> \<forall>i \<in> nat. \<forall>j \<in> nat. i < length(xs)  \<longrightarrow>
         nth(j, list_update(xs, i, x)) = (if i=j then x else nth(j, xs))"
apply (induct_tac "xs")
 apply simp_all
apply clarify
apply (rename_tac i j)
apply (erule_tac n=i in natE)
apply (erule_tac [2] n=j in natE)
apply (erule_tac n=j in natE, simp_all, force)
done

lemma nth_list_update_eq [simp]:
     "[| i < length(xs); xs:list(A) |] ==> nth(i, list_update(xs, i,x)) = x"
by (simp (no_asm_simp) add: lt_length_in_nat nth_list_update)

lemma nth_list_update_neq [rule_format]:
  "xs:list(A) ==>
     \<forall>i \<in> nat. \<forall>j \<in> nat. i \<noteq> j \<longrightarrow> nth(j, list_update(xs,i,x)) = nth(j,xs)"
apply (induct_tac "xs")
 apply (simp (no_asm))
apply clarify
apply (erule natE)
apply (erule_tac [2] natE, simp_all)
apply (erule natE, simp_all)
done
declare nth_list_update_neq [simp]

lemma list_update_overwrite [rule_format]:
     "xs:list(A) ==> \<forall>i \<in> nat. i < length(xs)
   \<longrightarrow> list_update(list_update(xs, i, x), i, y) = list_update(xs, i,y)"
apply (induct_tac "xs")
 apply (simp (no_asm))
apply clarify
apply (erule natE, auto)
done
declare list_update_overwrite [simp]

lemma list_update_same_conv [rule_format]:
     "xs:list(A) ==>
      \<forall>i \<in> nat. i < length(xs) \<longrightarrow>
                 (list_update(xs, i, x) = xs) \<longleftrightarrow> (nth(i, xs) = x)"
apply (induct_tac "xs")
 apply (simp (no_asm))
apply clarify
apply (erule natE, auto)
done

lemma update_zip [rule_format]:
     "ys:list(B) ==>
      \<forall>i \<in> nat. \<forall>xy \<in> A*B. \<forall>xs \<in> list(A).
        length(xs) = length(ys) \<longrightarrow>
        list_update(zip(xs, ys), i, xy) = zip(list_update(xs, i, fst(xy)),
                                              list_update(ys, i, snd(xy)))"
apply (induct_tac "ys")
 apply auto
apply (erule_tac a = xs in list.cases)
apply (auto elim: natE)
done

lemma set_update_subset_cons [rule_format]:
  "xs:list(A) ==>
   \<forall>i \<in> nat. set_of_list(list_update(xs, i, x)) \<subseteq> cons(x, set_of_list(xs))"
apply (induct_tac "xs")
 apply simp
apply (rule ballI)
apply (erule natE, simp_all, auto)
done

lemma set_of_list_update_subsetI:
     "[| set_of_list(xs) \<subseteq> A; xs:list(A); x \<in> A; i \<in> nat|]
   ==> set_of_list(list_update(xs, i,x)) \<subseteq> A"
apply (rule subset_trans)
apply (rule set_update_subset_cons, auto)
done

(** upt **)

lemma upt_rec:
     "j \<in> nat ==> upt(i,j) = (if i<j then Cons(i, upt(succ(i), j)) else Nil)"
apply (induct_tac "j", auto)
apply (drule not_lt_imp_le)
apply (auto simp: lt_Ord intro: le_anti_sym)
done

lemma upt_conv_Nil [simp]: "[| j \<le> i; j \<in> nat |] ==> upt(i,j) = Nil"
apply (subst upt_rec, auto)
apply (auto simp add: le_iff)
apply (drule lt_asym [THEN notE], auto)
done

(*Only needed if upt_Suc is deleted from the simpset*)
lemma upt_succ_append:
     "[| i \<le> j; j \<in> nat |] ==> upt(i,succ(j)) = upt(i, j)@[j]"
by simp

lemma upt_conv_Cons:
     "[| i<j; j \<in> nat |]  ==> upt(i,j) = Cons(i,upt(succ(i),j))"
apply (rule trans)
apply (rule upt_rec, auto)
done

lemma upt_type [simp,TC]: "j \<in> nat ==> upt(i,j):list(nat)"
by (induct_tac "j", auto)

(*LOOPS as a simprule, since j<=j*)
lemma upt_add_eq_append:
     "[| i \<le> j; j \<in> nat; k \<in> nat |] ==> upt(i, j #+k) = upt(i,j)@upt(j,j#+k)"
apply (induct_tac "k")
apply (auto simp add: app_assoc app_type)
apply (rule_tac j = j in le_trans, auto)
done

lemma length_upt [simp]: "[| i \<in> nat; j \<in> nat |] ==>length(upt(i,j)) = j #- i"
apply (induct_tac "j")
apply (rule_tac [2] sym)
apply (auto dest!: not_lt_imp_le simp add: diff_succ diff_is_0_iff)
done

lemma nth_upt [simp]:
     "[| i \<in> nat; j \<in> nat; k \<in> nat; i #+ k < j |] ==> nth(k, upt(i,j)) = i #+ k"
apply (rotate_tac -1, erule rev_mp)
apply (induct_tac "j", simp)
apply (auto dest!: not_lt_imp_le
            simp add: nth_append le_iff less_diff_conv add_commute)
done

lemma take_upt [rule_format]:
     "[| m \<in> nat; n \<in> nat |] ==>
         \<forall>i \<in> nat. i #+ m \<le> n \<longrightarrow> take(m, upt(i,n)) = upt(i,i#+m)"
apply (induct_tac "m")
apply (simp (no_asm_simp) add: take_0)
apply clarify
apply (subst upt_rec, simp)
apply (rule sym)
apply (subst upt_rec, simp)
apply (simp_all del: upt.simps)
apply (rule_tac j = "succ (i #+ x) " in lt_trans2)
apply auto
done
declare take_upt [simp]

lemma map_succ_upt:
     "[| m \<in> nat; n \<in> nat |] ==> map(succ, upt(m,n))= upt(succ(m), succ(n))"
apply (induct_tac "n")
apply (auto simp add: map_app_distrib)
done

lemma nth_map [rule_format]:
     "xs:list(A) ==>
      \<forall>n \<in> nat. n < length(xs) \<longrightarrow> nth(n, map(f, xs)) = f(nth(n, xs))"
apply (induct_tac "xs", simp)
apply (rule ballI)
apply (induct_tac "n", auto)
done
declare nth_map [simp]

lemma nth_map_upt [rule_format]:
     "[| m \<in> nat; n \<in> nat |] ==>
      \<forall>i \<in> nat. i < n #- m \<longrightarrow> nth(i, map(f, upt(m,n))) = f(m #+ i)"
apply (rule_tac n = m and m = n in diff_induct, typecheck, simp, simp)
apply (subst map_succ_upt [symmetric], simp_all, clarify)
apply (subgoal_tac "i < length (upt (0, x))")
 prefer 2
 apply (simp add: less_diff_conv)
 apply (rule_tac j = "succ (i #+ y) " in lt_trans2)
  apply simp
 apply simp
apply (subgoal_tac "i < length (upt (y, x))")
 apply (simp_all add: add_commute less_diff_conv)
done

(** sublist (a generalization of nth to sets) **)

definition
  sublist :: "[i, i] => i"  where
    "sublist(xs, A)==
     map(fst, (filter(%p. snd(p): A, zip(xs, upt(0,length(xs))))))"

lemma sublist_0 [simp]: "xs:list(A) ==>sublist(xs, 0) =Nil"
by (unfold sublist_def, auto)

lemma sublist_Nil [simp]: "sublist(Nil, A) = Nil"
by (unfold sublist_def, auto)

lemma sublist_shift_lemma:
 "[| xs:list(B); i \<in> nat |] ==>
  map(fst, filter(%p. snd(p):A, zip(xs, upt(i,i #+ length(xs))))) =
  map(fst, filter(%p. snd(p):nat & snd(p) #+ i \<in> A, zip(xs,upt(0,length(xs)))))"
apply (erule list_append_induct)
apply (simp (no_asm_simp))
apply (auto simp add: add_commute length_app filter_append map_app_distrib)
done

lemma sublist_type [simp,TC]:
     "xs:list(B) ==> sublist(xs, A):list(B)"
apply (unfold sublist_def)
apply (induct_tac "xs")
apply (auto simp add: filter_append map_app_distrib)
done

lemma upt_add_eq_append2:
     "[| i \<in> nat; j \<in> nat |] ==> upt(0, i #+ j) = upt(0, i) @ upt(i, i #+ j)"
by (simp add: upt_add_eq_append [of 0] nat_0_le)

lemma sublist_append:
 "[| xs:list(B); ys:list(B)  |] ==>
  sublist(xs@ys, A) = sublist(xs, A) @ sublist(ys, {j \<in> nat. j #+ length(xs): A})"
apply (unfold sublist_def)
apply (erule_tac l = ys in list_append_induct, simp)
apply (simp (no_asm_simp) add: upt_add_eq_append2 app_assoc [symmetric])
apply (auto simp add: sublist_shift_lemma length_type map_app_distrib app_assoc)
apply (simp_all add: add_commute)
done

lemma sublist_Cons:
     "[| xs:list(B); x \<in> B |] ==>
      sublist(Cons(x, xs), A) =
      (if 0 \<in> A then [x] else []) @ sublist(xs, {j \<in> nat. succ(j) \<in> A})"
apply (erule_tac l = xs in list_append_induct)
apply (simp (no_asm_simp) add: sublist_def)
apply (simp del: app_Cons add: app_Cons [symmetric] sublist_append, simp)
done

lemma sublist_singleton [simp]:
     "sublist([x], A) = (if 0 \<in> A then [x] else [])"
by (simp add: sublist_Cons)

lemma sublist_upt_eq_take [rule_format]:
    "xs:list(A) ==> \<forall>n\<in>nat. sublist(xs,n) = take(n,xs)"
apply (erule list.induct, simp)
apply (clarify )
apply (erule natE)
apply (simp_all add: nat_eq_Collect_lt Ord_mem_iff_lt sublist_Cons)
done
declare sublist_upt_eq_take [simp]

lemma sublist_Int_eq:
     "xs \<in> list(B) ==> sublist(xs, A \<inter> nat) = sublist(xs, A)"
apply (erule list.induct)
apply (simp_all add: sublist_Cons)
done

text\<open>Repetition of a List Element\<close>

consts   repeat :: "[i,i]=>i"
primrec
  "repeat(a,0) = []"

  "repeat(a,succ(n)) = Cons(a,repeat(a,n))"

lemma length_repeat: "n \<in> nat ==> length(repeat(a,n)) = n"
by (induct_tac n, auto)

lemma repeat_succ_app: "n \<in> nat ==> repeat(a,succ(n)) = repeat(a,n) @ [a]"
apply (induct_tac n)
apply (simp_all del: app_Cons add: app_Cons [symmetric])
done

lemma repeat_type [TC]: "[|a \<in> A; n \<in> nat|] ==> repeat(a,n) \<in> list(A)"
by (induct_tac n, auto)

end