section \<open> Closed Mereology \<close>

(*<*)
theory CM
  imports M
begin
(*>*)

text \<open> The theory of \emph{closed mereology} adds to ground mereology conditions guaranteeing the
existence of sums and products.\footnote{See \<^cite>\<open>"masolo_atomicity_1999"\<close> p. 238. \<^cite>\<open>"varzi_parts_1996"\<close> p. 263
and \<^cite>\<open>"casati_parts_1999"\<close> p. 43 give a slightly weaker version of the sum closure axiom, which is
equivalent given axioms considered later.} \<close>

locale CM = M +
  assumes sum_eq: "x \<oplus> y = (THE z. \<forall>v. O v z \<longleftrightarrow> O v x \<or> O v y)"
  assumes sum_closure: "\<exists>z. \<forall>v. O v z \<longleftrightarrow> O v x \<or> O v y"
  assumes product_eq:
    "x \<otimes> y = (THE z. \<forall>v. P v z \<longleftrightarrow> P v x \<and> P v y)"
  assumes product_closure:
    "O x y \<Longrightarrow> \<exists>z. \<forall>v. P v z \<longleftrightarrow> P v x \<and> P v y"
begin

subsection \<open> Products \<close>

lemma product_intro:
  "(\<forall>w. P w z \<longleftrightarrow> (P w x \<and> P w y)) \<Longrightarrow> x \<otimes> y = z"
proof -
  assume z: "\<forall>w. P w z \<longleftrightarrow> (P w x \<and> P w y)"
  hence "(THE v. \<forall>w. P w v \<longleftrightarrow> P w x \<and> P w y) = z"
  proof (rule the_equality)
    fix v
    assume v: "\<forall>w. P w v \<longleftrightarrow> (P w x \<and> P w y)"
    have "\<forall>w. P w v \<longleftrightarrow> P w z"
    proof
      fix w
      from z have "P w z \<longleftrightarrow> (P w x \<and> P w y)"..
      moreover from v have "P w v \<longleftrightarrow> (P w x \<and> P w y)"..
      ultimately show "P w v \<longleftrightarrow> P w z" by (rule ssubst)
    qed
    with part_extensionality show "v = z"..
  qed
  thus "x \<otimes> y = z"
    using product_eq by (rule subst)
qed

lemma product_idempotence: "x \<otimes> x = x"
proof -
  have "\<forall>w. P w x \<longleftrightarrow> P w x \<and> P w x"
  proof
    fix w
    show "P w x \<longleftrightarrow> P w x \<and> P w x"
    proof
      assume "P w x"
      thus "P w x \<and> P w x" using \<open>P w x\<close>..
    next
      assume "P w x \<and> P w x"
      thus "P w x"..
    qed
  qed
  thus "x \<otimes> x = x" by (rule product_intro)
qed

lemma product_character:
  "O x y \<Longrightarrow> (\<forall>w. P w (x \<otimes> y) \<longleftrightarrow> (P w x \<and> P w y))"
proof -
  assume "O x y"
  hence "\<exists>z. \<forall>w. P w z \<longleftrightarrow> (P w x \<and> P w y)" by (rule product_closure)
  then obtain z where z: "\<forall>w. P w z \<longleftrightarrow> (P w x \<and> P w y)"..
  hence "x \<otimes> y = z" by (rule product_intro)
  thus "\<forall>w. P w (x \<otimes> y) \<longleftrightarrow> P w x \<and> P w y"
    using z by (rule ssubst)
qed

lemma product_commutativity: "O x y \<Longrightarrow> x \<otimes> y = y \<otimes> x"
proof -
  assume "O x y"
  hence "O y x" by (rule overlap_symmetry)
  hence "\<forall>w. P w (y \<otimes> x) \<longleftrightarrow> (P w y \<and> P w x)" by (rule product_character)
  hence "\<forall>w. P w (y \<otimes> x) \<longleftrightarrow> (P w x \<and> P w y)" by auto
  thus "x \<otimes> y = y \<otimes> x" by (rule product_intro)
qed

lemma product_in_factors: "O x y \<Longrightarrow> P (x \<otimes> y) x \<and> P (x \<otimes> y) y"
proof -
  assume "O x y"
  hence "\<forall>w. P w (x \<otimes> y) \<longleftrightarrow> P w x \<and> P w y" by (rule product_character)
  hence "P (x \<otimes> y) (x \<otimes> y) \<longleftrightarrow> P (x \<otimes> y) x \<and> P (x \<otimes> y) y"..
  moreover have "P (x \<otimes> y) (x \<otimes> y)" by (rule part_reflexivity)
  ultimately show "P (x \<otimes> y) x \<and> P (x \<otimes> y) y"..
qed

lemma product_in_first_factor: "O x y \<Longrightarrow> P (x \<otimes> y) x"
proof -
  assume "O x y"
  hence "P (x \<otimes> y) x \<and> P (x \<otimes> y) y" by (rule product_in_factors)
  thus "P (x \<otimes> y) x"..
qed

lemma product_in_second_factor: "O x y \<Longrightarrow> P (x \<otimes> y) y"
proof -
  assume "O x y"
  hence "P (x \<otimes> y) x \<and> P (x \<otimes> y) y" by (rule product_in_factors)
  thus "P (x \<otimes> y) y"..
qed

lemma nonpart_implies_proper_product:
  "\<not> P x y \<and> O x y \<Longrightarrow> PP (x \<otimes> y) x"
proof -
  assume antecedent: "\<not> P x y \<and> O x y"
  hence "\<not> P x y"..
  from antecedent have "O x y"..
  hence "P (x \<otimes> y) x" by (rule product_in_first_factor)
  moreover have "(x \<otimes> y) \<noteq> x"
  proof
    assume "(x \<otimes> y) = x"
    hence "\<not> P (x \<otimes> y) y"
      using \<open>\<not> P x y\<close> by (rule ssubst)
    moreover have "P (x \<otimes> y) y"
      using \<open>O x y\<close> by (rule product_in_second_factor)
    ultimately show "False"..
  qed
  ultimately have "P (x \<otimes> y) x \<and> x \<otimes> y \<noteq> x"..
  with nip_eq show "PP (x \<otimes> y) x"..
qed

lemma common_part_in_product: "P z x \<and> P z y \<Longrightarrow> P z (x \<otimes> y)"
proof -
  assume antecedent: "P z x \<and> P z y"
  hence "\<exists>z. P z x \<and> P z y"..
  with overlap_eq have "O x y"..
  hence "\<forall>w. P w (x \<otimes> y) \<longleftrightarrow> (P w x \<and> P w y)"
    by (rule product_character)
  hence "P z (x \<otimes> y) \<longleftrightarrow> (P z x \<and> P z y)"..
  thus "P z (x \<otimes> y)"
    using \<open>P z x \<and> P z y\<close>..
qed

lemma product_part_in_factors:
  "O x y \<Longrightarrow> P z (x \<otimes> y) \<Longrightarrow> P z x \<and> P z y"
proof -
  assume "O x y"
  hence "\<forall>w. P w (x \<otimes> y) \<longleftrightarrow> (P w x \<and> P w y)"
    by (rule product_character)
  hence "P z (x \<otimes> y) \<longleftrightarrow> (P z x \<and> P z y)"..
  moreover assume "P z (x \<otimes> y)"
  ultimately show "P z x \<and> P z y"..
qed

corollary product_part_in_first_factor:
  "O x y \<Longrightarrow> P z (x \<otimes> y) \<Longrightarrow> P z x"
proof -
  assume "O x y"
  moreover assume "P z (x \<otimes> y)"
  ultimately have "P z x \<and> P z y"
    by (rule product_part_in_factors)
  thus "P z x"..
qed

corollary product_part_in_second_factor:
  "O x y \<Longrightarrow> P z (x \<otimes> y) \<Longrightarrow> P z y"
proof -
  assume "O x y"
  moreover assume "P z (x \<otimes> y)"
  ultimately have "P z x \<and> P z y"
    by (rule product_part_in_factors)
  thus "P z y"..
qed

lemma part_product_identity: "P x y \<Longrightarrow> x \<otimes> y = x"
proof -
  assume "P x y"
  with part_reflexivity have "P x x \<and> P x y"..
  hence "P x (x \<otimes> y)" by (rule common_part_in_product)
  have "O x y" using \<open>P x y\<close> by (rule part_implies_overlap)
  hence  "P (x \<otimes> y) x" by (rule product_in_first_factor)
  thus "x \<otimes> y = x" using \<open>P x (x \<otimes> y)\<close> by (rule part_antisymmetry)
qed

lemma product_overlap: "P z x \<Longrightarrow> O z y \<Longrightarrow> O z (x \<otimes> y)"
proof -
  assume "P z x"
  assume "O z y"
  with overlap_eq have "\<exists>v. P v z \<and> P v y"..
  then obtain v where v: "P v z \<and> P v y"..
  hence "P v y"..
  from v have "P v z"..
  hence "P v x" using \<open>P z x\<close> by (rule part_transitivity)
  hence "P v x \<and> P v y" using \<open>P v y\<close>..
  hence "P v (x \<otimes> y)" by (rule common_part_in_product)
  with \<open>P v z\<close> have "P v z \<and> P v (x \<otimes> y)"..
  hence "\<exists>v. P v z \<and> P v (x \<otimes> y)"..
  with overlap_eq show "O z (x \<otimes> y)"..
qed

lemma disjoint_from_second_factor:
  "P x y \<and> \<not> O x (y \<otimes> z) \<Longrightarrow> \<not> O x z"
proof -
  assume antecedent: "P x y \<and> \<not> O x (y \<otimes> z)"
  hence "\<not> O x (y \<otimes> z)"..
  show "\<not> O x z"
  proof
    from antecedent have "P x y"..
    moreover assume "O x z"
    ultimately have "O x (y \<otimes> z)"
      by (rule product_overlap)
    with \<open>\<not> O x (y \<otimes> z)\<close> show "False"..
  qed
qed

lemma converse_product_overlap:
  "O x y \<Longrightarrow> O z (x \<otimes> y) \<Longrightarrow> O z y"
proof -
  assume "O x y"
  hence "P (x \<otimes> y) y" by (rule product_in_second_factor)
  moreover assume "O z (x \<otimes> y)"
  ultimately show "O z y"
    by (rule overlap_monotonicity)
qed

lemma part_product_in_whole_product:
  "O x y \<Longrightarrow> P x v \<and> P y z \<Longrightarrow> P (x \<otimes> y) (v \<otimes> z)"
proof -
  assume "O x y"
  assume "P x v \<and> P y z"
  have "\<forall>w. P w (x \<otimes> y) \<longrightarrow> P w (v \<otimes> z)"
  proof
    fix w
    show "P w (x \<otimes> y) \<longrightarrow> P w (v \<otimes> z)"
    proof
      assume "P w (x \<otimes> y)"
      with \<open>O x y\<close> have "P w x \<and> P w y"
        by (rule product_part_in_factors)
      have "P w v \<and> P w z"
      proof
        from \<open>P w x \<and> P w y\<close> have "P w x"..
        moreover from \<open>P x v \<and> P y z\<close> have "P x v"..
        ultimately show "P w v" by (rule part_transitivity)
      next
        from \<open>P w x \<and> P w y\<close> have "P w y"..
        moreover from \<open>P x v \<and> P y z\<close> have "P y z"..
        ultimately show "P w z" by (rule part_transitivity)
      qed
      thus "P w (v \<otimes> z)" by (rule common_part_in_product)
    qed
  qed
  hence "P (x \<otimes> y) (x \<otimes> y) \<longrightarrow> P (x \<otimes> y) (v \<otimes> z)"..
  moreover have "P (x \<otimes> y) (x \<otimes> y)" by (rule part_reflexivity)
  ultimately show "P (x \<otimes> y) (v \<otimes> z)"..
qed

lemma right_associated_product: "(\<exists>w. P w x \<and> P w y \<and> P w z) \<Longrightarrow>
  (\<forall>w. P w (x \<otimes> (y \<otimes> z)) \<longleftrightarrow> P w x \<and> (P w y \<and> P w z))"
proof -
  assume antecedent: "(\<exists>w. P w x \<and> P w y \<and> P w z)"
  then obtain w where w: "P w x \<and> P w y \<and> P w z"..
  hence "P w x"..
  from w have "P w y \<and> P w z"..
  hence "\<exists>w. P w y \<and> P w z"..
  with overlap_eq have "O y z"..
  hence yz: "\<forall>w. P w (y \<otimes> z) \<longleftrightarrow> (P w y \<and> P w z)"
    by (rule product_character)
  hence "P w (y \<otimes> z) \<longleftrightarrow> (P w y \<and> P w z)"..
  hence "P w (y \<otimes> z)"
    using \<open>P w y \<and> P w z\<close>..
  with \<open>P w x\<close> have "P w x \<and> P w (y \<otimes> z)"..
  hence "\<exists>w. P w x \<and> P w (y \<otimes> z)"..
  with overlap_eq have "O x (y \<otimes> z)"..
  hence xyz: "\<forall>w. P w (x \<otimes> (y \<otimes> z)) \<longleftrightarrow> P w x \<and> P w (y \<otimes> z)"
    by (rule product_character)
  show "\<forall>w. P w (x \<otimes> (y \<otimes> z)) \<longleftrightarrow> P w x \<and> (P w y \<and> P w z)"
  proof
    fix w
    from yz have wyz: "P w (y \<otimes> z) \<longleftrightarrow> (P w y \<and> P w z)"..
    moreover from xyz have
      "P w (x \<otimes> (y \<otimes> z)) \<longleftrightarrow> P w x \<and> P w (y \<otimes> z)"..
    ultimately show
      "P w (x \<otimes> (y \<otimes> z)) \<longleftrightarrow> P w x \<and> (P w y \<and> P w z)"
      by (rule subst)
  qed
qed

lemma left_associated_product: "(\<exists>w. P w x \<and> P w y \<and> P w z) \<Longrightarrow>
  (\<forall>w. P w ((x \<otimes> y) \<otimes> z) \<longleftrightarrow> (P w x \<and> P w y) \<and> P w z)"
proof -
  assume antecedent: "(\<exists>w. P w x \<and> P w y \<and> P w z)"
  then obtain w where w: "P w x \<and> P w y \<and> P w z"..
  hence "P w y \<and> P w z"..
  hence "P w y"..
  have "P w z"
    using \<open>P w y \<and> P w z\<close>..
  from w have "P w x"..
  hence "P w x \<and> P w y"
    using \<open>P w y\<close>..
  hence "\<exists>z. P z x \<and> P z y"..
  with overlap_eq have "O x y"..
  hence xy: "\<forall>w. P w (x \<otimes> y) \<longleftrightarrow> (P w x \<and> P w y)"
    by (rule product_character)
  hence "P w (x \<otimes> y) \<longleftrightarrow> (P w x \<and> P w y)"..
  hence "P w (x \<otimes> y)"
    using \<open>P w x \<and> P w y\<close>..
  hence "P w (x \<otimes> y) \<and> P w z"
    using \<open>P w z\<close>..
  hence "\<exists>w. P w (x \<otimes> y) \<and> P w z"..
  with overlap_eq have "O (x \<otimes> y) z"..
  hence xyz: "\<forall>w. P w ((x \<otimes> y) \<otimes> z) \<longleftrightarrow> P w (x \<otimes> y) \<and> P w z"
    by (rule product_character)
  show "\<forall>w. P w ((x \<otimes> y) \<otimes> z) \<longleftrightarrow> (P w x \<and> P w y) \<and> P w z"
  proof
    fix v
    from xy have vxy: "P v (x \<otimes> y) \<longleftrightarrow> (P v x \<and> P v y)"..
    moreover from xyz have
      "P v ((x \<otimes> y) \<otimes> z) \<longleftrightarrow> P v (x \<otimes> y) \<and> P v z"..
    ultimately show "P v ((x \<otimes> y) \<otimes> z) \<longleftrightarrow> (P v x \<and> P v y) \<and> P v z"
      by (rule subst)
  qed
qed

theorem product_associativity:
  "(\<exists>w. P w x \<and> P w y \<and> P w z) \<Longrightarrow> x \<otimes> (y \<otimes> z) = (x \<otimes> y) \<otimes> z"
proof -
  assume ante:"(\<exists>w. P w x \<and> P w y \<and> P w z)"
  hence "(\<forall>w. P w (x \<otimes> (y \<otimes> z)) \<longleftrightarrow> P w x \<and> (P w y \<and> P w z))"
    by (rule right_associated_product)
  moreover from ante have
    "(\<forall>w. P w ((x \<otimes> y) \<otimes> z) \<longleftrightarrow> (P w x \<and> P w y) \<and> P w z)"
    by (rule left_associated_product)
  ultimately have "\<forall>w. P w (x \<otimes> (y \<otimes> z)) \<longleftrightarrow> P w ((x \<otimes> y) \<otimes> z)"
    by simp
  with part_extensionality show "x \<otimes> (y \<otimes> z) = (x \<otimes> y) \<otimes> z"..
qed

end

subsection \<open> Differences  \<close>

text \<open> Some writers also add to closed mereology the axiom of difference closure.\footnote{See, for example,
\<^cite>\<open>"varzi_parts_1996"\<close> p. 263 and \<^cite>\<open>"masolo_atomicity_1999"\<close> p. 238.} \<close>

locale CMD = CM +
  assumes difference_eq:
    "x \<ominus> y = (THE z. \<forall>w. P w z \<longleftrightarrow> P w x \<and> \<not> O w y)"
  assumes difference_closure:
    "(\<exists>w. P w x \<and> \<not> O w y) \<Longrightarrow> (\<exists>z. \<forall>w. P w z \<longleftrightarrow> P w x \<and> \<not> O w y)"
begin

lemma difference_intro:
  "(\<forall>w. P w z \<longleftrightarrow> P w x \<and> \<not> O w y) \<Longrightarrow> x \<ominus> y = z"
proof -
  assume antecedent: "(\<forall>w. P w z \<longleftrightarrow> P w x \<and> \<not> O w y)"
  hence "(THE z. \<forall>w. P w z \<longleftrightarrow> P w x \<and> \<not> O w y) = z"
  proof (rule the_equality)
    fix v
    assume v: "(\<forall>w. P w v \<longleftrightarrow> P w x \<and> \<not> O w y)"
    have "\<forall>w. P w v \<longleftrightarrow> P w z"
    proof
      fix w
      from antecedent have "P w z \<longleftrightarrow> P w x \<and> \<not> O w y"..
      moreover from v have "P w v \<longleftrightarrow> P w x \<and> \<not> O w y"..
      ultimately show "P w v \<longleftrightarrow> P w z" by (rule ssubst)
    qed
    with part_extensionality show "v = z"..
  qed
  with difference_eq show "x \<ominus> y = z" by (rule ssubst)
qed

lemma difference_idempotence: "\<not> O x y \<Longrightarrow> (x \<ominus> y) = x"
proof -
  assume "\<not> O x y"
  hence "\<not> O y x" by (rule disjoint_symmetry)
  have "\<forall>w. P w x \<longleftrightarrow> P w x \<and> \<not> O w y"
  proof
    fix w
    show "P w x \<longleftrightarrow> P w x \<and> \<not> O w y"
    proof
      assume "P w x"
      hence "\<not> O y w" using \<open>\<not> O y x\<close>
        by (rule disjoint_demonotonicity)
      hence "\<not> O w y" by (rule disjoint_symmetry)
      with \<open>P w x\<close> show "P w x \<and> \<not> O w y"..
    next
      assume "P w x \<and> \<not> O w y"
      thus "P w x"..
    qed
  qed
  thus "(x \<ominus> y) = x" by (rule difference_intro)
qed

lemma difference_character: "(\<exists>w. P w x \<and> \<not> O w y) \<Longrightarrow>
  (\<forall>w. P w (x \<ominus> y) \<longleftrightarrow> P w x \<and> \<not> O w y)"
proof -
  assume "\<exists>w. P w x \<and> \<not> O w y"
  hence "\<exists>z. \<forall>w. P w z \<longleftrightarrow> P w x \<and> \<not> O w y" by (rule difference_closure)
  then obtain z where z: "\<forall>w. P w z \<longleftrightarrow> P w x \<and> \<not> O w y"..
  hence "(x \<ominus> y) = z" by (rule difference_intro)
  thus "\<forall>w. P w (x \<ominus> y) \<longleftrightarrow> P w x \<and> \<not> O w y" using z by (rule ssubst)
qed

lemma difference_disjointness:
  "(\<exists>z. P z x \<and> \<not> O z y) \<Longrightarrow> \<not> O y (x \<ominus> y)"
proof -
  assume "\<exists>z. P z x \<and> \<not> O z y"
  hence xmy: "\<forall>w. P w (x \<ominus> y) \<longleftrightarrow> (P w x \<and> \<not> O w y)"
    by (rule difference_character)
  show "\<not> O y (x \<ominus> y)"
  proof
    assume "O y (x \<ominus> y)"
    with overlap_eq have "\<exists>v. P v y \<and> P v (x \<ominus> y)"..
    then obtain v where v: "P v y \<and> P v (x \<ominus> y)"..
    from xmy have "P v (x \<ominus> y) \<longleftrightarrow> (P v x \<and> \<not> O v y)"..
    moreover from v have "P v (x \<ominus> y)"..
    ultimately have "P v x \<and> \<not> O v y"..
    hence "\<not> O v y"..
    moreover from v have "P v y"..
    hence "O v y" by (rule part_implies_overlap)
    ultimately show "False"..
  qed
qed

end

subsection \<open> The Universe \<close>

text \<open> Another closure condition sometimes considered is the existence of the universe.\footnote{
See, for example, \<^cite>\<open>"varzi_parts_1996"\<close> p. 264 and \<^cite>\<open>"casati_parts_1999"\<close> p. 45.}  \<close>

locale CMU = CM +
  assumes universe_eq: "u = (THE z. \<forall>w. P w z)"
  assumes universe_closure: "\<exists>y. \<forall>x. P x y"
begin

lemma universe_intro: "(\<forall>w. P w z) \<Longrightarrow> u = z"
proof -
  assume z: "\<forall>w. P w z"
  hence "(THE z. \<forall>w. P w z) = z"
  proof (rule the_equality)
    fix v
    assume v: "\<forall>w. P w v"
    have "\<forall>w. P w v \<longleftrightarrow> P w z"
    proof
      fix w
      show "P w v \<longleftrightarrow> P w z"
      proof
        assume "P w v"
        from z show "P w z"..
      next
        assume "P w z"
        from v show "P w v"..
      qed
    qed
    with part_extensionality show "v = z"..
  qed
  thus "u = z" using universe_eq by (rule subst)
qed

lemma universe_character: "P x u"
proof -
  from universe_closure obtain y where y: "\<forall>x. P x y"..
  hence "u = y" by (rule universe_intro)
  hence "\<forall>x. P x u" using y by (rule ssubst)
  thus "P x u"..
qed

lemma "\<not> PP u x"
proof
  assume "PP u x"
  hence "\<not> P x u" by (rule proper_implies_not_part)
  thus "False" using universe_character..
qed

lemma product_universe_implies_factor_universe:
  "O x y \<Longrightarrow> x \<otimes> y = u \<Longrightarrow> x = u"
proof -
  assume "x \<otimes> y = u"
  moreover assume "O x y"
  hence "P (x \<otimes> y) x"
    by (rule product_in_first_factor)
  ultimately have "P u x"
    by (rule subst)
  with universe_character show "x = u"
    by (rule part_antisymmetry)
qed

end

subsection \<open> Complements \<close>

text \<open> As is a condition ensuring the existence of complements.\footnote{See, for example,
 \<^cite>\<open>"varzi_parts_1996"\<close> p. 264 and \<^cite>\<open>"casati_parts_1999"\<close> p. 45.} \<close>

locale CMC = CM +
  assumes complement_eq: "\<midarrow>x = (THE z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)"
  assumes complement_closure:
    "(\<exists>w. \<not> O w x) \<Longrightarrow> (\<exists>z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)"
  assumes difference_eq:
    "x \<ominus> y = (THE z. \<forall>w. P w z \<longleftrightarrow> P w x \<and> \<not> O w y)"
begin

lemma complement_intro:
  "(\<forall>w. P w z \<longleftrightarrow> \<not> O w x) \<Longrightarrow> \<midarrow>x = z"
proof -
  assume antecedent: "\<forall>w. P w z \<longleftrightarrow> \<not> O w x"
  hence "(THE z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x) = z"
  proof (rule the_equality)
    fix v
    assume v: "\<forall>w. P w v \<longleftrightarrow> \<not> O w x"
    have "\<forall>w. P w v \<longleftrightarrow> P w z"
    proof
      fix w
      from antecedent have "P w z \<longleftrightarrow> \<not> O w x"..
      moreover from v have "P w v \<longleftrightarrow> \<not> O w x"..
      ultimately show "P w v \<longleftrightarrow> P w z" by (rule ssubst)
    qed
    with part_extensionality show "v = z"..
  qed
  with complement_eq show "\<midarrow>x = z" by (rule ssubst)
qed

lemma complement_character:
  "(\<exists>w. \<not> O w x) \<Longrightarrow> (\<forall>w. P w (\<midarrow>x) \<longleftrightarrow> \<not> O w x)"
proof -
  assume "\<exists>w. \<not> O w x"
  hence "(\<exists>z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)" by (rule complement_closure)
  then obtain z where z: "\<forall>w. P w z \<longleftrightarrow> \<not> O w x"..
  hence "\<midarrow>x = z" by (rule complement_intro)
  thus "\<forall>w. P w (\<midarrow>x) \<longleftrightarrow> \<not> O w x"
    using z by (rule ssubst)
qed

lemma not_complement_part: "\<exists>w. \<not> O w x \<Longrightarrow> \<not> P x (\<midarrow>x)"
proof -
  assume "\<exists>w. \<not> O w x"
  hence "\<forall>w. P w (\<midarrow>x) \<longleftrightarrow> \<not> O w x"
    by (rule complement_character)
  hence "P x (\<midarrow>x) \<longleftrightarrow> \<not> O x x"..
  show "\<not> P x (\<midarrow>x)"
  proof
    assume "P x (\<midarrow>x)"
    with \<open>P x (\<midarrow>x) \<longleftrightarrow> \<not> O x x\<close> have "\<not> O x x"..
    thus "False" using overlap_reflexivity..
  qed
qed

lemma complement_part: "\<not> O x y \<Longrightarrow> P x (\<midarrow>y)"
proof -
  assume "\<not> O x y"
  hence "\<exists>z. \<not> O z y"..
  hence "\<forall>w. P w (\<midarrow>y) \<longleftrightarrow> \<not> O w y"
    by (rule complement_character)
  hence "P x (\<midarrow>y) \<longleftrightarrow> \<not> O x y"..
  thus "P x (\<midarrow>y)" using \<open>\<not> O x y\<close>..
qed

lemma complement_overlap: "\<not> O x y \<Longrightarrow> O x (\<midarrow>y)"
proof -
  assume "\<not> O x y"
  hence "P x (\<midarrow>y)"
    by (rule complement_part)
  thus "O x (\<midarrow>y)"
    by (rule part_implies_overlap)
qed

lemma or_complement_overlap: "\<forall>y. O y x \<or> O y (\<midarrow>x)"
proof
  fix y
  show "O y x \<or> O y (\<midarrow>x)"
  proof cases
    assume "O y x"
    thus "O y x \<or> O y (\<midarrow>x)"..
  next
    assume "\<not> O y x"
    hence "O y (\<midarrow>x)"
      by (rule complement_overlap)
    thus "O y x \<or> O y (\<midarrow>x)"..
  qed
qed

lemma complement_disjointness: "\<exists>v. \<not> O v x \<Longrightarrow> \<not> O x (\<midarrow>x)"
proof -
  assume "\<exists>v. \<not> O v x"
  hence w: "\<forall>w. P w (\<midarrow>x) \<longleftrightarrow> \<not> O w x"
    by (rule complement_character)
  show "\<not> O x (\<midarrow>x)"
  proof
    assume "O x (\<midarrow>x)"
    with overlap_eq have "\<exists>v. P v x \<and> P v (\<midarrow>x)"..
    then obtain v where v: "P v x \<and> P v (\<midarrow>x)"..
    from w have "P v (\<midarrow>x) \<longleftrightarrow> \<not> O v x"..
    moreover from v have  "P v (\<midarrow>x)"..
    ultimately have "\<not> O v x"..
    moreover from v have "P v x"..
    hence "O v x" by (rule part_implies_overlap)
    ultimately show "False"..
  qed
qed

lemma part_disjoint_from_complement:
  "\<exists>v. \<not> O v x \<Longrightarrow> P y x \<Longrightarrow> \<not> O y (\<midarrow>x)"
proof
  assume "\<exists>v. \<not> O v x"
  hence "\<not> O x (\<midarrow>x)" by (rule complement_disjointness)
  assume "P y x"
  assume "O y (\<midarrow>x)"
  with overlap_eq have "\<exists>v. P v y \<and> P v (\<midarrow>x)"..
  then obtain v where v: "P v y \<and> P v (\<midarrow>x)"..
  hence "P v y"..
  hence "P v x" using \<open>P y x\<close> by (rule part_transitivity)
  moreover from v have "P v (\<midarrow>x)"..
  ultimately have "P v x \<and> P v (\<midarrow>x)"..
  hence "\<exists>v. P v x \<and> P v (\<midarrow>x)"..
  with overlap_eq have "O x (\<midarrow>x)"..
  with \<open>\<not> O x (\<midarrow>x)\<close> show "False"..
qed

lemma product_complement_character: "(\<exists>w. P w x \<and> \<not> O w y) \<Longrightarrow>
  (\<forall>w. P w (x \<otimes> (\<midarrow>y)) \<longleftrightarrow> (P w x \<and> (\<not> O w y)))"
proof -
  assume antecedent: "\<exists>w. P w x \<and> \<not> O w y"
  then obtain w where w: "P w x \<and> \<not> O w y"..
  hence "P w x"..
  moreover from w have "\<not> O w y"..
  hence "P w (\<midarrow>y)" by (rule complement_part)
  ultimately have  "P w x \<and> P w (\<midarrow>y)"..
  hence "\<exists>w. P w x \<and> P w (\<midarrow>y)"..
  with overlap_eq have "O x (\<midarrow>y)"..
  hence prod: "(\<forall>w. P w (x \<otimes> (\<midarrow>y)) \<longleftrightarrow> (P w x \<and> P w (\<midarrow>y)))"
    by (rule product_character)
  show "\<forall>w. P w (x \<otimes> (\<midarrow>y)) \<longleftrightarrow> (P w x \<and> (\<not> O w y))"
  proof
    fix v
    from w have "\<not> O w y"..
    hence "\<exists>w. \<not> O w y"..
    hence "\<forall>w. P w (\<midarrow>y) \<longleftrightarrow> \<not> O w y"
      by (rule complement_character)
    hence "P v (\<midarrow>y) \<longleftrightarrow> \<not> O v y"..
    moreover have "P v (x \<otimes> (\<midarrow>y)) \<longleftrightarrow> (P v x \<and> P v (\<midarrow>y))"
      using prod..
    ultimately show "P v (x \<otimes> (\<midarrow>y)) \<longleftrightarrow> (P v x \<and> (\<not> O v y))"
      by (rule subst)
  qed
qed

theorem difference_closure: "(\<exists>w. P w x \<and> \<not> O w y) \<Longrightarrow>
  (\<exists>z. \<forall>w. P w z \<longleftrightarrow> P w x \<and> \<not> O w y)"
proof -
  assume "\<exists>w. P w x \<and> \<not> O w y"
  hence "\<forall>w. P w (x \<otimes> (\<midarrow>y)) \<longleftrightarrow> P w x \<and> \<not> O w y"
    by (rule product_complement_character)
  thus "(\<exists>z. \<forall>w. P w z \<longleftrightarrow> P w x \<and> \<not> O w y)" by (rule exI)
qed

end

sublocale CMC \<subseteq> CMD
proof
  fix x y
  show "x \<ominus> y = (THE z. \<forall>w. P w z = (P w x \<and> \<not> O w y))"
    using difference_eq.
  show "(\<exists>w. P w x \<and> \<not> O w y) \<Longrightarrow>
    (\<exists>z. \<forall>w. P w z = (P w x \<and> \<not> O w y))"
    using difference_closure.
qed

corollary (in CMC) difference_is_product_of_complement:
  "(\<exists>w. P w x \<and> \<not> O w y) \<Longrightarrow> (x \<ominus> y) = x \<otimes> (\<midarrow>y)"
proof -
  assume antecedent: "\<exists>w. P w x \<and> \<not> O w y"
  hence "\<forall>w. P w (x \<otimes> (\<midarrow>y)) \<longleftrightarrow> P w x \<and> \<not> O w y"
    by (rule product_complement_character)
  thus "(x \<ominus> y) = x \<otimes> (\<midarrow>y)" by (rule difference_intro)
qed

text \<open> Universe and difference closure entail complement closure, since the difference of an individual
and the universe is the individual's complement. \<close>

locale CMUD = CMU + CMD +
  assumes complement_eq: "\<midarrow>x = (THE z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)"
begin

lemma universe_difference:
  "(\<exists>w. \<not> O w x) \<Longrightarrow> (\<forall>w. P w (u \<ominus> x) \<longleftrightarrow> \<not> O w x)"
proof -
  assume "\<exists>w. \<not> O w x"
  then obtain w where w: "\<not> O w x"..
  from universe_character have "P w u".
  hence "P w u \<and> \<not> O w x" using \<open>\<not> O w x\<close>..
  hence "\<exists>z. P z u \<and> \<not> O z x"..
  hence ux: "\<forall>w. P w (u \<ominus> x) \<longleftrightarrow> (P w u \<and> \<not> O w x)"
    by (rule difference_character)
  show "\<forall>w. P w (u \<ominus> x) \<longleftrightarrow> \<not> O w x"
  proof
    fix w
    from ux have wux: "P w (u \<ominus> x) \<longleftrightarrow> (P w u \<and> \<not> O w x)"..
    show "P w (u \<ominus> x) \<longleftrightarrow> \<not> O w x"
    proof
      assume "P w (u \<ominus> x)"
      with wux have "P w u \<and> \<not> O w x"..
      thus "\<not> O w x"..
    next
      assume "\<not> O w x"
      from universe_character have "P w u".
      hence "P w u \<and> \<not> O w x" using \<open>\<not> O w x\<close>..
      with wux show "P w (u \<ominus> x)"..
    qed
  qed
qed

theorem complement_closure:
  "(\<exists>w. \<not> O w x) \<Longrightarrow> (\<exists>z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)"
proof -
  assume "\<exists>w. \<not> O w x"
  hence "\<forall>w. P w (u \<ominus> x) \<longleftrightarrow> \<not> O w x"
    by (rule universe_difference)
  thus "\<exists>z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x"..
qed

end

sublocale CMUD \<subseteq> CMC
proof
  fix x y
  show "\<midarrow>x = (THE z. \<forall>w. P w z \<longleftrightarrow> (\<not> O w x))"
    using complement_eq.
  show "\<exists>w. \<not> O w x \<Longrightarrow> \<exists>z. \<forall>w. P w z \<longleftrightarrow> (\<not> O w x)"
    using complement_closure.
  show "x \<ominus> y = (THE z. \<forall>w. P w z = (P w x \<and> \<not> O w y))"
    using difference_eq.
qed

corollary (in CMUD) complement_universe_difference:
  "(\<exists>y. \<not> O y x) \<Longrightarrow> \<midarrow>x = (u \<ominus> x)"
proof -
  assume "\<exists>w. \<not> O w x"
  hence "\<forall>w. P w (u \<ominus> x) \<longleftrightarrow> \<not> O w x"
    by (rule universe_difference)
  thus " \<midarrow>x = (u \<ominus> x)"
    by (rule complement_intro)
qed

(*<*) end (*>*)


(*
  Author: Tobias Nipkow
*)

(*
  Author: Mohammad Abdulaziz, copied it from src/HOL/Data_Structures to extend the global interpretation
*)
(*<*)
section "Join-Based Implementation of Sets via RBTs"

theory Set2_Join_RBT
imports
  "HOL-Data_Structures.Set2_Join"
  "HOL-Data_Structures.RBT_Set"
begin

subsection "Code"

text \<open>
Function \<open>joinL\<close> joins two trees (and an element).
Precondition: \<^prop>\<open>bheight l \<le> bheight r\<close>.
Method:
Descend along the left spine of \<open>r\<close>
until you find a subtree with the same \<open>bheight\<close> as \<open>l\<close>,
then combine them into a new red node.
\<close>
fun joinL :: "'a rbt \<Rightarrow> 'a \<Rightarrow> 'a rbt \<Rightarrow> 'a rbt" where
"joinL l x r =
  (if bheight l \<ge> bheight r then R l x r
   else case r of
     B l' x' r' \<Rightarrow> baliL (joinL l x l') x' r' |
     R l' x' r' \<Rightarrow> R (joinL l x l') x' r')"

fun joinR :: "'a rbt \<Rightarrow> 'a \<Rightarrow> 'a rbt \<Rightarrow> 'a rbt" where
"joinR l x r =
  (if bheight l \<le> bheight r then R l x r
   else case l of
     B l' x' r' \<Rightarrow> baliR l' x' (joinR r' x r) |
     R l' x' r' \<Rightarrow> R l' x' (joinR r' x r))"

definition join :: "'a rbt \<Rightarrow> 'a \<Rightarrow> 'a rbt \<Rightarrow> 'a rbt" where
"join l x r =
  (if bheight l > bheight r
   then paint Black (joinR l x r)
   else if bheight l < bheight r
   then paint Black (joinL l x r)
   else B l x r)"

declare joinL.simps[simp del]
declare joinR.simps[simp del]

subsection "Properties"

subsubsection "Color and height invariants"

lemma invc2_joinL:
 "\<lbrakk> invc l; invc r; bheight l \<le> bheight r \<rbrakk> \<Longrightarrow>
  invc2 (joinL l x r)
  \<and> (bheight l \<noteq> bheight r \<and> color r = Black \<longrightarrow> invc(joinL l x r))"
proof (induct l x r rule: joinL.induct)
  case (1 l x r) thus ?case
    by(auto simp: invc_baliL invc2I joinL.simps[of l x r] split!: tree.splits if_splits)
qed

lemma invc2_joinR:
  "\<lbrakk> invc l; invh l; invc r; invh r; bheight l \<ge> bheight r \<rbrakk> \<Longrightarrow>
  invc2 (joinR l x r)
  \<and> (bheight l \<noteq> bheight r \<and> color l = Black \<longrightarrow> invc(joinR l x r))"
proof (induct l x r rule: joinR.induct)
  case (1 l x r) thus ?case
    by(fastforce simp: invc_baliR invc2I joinR.simps[of l x r] split!: tree.splits if_splits)
qed

lemma bheight_joinL:
  "\<lbrakk> invh l; invh r; bheight l \<le> bheight r \<rbrakk> \<Longrightarrow> bheight (joinL l x r) = bheight r"
proof (induct l x r rule: joinL.induct)
  case (1 l x r) thus ?case
    by(auto simp: bheight_baliL joinL.simps[of l x r] split!: tree.split)
qed

lemma invh_joinL:
  "\<lbrakk> invh l;  invh r;  bheight l \<le> bheight r \<rbrakk> \<Longrightarrow> invh (joinL l x r)"
proof (induct l x r rule: joinL.induct)
  case (1 l x r) thus ?case
    by(auto simp: invh_baliL bheight_joinL joinL.simps[of l x r] split!: tree.split color.split)
qed

lemma bheight_baliR:
  "bheight l = bheight r \<Longrightarrow> bheight (baliR l a r) = Suc (bheight l)"
by (cases "(l,a,r)" rule: baliR.cases) auto

lemma bheight_joinR:
  "\<lbrakk> invh l;  invh r;  bheight l \<ge> bheight r \<rbrakk> \<Longrightarrow> bheight (joinR l x r) = bheight l"
proof (induct l x r rule: joinR.induct)
  case (1 l x r) thus ?case
    by(fastforce simp: bheight_baliR joinR.simps[of l x r] split!: tree.split)
qed

lemma invh_joinR:
  "\<lbrakk> invh l; invh r; bheight l \<ge> bheight r \<rbrakk> \<Longrightarrow> invh (joinR l x r)"
proof (induct l x r rule: joinR.induct)
  case (1 l x r) thus ?case
    by(fastforce simp: invh_baliR bheight_joinR joinR.simps[of l x r]
        split!: tree.split color.split)
qed

(* unused *)
lemma rbt_join: "\<lbrakk> invc l; invh l; invc r; invh r \<rbrakk> \<Longrightarrow> rbt(join l x r)"
by(simp add: invc2_joinL invc2_joinR invh_joinL invh_joinR invh_paint rbt_def
    color_paint_Black join_def)

text \<open>To make sure the the black height is not increased unnecessarily:\<close>

lemma bheight_paint_Black: "bheight(paint Black t) \<le> bheight t + 1"
by(cases t) auto

lemma "\<lbrakk> rbt l; rbt r \<rbrakk> \<Longrightarrow> bheight(join l x r) \<le> max (bheight l) (bheight r) + 1"
using bheight_paint_Black[of "joinL l x r"] bheight_paint_Black[of "joinR l x r"]
  bheight_joinL[of l r x] bheight_joinR[of l r x]
by(auto simp: max_def rbt_def join_def)

subsubsection "Inorder properties"

text "Currently unused. Instead \<^const>\<open>set_tree\<close> and \<^const>\<open>bst\<close> properties are proved directly."

lemma inorder_joinL: "bheight l \<le> bheight r \<Longrightarrow> inorder(joinL l x r) = inorder l @ x # inorder r"
proof(induction l x r rule: joinL.induct)
  case (1 l x r)
  thus ?case by(auto simp: inorder_baliL joinL.simps[of l x r] split!: tree.splits color.splits)
qed

lemma inorder_joinR:
  "inorder(joinR l x r) = inorder l @ x # inorder r"
proof(induction l x r rule: joinR.induct)
  case (1 l x r)
  thus ?case by (force simp: inorder_baliR joinR.simps[of l x r] split!: tree.splits color.splits)
qed

lemma "inorder(join l x r) = inorder l @ x # inorder r"
by(auto simp: inorder_joinL inorder_joinR inorder_paint join_def
      split!: tree.splits color.splits if_splits
      dest!: arg_cong[where f = inorder])

subsubsection "Set and bst properties"

lemma set_baliL:
  "set_tree(baliL l a r) = set_tree l \<union> {a} \<union> set_tree r"
by(cases "(l,a,r)" rule: baliL.cases) (auto)

lemma set_joinL:
  "bheight l \<le> bheight r \<Longrightarrow> set_tree (joinL l x r) = set_tree l \<union> {x} \<union> set_tree r"
proof(induction l x r rule: joinL.induct)
  case (1 l x r)
  thus ?case by(auto simp: set_baliL joinL.simps[of l x r] split!: tree.splits color.splits)
qed

lemma set_baliR:
  "set_tree(baliR l a r) = set_tree l \<union> {a} \<union> set_tree r"
by(cases "(l,a,r)" rule: baliR.cases) (auto)

lemma set_joinR:
  "set_tree (joinR l x r) = set_tree l \<union> {x} \<union> set_tree r"
proof(induction l x r rule: joinR.induct)
  case (1 l x r)
  thus ?case by(force simp: set_baliR joinR.simps[of l x r] split!: tree.splits color.splits)
qed

lemma set_paint: "set_tree (paint c t) = set_tree t"
by (cases t) auto

lemma set_join: "set_tree (join l x r) = set_tree l \<union> {x} \<union> set_tree r"
by(simp add: set_joinL set_joinR set_paint join_def)

lemma bst_baliL:
  "\<lbrakk>bst l; bst r; \<forall>x\<in>set_tree l. x < a; \<forall>x\<in>set_tree r. a < x\<rbrakk>
   \<Longrightarrow> bst (baliL l a r)"
by(cases "(l,a,r)" rule: baliL.cases) (auto simp: ball_Un)

lemma bst_baliR:
  "\<lbrakk>bst l; bst r; \<forall>x\<in>set_tree l. x < a; \<forall>x\<in>set_tree r. a < x\<rbrakk>
   \<Longrightarrow> bst (baliR l a r)"
by(cases "(l,a,r)" rule: baliR.cases) (auto simp: ball_Un)

lemma bst_joinL:
  "\<lbrakk>bst (Node l (a, n) r); bheight l \<le> bheight r\<rbrakk>
  \<Longrightarrow> bst (joinL l a r)"
proof(induction l a r rule: joinL.induct)
  case (1 l a r)
  thus ?case
    by(auto simp: set_baliL joinL.simps[of l a r] set_joinL ball_Un intro!: bst_baliL
        split!: tree.splits color.splits)
qed

lemma bst_joinR:
  "\<lbrakk>bst l; bst r; \<forall>x\<in>set_tree l. x < a; \<forall>y\<in>set_tree r. a < y \<rbrakk>
  \<Longrightarrow> bst (joinR l a r)"
proof(induction l a r rule: joinR.induct)
  case (1 l a r)
  thus ?case
    by(auto simp: set_baliR joinR.simps[of l a r] set_joinR ball_Un intro!: bst_baliR
        split!: tree.splits color.splits)
qed

lemma bst_paint: "bst (paint c t) = bst t"
by(cases t) auto

lemma bst_join:
  "bst (Node l (a, n) r) \<Longrightarrow> bst (join l a r)"
by(auto simp: bst_paint bst_joinL bst_joinR join_def)

lemma inv_join: "\<lbrakk> invc l; invh l; invc r; invh r \<rbrakk> \<Longrightarrow> invc(join l x r) \<and> invh(join l x r)"
by (simp add: invc2_joinL invc2_joinR invh_joinL invh_joinR invh_paint join_def)

subsubsection "Interpretation of \<^locale>\<open>Set2_Join\<close> with Red-Black Tree"

global_interpretation RBT: Set2_Join
where join = join and inv = "\<lambda>t. invc t \<and> invh t"
defines insert_rbt = RBT.insert and delete_rbt = RBT.delete and split_rbt = RBT.split
and join2_rbt = RBT.join2 and split_min_rbt = RBT.split_min and inter_rbt = RBT.inter
proof (standard, goal_cases)
  case 1 show ?case by (rule set_join)
next
  case 2 thus ?case by (simp add: bst_join)
next
  case 3 show ?case by simp
next
  case 4 thus ?case by (simp add: inv_join)
next
  case 5 thus ?case by simp
qed

text \<open>The invariant does not guarantee that the root node is black. This is not required
to guarantee that the height is logarithmic in the size --- Exercise.\<close>

end

(*>*)


(*
  File:   Akra_Bazzi.thy
  Author: Manuel Eberl <manuel@pruvisto.org>

  The Akra-Bazzi theorem for functions on the naturals.
*)

section \<open>The discrete Akra-Bazzi theorem\<close>
theory Akra_Bazzi
imports
  Complex_Main
  "HOL-Library.Landau_Symbols"
  Akra_Bazzi_Real
begin

lemma ex_mono: "(\<exists>x. P x) \<Longrightarrow> (\<And>x. P x \<Longrightarrow> Q x) \<Longrightarrow> (\<exists>x. Q x)" by blast

lemma x_over_ln_mono:
  assumes "(e::real) > 0"
  assumes "x > exp e"
  assumes "x \<le> y"
  shows   "x / ln x powr e \<le> y / ln y powr e"
proof (rule DERIV_nonneg_imp_mono[of _ _ "\<lambda>x. x / ln x powr e"])
  fix t assume t: "t \<in> {x..y}"
  from assms(1) have "1 < exp e" by simp
  from this and assms(2) have "x > 1" by (rule less_trans)
  with t have t': "t > 1" by simp
  from \<open>x > exp e\<close> and t have "t > exp e" by simp
  with t' have "ln t > ln (exp e)" by (subst ln_less_cancel_iff) simp_all
  hence t'': "ln t > e" by simp
  show "((\<lambda>x. x / ln x powr e) has_real_derivative
            (ln t - e) / ln t powr (e+1)) (at t)" using assms t t' t''
    by (force intro!: derivative_eq_intros simp: powr_diff field_simps powr_add)
  from t'' show "(ln t - e) / ln t powr (e + 1) \<ge> 0" by (intro divide_nonneg_nonneg) simp_all
qed (simp_all add: assms)

definition akra_bazzi_term :: "nat \<Rightarrow> nat \<Rightarrow> real \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> bool" where
  "akra_bazzi_term x\<^sub>0 x\<^sub>1 b t =
    (\<exists>e h. e > 0 \<and> (\<lambda>x. h x) \<in> O(\<lambda>x. real x / ln (real x) powr (1+e)) \<and>
               (\<forall>x\<ge>x\<^sub>1. t x \<ge> x\<^sub>0 \<and> t x < x \<and> b*x + h x = real (t x)))"

lemma akra_bazzi_termI [intro?]:
  assumes "e > 0" "(\<lambda>x. h x) \<in> O(\<lambda>x. real x / ln (real x) powr (1+e))"
          "\<And>x. x \<ge> x\<^sub>1 \<Longrightarrow> t x \<ge> x\<^sub>0" "\<And>x. x \<ge> x\<^sub>1 \<Longrightarrow> t x < x"
          "\<And>x. x \<ge> x\<^sub>1 \<Longrightarrow> b*x + h x = real (t x)"
  shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b t"
  using assms unfolding akra_bazzi_term_def by blast

lemma akra_bazzi_term_imp_less':
  assumes "akra_bazzi_term x\<^sub>0 (Suc x\<^sub>1) b t" "x > x\<^sub>1"
  shows   "t x < x"
  using assms unfolding akra_bazzi_term_def by force

locale akra_bazzi_recursion =
  fixes x\<^sub>0 x\<^sub>1 k :: nat and as bs :: "real list" and ts :: "(nat \<Rightarrow> nat) list" and  f :: "nat \<Rightarrow> real"
  assumes k_not_0:   "k \<noteq> 0"
  and     length_as: "length as = k"
  and     length_bs: "length bs = k"
  and     length_ts: "length ts = k"
  and     a_ge_0:    "a \<in> set as \<Longrightarrow> a \<ge> 0"
  and     b_bounds:  "b \<in> set bs \<Longrightarrow> b \<in> {0<..<1}"
  and     ts:        "i < length bs \<Longrightarrow> akra_bazzi_term x\<^sub>0 x\<^sub>1 (bs!i) (ts!i)"
begin

sublocale akra_bazzi_params k as bs
  using length_as length_bs k_not_0 a_ge_0 b_bounds by unfold_locales

lemma ts_nonempty: "ts \<noteq> []" using length_ts k_not_0 by (cases ts) simp_all

definition e_hs :: "real \<times> (nat \<Rightarrow> real) list" where
  "e_hs = (SOME (e,hs).
     e > 0 \<and> length hs = k \<and> (\<forall>h\<in>set hs. (\<lambda>x. h x) \<in> O(\<lambda>x. real x / ln (real x) powr (1+e))) \<and>
     (\<forall>t\<in>set ts. \<forall>x\<ge>x\<^sub>1. t x \<ge> x\<^sub>0 \<and> t x < x) \<and>
     (\<forall>i<k. \<forall>x\<ge>x\<^sub>1. (bs!i)*x + (hs!i) x = real ((ts!i) x))
   )"

definition "e = (case e_hs of (e,_) \<Rightarrow> e)"
definition "hs = (case e_hs of (_,hs) \<Rightarrow> hs)"

lemma filterlim_powr_zero_cong:
  "filterlim (\<lambda>x. P (x::real) (x powr (0::real))) F at_top = filterlim (\<lambda>x. P x 1) F at_top"
  apply (rule filterlim_cong[OF refl refl])
  using eventually_gt_at_top[of "0::real"] by eventually_elim simp_all

lemma e_hs_aux:
  "0 < e \<and> length hs = k \<and>
  (\<forall>h\<in>set hs. (\<lambda>x. h x) \<in> O(\<lambda>x. real x / ln (real x) powr (1 + e))) \<and>
  (\<forall>t\<in>set ts. \<forall>x\<ge>x\<^sub>1. x\<^sub>0 \<le> t x \<and> t x < x) \<and>
  (\<forall>i<k. \<forall>x\<ge>x\<^sub>1. (bs!i)*x + (hs!i) x = real ((ts!i) x))"
proof-
  have "Ex (\<lambda>(e,hs). e > 0 \<and> length hs = k \<and>
    (\<forall>h\<in>set hs. (\<lambda>x. h x) \<in> O(\<lambda>x. real x / ln (real x) powr (1+e))) \<and>
    (\<forall>t\<in>set ts. \<forall>x\<ge>x\<^sub>1. t x \<ge> x\<^sub>0 \<and> t x < x) \<and>
    (\<forall>i<k. \<forall>x\<ge>x\<^sub>1. (bs!i)*x + (hs!i) x = real ((ts!i) x)))"
  proof-
    from ts have A: "\<forall>i\<in>{..<k}. akra_bazzi_term x\<^sub>0 x\<^sub>1 (bs!i) (ts!i)" by (auto simp: length_bs)
    hence "\<exists>e h. (\<forall>i<k. e i > 0 \<and>
             (\<lambda>x. h i x) \<in> O(\<lambda>x. real x / ln (real x) powr (1+e i)) \<and>
             (\<forall>x\<ge>x\<^sub>1. (ts!i) x \<ge> x\<^sub>0 \<and> (ts!i) x < x) \<and>
             (\<forall>i<k. \<forall>x\<ge>x\<^sub>1. (bs!i)*real x + h i x = real ((ts!i) x)))"
             unfolding akra_bazzi_term_def
      by (subst (asm) bchoice_iff, subst (asm) bchoice_iff) blast
    then guess ee :: "_ \<Rightarrow> real" and hh :: "_ \<Rightarrow> nat \<Rightarrow> real"
      by (elim exE conjE) note eh = this
    define e where "e = Min {ee i |i. i < k}"
    define hs where "hs = map hh (upt 0 k)"
    have e_pos: "e > 0" unfolding e_def using eh k_not_0 by (subst Min_gr_iff) auto
    moreover have "length hs = k" unfolding hs_def by (simp_all add: length_ts)
    moreover have hs_growth: "\<forall>h\<in>set hs. (\<lambda>x. h x) \<in> O(\<lambda>x. real x / ln (real x) powr (1+e))"
    proof
      fix h assume "h \<in> set hs"
      then obtain i where t: "i < k" "h = hh i" unfolding hs_def by force
      hence "(\<lambda>x. h x) \<in> O(\<lambda>x. real x / ln (real x) powr (1+ee i))" using eh by blast
      also from t k_not_0 have "e \<le> ee i" unfolding e_def by (subst Min_le_iff) auto
      hence "(\<lambda>x::nat. real x / ln (real x) powr (1+ee i)) \<in> O(\<lambda>x. real x / ln (real x) powr (1+e))"
        by (intro bigo_real_nat_transfer) auto
      finally show "(\<lambda>x. h x) \<in> O(\<lambda>x. real x / ln (real x) powr (1+e))" .
    qed
    moreover have "\<forall>t\<in>set ts. (\<forall>x\<ge>x\<^sub>1. t x \<ge> x\<^sub>0 \<and> t x < x)"
    proof (rule ballI)
      fix t assume "t \<in> set ts"
      then obtain i where "i < k" "t = ts!i" using length_ts by (subst (asm) in_set_conv_nth) auto
      with eh show "\<forall>x\<ge>x\<^sub>1. t x \<ge> x\<^sub>0 \<and> t x < x" unfolding hs_def by force
    qed
    moreover have "\<forall>i<k. \<forall>x\<ge>x\<^sub>1. (bs!i)*x + (hs!i) x = real ((ts!i) x)"
    proof (rule allI, rule impI)
      fix i assume i: "i < k"
      with eh show "\<forall>x\<ge>x\<^sub>1. (bs!i)*x + (hs!i) x = real ((ts!i) x)"
        using length_ts unfolding hs_def by fastforce
    qed
    ultimately show ?thesis by blast
  qed
  from someI_ex[OF this, folded e_hs_def] show ?thesis
    unfolding e_def hs_def by (intro conjI) fastforce+
qed

lemma
  e_pos: "e > 0" and length_hs: "length hs = k" and
  hs_growth:  "\<And>h. h \<in> set hs \<Longrightarrow> (\<lambda>x. h x) \<in> O(\<lambda>x. real x / ln (real x) powr (1 + e))" and
  step_ge_x0: "\<And>t x. t \<in> set ts \<Longrightarrow> x \<ge> x\<^sub>1 \<Longrightarrow> x\<^sub>0 \<le> t x" and
  step_less:  "\<And>t x. t \<in> set ts \<Longrightarrow> x \<ge> x\<^sub>1 \<Longrightarrow> t x < x" and
  decomp:     "\<And>i x. i < k \<Longrightarrow> x \<ge> x\<^sub>1 \<Longrightarrow> (bs!i)*x + (hs!i) x = real ((ts!i) x)"
by (insert e_hs_aux) simp_all

lemma h_in_hs [intro, simp]: "i < k \<Longrightarrow> hs ! i \<in> set hs"
  by (rule nth_mem) (simp add: length_hs)

lemma t_in_ts [intro, simp]: "i < k \<Longrightarrow> ts ! i \<in> set ts"
  by (rule nth_mem) (simp add: length_ts)

lemma x0_less_x1: "x\<^sub>0 < x\<^sub>1" and x0_le_x1: "x\<^sub>0 \<le> x\<^sub>1"
proof-
  from ts_nonempty have "x\<^sub>0 \<le> hd ts x\<^sub>1" using step_ge_x0[of "hd ts" x\<^sub>1] by simp
  also from ts_nonempty have "... < x\<^sub>1" by (intro step_less) simp_all
  finally show "x\<^sub>0 < x\<^sub>1" by simp
  thus "x\<^sub>0 \<le> x\<^sub>1" by simp
qed

lemma akra_bazzi_induct [consumes 1, case_names base rec]:
  assumes "x \<ge> x\<^sub>0"
  assumes base: "\<And>x. x \<ge> x\<^sub>0 \<Longrightarrow> x < x\<^sub>1 \<Longrightarrow> P x"
  assumes rec:  "\<And>x. x \<ge> x\<^sub>1 \<Longrightarrow> (\<And>t. t \<in> set ts \<Longrightarrow> P (t x)) \<Longrightarrow> P x"
  shows   "P x"
proof (insert assms(1), induction x rule: less_induct)
  case (less x)
  with assms step_less step_ge_x0 show "P x" by (cases "x < x\<^sub>1") auto
qed

end

locale akra_bazzi_function = akra_bazzi_recursion +
  fixes integrable integral
  assumes integral: "akra_bazzi_integral integrable integral"
  fixes g :: "nat \<Rightarrow> real"
  assumes f_nonneg_base: "x \<ge> x\<^sub>0 \<Longrightarrow> x < x\<^sub>1 \<Longrightarrow> f x \<ge> 0"
  and     f_rec:         "x \<ge> x\<^sub>1 \<Longrightarrow> f x = g x + (\<Sum>i<k. as!i * f ((ts!i) x))"
  and     g_nonneg:      "x \<ge> x\<^sub>1 \<Longrightarrow> g x \<ge> 0"
  and     ex_pos_a:      "\<exists>a\<in>set as. a > 0"
begin

lemma ex_pos_a': "\<exists>i<k. as!i > 0"
  using ex_pos_a by (auto simp: in_set_conv_nth length_as)

sublocale akra_bazzi_params_nonzero
  using length_as length_bs ex_pos_a a_ge_0 b_bounds by unfold_locales

definition g_real :: "real \<Rightarrow> real" where "g_real x = g (nat \<lfloor>x\<rfloor>)"

lemma g_real_real[simp]: "g_real (real x) = g x" unfolding g_real_def by simp

lemma f_nonneg: "x \<ge> x\<^sub>0 \<Longrightarrow> f x \<ge> 0"
proof (induction x rule: akra_bazzi_induct)
  case (base x)
  with f_nonneg_base show "f x \<ge> 0" by simp
next
  case (rec x)
  from rec.hyps have "g x \<ge> 0" by (intro g_nonneg) simp
  moreover have "(\<Sum>i<k. as!i*f ((ts!i) x)) \<ge> 0" using rec.hyps length_ts length_as
    by (intro sum_nonneg ballI mult_nonneg_nonneg[OF a_ge_0 rec.IH]) simp_all
  ultimately show "f x \<ge> 0" using rec.hyps by (simp add: f_rec)
qed

definition "hs' = map (\<lambda>h x. h (nat \<lfloor>x::real\<rfloor>)) hs"

lemma length_hs': "length hs' = k" unfolding hs'_def by (simp add: length_hs)

lemma h_bound:
  obtains hb where "hb > 0" and
      "eventually (\<lambda>x. \<forall>h\<in>set hs'. \<bar>h x\<bar> \<le> hb * x / ln x powr (1 + e)) at_top"
proof-
  have "\<forall>h\<in>set hs. \<exists>c>0. eventually (\<lambda>x. \<bar>h x\<bar> \<le> c * real x / ln (real x) powr (1 + e)) at_top"
  proof
    fix h assume h: "h \<in> set hs"
    hence "(\<lambda>x. h x) \<in> O(\<lambda>x. real x / ln (real x) powr (1 + e))" by (rule hs_growth)
    thus "\<exists>c>0. eventually (\<lambda>x. \<bar>h x\<bar> \<le> c * x / ln x powr (1 + e)) at_top"
     unfolding bigo_def by auto
  qed
  from bchoice[OF this] obtain hb where hb:
      "\<forall>h\<in>set hs. hb h > 0 \<and> eventually (\<lambda>x. \<bar>h x\<bar> \<le> hb h * real x / ln (real x) powr (1 + e)) at_top" by blast
  define hb' where "hb' = max 1 (Max {hb h |h. h \<in> set hs})"
  have "hb' > 0" unfolding hb'_def by simp
  moreover have "\<forall>h\<in>set hs. eventually (\<lambda>x. \<bar>h (nat \<lfloor>x\<rfloor>)\<bar> \<le> hb' * x / ln x powr (1 + e)) at_top"
  proof (intro ballI, rule eventually_mp[OF always_eventually eventually_conj], clarify)
    fix h assume h: "h \<in> set hs"
    with hb have hb_pos: "hb h > 0" by auto

    show "eventually (\<lambda>x. x > exp (1 + e) + 1) at_top" by (rule eventually_gt_at_top)
    from h hb have e: "eventually (\<lambda>x. \<bar>h (nat \<lfloor>x :: real\<rfloor>)\<bar> \<le>
        hb h * real (nat \<lfloor>x\<rfloor>) / ln (real (nat \<lfloor>x\<rfloor>)) powr (1 + e)) at_top"
      by (intro eventually_natfloor) blast
    show "eventually (\<lambda>x. \<bar>h (nat \<lfloor>x :: real\<rfloor>)\<bar> \<le> hb' * x / ln x powr (1 + e)) at_top"
      using e eventually_gt_at_top
    proof eventually_elim
      fix x :: real assume x: "x > exp (1 + e) + 1"

      have x': "x > 0" by (rule le_less_trans[OF _ x]) simp_all
      assume "\<bar>h (nat \<lfloor>x\<rfloor>)\<bar> \<le> hb h*real (nat \<lfloor>x\<rfloor>)/ln (real (nat \<lfloor>x\<rfloor>)) powr (1 + e)"
      also {
        from x have "exp (1 + e) < real (nat \<lfloor>x\<rfloor>)" by linarith
        moreover have "x > 0" by (rule le_less_trans[OF _ x]) simp_all
        hence "real (nat \<lfloor>x\<rfloor>) \<le> x" by simp
        ultimately have "real (nat \<lfloor>x\<rfloor>)/ln (real (nat \<lfloor>x\<rfloor>)) powr (1+e) \<le> x/ln x powr (1+e)"
          using e_pos by (intro x_over_ln_mono) simp_all
        from hb_pos mult_left_mono[OF this, of "hb h"]
          have "hb h * real (nat \<lfloor>x\<rfloor>)/ln (real (nat \<lfloor>x\<rfloor>)) powr (1+e) \<le> hb h * x / ln x powr (1+e)"
          by (simp add: algebra_simps)
      }
      also from h have "hb h \<le> hb'"
        unfolding hb'_def f_rec by (intro order.trans[OF Max.coboundedI max.cobounded2]) auto
      with x' have "hb h*x/ln x powr (1+e) \<le> hb'*x/ln x powr (1+e)"
        by (intro mult_right_mono divide_right_mono) simp_all
      finally show "\<bar>h (nat \<lfloor>x\<rfloor>)\<bar> \<le> hb' * x / ln x powr (1 + e)" .
    qed
  qed
  hence "\<forall>h\<in>set hs'. eventually (\<lambda>x. \<bar>h x\<bar> \<le> hb' * x / ln x powr (1 + e)) at_top"
    by (auto simp: hs'_def)
  hence "eventually (\<lambda>x. \<forall>h\<in>set hs'. \<bar>h x\<bar> \<le> hb' * x / ln x powr (1 + e)) at_top"
    by (intro eventually_ball_finite) simp_all
  ultimately show ?thesis by (rule that)
qed

lemma C_bound:
  assumes "\<And>b. b \<in> set bs \<Longrightarrow> C < b" "hb > 0"
  shows   "eventually (\<lambda>x::real. \<forall>b\<in>set bs. C*x \<le> b*x - hb*x/ln x powr (1+e)) at_top"
proof-
  from e_pos have "((\<lambda>x. hb * ln x powr -(1+e)) \<longlongrightarrow> 0) at_top"
    by (intro tendsto_mult_right_zero tendsto_neg_powr ln_at_top) simp_all
  with assms have "\<forall>b\<in>set bs. eventually (\<lambda>x. \<bar>hb * ln x powr -(1+e)\<bar> < b - C) at_top"
    by (force simp: tendsto_iff dist_real_def)
  hence "eventually (\<lambda>x. \<forall>b\<in>set bs. \<bar>hb * ln x powr -(1+e)\<bar> < b - C) at_top"
    by (intro eventually_ball_finite) simp_all
  note A = eventually_conj[OF this eventually_gt_at_top]
  show ?thesis using A apply eventually_elim
  proof clarify
    fix x b :: real assume x: "x > 0" and b: "b \<in> set bs"
    assume A: "\<forall>b\<in>set bs. \<bar>hb * ln x powr -(1+e)\<bar> < b - C"
    from b A assms have "hb * ln x powr -(1+e) < b - C" by simp
    with x have "x * (hb * ln x powr -(1+e)) < x * (b - C)" by (intro mult_strict_left_mono)
    thus "C*x \<le> b*x - hb*x / ln x powr (1+e)"
      by (subst (asm) powr_minus) (simp_all add: field_simps)
  qed
qed

end

locale akra_bazzi_lower = akra_bazzi_function +
  fixes   g' :: "real \<Rightarrow> real"
  assumes f_pos:      "eventually (\<lambda>x. f x > 0) at_top"
  and     g_growth2:  "\<exists>C c2. c2 > 0 \<and> C < Min (set bs) \<and>
                           eventually (\<lambda>x. \<forall>u\<in>{C*x..x}. g' u \<le> c2 * g' x) at_top"
  and     g'_integrable:  "\<exists>a. \<forall>b\<ge>a. integrable (\<lambda>u. g' u / u powr (p + 1)) a b"
  and     g'_bounded:  "eventually (\<lambda>a::real. (\<forall>b>a. \<exists>c. \<forall>x\<in>{a..b}. g' x \<le> c)) at_top"
  and     g_bigomega: "g \<in> \<Omega>(\<lambda>x. g' (real x))"
  and     g'_nonneg:  "eventually (\<lambda>x. g' x \<ge> 0) at_top"
begin

definition "gc2 \<equiv> SOME gc2. gc2 > 0 \<and> eventually (\<lambda>x. g x \<ge> gc2 * g' (real x)) at_top"

lemma gc2: "gc2 > 0" "eventually (\<lambda>x. g x \<ge> gc2 * g' (real x)) at_top"
proof-
  from g_bigomega guess c by (elim landau_omega.bigE) note c = this
  from g'_nonneg have "eventually (\<lambda>x::nat. g' (real x) \<ge> 0) at_top" by (rule eventually_nat_real)
  with c(2) have "eventually (\<lambda>x. g x \<ge> c * g' (real x)) at_top"
    using eventually_ge_at_top[of x\<^sub>1] by eventually_elim (insert g_nonneg, simp_all)
  with c(1) have "\<exists>gc2. gc2 > 0 \<and> eventually (\<lambda>x. g x \<ge> gc2 * g' (real x)) at_top" by blast
  from someI_ex[OF this] show "gc2 > 0" "eventually (\<lambda>x. g x \<ge> gc2 * g' (real x)) at_top"
    unfolding gc2_def by blast+
qed

definition "gx0 \<equiv> max x\<^sub>1 (SOME gx0. \<forall>x\<ge>gx0. g x \<ge> gc2 * g' (real x) \<and> f x > 0 \<and> g' (real x) \<ge> 0)"
definition "gx1 \<equiv> max gx0 (SOME gx1. \<forall>x\<ge>gx1. \<forall>i<k. (ts!i) x \<ge> gx0)"

lemma gx0:
  assumes "x \<ge> gx0"
  shows   "g x \<ge> gc2 * g' (real x)" "f x > 0" "g' (real x) \<ge> 0"
proof-
  from eventually_conj[OF gc2(2) eventually_conj[OF f_pos eventually_nat_real[OF g'_nonneg]]]
    have "\<exists>gx0. \<forall>x\<ge>gx0. g x \<ge> gc2 * g' (real x) \<and> f x > 0 \<and> g' (real x) \<ge> 0"
    by (simp add: eventually_at_top_linorder)
  note someI_ex[OF this]
  moreover have "x \<ge> (SOME gx0. \<forall>x\<ge>gx0. g x \<ge> gc2 * g' (real x) \<and>f x > 0 \<and> g' (real x) \<ge> 0)"
    using assms unfolding gx0_def by simp
  ultimately show "g x \<ge> gc2 * g' (real x)" "f x > 0" "g' (real x) \<ge> 0" unfolding gx0_def by blast+
qed

lemma gx1:
  assumes "x \<ge> gx1" "i < k"
  shows  "(ts!i) x \<ge> gx0"
proof-
  define mb where "mb = Min (set bs)/2"
  from b_bounds bs_nonempty have mb_pos: "mb > 0" unfolding mb_def by simp
  from h_bound guess hb . note hb = this
  from e_pos have "((\<lambda>x. hb * ln x powr -(1 + e)) \<longlongrightarrow> 0) at_top"
    by (intro tendsto_mult_right_zero tendsto_neg_powr ln_at_top) simp_all
  moreover note mb_pos
  ultimately have "eventually (\<lambda>x. hb * ln x powr -(1 + e) < mb) at_top" using hb(1)
    by (subst (asm) tendsto_iff) (simp_all add: dist_real_def)

  from eventually_nat_real[OF hb(2)] eventually_nat_real[OF this]
       eventually_ge_at_top eventually_ge_at_top
  have "eventually (\<lambda>x. \<forall>i<k. (ts!i) x \<ge> gx0) at_top" apply eventually_elim
  proof clarify
    fix i x :: nat assume A: "hb * ln (real x) powr -(1+e) < mb" and i: "i < k"
    assume B: "\<forall>h\<in>set hs'. \<bar>h (real x)\<bar> \<le> hb * real x / ln (real x) powr (1+e)"
    with i have B': "\<bar>(hs'!i) (real x)\<bar> \<le> hb * real x / ln (real x) powr (1+e)"
      using length_hs'[symmetric] by auto
    assume C: "x \<ge> nat \<lceil>gx0/mb\<rceil>"
    hence C': "real gx0/mb \<le> real x" by linarith
    assume D: "x \<ge> x\<^sub>1"

    from mb_pos have "real gx0 = mb * (real gx0/mb)" by simp
    also from i bs_nonempty have "mb \<le> bs!i/2" unfolding mb_def by simp
    hence "mb * (real gx0/mb) \<le> bs!i/2 * x"
      using C' i b_bounds[of "bs!i"] mb_pos by (intro mult_mono) simp_all
    also have "... = bs!i*x + -bs!i/2 * x" by simp
    also {
      have "-(hs!i) x \<le> \<bar>(hs!i) x\<bar>" by simp
      also from i B' length_hs have "\<bar>(hs!i) x\<bar> \<le> hb * real x / ln (real x) powr (1+e)"
        by (simp add: hs'_def)
      also from A have "hb / ln x powr (1+e) \<le> mb"
        by (subst (asm) powr_minus) (simp add: field_simps)
      hence "hb / ln x powr (1+e) * x \<le> mb * x" by (intro mult_right_mono) simp_all
      hence "hb * x / ln x powr (1+e) \<le> mb * x" by simp
      also from i have "... \<le> (bs!i/2) * x" unfolding mb_def by (intro mult_right_mono) simp_all
      finally have "-bs!i/2 * x \<le> (hs!i) x" by simp
    }
    also have "bs!i*real x + (hs!i) x = real ((ts!i) x)" using i D decomp by simp
    finally show "(ts!i) x \<ge> gx0" by simp
  qed
  hence "\<exists>gx1. \<forall>x\<ge>gx1. \<forall>i<k. gx0 \<le> (ts!i) x" (is "Ex ?P")
    by (simp add: eventually_at_top_linorder)
  from someI_ex[OF this] have "?P (SOME x. ?P x)" .
  moreover have "\<And>x. x \<ge> gx1 \<Longrightarrow> x \<ge> (SOME x. ?P x)" unfolding gx1_def by simp
  ultimately have "?P gx1" by blast
  with assms show ?thesis by blast
qed

lemma gx0_ge_x1: "gx0 \<ge> x\<^sub>1" unfolding gx0_def by simp
lemma gx0_le_gx1: "gx0 \<le> gx1" unfolding gx1_def by simp

function f2' :: "nat \<Rightarrow> real" where
  "x < gx1 \<Longrightarrow> f2' x = max 0 (f x / gc2)"
| "x \<ge> gx1 \<Longrightarrow> f2' x = g' (real x) + (\<Sum>i<k. as!i*f2' ((ts!i) x))"
using le_less_linear by (blast, simp_all)
termination by (relation "Wellfounded.measure (\<lambda>x. x)")
               (insert gx0_le_gx1 gx0_ge_x1, simp_all add: step_less)

lemma f2'_pos: "eventually (\<lambda>x. f2' x > 0) at_top"
proof (subst eventually_at_top_linorder, intro exI allI impI)
  fix x :: nat assume "x \<ge> gx0"
  thus "f2' x > 0"
  proof (induction x rule: f2'.induct)
    case (1 x)
    with gc2 gx0(2)[of x] show ?case by (simp add: max_def field_simps)
  next
    case prems: (2 x)
    have "(\<Sum>i<k. as!i*f2' ((ts!i) x)) > 0"
    proof (rule sum_pos')
      from ex_pos_a' guess i by (elim exE conjE) note i = this
      with prems(1) gx0 gx1 have "as!i * f2' ((ts!i) x) > 0"
        by (intro mult_pos_pos prems(2)) simp_all
      with i show "\<exists>i\<in>{..<k}. as!i * f2' ((ts!i) x) > 0" by blast
    next
      fix i assume i: "i \<in> {..<k}"
      with prems(1) have "f2' ((ts!i) x) > 0" by (intro prems(2) gx1) simp_all
      with i show "as!i * f2' ((ts!i) x) \<ge> 0" by (intro mult_nonneg_nonneg[OF a_ge_0]) simp_all
    qed simp_all
    with prems(1) gx0_le_gx1 show ?case by (auto intro!: add_nonneg_pos gx0)
  qed
qed

lemma bigomega_f_aux:
  obtains a where "a \<ge> A" "\<forall>a'\<ge>a. a' \<in> \<nat> \<longrightarrow>
    f \<in> \<Omega>(\<lambda>x. x powr p *(1 + integral (\<lambda>u. g' u / u powr (p + 1)) a' x))"
proof-
  from g'_integrable guess a0 by (elim exE) note a0 = this
  from h_bound guess hb . note hb = this
  moreover from g_growth2 guess C c2 by (elim conjE exE) note C = this
  hence "eventually (\<lambda>x. \<forall>b\<in>set bs. C*x \<le> b*x - hb*x/ln x powr (1 + e)) at_top"
    using hb(1) bs_nonempty by (intro C_bound) simp_all
  moreover from b_bounds hb(1) e_pos
    have "eventually (\<lambda>x. \<forall>b\<in>set bs. akra_bazzi_asymptotics b hb e p x) at_top"
    by (rule akra_bazzi_asymptotics)
  moreover note g'_bounded C(3) g'_nonneg eventually_natfloor[OF f2'_pos] eventually_natfloor[OF gc2(2)]
  ultimately have "eventually (\<lambda>x. (\<forall>h\<in>set hs'. \<bar>h x\<bar> \<le> hb*x/ln x powr (1+e)) \<and>
                     (\<forall>b\<in>set bs. C*x \<le> b*x - hb*x/ln x powr (1+e)) \<and>
                     (\<forall>b\<in>set bs. akra_bazzi_asymptotics b hb e p x) \<and>
                     (\<forall>b>x. \<exists>c. \<forall>x\<in>{x..b}. g' x \<le> c) \<and> f2' (nat \<lfloor>x\<rfloor>) > 0 \<and>
                     (\<forall>u\<in>{C * x..x}. g' u \<le> c2 * g' x) \<and>
                     g' x \<ge> 0) at_top"
    by (intro eventually_conj) (force elim!: eventually_conjE)+
  then have "\<exists>X. (\<forall>x\<ge>X. (\<forall>h\<in>set hs'. \<bar>h x\<bar> \<le> hb*x/ln x powr (1+e)) \<and>
                        (\<forall>b\<in>set bs. C*x \<le> b*x - hb*x/ln x powr (1+e)) \<and>
                        (\<forall>b\<in>set bs. akra_bazzi_asymptotics b hb e p x) \<and>
                        (\<forall>b>x. \<exists>c. \<forall>x\<in>{x..b}. g' x \<le> c) \<and>
                        (\<forall>u\<in>{C * x..x}. g' u \<le> c2 * g' x) \<and>
                        f2' (nat \<lfloor>x\<rfloor>) > 0 \<and> g' x \<ge> 0)"
    by (subst (asm) eventually_at_top_linorder) (erule ex_mono, blast)
  then guess X by (elim exE conjE) note X = this

  define x\<^sub>0'_min where "x\<^sub>0'_min = max A (max X (max a0 (max gx1 (max 1 (real x\<^sub>1 + 1)))))"
  {
  fix x\<^sub>0' :: real assume x0'_props: "x\<^sub>0' \<ge> x\<^sub>0'_min" "x\<^sub>0' \<in> \<nat>"
  hence x0'_ge_x1: "x\<^sub>0' \<ge> real (x\<^sub>1+1)" and x0'_ge_1: "x\<^sub>0' \<ge> 1" and x0'_ge_X: "x\<^sub>0' \<ge> X"
    unfolding x\<^sub>0'_min_def by linarith+
  hence x0'_pos: "x\<^sub>0' > 0" and  x0'_nonneg: "x\<^sub>0' \<ge> 0" by simp_all
  have x0': "\<forall>x\<ge>x\<^sub>0'. (\<forall>h\<in>set hs'. \<bar>h x\<bar> \<le> hb*x/ln x powr (1+e))"
            "\<forall>x\<ge>x\<^sub>0'. (\<forall>b\<in>set bs. C*x \<le> b*x - hb*x/ln x powr (1+e))"
            "\<forall>x\<ge>x\<^sub>0'. (\<forall>b\<in>set bs. akra_bazzi_asymptotics b hb e p x)"
            "\<forall>a\<ge>x\<^sub>0'. \<forall>b>a. \<exists>c. \<forall>x\<in>{a..b}. g' x \<le> c"
            "\<forall>x\<ge>x\<^sub>0'. \<forall>u\<in>{C * x..x}. g' u \<le> c2 * g' x"
            "\<forall>x\<ge>x\<^sub>0'. f2' (nat \<lfloor>x\<rfloor>) > 0" "\<forall>x\<ge>x\<^sub>0'. g' x \<ge> 0"
    using X x0'_ge_X by auto
  from x0'_props(2) have x0'_int: "real (nat \<lfloor>x\<^sub>0'\<rfloor>) = x\<^sub>0'" by (rule real_natfloor_nat)
  from x0'_props have x0'_ge_gx1: "x\<^sub>0' \<ge> gx1" and x0'_ge_a0: "x\<^sub>0' \<ge> a0"
    unfolding x\<^sub>0'_min_def by simp_all
  with gx0_le_gx1 have f2'_nonneg: "\<And>x. x \<ge> x\<^sub>0' \<Longrightarrow> f2' x \<ge> 0" by (force intro!: f2'_nonneg)

  define bm where "bm = Min (set bs)"
  define x\<^sub>1' where "x\<^sub>1' = 2 * x\<^sub>0' * inverse bm"
  define fb2 where "fb2 = Min {f2' x |x. x \<in> {x\<^sub>0'..x\<^sub>1'}}"
  define gb2 where "gb2 = (SOME c. \<forall>x\<in>{x\<^sub>0'..x\<^sub>1'}. g' x \<le> c)"

  from b_bounds bs_nonempty have "bm > 0" "bm < 1" unfolding bm_def by auto
  hence "1 < 2 * inverse bm" by (simp add: field_simps)
  from mult_strict_left_mono[OF this x0'_pos]
    have x0'_lt_x1': "x\<^sub>0' < x\<^sub>1'" and x0'_le_x1': "x\<^sub>0' \<le> x\<^sub>1'" unfolding x\<^sub>1'_def by simp_all

  from x0_le_x1 x0'_ge_x1 have ge_x0'D: "\<And>x. x\<^sub>0' \<le> real x \<Longrightarrow> x\<^sub>0 \<le> x" by simp
  from x0'_ge_x1 x0'_le_x1' have gt_x1'D: "\<And>x. x\<^sub>1' < real x \<Longrightarrow> x\<^sub>1 \<le> x" by simp

  have x0'_x1': "\<forall>b\<in>set bs. 2 * x\<^sub>0' * inverse b \<le> x\<^sub>1'"
  proof
    fix b assume b: "b \<in> set bs"
    hence "bm \<le> b" by (simp add: bm_def)
    moreover from b bs_nonempty b_bounds have "bm > 0" "b > 0" unfolding bm_def by auto
    ultimately have "inverse b \<le> inverse bm" by simp
    with x0'_nonneg show "2 * x\<^sub>0' * inverse b \<le> x\<^sub>1'"
      unfolding x\<^sub>1'_def by (intro mult_left_mono) simp_all
  qed

  note f_nonneg' = f_nonneg
  have "\<And>x. real x \<ge> x\<^sub>0' \<Longrightarrow> x \<ge> nat \<lfloor>x\<^sub>0'\<rfloor>" "\<And>x. real x \<le> x\<^sub>1' \<Longrightarrow> x \<le> nat \<lceil>x\<^sub>1'\<rceil>" by linarith+
  hence "{x |x. real x \<in> {x\<^sub>0'..x\<^sub>1'}} \<subseteq> {x |x. x \<in> {nat \<lfloor>x\<^sub>0'\<rfloor>..nat \<lceil>x\<^sub>1'\<rceil>}}" by auto
  hence "finite {x |x::nat. real x \<in> {x\<^sub>0'..x\<^sub>1'}}" by (rule finite_subset) auto
  hence fin: "finite {f2' x |x::nat. real x \<in> {x\<^sub>0'..x\<^sub>1'}}" by force

  note facts = hs'_real e_pos length_hs' length_as length_bs k_not_0 a_ge_0 p_props x0'_ge_1
               f2'_nonneg f_rec[OF gt_x1'D] x0' x0'_int x0'_x1' gc2(1) decomp
  from b_bounds x0'_le_x1' x0'_ge_gx1 gx0_le_gx1 x0'_ge_x1
    interpret abr: akra_bazzi_nat_to_real as bs hs' k x\<^sub>0' x\<^sub>1' hb e p f2' g'
    by (unfold_locales) (auto simp: facts simp del: f2'.simps intro!: f2'.simps(2))

  have f'_nat: "\<And>x::nat. abr.f' (real x) = f2' x"
  proof-
    fix x :: nat show "abr.f' (real (x::nat)) = f2' x"
    proof (induction "real x" arbitrary: x rule: abr.f'.induct)
      case (2 x)
      note x = this(1) and IH = this(2)
      from x have "abr.f' (real x) = g' (real x) + (\<Sum>i<k. as!i*abr.f' (bs!i*real x + (hs!i) x))"
        by (auto simp: gt_x1'D hs'_real g_real_def intro!: sum.cong)
      also have "(\<Sum>i<k. as!i*abr.f' (bs!i*real x + (hs!i) x)) =
                 (\<Sum>i<k. as!i*f2' ((ts!i) x))"
      proof (rule sum.cong, simp, clarify)
        fix i assume i: "i < k"
        from i x x0'_le_x1' x0'_ge_x1 have *: "bs!i * real x + (hs!i) x = real ((ts!i) x)"
          by (intro decomp) simp_all
        also from i * have "abr.f' ... = f2' ((ts!i) x)"
          by (subst IH[of i]) (simp_all add: hs'_real)
        finally show "as!i*abr.f' (bs!i*real x+(hs!i) x) = as!i*f2' ((ts!i) x)" by simp
      qed
      also have "g' x + ... = f2' x" using x x0'_ge_gx1 x0'_le_x1'
        by (intro f2'.simps(2)[symmetric] gt_x1'D) simp_all
      finally show ?case .
    qed simp
  qed
  interpret akra_bazzi_integral integrable integral by (rule integral)
  interpret akra_bazzi_real_lower as bs hs' k x\<^sub>0' x\<^sub>1' hb e p
      integrable integral abr.f' g' C fb2 gb2 c2
  proof unfold_locales
    fix x assume "x \<ge> x\<^sub>0'" "x \<le> x\<^sub>1'"
    thus "abr.f' x \<ge> 0" by (intro abr.f'_base) simp_all
  next
    fix x assume x:"x \<ge> x\<^sub>0'"
    show "integrable (\<lambda>x. g' x / x powr (p + 1)) x\<^sub>0' x"
      by (rule integrable_subinterval[of _ a0 x]) (insert a0 x0'_ge_a0 x, auto)
  next
    fix x assume x: "x \<ge> x\<^sub>0'" "x \<le> x\<^sub>1'"
    have "x\<^sub>0' = real (nat \<lfloor>x\<^sub>0'\<rfloor>)" by (simp add: x0'_int)
    also from x have "... \<le> real (nat \<lfloor>x\<rfloor>)" by (auto intro!: nat_mono floor_mono)
    finally have "x\<^sub>0' \<le> real (nat \<lfloor>x\<rfloor>)" .
    moreover have "real (nat \<lfloor>x\<rfloor>) \<le> x\<^sub>1'" using x x0'_ge_1 by linarith
    ultimately have "f2' (nat \<lfloor>x\<rfloor>) \<in> {f2' x |x. real x \<in> {x\<^sub>0'..x\<^sub>1'}}" by force
    from fin and this have "f2' (nat \<lfloor>x\<rfloor>) \<ge> fb2" unfolding fb2_def by (rule Min_le)
    with x show "abr.f' x \<ge> fb2" by simp
  next
    from x0'_int x0'_le_x1' have "\<exists>x::nat. real x \<ge> x\<^sub>0' \<and> real x \<le> x\<^sub>1'"
        by (intro exI[of _ "nat \<lfloor>x\<^sub>0'\<rfloor>"]) simp_all
    moreover {
      fix x :: nat assume "real x \<ge> x\<^sub>0' \<and> real x \<le> x\<^sub>1'"
      with x0'(6) have "f2' (nat \<lfloor>real x\<rfloor>) > 0" by blast
      hence "f2' x > 0" by simp
    }
    ultimately show "fb2 > 0" unfolding fb2_def using fin by (subst Min_gr_iff) auto
  next
    fix x assume x: "x\<^sub>0' \<le> x" "x \<le> x\<^sub>1'"
    with x0'(4) x0'_lt_x1' have "\<exists>c. \<forall>x\<in>{x\<^sub>0'..x\<^sub>1'}. g' x \<le> c" by force
    from someI_ex[OF this] x show "g' x \<le> gb2" unfolding gb2_def by simp
  qed (insert g_nonneg integral x0'(2) C x0'_le_x1' x0'_ge_x1, simp_all add: facts)

  from akra_bazzi_lower guess c5 . note c5 = this
  have "eventually (\<lambda>x. \<bar>f x\<bar> \<ge> gc2 * c5 * \<bar>f_approx (real x)\<bar>) at_top"
  proof (unfold eventually_at_top_linorder, intro exI allI impI)
    fix x :: nat assume "x \<ge> nat \<lceil>x\<^sub>0'\<rceil>"
    hence x: "real x \<ge> x\<^sub>0'" by linarith
    note c5(1)[OF x]
    also have "abr.f' (real x) = f2' x" by (rule f'_nat)
    also have "gc2 * ... \<le> f x" using x x0'_ge_x1 x0_le_x1 by (intro f2'_le_f) simp_all
    also have "f x = \<bar>f x\<bar>" using x f_nonneg' x0'_ge_x1 x0_le_x1 by simp
    finally show "gc2 * c5 * \<bar>f_approx (real x)\<bar> \<le> \<bar>f x\<bar>"
      using gc2 f_approx_nonneg[OF x] by (simp add: algebra_simps)
  qed
  hence "f \<in> \<Omega>(\<lambda>x. f_approx (real x))" using gc2(1) f_nonneg' f_approx_nonneg
    by (intro landau_omega.bigI[of "gc2 * c5"] eventually_conj
        mult_pos_pos c5 eventually_nat_real) (auto simp: eventually_at_top_linorder)
  note this[unfolded f_approx_def]
  }
  moreover have "x\<^sub>0'_min \<ge> A" unfolding x\<^sub>0'_min_def gx0_ge_x1 by simp
  ultimately show ?thesis by (intro that) auto
qed

lemma bigomega_f:
  obtains a where "a \<ge> A" "f \<in> \<Omega>(\<lambda>x. x powr p *(1 + integral (\<lambda>u. g' u / u powr (p+1)) a x))"
proof-
  from bigomega_f_aux[of A] guess a . note a = this
  define a' where "a' = real (max (nat \<lceil>a\<rceil>) 0) + 1"
  note a
  moreover have "a' \<in> \<nat>" by (auto simp: max_def a'_def)
  moreover have *: "a' \<ge> a + 1" unfolding a'_def by linarith
  moreover from * and a have "a' \<ge> A" by simp
  ultimately show ?thesis by (intro that[of a']) auto
qed

end

locale akra_bazzi_upper = akra_bazzi_function +
  fixes   g' :: "real \<Rightarrow> real"
  assumes g'_integrable:  "\<exists>a. \<forall>b\<ge>a. integrable (\<lambda>u. g' u / u powr (p + 1)) a b"
  and     g_growth1: "\<exists>C c1. c1 > 0 \<and> C < Min (set bs) \<and>
                          eventually (\<lambda>x. \<forall>u\<in>{C*x..x}. g' u \<ge> c1 * g' x) at_top"
  and     g_bigo:    "g \<in> O(g')"
  and     g'_nonneg: "eventually (\<lambda>x. g' x \<ge> 0) at_top"
begin

definition "gc1 \<equiv> SOME gc1. gc1 > 0 \<and> eventually (\<lambda>x. g x \<le> gc1 * g' (real x)) at_top"

lemma gc1: "gc1 > 0" "eventually (\<lambda>x. g x \<le> gc1 * g' (real x)) at_top"
proof-
  from g_bigo guess c by (elim landau_o.bigE) note c = this
  from g'_nonneg have "eventually (\<lambda>x::nat. g' (real x) \<ge> 0) at_top" by (rule eventually_nat_real)
  with c(2) have "eventually (\<lambda>x. g x \<le> c * g' (real x)) at_top"
    using eventually_ge_at_top[of x\<^sub>1] by eventually_elim (insert g_nonneg, simp_all)
  with c(1) have "\<exists>gc1. gc1 > 0 \<and> eventually (\<lambda>x. g x \<le> gc1 * g' (real x)) at_top" by blast
  from someI_ex[OF this] show "gc1 > 0" "eventually (\<lambda>x. g x \<le> gc1 * g' (real x)) at_top"
    unfolding gc1_def by blast+
qed

definition "gx3 \<equiv> max x\<^sub>1 (SOME gx0. \<forall>x\<ge>gx0. g x \<le> gc1 * g' (real x))"

lemma gx3:
  assumes "x \<ge> gx3"
  shows   "g x \<le> gc1 * g' (real x)"
proof-
  from gc1(2) have "\<exists>gx3. \<forall>x\<ge>gx3. g x \<le> gc1 * g' (real x)" by (simp add: eventually_at_top_linorder)
  note someI_ex[OF this]
  moreover have "x \<ge> (SOME gx0. \<forall>x\<ge>gx0. g x \<le> gc1 * g' (real x))"
    using assms unfolding gx3_def by simp
  ultimately show "g x \<le> gc1 * g' (real x)" unfolding gx3_def by blast
qed

lemma gx3_ge_x1: "gx3 \<ge> x\<^sub>1" unfolding gx3_def by simp

function f' :: "nat \<Rightarrow> real" where
  "x < gx3 \<Longrightarrow> f' x = max 0 (f x / gc1)"
| "x \<ge> gx3 \<Longrightarrow> f' x = g' (real x) + (\<Sum>i<k. as!i*f' ((ts!i) x))"
using le_less_linear by (blast, simp_all)
termination by (relation "Wellfounded.measure (\<lambda>x. x)")
               (insert gx3_ge_x1, simp_all add: step_less)

lemma f'_ge_f: "x \<ge> x\<^sub>0 \<Longrightarrow> gc1 * f' x \<ge> f x"
proof (induction rule: f'.induct)
  case (1 x)
  with gc1 f_nonneg show ?case by (simp add: max_def field_simps)
next
  case prems: (2 x)
  with gx3 have "gc1 * g' (real x) \<ge> g x" by force
  moreover from step_ge_x0 prems(1) gx3_ge_x1
    have "\<And>i. i < k \<Longrightarrow> x\<^sub>0 \<le> nat \<lfloor>(ts!i) x\<rfloor>" by (intro le_nat_floor) simp
  hence "\<And>i. i < k \<Longrightarrow> as!i * (gc1 * f' ((ts!i) x)) \<ge> as!i * f ((ts!i) x)"
    using prems(1) by (intro mult_left_mono a_ge_0 prems(2)) auto
  hence "gc1 * (\<Sum>i<k. as!i*f' ((ts!i) x)) \<ge> (\<Sum>i<k. as!i*f ((ts!i) x))"
    by (subst sum_distrib_left, intro sum_mono) (simp_all add: algebra_simps)
  ultimately show ?case using prems(1) gx3_ge_x1
    by (simp_all add: algebra_simps f_rec)
qed

lemma bigo_f_aux:
  obtains a where "a \<ge> A" "\<forall>a'\<ge>a. a' \<in> \<nat> \<longrightarrow>
    f \<in> O(\<lambda>x. x powr p *(1 + integral (\<lambda>u. g' u / u powr (p + 1)) a' x))"
proof-
  from g'_integrable guess a0 by (elim exE) note a0 = this
  from h_bound guess hb . note hb = this
  moreover from g_growth1 guess C c1 by (elim conjE exE) note C = this
  hence "eventually (\<lambda>x. \<forall>b\<in>set bs. C*x \<le> b*x - hb*x/ln x powr (1 + e)) at_top"
    using hb(1) bs_nonempty by (intro C_bound) simp_all
  moreover from b_bounds hb(1) e_pos
    have "eventually (\<lambda>x. \<forall>b\<in>set bs. akra_bazzi_asymptotics b hb e p x) at_top"
    by (rule akra_bazzi_asymptotics)
  moreover note gc1(2) C(3) g'_nonneg
  ultimately have "eventually (\<lambda>x. (\<forall>h\<in>set hs'. \<bar>h x\<bar> \<le> hb*x/ln x powr (1+e)) \<and>
                     (\<forall>b\<in>set bs. C*x \<le> b*x - hb*x/ln x powr (1+e)) \<and>
                     (\<forall>b\<in>set bs. akra_bazzi_asymptotics b hb e p x) \<and>
                     (\<forall>u\<in>{C*x..x}. g' u \<ge> c1 * g' x) \<and> g' x \<ge> 0) at_top"
    by (intro eventually_conj) (force elim!: eventually_conjE)+
  then have "\<exists>X. (\<forall>x\<ge>X. (\<forall>h\<in>set hs'. \<bar>h x\<bar> \<le> hb*x/ln x powr (1+e)) \<and>
                        (\<forall>b\<in>set bs. C*x \<le> b*x - hb*x/ln x powr (1+e)) \<and>
                        (\<forall>b\<in>set bs. akra_bazzi_asymptotics b hb e p x) \<and>
                        (\<forall>u\<in>{C*x..x}. g' u \<ge> c1 * g' x) \<and> g' x \<ge> 0)"
    by (subst (asm) eventually_at_top_linorder) fast
  then guess X by (elim exE conjE) note X = this

  define x\<^sub>0'_min where "x\<^sub>0'_min = max A (max X (max 1 (max a0 (max gx3 (real x\<^sub>1 + 1)))))"
  {
  fix x\<^sub>0' :: real assume x0'_props: "x\<^sub>0' \<ge> x\<^sub>0'_min" "x\<^sub>0' \<in> \<nat>"
  hence x0'_ge_x1: "x\<^sub>0' \<ge> real (x\<^sub>1+1)" and x0'_ge_1: "x\<^sub>0' \<ge> 1" and x0'_ge_X: "x\<^sub>0' \<ge> X"
    unfolding x\<^sub>0'_min_def by linarith+
  hence x0'_pos: "x\<^sub>0' > 0" and  x0'_nonneg: "x\<^sub>0' \<ge> 0" by simp_all
  have x0': "\<forall>x\<ge>x\<^sub>0'. (\<forall>h\<in>set hs'. \<bar>h x\<bar> \<le> hb*x/ln x powr (1+e))"
            "\<forall>x\<ge>x\<^sub>0'. (\<forall>b\<in>set bs. C*x \<le> b*x - hb*x/ln x powr (1+e))"
            "\<forall>x\<ge>x\<^sub>0'. (\<forall>b\<in>set bs. akra_bazzi_asymptotics b hb e p x)"
            "\<forall>x\<ge>x\<^sub>0'. \<forall>u\<in>{C*x..x}. g' u \<ge> c1 * g' x" "\<forall>x\<ge>x\<^sub>0'. g' x \<ge> 0"
            using X x0'_ge_X by auto
  from x0'_props(2) have x0'_int: "real (nat \<lfloor>x\<^sub>0'\<rfloor>) = x\<^sub>0'" by (rule real_natfloor_nat)
  from x0'_props have x0'_ge_gx0: "x\<^sub>0' \<ge> gx3" and x0'_ge_a0: "x\<^sub>0' \<ge> a0"
    unfolding x\<^sub>0'_min_def by simp_all
  hence f'_nonneg: "\<And>x. x \<ge> x\<^sub>0' \<Longrightarrow> f' x \<ge> 0"
    using order.trans[OF f_nonneg f'_ge_f] gc1(1) x0'_ge_x1 x0_le_x1
    by (simp add: zero_le_mult_iff del: f'.simps)

  define bm where "bm = Min (set bs)"
  define x\<^sub>1' where "x\<^sub>1' = 2 * x\<^sub>0' * inverse bm"
  define fb1 where "fb1 = Max {f' x |x. x \<in> {x\<^sub>0'..x\<^sub>1'}}"

from b_bounds bs_nonempty have "bm > 0" "bm < 1" unfolding bm_def by auto
  hence "1 < 2 * inverse bm" by (simp add: field_simps)
  from mult_strict_left_mono[OF this x0'_pos]
    have x0'_lt_x1': "x\<^sub>0' < x\<^sub>1'" and x0'_le_x1': "x\<^sub>0' \<le> x\<^sub>1'" unfolding x\<^sub>1'_def by simp_all

  from x0_le_x1 x0'_ge_x1 have ge_x0'D: "\<And>x. x\<^sub>0' \<le> real x \<Longrightarrow> x\<^sub>0 \<le> x" by simp
  from x0'_ge_x1 x0'_le_x1' have gt_x1'D: "\<And>x. x\<^sub>1' < real x \<Longrightarrow> x\<^sub>1 \<le> x" by simp

  have x0'_x1': "\<forall>b\<in>set bs. 2 * x\<^sub>0' * inverse b \<le> x\<^sub>1'"
  proof
    fix b assume b: "b \<in> set bs"
    hence "bm \<le> b" by (simp add: bm_def)
    moreover from b b_bounds bs_nonempty have "bm > 0" "b > 0" unfolding bm_def by auto
    ultimately have "inverse b \<le> inverse bm" by simp
    with x0'_nonneg show "2 * x\<^sub>0' * inverse b \<le> x\<^sub>1'"
      unfolding x\<^sub>1'_def by (intro mult_left_mono) simp_all
  qed

  note f_nonneg' = f_nonneg
  have "\<And>x. real x \<ge> x\<^sub>0' \<Longrightarrow> x \<ge> nat \<lfloor>x\<^sub>0'\<rfloor>" "\<And>x. real x \<le> x\<^sub>1' \<Longrightarrow> x \<le> nat \<lceil>x\<^sub>1'\<rceil>" by linarith+
  hence "{x |x. real x \<in> {x\<^sub>0'..x\<^sub>1'}} \<subseteq> {x |x. x \<in> {nat \<lfloor>x\<^sub>0'\<rfloor>..nat \<lceil>x\<^sub>1'\<rceil>}}" by auto
  hence "finite {x |x::nat. real x \<in> {x\<^sub>0'..x\<^sub>1'}}" by (rule finite_subset) auto
  hence fin: "finite {f' x |x::nat. real x \<in> {x\<^sub>0'..x\<^sub>1'}}" by force

  note facts = hs'_real e_pos length_hs' length_as length_bs k_not_0 a_ge_0 p_props x0'_ge_1
               f'_nonneg f_rec[OF gt_x1'D] x0' x0'_int x0'_x1' gc1(1) decomp
  from b_bounds x0'_le_x1' x0'_ge_gx0 x0'_ge_x1
  interpret abr: akra_bazzi_nat_to_real as bs hs' k x\<^sub>0' x\<^sub>1' hb e p f' g'
    by (unfold_locales) (auto simp add: facts simp del: f'.simps intro!: f'.simps(2))

  have f'_nat: "\<And>x::nat. abr.f' (real x) = f' x"
  proof-
    fix x :: nat show "abr.f' (real (x::nat)) = f' x"
    proof (induction "real x" arbitrary: x rule: abr.f'.induct)
      case (2 x)
      note x = this(1) and IH = this(2)
      from x have "abr.f' (real x) = g' (real x) + (\<Sum>i<k. as!i*abr.f' (bs!i*real x + (hs!i) x))"
        by (auto simp: gt_x1'D hs'_real intro!: sum.cong)
      also have "(\<Sum>i<k. as!i*abr.f' (bs!i*real x + (hs!i) x)) = (\<Sum>i<k. as!i*f' ((ts!i) x))"
      proof (rule sum.cong, simp, clarify)
        fix i assume i: "i < k"
        from i x x0'_le_x1' x0'_ge_x1 have *: "bs!i * real x + (hs!i) x = real ((ts!i) x)"
          by (intro decomp) simp_all
        also from i * have "abr.f' ... = f' ((ts!i) x)"
          by (subst IH[of i]) (simp_all add: hs'_real)
        finally show "as!i*abr.f' (bs!i*real x+(hs!i) x) = as!i*f' ((ts!i) x)" by simp
      qed
      also from x have "g' x + ... = f' x" using x0'_le_x1' x0'_ge_gx0 by simp
      finally show ?case .
    qed simp
  qed

  interpret akra_bazzi_integral integrable integral by (rule integral)
  interpret akra_bazzi_real_upper as bs hs' k x\<^sub>0' x\<^sub>1' hb e p integrable integral abr.f' g' C fb1 c1
  proof (unfold_locales)
    fix x assume "x \<ge> x\<^sub>0'" "x \<le> x\<^sub>1'"
    thus "abr.f' x \<ge> 0" by (intro abr.f'_base) simp_all
  next
    fix x assume x:"x \<ge> x\<^sub>0'"
    show "integrable (\<lambda>x. g' x / x powr (p + 1)) x\<^sub>0' x"
      by (rule integrable_subinterval[of _ a0 x]) (insert a0 x0'_ge_a0 x, auto)
  next
    fix x assume x: "x \<ge> x\<^sub>0'" "x \<le> x\<^sub>1'"
    have "x\<^sub>0' = real (nat \<lfloor>x\<^sub>0'\<rfloor>)" by (simp add: x0'_int)
    also from x have "... \<le> real (nat \<lfloor>x\<rfloor>)" by (auto intro!: nat_mono floor_mono)
    finally have "x\<^sub>0' \<le> real (nat \<lfloor>x\<rfloor>)" .
    moreover have "real (nat \<lfloor>x\<rfloor>) \<le> x\<^sub>1'" using x x0'_ge_1 by linarith
    ultimately have "f' (nat \<lfloor>x\<rfloor>) \<in> {f' x |x. real x \<in> {x\<^sub>0'..x\<^sub>1'}}" by force
    from fin and this have "f' (nat \<lfloor>x\<rfloor>) \<le> fb1" unfolding fb1_def by (rule Max_ge)
    with x show "abr.f' x \<le> fb1" by simp
  qed (insert x0'(2) x0'_le_x1' x0'_ge_x1 C, simp_all add: facts)

  from akra_bazzi_upper guess c6 . note c6 = this
  {
    fix x :: nat assume "x \<ge> nat \<lceil>x\<^sub>0'\<rceil>"
    hence x: "real x \<ge> x\<^sub>0'" by linarith
    have "f x \<le> gc1 * f' x" using x x0'_ge_x1 x0_le_x1 by (intro f'_ge_f) simp_all
    also have "f' x = abr.f' (real x)" by (simp add: f'_nat)
    also note c6(1)[OF x]
    also from f_nonneg' x x0'_ge_x1 x0_le_x1 have "f x = \<bar>f x\<bar>" by simp
    also from f_approx_nonneg x have "f_approx (real x) = \<bar>f_approx (real x)\<bar>" by simp
    finally have "gc1 * c6 * \<bar>f_approx (real x)\<bar> \<ge> \<bar>f x\<bar>" using gc1 by (simp add: algebra_simps)
  }
  hence "eventually (\<lambda>x. \<bar>f x\<bar> \<le> gc1 * c6 * \<bar>f_approx (real x)\<bar>) at_top"
    using eventually_ge_at_top[of "nat \<lceil>x\<^sub>0'\<rceil>"] by (auto elim!: eventually_mono)
  hence "f \<in> O(\<lambda>x. f_approx (real x))" using gc1(1) f_nonneg' f_approx_nonneg
    by (intro landau_o.bigI[of "gc1 * c6"] eventually_conj
        mult_pos_pos c6 eventually_nat_real) (auto simp: eventually_at_top_linorder)
  note this[unfolded f_approx_def]
  }
  moreover have "x\<^sub>0'_min \<ge> A" unfolding x\<^sub>0'_min_def gx3_ge_x1 by simp
  ultimately show ?thesis by (intro that) auto
qed

lemma bigo_f:
  obtains a where "a > A" "f \<in> O(\<lambda>x. x powr p *(1 + integral (\<lambda>u. g' u / u powr (p + 1)) a x))"
proof-
  from bigo_f_aux[of A] guess a . note a = this
  define a' where "a' = real (max (nat \<lceil>a\<rceil>) 0) + 1"
  note a
  moreover have "a' \<in> \<nat>" by (auto simp: max_def a'_def)
  moreover have *: "a' \<ge> a + 1" unfolding a'_def by linarith
  moreover from * and a have "a' > A" by simp
  ultimately show ?thesis by (intro that[of a']) auto
qed

end

locale akra_bazzi = akra_bazzi_function +
  fixes   g' :: "real \<Rightarrow> real"
  assumes f_pos:         "eventually (\<lambda>x. f x > 0) at_top"
  and     g'_nonneg:     "eventually (\<lambda>x. g' x \<ge> 0) at_top"
  assumes g'_integrable:  "\<exists>a. \<forall>b\<ge>a. integrable (\<lambda>u. g' u / u powr (p + 1)) a b"
  and     g_growth1:  "\<exists>C c1. c1 > 0 \<and> C < Min (set bs) \<and>
                           eventually (\<lambda>x. \<forall>u\<in>{C*x..x}. g' u \<ge> c1 * g' x) at_top"
  and     g_growth2:  "\<exists>C c2. c2 > 0 \<and> C < Min (set bs) \<and>
                           eventually (\<lambda>x. \<forall>u\<in>{C*x..x}. g' u \<le> c2 * g' x) at_top"
  and     g_bounded:  "eventually (\<lambda>a::real. (\<forall>b>a. \<exists>c. \<forall>x\<in>{a..b}. g' x \<le> c)) at_top"
  and     g_bigtheta: "g \<in> \<Theta>(g')"
begin

sublocale akra_bazzi_lower using f_pos g_growth2 g_bounded
  bigthetaD2[OF g_bigtheta] g'_nonneg g'_integrable by unfold_locales
sublocale akra_bazzi_upper using g_growth1 bigthetaD1[OF g_bigtheta]
  g'_nonneg g'_integrable by unfold_locales

lemma bigtheta_f:
  obtains a where "a > A" "f \<in> \<Theta>(\<lambda>x. x powr p *(1 + integral (\<lambda>u. g' u / u powr (p + 1)) a x))"
proof-
  from bigo_f_aux[of A] guess a . note a = this
  moreover from bigomega_f_aux[of A] guess b . note b = this
  let ?a = "real (max (max (nat \<lceil>a\<rceil>) (nat \<lceil>b\<rceil>)) 0) + 1"
  have "?a \<in> \<nat>" by (auto simp: max_def)
  moreover have "?a \<ge> a" "?a \<ge> b" by linarith+
  ultimately have "f \<in> \<Theta>(\<lambda>x. x powr p *(1 + integral (\<lambda>u. g' u / u powr (p + 1)) ?a x))"
    using a b by (intro bigthetaI) blast+
  moreover from a b have "?a > A" by linarith
  ultimately show ?thesis by (intro that[of ?a]) simp_all
qed

end

named_theorems akra_bazzi_term_intros "introduction rules for Akra-Bazzi terms"

lemma akra_bazzi_term_floor_add [akra_bazzi_term_intros]:
  assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \<le> b * real x\<^sub>1 + c" "c < (1 - b) * real x\<^sub>1" "x\<^sub>1 > 0"
  shows   "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lfloor>b*real x + c\<rfloor>)"
proof (rule akra_bazzi_termI[OF zero_less_one])
  fix x assume x: "x \<ge> x\<^sub>1"
  from assms x have "real x\<^sub>0 \<le> b * real x\<^sub>1 + c" by simp
  also from x assms have "... \<le> b * real x + c" by auto
  finally have step_ge_x0: "b * real x + c \<ge> real x\<^sub>0" by simp
  thus "nat \<lfloor>b * real x + c\<rfloor> \<ge> x\<^sub>0" by (subst le_nat_iff) (simp_all add: le_floor_iff)

  from assms x have "c < (1 - b) * real x\<^sub>1" by simp
  also from assms x have "... \<le> (1 - b) * real x" by (intro mult_left_mono) simp_all
  finally show "nat \<lfloor>b * real x + c\<rfloor> < x" using assms step_ge_x0
    by (subst nat_less_iff) (simp_all add: floor_less_iff algebra_simps)

  from step_ge_x0 have "real_of_int \<lfloor>c + b * real x\<rfloor> = real_of_int (nat \<lfloor>c + b * real x\<rfloor>)" by linarith
  thus "(b * real x) + (\<lfloor>b * real x + c\<rfloor> - (b * real x)) =
          real (nat \<lfloor>b * real x + c\<rfloor>)" by linarith
next
  have "(\<lambda>x::nat. real_of_int \<lfloor>b * real x + c\<rfloor> - b * real x) \<in> O(\<lambda>_. \<bar>c\<bar> + 1)"
    by (intro landau_o.big_mono always_eventually allI, unfold real_norm_def) linarith
  also have "(\<lambda>_::nat. \<bar>c\<bar> + 1) \<in> O(\<lambda>x. real x / ln (real x) powr (1 + 1))" by force
  finally show "(\<lambda>x::nat. real_of_int \<lfloor>b * real x + c\<rfloor> - b * real x) \<in>
                    O(\<lambda>x. real x / ln (real x) powr (1+1))" .
qed

lemma akra_bazzi_term_floor_add' [akra_bazzi_term_intros]:
  assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \<le> b * real x\<^sub>1 + real c" "real c < (1 - b) * real x\<^sub>1" "x\<^sub>1 > 0"
  shows   "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lfloor>b*real x\<rfloor> + c)"
proof-
  from assms have "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lfloor>b*real x + real c\<rfloor>)"
    by (rule akra_bazzi_term_floor_add)
  also have "(\<lambda>x. nat \<lfloor>b*real x + real c\<rfloor>) = (\<lambda>x::nat. nat \<lfloor>b*real x\<rfloor> + c)"
  proof
    fix x :: nat
    have "\<lfloor>b * real x + real c\<rfloor> = \<lfloor>b * real x\<rfloor> + int c" by linarith
    also from assms have "nat ... = nat \<lfloor>b * real x\<rfloor> + c" by (simp add: nat_add_distrib)
    finally show "nat \<lfloor>b * real x + real c\<rfloor> = nat \<lfloor>b * real x\<rfloor> + c" .
  qed
  finally show ?thesis .
qed

lemma akra_bazzi_term_floor_subtract [akra_bazzi_term_intros]:
  assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \<le> b * real x\<^sub>1 - c" "0 < c + (1 - b) * real x\<^sub>1" "x\<^sub>1 > 0"
  shows   "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lfloor>b*real x - c\<rfloor>)"
  by (subst diff_conv_add_uminus, rule akra_bazzi_term_floor_add, insert assms) simp_all

lemma akra_bazzi_term_floor_subtract' [akra_bazzi_term_intros]:
  assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \<le> b * real x\<^sub>1 - real c" "0 < real c + (1 - b) * real x\<^sub>1" "x\<^sub>1 > 0"
  shows   "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lfloor>b*real x\<rfloor> - c)"
proof-
  from assms have "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lfloor>b*real x - real c\<rfloor>)"
    by (intro akra_bazzi_term_floor_subtract) simp_all
  also have "(\<lambda>x. nat \<lfloor>b*real x - real c\<rfloor>) = (\<lambda>x::nat. nat \<lfloor>b*real x\<rfloor> - c)"
  proof
    fix x :: nat
    have "\<lfloor>b * real x - real c\<rfloor> = \<lfloor>b * real x\<rfloor> - int c" by linarith
    also from assms have "nat ... = nat \<lfloor>b * real x\<rfloor> - c" by (simp add: nat_diff_distrib)
    finally show "nat \<lfloor>b * real x - real c\<rfloor> = nat \<lfloor>b * real x\<rfloor> - c" .
  qed
  finally show ?thesis .
qed

lemma akra_bazzi_term_floor [akra_bazzi_term_intros]:
  assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \<le> b * real x\<^sub>1" "0 < (1 - b) * real x\<^sub>1" "x\<^sub>1 > 0"
  shows   "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lfloor>b*real x\<rfloor>)"
  using assms akra_bazzi_term_floor_add[where c = 0] by simp

lemma akra_bazzi_term_ceiling_add [akra_bazzi_term_intros]:
  assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \<le> b * real x\<^sub>1 + c" "c + 1 \<le> (1 - b) * x\<^sub>1"
  shows   "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lceil>b*real x + c\<rceil>)"
proof (rule akra_bazzi_termI[OF zero_less_one])
  fix x assume x: "x \<ge> x\<^sub>1"
  have "0 \<le> real x\<^sub>0" by simp
  also from assms have "real x\<^sub>0 \<le> b * real x\<^sub>1 + c" by simp
  also from assms x have "b * real x\<^sub>1 \<le> b * real x" by (intro mult_left_mono) simp_all
  hence "b * real x\<^sub>1 + c \<le> b * real x + c" by simp
  also have "b * real x + c \<le> real_of_int \<lceil>b * real x + c\<rceil>" by linarith
  finally have bx_nonneg: "real_of_int \<lceil>b * real x + c\<rceil> \<ge> 0" .

  have "c + 1 \<le> (1 - b) * x\<^sub>1" by fact
  also have "(1 - b) * x\<^sub>1 \<le> (1 - b) * x" using assms x by (intro mult_left_mono) simp_all
  finally have "b * real x + c + 1 \<le> real x" using assms by (simp add: algebra_simps)
  with bx_nonneg show "nat \<lceil>b * real x + c\<rceil> < x" by (subst nat_less_iff) (simp_all add: ceiling_less_iff)

  have "real x\<^sub>0 \<le> b * real x\<^sub>1 + c" by fact
  also have "... \<le> real_of_int \<lceil>...\<rceil>" by linarith
  also have "x\<^sub>1 \<le> x" by fact
  finally show "x\<^sub>0 \<le> nat \<lceil>b * real x + c\<rceil>" using assms by (force simp: ceiling_mono)

  show "b * real x + (\<lceil>b * real x + c\<rceil> - b * real x) = real (nat \<lceil>b * real x + c\<rceil>)"
    using assms bx_nonneg by simp
next
  have "(\<lambda>x::nat. real_of_int \<lceil>b * real x + c\<rceil> - b * real x) \<in> O(\<lambda>_. \<bar>c\<bar> + 1)"
    by (intro landau_o.big_mono always_eventually allI, unfold real_norm_def) linarith
  also have "(\<lambda>_::nat. \<bar>c\<bar> + 1) \<in> O(\<lambda>x. real x / ln (real x) powr (1 + 1))" by force
  finally show "(\<lambda>x::nat. real_of_int \<lceil>b * real x + c\<rceil> - b * real x) \<in>
                    O(\<lambda>x. real x / ln (real x) powr (1+1))" .
qed

lemma akra_bazzi_term_ceiling_add' [akra_bazzi_term_intros]:
  assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \<le> b * real x\<^sub>1 + real c" "real c + 1 \<le> (1 - b) * x\<^sub>1"
  shows   "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lceil>b*real x\<rceil> + c)"
proof-
  from assms have "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lceil>b*real x + real c\<rceil>)"
    by (rule akra_bazzi_term_ceiling_add)
  also have "(\<lambda>x. nat \<lceil>b*real x + real c\<rceil>) = (\<lambda>x::nat. nat \<lceil>b*real x\<rceil> + c)"
  proof
    fix x :: nat
    from assms have "0 \<le> b * real x" by simp
    also have "b * real x \<le> real_of_int \<lceil>b * real x\<rceil>" by linarith
    finally have bx_nonneg: "\<lceil>b * real x\<rceil> \<ge> 0" by simp

    have "\<lceil>b * real x + real c\<rceil> = \<lceil>b * real x\<rceil> + int c" by linarith
    also from assms bx_nonneg have "nat ... = nat \<lceil>b * real x\<rceil> + c"
      by (subst nat_add_distrib) simp_all
    finally show "nat \<lceil>b * real x + real c\<rceil> = nat \<lceil>b * real x\<rceil> + c" .
  qed
  finally show ?thesis .
qed

lemma akra_bazzi_term_ceiling_subtract [akra_bazzi_term_intros]:
  assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \<le> b * real x\<^sub>1 - c" "1 \<le> c + (1 - b) * x\<^sub>1"
  shows   "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lceil>b*real x - c\<rceil>)"
  by (subst diff_conv_add_uminus, rule akra_bazzi_term_ceiling_add, insert assms) simp_all

lemma akra_bazzi_term_ceiling_subtract' [akra_bazzi_term_intros]:
  assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \<le> b * real x\<^sub>1 - real c" "1 \<le> real c + (1 - b) * x\<^sub>1"
  shows   "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lceil>b*real x\<rceil> - c)"
proof-
  from assms have "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lceil>b*real x - real c\<rceil>)"
    by (intro akra_bazzi_term_ceiling_subtract) simp_all
  also have "(\<lambda>x. nat \<lceil>b*real x - real c\<rceil>) = (\<lambda>x::nat. nat \<lceil>b*real x\<rceil> - c)"
  proof
    fix x :: nat
    from assms have "0 \<le> b * real x" by simp
    also have "b * real x \<le> real_of_int \<lceil>b * real x\<rceil>" by linarith
    finally have bx_nonneg: "\<lceil>b * real x\<rceil> \<ge> 0" by simp

    have "\<lceil>b * real x - real c\<rceil> = \<lceil>b * real x\<rceil> - int c" by linarith
    also from assms bx_nonneg have "nat ... = nat \<lceil>b * real x\<rceil> - c" by simp
    finally show "nat \<lceil>b * real x - real c\<rceil> = nat \<lceil>b * real x\<rceil> - c" .
  qed
  finally show ?thesis .
qed

lemma akra_bazzi_term_ceiling [akra_bazzi_term_intros]:
  assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \<le> b * real x\<^sub>1" "1 \<le> (1 - b) * x\<^sub>1"
  shows   "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\<lambda>x. nat \<lceil>b*real x\<rceil>)"
  using assms akra_bazzi_term_ceiling_add[where c = 0] by simp

end


(*  Title:      HOL/Library/Code_Binary_Nat.thy
    Author:     Florian Haftmann, TU Muenchen
*)

section \<open>Implementation of natural numbers as binary numerals\<close>

theory Code_Binary_Nat
imports Code_Abstract_Nat
begin

text \<open>
  When generating code for functions on natural numbers, the
  canonical representation using @{term "0::nat"} and
  @{term Suc} is unsuitable for computations involving large
  numbers.  This theory refines the representation of
  natural numbers for code generation to use binary
  numerals, which do not grow linear in size but logarithmic.
\<close>

subsection \<open>Representation\<close>

code_datatype "0::nat" nat_of_num

lemma [code]:
  "(1::nat) = Numeral1"
  by simp

lemma [code_abbrev]: "Numeral1 = (1::nat)"
  by simp

lemma [code]:
  "Suc n = n + 1"
  by simp

subsection \<open>Basic arithmetic\<close>

context
begin

lemma [code, code del]:
  "(plus :: nat \<Rightarrow> _) = plus" ..

lemma plus_nat_code [code]:
  "nat_of_num k + nat_of_num l = nat_of_num (k + l)"
  "m + 0 = (m::nat)"
  "0 + n = (n::nat)"
  by (simp_all add: nat_of_num_numeral)

text \<open>Bounded subtraction needs some auxiliary\<close>

qualified definition dup :: "nat \<Rightarrow> nat" where
  "dup n = n + n"

lemma dup_code [code]:
  "dup 0 = 0"
  "dup (nat_of_num k) = nat_of_num (Num.Bit0 k)"
  by (simp_all add: dup_def numeral_Bit0)

qualified definition sub :: "num \<Rightarrow> num \<Rightarrow> nat option" where
  "sub k l = (if k \<ge> l then Some (numeral k - numeral l) else None)"

lemma sub_code [code]:
  "sub Num.One Num.One = Some 0"
  "sub (Num.Bit0 m) Num.One = Some (nat_of_num (Num.BitM m))"
  "sub (Num.Bit1 m) Num.One = Some (nat_of_num (Num.Bit0 m))"
  "sub Num.One (Num.Bit0 n) = None"
  "sub Num.One (Num.Bit1 n) = None"
  "sub (Num.Bit0 m) (Num.Bit0 n) = map_option dup (sub m n)"
  "sub (Num.Bit1 m) (Num.Bit1 n) = map_option dup (sub m n)"
  "sub (Num.Bit1 m) (Num.Bit0 n) = map_option (\<lambda>q. dup q + 1) (sub m n)"
  "sub (Num.Bit0 m) (Num.Bit1 n) = (case sub m n of None \<Rightarrow> None
     | Some q \<Rightarrow> if q = 0 then None else Some (dup q - 1))"
  apply (auto simp add: nat_of_num_numeral
    Num.dbl_def Num.dbl_inc_def Num.dbl_dec_def
    Let_def le_imp_diff_is_add BitM_plus_one sub_def dup_def)
  apply (simp_all add: sub_non_positive)
  apply (simp_all add: sub_non_negative [symmetric, where ?'a = int])
  done

lemma [code, code del]:
  "(minus :: nat \<Rightarrow> _) = minus" ..

lemma minus_nat_code [code]:
  "nat_of_num k - nat_of_num l = (case sub k l of None \<Rightarrow> 0 | Some j \<Rightarrow> j)"
  "m - 0 = (m::nat)"
  "0 - n = (0::nat)"
  by (simp_all add: nat_of_num_numeral sub_non_positive sub_def)

lemma [code, code del]:
  "(times :: nat \<Rightarrow> _) = times" ..

lemma times_nat_code [code]:
  "nat_of_num k * nat_of_num l = nat_of_num (k * l)"
  "m * 0 = (0::nat)"
  "0 * n = (0::nat)"
  by (simp_all add: nat_of_num_numeral)

lemma [code, code del]:
  "(HOL.equal :: nat \<Rightarrow> _) = HOL.equal" ..

lemma equal_nat_code [code]:
  "HOL.equal 0 (0::nat) \<longleftrightarrow> True"
  "HOL.equal 0 (nat_of_num l) \<longleftrightarrow> False"
  "HOL.equal (nat_of_num k) 0 \<longleftrightarrow> False"
  "HOL.equal (nat_of_num k) (nat_of_num l) \<longleftrightarrow> HOL.equal k l"
  by (simp_all add: nat_of_num_numeral equal)

lemma equal_nat_refl [code nbe]:
  "HOL.equal (n::nat) n \<longleftrightarrow> True"
  by (rule equal_refl)

lemma [code, code del]:
  "(less_eq :: nat \<Rightarrow> _) = less_eq" ..

lemma less_eq_nat_code [code]:
  "0 \<le> (n::nat) \<longleftrightarrow> True"
  "nat_of_num k \<le> 0 \<longleftrightarrow> False"
  "nat_of_num k \<le> nat_of_num l \<longleftrightarrow> k \<le> l"
  by (simp_all add: nat_of_num_numeral)

lemma [code, code del]:
  "(less :: nat \<Rightarrow> _) = less" ..

lemma less_nat_code [code]:
  "(m::nat) < 0 \<longleftrightarrow> False"
  "0 < nat_of_num l \<longleftrightarrow> True"
  "nat_of_num k < nat_of_num l \<longleftrightarrow> k < l"
  by (simp_all add: nat_of_num_numeral)

lemma [code, code del]:
  "Divides.divmod_nat = Divides.divmod_nat" ..

lemma divmod_nat_code [code]:
  "Divides.divmod_nat (nat_of_num k) (nat_of_num l) = divmod k l"
  "Divides.divmod_nat m 0 = (0, m)"
  "Divides.divmod_nat 0 n = (0, 0)"
  by (simp_all add: prod_eq_iff nat_of_num_numeral)

end

subsection \<open>Conversions\<close>

lemma [code, code del]:
  "of_nat = of_nat" ..

lemma of_nat_code [code]:
  "of_nat 0 = 0"
  "of_nat (nat_of_num k) = numeral k"
  by (simp_all add: nat_of_num_numeral)

code_identifier
  code_module Code_Binary_Nat \<rightharpoonup>
    (SML) Arith and (OCaml) Arith and (Haskell) Arith

end