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

  Provides the "master_theorem" and "akra_bazzi_termination" proof methods.
*)
section \<open>The proof methods\<close>
subsection \<open>Master theorem and termination\<close>
theory Akra_Bazzi_Method
imports
  Complex_Main
  Akra_Bazzi
  Master_Theorem
  Eval_Numeral
begin

lemma landau_symbol_ge_3_cong:
  assumes "landau_symbol L L' Lr"
  assumes "\<And>x::'a::linordered_semidom. x \<ge> 3 \<Longrightarrow> f x = g x"
  shows   "L at_top (f) = L at_top (g)"
apply (rule landau_symbol.cong[OF assms(1)])
apply (subst eventually_at_top_linorder, rule exI[of _ 3], simp add: assms(2))
done

lemma exp_1_lt_3: "exp (1::real) < 3"
proof-
  from Taylor_up[of 3 "\<lambda>_. exp" exp 0 1 0]
    obtain t :: real where "t > 0" "t < 1" "exp 1 = 5/2 + exp t / 6" by (auto simp: eval_nat_numeral)
  note this(3)
  also from \<open>t < 1\<close> have "exp t < exp 1" by simp
  finally show "exp (1::real) < 3" by (simp add: field_simps)
qed

lemma ln_ln_pos:
  assumes "(x::real) \<ge> 3"
  shows   "ln (ln x) > 0"
proof (subst ln_gt_zero_iff)
  from assms exp_1_lt_3 have "ln x > ln (exp 1)" by (intro ln_mono_strict) simp_all
  thus "ln x > 0" "ln x > 1" by simp_all
qed

definition akra_bazzi_terms where
  "akra_bazzi_terms x\<^sub>0 x\<^sub>1 bs ts = (\<forall>i<length bs. akra_bazzi_term x\<^sub>0 x\<^sub>1 (bs!i) (ts!i))"

lemma akra_bazzi_termsI:
  "(\<And>i. i < length bs \<Longrightarrow> akra_bazzi_term x\<^sub>0 x\<^sub>1 (bs!i) (ts!i)) \<Longrightarrow> akra_bazzi_terms x\<^sub>0 x\<^sub>1 bs ts"
  unfolding akra_bazzi_terms_def by blast

lemma master_theorem_functionI:
  assumes "\<forall>x\<in>{x\<^sub>0..<x\<^sub>1}. f x \<ge> 0"
  assumes "\<forall>x\<ge>x\<^sub>1. f x = g x + (\<Sum>i<k. as ! i * f ((ts ! i) x))"
  assumes "\<forall>x\<ge>x\<^sub>1. g x \<ge> 0"
  assumes "\<forall>a\<in>set as. a \<ge> 0"
  assumes "list_ex (\<lambda>a. a > 0) as"
  assumes "\<forall>b\<in>set bs. b \<in> {0<..<1}"
  assumes "k \<noteq> 0"
  assumes "length as = k"
  assumes "length bs = k"
  assumes "length ts = k"
  assumes "akra_bazzi_terms x\<^sub>0 x\<^sub>1 bs ts"
  shows "master_theorem_function x\<^sub>0 x\<^sub>1 k as bs ts f g"
using assms unfolding akra_bazzi_terms_def by unfold_locales (auto simp: list_ex_iff)

lemma akra_bazzi_term_measure:
  " x \<ge> x\<^sub>1 \<Longrightarrow> akra_bazzi_term 0 x\<^sub>1 b t \<Longrightarrow> (t x, x) \<in> Wellfounded.measure (\<lambda>n::nat. n)"
  " x > x\<^sub>1 \<Longrightarrow> akra_bazzi_term 0 (Suc x\<^sub>1) b t \<Longrightarrow> (t x, x) \<in> Wellfounded.measure (\<lambda>n::nat. n)"
  unfolding akra_bazzi_term_def by auto

lemma measure_prod_conv:
  "((a, b), (c, d)) \<in> Wellfounded.measure (\<lambda>x. t (fst x)) \<longleftrightarrow> (a, c) \<in> Wellfounded.measure t"
  "((e, f), (g, h)) \<in> Wellfounded.measure (\<lambda>x. t (snd x)) \<longleftrightarrow> (f, h) \<in> Wellfounded.measure t"
by simp_all

lemmas measure_prod_conv' = measure_prod_conv[where t = "\<lambda>x. x"]

lemma akra_bazzi_termination_simps:
  fixes x :: nat
  shows "a * real x / b = a/b * real x" "real x / b = 1/b * real x"
  by simp_all

lemma akra_bazzi_params_nonzeroI:
  "length as = length bs \<Longrightarrow>
   (\<forall>a\<in>set as. a \<ge> 0) \<Longrightarrow> (\<forall>b\<in>set bs. b \<in> {0<..<1}) \<Longrightarrow> (\<exists>a\<in>set as. a > 0) \<Longrightarrow>
   akra_bazzi_params_nonzero (length as) as bs" by (unfold_locales, simp_all) []

lemmas akra_bazzi_p_rel_intros =
  akra_bazzi_params_nonzero.p_lessI[rotated, OF _ akra_bazzi_params_nonzeroI]
  akra_bazzi_params_nonzero.p_greaterI[rotated, OF _ akra_bazzi_params_nonzeroI]
  akra_bazzi_params_nonzero.p_leI[rotated, OF _ akra_bazzi_params_nonzeroI]
  akra_bazzi_params_nonzero.p_geI[rotated, OF _ akra_bazzi_params_nonzeroI]
  akra_bazzi_params_nonzero.p_boundsI[rotated, OF _ akra_bazzi_params_nonzeroI]
  akra_bazzi_params_nonzero.p_boundsI'[rotated, OF _ akra_bazzi_params_nonzeroI]

lemma eval_length: "length [] = 0" "length (x # xs) = Suc (length xs)" by simp_all

lemma eval_akra_bazzi_sum:
  "(\<Sum>i<0. as!i * bs!i powr x) = 0"
  "(\<Sum>i<Suc 0. (a#as)!i * (b#bs)!i powr x) = a * b powr x"
  "(\<Sum>i<Suc k. (a#as)!i * (b#bs)!i powr x) = a * b powr x + (\<Sum>i<k. as!i * bs!i powr x)"
  apply simp
  apply simp
  apply (induction k arbitrary: a as b bs)
  apply simp_all
  done

lemma eval_akra_bazzi_sum':
  "(\<Sum>i<0. as!i * f ((ts!i) x)) = 0"
  "(\<Sum>i<Suc 0. (a#as)!i * f (((t#ts)!i) x)) = a * f (t x)"
  "(\<Sum>i<Suc k. (a#as)!i * f (((t#ts)!i) x)) = a * f (t x) + (\<Sum>i<k. as!i * f ((ts!i) x))"
  apply simp
  apply simp
  apply (induction k arbitrary: a as t ts)
  apply (simp_all add: algebra_simps)
  done

lemma akra_bazzi_termsI':
  "akra_bazzi_terms x\<^sub>0 x\<^sub>1 [] []"
  "akra_bazzi_term x\<^sub>0 x\<^sub>1 b t \<Longrightarrow> akra_bazzi_terms x\<^sub>0 x\<^sub>1 bs ts \<Longrightarrow> akra_bazzi_terms x\<^sub>0 x\<^sub>1 (b#bs) (t#ts)"
unfolding akra_bazzi_terms_def using less_Suc_eq_0_disj by auto

lemma ball_set_intros: "(\<forall>x\<in>set []. P x)" "P x \<Longrightarrow> (\<forall>x\<in>set xs. P x) \<Longrightarrow> (\<forall>x\<in>set (x#xs). P x)"
  by auto

lemma ball_set_simps: "(\<forall>x\<in>set []. P x) = True" "(\<forall>x\<in>set (x#xs). P x) = (P x \<and> (\<forall>x\<in>set xs. P x))"
  by auto

lemma bex_set_simps: "(\<exists>x\<in>set []. P x) = False" "(\<exists>x\<in>set (x#xs). P x) = (P x \<or> (\<exists>x\<in>set xs. P x))"
  by auto

lemma eval_akra_bazzi_le_list_ex:
  "list_ex P (x#y#xs) \<longleftrightarrow> P x \<or> list_ex P (y#xs)"
  "list_ex P [x] \<longleftrightarrow> P x"
  "list_ex P [] \<longleftrightarrow> False"
  by (auto simp: list_ex_iff)

lemma eval_akra_bazzi_le_sum_list:
  "x \<le> sum_list [] \<longleftrightarrow> x \<le> 0" "x \<le> sum_list (y#ys) \<longleftrightarrow> x \<le> y + sum_list ys"
  "x \<le> z + sum_list [] \<longleftrightarrow> x \<le> z" "x \<le> z + sum_list (y#ys) \<longleftrightarrow> x \<le> z + y + sum_list ys"
  by (simp_all add: algebra_simps)

lemma atLeastLessThanE: "x \<in> {a..<b} \<Longrightarrow> (x \<ge> a \<Longrightarrow> x < b \<Longrightarrow> P) \<Longrightarrow> P" by simp

lemma master_theorem_preprocess:
  "\<Theta>(\<lambda>n::nat. 1) = \<Theta>(\<lambda>n::nat. real n powr 0)"
  "\<Theta>(\<lambda>n::nat. real n) = \<Theta>(\<lambda>n::nat. real n powr 1)"
  "O(\<lambda>n::nat. 1) = O(\<lambda>n::nat. real n powr 0)"
  "O(\<lambda>n::nat. real n) = O(\<lambda>n::nat. real n powr 1)"

  "\<Theta>(\<lambda>n::nat. ln (ln (real n))) = \<Theta>(\<lambda>n::nat. real n powr 0 * ln (ln (real n)))"
  "\<Theta>(\<lambda>n::nat. real n * ln (ln (real n))) = \<Theta>(\<lambda>n::nat. real n powr 1 * ln (ln (real n)))"

  "\<Theta>(\<lambda>n::nat. ln (real n)) = \<Theta>(\<lambda>n::nat. real n powr 0 * ln (real n) powr 1)"
  "\<Theta>(\<lambda>n::nat. real n * ln (real n)) = \<Theta>(\<lambda>n::nat. real n powr 1 * ln (real n) powr 1)"
  "\<Theta>(\<lambda>n::nat. real n powr p * ln (real n)) = \<Theta>(\<lambda>n::nat. real n powr p * ln (real n) powr 1)"
  "\<Theta>(\<lambda>n::nat. ln (real n) powr p') = \<Theta>(\<lambda>n::nat. real n powr 0 * ln (real n) powr p')"
  "\<Theta>(\<lambda>n::nat. real n * ln (real n) powr p') = \<Theta>(\<lambda>n::nat. real n powr 1 * ln (real n) powr p')"
apply (simp_all)
apply (simp_all cong: landau_symbols[THEN landau_symbol_ge_3_cong])?
done

lemma akra_bazzi_term_imp_size_less:
  "x\<^sub>1 \<le> x \<Longrightarrow> akra_bazzi_term 0 x\<^sub>1 b t \<Longrightarrow> size (t x) < size x"
  "x\<^sub>1 < x \<Longrightarrow> akra_bazzi_term 0 (Suc x\<^sub>1) b t \<Longrightarrow> size (t x) < size x"
  by (simp_all add: akra_bazzi_term_imp_less)

definition "CLAMP (f :: nat \<Rightarrow> real) x = (if x < 3 then 0 else f x)"
definition "CLAMP' (f :: nat \<Rightarrow> real) x = (if x < 3 then 0 else f x)"
definition "MASTER_BOUND a b c x = real x powr a * ln (real x) powr b * ln (ln (real x)) powr c"
definition "MASTER_BOUND' a b x = real x powr a * ln (real x) powr b"
definition "MASTER_BOUND'' a x = real x powr a"

lemma ln_1_imp_less_3:
  "ln x = (1::real) \<Longrightarrow> x < 3"
proof-
  assume "ln x = 1"
  also have "(1::real) \<le> ln (exp 1)" by simp
  finally have "ln x \<le> ln (exp 1)" by simp
  hence "x \<le> exp 1"
    by (cases "x > 0") (force simp del: ln_exp simp add: not_less intro: order.trans)+
  also have "... < 3" by (rule exp_1_lt_3)
  finally show ?thesis .
qed

lemma ln_1_imp_less_3': "ln (real (x::nat)) = 1 \<Longrightarrow> x < 3" by (drule ln_1_imp_less_3) simp

lemma ln_ln_nonneg: "x \<ge> (3::real) \<Longrightarrow> ln (ln x) \<ge> 0" using ln_ln_pos[of "x"] by simp
lemma ln_ln_nonneg': "x \<ge> (3::nat) \<Longrightarrow> ln (ln (real x)) \<ge> 0" using ln_ln_pos[of "real x"] by simp

lemma MASTER_BOUND_postproc:
  "CLAMP (MASTER_BOUND' a 0) = CLAMP (MASTER_BOUND'' a)"
  "CLAMP (MASTER_BOUND' a 1) = CLAMP (\<lambda>x. CLAMP (MASTER_BOUND'' a) x * CLAMP (\<lambda>x. ln (real x)) x)"
  "CLAMP (MASTER_BOUND' a (numeral n)) =
       CLAMP (\<lambda>x. CLAMP (MASTER_BOUND'' a) x * CLAMP (\<lambda>x. ln (real x) ^ numeral n) x)"
  "CLAMP (MASTER_BOUND' a (-1)) =
       CLAMP (\<lambda>x. CLAMP (MASTER_BOUND'' a) x / CLAMP (\<lambda>x. ln (real x)) x)"
  "CLAMP (MASTER_BOUND' a (-numeral n)) =
       CLAMP (\<lambda>x. CLAMP (MASTER_BOUND'' a) x / CLAMP (\<lambda>x. ln (real x) ^ numeral n) x)"
  "CLAMP (MASTER_BOUND' a b) =
       CLAMP (\<lambda>x. CLAMP (MASTER_BOUND'' a) x * CLAMP (\<lambda>x. ln (real x) powr b) x)"

  "CLAMP (MASTER_BOUND'' 0) = CLAMP (\<lambda>x. 1)"
  "CLAMP (MASTER_BOUND'' 1) = CLAMP (\<lambda>x. (real x))"
  "CLAMP (MASTER_BOUND'' (numeral n)) = CLAMP (\<lambda>x. (real x) ^ numeral n)"
  "CLAMP (MASTER_BOUND'' (-1)) = CLAMP (\<lambda>x. 1 / (real x))"
  "CLAMP (MASTER_BOUND'' (-numeral n)) = CLAMP (\<lambda>x. 1 / (real x) ^ numeral n)"
  "CLAMP (MASTER_BOUND'' a) = CLAMP (\<lambda>x. (real x) powr a)"

  and MASTER_BOUND_UNCLAMP:
  "CLAMP (\<lambda>x. CLAMP f x * CLAMP g x) = CLAMP (\<lambda>x. f x * g x)"
  "CLAMP (\<lambda>x. CLAMP f x / CLAMP g x) = CLAMP (\<lambda>x. f x / g x)"
  "CLAMP (CLAMP f) = CLAMP f"
  unfolding CLAMP_def[abs_def] MASTER_BOUND'_def[abs_def] MASTER_BOUND''_def[abs_def]
  by (simp_all add: powr_minus divide_inverse fun_eq_iff)

context
begin

private lemma CLAMP_:
  "landau_symbol L L' Lr \<Longrightarrow> L at_top (f::nat \<Rightarrow> real) \<equiv> L at_top (\<lambda>x. CLAMP f x)"
  unfolding CLAMP_def[abs_def]
  by (intro landau_symbol.cong eq_reflection)
     (auto intro: eventually_mono[OF eventually_ge_at_top[of "3::nat"]])

private lemma UNCLAMP'_:
  "landau_symbol L L' Lr \<Longrightarrow> L at_top (CLAMP' (MASTER_BOUND a b c)) \<equiv> L at_top (MASTER_BOUND a b c)"
  unfolding CLAMP'_def[abs_def] CLAMP_def[abs_def]
  by (intro landau_symbol.cong eq_reflection)
     (auto intro: eventually_mono[OF eventually_ge_at_top[of "3::nat"]])

private lemma UNCLAMP_:
  "landau_symbol L L' Lr \<Longrightarrow> L at_top (CLAMP f) \<equiv> L at_top (f)"
  using eventually_ge_at_top[of "3::nat"] unfolding CLAMP'_def[abs_def] CLAMP_def[abs_def]
  by (intro landau_symbol.cong eq_reflection)
     (auto intro: eventually_mono[OF eventually_ge_at_top[of "3::nat"]])

lemmas CLAMP = landau_symbols[THEN CLAMP_]
lemmas UNCLAMP' = landau_symbols[THEN UNCLAMP'_]
lemmas UNCLAMP = landau_symbols[THEN UNCLAMP_]
end

lemma propagate_CLAMP:
  "CLAMP (\<lambda>x. f x * g x) = CLAMP' (\<lambda>x. CLAMP f x * CLAMP g x)"
  "CLAMP (\<lambda>x. f x / g x) = CLAMP' (\<lambda>x. CLAMP f x / CLAMP g x)"
  "CLAMP (\<lambda>x. inverse (f x)) = CLAMP' (\<lambda>x. inverse (CLAMP f x))"
  "CLAMP (\<lambda>x. real x) = CLAMP' (MASTER_BOUND 1 0 0)"
  "CLAMP (\<lambda>x. real x powr a) = CLAMP' (MASTER_BOUND a 0 0)"
  "CLAMP (\<lambda>x. real x ^ a') = CLAMP' (MASTER_BOUND (real a') 0 0)"
  "CLAMP (\<lambda>x. ln (real x)) = CLAMP' (MASTER_BOUND 0 1 0)"
  "CLAMP (\<lambda>x. ln (real x) powr b) = CLAMP' (MASTER_BOUND 0 b 0)"
  "CLAMP (\<lambda>x. ln (real x) ^ b') = CLAMP' (MASTER_BOUND 0 (real b') 0)"
  "CLAMP (\<lambda>x. ln (ln (real x))) = CLAMP' (MASTER_BOUND 0 0 1)"
  "CLAMP (\<lambda>x. ln (ln (real x)) powr c) = CLAMP' (MASTER_BOUND 0 0 c)"
  "CLAMP (\<lambda>x. ln (ln (real x)) ^ c') = CLAMP' (MASTER_BOUND 0 0 (real c'))"
  "CLAMP' (CLAMP f) = CLAMP' f"
  "CLAMP' (\<lambda>x. CLAMP' (MASTER_BOUND a1 b1 c1) x * CLAMP' (MASTER_BOUND a2 b2 c2) x) =
       CLAMP' (MASTER_BOUND (a1+a2) (b1+b2) (c1+c2))"
  "CLAMP' (\<lambda>x. CLAMP' (MASTER_BOUND a1 b1 c1) x / CLAMP' (MASTER_BOUND a2 b2 c2) x) =
       CLAMP' (MASTER_BOUND (a1-a2) (b1-b2) (c1-c2))"
  "CLAMP' (\<lambda>x. inverse (MASTER_BOUND a1 b1 c1 x)) = CLAMP' (MASTER_BOUND (-a1) (-b1) (-c1))"
by (insert ln_1_imp_less_3')
   (rule ext, simp add: CLAMP_def CLAMP'_def MASTER_BOUND_def
      powr_realpow powr_one[OF ln_ln_nonneg'] powr_realpow[OF ln_ln_pos] powr_add
      powr_diff powr_minus)+

lemma numeral_assoc_simps:
  "((a::real) + numeral b) + numeral c = a + numeral (b + c)"
  "(a + numeral b) - numeral c = a + neg_numeral_class.sub b c"
  "(a - numeral b) + numeral c = a + neg_numeral_class.sub c b"
  "(a - numeral b) - numeral c = a - numeral (b + c)" by simp_all

lemmas CLAMP_aux =
  arith_simps numeral_assoc_simps of_nat_power of_nat_mult of_nat_numeral
  one_add_one numeral_One [symmetric]

lemmas CLAMP_postproc = numeral_One

context master_theorem_function
begin

lemma master1_bigo_automation:
  assumes "g \<in> O(\<lambda>x. real x powr p')" "1 < (\<Sum>i<k. as ! i * bs ! i powr p')"
  shows   "f \<in> O(MASTER_BOUND p 0 0)"
proof-
  have "MASTER_BOUND p 0 0 \<in> \<Theta>(\<lambda>x::nat. x powr p)" unfolding MASTER_BOUND_def[abs_def]
    by (intro landau_real_nat_transfer bigthetaI_cong
          eventually_mono[OF eventually_ge_at_top[of "3::real"]]) (auto dest!: ln_1_imp_less_3)
  from landau_o.big.cong_bigtheta[OF this] master1_bigo[OF assms] show ?thesis by simp
qed

lemma master1_automation:
  assumes "g \<in> O(MASTER_BOUND'' p')" "1 < (\<Sum>i<k. as ! i * bs ! i powr p')"
          "eventually (\<lambda>x. f x > 0) at_top"
  shows   "f \<in> \<Theta>(MASTER_BOUND p 0 0)"
proof-
  have A: "MASTER_BOUND p 0 0 \<in> \<Theta>(\<lambda>x::nat. x powr p)" unfolding MASTER_BOUND_def[abs_def]
    by (intro landau_real_nat_transfer bigthetaI_cong
      eventually_mono[OF eventually_ge_at_top[of "3::real"]]) (auto dest!: ln_1_imp_less_3)
  have B: "O(MASTER_BOUND'' p') = O(\<lambda>x::nat. real x powr p')"
    using eventually_ge_at_top[of "2::nat"]
    by (intro landau_o.big.cong) (auto elim!: eventually_mono simp: MASTER_BOUND''_def)
  from landau_theta.cong_bigtheta[OF A] B assms(1) master1[OF _ assms(2-)] show ?thesis by simp
qed

lemma master2_1_automation:
  assumes "g \<in> \<Theta>(MASTER_BOUND' p p')" "p' < -1"
  shows   "f \<in> \<Theta>(MASTER_BOUND p 0 0)"
proof-
  have A: "MASTER_BOUND p 0 0 \<in> \<Theta>(\<lambda>x::nat. x powr p)" unfolding MASTER_BOUND_def[abs_def]
    by (intro landau_real_nat_transfer bigthetaI_cong
          eventually_mono[OF eventually_ge_at_top[of "3::real"]]) (auto dest!: ln_1_imp_less_3)
  have B: "\<Theta>(MASTER_BOUND' p p') = \<Theta>(\<lambda>x::nat. real x powr p * ln (real x) powr p')"
    by (subst CLAMP, (subst MASTER_BOUND_postproc MASTER_BOUND_UNCLAMP)+, simp only: UNCLAMP)
  from landau_theta.cong_bigtheta[OF A] B assms(1) master2_1[OF _ assms(2-)] show ?thesis by simp
qed

lemma master2_2_automation:
  assumes "g \<in> \<Theta>(MASTER_BOUND' p (-1))"
  shows   "f \<in> \<Theta>(MASTER_BOUND p 0 1)"
proof-
  have A: "MASTER_BOUND p 0 1 \<in> \<Theta>(\<lambda>x::nat. x powr p * ln (ln x))" unfolding MASTER_BOUND_def[abs_def]
    using eventually_ge_at_top[of "3::real"]
    apply (intro landau_real_nat_transfer, intro bigthetaI_cong)
    apply (elim eventually_mono, subst powr_one[OF ln_ln_nonneg])
    apply simp_all
    done
  have B: "\<Theta>(MASTER_BOUND' p (-1)) = \<Theta>(\<lambda>x::nat. real x powr p / ln (real x))"
    by (subst CLAMP, (subst MASTER_BOUND_postproc MASTER_BOUND_UNCLAMP)+, simp only: UNCLAMP)
  from landau_theta.cong_bigtheta[OF A] B assms(1) master2_2 show ?thesis by simp
qed

lemma master2_3_automation:
  assumes "g \<in> \<Theta>(MASTER_BOUND' p (p' - 1))" "p' > 0"
  shows   "f \<in> \<Theta>(MASTER_BOUND p p' 0)"
proof-
  have A: "MASTER_BOUND p p' 0 \<in> \<Theta>(\<lambda>x::nat. x powr p * ln x powr p')" unfolding MASTER_BOUND_def[abs_def]
    using eventually_ge_at_top[of "3::real"]
    apply (intro landau_real_nat_transfer, intro bigthetaI_cong)
    apply (elim eventually_mono, auto dest: ln_1_imp_less_3)
    done
  have B: "\<Theta>(MASTER_BOUND' p (p' - 1)) = \<Theta>(\<lambda>x::nat. real x powr p * ln x powr (p' - 1))"
    by (subst CLAMP, (subst MASTER_BOUND_postproc MASTER_BOUND_UNCLAMP)+, simp only: UNCLAMP)
  from landau_theta.cong_bigtheta[OF A] B assms(1) master2_3[OF _ assms(2-)] show ?thesis by simp
qed

lemma master3_automation:
  assumes "g \<in> \<Theta>(MASTER_BOUND'' p')" "1 > (\<Sum>i<k. as ! i * bs ! i powr p')"
  shows   "f \<in> \<Theta>(MASTER_BOUND p' 0 0)"
proof-
  have A: "MASTER_BOUND p' 0 0 \<in> \<Theta>(\<lambda>x::nat. x powr p')" unfolding MASTER_BOUND_def[abs_def]
    using eventually_ge_at_top[of "3::real"]
    apply (intro landau_real_nat_transfer, intro bigthetaI_cong)
    apply (elim eventually_mono, auto dest: ln_1_imp_less_3)
    done
  have B: "\<Theta>(MASTER_BOUND'' p') = \<Theta>(\<lambda>x::nat. real x powr p')"
    by (subst CLAMP, (subst MASTER_BOUND_postproc)+, simp only: UNCLAMP)
  from landau_theta.cong_bigtheta[OF A] B assms(1) master3[OF _ assms(2-)] show ?thesis by simp
qed

lemmas master_automation =
  master1_automation master2_1_automation master2_2_automation
  master2_2_automation master3_automation

ML \<open>

fun generalize_master_thm ctxt thm =
  let
    val ([p'], ctxt') = Variable.variant_fixes ["p''"] ctxt
    val p' = Free (p', HOLogic.realT)
    val a = @{term "nth as"} $ Bound 0
    val b = @{term "Transcendental.powr :: real => real => real"} $
              (@{term "nth bs"} $ Bound 0) $ p'
    val f = Abs ("i", HOLogic.natT, @{term "(*) :: real => real => real"} $ a $ b)
    val sum = @{term "sum :: (nat => real) => nat set => real"} $ f $ @{term "{..<k}"}
    val prop = HOLogic.mk_Trueprop (HOLogic.mk_eq (sum, @{term "1::real"}))
    val cprop = Thm.cterm_of ctxt' prop
  in
    thm
    |> Local_Defs.unfold ctxt' [Thm.assume cprop RS @{thm p_unique}]
    |> Thm.implies_intr cprop
    |> rotate_prems 1
    |> singleton (Variable.export ctxt' ctxt)
  end

fun generalize_master_thm' (binding, thm) ctxt =
  Local_Theory.note ((binding, []), [generalize_master_thm ctxt thm]) ctxt |> snd

\<close>

local_setup \<open>
  fold generalize_master_thm'
    [(@{binding master1_automation'}, @{thm master1_automation}),
     (@{binding master1_bigo_automation'}, @{thm master1_bigo_automation}),
     (@{binding master2_1_automation'}, @{thm master2_1_automation}),
     (@{binding master2_2_automation'}, @{thm master2_2_automation}),
     (@{binding master2_3_automation'}, @{thm master2_3_automation}),
     (@{binding master3_automation'}, @{thm master3_automation})]
\<close>

end

definition "arith_consts (x :: real) (y :: nat) =
  (if \<not> (-x) + 3 / x * 5 - 1 \<le> x \<and> True \<or> True \<longrightarrow> True then
  x < inverse 3 powr 21 else x = real (Suc 0 ^ 2 +
  (if 42 - x \<le> 1 \<and> 1 div y = y mod 2 \<or> y < Numeral1 then 0 else 0)) + Numeral1)"

ML_file \<open>akra_bazzi.ML\<close>

hide_const arith_consts

method_setup master_theorem = \<open>
  Akra_Bazzi.setup_master_theorem
\<close> "automatically apply the Master theorem for recursive functions"

method_setup akra_bazzi_termination = \<open>
  Scan.succeed (fn ctxt => SIMPLE_METHOD' (Akra_Bazzi.akra_bazzi_termination_tac ctxt))
\<close> "prove termination of Akra-Bazzi functions"

hide_const CLAMP CLAMP' MASTER_BOUND MASTER_BOUND' MASTER_BOUND''

end


(*  Title:      HOL/HOLCF/Tr.thy
    Author:     Franz Regensburger
*)

section \<open>The type of lifted booleans\<close>

theory Tr
  imports Lift
begin

subsection \<open>Type definition and constructors\<close>

type_synonym tr = "bool lift"

translations
  (type) "tr" \<leftharpoondown> (type) "bool lift"

definition TT :: "tr"
  where "TT = Def True"

definition FF :: "tr"
  where "FF = Def False"

text \<open>Exhaustion and Elimination for type \<^typ>\<open>tr\<close>\<close>

lemma Exh_tr: "t = \<bottom> \<or> t = TT \<or> t = FF"
  by (induct t) (auto simp: FF_def TT_def)

lemma trE [case_names bottom TT FF, cases type: tr]:
  "\<lbrakk>p = \<bottom> \<Longrightarrow> Q; p = TT \<Longrightarrow> Q; p = FF \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
  by (induct p) (auto simp: FF_def TT_def)

lemma tr_induct [case_names bottom TT FF, induct type: tr]:
  "P \<bottom> \<Longrightarrow> P TT \<Longrightarrow> P FF \<Longrightarrow> P x"
  by (cases x) simp_all

text \<open>distinctness for type \<^typ>\<open>tr\<close>\<close>

lemma dist_below_tr [simp]:
  "TT \<notsqsubseteq> \<bottom>" "FF \<notsqsubseteq> \<bottom>" "TT \<notsqsubseteq> FF" "FF \<notsqsubseteq> TT"
  by (simp_all add: TT_def FF_def)

lemma dist_eq_tr [simp]: "TT \<noteq> \<bottom>" "FF \<noteq> \<bottom>" "TT \<noteq> FF" "\<bottom> \<noteq> TT" "\<bottom> \<noteq> FF" "FF \<noteq> TT"
  by (simp_all add: TT_def FF_def)

lemma TT_below_iff [simp]: "TT \<sqsubseteq> x \<longleftrightarrow> x = TT"
  by (induct x) simp_all

lemma FF_below_iff [simp]: "FF \<sqsubseteq> x \<longleftrightarrow> x = FF"
  by (induct x) simp_all

lemma not_below_TT_iff [simp]: "x \<notsqsubseteq> TT \<longleftrightarrow> x = FF"
  by (induct x) simp_all

lemma not_below_FF_iff [simp]: "x \<notsqsubseteq> FF \<longleftrightarrow> x = TT"
  by (induct x) simp_all

subsection \<open>Case analysis\<close>

default_sort pcpo

definition tr_case :: "'a \<rightarrow> 'a \<rightarrow> tr \<rightarrow> 'a"
  where "tr_case = (\<Lambda> t e (Def b). if b then t else e)"

abbreviation cifte_syn :: "[tr, 'c, 'c] \<Rightarrow> 'c"  ("(If (_)/ then (_)/ else (_))" [0, 0, 60] 60)
  where "If b then e1 else e2 \<equiv> tr_case\<cdot>e1\<cdot>e2\<cdot>b"

translations
  "\<Lambda> (XCONST TT). t" \<rightleftharpoons> "CONST tr_case\<cdot>t\<cdot>\<bottom>"
  "\<Lambda> (XCONST FF). t" \<rightleftharpoons> "CONST tr_case\<cdot>\<bottom>\<cdot>t"

lemma ifte_thms [simp]:
  "If \<bottom> then e1 else e2 = \<bottom>"
  "If FF then e1 else e2 = e2"
  "If TT then e1 else e2 = e1"
  by (simp_all add: tr_case_def TT_def FF_def)

subsection \<open>Boolean connectives\<close>

definition trand :: "tr \<rightarrow> tr \<rightarrow> tr"
  where andalso_def: "trand = (\<Lambda> x y. If x then y else FF)"

abbreviation andalso_syn :: "tr \<Rightarrow> tr \<Rightarrow> tr"  ("_ andalso _" [36,35] 35)
  where "x andalso y \<equiv> trand\<cdot>x\<cdot>y"

definition tror :: "tr \<rightarrow> tr \<rightarrow> tr"
  where orelse_def: "tror = (\<Lambda> x y. If x then TT else y)"

abbreviation orelse_syn :: "tr \<Rightarrow> tr \<Rightarrow> tr"  ("_ orelse _"  [31,30] 30)
  where "x orelse y \<equiv> tror\<cdot>x\<cdot>y"

definition neg :: "tr \<rightarrow> tr"
  where "neg = flift2 Not"

definition If2 :: "tr \<Rightarrow> 'c \<Rightarrow> 'c \<Rightarrow> 'c"
  where "If2 Q x y = (If Q then x else y)"

text \<open>tactic for tr-thms with case split\<close>

lemmas tr_defs = andalso_def orelse_def neg_def tr_case_def TT_def FF_def

text \<open>lemmas about andalso, orelse, neg and if\<close>

lemma andalso_thms [simp]:
  "(TT andalso y) = y"
  "(FF andalso y) = FF"
  "(\<bottom> andalso y) = \<bottom>"
  "(y andalso TT) = y"
  "(y andalso y) = y"
      apply (unfold andalso_def, simp_all)
   apply (cases y, simp_all)
  apply (cases y, simp_all)
  done

lemma orelse_thms [simp]:
  "(TT orelse y) = TT"
  "(FF orelse y) = y"
  "(\<bottom> orelse y) = \<bottom>"
  "(y orelse FF) = y"
  "(y orelse y) = y"
      apply (unfold orelse_def, simp_all)
   apply (cases y, simp_all)
  apply (cases y, simp_all)
  done

lemma neg_thms [simp]:
  "neg\<cdot>TT = FF"
  "neg\<cdot>FF = TT"
  "neg\<cdot>\<bottom> = \<bottom>"
  by (simp_all add: neg_def TT_def FF_def)

text \<open>split-tac for If via If2 because the constant has to be a constant\<close>

lemma split_If2: "P (If2 Q x y) \<longleftrightarrow> ((Q = \<bottom> \<longrightarrow> P \<bottom>) \<and> (Q = TT \<longrightarrow> P x) \<and> (Q = FF \<longrightarrow> P y))"
  by (cases Q) (simp_all add: If2_def)

(* FIXME unused!? *)
ML \<open>
fun split_If_tac ctxt =
  simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm If2_def} RS sym])
    THEN' (split_tac ctxt [@{thm split_If2}])
\<close>

subsection "Rewriting of HOLCF operations to HOL functions"

lemma andalso_or: "t \<noteq> \<bottom> \<Longrightarrow> (t andalso s) = FF \<longleftrightarrow> t = FF \<or> s = FF"
  by (cases t) simp_all

lemma andalso_and: "t \<noteq> \<bottom> \<Longrightarrow> ((t andalso s) \<noteq> FF) \<longleftrightarrow> t \<noteq> FF \<and> s \<noteq> FF"
  by (cases t) simp_all

lemma Def_bool1 [simp]: "Def x \<noteq> FF \<longleftrightarrow> x"
  by (simp add: FF_def)

lemma Def_bool2 [simp]: "Def x = FF \<longleftrightarrow> \<not> x"
  by (simp add: FF_def)

lemma Def_bool3 [simp]: "Def x = TT \<longleftrightarrow> x"
  by (simp add: TT_def)

lemma Def_bool4 [simp]: "Def x \<noteq> TT \<longleftrightarrow> \<not> x"
  by (simp add: TT_def)

lemma If_and_if: "(If Def P then A else B) = (if P then A else B)"
  by (cases "Def P") (auto simp add: TT_def[symmetric] FF_def[symmetric])

subsection \<open>Compactness\<close>

lemma compact_TT: "compact TT"
  by (rule compact_chfin)

lemma compact_FF: "compact FF"
  by (rule compact_chfin)

end


(* @TAG(OTHER_LGPL) *)

(*  Author:      Norbert Schirmer
    Maintainer:  Norbert Schirmer, norbert.schirmer at web de
    License:     LGPL
*)

(*  Title:      HeapList.thy
    Author:     Norbert Schirmer, TU Muenchen

Copyright (C) 2004-2008 Norbert Schirmer
Some rights reserved, TU Muenchen

This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2.1 of the
License, or (at your option) any later version.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA
*)

section {* Paths and Lists in the Heap *}
theory HeapList
imports Simpl_Heap
begin

text {* Adapted from 'HOL/Hoare/Heap.thy'. *}

subsection "Paths in The Heap"

primrec
 Path :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> ref \<Rightarrow>  ref list  \<Rightarrow> bool"
where
"Path x h y [] = (x = y)" |
"Path x h y (p#ps) = (x = p \<and> x \<noteq> Null \<and> Path (h x) h y ps)"

lemma Path_Null_iff [iff]: "Path Null h y xs  = (xs = [] \<and> y = Null)"
apply(case_tac xs)
apply fastforce
apply fastforce
done

lemma Path_not_Null_iff [simp]: "p\<noteq>Null \<Longrightarrow>
  Path p h q as = (as = [] \<and> q = p  \<or>  (\<exists>ps. as = p#ps \<and> Path (h p) h q ps ))"
apply(case_tac as)
apply fastforce
apply fastforce
done

lemma Path_append [simp]:
  "\<And>p. Path p f q (as@bs)  = (\<exists>y. Path p f y as \<and> Path y f q bs)"
by(induct as, simp+)

lemma notin_Path_update[simp]:
 "\<And>p. u \<notin> set ps \<Longrightarrow> Path p (f(u := v)) q ps  = Path p f q ps "
by(induct ps, simp, simp add:eq_sym_conv)

lemma Path_upd_same [simp]:
  "Path p (f(p:=p)) q qs =
      ((p=Null \<and> q=Null \<and> qs = []) \<or> (p\<noteq>Null \<and> q=p \<and> (\<forall>x\<in>set qs. x=p)))"
by (induct qs) auto

text {* @{thm[source] Path_upd_same} prevents
@{term "p\<noteq>Null \<Longrightarrow> Path p (f(p:=p)) q qs = X"} from looping, because of
@{thm[source] Path_not_Null_iff} and @{thm[source]fun_upd_apply}.
 *}

lemma notin_Path_updateI [intro]:
 "\<lbrakk>Path p h q ps ; r \<notin> set ps\<rbrakk> \<Longrightarrow> Path p (h(r := y)) q ps "
by simp

lemma Path_update_new [simp]: "\<lbrakk>set ps \<subseteq> set alloc\<rbrakk>
     \<Longrightarrow> Path p (f(new (set alloc) := x)) q ps  = Path p f q ps "
  by (rule notin_Path_update) fastforce

lemma Null_notin_Path [simp,intro]:
"\<And>p. Path p f q ps \<Longrightarrow> Null \<notin> set ps"
by(induct ps) auto

lemma Path_snoc:
 "\<lbrakk>Path p (f(a := q)) a as ; a\<noteq>Null\<rbrakk> \<Longrightarrow> Path p (f(a := q)) q (as @ [a])"
by simp

subsection "Lists on The Heap"

subsubsection "Relational Abstraction"

definition
 List :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> ref list \<Rightarrow> bool" where
"List p h ps = Path p h Null ps "

lemma List_empty [simp]: "List p h [] = (p = Null)"
by(simp add:List_def)

lemma List_cons [simp]: "List p h (a#ps) = (p = a \<and> p\<noteq>Null \<and> List (h p) h ps)"
by(simp add:List_def)

lemma List_Null [simp]: "List Null h ps = (ps = [])"
by(case_tac ps, simp_all)

lemma List_not_Null [simp]: "p\<noteq>Null \<Longrightarrow>
  List p h as = (\<exists>ps. as = p#ps \<and> List (h p) h ps)"
by(case_tac as, simp_all, fast)

lemma Null_notin_List [simp,intro]: "\<And>p. List p h ps \<Longrightarrow> Null \<notin> set ps"
by (simp add : List_def)

lemma List_upd_same_lemma: "\<And>p.  p \<noteq> Null \<Longrightarrow> \<not> List p (h(p := p)) ps"
apply (induct ps)
apply  simp
apply (simp (no_asm_simp) del: fun_upd_apply)
apply (simp (no_asm_simp) only: fun_upd_apply refl if_True)
apply blast
done

lemma List_upd_same [simp]: "List p (h(p:=p)) ps = (p = Null \<and> ps = [])"
apply (cases "p=Null")
apply  simp
apply (fast dest: List_upd_same_lemma)
done

text {* @{thm[source] List_upd_same} prevents
@{term "p\<noteq>Null \<Longrightarrow> List p (h(p:=p)) as = X"} from looping, because of
@{thm[source] List_not_Null} and @{thm[source] fun_upd_apply}.
 *}

lemma  List_update_new [simp]: "\<lbrakk>set ps \<subseteq> set alloc\<rbrakk>
     \<Longrightarrow> List p (h(new (set alloc) := x)) ps = List p h ps"
by (rule notin_List_update) fastforce

lemma List_updateI [intro]:
 "\<lbrakk>List p h ps; q \<notin> set ps\<rbrakk> \<Longrightarrow> List p (h(q := y)) ps"
by simp

lemma List_unique: "\<And>p bs. List p h as \<Longrightarrow> List p h bs \<Longrightarrow> as = bs"
by(induct as, simp, clarsimp)

lemma List_unique1: "List p h as \<Longrightarrow> \<exists>!as. List p h as"
by(blast intro:List_unique)

lemma List_app: "\<And>p. List p h (as@bs) = (\<exists>y. Path p h y as \<and> List y h bs)"
by(induct as, simp, clarsimp)

lemma List_hd_not_in_tl[simp]: "List (h p) h ps \<Longrightarrow> p \<notin> set ps"
apply (clarsimp simp add:in_set_conv_decomp)
apply(frule List_app[THEN iffD1])
apply(fastforce dest: List_unique)
done

lemma List_distinct[simp]: "\<And>p. List p h ps \<Longrightarrow> distinct ps"
apply(induct ps, simp)
apply(fastforce dest:List_hd_not_in_tl)
done

lemma heap_eq_List_eq:
  "\<And>p. \<forall>x \<in> set ps. h x = g x \<Longrightarrow> List p h ps = List p g ps"
  by (induct ps) auto

lemma heap_eq_ListI:
  assumes list: "List p h ps"
  assumes hp_eq: "\<forall>x \<in> set ps. h x = g x"
  shows "List p g ps"
  using list
  by (simp add: heap_eq_List_eq [OF hp_eq])

lemma heap_eq_ListI1:
  assumes list: "List p h ps"
  assumes hp_eq: "\<forall>x \<in> set ps. g x = h x"
  shows "List p g ps"
  using list
  by (simp add: heap_eq_List_eq [OF hp_eq])

text {* The following lemmata are usefull for the simplifier to instantiate
bound variables in the assumptions resp. conclusion, using the uniqueness
of the List predicate *}

lemma conj_impl_simp: "(P \<and> Q \<longrightarrow> K) = (P \<longrightarrow> Q \<longrightarrow> K)"
by auto

lemma  List_unique_all_impl_simp [simp]:
 "List p h ps \<Longrightarrow> (\<forall>ps. List p h ps \<longrightarrow> P ps) = P ps"
by (auto dest: List_unique)

(*
lemma  List_unique_all_impl_simp1 [simp]:
 "List p h ps \<Longrightarrow> (\<forall>ps. Q ps \<longrightarrow> List p h ps \<longrightarrow> P ps) = Q ps \<longrightarrow> P ps"
by (auto dest: List_unique)
*)
lemma List_unique_ex_conj_simp [simp]:
"List p h ps \<Longrightarrow> (\<exists>ps. List p h ps \<and> P ps) = P ps"
by (auto dest: List_unique)

subsection "Functional abstraction"

definition
 islist :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> bool" where
"islist p h = (\<exists>ps. List p h ps)"

definition
 list :: "ref \<Rightarrow> (ref \<Rightarrow> ref) \<Rightarrow> ref list" where
"list p h = (THE ps. List p h ps)"

lemma List_conv_islist_list: "List p h ps = (islist p h \<and> ps = list p h)"
apply(simp add:islist_def list_def)
apply(rule iffI)
apply(rule conjI)
apply blast
apply(subst the1_equality)
  apply(erule List_unique1)
 apply assumption
apply(rule refl)
apply simp
apply (clarify)
apply (rule theI)
apply  assumption
by (rule List_unique)

lemma List_islist [intro]:
  "List p h ps \<Longrightarrow> islist p h"
  apply (simp add: List_conv_islist_list)
  done

lemma List_list:
  "List p h ps \<Longrightarrow> list p h = ps"
  apply (simp only: List_conv_islist_list)
  done

lemma [simp]: "p\<noteq>Null \<Longrightarrow> islist (h p) h = islist p h"
by(simp add:islist_def)

lemma [simp]: "list Null h = []"
by(simp add:list_def)

lemma list_Ref_conv[simp]:
 "\<lbrakk>islist (h p) h; p\<noteq>Null \<rbrakk> \<Longrightarrow> list p h = p # list (h p) h"
apply(insert List_not_Null[of _ h])
apply(fastforce simp:List_conv_islist_list)
done

lemma [simp]: "islist (h p) h \<Longrightarrow> p \<notin> set(list (h p) h)"
apply(insert List_hd_not_in_tl[of h])
apply(simp add:List_conv_islist_list)
done

lemma list_upd_conv[simp]:
 "islist p h \<Longrightarrow> y \<notin> set(list p h) \<Longrightarrow> list p (h(y := q)) = list p h"
apply(drule notin_List_update[of _ _ p h q])
apply(simp add:List_conv_islist_list)
done

lemma islist_upd[simp]:
 "islist p h \<Longrightarrow> y \<notin> set(list p h) \<Longrightarrow> islist p (h(y := q))"
apply(frule notin_List_update[of _ _ p h q])
apply(simp add:List_conv_islist_list)
done

lemma list_distinct[simp]: "islist p h \<Longrightarrow> distinct (list p h)"
apply (clarsimp simp add: list_def islist_def)
apply (frule List_unique1)
apply (drule (1) the1_equality)
apply simp
done

lemma Null_notin_list [simp,intro]: "islist p h \<Longrightarrow> Null \<notin> set (list p h)"
apply (clarsimp simp add: list_def islist_def)
apply (frule List_unique1)
apply (drule (1) the1_equality)
apply simp
done

end


subsection\<open>Simplified Variant with Simple Entailment in Logic K (Fig.~8 in \<^cite>\<open>"C85"\<close>)\<close>

theory SimpleVariantSE imports
  HOML
  MFilter
  BaseDefs
begin
text\<open>Axiom's of new variant based on ultrafilters.\<close>
axiomatization where
  A1': "\<lfloor>\<^bold>\<not>(\<P>(\<lambda>x.(x\<^bold>\<noteq>x)))\<rfloor>" and
  A2'': "\<lfloor>\<^bold>\<forall>X Y.(((\<P> X) \<^bold>\<and> (X\<^bold>\<sqsubseteq>Y)) \<^bold>\<rightarrow> (\<P> Y))\<rfloor>" and
  T2:  "\<lfloor>\<P> \<G>\<rfloor>"

text\<open>Necessary existence of a Godlike entity.\<close>
theorem T6: "\<lfloor>\<^bold>\<box>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>" using A1' A2'' T2 by blast
theorem T7: "\<lfloor>\<^bold>\<exists>\<^sup>E \<G>\<rfloor>" using A1' A2'' T2 by blast

text\<open>Possible existence of a Godlike: has counterodel.\<close>
lemma T3: "\<lfloor>\<^bold>\<diamond>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>" nitpick oops \<comment>\<open>Countermodel\<close>

lemma T3': assumes T: "\<lfloor>\<^bold>\<forall>\<phi>.((\<^bold>\<box>\<phi>) \<^bold>\<rightarrow> \<phi>)\<rfloor>"
  shows "\<lfloor>\<^bold>\<diamond>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>"
  using A1' A2'' T2 T by metis
end