header {* Exp Upper and Lower Bounds *}

theory Exp_Bounds
imports Bounds_Lemmas
        "~~/src/HOL/Library/Sum_of_Squares"
        "../Sturm_Sequences/Sturm"

begin

text{*Covers all bounds used in exp-upper.ax, exp-lower.ax and exp-extended.ax.*}

section {*Taylor Series Bounds*}

text{*@{text exp_positive} is the theorem @{thm Transcendental.exp_ge_zero}*}

text{*@{text exp_lower_taylor_1} is the theorem @{thm Transcendental.exp_ge_add_one_self} *}

text{*All even approximants are lower bounds.*}
lemma exp_lower_taylor_even: "even n \<Longrightarrow> (\<Sum>m<n. (x ^ m) / real (fact m)) \<le> exp x"
  using Maclaurin_exp_le [of x n]
  by (auto simp add: zero_le_divide_iff)
     (metis exp_ge_zero zero_le_mult_iff zero_le_power_iff)

lemma exp_upper_taylor_even:
  assumes n: "even n"
      and pos: "(\<Sum>m<n. ((-x) ^ m) / real (fact m)) > 0"  (is "?sum > 0")
    shows "exp x \<le> inverse ?sum"
  using exp_lower_taylor_even [OF n, of "-x"]
  by (metis exp_minus inverse_inverse_eq le_imp_inverse_le pos)

text{*3 if the previous lemma is expressed in terms of @{term "2*m"}.*}
lemma exp_lower_taylor_3:
  fixes x::real
  shows "1 + x + (1/2)*x^2 + (1/6)*x^3 + (1/24)*x^4 + (1/120)*x^5 \<le> exp x"
  by (rule order_trans [OF _ exp_lower_taylor_even [of 6]])
     (auto simp: lessThan_nat_numeral fact_numeral)

lemma exp_lower_taylor_2:
  fixes x::real
  shows "1 + x + (1/2)*x^2 + (1/6)*x^3 \<le> exp x"
proof -
  have "even (4::nat)" by simp
  then have "(\<Sum>m<4. x ^ m / real (fact m)) \<le> exp x"
    by (rule exp_lower_taylor_even)
  then show ?thesis by (auto simp add: numeral_eq_Suc)
qed

lemma exp_upper_bound_case_3:
  fixes x::real
  assumes "x \<le> 3.19"
  shows "exp x \<le> 2304 / (-(x^3) + 6*x^2 - 24*x + 48)^2"
proof -
  have "(1/48)*(-(x^3) + 6*x^2 - 24*x + 48) = (1 + (-x/2) + (1/2)*(-x/2)^2 + (1/6)*(-x/2)^3)"
    by (simp add: field_simps power2_eq_square power3_eq_cube)
  also have "... \<le> exp (-x/2)"
    by (rule exp_lower_taylor_2)
  finally have 1: "(1/48)*(-(x^3) + 6*x^2 - 24*x + 48) \<le> exp (-x/2)" .
  have "(-(x^3) + 6*x^2 - 24*x + 48)^2 / 2304 = ((1/48)*(-(x^3) + 6*x^2 - 24*x + 48))^2"
    by (simp add: field_simps power2_eq_square power3_eq_cube)
  also have "... \<le> (exp (-x/2))^2"
    apply (rule power_mono [OF 1])
    apply (simp add: algebra_simps)
    using assms
    apply (sos "((R<1 + ((R<1 * ((R<1323/13 * [~15/49*x + 1]^2) + (R<1/637 * [x]^2))) + (((A<0 * R<1) * (R<50/13 * [1]^2)) + ((A<=0 * R<1) * ((R<56/13 * [~5/56*x + 1]^2) + (R<199/728 * [x]^2)))))))")
    done
  also have "... = inverse (exp x)"
    by (metis exp_minus mult_exp_exp power2_eq_square real_sum_of_halves)
  finally have 2: "(-(x^3) + 6*x^2 - 24*x + 48)^2 / 2304 \<le> inverse (exp x)" .
  have "6 * x\<^sup>2 - x ^ 3 - 24 * x + 48 \<noteq> 0" using assms
    by (sos "((R<1 + (([~400/13] * A=0) + ((R<1 * ((R<1323/13 * [~15/49*x + 1]^2) + (R<1/637 * [x]^2))) + ((A<=0 * R<1) * ((R<56/13 * [~5/56*x + 1]^2) + (R<199/728 * [x]^2)))))))")
  then show ?thesis
    using Fields.linordered_field_class.le_imp_inverse_le [OF 2]
    by simp
qed

lemma exp_upper_bound_case_5:
  fixes x::real
  assumes "x \<le> 6.36"
  shows "exp x \<le> 21743271936 / (-(x^3) + 12*x^2 - 96*x + 384)^4"
proof -
  have "(1/384)*(-(x^3) + 12*x^2 - 96*x + 384) = (1 + (-x/4) + (1/2)*(-x/4)^2 + (1/6)*(-x/4)^3)"
    by (simp add: field_simps power2_eq_square power3_eq_cube)
  also have "... \<le> exp (-x/4)"
    by (rule exp_lower_taylor_2)
  finally have 1: "(1/384)*(-(x^3) + 12*x^2 - 96*x + 384) \<le> exp (-x/4)" .
  have "(-(x^3) + 12*x^2 - 96*x + 384)^4 / 21743271936 = ((1/384)*(-(x^3) + 12*x^2 - 96*x + 384))^4"
    by (simp add: divide_simps)
  also have "... \<le> (exp (-x/4))^4"
    apply (rule power_mono [OF 1])
    apply (simp add: algebra_simps)
    using assms
    apply (sos "((R<1 + ((R<1 * ((R<1777/32 * [~539/3554*x + 1]^2) + (R<907/227456 * [x]^2))) + (((A<0 * R<1) * (R<25/1024 * [1]^2)) + ((A<=0 * R<1) * ((R<49/32 * [~2/49*x + 1]^2) + (R<45/1568 * [x]^2)))))))")
    done
  also have "... = inverse (exp x)"
    by (simp add: exp_real_of_nat_mult [symmetric] exp_minus [symmetric])
  finally have 2: "(-(x^3) + 12*x^2 - 96*x + 384)^4 / 21743271936 \<le> inverse (exp x)" .
  have "12 * x\<^sup>2 - x ^ 3 - 96 * x + 384 \<noteq> 0" using assms
    by (sos "((R<1 + (([~25/32] * A=0) + ((R<1 * ((R<1777/32 * [~539/3554*x + 1]^2) + (R<907/227456 * [x]^2))) + ((A<=0 * R<1) * ((R<49/32 * [~2/49*x + 1]^2) + (R<45/1568 * [x]^2)))))))")
  then show ?thesis
    using Fields.linordered_field_class.le_imp_inverse_le [OF 2]
    by simp
qed

section {*Continued Fraction Bound 2*}

definition exp_cf2 :: "real \<Rightarrow> real"
  where "exp_cf2 \<equiv> \<lambda>x. (x^2 + 6*x + 12) / (x^2 - 6*x + 12)"

lemma denom_cf2_pos: fixes x::real shows "x\<^sup>2 - 6 * x + 12 > 0"
  by (sos "((R<1 + ((R<1 * ((R<5 * [~3/10*x + 1]^2) + (R<1/20 * [x]^2))) + ((A<=0 * R<1) * (R<1/2 * [1]^2)))))")

lemma numer_cf2_pos: fixes x::real shows "x\<^sup>2 + 6 * x + 12 > 0"
  by (sos "((R<1 + ((R<1 * ((R<5 * [3/10*x + 1]^2) + (R<1/20 * [x]^2))) + ((A<=0 * R<1) * (R<1/2 * [1]^2)))))")

lemma exp_cf2_pos: "exp_cf2 x > 0"
  unfolding exp_cf2_def
  by (auto simp add: divide_simps denom_cf2_pos numer_cf2_pos)

definition diff_delta_lnexp_cf2 :: "real \<Rightarrow> real"
  where "diff_delta_lnexp_cf2 \<equiv> \<lambda>x. - (x^4) / ((x^2 - 6*x + 12) * (x^2 + 6*x + 12))"

lemma d_delta_lnexp_cf2_nonpos: "diff_delta_lnexp_cf2 x \<le> 0"
unfolding diff_delta_lnexp_cf2_def
by (sos "(((R<1 + ((R<1 * ((R<5/4 * [~3/40*x^2 + 1]^2) + (R<11/1280 * [x^2]^2))) +
      ((A<1 * R<1) * (R<1/64 * [1]^2))))) & ((R<1 + ((R<1 * ((R<5/4 * [~3/40*x^2 + 1]^2) + (R<11/1280 * [x^2]^2))) + ((A<1 * R<1) * (R<1/64 * [1]^2))))))")

lemma d_delta_lnexp_cf2:
    "((\<lambda>x. ln (exp_cf2 x) - x) has_field_derivative diff_delta_lnexp_cf2 x) (at x)"
  unfolding exp_cf2_def diff_delta_lnexp_cf2_def
  apply (intro derivative_eq_intros | simp)+
  apply (metis exp_cf2_def exp_cf2_pos)
  apply (simp_all add: )
  using denom_cf2_pos [of x] numer_cf2_pos [of x]
  apply (auto simp: divide_simps)
  apply algebra
  done

text{*Upper bound for non-positive x*}
lemma ln_exp_cf2_upper_bound_neg:
  assumes "x \<le> 0"
    shows "x \<le> ln (exp_cf2 x)"
  by (rule gen_upper_bound_decreasing [OF assms d_delta_lnexp_cf2 d_delta_lnexp_cf2_nonpos])
     (simp add: exp_cf2_def)

theorem exp_cf2_upper_bound_neg: "x\<le>0 \<Longrightarrow> exp(x) \<le> exp_cf2 x"
  by (metis ln_exp_cf2_upper_bound_neg exp_cf2_pos exp_le_cancel_iff exp_ln_iff)

text{*Lower bound for non-negative x*}
lemma ln_exp_cf2_lower_bound_pos:
  assumes "0\<le>x"
    shows "ln (exp_cf2 x) \<le> x"
  by (rule gen_lower_bound_increasing [OF assms d_delta_lnexp_cf2 d_delta_lnexp_cf2_nonpos])
     (simp add: exp_cf2_def)

theorem exp_cf2_lower_bound_pos: "0\<le>x \<Longrightarrow> exp_cf2 x \<le> exp x"
  by (metis exp_cf2_pos exp_le_cancel_iff exp_ln ln_exp_cf2_lower_bound_pos)

section {*Continued Fraction Bound 3*}

text{*This bound crosses the X-axis twice, causing complications.*}

definition numer_cf3 :: "real \<Rightarrow> real"
  where "numer_cf3 \<equiv> \<lambda>x. x^3 + 12*x^2 + 60*x + 120"

definition exp_cf3 :: "real \<Rightarrow> real"
  where "exp_cf3 \<equiv> \<lambda>x. numer_cf3 x / numer_cf3 (-x)"

lemma numer_cf3_pos: "-4.64 \<le> x \<Longrightarrow> numer_cf3 x > 0"
  unfolding numer_cf3_def
  by sturm

lemma exp_cf3_pos: "numer_cf3 x > 0 \<Longrightarrow> numer_cf3 (-x) > 0 \<Longrightarrow> exp_cf3 x > 0"
  by (simp add: exp_cf3_def)

definition diff_delta_lnexp_cf3 :: "real \<Rightarrow> real"
  where "diff_delta_lnexp_cf3 \<equiv> \<lambda>x. (x^6) / (numer_cf3 (-x) * numer_cf3 x)"

lemma d_delta_lnexp_cf3_nonneg: "numer_cf3 x > 0 \<Longrightarrow> numer_cf3 (-x) > 0 \<Longrightarrow> diff_delta_lnexp_cf3 x \<ge> 0"
  unfolding diff_delta_lnexp_cf3_def
  by (auto simp: mult_less_0_iff intro: divide_nonneg_neg)

lemma d_delta_lnexp_cf3:
  assumes "numer_cf3 x > 0" "numer_cf3 (-x) > 0"
  shows "((\<lambda>x. ln (exp_cf3 x) - x) has_field_derivative diff_delta_lnexp_cf3 x) (at x)"
unfolding exp_cf3_def numer_cf3_def diff_delta_lnexp_cf3_def
apply (intro derivative_eq_intros | simp)+
using assms numer_cf3_pos [of x] numer_cf3_pos [of "-x"]
apply (auto simp: numer_cf3_def)
apply (auto simp add: divide_simps add_nonneg_eq_0_iff)
apply algebra
done

lemma numer_cf3_mono: "y \<le> x \<Longrightarrow> numer_cf3 y \<le> numer_cf3 x"
  unfolding numer_cf3_def
  by (sos "(((A<0 * R<1) + ((A<=0 * R<1) * ((R<60 * [1/10*x + 1/10*y + 1]^2) +
                ((R<2/5 * [x + ~1/4*y]^2) + (R<3/8 * [y]^2))))))")

text{*Upper bound for non-negative x*}
lemma ln_exp_cf3_upper_bound_nonneg:
  assumes x0: "0 \<le> x" and xless: "numer_cf3 (-x) > 0"
    shows "x \<le> ln (exp_cf3 x)"
proof -
  have ncf3: "\<And>y. 0 \<le> y \<Longrightarrow> y \<le> x \<Longrightarrow> numer_cf3 (-y) > 0"
    by (metis neg_le_iff_le numer_cf3_mono order.strict_trans2 xless)
  show ?thesis
    apply (rule gen_upper_bound_increasing [OF x0 d_delta_lnexp_cf3 d_delta_lnexp_cf3_nonneg])
    apply (auto simp add: ncf3 assms numer_cf3_pos)
    apply (simp add: exp_cf3_def numer_cf3_def)
    done
qed

theorem exp_cf3_upper_bound_pos: "0 \<le> x \<Longrightarrow> numer_cf3 (-x) > 0 \<Longrightarrow> exp x \<le> exp_cf3 x"
  using ln_exp_cf3_upper_bound_nonneg [of x] exp_cf3_pos [of x] numer_cf3_pos [of x]
  by auto (metis exp_le_cancel_iff exp_ln_iff)

corollary "0 \<le> x \<Longrightarrow> x \<le> 4.64 \<Longrightarrow> exp x \<le> exp_cf3 x"
  by (metis minus_divide_left numer_cf3_pos neg_le_iff_le exp_cf3_upper_bound_pos)

text{*Lower bound for negative x, provided @{term"exp_cf3 x > 0"}]*}
lemma ln_exp_cf3_lower_bound_neg:
  assumes x0: "x \<le> 0" and xgtr: "numer_cf3 x > 0"
    shows "ln (exp_cf3 x) \<le> x"
proof -
  have ncf3: "\<And>y. x \<le> y \<Longrightarrow> y \<le> 0 \<Longrightarrow> numer_cf3 y > 0"
    by (metis dual_order.strict_trans1 numer_cf3_mono xgtr)
  show ?thesis
    apply (rule gen_lower_bound_decreasing [OF x0 d_delta_lnexp_cf3 d_delta_lnexp_cf3_nonneg])
    apply (auto simp add: ncf3 assms numer_cf3_pos)
    apply (simp add: exp_cf3_def numer_cf3_def)
    done
qed

theorem exp_cf3_lower_bound_pos:
  assumes "x \<le> 0" shows "exp_cf3 x \<le> exp x"
proof (cases "numer_cf3 x > 0")
  case True
  then have "exp_cf3 x > 0"
    using assms numer_cf3_pos [of "-x"]
    by (auto simp: exp_cf3_pos)
  then show ?thesis
  using ln_exp_cf3_lower_bound_neg [of x] assms True
    by auto (metis exp_le_cancel_iff exp_ln_iff)
next
  case False
  then have "exp_cf3 x \<le> 0"
    using assms numer_cf3_pos [of "-x"]
    unfolding exp_cf3_def
    by (simp add: divide_nonpos_pos)
  then show ?thesis
    by (metis exp_ge_zero order.trans)
qed

section {*Continued Fraction Bound 4*}

text {*Here we have the extended exp continued fraction bounds*}

definition numer_cf4 :: "real \<Rightarrow> real"
  where "numer_cf4 \<equiv> \<lambda>x. x^4 + 20*x^3 + 180*x^2 + 840*x + 1680"

definition exp_cf4 :: "real \<Rightarrow> real"
  where "exp_cf4 \<equiv> \<lambda>x. numer_cf4 x / numer_cf4 (-x)"

lemma numer_cf4_pos: fixes x::real shows "numer_cf4 x > 0"
unfolding numer_cf4_def
by (sos "((R<1 + ((R<1 * ((R<4469/256 * [1135/71504*x^2 + 4725/17876*x + 1]^2) + ((R<3728645/18305024 * [536265/2982916*x^2 + x]^2) + (R<106265/24436047872 * [x^2]^2)))) + ((A<=0 * R<1) * (R<45/4096 * [1]^2)))))")

lemma exp_cf4_pos: "exp_cf4 x > 0"
  unfolding exp_cf4_def
  by (auto simp add: divide_simps numer_cf4_pos)

definition diff_delta_lnexp_cf4 :: "real \<Rightarrow> real"
  where "diff_delta_lnexp_cf4 \<equiv> \<lambda>x. - (x^8) / (numer_cf4 (-x) * numer_cf4 x)"

lemma d_delta_lnexp_cf4_nonpos: "diff_delta_lnexp_cf4 x \<le> 0"
  unfolding diff_delta_lnexp_cf4_def
  using numer_cf4_pos [of x] numer_cf4_pos [of "-x"]
  by (simp add: zero_le_divide_iff zero_le_mult_iff)

lemma d_delta_lnexp_cf4:
    "((\<lambda>x. ln (exp_cf4 x) - x) has_field_derivative diff_delta_lnexp_cf4 x) (at x)"
  unfolding exp_cf4_def numer_cf4_def diff_delta_lnexp_cf4_def
  apply (intro derivative_eq_intros | simp)+
  using exp_cf4_pos
  apply (simp add: exp_cf4_def numer_cf4_def)
  apply (simp_all add: )
  using numer_cf4_pos [of x]  numer_cf4_pos [of "-x"]
  apply (auto simp: divide_simps numer_cf4_def)
  apply algebra
  done

text{*Upper bound for non-positive x*}
lemma ln_exp_cf4_upper_bound_neg:
  assumes "x \<le> 0"
    shows "x \<le> ln (exp_cf4 x)"
  by (rule gen_upper_bound_decreasing [OF assms d_delta_lnexp_cf4 d_delta_lnexp_cf4_nonpos])
     (simp add: exp_cf4_def numer_cf4_def)

theorem exp_cf4_upper_bound_neg: "x\<le>0 \<Longrightarrow> exp(x) \<le> exp_cf4 x"
  by (metis ln_exp_cf4_upper_bound_neg exp_cf4_pos exp_le_cancel_iff exp_ln_iff)

text{*Lower bound for non-negative x*}
lemma ln_exp_cf4_lower_bound_pos:
  assumes "0\<le>x"
    shows "ln (exp_cf4 x) \<le> x"
  by (rule gen_lower_bound_increasing [OF assms d_delta_lnexp_cf4 d_delta_lnexp_cf4_nonpos])
     (simp add: exp_cf4_def numer_cf4_def)

theorem exp_cf4_lower_bound_pos: "0\<le>x \<Longrightarrow> exp_cf4 x \<le> exp x"
  by (metis exp_cf4_pos exp_le_cancel_iff exp_ln ln_exp_cf4_lower_bound_pos)

section {*Continued Fraction Bound 5*}

text{*This bound crosses the X-axis twice, causing complications.*}

definition numer_cf5 :: "real \<Rightarrow> real"
  where "numer_cf5 \<equiv> \<lambda>x. x^5 + 30*x^4 + 420*x^3 + 3360*x^2 + 15120*x + 30240"

definition exp_cf5 :: "real \<Rightarrow> real"
  where "exp_cf5 \<equiv> \<lambda>x. numer_cf5 x / numer_cf5 (-x)"

lemma numer_cf5_pos: "-7.293 \<le> x \<Longrightarrow> numer_cf5 x > 0"
  unfolding numer_cf5_def
  by sturm

lemma exp_cf5_pos: "numer_cf5 x > 0 \<Longrightarrow> numer_cf5 (-x) > 0 \<Longrightarrow> exp_cf5 x > 0"
  unfolding exp_cf5_def numer_cf5_def
  by (simp add: divide_neg_neg)

definition diff_delta_lnexp_cf5 :: "real \<Rightarrow> real"
  where "diff_delta_lnexp_cf5 \<equiv> \<lambda>x. (x^10) / (numer_cf5 (-x) * numer_cf5 x)"

lemma d_delta_lnexp_cf5_nonneg: "numer_cf5 x > 0 \<Longrightarrow> numer_cf5 (-x) > 0 \<Longrightarrow> diff_delta_lnexp_cf5 x \<ge> 0"
  unfolding diff_delta_lnexp_cf5_def
  by (auto simp add: mult_less_0_iff intro: divide_nonneg_neg )

lemma d_delta_lnexp_cf5:
  assumes "numer_cf5 x > 0" "numer_cf5 (-x) > 0"
  shows "((\<lambda>x. ln (exp_cf5 x) - x) has_field_derivative diff_delta_lnexp_cf5 x) (at x)"
unfolding exp_cf5_def numer_cf5_def diff_delta_lnexp_cf5_def
apply (intro derivative_eq_intros | simp)+
using assms numer_cf5_pos [of x] numer_cf5_pos [of "-x"]
apply (auto simp: numer_cf5_def)
apply (auto simp add: divide_simps add_nonneg_eq_0_iff)
apply algebra
done

subsection{*Proving monotonicity via a non-negative derivative*}

definition numer_cf5_deriv :: "real \<Rightarrow> real"
  where "numer_cf5_deriv \<equiv> \<lambda>x. 5*x^4 + 120*x^3 + 1260*x^2 + 6720*x + 15120"

lemma numer_cf5_deriv:
  shows "(numer_cf5 has_field_derivative numer_cf5_deriv x) (at x)"
  unfolding numer_cf5_def numer_cf5_deriv_def
  by (intro derivative_eq_intros | simp)+

lemma numer_cf5_deriv_pos: "numer_cf5_deriv x \<ge> 0"
  unfolding numer_cf5_deriv_def
  by (sos "((R<1 + ((R<1 * ((R<185533/8192 * [73459/5937056*x^2 + 43050/185533*x + 1]^2) + ((R<4641265253/24318181376 * [700850925/4641265253*x^2 + x]^2) + (R<38142496079/38933754831437824 * [x^2]^2)))) + ((A<0 * R<1) * (R<205/131072 * [1]^2)))))")

lemma numer_cf5_mono: "y \<le> x \<Longrightarrow> numer_cf5 y \<le> numer_cf5 x"
  by (auto intro: DERIV_nonneg_imp_nondecreasing numer_cf5_deriv numer_cf5_deriv_pos)

subsection{*Results*}

text{*Upper bound for non-negative x*}
lemma ln_exp_cf5_upper_bound_nonneg:
  assumes x0: "0 \<le> x" and xless: "numer_cf5 (-x) > 0"
    shows "x \<le> ln (exp_cf5 x)"
proof -
  have ncf5: "\<And>y. 0 \<le> y \<Longrightarrow> y \<le> x \<Longrightarrow> numer_cf5 (-y) > 0"
    by (metis neg_le_iff_le numer_cf5_mono order.strict_trans2 xless)
  show ?thesis
    apply (rule gen_upper_bound_increasing [OF x0 d_delta_lnexp_cf5 d_delta_lnexp_cf5_nonneg])
    apply (auto simp add: ncf5 assms numer_cf5_pos)
    apply (simp add: exp_cf5_def numer_cf5_def)
    done
qed

theorem exp_cf5_upper_bound_pos: "0 \<le> x \<Longrightarrow> numer_cf5 (-x) > 0 \<Longrightarrow> exp x \<le> exp_cf5 x"
  using ln_exp_cf5_upper_bound_nonneg [of x] exp_cf5_pos [of x] numer_cf5_pos [of x]
  by auto (metis exp_le_cancel_iff exp_ln_iff)

corollary "0 \<le> x \<Longrightarrow> x \<le> 7.293 \<Longrightarrow> exp x \<le> exp_cf5 x"
  by (metis minus_divide_left neg_le_iff_le numer_cf5_pos exp_cf5_upper_bound_pos)

text{*Lower bound for negative x, provided @{term"exp_cf5 x > 0"}]*}
lemma ln_exp_cf5_lower_bound_neg:
  assumes x0: "x \<le> 0" and xgtr: "numer_cf5 x > 0"
    shows "ln (exp_cf5 x) \<le> x"
proof -
  have ncf5: "\<And>y. x \<le> y \<Longrightarrow> y \<le> 0 \<Longrightarrow> numer_cf5 y > 0"
    by (metis dual_order.strict_trans1 numer_cf5_mono xgtr)
  show ?thesis
    apply (rule gen_lower_bound_decreasing [OF x0 d_delta_lnexp_cf5 d_delta_lnexp_cf5_nonneg])
    apply (auto simp add: ncf5 assms numer_cf5_pos)
    apply (simp add: exp_cf5_def numer_cf5_def)
    done
qed

theorem exp_cf5_lower_bound_pos:
  assumes "x \<le> 0" shows "exp_cf5 x \<le> exp x"
proof (cases "numer_cf5 x > 0")
  case True
  then have "exp_cf5 x > 0"
    using assms numer_cf5_pos [of "-x"]
    by (auto simp: exp_cf5_pos)
  then show ?thesis
  using ln_exp_cf5_lower_bound_neg [of x] assms True
    by auto (metis exp_le_cancel_iff exp_ln_iff)
next
  case False
  then have "exp_cf5 x \<le> 0"
    using assms numer_cf5_pos [of "-x"]
    unfolding exp_cf5_def numer_cf5_def
    by (simp add: divide_nonpos_pos)
  then show ?thesis
    by (metis exp_ge_zero order.trans)
qed

section {*Continued Fraction Bound 6*}

definition numer_cf6 :: "real \<Rightarrow> real"
  where "numer_cf6 \<equiv> \<lambda>x. x^6 + 42*x^5 + 840*x^4 + 10080*x^3 + 75600*x^2 + 332640*x + 665280"

definition exp_cf6 :: "real \<Rightarrow> real"
  where "exp_cf6 \<equiv> \<lambda>x. numer_cf6 x / numer_cf6 (-x)"

lemma numer_cf6_pos: fixes x::real shows "numer_cf6 x > 0"
  unfolding numer_cf6_def
  by sturm

lemma exp_cf6_pos: "exp_cf6 x > 0"
  unfolding exp_cf6_def
  by (auto simp add: divide_simps numer_cf6_pos)

definition diff_delta_lnexp_cf6 :: "real \<Rightarrow> real"
  where "diff_delta_lnexp_cf6 \<equiv> \<lambda>x. - (x^12) / (numer_cf6 (-x) * numer_cf6 x)"

lemma d_delta_lnexp_cf6_nonpos: "diff_delta_lnexp_cf6 x \<le> 0"
  unfolding diff_delta_lnexp_cf6_def
  using numer_cf6_pos [of x]  numer_cf6_pos [of "-x"]
  by (simp add: zero_le_divide_iff zero_le_mult_iff)

lemma d_delta_lnexp_cf6:
    "((\<lambda>x. ln (exp_cf6 x) - x) has_field_derivative diff_delta_lnexp_cf6 x) (at x)"
  unfolding exp_cf6_def diff_delta_lnexp_cf6_def numer_cf6_def
  apply (intro derivative_eq_intros | simp)+
  using exp_cf6_pos
  apply (simp add: exp_cf6_def numer_cf6_def)
  apply (simp_all add: )
  using numer_cf6_pos [of x]  numer_cf6_pos [of "-x"]
  apply (auto simp: divide_simps numer_cf6_def)
  apply algebra
  done

text{*Upper bound for non-positive x*}
lemma ln_exp_cf6_upper_bound_neg:
  assumes "x \<le> 0"
    shows "x \<le> ln (exp_cf6 x)"
  by (rule gen_upper_bound_decreasing [OF assms d_delta_lnexp_cf6 d_delta_lnexp_cf6_nonpos])
     (simp add: exp_cf6_def numer_cf6_def)

theorem exp_cf6_upper_bound_neg: "x\<le>0 \<Longrightarrow> exp(x) \<le> exp_cf6 x"
  by (metis ln_exp_cf6_upper_bound_neg exp_cf6_pos exp_le_cancel_iff exp_ln_iff)

text{*Lower bound for non-negative x*}
lemma ln_exp_cf6_lower_bound_pos:
  assumes "0\<le>x"
    shows "ln (exp_cf6 x) \<le> x"
  by (rule gen_lower_bound_increasing [OF assms d_delta_lnexp_cf6 d_delta_lnexp_cf6_nonpos])
     (simp add: exp_cf6_def numer_cf6_def)

theorem exp_cf6_lower_bound_pos: "0\<le>x \<Longrightarrow> exp_cf6 x \<le> exp x"
  by (metis exp_cf6_pos exp_le_cancel_iff exp_ln ln_exp_cf6_lower_bound_pos)

section {*Continued Fraction Bound 7*}

text{*This bound crosses the X-axis twice, causing complications.*}

definition numer_cf7 :: "real \<Rightarrow> real"
  where "numer_cf7 \<equiv> \<lambda>x. x^7 + 56*x^6 + 1512*x^5 + 25200*x^4 + 277200*x^3 + 1995840*x^2 + 8648640*x + 17297280"

definition exp_cf7 :: "real \<Rightarrow> real"
  where "exp_cf7 \<equiv> \<lambda>x. numer_cf7 x / numer_cf7 (-x)"

lemma numer_cf7_pos: "-9.943 \<le> x \<Longrightarrow> numer_cf7 x > 0"
  unfolding numer_cf7_def
  by sturm

lemma exp_cf7_pos: "numer_cf7 x > 0 \<Longrightarrow> numer_cf7 (-x) > 0 \<Longrightarrow> exp_cf7 x > 0"
  by (simp add: exp_cf7_def)

definition diff_delta_lnexp_cf7 :: "real \<Rightarrow> real"
  where "diff_delta_lnexp_cf7 \<equiv> \<lambda>x. (x^14) / (numer_cf7 (-x) * numer_cf7 x)"

lemma d_delta_lnexp_cf7_nonneg: "numer_cf7 x > 0 \<Longrightarrow> numer_cf7 (-x) > 0 \<Longrightarrow> diff_delta_lnexp_cf7 x \<ge> 0"
  unfolding diff_delta_lnexp_cf7_def
  by (auto simp: mult_less_0_iff intro: divide_nonneg_neg)

lemma d_delta_lnexp_cf7:
  assumes "numer_cf7 x > 0" "numer_cf7 (-x) > 0"
  shows "((\<lambda>x. ln (exp_cf7 x) - x) has_field_derivative diff_delta_lnexp_cf7 x) (at x)"
unfolding exp_cf7_def numer_cf7_def diff_delta_lnexp_cf7_def
apply (intro derivative_eq_intros | simp)+
using assms numer_cf7_pos [of x] numer_cf7_pos [of "-x"]
apply (auto simp: numer_cf7_def)
apply (auto simp: divide_simps add_nonneg_eq_0_iff)
apply algebra
done

subsection{*Proving monotonicity via a non-negative derivative*}

definition numer_cf7_deriv :: "real \<Rightarrow> real"
  where "numer_cf7_deriv \<equiv> \<lambda>x. 7*x^6 + 336*x^5 + 7560*x^4 + 100800*x^3 + 831600*x^2 + 3991680*x + 8648640"

lemma numer_cf7_deriv:
  shows "(numer_cf7 has_field_derivative numer_cf7_deriv x) (at x)"
  unfolding numer_cf7_def numer_cf7_deriv_def
  by (intro derivative_eq_intros | simp)+

lemma numer_cf7_deriv_pos: "numer_cf7_deriv x \<ge> 0"
  unfolding numer_cf7_deriv_def
  apply (rule order.strict_implies_order)  --{*FIXME should not be necessary*}
  by sturm

lemma numer_cf7_mono: "y \<le> x \<Longrightarrow> numer_cf7 y \<le> numer_cf7 x"
  by (auto intro: DERIV_nonneg_imp_nondecreasing numer_cf7_deriv numer_cf7_deriv_pos)

subsection{*Results*}

text{*Upper bound for non-negative x*}
lemma ln_exp_cf7_upper_bound_nonneg:
  assumes x0: "0 \<le> x" and xless: "numer_cf7 (-x) > 0"
    shows "x \<le> ln (exp_cf7 x)"
proof -
  have ncf7: "\<And>y. 0 \<le> y \<Longrightarrow> y \<le> x \<Longrightarrow> numer_cf7 (-y) > 0"
    by (metis neg_le_iff_le numer_cf7_mono order.strict_trans2 xless)
  show ?thesis
    apply (rule gen_upper_bound_increasing [OF x0 d_delta_lnexp_cf7 d_delta_lnexp_cf7_nonneg])
    apply (auto simp add: ncf7 assms numer_cf7_pos)
    apply (simp add: exp_cf7_def numer_cf7_def)
    done
qed

theorem exp_cf7_upper_bound_pos: "0 \<le> x \<Longrightarrow> numer_cf7 (-x) > 0 \<Longrightarrow> exp x \<le> exp_cf7 x"
  using ln_exp_cf7_upper_bound_nonneg [of x] exp_cf7_pos [of x] numer_cf7_pos [of x]
  by auto (metis exp_le_cancel_iff exp_ln_iff)

corollary "0 \<le> x \<Longrightarrow> x \<le> 9.943 \<Longrightarrow> exp x \<le> exp_cf7 x"
  by (metis minus_divide_left neg_le_iff_le numer_cf7_pos exp_cf7_upper_bound_pos)

text{*Lower bound for negative x, provided @{term"exp_cf7 x > 0"}]*}
lemma ln_exp_cf7_lower_bound_neg:
  assumes x0: "x \<le> 0" and xgtr: "numer_cf7 x > 0"
    shows "ln (exp_cf7 x) \<le> x"
proof -
  have ncf7: "\<And>y. x \<le> y \<Longrightarrow> y \<le> 0 \<Longrightarrow> numer_cf7 y > 0"
    by (metis dual_order.strict_trans1 numer_cf7_mono xgtr)
  show ?thesis
    apply (rule gen_lower_bound_decreasing [OF x0 d_delta_lnexp_cf7 d_delta_lnexp_cf7_nonneg])
    apply (auto simp add: ncf7 assms numer_cf7_pos)
    apply (simp add: exp_cf7_def numer_cf7_def)
    done
qed

theorem exp_cf7_lower_bound_pos:
  assumes "x \<le> 0" shows "exp_cf7 x \<le> exp x"
proof (cases "numer_cf7 x > 0")
  case True
  then have "exp_cf7 x > 0"
    using assms numer_cf7_pos [of "-x"]
    by (auto simp: exp_cf7_pos)
  then show ?thesis
  using ln_exp_cf7_lower_bound_neg [of x] assms True
    by auto (metis exp_le_cancel_iff exp_ln_iff)
next
  case False
  then have "exp_cf7 x \<le> 0"
    using assms numer_cf7_pos [of "-x"]
    unfolding exp_cf7_def
    by (simp add: divide_nonpos_pos)
  then show ?thesis
    by (metis exp_ge_zero order.trans)
qed

end


(* Author: Alexander Bentkamp, Universität des Saarlandes
*)
section \<open>Shallow Network Model\<close>

theory DL_Shallow_Model
imports DL_Network Tensor_Rank
begin

fun shallow_model' where
"shallow_model' Z M 0 = Conv (Z,M) (Input M)" |
"shallow_model' Z M (Suc N) = Pool (shallow_model' Z M 0) (shallow_model' Z M N)"

definition shallow_model where
"shallow_model Y Z M N = Conv (Y,Z) (shallow_model' Z M N)"

lemma valid_shallow_model': "valid_net (shallow_model' Z M N)"
  apply (induction N) unfolding shallow_model'.simps
  by (simp add: valid_net.intros, metis shallow_model'.elims shallow_model'.simps(1) valid_net.intros output_size.simps)

lemma output_size_shallow_model': "output_size (shallow_model' Z M N) = Z"
  apply (induction N) unfolding shallow_model'.simps using output_size.simps by simp_all

lemma valid_shallow_model: "valid_net (shallow_model Y Z M N)"
  unfolding shallow_model_def using valid_shallow_model' valid_net.intros output_size.simps output_size_shallow_model' by metis

lemma output_size_shallow_model: "output_size (shallow_model Y Z M N) = Y"
  unfolding shallow_model_def using output_size_shallow_model' output_size.simps by simp

lemma input_sizes_shallow_model: "input_sizes (shallow_model Y Z M N) = replicate (Suc N) M"
  apply (induction N) unfolding shallow_model_def input_sizes.simps by simp_all

lemma balanced_net_shallow_model': "balanced_net (shallow_model' Z M N)"
proof(induction N)
case 0
  then show ?case
    by (metis balanced_net.simps shallow_model'.simps(1))
next
  case (Suc N)
  have "count_weights True (Conv (Z, M) (Input M)) = count_weights True (shallow_model' Z M N)"
    by (induction N; simp)
  then show ?case unfolding shallow_model'.simps
  by (simp add: Suc.IH balanced_net_Conv balanced_net_Input balanced_net_Pool)
qed

lemma balanced_net_shallow_model: "balanced_net (shallow_model Y Z M N)"
  unfolding shallow_model_def
  by (simp add: balanced_net_Conv balanced_net_shallow_model')

lemma cprank_max1_shallow_model':
assumes "y < output_size (shallow_model' Z M N)"
shows "cprank_max1 (tensors_from_net (insert_weights s (shallow_model' Z M N) w) $ y)"
  using assms proof (induction N arbitrary:w)
  case 0
  then have "input_sizes (insert_weights s (shallow_model' Z M 0) w) = [M]"
    unfolding shallow_model_def shallow_model'.simps insert_weights.simps
    input_sizes.simps by metis
  then have "dims (tensors_from_net (insert_weights s (shallow_model' Z M 0) w) $ y) = [M]"
    using dims_tensors_from_net[OF vec_setI] "0.prems"(1) output_size_correct_tensors
    remove_insert_weights valid_shallow_model' by metis
  then show ?case
    using order1 by (metis One_nat_def eq_imp_le length_Cons list.size(3))
next
  case (Suc N)
  have y_le_IH:"y < dim_vec (tensors_from_net (insert_weights s (shallow_model' Z M N) (\<lambda>i. w (i + (count_weights s (shallow_model' Z M 0))))))"
    using output_size_correct_tensors[of "insert_weights s (shallow_model' Z M N) (\<lambda>i. w (i + (count_weights s (shallow_model' Z M 0))))",
    unfolded remove_insert_weights, OF valid_shallow_model']
    using Suc.prems(1) output_size_shallow_model' by auto
  have cprank_max1_IH:"cprank_max1 (tensors_from_net (insert_weights s (shallow_model' Z M N) (\<lambda>i. w (i + (count_weights s (shallow_model' Z M 0))))) $ y)"
    using Suc.IH Suc.prems(1) output_size_shallow_model' by auto
  have y_le_0:"y < dim_vec (tensors_from_net (insert_weights s (shallow_model' Z M 0) w))"
    by (metis assms output_size_correct_tensors output_size_shallow_model' remove_insert_weights valid_shallow_model')
  have cprank_max1_0:"cprank_max1 (tensors_from_net (insert_weights s (shallow_model' Z M 0) w) $ y)"
  proof -
    have "input_sizes (insert_weights s (shallow_model' Z M 0) w) = [M]"
      unfolding shallow_model_def shallow_model'.simps insert_weights.simps
      input_sizes.simps by metis
    then show ?thesis using order1 dims_tensors_from_net[OF vec_setI]  One_nat_def eq_imp_le length_Cons list.size(3) y_le_0 by metis
  qed
  then show ?case unfolding shallow_model'.simps(2) insert_weights.simps tensors_from_net.simps
    using cprank_max1_IH cprank_max1_0 cprank_max1_prod index_component_mult y_le_0 y_le_IH
    by (metis Suc.IH output_size_correct_tensors remove_insert_weights valid_shallow_model')
qed

lemma cprank_shallow_model:
assumes "m = insert_weights s (shallow_model Y Z M N) w"
assumes "y < Y"
shows "cprank (tensors_from_net m $ y) \<le> Z"
proof -
  have "s \<Longrightarrow> shared_weight_net m"
    by (simp add: assms(1) balanced_net_shallow_model shared_weight_net_insert_weights)
  have "cprank_max Z (tensors_from_net m $ y)"
  proof -
    have dim_extract: "dim_row (extract_matrix w Y Z) = Y"
      using dim_extract_matrix(1) by force
    have dimc_extract_matrix: "dim_col (extract_matrix w Y Z) = Z"
      using dim_extract_matrix(2) by force
    have input_sizes: "(input_sizes (insert_weights s (shallow_model' Z M N) (\<lambda>i. w (i + Y * Z)))) = (input_sizes (shallow_model' Z M N))"
      using input_sizes_remove_weights remove_insert_weights by auto
    have 0:"tensors_from_net m $ y = Tensor_Plus.listsum (input_sizes (shallow_model' Z M N))
      (map (\<lambda>j. (extract_matrix w Y Z)  $$ (y, j) \<cdot> (tensors_from_net (insert_weights s (shallow_model' Z M N) (\<lambda>i. w (i + Y * Z)))) $ j) [0..<Z])"
      unfolding \<open>m = insert_weights s (shallow_model Y Z M N) w\<close> shallow_model_def insert_weights.simps tensors_from_net.simps
      using nth_mat_tensorlist_mult dims_tensors_from_net assms(2) dim_extract output_size_correct_tensors[of "insert_weights s (shallow_model' Z M N) (\<lambda>i. w (i + Y * Z))", unfolded remove_insert_weights, OF valid_shallow_model']
      dimc_extract_matrix output_size_shallow_model' input_sizes by auto

    define Bs where "Bs = map (\<lambda>j. extract_matrix w Y Z $$ (y, j) \<cdot> tensors_from_net (insert_weights s (shallow_model' Z M N) (\<lambda>i. w (i + Y * Z))) $ j) [0..<Z]"

    have "\<And>B. B \<in> set Bs \<Longrightarrow> cprank_max1 B" "\<And>B. B \<in> set Bs \<Longrightarrow> dims B = input_sizes (shallow_model' Z M N)"
    proof -
      fix B assume "B \<in> set Bs"
      then obtain j where "B = Bs ! j" "j < length Bs" by (metis in_set_conv_nth)
      then have "j < Z" using length_map Bs_def by simp
      have 1:"cprank_max1 (tensors_from_net (insert_weights s (shallow_model' Z M N) (\<lambda>i. w (i + Y * Z))) $ j)"
        using \<open>j < Z\<close> output_size_shallow_model' cprank_max1_shallow_model' by auto
      then have "cprank_max1 (extract_matrix w Y Z $$ (y, j) \<cdot> tensors_from_net (insert_weights s (shallow_model' Z M N) (\<lambda>i. w (i + Y * Z))) $ j)"
        using smult_prod_extract1 cprank_max1_order0[OF 1, of "extract_matrix w Y Z $$ (y, j) \<cdot> 1"]
        by (metis dims_smult mult.left_neutral order_tensor_one)
      then show "cprank_max1 B" by (simp add: Bs_def \<open>B = Bs ! j\<close> \<open>j < Z\<close>)
      show "dims B = input_sizes (shallow_model' Z M N)" unfolding \<open>B = Bs ! j\<close> Bs_def
        nth_map[of j "[0..<Z]", unfolded length_upt Nat.diff_0, OF \<open>j < Z\<close>] dims_smult
        input_sizes[symmetric]
        by (rule dims_tensors_from_net; rule vec_setI[where i=j], simp add:\<open>j < Z\<close>, metis (no_types) \<open>j < Z\<close> output_size_correct_tensors output_size_shallow_model' remove_insert_weights valid_shallow_model')
    qed
    then show ?thesis unfolding 0 using cprank_maxI length_map Bs_def by (metis (no_types, lifting) diff_zero length_upt)
  qed
  then show ?thesis unfolding cprank_def by (simp add: Least_le)
qed

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_list_elem_map
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun map :: "('a => 'b) => 'a list => 'b list" where
"map f (nil2) = nil2"
| "map f (cons2 y xs) = cons2 (f y) (map f xs)"

fun elem :: "'a => 'a list => bool" where
"elem x (nil2) = False"
| "elem x (cons2 z xs) = ((z = x) | (elem x xs))"

theorem property0 :
  "((elem y (map f xs)) ==>
      (? (x :: 'a) . (((f x) = y) & (elem y xs))))"
  oops

end


(* Property from Case-Analysis for Rippling and Inductive Proof,
   Moa Johansson, Lucas Dixon and Alan Bundy, ITP 2010.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_prop_73
  imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun rev :: "'a list => 'a list" where
  "rev (nil2) = nil2"
| "rev (cons2 z xs) = x (rev xs) (cons2 z (nil2))"

fun filter :: "('a => bool) => 'a list => 'a list" where
  "filter y (nil2) = nil2"
| "filter y (cons2 z2 xs) =
     (if y z2 then cons2 z2 (filter y xs) else filter y xs)"

theorem property0 :
  "((rev (filter p xs)) = (filter p (rev xs)))"
  oops

end


(*<*)
theory Abstract_Monitor
  imports Trace Table
begin
(*>*)

section \<open>Abstract monitors and slicing\<close>

subsection \<open>First-order specifications\<close>

text \<open>
  We abstract from first-order trace specifications by referring only to their
  semantics. A first-order specification is described by a finite set of free
  variables and a satisfaction function that defines for every trace the pairs
  of valuations and time-points for which the specification is satisfied.
  The specification can be restricted to a set of traces to which it applies.
\<close>

locale fo_spec =
  fixes
    nfv :: nat and fv :: "nat set" and
    traces :: "'a trace set" and
    sat :: "'a trace \<Rightarrow> 'b list \<Rightarrow> nat \<Rightarrow> bool"
  assumes
    fv_less_nfv: "x \<in> fv \<Longrightarrow> x < nfv" and
    sat_fv_cong: "\<sigma> \<in> traces \<Longrightarrow> (\<And>x. x \<in> fv \<Longrightarrow> v!x = v'!x) \<Longrightarrow> sat \<sigma> v i = sat \<sigma> v' i"
begin

definition verdicts :: "'a trace \<Rightarrow> (nat \<times> 'b tuple) set" where
  "verdicts \<sigma> = {(i, v). wf_tuple nfv fv v \<and> sat \<sigma> (map the v) i}"

definition prefixes :: "'a prefix set" where
  "prefixes = {\<pi>. \<exists>\<sigma> \<in> traces. prefix_of \<pi> \<sigma>}"

lemma prefix_of_trace[simp, intro]: "\<sigma> \<in> traces \<Longrightarrow> prefix_of \<pi> \<sigma> \<Longrightarrow> \<pi> \<in> prefixes"
  by (auto simp: prefixes_def)

lemma prefixes_closed[simp, intro]: "\<pi>' \<in> prefixes \<Longrightarrow> \<pi> \<le> \<pi>' \<Longrightarrow> \<pi> \<in> prefixes"
  using prefix_of_antimono by (auto simp: prefixes_def)

end

text \<open>
  We usually employ a monitor to find the \<^emph>\<open>violations\<close> of a specification.
  That is, the monitor should output the satisfactions of its negation.
  Moreover, all monitor implementations must work with finite prefixes.
  We are therefore interested in co-safety properties, which allow us to
  identify all satisfactions on finite prefixes.
\<close>

locale cosafety_fo_spec = fo_spec +
  assumes cosafety_lr: "\<sigma> \<in> traces \<Longrightarrow> sat \<sigma> v i \<Longrightarrow>
    \<exists>\<pi>. prefix_of \<pi> \<sigma> \<and> (\<forall>\<sigma>' \<in> traces. prefix_of \<pi> \<sigma>' \<longrightarrow> sat \<sigma>' v i)"
begin

lemma cosafety: "\<sigma> \<in> traces \<Longrightarrow>
  sat \<sigma> v i \<longleftrightarrow> (\<exists>\<pi>. prefix_of \<pi> \<sigma> \<and> (\<forall>\<sigma>' \<in> traces. prefix_of \<pi> \<sigma>' \<longrightarrow> sat \<sigma>' v i))"
  using cosafety_lr by blast

end

subsection \<open>Monitor function\<close>

text \<open>
  We model monitors abstractly as functions from prefixes to verdict sets.
  The following locale specifies a minimal set of properties that any
  reasonable monitor should have.
\<close>

locale monitor = fo_spec +
  fixes M :: "'a prefix \<Rightarrow> (nat \<times> 'b tuple) set"
  assumes
    mono_monitor: "\<pi>' \<in> prefixes \<Longrightarrow> \<pi> \<le> \<pi>' \<Longrightarrow> M \<pi> \<subseteq> M \<pi>'" and
    wf_monitor: "\<pi> \<in> prefixes \<Longrightarrow> (i, v) \<in> M \<pi> \<Longrightarrow> wf_tuple nfv fv v" and
    sound_monitor: "\<sigma> \<in> traces \<Longrightarrow> (i, v) \<in> M \<pi> \<Longrightarrow> prefix_of \<pi> \<sigma> \<Longrightarrow> sat \<sigma> (map the v) i" and
    complete_monitor: "\<sigma> \<in> traces \<Longrightarrow> prefix_of \<pi> \<sigma> \<Longrightarrow> wf_tuple nfv fv v \<Longrightarrow>
      (\<And>\<sigma>'. \<sigma>' \<in> traces \<Longrightarrow> prefix_of \<pi> \<sigma>' \<Longrightarrow> sat \<sigma>' (map the v) i) \<Longrightarrow>
      \<exists>\<pi>'. prefix_of \<pi>' \<sigma> \<and> (i, v) \<in> M \<pi>'"

text \<open>
  A monitor for a co-safety specification computes precisely the set of all
  satisfactions in the limit:
\<close>

abbreviation (in monitor) "M_limit \<sigma> \<equiv> \<Union>{M \<pi> | \<pi>. prefix_of \<pi> \<sigma>}"

locale cosafety_monitor = cosafety_fo_spec + monitor
begin

lemma M_limit_eq:
  assumes "\<sigma> \<in> traces"
  shows "M_limit \<sigma> = verdicts \<sigma>"
proof
  show "\<Union>{M \<pi> | \<pi>. prefix_of \<pi> \<sigma>} \<subseteq> verdicts \<sigma>"
    using assms wf_monitor sound_monitor by (auto simp: verdicts_def)
next
  show "\<Union>{M \<pi> | \<pi>. prefix_of \<pi> \<sigma>} \<supseteq> verdicts \<sigma>"
    unfolding verdicts_def
  proof safe
    fix i v
    assume "wf_tuple nfv fv v" and "sat \<sigma> (map the v) i"
    then obtain \<pi> where "prefix_of \<pi> \<sigma> \<and> (\<forall>\<sigma>'\<in>traces. prefix_of \<pi> \<sigma>' \<longrightarrow> sat \<sigma>' (map the v) i)"
      using assms cosafety_lr by blast
    with \<open>wf_tuple nfv fv v\<close> obtain \<pi>' where "prefix_of \<pi>' \<sigma> \<and> (i, v) \<in> M \<pi>'"
      using assms complete_monitor by blast
    then show "(i, v) \<in> \<Union>{M \<pi> | \<pi>. prefix_of \<pi> \<sigma>}"
      by blast
  qed
qed

end

text \<open>
  The monitor function \<^term>\<open>M\<close> adds some information over \<^term>\<open>sat\<close>, namely
  when a verdict is output. One possible behavior is that the monitor outputs
  its verdicts for one time-point at a time, in increasing order of
  time-points. Then \<^term>\<open>M\<close> is uniquely defined by a progress function, which
  returns for every prefix the time-point up to which all verdicts are computed.
\<close>

locale progress = fo_spec _ _ _ sat for sat :: "'a trace \<Rightarrow> 'b list \<Rightarrow> nat \<Rightarrow> bool" +
  fixes progress :: "'a prefix \<Rightarrow> nat"
  assumes
    progress_mono: "\<pi>' \<in> prefixes \<Longrightarrow> \<pi> \<le> \<pi>' \<Longrightarrow> progress \<pi> \<le> progress \<pi>'" and
    ex_progress_ge: "\<sigma> \<in> traces \<Longrightarrow> \<exists>\<pi>. prefix_of \<pi> \<sigma> \<and> x \<le> progress \<pi>" and
    progress_sat_cong: "\<sigma> \<in> traces \<Longrightarrow> prefix_of \<pi> \<sigma> \<Longrightarrow> prefix_of \<pi> \<sigma>' \<Longrightarrow> i < progress \<pi> \<Longrightarrow>
      sat \<sigma> v i \<longleftrightarrow> sat \<sigma>' v i"
    \<comment> \<open>The last condition is not necessary to obtain a proper monitor function.
      However, it corresponds to the intuitive understanding of monitor progress,
      and it results in a stronger characterisation. In particular, it implies that
      the specification is co-safety, as we will show below.\<close>
begin

definition M :: "'a prefix \<Rightarrow> (nat \<times> 'b tuple) set" where
  "M \<pi> = {(i, v). i < progress \<pi> \<and> wf_tuple nfv fv v \<and>
    (\<forall>\<sigma> \<in> traces. prefix_of \<pi> \<sigma> \<longrightarrow> sat \<sigma> (map the v) i)}"

lemma M_alt: "\<pi> \<in> prefixes \<Longrightarrow> M \<pi> = {(i, v). i < progress \<pi> \<and> wf_tuple nfv fv v \<and>
    (\<exists>\<sigma> \<in> traces. prefix_of \<pi> \<sigma> \<and> sat \<sigma> (map the v) i)}"
  using ex_prefix_of[of \<pi>]
  by (auto simp: prefixes_def M_def cong: progress_sat_cong)

end

sublocale progress \<subseteq> cosafety_monitor _ _ _ _ M
proof
  fix i v and \<sigma> :: "'a trace"
  assume "\<sigma> \<in> traces" and "sat \<sigma> v i"
  moreover obtain \<pi> where *: "prefix_of \<pi> \<sigma>" "i < progress \<pi>"
    using \<open>\<sigma> \<in> traces\<close> ex_progress_ge by (auto simp: less_eq_Suc_le)
  ultimately have "sat \<sigma>' v i" if "prefix_of \<pi> \<sigma>'" for \<sigma>'
    using \<open>\<sigma> \<in> traces\<close> that progress_sat_cong by blast
  with * show "\<exists>\<pi>. prefix_of \<pi> \<sigma> \<and> (\<forall>\<sigma>' \<in> traces. prefix_of \<pi> \<sigma>' \<longrightarrow> sat \<sigma>' v i)"
    by blast
next
  fix \<pi> \<pi>' :: "'a prefix"
  assume "\<pi>' \<in> prefixes" and "\<pi> \<le> \<pi>'"
  then show "M \<pi> \<subseteq> M \<pi>'"
    by (auto simp: M_def intro: progress_mono prefix_of_antimono
        elim: order.strict_trans2)
next
  fix i v \<pi>
  assume "\<pi> \<in> prefixes" and "(i, v) \<in> M \<pi>"
  then show "wf_tuple nfv fv v"
    by (simp add: M_def)
next
  fix i v \<pi> and \<sigma> :: "'a trace"
  assume "\<sigma> \<in> traces" and "(i, v) \<in> M \<pi>" and "prefix_of \<pi> \<sigma>"
  then show "sat \<sigma> (map the v) i"
    by (simp add: M_def)
next
  fix i v \<pi> and \<sigma> :: "'a trace"
  assume *: "\<sigma> \<in> traces" "prefix_of \<pi> \<sigma>" "wf_tuple nfv fv v"
    "\<And>\<sigma>'. \<sigma>' \<in> traces \<Longrightarrow> prefix_of \<pi> \<sigma>' \<Longrightarrow> sat \<sigma>' (map the v) i"
  show "\<exists>\<pi>'. prefix_of \<pi>' \<sigma> \<and> (i, v) \<in> M \<pi>'"
  proof (cases "i < progress \<pi>")
    case True
    with * show ?thesis by (auto simp: M_def)
  next
    case False
    obtain \<pi>' where **: "prefix_of \<pi>' \<sigma> \<and> i < progress \<pi>'"
      using \<open>\<sigma> \<in> traces\<close> ex_progress_ge by (auto simp: less_eq_Suc_le)
    then have "\<pi> \<le> \<pi>'"
      using \<open>\<sigma> \<in> traces\<close> \<open>prefix_of \<pi> \<sigma>\<close> prefix_of_imp_linear False progress_mono
      by (blast intro: order.strict_trans2)
    with * ** show ?thesis
      by (auto simp: M_def intro: prefix_of_antimono)
  qed
qed

subsection \<open>Slicing\<close>

text \<open>Sliceable specifications can be evaluated meaningfully on a subset of events.\<close>

locale abstract_slicer =
  fixes relevant_events :: "'b list set \<Rightarrow> 'a set"
begin

abbreviation slice :: "'b list set \<Rightarrow> 'a trace \<Rightarrow> 'a trace" where
  "slice S \<equiv> map_\<Gamma> (\<lambda>D. D \<inter> relevant_events S)"

abbreviation pslice :: "'b list set \<Rightarrow> 'a prefix \<Rightarrow> 'a prefix" where
  "pslice S \<equiv> pmap_\<Gamma> (\<lambda>D. D \<inter> relevant_events S)"

lemma prefix_of_psliceI: "prefix_of \<pi> \<sigma> \<Longrightarrow> prefix_of (pslice S \<pi>) (slice S \<sigma>)"
  by (transfer fixing: S) auto

lemma plen_pslice[simp]: "plen (pslice S \<pi>) = plen \<pi>"
  by (transfer fixing: S) simp

lemma pslice_pnil[simp]: "pslice S pnil = pnil"
  by (transfer fixing: S) simp

lemma last_ts_pslice[simp]: "last_ts (pslice S \<pi>) = last_ts \<pi>"
  by (transfer fixing: S) (simp add: last_map case_prod_beta split: list.split)

abbreviation verdict_filter :: "'b list set \<Rightarrow> (nat \<times> 'b tuple) set \<Rightarrow> (nat \<times> 'b tuple) set" where
  "verdict_filter S V \<equiv> {(i, v) \<in> V. mem_restr S v}"

end

locale sliceable_fo_spec = fo_spec _ _ _ sat + abstract_slicer relevant_events
  for relevant_events :: "'b list set \<Rightarrow> 'a set" and sat :: "'a trace \<Rightarrow> 'b list \<Rightarrow> nat \<Rightarrow> bool" +
  assumes
    slice_closed[simp, intro]: "\<sigma> \<in> traces \<Longrightarrow> slice S \<sigma> \<in> traces" and
    sliceable: "\<sigma> \<in> traces \<Longrightarrow> v \<in> S \<Longrightarrow> sat (slice S \<sigma>) v i \<longleftrightarrow> sat \<sigma> v i"
begin

lemma pslice_closed[simp, intro]: "\<pi> \<in> prefixes \<Longrightarrow> pslice S \<pi> \<in> prefixes"
  using prefix_of_pmap_\<Gamma> by (fastforce simp: prefixes_def)

lemma union_verdicts_slice:
  assumes part: "\<Union>\<S> = UNIV"
    and trace: "\<sigma> \<in> traces"
  shows "\<Union>((\<lambda>S. verdict_filter S (verdicts (slice S \<sigma>))) ` \<S>) = verdicts \<sigma>"
proof safe
  fix S i and v :: "'b tuple"
  assume "(i, v) \<in> verdicts (slice S \<sigma>)"
  then have tuple: "wf_tuple nfv fv v" and "sat (slice S \<sigma>) (map the v) i"
    by (auto simp: verdicts_def)
  assume "mem_restr S v"
  then obtain v' where "v' \<in> S" and 1: "\<forall>i\<in>fv. v ! i = Some (v' ! i)"
    using tuple by (auto simp: fv_less_nfv elim: mem_restrE)
  then have "sat (slice S \<sigma>) v' i"
    using trace \<open>sat (slice S \<sigma>) (map the v) i\<close> tuple
    by (auto simp: wf_tuple_length fv_less_nfv cong: sat_fv_cong)
  then have "sat \<sigma> v' i"
    using sliceable[OF trace \<open>v' \<in> S\<close>] by simp
  then have "sat \<sigma> (map the v) i"
    using trace tuple 1
    by (auto simp: wf_tuple_length fv_less_nfv cong: sat_fv_cong)
  then show "(i, v) \<in> verdicts \<sigma>"
    using tuple by (simp add: verdicts_def)
next
  fix i and v :: "'b tuple"
  assume "(i, v) \<in> verdicts \<sigma>"
  then have tuple: "wf_tuple nfv fv v" and "sat \<sigma> (map the v) i"
    by (auto simp: verdicts_def)
  from part obtain S where "S \<in> \<S>" and "map the v \<in> S"
    by blast
  then have "mem_restr S v"
    using mem_restrI[of "map the v" S nfv fv] tuple
    by (auto simp: wf_tuple_def fv_less_nfv)
  moreover have "sat (slice S \<sigma>) (map the v) i"
    using \<open>sat \<sigma> (map the v) i\<close> sliceable[OF trace \<open>map the v \<in> S\<close>] by simp
  then have "(i, v) \<in> verdicts (slice S \<sigma>)"
    using tuple by (simp add: verdicts_def)
  ultimately show "(i, v) \<in> (\<Union>S\<in>\<S>. verdict_filter S (verdicts (slice S \<sigma>)))"
    using \<open>S \<in> \<S>\<close> by blast
qed

end

text \<open>
  We define a similar notion for monitors. It is potentially stronger because
  the time-point at which verdicts are output must not change.
\<close>

locale sliceable_monitor = monitor _ _ _ sat M + abstract_slicer relevant_events
  for relevant_events :: "'b list set \<Rightarrow> 'a set" and sat :: "'a trace \<Rightarrow> 'b list \<Rightarrow> nat \<Rightarrow> bool" and M +
  assumes sliceable_M: "\<pi> \<in> prefixes \<Longrightarrow> mem_restr S v \<Longrightarrow> (i, v) \<in> M (pslice S \<pi>) \<longleftrightarrow> (i, v) \<in> M \<pi>"
begin

lemma union_M_pslice:
  assumes part: "\<Union>\<S> = UNIV"
    and prefix: "\<pi> \<in> prefixes"
  shows "\<Union>((\<lambda>S. verdict_filter S (M (pslice S \<pi>))) ` \<S>) = M \<pi>"
proof safe
  fix S i and v :: "'b tuple"
  assume "mem_restr S v" and "(i, v) \<in> M (pslice S \<pi>)"
  then show "(i, v) \<in> M \<pi>" using sliceable_M prefix by blast
next
  fix i and v :: "'b tuple"
  assume "(i, v) \<in> M \<pi>"
  then have tuple: "wf_tuple nfv fv v"
    using prefix wf_monitor by blast
  from part obtain S where "S \<in> \<S>" and "map the v \<in> S"
    by blast
  then have "mem_restr S v"
    using mem_restrI[of "map the v" S nfv fv] tuple
    by (auto simp: wf_tuple_def fv_less_nfv)
  then have "(i, v) \<in> M (pslice S \<pi>)"
    using \<open>(i, v) \<in> M \<pi>\<close> sliceable_M prefix by blast
  then show "(i, v) \<in> (\<Union>S\<in>\<S>. verdict_filter S (M (pslice S \<pi>)))"
    using \<open>S \<in> \<S>\<close> \<open>mem_restr S v\<close> by blast
qed

end

text \<open>
  If the specification is sliceable and the monitor's progress depends only on
  time-stamps, then also the monitor itself is sliceable.
\<close>

locale timed_progress = progress +
  assumes progress_time_conv: "\<pi> \<in> prefixes \<Longrightarrow> \<pi>' \<in> prefixes \<Longrightarrow>
    pts \<pi> = pts \<pi>' \<Longrightarrow> progress \<pi> = progress \<pi>'"

locale sliceable_timed_progress = sliceable_fo_spec + timed_progress
begin

lemma progress_pslice[simp]: "\<pi> \<in> prefixes \<Longrightarrow> progress (pslice S \<pi>) = progress \<pi>"
  by (simp cong: progress_time_conv)

end

sublocale sliceable_timed_progress \<subseteq> sliceable_monitor _ _ _ _ _ M
proof
  fix S :: "'b list set" and v i \<pi>
  assume *: "\<pi> \<in> prefixes" "mem_restr S v"
  show "(i, v) \<in> M (pslice S \<pi>) \<longleftrightarrow> (i, v) \<in> M \<pi>" (is "?L \<longleftrightarrow> ?R")
  proof
    assume ?L
    with * show ?R
      by (auto 0 4 simp: M_def wf_tuple_def elim!: mem_restrE
          box_equals[OF sliceable sat_fv_cong sat_fv_cong, THEN iffD1, rotated -1]
          intro: prefix_of_psliceI dest: fv_less_nfv spec[of _ "slice S _"]) (* SLOW *)
  next
    assume ?R
    with * show ?L
      by (auto 0 4 simp: M_alt wf_tuple_def elim!: mem_restrE
        box_equals[OF sliceable sat_fv_cong sat_fv_cong, THEN iffD2, rotated -1]
        intro: exI[of _ "slice S _"] prefix_of_psliceI dest: fv_less_nfv) (* SLOW *)
  qed
qed

(*<*)
end
(*>*)


theory Datatypes

imports inc.Prelude

begin

default_sort type

datatype channel = cin1 | cin2 | cout | cbot

section \<open>Message Definition\<close>

text\<open>The same is true for the "Message" Datatype. Every kind of message has to be described here:\<close>
datatype M_pure = \<N> nat | \<B> bool

instance M_pure::countable
  apply(countable_datatype)
  done

text \<open>Then one describes the types of each channel. Only Messages included are allowed to be
  transmitted\<close>
fun cMsg :: "channel \<Rightarrow> M_pure set" where
"cMsg cin1 = range \<N>" |
"cMsg cin2 = range \<N>" |
"cMsg cout = range \<N>" |
"cMsg _ = {}"

lemma cmsgempty_ex:"\<exists>c. cMsg c = {}"
  using cMsg.simps by blast

fun cTime :: "channel \<Rightarrow> timeType" where
"cTime cin1 = TTsyn" |
"cTime cin2 = TTsyn" |
"cTime cout = TTsyn" |
"cTime _ = undefined"

end


(*
  File:      HOL/Number_Theory/Prime_Powers.thy
  Author:    Manuel Eberl <manuel@pruvisto.org>

  Prime powers and the Mangoldt function
*)
section \<open>Prime powers\<close>
theory Prime_Powers
  imports Complex_Main "HOL-Computational_Algebra.Primes" "HOL-Library.FuncSet"
begin

definition aprimedivisor :: "'a :: normalization_semidom \<Rightarrow> 'a" where
  "aprimedivisor q = (SOME p. prime p \<and> p dvd q)"

definition primepow :: "'a :: normalization_semidom \<Rightarrow> bool" where
  "primepow n \<longleftrightarrow> (\<exists>p k. prime p \<and> k > 0 \<and> n = p ^ k)"

definition primepow_factors :: "'a :: normalization_semidom \<Rightarrow> 'a set" where
  "primepow_factors n = {x. primepow x \<and> x dvd n}"

lemma primepow_gt_Suc_0: "primepow n \<Longrightarrow> n > Suc 0"
  using one_less_power[of "p::nat" for p] by (auto simp: primepow_def prime_nat_iff)

lemma
  assumes "prime p" "p dvd n"
  shows prime_aprimedivisor: "prime (aprimedivisor n)"
    and aprimedivisor_dvd:   "aprimedivisor n dvd n"
proof -
  from assms have "\<exists>p. prime p \<and> p dvd n" by auto
  from someI_ex[OF this] show "prime (aprimedivisor n)" "aprimedivisor n dvd n"
      unfolding aprimedivisor_def by (simp_all add: conj_commute)
qed

lemma
  assumes "n \<noteq> 0" "\<not>is_unit (n :: 'a :: factorial_semiring)"
  shows prime_aprimedivisor': "prime (aprimedivisor n)"
    and aprimedivisor_dvd':   "aprimedivisor n dvd n"
proof -
  from someI_ex[OF prime_divisor_exists[OF assms]]
    show "prime (aprimedivisor n)" "aprimedivisor n dvd n"
      unfolding aprimedivisor_def by (simp_all add: conj_commute)
qed

lemma aprimedivisor_of_prime [simp]:
  assumes "prime p"
  shows   "aprimedivisor p = p"
proof -
  from assms have "\<exists>q. prime q \<and> q dvd p" by auto
  from someI_ex[OF this, folded aprimedivisor_def] assms show ?thesis
    by (auto intro: primes_dvd_imp_eq)
qed

lemma aprimedivisor_pos_nat: "(n::nat) > 1 \<Longrightarrow> aprimedivisor n > 0"
  using aprimedivisor_dvd'[of n] by (auto elim: dvdE intro!: Nat.gr0I)

lemma aprimedivisor_primepow_power:
  assumes "primepow n" "k > 0"
  shows   "aprimedivisor (n ^ k) = aprimedivisor n"
proof -
  from assms obtain p l where l: "prime p" "l > 0" "n = p ^ l"
    by (auto simp: primepow_def)
  from l assms have *: "prime (aprimedivisor (n ^ k))" "aprimedivisor (n ^ k) dvd n ^ k"
    by (intro prime_aprimedivisor[of p] aprimedivisor_dvd[of p] dvd_power;
        simp add: power_mult [symmetric])+
  from * l have "aprimedivisor (n ^ k) dvd p ^ (l * k)" by (simp add: power_mult)
  with assms * l have "aprimedivisor (n ^ k) dvd p"
    by (subst (asm) prime_dvd_power_iff) simp_all
  with l assms have "aprimedivisor (n ^ k) = p"
    by (intro primes_dvd_imp_eq prime_aprimedivisor l) (auto simp: power_mult [symmetric])
  moreover from l have "aprimedivisor n dvd p ^ l"
    by (auto intro: aprimedivisor_dvd simp: prime_gt_0_nat)
  with assms l have "aprimedivisor n dvd p"
    by (subst (asm) prime_dvd_power_iff) (auto intro!: prime_aprimedivisor simp: prime_gt_0_nat)
  with l assms have "aprimedivisor n = p"
    by (intro primes_dvd_imp_eq prime_aprimedivisor l) auto
  ultimately show ?thesis by simp
qed

lemma aprimedivisor_prime_power:
  assumes "prime p" "k > 0"
  shows   "aprimedivisor (p ^ k) = p"
proof -
  from assms have *: "prime (aprimedivisor (p ^ k))" "aprimedivisor (p ^ k) dvd p ^ k"
    by (intro prime_aprimedivisor[of p] aprimedivisor_dvd[of p]; simp add: prime_nat_iff)+
  from assms * have "aprimedivisor (p ^ k) dvd p"
    by (subst (asm) prime_dvd_power_iff) simp_all
  with assms * show "aprimedivisor (p ^ k) = p" by (intro primes_dvd_imp_eq)
qed

lemma prime_factorization_primepow:
  assumes "primepow n"
  shows   "prime_factorization n =
             replicate_mset (multiplicity (aprimedivisor n) n) (aprimedivisor n)"
  using assms
  by (auto simp: primepow_def aprimedivisor_prime_power prime_factorization_prime_power)

lemma primepow_decompose:
  fixes n :: "'a :: factorial_semiring_multiplicative"
  assumes "primepow n"
  shows   "aprimedivisor n ^ multiplicity (aprimedivisor n) n = n"
proof -
  from assms have "n \<noteq> 0" by (intro notI) (auto simp: primepow_def)
  hence "n = unit_factor n * prod_mset (prime_factorization n)"
    by (subst prod_mset_prime_factorization) simp_all
  also from assms have "unit_factor n = 1" by (auto simp: primepow_def unit_factor_power)
  also have "prime_factorization n =
               replicate_mset (multiplicity (aprimedivisor n) n) (aprimedivisor n)"
    by (intro prime_factorization_primepow assms)
  also have "prod_mset \<dots> = aprimedivisor n ^ multiplicity (aprimedivisor n) n" by simp
  finally show ?thesis by simp
qed

lemma prime_power_not_one:
  assumes "prime p" "k > 0"
  shows   "p ^ k \<noteq> 1"
proof
  assume "p ^ k = 1"
  hence "is_unit (p ^ k)" by simp
  thus False using assms by (simp add: is_unit_power_iff)
qed

lemma zero_not_primepow [simp]: "\<not>primepow 0"
  by (auto simp: primepow_def)

lemma one_not_primepow [simp]: "\<not>primepow 1"
  by (auto simp: primepow_def prime_power_not_one)

lemma primepow_not_unit [simp]: "primepow p \<Longrightarrow> \<not>is_unit p"
  by (auto simp: primepow_def is_unit_power_iff)

lemma not_primepow_Suc_0_nat [simp]: "\<not>primepow (Suc 0)"
  using primepow_gt_Suc_0[of "Suc 0"] by auto

lemma primepow_gt_0_nat: "primepow n \<Longrightarrow> n > (0::nat)"
  using primepow_gt_Suc_0[of n] by simp

lemma unit_factor_primepow:
  fixes p :: "'a :: factorial_semiring_multiplicative"
  shows "primepow p \<Longrightarrow> unit_factor p = 1"
  by (auto simp: primepow_def unit_factor_power)

lemma aprimedivisor_primepow:
  assumes "prime p" "p dvd n" "primepow (n :: 'a :: factorial_semiring_multiplicative)"
  shows   "aprimedivisor (p * n) = p" "aprimedivisor n = p"
proof -
  from assms have [simp]: "n \<noteq> 0" by auto
  define q where "q = aprimedivisor n"
  with assms have q: "prime q" by (auto simp: q_def intro!: prime_aprimedivisor)
  from \<open>primepow n\<close> have n: "n = q ^ multiplicity q n"
    by (simp add: primepow_decompose q_def)
  have nz: "multiplicity q n \<noteq> 0"
  proof
    assume "multiplicity q n = 0"
    with n have n': "n = unit_factor n" by simp
    have "is_unit n" by (subst n', rule unit_factor_is_unit) (insert assms, auto)
    with assms show False by auto
  qed
  with \<open>prime p\<close> \<open>p dvd n\<close> q have "p dvd q"
    by (subst (asm) n) (auto intro: prime_dvd_power)
  with \<open>prime p\<close> q have "p = q" by (intro primes_dvd_imp_eq)
  thus "aprimedivisor n = p" by (simp add: q_def)

  define r where "r = aprimedivisor (p * n)"
  with assms have r: "r dvd (p * n)" "prime r" unfolding r_def
    by (intro aprimedivisor_dvd[of p] prime_aprimedivisor[of p]; simp)+
  hence "r dvd q ^ Suc (multiplicity q n)"
    by (subst (asm) n) (auto simp: \<open>p = q\<close> dest: dvd_unit_imp_unit)
  with r have "r dvd q"
    by (auto intro: prime_dvd_power_nat simp: prime_dvd_mult_iff dest: prime_dvd_power)
  with r q have "r = q" by (intro primes_dvd_imp_eq)
  thus "aprimedivisor (p * n) = p" by (simp add: r_def \<open>p = q\<close>)
qed

lemma power_eq_prime_powerD:
  fixes p :: "'a :: factorial_semiring"
  assumes "prime p" "n > 0" "x ^ n = p ^ k"
  shows   "\<exists>i. normalize x = normalize (p ^ i)"
proof -
  have "normalize x = normalize (p ^ multiplicity p x)"
  proof (rule multiplicity_eq_imp_eq)
    fix q :: 'a assume "prime q"
    from assms have "multiplicity q (x ^ n) = multiplicity q (p ^ k)" by simp
    with \<open>prime q\<close> and assms have "n * multiplicity q x = k * multiplicity q p"
      by (subst (asm) (1 2) prime_elem_multiplicity_power_distrib) (auto simp: power_0_left)
    with assms and \<open>prime q\<close> show "multiplicity q x = multiplicity q (p ^ multiplicity p x)"
      by (cases "p = q") (auto simp: multiplicity_distinct_prime_power prime_multiplicity_other)
  qed (insert assms, auto simp: power_0_left)
  thus ?thesis by auto
qed

lemma primepow_power_iff:
  fixes p :: "'a :: factorial_semiring_multiplicative"
  assumes "unit_factor p = 1"
  shows   "primepow (p ^ n) \<longleftrightarrow> primepow p \<and> n > 0"
proof safe
  assume "primepow (p ^ n)"
  hence n: "n \<noteq> 0" by (auto intro!: Nat.gr0I)
  thus "n > 0" by simp
  from assms have [simp]: "normalize p = p"
    using normalize_mult_unit_factor[of p] by (simp only: mult.right_neutral)
  from \<open>primepow (p ^ n)\<close> obtain q k where *: "k > 0" "prime q" "p ^ n = q ^ k"
    by (auto simp: primepow_def)
  with power_eq_prime_powerD[of q n p k] n
    obtain i where eq: "normalize p = normalize (q ^ i)" by auto
  with primepow_not_unit[OF \<open>primepow (p ^ n)\<close>] have "i \<noteq> 0"
    by (intro notI) (simp add: normalize_1_iff is_unit_power_iff del: primepow_not_unit)
  with \<open>normalize p = normalize (q ^ i)\<close> \<open>prime q\<close> show "primepow p"
    by (auto simp: normalize_power primepow_def intro!: exI[of _ q] exI[of _ i])
next
  assume "primepow p" "n > 0"
  then obtain q k where *: "k > 0" "prime q" "p = q ^ k" by (auto simp: primepow_def)
  with \<open>n > 0\<close> show "primepow (p ^ n)"
    by (auto simp: primepow_def power_mult intro!: exI[of _ q] exI[of _ "k * n"])
qed

lemma primepow_power_iff_nat:
  "p > 0 \<Longrightarrow> primepow (p ^ n) \<longleftrightarrow> primepow (p :: nat) \<and> n > 0"
  by (rule primepow_power_iff) (simp_all add: unit_factor_nat_def)

lemma primepow_prime [simp]: "prime n \<Longrightarrow> primepow n"
  by (auto simp: primepow_def intro!: exI[of _ n] exI[of _ "1::nat"])

lemma primepow_prime_power [simp]:
    "prime (p :: 'a :: factorial_semiring_multiplicative) \<Longrightarrow> primepow (p ^ n) \<longleftrightarrow> n > 0"
  by (subst primepow_power_iff) auto

lemma aprimedivisor_vimage:
  assumes "prime (p :: 'a :: factorial_semiring_multiplicative)"
  shows   "aprimedivisor -` {p} \<inter> primepow_factors n = {p ^ k |k. k > 0 \<and> p ^ k dvd n}"
proof safe
  fix q assume q: "q \<in> primepow_factors n"
  hence q': "q \<noteq> 0" "q \<noteq> 1" by (auto simp: primepow_def primepow_factors_def prime_power_not_one)
  let ?n = "multiplicity (aprimedivisor q) q"
  from q q' have "q = aprimedivisor q ^ ?n \<and> ?n > 0 \<and> aprimedivisor q ^ ?n dvd n"
    by (auto simp: primepow_decompose primepow_factors_def prime_multiplicity_gt_zero_iff
          prime_aprimedivisor' prime_imp_prime_elem aprimedivisor_dvd')
  thus "\<exists>k. q = aprimedivisor q ^ k \<and> k > 0 \<and> aprimedivisor q ^ k dvd n" ..
next
  fix k :: nat assume k: "p ^ k dvd n" "k > 0"
  with assms show "p ^ k \<in> aprimedivisor -` {p}"
    by (auto simp: aprimedivisor_prime_power)
  with assms k show "p ^ k \<in> primepow_factors n"
    by (auto simp: primepow_factors_def primepow_def aprimedivisor_prime_power intro: Suc_leI)
qed

lemma aprimedivisor_nat:
  assumes "n \<noteq> (Suc 0::nat)"
  shows   "prime (aprimedivisor n)" "aprimedivisor n dvd n"
proof -
  from assms have "\<exists>p. prime p \<and> p dvd n" by (intro prime_factor_nat) auto
  from someI_ex[OF this, folded aprimedivisor_def]
    show "prime (aprimedivisor n)" "aprimedivisor n dvd n" by blast+
qed

lemma aprimedivisor_gt_Suc_0:
  assumes "n \<noteq> Suc 0"
  shows   "aprimedivisor n > Suc 0"
proof -
  from assms have "prime (aprimedivisor n)" by (rule aprimedivisor_nat)
  thus "aprimedivisor n > Suc 0" by (simp add: prime_nat_iff)
qed

lemma aprimedivisor_le_nat:
  assumes "n > Suc 0"
  shows   "aprimedivisor n \<le> n"
proof -
  from assms have "aprimedivisor n dvd n" by (intro aprimedivisor_nat) simp_all
  with assms show "aprimedivisor n \<le> n"
    by (intro dvd_imp_le) simp_all
qed

lemma bij_betw_primepows:
  "bij_betw (\<lambda>(p,k). p ^ Suc k :: 'a :: factorial_semiring_multiplicative)
     (Collect prime \<times> UNIV) (Collect primepow)"
proof (rule bij_betwI [where ?g = "(\<lambda>n. (aprimedivisor n, multiplicity (aprimedivisor n) n - 1))"],
       goal_cases)
  case 1
  show "(\<lambda>(p, k). p ^ Suc k :: 'a) \<in> Collect prime \<times> UNIV \<rightarrow> Collect primepow"
    by (auto intro!: primepow_prime_power simp del: power_Suc )
next
  case 2
  show ?case
    by (auto simp: primepow_def prime_aprimedivisor)
next
  case (3 n)
  thus ?case
    by (auto simp: aprimedivisor_prime_power simp del: power_Suc)
next
  case (4 n)
  hence *: "0 < multiplicity (aprimedivisor n) n"
    by (subst prime_multiplicity_gt_zero_iff)
       (auto intro!: prime_imp_prime_elem aprimedivisor_dvd simp: primepow_def prime_aprimedivisor)
  have "aprimedivisor n * aprimedivisor n ^ (multiplicity (aprimedivisor n) n - Suc 0) =
          aprimedivisor n ^ Suc (multiplicity (aprimedivisor n) n - Suc 0)" by simp
  also from * have "Suc (multiplicity (aprimedivisor n) n - Suc 0) =
                      multiplicity (aprimedivisor n) n"
    by (subst Suc_diff_Suc) (auto simp: prime_multiplicity_gt_zero_iff)
  also have "aprimedivisor n ^ \<dots> = n"
    using 4 by (subst primepow_decompose) auto
  finally show ?case by auto
qed

(* TODO Generalise *)
lemma primepow_multD:
  assumes "primepow (a * b :: nat)"
  shows   "a = 1 \<or> primepow a" "b = 1 \<or> primepow b"
proof -
  from assms obtain p k where k: "k > 0" "a * b = p ^ k" "prime p"
    unfolding primepow_def by auto
  then obtain i j where "a = p ^ i" "b = p ^ j"
    using prime_power_mult_nat[of p a b] by blast
  with \<open>prime p\<close> show "a = 1 \<or> primepow a" "b = 1 \<or> primepow b" by auto
qed

lemma primepow_mult_aprimedivisorI:
  assumes "primepow (n :: 'a :: factorial_semiring_multiplicative)"
  shows   "primepow (aprimedivisor n * n)"
  by (subst (2) primepow_decompose[OF assms, symmetric], subst power_Suc [symmetric],
      subst primepow_prime_power)
     (insert assms, auto intro!: prime_aprimedivisor' dest: primepow_gt_Suc_0)

lemma primepow_factors_altdef:
  fixes x :: "'a :: factorial_semiring_multiplicative"
  assumes "x \<noteq> 0"
  shows "primepow_factors x = {p ^ k |p k. p \<in> prime_factors x \<and> k \<in> {0<.. multiplicity p x}}"
proof (intro equalityI subsetI)
  fix q assume "q \<in> primepow_factors x"
  then obtain p k where pk: "prime p" "k > 0" "q = p ^ k" "q dvd x"
    unfolding primepow_factors_def primepow_def by blast
  moreover have "k \<le> multiplicity p x" using pk assms by (intro multiplicity_geI) auto
  ultimately show "q \<in> {p ^ k |p k. p \<in> prime_factors x \<and> k \<in> {0<.. multiplicity p x}}"
    by (auto simp: prime_factors_multiplicity intro!: exI[of _ p] exI[of _ k])
qed (auto simp: primepow_factors_def prime_factors_multiplicity multiplicity_dvd')

lemma finite_primepow_factors:
  assumes "x \<noteq> (0 :: 'a :: factorial_semiring_multiplicative)"
  shows   "finite (primepow_factors x)"
proof -
  have "finite (SIGMA p:prime_factors x. {0<..multiplicity p x})"
    by (intro finite_SigmaI) simp_all
  hence "finite ((\<lambda>(p,k). p ^ k) ` \<dots>)" (is "finite ?A") by (rule finite_imageI)
  also have "?A = primepow_factors x"
    using assms by (subst primepow_factors_altdef) fast+
  finally show ?thesis .
qed

lemma aprimedivisor_primepow_factors_conv_prime_factorization:
  assumes [simp]: "n \<noteq> (0 :: 'a :: factorial_semiring_multiplicative)"
  shows   "image_mset aprimedivisor (mset_set (primepow_factors n)) = prime_factorization n"
          (is "?lhs = ?rhs")
proof (intro multiset_eqI)
  fix p :: 'a
  show "count ?lhs p = count ?rhs p"
  proof (cases "prime p")
    case False
    have "p \<notin># image_mset aprimedivisor (mset_set (primepow_factors n))"
    proof
      assume "p \<in># image_mset aprimedivisor (mset_set (primepow_factors n))"
      then obtain q where "p = aprimedivisor q" "q \<in> primepow_factors n"
        by (auto simp: finite_primepow_factors)
      with False prime_aprimedivisor'[of q] have "q = 0 \<or> is_unit q" by auto
      with \<open>q \<in> primepow_factors n\<close> show False by (auto simp: primepow_factors_def primepow_def)
    qed
    hence "count ?lhs p = 0" by (simp only: Multiset.not_in_iff)
    with False show ?thesis by (simp add: count_prime_factorization)
  next
    case True
    hence p: "p \<noteq> 0" "\<not>is_unit p" by auto
    have "count ?lhs p = card (aprimedivisor -` {p} \<inter> primepow_factors n)"
      by (simp add: count_image_mset finite_primepow_factors)
    also have "aprimedivisor -` {p} \<inter> primepow_factors n = {p^k |k. k > 0 \<and> p ^ k dvd n}"
      using True by (rule aprimedivisor_vimage)
    also from True have "\<dots> = (\<lambda>k. p ^ k) ` {0<..multiplicity p n}"
      by (subst power_dvd_iff_le_multiplicity) auto
    also from p True have "card \<dots> = multiplicity p n"
      by (subst card_image) (auto intro!: inj_onI dest: prime_power_inj)
    also from True have "\<dots> = count (prime_factorization n) p"
      by (simp add: count_prime_factorization)
    finally show ?thesis .
  qed
qed

lemma prime_elem_aprimedivisor_nat: "d > Suc 0 \<Longrightarrow> prime_elem (aprimedivisor d)"
  using prime_aprimedivisor'[of d] by simp

lemma aprimedivisor_gt_0_nat [simp]: "d > Suc 0 \<Longrightarrow> aprimedivisor d > 0"
  using prime_aprimedivisor'[of d] by (simp add: prime_gt_0_nat)

lemma aprimedivisor_gt_Suc_0_nat [simp]: "d > Suc 0 \<Longrightarrow> aprimedivisor d > Suc 0"
  using prime_aprimedivisor'[of d] by (simp add: prime_gt_Suc_0_nat)

lemma aprimedivisor_not_Suc_0_nat [simp]: "d > Suc 0 \<Longrightarrow> aprimedivisor d \<noteq> Suc 0"
  using aprimedivisor_gt_Suc_0[of d] by (intro notI) auto

lemma multiplicity_aprimedivisor_gt_0_nat [simp]:
  "d > Suc 0 \<Longrightarrow> multiplicity (aprimedivisor d) d > 0"
  by (subst multiplicity_gt_zero_iff) (auto intro: aprimedivisor_dvd')

lemma primepowI:
  "prime p \<Longrightarrow> k > 0 \<Longrightarrow> p ^ k = n \<Longrightarrow> primepow n \<and> aprimedivisor n = p"
  unfolding primepow_def by (auto simp: aprimedivisor_prime_power)

lemma not_primepowI:
  assumes "prime p" "prime q" "p \<noteq> q" "p dvd n" "q dvd n"
  shows   "\<not>primepow n"
  using assms by (auto simp: primepow_def dest!: prime_dvd_power[rotated] dest: primes_dvd_imp_eq)

lemma sum_prime_factorization_conv_sum_primepow_factors:
  fixes n :: "'a :: factorial_semiring_multiplicative"
  assumes "n \<noteq> 0"
  shows "(\<Sum>q\<in>primepow_factors n. f (aprimedivisor q)) = (\<Sum>p\<in>#prime_factorization n. f p)"
proof -
  from assms have "prime_factorization n = image_mset aprimedivisor (mset_set (primepow_factors n))"
    by (rule aprimedivisor_primepow_factors_conv_prime_factorization [symmetric])
  also have "(\<Sum>p\<in>#\<dots>. f p) = (\<Sum>q\<in>primepow_factors n. f (aprimedivisor q))"
    by (simp add: image_mset.compositionality sum_unfold_sum_mset o_def)
  finally show ?thesis ..
qed

lemma multiplicity_aprimedivisor_Suc_0_iff:
  assumes "primepow (n :: 'a :: factorial_semiring_multiplicative)"
  shows   "multiplicity (aprimedivisor n) n = Suc 0 \<longleftrightarrow> prime n"
  by (subst (3) primepow_decompose [OF assms, symmetric])
     (insert assms, auto simp add: prime_power_iff intro!: prime_aprimedivisor')

definition mangoldt :: "nat \<Rightarrow> 'a :: real_algebra_1" where
  "mangoldt n = (if primepow n then of_real (ln (real (aprimedivisor n))) else 0)"

lemma mangoldt_0 [simp]: "mangoldt 0 = 0"
  by (simp add: mangoldt_def)

lemma mangoldt_Suc_0 [simp]: "mangoldt (Suc 0) = 0"
  by (simp add: mangoldt_def)

lemma of_real_mangoldt [simp]: "of_real (mangoldt n) = mangoldt n"
  by (simp add: mangoldt_def)

lemma mangoldt_sum:
  assumes "n \<noteq> 0"
  shows   "(\<Sum>d | d dvd n. mangoldt d :: 'a :: real_algebra_1) = of_real (ln (real n))"
proof -
  have "(\<Sum>d | d dvd n. mangoldt d :: 'a) = of_real (\<Sum>d | d dvd n. mangoldt d)" by simp
  also have "(\<Sum>d | d dvd n. mangoldt d) = (\<Sum>d \<in> primepow_factors n. ln (real (aprimedivisor d)))"
    using assms by (intro sum.mono_neutral_cong_right) (auto simp: primepow_factors_def mangoldt_def)
  also have "\<dots> = ln (real (\<Prod>d \<in> primepow_factors n. aprimedivisor d))"
    using assms finite_primepow_factors[of n]
    by (subst ln_prod [symmetric])
       (auto simp: primepow_factors_def intro!: aprimedivisor_pos_nat
             intro: Nat.gr0I primepow_gt_Suc_0)
  also have "primepow_factors n =
               (\<lambda>(p,k). p ^ k) ` (SIGMA p:prime_factors n. {0<..multiplicity p n})"
    (is "_ = _ ` ?A") by (subst primepow_factors_altdef[OF assms]) fast+
  also have "prod aprimedivisor \<dots> = (\<Prod>(p,k)\<in>?A. aprimedivisor (p ^ k))"
    by (subst prod.reindex)
       (auto simp: inj_on_def prime_power_inj'' prime_factors_multiplicity
                   prod.Sigma [symmetric] case_prod_unfold)
  also have "\<dots> = (\<Prod>(p,k)\<in>?A. p)"
    by (intro prod.cong refl) (auto simp: aprimedivisor_prime_power prime_factors_multiplicity)
  also have "\<dots> = (\<Prod>x\<in>prime_factors n. \<Prod>k\<in>{0<..multiplicity x n}. x)"
    by (rule prod.Sigma [symmetric]) auto
  also have "\<dots> = (\<Prod>x\<in>prime_factors n. x ^ multiplicity x n)"
    by (intro prod.cong refl) (simp add: prod_constant)
  also have "\<dots> = n" using assms by (intro prime_factorization_nat [symmetric]) simp
  finally show ?thesis .
qed

lemma mangoldt_primepow:
   "prime p \<Longrightarrow> mangoldt (p ^ k) = (if k > 0 then of_real (ln (real p)) else 0)"
  by (simp add: mangoldt_def aprimedivisor_prime_power)

lemma mangoldt_primepow' [simp]: "prime p \<Longrightarrow> k > 0 \<Longrightarrow> mangoldt (p ^ k) = of_real (ln (real p))"
  by (subst mangoldt_primepow) auto

lemma mangoldt_prime [simp]: "prime p \<Longrightarrow> mangoldt p = of_real (ln (real p))"
  using mangoldt_primepow[of p 1] by simp

lemma mangoldt_nonneg: "0 \<le> (mangoldt d :: real)"
  using aprimedivisor_gt_Suc_0_nat[of d]
  by (auto simp: mangoldt_def of_nat_le_iff[of 1 x for x, unfolded of_nat_1] Suc_le_eq
           intro!: ln_ge_zero dest: primepow_gt_Suc_0)

lemma norm_mangoldt [simp]:
  "norm (mangoldt n :: 'a :: real_normed_algebra_1) = mangoldt n"
proof (cases "primepow n")
  case True
  hence "prime (aprimedivisor n)"
    by (intro prime_aprimedivisor')
       (auto simp: primepow_def prime_gt_0_nat)
  hence "aprimedivisor n > 1" by (simp add: prime_gt_Suc_0_nat)
  with True show ?thesis by (auto simp: mangoldt_def abs_if)
qed (auto simp: mangoldt_def)

lemma Re_mangoldt [simp]: "Re (mangoldt n) = mangoldt n"
  and Im_mangoldt [simp]: "Im (mangoldt n) = 0"
  by (simp_all add: mangoldt_def)

lemma abs_mangoldt [simp]: "abs (mangoldt n :: real) = mangoldt n"
  using norm_mangoldt[of n, where ?'a = real, unfolded real_norm_def] .

lemma mangoldt_le:
  assumes "n > 0"
  shows   "mangoldt n \<le> ln n"
proof (cases "primepow n")
  case True
  from True have "prime (aprimedivisor n)"
    by (intro prime_aprimedivisor')
       (auto simp: primepow_def prime_gt_0_nat)
  hence gt_1: "aprimedivisor n > 1" by (simp add: prime_gt_Suc_0_nat)
  from True have "mangoldt n = ln (aprimedivisor n)"
    by (simp add: mangoldt_def)
  also have "\<dots> \<le> ln n" using True gt_1
    by (subst ln_le_cancel_iff) (auto intro!: Nat.gr0I dvd_imp_le aprimedivisor_dvd')
  finally show ?thesis .
qed (insert assms, auto simp: mangoldt_def)

end


section \<open>Countermodels from Hintikka sets\<close>

theory Countermodel
  imports Hintikka Usemantics ProverLemmas
begin

text \<open>In this theory, we will construct a countermodel in the bounded semantics from a Hintikka
  set. This will allow us to prove completeness of the prover.\<close>

text \<open>A predicate is satisfied in the model based on a set of formulas S when its negation is in S.\<close>
abbreviation (input)
  \<open>G S n ts \<equiv> Neg (Pre n ts) \<in> S\<close>

text \<open>Alternate interpretation for environments: if a variable is not present, we interpret it as
  some existing term.\<close>
abbreviation
  \<open>E S n \<equiv> if Var n \<in> terms S then Var n else SOME t. t \<in> terms S\<close>

text \<open>Alternate interpretation for functions: if a function application is not present, we interpret
  it as some existing term.\<close>
abbreviation
  \<open>F S i l \<equiv> if Fun i l \<in> terms S then Fun i l else SOME t. t \<in> terms S\<close>

text \<open>The terms function never returns the empty set (because it will add \<open>Fun 0 []\<close> if that is the
  case).\<close>
lemma terms_ne [simp]: \<open>terms S \<noteq> {}\<close>
  unfolding terms_def by simp

text \<open>If a term is in the set of terms, it is either the default term or a subterm of some formula
  in the set.\<close>
lemma terms_cases: \<open>t \<in> terms S \<Longrightarrow> t = Fun 0 [] \<or> (\<exists>p \<in> S. t \<in> set (subtermFm p))\<close>
  unfolding terms_def by (simp split: if_splits)

text \<open>The set of terms is downwards closed under the subterm function.\<close>
lemma terms_downwards_closed: \<open>t \<in> terms S \<Longrightarrow> set (subtermTm t) \<subseteq> terms S\<close>
proof (induct t)
  case (Fun n ts)
  moreover have \<open>\<forall>t \<in> set ts. t \<in> set ts\<close>
    by simp
  moreover have \<open>\<forall>t \<in> set ts. t \<in> terms S\<close>
  proof
    fix t
    assume *: \<open>t \<in> set ts\<close>
    then show \<open>t \<in> terms S\<close>
    proof (cases \<open>terms S = {Fun 0 []}\<close>)
      case True
      then show ?thesis
        using Fun * by simp
    next
      case False
      moreover obtain p where p: \<open>p \<in> S\<close> \<open>Fun n ts \<in> set (subtermFm p)\<close>
        using Fun(2) terms_cases * by fastforce
      then have \<open>set ts \<subseteq> set (subtermFm p)\<close>
        using fun_arguments_subterm by blast
      ultimately show \<open>t \<in> terms S\<close>
        unfolding terms_def using * p(1) by (metis UN_iff in_mono)
    qed
  qed
  ultimately have \<open>\<forall>t \<in> set ts. set (subtermTm t) \<subseteq> terms S\<close>
    using Fun by meson
  moreover note \<open>Fun n ts \<in> terms S\<close>
  ultimately show ?case
    by auto
next
  case (Var x)
  then show ?case
    by simp
qed

text \<open>If terms are actually in a set of formulas, interpreting the environment over these formulas
allows for a Herbrand interpretation.\<close>
lemma usemantics_E:
    \<open>t \<in> terms S \<Longrightarrow> semantics_term (E S) (F S) t = t\<close>
    \<open>list_all (\<lambda>t. t \<in> terms S) ts \<Longrightarrow> semantics_list (E S) (F S) ts = ts\<close>
proof (induct t and ts arbitrary: ts rule: semantics_term.induct semantics_list.induct)
  case (Fun i ts')
  moreover have \<open>\<forall>t' \<in> set ts'. t' \<in> set (subtermTm (Fun i ts'))\<close>
    using subterm_Fun_refl by blast
  ultimately have \<open>list_all (\<lambda>t. t \<in> terms S) ts'\<close>
    using terms_downwards_closed unfolding list_all_def by (metis (no_types, lifting) subsetD)
  then show ?case
    using Fun by simp
qed simp_all

text \<open>Our alternate interpretation of environments is well-formed for the terms function.\<close>
lemma is_env_E:
  \<open>is_env (terms S) (E S)\<close>
  unfolding is_env_def
proof
  fix n
  show \<open>E S n \<in> terms S\<close>
    by (cases \<open>Var n \<in> terms S\<close>) (simp_all add: some_in_eq)
qed

text \<open>Our alternate function interpretation is well-formed for the terms function.\<close>
lemma is_fdenot_F:
  \<open>is_fdenot (terms S) (F S)\<close>
  unfolding is_fdenot_def
proof (intro allI impI)
  fix i l
  assume \<open>list_all (\<lambda>x. x \<in> terms S) l\<close>
  then show \<open>F S i l \<in> terms S\<close>
    by (cases \<open>\<forall>n. Var n \<in> terms S\<close>) (simp_all add: some_in_eq)
qed

abbreviation
  \<open>M S \<equiv> usemantics (terms S) (E S) (F S) (G S)\<close>

text \<open>If S is a Hintikka set, then we can construct a countermodel for any formula using our
  bounded semantics and a Herbrand interpretation.\<close>
theorem Hintikka_counter_model:
  assumes \<open>Hintikka S\<close>
  shows \<open>(p \<in> S \<longrightarrow> \<not> M S p) \<and> (Neg p \<in> S \<longrightarrow> M S p)\<close>
proof (induct p rule: wf_induct [where r=\<open>measure size\<close>])
  case 1
  then show ?case ..
next
  fix x
  assume wf: \<open>\<forall>q. (q, x) \<in> measure size \<longrightarrow>
    (q \<in> S \<longrightarrow> \<not> M S q) \<and> (Neg q \<in> S \<longrightarrow> M S q)\<close>
  show \<open>(x \<in> S \<longrightarrow> \<not> M S x) \<and> (Neg x \<in> S \<longrightarrow> M S x)\<close>
  proof (cases x)
    case (Pre n ts)
    show ?thesis
    proof (intro conjI impI)
      assume \<open>x \<in> S\<close>
      then have \<open>Neg (Pre n ts) \<notin> S\<close>
        using assms Pre Hintikka.Basic by blast
      moreover have \<open>list_all (\<lambda>t. t \<in> terms S) ts\<close>
        using \<open>x \<in> S\<close> Pre subterm_Pre_refl unfolding terms_def list_all_def by force
      ultimately show \<open>\<not> M S x\<close>
        using Pre usemantics_E
        by (metis (no_types, lifting) usemantics.simps(1))
    next
      assume \<open>Neg x \<in> S\<close>
      then have \<open>G S n ts\<close>
        using assms Pre Hintikka.Basic by blast
      moreover have \<open>list_all (\<lambda>t. t \<in> terms S) ts\<close>
        using \<open>Neg x \<in> S\<close> Pre subterm_Pre_refl unfolding terms_def list_all_def by force
      ultimately show \<open>M S x\<close>
        using Pre usemantics_E
        by (metis (no_types, lifting) usemantics.simps(1))
    qed
  next
    case (Imp p q)
    show ?thesis
    proof (intro conjI impI)
      assume \<open>x \<in> S\<close>
      then have \<open>Neg p \<in> S\<close> \<open>q \<in> S\<close>
        using Imp assms Hintikka.AlphaImp by blast+
      then show \<open>\<not> M S x\<close>
        using wf Imp by fastforce
    next
      assume \<open>Neg x \<in> S\<close>
      then have \<open>p \<in> S \<or> Neg q \<in> S\<close>
        using Imp assms Hintikka.BetaImp by blast
      then show \<open>M S x\<close>
        using wf Imp by fastforce
    qed
  next
    case (Dis p q)
    show ?thesis
    proof (intro conjI impI)
      assume \<open>x \<in> S\<close>
      then have \<open>p \<in> S\<close> \<open>q \<in> S\<close>
        using Dis assms Hintikka.AlphaDis by blast+
      then show \<open>\<not> M S x\<close>
        using wf Dis by fastforce
    next
      assume \<open>Neg x \<in> S\<close>
      then have \<open>Neg p \<in> S \<or> Neg q \<in> S\<close>
        using Dis assms Hintikka.BetaDis by blast
      then show \<open>M S x\<close>
        using wf Dis by fastforce
    qed
  next
    case (Con p q)
    show ?thesis
    proof (intro conjI impI)
      assume \<open>x \<in> S\<close>
      then have \<open>p \<in> S \<or> q \<in> S\<close>
        using Con assms Hintikka.BetaCon by blast
      then show \<open>\<not> M S x\<close>
        using wf Con by fastforce
    next
      assume \<open>Neg x \<in> S\<close>
      then have \<open>Neg p \<in> S\<close> \<open>Neg q \<in> S\<close>
        using Con assms Hintikka.AlphaCon by blast+
      then show \<open>M S x\<close>
        using wf Con by fastforce
    qed
  next
    case (Exi p)
    show ?thesis
    proof (intro conjI impI)
      assume \<open>x \<in> S\<close>
      then have \<open>\<forall>t \<in> terms S. sub 0 t p \<in> S\<close>
        using Exi assms Hintikka.GammaExi by blast
      then have \<open>\<forall>t \<in> terms S. \<not> M S (sub 0 t p)\<close>
        using wf Exi size_sub
        by (metis (no_types, lifting) add.right_neutral add_Suc_right fm.size(12) in_measure lessI)
      moreover have \<open>\<forall>t \<in> terms S. semantics_term (E S) (F S) t = t\<close>
        using usemantics_E(1) terms_downwards_closed unfolding list_all_def by blast
      ultimately have \<open>\<forall>t \<in> terms S. \<not> usemantics (terms S) (SeCaV.shift (E S) 0 t) (F S) (G S) p\<close>
        by simp
      then show \<open>\<not> M S x\<close>
        using Exi by simp
    next
      assume \<open>Neg x \<in> S\<close>
      then obtain t where \<open>t \<in> terms S\<close> \<open>Neg (sub 0 t p) \<in> S\<close>
        using Exi assms Hintikka.DeltaExi by metis
      then have \<open>M S (sub 0 t p)\<close>
        using wf Exi size_sub
        by (metis (no_types, lifting) add.right_neutral add_Suc_right fm.size(12) in_measure lessI)
      moreover have \<open>semantics_term (E S) (F S) t = t\<close>
        using \<open>t \<in> terms S\<close> usemantics_E(1) terms_downwards_closed unfolding list_all_def by blast
      ultimately show \<open>M S x\<close>
        using Exi \<open>t \<in> terms S\<close> by auto
    qed
  next
    case (Uni p)
    show ?thesis
    proof (intro conjI impI)
      assume \<open>x \<in> S\<close>
      then obtain t where \<open>t \<in> terms S\<close> \<open>sub 0 t p \<in> S\<close>
        using Uni assms Hintikka.DeltaUni by metis
      then have \<open>\<not> M S (sub 0 t p)\<close>
        using wf Uni size_sub
        by (metis (no_types, lifting) add.right_neutral add_Suc_right fm.size(13) in_measure lessI)
      moreover have \<open>semantics_term (E S) (F S) t = t\<close>
        using \<open>t \<in> terms S\<close> usemantics_E(1) terms_downwards_closed unfolding list_all_def by blast
      ultimately show \<open>\<not> M S x\<close>
        using Uni \<open>t \<in> terms S\<close> by auto
    next
      assume \<open>Neg x \<in> S\<close>
      then have \<open>\<forall>t \<in> terms S. Neg (sub 0 t p) \<in> S\<close>
        using Uni assms Hintikka.GammaUni by blast
      then have \<open>\<forall>t \<in> terms S. M S (sub 0 t p)\<close>
        using wf Uni size_sub
        by (metis (no_types, lifting) Nat.add_0_right add_Suc_right fm.size(13) in_measure lessI)
      moreover have \<open>\<forall>t \<in> terms S. semantics_term (E S) (F S) t = t\<close>
        using usemantics_E(1) terms_downwards_closed unfolding list_all_def by blast
      ultimately have \<open>\<forall>t \<in> terms S. \<not> usemantics (terms S) (SeCaV.shift (E S) 0 t) (F S) (G S) (Neg p)\<close>
        by simp
      then show \<open>M S x\<close>
        using Uni by simp
    qed
  next
    case (Neg p)
    show ?thesis
    proof (intro conjI impI)
      assume \<open>x \<in> S\<close>
      then show \<open>\<not> M S x\<close>
        using wf Neg by fastforce
    next
      assume \<open>Neg x \<in> S\<close>
      then have \<open>p \<in> S\<close>
        using Neg assms Hintikka.Neg by blast
      then show \<open>M S x\<close>
        using wf Neg by fastforce
    qed
  qed
qed

end