section \<open>Cutoff Level\<close>

text \<open>This section verifies that the cutoff will be below @{term "q_max"} with high probability.
The result will be needed in Section~\ref{sec:accuracy}, where it is shown that the estimates
will be accurate for any cutoff below @{term "q_max"}.\<close>

theory Distributed_Distinct_Elements_Cutoff_Level
  imports
    Distributed_Distinct_Elements_Accuracy_Without_Cutoff
    Distributed_Distinct_Elements_Tail_Bounds
begin

hide_const Quantum.Z

unbundle intro_cong_syntax

lemma mono_real_of_int: "mono real_of_int"
  unfolding mono_def by auto

lemma Max_le_Sum:
  fixes f :: "'a \<Rightarrow> int"
  assumes "finite A"
  assumes "\<And>a. a \<in> A \<Longrightarrow> f a \<ge> 0"
  shows "Max (insert 0 (f ` A)) \<le> (\<Sum>a \<in>A .f a)" (is "?L \<le> ?R")
proof (cases "A\<noteq>{}")
  case True

  have 0: "f a \<le> (\<Sum>a \<in>A .f a)" if "a \<in> A" for a
    using that assms by (intro member_le_sum) auto

  have "?L = max 0 (Max (f ` A))"
    using True assms(1) by (subst Max_insert) auto
  also have "... = Max (max 0 ` f ` A)"
    using assms True by (intro mono_Max_commute monoI) auto
  also have "... = Max (f ` A)"
    unfolding image_image using assms
    by (intro arg_cong[where f="Max"] image_cong) auto
  also have "... \<le> ?R"
    using 0 True assms(1)
    by (intro iffD2[OF Max_le_iff]) auto
  finally show ?thesis by simp
next
  case False
  hence "A = {}" by simp
  then show ?thesis by simp
qed

context inner_algorithm_fix_A
begin

text \<open>The following inequality is true for base e on the entire domain ($x > 0$). It is
shown in @{thm [source] ln_add_one_self_le_self}. In the following it is established for base
$2$, where it holds for $x \geq 1$.\<close>

lemma log_2_estimate:
  assumes "x \<ge> (1::real)"
  shows "log 2 (1+x) \<le> x"
proof -
  define f where "f x = x - log 2 (1+ x)" for x :: real
  define f' where "f' x = 1 - 1/((x+1)*ln 2)" for x :: real

  have 0:"(f has_real_derivative (f' x)) (at x)" if "x > 0" for x
    unfolding f_def f'_def using that
    by (auto intro!: derivative_eq_intros)

  have "f' x \<ge> 0" if "1 \<le> x" for x :: real
  proof -
    have "(1::real) \<le> 2*ln 2"
      by (approximation 5)
    also have "... \<le> (x+1)*ln 2"
      using that by (intro mult_right_mono) auto
    finally have "1 \<le> (x+1)*ln 2" by simp
    hence "1/((x+1)*ln 2) \<le> 1"
      by simp
    thus ?thesis
      unfolding f'_def by simp
  qed

  hence "\<exists>y. (f has_real_derivative y) (at x) \<and> 0 \<le> y" if "x \<ge> 1" for x :: real
    using that order_less_le_trans[OF exp_gt_zero]
    by (intro exI[where x="f' x"] conjI 0) auto
  hence "f 1 \<le> f x"
    by (intro DERIV_nonneg_imp_nondecreasing[OF assms]) auto
  thus "?thesis"
    unfolding f_def by simp
qed

lemma cutoff_eq_7:
  "real X * 2 powr (-real q_max) / b \<le> 1"
proof -
  have "real X = 2 powr (log 2 X)"
    using X_ge_1 by (intro powr_log_cancel[symmetric]) auto
  also have "... \<le> 2 powr (nat \<lceil>log 2 X\<rceil>)"
    by (intro powr_mono) linarith+
  also have "... = 2 ^ (nat \<lceil>log 2 X\<rceil>)"
    by (subst powr_realpow) auto
  also have "... = real (2 ^ (nat \<lceil>log 2 (real X)\<rceil>))"
    by simp
  also have "... \<le> real (2 ^ (b_exp + nat (\<lceil>log 2 (real X)\<rceil> - int b_exp)))"
    by (intro Nat.of_nat_mono power_increasing) linarith+
  also have "... = b * 2^q_max"
    unfolding q_max_def b_def by (simp add: power_add)

  finally have "real X \<le> b * 2 ^ q_max" by simp
  thus ?thesis
    using b_min
    unfolding powr_minus inverse_eq_divide
    by (simp add:field_simps powr_realpow)
qed

lemma cutoff_eq_6:
  fixes k
  assumes "a \<in> A"
  shows " (\<integral>f. real_of_int (max 0 (int (f a) - int k)) \<partial>\<Psi>\<^sub>1) \<le> 2 powr (-real k)" (is "?L \<le> ?R")
proof (cases "k \<le> n_exp - 1")
  case True
  have a_le_n: "a < n"
    using assms A_range by auto

  have "?L = (\<integral>x. real_of_int (max 0 (int x - k)) \<partial>map_pmf (\<lambda>x. x a) \<Psi>\<^sub>1)"
    by simp
  also have "... = (\<integral>x. real_of_int (max 0 (int x - k)) \<partial>(\<G> n_exp))"
    unfolding \<Psi>\<^sub>1.single[OF a_le_n] by simp
  also have "... = (\<integral>x. max 0 (real x - real k) \<partial>(\<G> n_exp))"
    unfolding max_of_mono[OF mono_real_of_int,symmetric] by simp
  also have "... = (\<Sum>x\<le>n_exp.  max 0 (real x - real k) * pmf (\<G> n_exp) x)"
    using \<G>_range unfolding sample_space_alt[OF \<G>_sample_space]
    by (intro integral_measure_pmf_real) auto
  also have "... = (\<Sum>x=k+1..n_exp. (real x - real k) * pmf (\<G> n_exp) x)"
    by (intro sum.mono_neutral_cong_right) auto
  also have "... = (\<Sum>x=k+1..n_exp. (real x - real k) * measure (\<G> n_exp) {x})"
    unfolding measure_pmf_single by simp
  also have "... = (\<Sum>x=k+1..n_exp. (real x-real k)*(measure (\<G> n_exp) ({\<omega>. \<omega>\<ge>x}-{\<omega>. \<omega>\<ge>(x+1)})))"
    by (intro sum.cong arg_cong2[where f="(*)"] measure_pmf_cong) auto
  also have "... = (\<Sum>x=k+1..n_exp. (real x-real k)*
    (measure (\<G> n_exp) {\<omega>. \<omega>\<ge>x} - measure (\<G> n_exp) {\<omega>. \<omega>\<ge>(x+1)}))"
    by (intro sum.cong arg_cong2[where f="(*)"] measure_Diff) auto
  also have "... = (\<Sum>x=k+1..n_exp. (real x - real k) * (1/2^x - of_bool(x+1\<le>n_exp)/2^(x+1)))"
    unfolding \<G>_prob by (intro_cong "[\<sigma>\<^sub>2 (*), \<sigma>\<^sub>2 (-), \<sigma>\<^sub>2 (/)]" more:sum.cong) auto
  also have "... =
    (\<Sum>x=k+1..n_exp. (real x-k)/2^x) - (\<Sum>x=k+1..n_exp. (real x-k)* of_bool(x+1\<le>n_exp)/2^(x+1))"
    by (simp add:algebra_simps sum_subtractf)
  also have "...=(\<Sum>x=k+1..n_exp. (real x-k)/2^x)-(\<Sum>x=k+1..n_exp-1. (real x-k)/2^(x+1))"
    by (intro arg_cong2[where f="(-)"] refl sum.mono_neutral_cong_right) auto
  also have "...=(\<Sum>x=k+1..(n_exp-1)+1. (real x-k)/2^x)-(\<Sum>x=k+1..n_exp-1. (real x-k)/2^(x+1))"
    using n_exp_gt_0 by (intro arg_cong2[where f="(-)"] refl sum.cong) auto
  also have "...= (\<Sum>x\<in>insert k {k+1..n_exp-1}. (real (x+1)-k)/2^(x+1))-
    (\<Sum>x=k+1..n_exp-1. (real x-k)/2^(x+1))"
    unfolding sum.shift_bounds_cl_nat_ivl using True
    by (intro arg_cong2[where f="(-)"] sum.cong) auto
  also have "... = 1/2^(k+1)+(\<Sum>x=k+1..n_exp-1. (real (x+1)-k)/2^(x+1)- (real x-k)/2^(x+1))"
    by (subst sum.insert) (auto simp add:sum_subtractf)
  also have "... = 1/2^(k+1)+(\<Sum>x=k+1..n_exp-1. (1/2^(x+1)))"
    by (intro arg_cong2[where f="(+)"] sum.cong refl) (simp add:field_simps)
  also have "... = (\<Sum>x\<in>insert k {k+1..n_exp-1}. (1/2^(x+1)))"
    by (subst sum.insert) auto
  also have "... = (\<Sum>x=0+k..(n_exp-1-k)+k. 1/2^(x+1))"
    using True by (intro sum.cong) auto
  also have "... = (\<Sum>x<n_exp-k. 1/2^(x+k+1))"
    unfolding sum.shift_bounds_cl_nat_ivl using True n_exp_gt_0 by (intro sum.cong) auto
  also have "... = (1/2)^(k+1) * (\<Sum>x<n_exp-k. (1/2)^x)"
    unfolding  sum_distrib_left power_add[symmetric] by (simp add:power_divide ac_simps)
  also have "... = (1/2)^(k+1) * 2 * (1-(1 / 2) ^ (n_exp - k))"
    by (subst geometric_sum) auto
  also have "... \<le> (1/2)^(k+1) * 2 * (1-0)"
    by (intro mult_left_mono diff_mono) auto
  also have "... = (1/2)^k"
    unfolding power_add by simp
  also have "... = ?R"
    unfolding powr_minus by (simp add:powr_realpow inverse_eq_divide power_divide)
  finally show ?thesis
    by simp
next
  case False
  hence k_ge_n_exp: "k \<ge> n_exp"
    by simp
  have a_lt_n: "a < n"
    using assms A_range by auto

  have "?L = (\<integral>x. real_of_int (max 0 (int x - k)) \<partial>map_pmf (\<lambda>x. x a) \<Psi>\<^sub>1)"
    by simp
  also have "... = (\<integral>x. real_of_int (max 0 (int x - k)) \<partial>(\<G> n_exp))"
    unfolding \<Psi>\<^sub>1.single[OF a_lt_n] by simp
  also have "... = (\<integral>x. real_of_int 0 \<partial>(\<G> n_exp))"
    using \<G>_range k_ge_n_exp unfolding sample_space_alt[OF \<G>_sample_space]
    by (intro integral_cong_AE AE_pmfI iffD2[OF of_int_eq_iff] max_absorb1) force+
  also have "... = 0" by simp
  finally show ?thesis by simp
qed

lemma cutoff_eq_5:
  assumes "x \<ge> (-1 :: real)"
  shows "real_of_int \<lfloor>log 2 (x+2)\<rfloor> \<le> (real c+2) + max (x - 2^c) 0" (is "?L \<le> ?R")
proof -
  have 0: "1 \<le> 2 ^ 1 * ln (2::real)"
    by (approximation 5)

  consider (a) "c = 0 \<and> x \<ge> 2^c+1" | (b) "c > 0 \<and> x \<ge> 2^c+1" | (c) "x \<le> 2^c+1"
    by linarith
  hence "log 2 (x+2) \<le> ?R"
  proof (cases)
    case a
    have "log 2 (x+2) = log 2 (1+(x+1))"
      by (simp add:algebra_simps)
    also have "... \<le> x+1"
      using a by (intro log_2_estimate) auto
    also have "... = ?R"
      using a by auto
    finally show ?thesis by simp
  next
    case b
    have "0 < 0 + (1::real)"
      by simp
    also have "... \<le> 2^c+(1::real)"
      by (intro add_mono) auto
    also have "... \<le> x"
      using b by simp
    finally have x_gt_0: "x > 0"
      by simp

    have "log 2 (x+2) = log 2 ((x+2)/2^c) + c"
      using x_gt_0 by (subst log_divide) auto
    also have "... = log 2 (1+(x+2-2^c)/2^c) + c"
      by (simp add:divide_simps)
    also have "... \<le> (x+2-2^c)/2^c / ln 2 + c"
      using b unfolding log_def
      by (intro add_mono divide_right_mono ln_add_one_self_le_self divide_nonneg_pos) auto
    also have "... = (x+2-2^c)/(2^c*ln 2) + c"
      by simp
    also have "... \<le> (x+2-2^c)/(2^1*ln 2)+c"
      using b by (intro add_mono divide_left_mono mult_right_mono power_increasing) simp_all
    also have "... \<le> (x+2-2^c)/1 + c"
      using b by (intro add_mono divide_left_mono 0) auto
    also have "... \<le> (c+2) + max (x - 2^c) 0"
      using b by simp
    finally show ?thesis by simp
  next
    case c
    hence "log 2 (x+2) \<le> log 2 ((2^c+1)+2)"
      using assms by (intro log_mono add_mono) auto
    also have "... = log 2 (2^c*(1+3/2^c))"
      by (simp add:algebra_simps)
    also have "... = c + log 2 (1+3/2^c)"
      by (subst log_mult) (auto intro:add_pos_nonneg)
    also have "... \<le> c + log 2 (1+3/2^0)"
      by (intro add_mono log_mono divide_left_mono power_increasing add_pos_nonneg) auto
    also have "... = c + log 2 (2*2)"
      by simp
    also have "... = real c + 2"
      by (subst log_mult) auto
    also have "... \<le> (c+2) + max (x - 2^c) 0"
      by simp
    finally show ?thesis
      by simp
  qed
  moreover have "\<lfloor>log 2 (x+2)\<rfloor> \<le> log 2 (x+2)"
      by simp
  ultimately show ?thesis using order_trans by blast
qed

lemma cutoff_level:
  "measure \<Omega> {\<omega>. q \<omega> A > q_max} \<le> \<epsilon>/2" (is "?L \<le> ?R")
proof -
  have C\<^sub>1_est: "C\<^sub>1 * l \<le> 30 * real l"
    unfolding C\<^sub>1_def
    by (intro mult_right_mono of_nat_0_le_iff) (approximation 10)

  define Z where "Z \<omega> = (\<Sum>j<b. real_of_int \<lfloor>log 2 (of_int (max (\<tau>\<^sub>1 \<omega> A q_max j) (-1)) + 2)\<rfloor>)" for \<omega>
  define V where "V \<omega> = Z \<omega> / real b - 3" for \<omega>

  have 2:"Z \<psi> \<le> real b*(real c+2) + of_int (\<Sum>a\<in>A. max 0 (int (fst \<psi> a) - q_max -2^c))"
    (is "?L1 \<le> ?R1") if "\<psi> \<in> sample_set \<Psi>" for c \<psi>
  proof -
    obtain f g h where \<psi>_def: "\<psi> = (f,g,h)"
      using prod_cases3 by blast

    have \<psi>_range: "(f,g,h) \<in> sample_set \<Psi>"
      using that unfolding \<psi>_def by simp

    have "- 1 - 2^c \<le> -1-(1::real)"
      by (intro diff_mono) auto
    also have "... \<le> 0" by simp
    finally have "- 1 - 2 ^ c \<le> (0::real)" by simp
    hence aux3: "max (-1-2^c) 0 = (0::real)"
      by (intro max_absorb2)

    have "- 1 - int q_max - 2 ^ c \<le> -1 - 0 - 1"
      by (intro diff_mono) auto
    also have "... \<le> 0" by simp
    finally have "- 1 - int q_max - 2 ^ c \<le> 0" by simp
    hence aux3_2: "max 0 (- 1 - int q_max - 2 ^ c) = 0"
      by (intro max_absorb1)

    have "?L1 \<le> (\<Sum>j<b. (real c+2) + max (real_of_int (max (\<tau>\<^sub>1 \<psi> A q_max j) (- 1)) - 2^c) 0)"
      unfolding Z_def by (intro sum_mono cutoff_eq_5) auto
    also have "... = (\<Sum>j<b. (real c+2)+max (\<tau>\<^sub>0 \<psi> A j - q_max - 2^c) 0)"
      unfolding \<tau>\<^sub>1_def max_of_mono[OF mono_real_of_int,symmetric]
      by (intro_cong "[\<sigma>\<^sub>2 (+)]" more:sum.cong) (simp add:max_diff_distrib_left max.assoc aux3)
    also have "... = real b * (real c + 2) +
      of_int (\<Sum>j<b. (max 0 (Max (insert (- 1) {int (f a) |a. a \<in> A \<and> h (g a) = j})-q_max - 2^c)))"
      unfolding \<psi>_def by (simp add:max.commute)
    also have "... = real b * (real c + 2) +
      of_int (\<Sum>j<b. max 0 (Max ((\<lambda>x. x-q_max-2^c)`(insert(-1){int (f a) |a. a \<in> A\<and>h(g a)=j}))))"
      using fin_A
      by (intro_cong "[\<sigma>\<^sub>2 (+), \<sigma>\<^sub>1 of_int, \<sigma>\<^sub>2 max]" more:sum.cong mono_Max_commute) (auto simp:monoI)
    also have "... = real b * (real c + 2) +
      of_int(\<Sum>j<b. max 0(Max(insert(-1-q_max-2^c){int (f a)-q_max-2^c |a. a \<in> A \<and> h (g a) = j})))"
      by (intro_cong "[\<sigma>\<^sub>2 (+), \<sigma>\<^sub>1 of_int, \<sigma>\<^sub>2 max, \<sigma>\<^sub>1 Max]" more:sum.cong)  auto
    also have "... = real b * (real c + 2) + of_int
      (\<Sum>j<b. Max ((max 0) `(insert(-1-q_max-2^c){int (f a)-q_max-2^c |a. a \<in> A \<and> h (g a) = j})))"
      using fin_A by (intro_cong "[\<sigma>\<^sub>2 (+), \<sigma>\<^sub>1 of_int]" more:sum.cong mono_Max_commute)
        (auto simp add:monoI setcompr_eq_image)
    also have "... = real b * (real c + 2) +
      of_int (\<Sum>j<b. Max (insert 0 {max 0 (int (f a)-q_max-2^c) |a. a \<in> A \<and> h (g a) = j}))"
      using aux3_2 by (intro_cong "[\<sigma>\<^sub>2 (+), \<sigma>\<^sub>1 of_int, \<sigma>\<^sub>1 Max]" more:sum.cong)
        (simp add:setcompr_eq_image image_image)
    also have "... \<le> b*(real c+2)+ of_int(\<Sum>j<b. (\<Sum>a|a\<in>A\<and>h(g(a))=j. max 0(int(f a)-q_max-2^c)))"
      using fin_A Max_le_Sum unfolding setcompr_eq_image
      by (intro add_mono iffD2[OF of_int_le_iff] sum_mono Max_le_Sum) (simp_all)
    also have "... = real b*(real c+2)+
      of_int(\<Sum>a\<in>(\<Union>j\<in>{..<b}. {a. a\<in>A\<and> h(g(a)) = j}). max 0(int(f a)-q_max-2^c))"
      using fin_A
      by (intro_cong "[\<sigma>\<^sub>2 (+), \<sigma>\<^sub>1 of_int]" more:sum.UNION_disjoint[symmetric]) auto
    also have "... = real b*(real c+2) + of_int(\<Sum>a\<in>A. max 0(int(f a)-q_max-2^c))"
      using h_range[OF \<psi>_range] by (intro_cong "[\<sigma>\<^sub>2 (+), \<sigma>\<^sub>1 of_int]" more:sum.cong) auto
    also have "... = ?R1"
      unfolding \<psi>_def by simp
    finally show ?thesis
      by simp
  qed

  have 1: "measure \<Psi> {\<psi>. real c \<le> V \<psi>} \<le> 2 powr (- (2^c))" (is "?L1 \<le> ?R1") for c
  proof -
    have "?L1 = measure \<Psi> {\<psi>. real b * (real c + 3) \<le> Z \<psi>}"
      unfolding V_def using b_min by (intro measure_pmf_cong) (simp add:field_simps)
    also have "... \<le> measure \<Psi>
      {\<psi>. real b*(real c+3)\<le> real b*(real c+2)+ of_int (\<Sum>a\<in>A. max 0 (int (fst \<psi> a)-q_max -2^c))}"
      using 2 order_trans unfolding sample_space_alt[OF sample_space_\<Psi>]
      by (intro pmf_mono) blast
    also have "... = measure \<Psi> {\<psi>. real b \<le> (\<Sum>a\<in>A. of_int (max 0 (int (fst \<psi> a) -q_max -2^c)))}"
      by (intro measure_pmf_cong) (simp add:algebra_simps)
    also have "... \<le> (\<integral>\<psi>. (\<Sum>a\<in>A. of_int (max 0 (int (fst \<psi> a) -q_max -2^c))) \<partial>\<Psi>)/real b"
      using b_min sample_space_\<Psi> by (intro pmf_markov sum_nonneg) simp_all
    also have "... = (\<Sum>a\<in>A. (\<integral>\<psi>.  of_int (max 0 (int (fst \<psi> a) -q_max -2^c)) \<partial>\<Psi>))/real b"
      using sample_space_\<Psi> by (intro_cong "[\<sigma>\<^sub>2(/)]" more:Bochner_Integration.integral_sum) simp
    also have "... = (\<Sum>a\<in>A. (\<integral>f.  of_int (max 0 (int (f a)-q_max -2^c)) \<partial>(map_pmf fst \<Psi>)))/real b"
      by simp
    also have "... = (\<Sum>a\<in>A. (\<integral>f. of_int (max 0 (int (f a) - (q_max +2^c))) \<partial>\<Psi>\<^sub>1))/real b"
      unfolding sample_pmf_\<Psi> map_fst_pair_pmf by (simp add:algebra_simps)
    also have "... \<le> (\<Sum>a\<in>A. 2 powr -real (q_max + 2^c))/real b"
      using b_min by (intro sum_mono divide_right_mono cutoff_eq_6) auto
    also have "... = real X * 2 powr (- real q_max + (- (2 ^ c))) / real b"
      unfolding X_def by simp
    also have "... = (real X * 2 powr (-real q_max) / b) * 2 powr (-(2^c))"
      unfolding powr_add by (simp add:algebra_simps)
    also have "... \<le> 1 * 2 powr (-(2^c))"
      using cutoff_eq_7 by (intro mult_right_mono) auto
    finally show ?thesis
      by simp
  qed

  have 0: "measure \<Psi> {\<psi>. x \<le> V \<psi>} \<le> exp (- x * ln x ^ 3)"  (is "?L1 \<le> ?R1") if "x \<ge> 20" for x
  proof -
    define c where "c = nat \<lfloor>x\<rfloor>"

    have "x * ln x^3 \<le> exp (x * ln 2) * ln 2/2" if "x \<ge> 150" for x::real
    proof -
      have aux_aux_0: "x^4 \<ge> 0"
        by simp

      have "x * ln x^3 \<le> x * x^3"
        using that by (intro mult_left_mono power_mono ln_bound) auto
      also have "... = x^4 * 1"
        by (simp add:numeral_eq_Suc)
      also have "... \<le> x^4  * ((ln 2 / 10)^4 * (150 * (ln 2 / 10))^6  * (ln 2/2))"
        by (intro mult_left_mono aux_aux_0) (approximation 8)
      also have "... = (x * (ln 2 / 10))^4 * (150 * (ln 2 / 10))^6  * (ln 2/2)"
        unfolding power_mult_distrib by (simp add:algebra_simps)
      also have "... \<le> (x * (ln 2 / 10))^4 * (x * (ln 2 / 10))^6  * (ln 2/2)"
        by (intro mult_right_mono mult_left_mono power_mono that) auto
      also have "... = (0+x * (ln 2 / 10))^10 * (ln 2/2)"
        unfolding power_add[symmetric] by simp
      also have "... \<le> (1+x * ln 2 / 10)^10 * (ln 2/2)"
        using that by (intro mult_right_mono power_mono add_mono) auto
      also have "... \<le> exp (x * ln 2 / 10)^10 * (ln 2/2)"
        using that by (intro mult_right_mono power_mono exp_ge_add_one_self) auto
      also have "... = exp (x * ln 2) * (ln 2/2)"
        unfolding exp_of_nat_mult[symmetric] by simp
      finally show ?thesis by simp
    qed
    moreover have "x * ln x^3 \<le> exp (x * ln 2) * ln 2/2" if "x \<in> {20..150}"
      using that by (approximation 10 splitting: x=1)

    ultimately have "x * ln x^3 \<le> exp (x * ln 2) * ln 2/2"
      using that by fastforce
    also have "... = 2 powr (x-1) * ln 2"
      unfolding powr_diff unfolding powr_def by simp
    also have "... \<le> 2 powr c * ln 2"
      unfolding c_def using that
      by (intro mult_right_mono powr_mono) auto
    also have "... = 2^c * ln 2"
      using powr_realpow by simp
    finally have aux0: "x * ln x^3 \<le> 2^c * ln 2"
      by simp
    have "real c \<le> x"
      using that unfolding c_def by linarith
    hence "?L1 \<le> measure \<Psi> {\<psi>. real c \<le> V \<psi>}"
      by (intro pmf_mono) auto
    also have "... \<le> 2 powr (-(2^c))"
      by (intro 1)
    also have "... = exp (- (2 ^ c * ln 2))"
      by (simp add:powr_def)
    also have "... \<le> exp (- (x *ln x^3))"
      using aux0 by (intro iffD2[OF exp_le_cancel_iff]) auto
    also have "... = ?R1"
      by simp
    finally show ?thesis
      by simp
  qed

  have "?L \<le> measure \<Omega> {\<omega>. is_too_large (\<tau>\<^sub>2 \<omega> A q_max)}"
    using lt_s_too_large
    by (intro pmf_mono) (simp del:is_too_large.simps)
  also have "... = measure \<Omega>
    {\<omega>. (\<Sum>(i,j)\<in>{..<l}\<times>{..<b}. \<lfloor>log 2 (of_int (max (\<tau>\<^sub>2 \<omega> A q_max i j) (-1)) + 2)\<rfloor>) > C\<^sub>5 * b *l}"
    by simp
  also have "... = measure \<Omega> {\<omega>. real_of_int (\<Sum>(i,j)\<in>{..<l}\<times>{..<b}.
    \<lfloor>log 2 (of_int (max (\<tau>\<^sub>2 \<omega> A q_max i j) (-1)) + 2)\<rfloor>) > of_int (C\<^sub>5 * b * l)}"
    unfolding  of_int_less_iff by simp
  also have "... = measure \<Omega> {\<omega>. real_of_int C\<^sub>5 * real b * real l < of_int (\<Sum>x\<in>{..<l} \<times> {..<b}.
    \<lfloor>log 2 (real_of_int (\<tau>\<^sub>1 (\<omega> (fst x)) A q_max (snd x)) + 2)\<rfloor>)}"
    by (intro_cong "[\<sigma>\<^sub>2 measure, \<sigma>\<^sub>1 Collect, \<sigma>\<^sub>1 of_int, \<sigma>\<^sub>2 (<)]" more:ext sum.cong)
     (auto simp add:case_prod_beta \<tau>\<^sub>2_def \<tau>\<^sub>1_def)

  also have "... = measure \<Omega> {\<omega>. (\<Sum>i<l. Z (\<omega> i)) > of_int C\<^sub>5 * real b * real l}"
    unfolding Z_def sum.cartesian_product \<tau>\<^sub>1_def by (simp add:case_prod_beta)
  also have "... = measure \<Omega> {\<omega>. (\<Sum>i<l. V (\<omega> i) + 3) > of_int C\<^sub>5 * real l}"
    unfolding V_def using b_min
    by (intro measure_pmf_cong) (simp add:sum_divide_distrib[symmetric] field_simps sum.distrib)
  also have "... = measure \<Omega> {\<omega>. (\<Sum>i<l. V (\<omega> i)) > of_int (C\<^sub>5-3) * real l}"
    by (simp add:sum.distrib algebra_simps)
  also have "... \<le> measure \<Omega> {\<omega>. (\<Sum>i<l. V (\<omega> i)) \<ge> C\<^sub>1 * real l}"
    unfolding C\<^sub>5_def using C\<^sub>1_est by (intro pmf_mono) auto
  also have "... \<le> exp (- real l)"
    by (intro \<Omega>.deviation_bound l_gt_0 0) (simp_all add: \<Lambda>_def)
  also have "... \<le> exp (- (C\<^sub>6 * ln (2 / \<epsilon>)))"
    using l_lbound by (intro iffD2[OF exp_le_cancel_iff]) auto
  also have "... \<le> exp (- (1 * ln (2 / \<epsilon>)))"
    unfolding C\<^sub>6_def using \<epsilon>_gt_0 \<epsilon>_lt_1
    by (intro iffD2[OF exp_le_cancel_iff] le_imp_neg_le mult_right_mono ln_ge_zero) auto
  also have "... = exp ( ln ( \<epsilon> / 2))"
    using \<epsilon>_gt_0 by (simp add: ln_div)
  also have "... =  \<epsilon>/2"
    using \<epsilon>_gt_0 by simp
  finally show ?thesis
    by simp
qed

end

unbundle no_intro_cong_syntax

end


section \<open>The Residue Theorem, the Argument Principle and Rouch\'{e}'s Theorem\<close>
theory Residue_Theorem
  imports Complex_Residues
begin

subsection \<open>Cauchy's residue theorem\<close>

lemma get_integrable_path:
  assumes "open s" "connected (s-pts)" "finite pts" "f holomorphic_on (s-pts) " "a\<in>s-pts" "b\<in>s-pts"
  obtains g where "valid_path g" "pathstart g = a" "pathfinish g = b"
    "path_image g \<subseteq> s-pts" "f contour_integrable_on g" using assms
proof (induct arbitrary:s thesis a rule:finite_induct[OF \<open>finite pts\<close>])
  case 1
  obtain g where "valid_path g" "path_image g \<subseteq> s" "pathstart g = a" "pathfinish g = b"
    using connected_open_polynomial_connected[OF \<open>open s\<close>,of a b ] \<open>connected (s - {})\<close>
      valid_path_polynomial_function "1.prems"(6) "1.prems"(7) by auto
  moreover have "f contour_integrable_on g"
    using contour_integrable_holomorphic_simple[OF _ \<open>open s\<close> \<open>valid_path g\<close> \<open>path_image g \<subseteq> s\<close>,of f]
      \<open>f holomorphic_on s - {}\<close>
    by auto
  ultimately show ?case using "1"(1)[of g] by auto
next
  case idt:(2 p pts)
  obtain e where "e>0" and e:"\<forall>w\<in>ball a e. w \<in> s \<and> (w \<noteq> a \<longrightarrow> w \<notin> insert p pts)"
    using finite_ball_avoid[OF \<open>open s\<close> \<open>finite (insert p pts)\<close>, of a]
      \<open>a \<in> s - insert p pts\<close>
    by auto
  define a' where "a' \<equiv> a+e/2"
  have "a'\<in>s-{p} -pts"  using e[rule_format,of "a+e/2"] \<open>e>0\<close>
    by (auto simp add:dist_complex_def a'_def)
  then obtain g' where g'[simp]:"valid_path g'" "pathstart g' = a'" "pathfinish g' = b"
    "path_image g' \<subseteq> s - {p} - pts" "f contour_integrable_on g'"
    using idt.hyps(3)[of a' "s-{p}"] idt.prems idt.hyps(1)
    by (metis Diff_insert2 open_delete)
  define g where "g \<equiv> linepath a a' +++ g'"
  have "valid_path g" unfolding g_def by (auto intro: valid_path_join)
  moreover have "pathstart g = a" and  "pathfinish g = b" unfolding g_def by auto
  moreover have "path_image g \<subseteq> s - insert p pts" unfolding g_def
    proof (rule subset_path_image_join)
      have "closed_segment a a' \<subseteq> ball a e" using \<open>e>0\<close>
        by (auto dest!:segment_bound1 simp:a'_def dist_complex_def norm_minus_commute)
      then show "path_image (linepath a a') \<subseteq> s - insert p pts" using e idt(9)
        by auto
    next
      show "path_image g' \<subseteq> s - insert p pts" using g'(4) by blast
    qed
  moreover have "f contour_integrable_on g"
    proof -
      have "closed_segment a a' \<subseteq> ball a e" using \<open>e>0\<close>
        by (auto dest!:segment_bound1 simp:a'_def dist_complex_def norm_minus_commute)
      then have "continuous_on (closed_segment a a') f"
        using e idt.prems(6) holomorphic_on_imp_continuous_on[OF idt.prems(5)]
        apply (elim continuous_on_subset)
        by auto
      then have "f contour_integrable_on linepath a a'"
        using contour_integrable_continuous_linepath by auto
      then show ?thesis unfolding g_def
        apply (rule contour_integrable_joinI)
        by (auto simp add: \<open>e>0\<close>)
    qed
  ultimately show ?case using idt.prems(1)[of g] by auto
qed

lemma Cauchy_theorem_aux:
  assumes "open s" "connected (s-pts)" "finite pts" "pts \<subseteq> s" "f holomorphic_on s-pts"
          "valid_path g" "pathfinish g = pathstart g" "path_image g \<subseteq> s-pts"
          "\<forall>z. (z \<notin> s) \<longrightarrow> winding_number g z  = 0"
          "\<forall>p\<in>s. h p>0 \<and> (\<forall>w\<in>cball p (h p). w\<in>s \<and> (w\<noteq>p \<longrightarrow> w \<notin> pts))"
  shows "contour_integral g f = (\<Sum>p\<in>pts. winding_number g p * contour_integral (circlepath p (h p)) f)"
    using assms
proof (induct arbitrary:s g rule:finite_induct[OF \<open>finite pts\<close>])
  case 1
  then show ?case by (simp add: Cauchy_theorem_global contour_integral_unique)
next
  case (2 p pts)
  note fin[simp] = \<open>finite (insert p pts)\<close>
    and connected = \<open>connected (s - insert p pts)\<close>
    and valid[simp] = \<open>valid_path g\<close>
    and g_loop[simp] = \<open>pathfinish g = pathstart g\<close>
    and holo[simp]= \<open>f holomorphic_on s - insert p pts\<close>
    and path_img = \<open>path_image g \<subseteq> s - insert p pts\<close>
    and winding = \<open>\<forall>z. z \<notin> s \<longrightarrow> winding_number g z = 0\<close>
    and h = \<open>\<forall>pa\<in>s. 0 < h pa \<and> (\<forall>w\<in>cball pa (h pa). w \<in> s \<and> (w \<noteq> pa \<longrightarrow> w \<notin> insert p pts))\<close>
  have "h p>0" and "p\<in>s"
    and h_p: "\<forall>w\<in>cball p (h p). w \<in> s \<and> (w \<noteq> p \<longrightarrow> w \<notin> insert p pts)"
    using h \<open>insert p pts \<subseteq> s\<close> by auto
  obtain pg where pg[simp]: "valid_path pg" "pathstart pg = pathstart g" "pathfinish pg=p+h p"
      "path_image pg \<subseteq> s-insert p pts" "f contour_integrable_on pg"
    proof -
      have "p + h p\<in>cball p (h p)" using h[rule_format,of p]
        by (simp add: \<open>p \<in> s\<close> dist_norm)
      then have "p + h p \<in> s - insert p pts" using h[rule_format,of p] \<open>insert p pts \<subseteq> s\<close>
        by fastforce
      moreover have "pathstart g \<in> s - insert p pts " using path_img by auto
      ultimately show ?thesis
        using get_integrable_path[OF \<open>open s\<close> connected fin holo,of "pathstart g" "p+h p"] that
        by blast
    qed
  obtain n::int where "n=winding_number g p"
    using integer_winding_number[OF _ g_loop,of p] valid path_img
    by (metis DiffD2 Ints_cases insertI1 subset_eq valid_path_imp_path)
  define p_circ where "p_circ \<equiv> circlepath p (h p)"
  define p_circ_pt where "p_circ_pt \<equiv> linepath (p+h p) (p+h p)"
  define n_circ where "n_circ \<equiv> \<lambda>n. ((+++) p_circ ^^ n) p_circ_pt"
  define cp where "cp \<equiv> if n\<ge>0 then reversepath (n_circ (nat n)) else n_circ (nat (- n))"
  have n_circ:"valid_path (n_circ k)"
      "winding_number (n_circ k) p = k"
      "pathstart (n_circ k) = p + h p" "pathfinish (n_circ k) = p + h p"
      "path_image (n_circ k) =  (if k=0 then {p + h p} else sphere p (h p))"
      "p \<notin> path_image (n_circ k)"
      "\<And>p'. p'\<notin>s - pts \<Longrightarrow> winding_number (n_circ k) p'=0 \<and> p'\<notin>path_image (n_circ k)"
      "f contour_integrable_on (n_circ k)"
      "contour_integral (n_circ k) f = k *  contour_integral p_circ f"
      for k
    proof (induct k)
      case 0
      show "valid_path (n_circ 0)"
        and "path_image (n_circ 0) =  (if 0=0 then {p + h p} else sphere p (h p))"
        and "winding_number (n_circ 0) p = of_nat 0"
        and "pathstart (n_circ 0) = p + h p"
        and "pathfinish (n_circ 0) = p + h p"
        and "p \<notin> path_image (n_circ 0)"
        unfolding n_circ_def p_circ_pt_def using \<open>h p > 0\<close>
        by (auto simp add: dist_norm)
      show "winding_number (n_circ 0) p'=0 \<and> p'\<notin>path_image (n_circ 0)" when "p'\<notin>s- pts" for p'
        unfolding n_circ_def p_circ_pt_def
        apply (auto intro!:winding_number_trivial)
        by (metis Diff_iff pathfinish_in_path_image pg(3) pg(4) subsetCE subset_insertI that)+
      show "f contour_integrable_on (n_circ 0)"
        unfolding n_circ_def p_circ_pt_def
        by (auto intro!:contour_integrable_continuous_linepath simp add:continuous_on_sing)
      show "contour_integral (n_circ 0) f = of_nat 0  *  contour_integral p_circ f"
        unfolding n_circ_def p_circ_pt_def by auto
    next
      case (Suc k)
      have n_Suc:"n_circ (Suc k) = p_circ +++ n_circ k" unfolding n_circ_def by auto
      have pcirc:"p \<notin> path_image p_circ" "valid_path p_circ" "pathfinish p_circ = pathstart (n_circ k)"
        using Suc(3) unfolding p_circ_def using \<open>h p > 0\<close> by (auto simp add: p_circ_def)
      have pcirc_image:"path_image p_circ \<subseteq> s - insert p pts"
        proof -
          have "path_image p_circ \<subseteq> cball p (h p)" using \<open>0 < h p\<close> p_circ_def by auto
          then show ?thesis using h_p pcirc(1) by auto
        qed
      have pcirc_integrable:"f contour_integrable_on p_circ"
        by (auto simp add:p_circ_def intro!: pcirc_image[unfolded p_circ_def]
          contour_integrable_continuous_circlepath holomorphic_on_imp_continuous_on
          holomorphic_on_subset[OF holo])
      show "valid_path (n_circ (Suc k))"
        using valid_path_join[OF pcirc(2) Suc(1) pcirc(3)] unfolding n_circ_def by auto
      show "path_image (n_circ (Suc k))
          = (if Suc k = 0 then {p + complex_of_real (h p)} else sphere p (h p))"
        proof -
          have "path_image p_circ = sphere p (h p)"
            unfolding p_circ_def using \<open>0 < h p\<close> by auto
          then show ?thesis unfolding n_Suc  using Suc.hyps(5)  \<open>h p>0\<close>
            by (auto simp add:  path_image_join[OF pcirc(3)]  dist_norm)
        qed
      then show "p \<notin> path_image (n_circ (Suc k))" using \<open>h p>0\<close> by auto
      show "winding_number (n_circ (Suc k)) p = of_nat (Suc k)"
        proof -
          have "winding_number p_circ p = 1"
            by (simp add: \<open>h p > 0\<close> p_circ_def winding_number_circlepath_centre)
          moreover have "p \<notin> path_image (n_circ k)" using Suc(5) \<open>h p>0\<close> by auto
          then have "winding_number (p_circ +++ n_circ k) p
              = winding_number p_circ p + winding_number (n_circ k) p"
            using  valid_path_imp_path Suc.hyps(1) Suc.hyps(2) pcirc
            apply (intro winding_number_join)
            by auto
          ultimately show ?thesis using Suc(2) unfolding n_circ_def
            by auto
        qed
      show "pathstart (n_circ (Suc k)) = p + h p"
        by (simp add: n_circ_def p_circ_def)
      show "pathfinish (n_circ (Suc k)) = p + h p"
        using Suc(4) unfolding n_circ_def by auto
      show "winding_number (n_circ (Suc k)) p'=0 \<and>  p'\<notin>path_image (n_circ (Suc k))" when "p'\<notin>s-pts" for p'
        proof -
          have " p' \<notin> path_image p_circ" using \<open>p \<in> s\<close> h p_circ_def that using pcirc_image by blast
          moreover have "p' \<notin> path_image (n_circ k)"
            using Suc.hyps(7) that by blast
          moreover have "winding_number p_circ p' = 0"
            proof -
              have "path_image p_circ \<subseteq> cball p (h p)"
                using h unfolding p_circ_def using \<open>p \<in> s\<close> by fastforce
              moreover have "p'\<notin>cball p (h p)" using \<open>p \<in> s\<close> h that "2.hyps"(2) by fastforce
              ultimately show ?thesis unfolding p_circ_def
                apply (intro winding_number_zero_outside)
                by auto
            qed
          ultimately show ?thesis
            unfolding n_Suc
            apply (subst winding_number_join)
            by (auto simp: valid_path_imp_path pcirc Suc that not_in_path_image_join Suc.hyps(7)[OF that])
        qed
      show "f contour_integrable_on (n_circ (Suc k))"
        unfolding n_Suc
        by (rule contour_integrable_joinI[OF pcirc_integrable Suc(8) pcirc(2) Suc(1)])
      show "contour_integral (n_circ (Suc k)) f = (Suc k) *  contour_integral p_circ f"
        unfolding n_Suc
        by (auto simp add:contour_integral_join[OF pcirc_integrable Suc(8) pcirc(2) Suc(1)]
          Suc(9) algebra_simps)
    qed
  have cp[simp]:"pathstart cp = p + h p"  "pathfinish cp = p + h p"
         "valid_path cp" "path_image cp \<subseteq> s - insert p pts"
         "winding_number cp p = - n"
         "\<And>p'. p'\<notin>s - pts \<Longrightarrow> winding_number cp p'=0 \<and> p' \<notin> path_image cp"
         "f contour_integrable_on cp"
         "contour_integral cp f = - n * contour_integral p_circ f"
    proof -
      show "pathstart cp = p + h p" and "pathfinish cp = p + h p" and "valid_path cp"
        using n_circ unfolding cp_def by auto
    next
      have "sphere p (h p) \<subseteq>  s - insert p pts"
        using h[rule_format,of p] \<open>insert p pts \<subseteq> s\<close> by force
      moreover  have "p + complex_of_real (h p) \<in> s - insert p pts"
        using pg(3) pg(4) by (metis pathfinish_in_path_image subsetCE)
      ultimately show "path_image cp \<subseteq>  s - insert p pts" unfolding cp_def
        using n_circ(5)  by auto
    next
      show "winding_number cp p = - n"
        unfolding cp_def using winding_number_reversepath n_circ \<open>h p>0\<close>
        by (auto simp: valid_path_imp_path)
    next
      show "winding_number cp p'=0 \<and> p' \<notin> path_image cp" when "p'\<notin>s - pts" for p'
        unfolding cp_def
        apply (auto)
        apply (subst winding_number_reversepath)
        by (auto simp add: valid_path_imp_path n_circ(7)[OF that] n_circ(1))
    next
      show "f contour_integrable_on cp" unfolding cp_def
        using contour_integrable_reversepath_eq n_circ(1,8) by auto
    next
      show "contour_integral cp f = - n * contour_integral p_circ f"
        unfolding cp_def using contour_integral_reversepath[OF n_circ(1)] n_circ(9)
        by auto
    qed
  define g' where "g' \<equiv> g +++ pg +++ cp +++ (reversepath pg)"
  have "contour_integral g' f = (\<Sum>p\<in>pts. winding_number g' p * contour_integral (circlepath p (h p)) f)"
    proof (rule "2.hyps"(3)[of "s-{p}" "g'",OF _ _ \<open>finite pts\<close> ])
      show "connected (s - {p} - pts)" using connected by (metis Diff_insert2)
      show "open (s - {p})" using \<open>open s\<close> by auto
      show " pts \<subseteq> s - {p}" using \<open>insert p pts \<subseteq> s\<close> \<open> p \<notin> pts\<close>  by blast
      show "f holomorphic_on s - {p} - pts" using holo \<open>p \<notin> pts\<close> by (metis Diff_insert2)
      show "valid_path g'"
        unfolding g'_def cp_def using n_circ valid pg g_loop
        by (auto intro!:valid_path_join )
      show "pathfinish g' = pathstart g'"
        unfolding g'_def cp_def using pg(2) by simp
      show "path_image g' \<subseteq> s - {p} - pts"
        proof -
          define s' where "s' \<equiv> s - {p} - pts"
          have s':"s' = s-insert p pts " unfolding s'_def by auto
          then show ?thesis using path_img pg(4) cp(4)
            unfolding g'_def
            apply (fold s'_def s')
            apply (intro subset_path_image_join)
            by auto
        qed
      note path_join_imp[simp]
      show "\<forall>z. z \<notin> s - {p} \<longrightarrow> winding_number g' z = 0"
        proof clarify
          fix z assume z:"z\<notin>s - {p}"
          have "winding_number (g +++ pg +++ cp +++ reversepath pg) z = winding_number g z
              + winding_number (pg +++ cp +++ (reversepath pg)) z"
            proof (rule winding_number_join)
              show "path g" using \<open>valid_path g\<close> by (simp add: valid_path_imp_path)
              show "z \<notin> path_image g" using z path_img by auto
              show "path (pg +++ cp +++ reversepath pg)" using pg(3) cp
                by (simp add: valid_path_imp_path)
            next
              have "path_image (pg +++ cp +++ reversepath pg) \<subseteq> s - insert p pts"
                using pg(4) cp(4) by (auto simp:subset_path_image_join)
              then show "z \<notin> path_image (pg +++ cp +++ reversepath pg)" using z by auto
            next
              show "pathfinish g = pathstart (pg +++ cp +++ reversepath pg)" using g_loop by auto
            qed
          also have "... = winding_number g z + (winding_number pg z
              + winding_number (cp +++ (reversepath pg)) z)"
            proof (subst add_left_cancel,rule winding_number_join)
              show "path pg" and "path (cp +++ reversepath pg)"
               and "pathfinish pg = pathstart (cp +++ reversepath pg)"
                by (auto simp add: valid_path_imp_path)
              show "z \<notin> path_image pg" using pg(4) z by blast
              show "z \<notin> path_image (cp +++ reversepath pg)" using z
                by (metis Diff_iff \<open>z \<notin> path_image pg\<close> contra_subsetD cp(4) insertI1
                  not_in_path_image_join path_image_reversepath singletonD)
            qed
          also have "... = winding_number g z + (winding_number pg z
              + (winding_number cp z + winding_number (reversepath pg) z))"
            apply (auto intro!:winding_number_join simp: valid_path_imp_path)
            apply (metis Diff_iff contra_subsetD cp(4) insertI1 singletonD z)
            by (metis Diff_insert2 Diff_subset contra_subsetD pg(4) z)
          also have "... = winding_number g z + winding_number cp z"
            apply (subst winding_number_reversepath)
            apply (auto simp: valid_path_imp_path)
            by (metis Diff_iff contra_subsetD insertI1 pg(4) singletonD z)
          finally have "winding_number g' z = winding_number g z + winding_number cp z"
            unfolding g'_def .
          moreover have "winding_number g z + winding_number cp z = 0"
            using winding z \<open>n=winding_number g p\<close> by auto
          ultimately show "winding_number g' z = 0" unfolding g'_def by auto
        qed
      show "\<forall>pa\<in>s - {p}. 0 < h pa \<and> (\<forall>w\<in>cball pa (h pa). w \<in> s - {p} \<and> (w \<noteq> pa \<longrightarrow> w \<notin> pts))"
        using h by fastforce
    qed
  moreover have "contour_integral g' f = contour_integral g f
      - winding_number g p * contour_integral p_circ f"
    proof -
      have "contour_integral g' f =  contour_integral g f
        + contour_integral (pg +++ cp +++ reversepath pg) f"
        unfolding g'_def
        apply (subst contour_integral_join)
        by (auto simp add:open_Diff[OF \<open>open s\<close>,OF finite_imp_closed[OF fin]]
          intro!: contour_integrable_holomorphic_simple[OF holo _ _ path_img]
          contour_integrable_reversepath)
      also have "... = contour_integral g f + contour_integral pg f
          + contour_integral (cp +++ reversepath pg) f"
        apply (subst contour_integral_join)
        by (auto simp add:contour_integrable_reversepath)
      also have "... = contour_integral g f + contour_integral pg f
          + contour_integral cp f + contour_integral (reversepath pg) f"
        apply (subst contour_integral_join)
        by (auto simp add:contour_integrable_reversepath)
      also have "... = contour_integral g f + contour_integral cp f"
        using contour_integral_reversepath
        by (auto simp add:contour_integrable_reversepath)
      also have "... = contour_integral g f - winding_number g p * contour_integral p_circ f"
        using \<open>n=winding_number g p\<close> by auto
      finally show ?thesis .
    qed
  moreover have "winding_number g' p' = winding_number g p'" when "p'\<in>pts" for p'
    proof -
      have [simp]: "p' \<notin> path_image g" "p' \<notin> path_image pg" "p'\<notin>path_image cp"
        using "2.prems"(8) that
        apply blast
        apply (metis Diff_iff Diff_insert2 contra_subsetD pg(4) that)
        by (meson DiffD2 cp(4) rev_subsetD subset_insertI that)
      have "winding_number g' p' = winding_number g p'
          + winding_number (pg +++ cp +++ reversepath pg) p'" unfolding g'_def
        apply (subst winding_number_join)
        apply (simp_all add: valid_path_imp_path)
        apply (intro not_in_path_image_join)
        by auto
      also have "... = winding_number g p' + winding_number pg p'
          + winding_number (cp +++ reversepath pg) p'"
        apply (subst winding_number_join)
        apply (simp_all add: valid_path_imp_path)
        apply (intro not_in_path_image_join)
        by auto
      also have "... = winding_number g p' + winding_number pg p'+ winding_number cp p'
          + winding_number (reversepath pg) p'"
        apply (subst winding_number_join)
        by (simp_all add: valid_path_imp_path)
      also have "... = winding_number g p' + winding_number cp p'"
        apply (subst winding_number_reversepath)
        by (simp_all add: valid_path_imp_path)
      also have "... = winding_number g p'" using that by auto
      finally show ?thesis .
    qed
  ultimately show ?case unfolding p_circ_def
    apply (subst (asm) sum.cong[OF refl,
        of pts _ "\<lambda>p. winding_number g p * contour_integral (circlepath p (h p)) f"])
    by (auto simp add:sum.insert[OF \<open>finite pts\<close> \<open>p\<notin>pts\<close>] algebra_simps)
qed

lemma Cauchy_theorem_singularities:
  assumes "open s" "connected s" "finite pts" and
          holo:"f holomorphic_on s-pts" and
          "valid_path g" and
          loop:"pathfinish g = pathstart g" and
          "path_image g \<subseteq> s-pts" and
          homo:"\<forall>z. (z \<notin> s) \<longrightarrow> winding_number g z  = 0" and
          avoid:"\<forall>p\<in>s. h p>0 \<and> (\<forall>w\<in>cball p (h p). w\<in>s \<and> (w\<noteq>p \<longrightarrow> w \<notin> pts))"
  shows "contour_integral g f = (\<Sum>p\<in>pts. winding_number g p * contour_integral (circlepath p (h p)) f)"
    (is "?L=?R")
proof -
  define circ where "circ \<equiv> \<lambda>p. winding_number g p * contour_integral (circlepath p (h p)) f"
  define pts1 where "pts1 \<equiv> pts \<inter> s"
  define pts2 where "pts2 \<equiv> pts - pts1"
  have "pts=pts1 \<union> pts2" "pts1 \<inter> pts2 = {}" "pts2 \<inter> s={}" "pts1\<subseteq>s"
    unfolding pts1_def pts2_def by auto
  have "contour_integral g f =  (\<Sum>p\<in>pts1. circ p)" unfolding circ_def
    proof (rule Cauchy_theorem_aux[OF \<open>open s\<close> _ _ \<open>pts1\<subseteq>s\<close> _ \<open>valid_path g\<close> loop _ homo])
      have "finite pts1" unfolding pts1_def using \<open>finite pts\<close> by auto
      then show "connected (s - pts1)"
        using \<open>open s\<close> \<open>connected s\<close> connected_open_delete_finite[of s] by auto
    next
      show "finite pts1" using \<open>pts = pts1 \<union> pts2\<close> assms(3) by auto
      show "f holomorphic_on s - pts1" by (metis Diff_Int2 Int_absorb holo pts1_def)
      show "path_image g \<subseteq> s - pts1" using assms(7) pts1_def by auto
      show "\<forall>p\<in>s. 0 < h p \<and> (\<forall>w\<in>cball p (h p). w \<in> s \<and> (w \<noteq> p \<longrightarrow> w \<notin> pts1))"
        by (simp add: avoid pts1_def)
    qed
  moreover have "sum circ pts2=0"
    proof -
      have "winding_number g p=0" when "p\<in>pts2" for p
        using  \<open>pts2 \<inter> s={}\<close> that homo[rule_format,of p] by auto
      thus ?thesis unfolding circ_def
        apply (intro sum.neutral)
        by auto
    qed
  moreover have "?R=sum circ pts1 + sum circ pts2"
    unfolding circ_def
    using sum.union_disjoint[OF _ _ \<open>pts1 \<inter> pts2 = {}\<close>] \<open>finite pts\<close> \<open>pts=pts1 \<union> pts2\<close>
    by blast
  ultimately show ?thesis
    apply (fold circ_def)
    by auto
qed

theorem Residue_theorem:
  fixes s pts::"complex set" and f::"complex \<Rightarrow> complex"
    and g::"real \<Rightarrow> complex"
  assumes "open s" "connected s" "finite pts" and
          holo:"f holomorphic_on s-pts" and
          "valid_path g" and
          loop:"pathfinish g = pathstart g" and
          "path_image g \<subseteq> s-pts" and
          homo:"\<forall>z. (z \<notin> s) \<longrightarrow> winding_number g z  = 0"
  shows "contour_integral g f = 2 * pi * \<i> *(\<Sum>p\<in>pts. winding_number g p * residue f p)"
proof -
  define c where "c \<equiv>  2 * pi * \<i>"
  obtain h where avoid:"\<forall>p\<in>s. h p>0 \<and> (\<forall>w\<in>cball p (h p). w\<in>s \<and> (w\<noteq>p \<longrightarrow> w \<notin> pts))"
    using finite_cball_avoid[OF \<open>open s\<close> \<open>finite pts\<close>] by metis
  have "contour_integral g f
      = (\<Sum>p\<in>pts. winding_number g p * contour_integral (circlepath p (h p)) f)"
    using Cauchy_theorem_singularities[OF assms avoid] .
  also have "... = (\<Sum>p\<in>pts.  c * winding_number g p * residue f p)"
    proof (intro sum.cong)
      show "pts = pts" by simp
    next
      fix x assume "x \<in> pts"
      show "winding_number g x * contour_integral (circlepath x (h x)) f
          = c * winding_number g x * residue f x"
        proof (cases "x\<in>s")
          case False
          then have "winding_number g x=0" using homo by auto
          thus ?thesis by auto
        next
          case True
          have "contour_integral (circlepath x (h x)) f = c* residue f x"
            using \<open>x\<in>pts\<close> \<open>finite pts\<close> avoid[rule_format,OF True]
            apply (intro base_residue[of "s-(pts-{x})",THEN contour_integral_unique,folded c_def])
            by (auto intro:holomorphic_on_subset[OF holo] open_Diff[OF \<open>open s\<close> finite_imp_closed])
          then show ?thesis by auto
        qed
    qed
  also have "... = c * (\<Sum>p\<in>pts. winding_number g p * residue f p)"
    by (simp add: sum_distrib_left algebra_simps)
  finally show ?thesis unfolding c_def .
qed

subsection \<open>The argument principle\<close>

theorem argument_principle:
  fixes f::"complex \<Rightarrow> complex" and poles s:: "complex set"
  defines "pz \<equiv> {w. f w = 0 \<or> w \<in> poles}" \<comment> \<open>\<^term>\<open>pz\<close> is the set of poles and zeros\<close>
  assumes "open s" and
          "connected s" and
          f_holo:"f holomorphic_on s-poles" and
          h_holo:"h holomorphic_on s" and
          "valid_path g" and
          loop:"pathfinish g = pathstart g" and
          path_img:"path_image g \<subseteq> s - pz" and
          homo:"\<forall>z. (z \<notin> s) \<longrightarrow> winding_number g z = 0" and
          finite:"finite pz" and
          poles:"\<forall>p\<in>poles. is_pole f p"
  shows "contour_integral g (\<lambda>x. deriv f x * h x / f x) = 2 * pi * \<i> *
          (\<Sum>p\<in>pz. winding_number g p * h p * zorder f p)"
    (is "?L=?R")
proof -
  define c where "c \<equiv> 2 * complex_of_real pi * \<i> "
  define ff where "ff \<equiv> (\<lambda>x. deriv f x * h x / f x)"
  define cont where "cont \<equiv> \<lambda>ff p e. (ff has_contour_integral c * zorder f p * h p ) (circlepath p e)"
  define avoid where "avoid \<equiv> \<lambda>p e. \<forall>w\<in>cball p e. w \<in> s \<and> (w \<noteq> p \<longrightarrow> w \<notin> pz)"

  have "\<exists>e>0. avoid p e \<and> (p\<in>pz \<longrightarrow> cont ff p e)" when "p\<in>s" for p
  proof -
    obtain e1 where "e1>0" and e1_avoid:"avoid p e1"
      using finite_cball_avoid[OF \<open>open s\<close> finite] \<open>p\<in>s\<close> unfolding avoid_def by auto
    have "\<exists>e2>0. cball p e2 \<subseteq> ball p e1 \<and> cont ff p e2" when "p\<in>pz"
    proof -
      define po where "po \<equiv> zorder f p"
      define pp where "pp \<equiv> zor_poly f p"
      define f' where "f' \<equiv> \<lambda>w. pp w * (w - p) powr po"
      define ff' where "ff' \<equiv> (\<lambda>x. deriv f' x * h x / f' x)"
      obtain r where "pp p\<noteq>0" "r>0" and
          "r<e1" and
          pp_holo:"pp holomorphic_on cball p r" and
          pp_po:"(\<forall>w\<in>cball p r-{p}. f w = pp w * (w - p) powr po \<and> pp w \<noteq> 0)"
      proof -
        have "isolated_singularity_at f p"
        proof -
          have "f holomorphic_on ball p e1 - {p}"
            apply (intro holomorphic_on_subset[OF f_holo])
            using e1_avoid \<open>p\<in>pz\<close> unfolding avoid_def pz_def by force
          then show ?thesis unfolding isolated_singularity_at_def
            using \<open>e1>0\<close> analytic_on_open open_delete by blast
        qed
        moreover have "not_essential f p"
        proof (cases "is_pole f p")
          case True
          then show ?thesis unfolding not_essential_def by auto
        next
          case False
          then have "p\<in>s-poles" using \<open>p\<in>s\<close> poles unfolding pz_def by auto
          moreover have "open (s-poles)"
            using \<open>open s\<close>
            apply (elim open_Diff)
            apply (rule finite_imp_closed)
            using finite unfolding pz_def by simp
          ultimately have "isCont f p"
            using holomorphic_on_imp_continuous_on[OF f_holo] continuous_on_eq_continuous_at
            by auto
          then show ?thesis unfolding isCont_def not_essential_def by auto
        qed
        moreover have "\<exists>\<^sub>F w in at p. f w \<noteq> 0 "
        proof (rule ccontr)
          assume "\<not> (\<exists>\<^sub>F w in at p. f w \<noteq> 0)"
          then have "\<forall>\<^sub>F w in at p. f w= 0" unfolding frequently_def by auto
          then obtain rr where "rr>0" "\<forall>w\<in>ball p rr - {p}. f w =0"
            unfolding eventually_at by (auto simp add:dist_commute)
          then have "ball p rr - {p} \<subseteq> {w\<in>ball p rr-{p}. f w=0}" by blast
          moreover have "infinite (ball p rr - {p})" using \<open>rr>0\<close> using finite_imp_not_open by fastforce
          ultimately have "infinite {w\<in>ball p rr-{p}. f w=0}" using infinite_super by blast
          then have "infinite pz"
            unfolding pz_def infinite_super by auto
          then show False using \<open>finite pz\<close> by auto
        qed
        ultimately obtain r where "pp p \<noteq> 0" and r:"r>0" "pp holomorphic_on cball p r"
                  "(\<forall>w\<in>cball p r - {p}. f w = pp w * (w - p) powr of_int po \<and> pp w \<noteq> 0)"
          using zorder_exist[of f p,folded po_def pp_def] by auto
        define r1 where "r1=min r e1 / 2"
        have "r1<e1" unfolding r1_def using \<open>e1>0\<close> \<open>r>0\<close> by auto
        moreover have "r1>0" "pp holomorphic_on cball p r1"
                  "(\<forall>w\<in>cball p r1 - {p}. f w = pp w * (w - p) powr of_int po \<and> pp w \<noteq> 0)"
          unfolding r1_def using \<open>e1>0\<close> r by auto
        ultimately show ?thesis using that \<open>pp p\<noteq>0\<close> by auto
      qed

      define e2 where "e2 \<equiv> r/2"
      have "e2>0" using \<open>r>0\<close> unfolding e2_def by auto
      define anal where "anal \<equiv> \<lambda>w. deriv pp w * h w / pp w"
      define prin where "prin \<equiv> \<lambda>w. po * h w / (w - p)"
      have "((\<lambda>w.  prin w + anal w) has_contour_integral c * po * h p) (circlepath p e2)"
      proof (rule has_contour_integral_add[of _ _ _ _ 0,simplified])
        have "ball p r \<subseteq> s"
          using \<open>r<e1\<close> avoid_def ball_subset_cball e1_avoid by (simp add: subset_eq)
        then have "cball p e2 \<subseteq> s"
          using \<open>r>0\<close> unfolding e2_def by auto
        then have "(\<lambda>w. po * h w) holomorphic_on cball p e2"
          using h_holo by (auto intro!: holomorphic_intros)
        then show "(prin has_contour_integral c * po * h p ) (circlepath p e2)"
          using Cauchy_integral_circlepath_simple[folded c_def, of "\<lambda>w. po * h w"] \<open>e2>0\<close>
          unfolding prin_def by (auto simp add: mult.assoc)
        have "anal holomorphic_on ball p r" unfolding anal_def
          using pp_holo h_holo pp_po \<open>ball p r \<subseteq> s\<close> \<open>pp p\<noteq>0\<close>
          by (auto intro!: holomorphic_intros)
        then show "(anal has_contour_integral 0) (circlepath p e2)"
          using e2_def \<open>r>0\<close>
          by (auto elim!: Cauchy_theorem_disc_simple)
      qed
      then have "cont ff' p e2" unfolding cont_def po_def
      proof (elim has_contour_integral_eq)
        fix w assume "w \<in> path_image (circlepath p e2)"
        then have "w\<in>ball p r" and "w\<noteq>p" unfolding e2_def using \<open>r>0\<close> by auto
        define wp where "wp \<equiv> w-p"
        have "wp\<noteq>0" and "pp w \<noteq>0"
          unfolding wp_def using \<open>w\<noteq>p\<close> \<open>w\<in>ball p r\<close> pp_po by auto
        moreover have der_f':"deriv f' w = po * pp w * (w-p) powr (po - 1) + deriv pp w * (w-p) powr po"
        proof (rule DERIV_imp_deriv)
          have "(pp has_field_derivative (deriv pp w)) (at w)"
            using DERIV_deriv_iff_has_field_derivative pp_holo \<open>w\<noteq>p\<close>
            by (meson open_ball \<open>w \<in> ball p r\<close> ball_subset_cball holomorphic_derivI holomorphic_on_subset)
          then show " (f' has_field_derivative of_int po * pp w * (w - p) powr of_int (po - 1)
                  + deriv pp w * (w - p) powr of_int po) (at w)"
            unfolding f'_def using \<open>w\<noteq>p\<close>
            by (auto intro!: derivative_eq_intros DERIV_cong[OF has_field_derivative_powr_of_int])
        qed
        ultimately show "prin w + anal w = ff' w"
          unfolding ff'_def prin_def anal_def
          apply simp
          apply (unfold f'_def)
          apply (fold wp_def)
          apply (auto simp add:field_simps)
          by (metis (no_types, lifting) diff_add_cancel mult.commute powr_add powr_to_1)
      qed
      then have "cont ff p e2" unfolding cont_def
      proof (elim has_contour_integral_eq)
        fix w assume "w \<in> path_image (circlepath p e2)"
        then have "w\<in>ball p r" and "w\<noteq>p" unfolding e2_def using \<open>r>0\<close> by auto
        have "deriv f' w =  deriv f w"
        proof (rule complex_derivative_transform_within_open[where s="ball p r - {p}"])
          show "f' holomorphic_on ball p r - {p}" unfolding f'_def using pp_holo
            by (auto intro!: holomorphic_intros)
        next
          have "ball p e1 - {p} \<subseteq> s - poles"
            using ball_subset_cball e1_avoid[unfolded avoid_def] unfolding pz_def
            by auto
          then have "ball p r - {p} \<subseteq> s - poles"
            apply (elim dual_order.trans)
            using \<open>r<e1\<close> by auto
          then show "f holomorphic_on ball p r - {p}" using f_holo
            by auto
        next
          show "open (ball p r - {p})" by auto
          show "w \<in> ball p r - {p}" using \<open>w\<in>ball p r\<close> \<open>w\<noteq>p\<close> by auto
        next
          fix x assume "x \<in> ball p r - {p}"
          then show "f' x = f x"
            using pp_po unfolding f'_def by auto
        qed
        moreover have " f' w  =  f w "
          using \<open>w \<in> ball p r\<close> ball_subset_cball subset_iff pp_po \<open>w\<noteq>p\<close>
          unfolding f'_def by auto
        ultimately show "ff' w = ff w"
          unfolding ff'_def ff_def by simp
      qed
      moreover have "cball p e2 \<subseteq> ball p e1"
        using \<open>0 < r\<close> \<open>r<e1\<close> e2_def by auto
      ultimately show ?thesis using \<open>e2>0\<close> by auto
    qed
    then obtain e2 where e2:"p\<in>pz \<longrightarrow> e2>0 \<and> cball p e2 \<subseteq> ball p e1 \<and> cont ff p e2"
      by auto
    define e4 where "e4 \<equiv> if p\<in>pz then e2 else  e1"
    have "e4>0" using e2 \<open>e1>0\<close> unfolding e4_def by auto
    moreover have "avoid p e4" using e2 \<open>e1>0\<close> e1_avoid unfolding e4_def avoid_def by auto
    moreover have "p\<in>pz \<longrightarrow> cont ff p e4"
      by (auto simp add: e2 e4_def)
    ultimately show ?thesis by auto
  qed
  then obtain get_e where get_e:"\<forall>p\<in>s. get_e p>0 \<and> avoid p (get_e p)
      \<and> (p\<in>pz \<longrightarrow> cont ff p (get_e p))"
    by metis
  define ci where "ci \<equiv> \<lambda>p. contour_integral (circlepath p (get_e p)) ff"
  define w where "w \<equiv> \<lambda>p. winding_number g p"
  have "contour_integral g ff = (\<Sum>p\<in>pz. w p * ci p)" unfolding ci_def w_def
  proof (rule Cauchy_theorem_singularities[OF \<open>open s\<close> \<open>connected s\<close> finite _ \<open>valid_path g\<close> loop
        path_img homo])
    have "open (s - pz)" using open_Diff[OF _ finite_imp_closed[OF finite]] \<open>open s\<close> by auto
    then show "ff holomorphic_on s - pz" unfolding ff_def using f_holo h_holo
      by (auto intro!: holomorphic_intros simp add:pz_def)
  next
    show "\<forall>p\<in>s. 0 < get_e p \<and> (\<forall>w\<in>cball p (get_e p). w \<in> s \<and> (w \<noteq> p \<longrightarrow> w \<notin> pz))"
      using get_e using avoid_def by blast
  qed
  also have "... = (\<Sum>p\<in>pz. c * w p * h p * zorder f p)"
  proof (rule sum.cong[of pz pz,simplified])
    fix p assume "p \<in> pz"
    show "w p * ci p = c * w p * h p * (zorder f p)"
    proof (cases "p\<in>s")
      assume "p \<in> s"
      have "ci p = c * h p * (zorder f p)" unfolding ci_def
        apply (rule contour_integral_unique)
        using get_e \<open>p\<in>s\<close> \<open>p\<in>pz\<close> unfolding cont_def by (metis mult.assoc mult.commute)
      thus ?thesis by auto
    next
      assume "p\<notin>s"
      then have "w p=0" using homo unfolding w_def by auto
      then show ?thesis by auto
    qed
  qed
  also have "... = c*(\<Sum>p\<in>pz. w p * h p * zorder f p)"
    unfolding sum_distrib_left by (simp add:algebra_simps)
  finally have "contour_integral g ff = c * (\<Sum>p\<in>pz. w p * h p * of_int (zorder f p))" .
  then show ?thesis unfolding ff_def c_def w_def by simp
qed

subsection \<open>Rouche's theorem \<close>

theorem Rouche_theorem:
  fixes f g::"complex \<Rightarrow> complex" and s:: "complex set"
  defines "fg\<equiv>(\<lambda>p. f p + g p)"
  defines "zeros_fg\<equiv>{p. fg p = 0}" and "zeros_f\<equiv>{p. f p = 0}"
  assumes
    "open s" and "connected s" and
    "finite zeros_fg" and
    "finite zeros_f" and
    f_holo:"f holomorphic_on s" and
    g_holo:"g holomorphic_on s" and
    "valid_path \<gamma>" and
    loop:"pathfinish \<gamma> = pathstart \<gamma>" and
    path_img:"path_image \<gamma> \<subseteq> s " and
    path_less:"\<forall>z\<in>path_image \<gamma>. cmod(f z) > cmod(g z)" and
    homo:"\<forall>z. (z \<notin> s) \<longrightarrow> winding_number \<gamma> z = 0"
  shows "(\<Sum>p\<in>zeros_fg. winding_number \<gamma> p * zorder fg p)
          = (\<Sum>p\<in>zeros_f. winding_number \<gamma> p * zorder f p)"
proof -
  have path_fg:"path_image \<gamma> \<subseteq> s - zeros_fg"
  proof -
    have False when "z\<in>path_image \<gamma>" and "f z + g z=0" for z
    proof -
      have "cmod (f z) > cmod (g z)" using \<open>z\<in>path_image \<gamma>\<close> path_less by auto
      moreover have "f z = - g z"  using \<open>f z + g z =0\<close> by (simp add: eq_neg_iff_add_eq_0)
      then have "cmod (f z) = cmod (g z)" by auto
      ultimately show False by auto
    qed
    then show ?thesis unfolding zeros_fg_def fg_def using path_img by auto
  qed
  have path_f:"path_image \<gamma> \<subseteq> s - zeros_f"
  proof -
    have False when "z\<in>path_image \<gamma>" and "f z =0" for z
    proof -
      have "cmod (g z) < cmod (f z) " using \<open>z\<in>path_image \<gamma>\<close> path_less by auto
      then have "cmod (g z) < 0" using \<open>f z=0\<close> by auto
      then show False by auto
    qed
    then show ?thesis unfolding zeros_f_def using path_img by auto
  qed
  define w where "w \<equiv> \<lambda>p. winding_number \<gamma> p"
  define c where "c \<equiv> 2 * complex_of_real pi * \<i>"
  define h where "h \<equiv> \<lambda>p. g p / f p + 1"
  obtain spikes
    where "finite spikes" and spikes: "\<forall>x\<in>{0..1} - spikes. \<gamma> differentiable at x"
    using \<open>valid_path \<gamma>\<close>
    by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
  have h_contour:"((\<lambda>x. deriv h x / h x) has_contour_integral 0) \<gamma>"
  proof -
    have outside_img:"0 \<in> outside (path_image (h o \<gamma>))"
    proof -
      have "h p \<in> ball 1 1" when "p\<in>path_image \<gamma>" for p
      proof -
        have "cmod (g p/f p) <1" using path_less[rule_format,OF that]
          apply (cases "cmod (f p) = 0")
          by (auto simp add: norm_divide)
        then show ?thesis unfolding h_def by (auto simp add:dist_complex_def)
      qed
      then have "path_image (h o \<gamma>) \<subseteq> ball 1 1"
        by (simp add: image_subset_iff path_image_compose)
      moreover have " (0::complex) \<notin> ball 1 1" by (simp add: dist_norm)
      ultimately show "?thesis"
        using  convex_in_outside[of "ball 1 1" 0] outside_mono by blast
    qed
    have valid_h:"valid_path (h \<circ> \<gamma>)"
    proof (rule valid_path_compose_holomorphic[OF \<open>valid_path \<gamma>\<close> _ _ path_f])
      show "h holomorphic_on s - zeros_f"
        unfolding h_def using f_holo g_holo
        by (auto intro!: holomorphic_intros simp add:zeros_f_def)
    next
      show "open (s - zeros_f)" using \<open>finite zeros_f\<close> \<open>open s\<close> finite_imp_closed
        by auto
    qed
    have "((\<lambda>z. 1/z) has_contour_integral 0) (h \<circ> \<gamma>)"
    proof -
      have "0 \<notin> path_image (h \<circ> \<gamma>)" using outside_img by (simp add: outside_def)
      then have "((\<lambda>z. 1/z) has_contour_integral c * winding_number (h \<circ> \<gamma>) 0) (h \<circ> \<gamma>)"
        using has_contour_integral_winding_number[of "h o \<gamma>" 0,simplified] valid_h
        unfolding c_def by auto
      moreover have "winding_number (h o \<gamma>) 0 = 0"
      proof -
        have "0 \<in> outside (path_image (h \<circ> \<gamma>))" using outside_img .
        moreover have "path (h o \<gamma>)"
          using valid_h  by (simp add: valid_path_imp_path)
        moreover have "pathfinish (h o \<gamma>) = pathstart (h o \<gamma>)"
          by (simp add: loop pathfinish_compose pathstart_compose)
        ultimately show ?thesis using winding_number_zero_in_outside by auto
      qed
      ultimately show ?thesis by auto
    qed
    moreover have "vector_derivative (h \<circ> \<gamma>) (at x) = vector_derivative \<gamma> (at x) * deriv h (\<gamma> x)"
      when "x\<in>{0..1} - spikes" for x
    proof (rule vector_derivative_chain_at_general)
      show "\<gamma> differentiable at x" using that \<open>valid_path \<gamma>\<close> spikes by auto
    next
      define der where "der \<equiv> \<lambda>p. (deriv g p * f p - g p * deriv f p)/(f p * f p)"
      define t where "t \<equiv> \<gamma> x"
      have "f t\<noteq>0" unfolding zeros_f_def t_def
        by (metis DiffD1 image_eqI norm_not_less_zero norm_zero path_defs(4) path_less that)
      moreover have "t\<in>s"
        using contra_subsetD path_image_def path_fg t_def that by fastforce
      ultimately have "(h has_field_derivative der t) (at t)"
        unfolding h_def der_def using g_holo f_holo \<open>open s\<close>
        by (auto intro!: holomorphic_derivI derivative_eq_intros)
      then show "h field_differentiable at (\<gamma> x)"
        unfolding t_def field_differentiable_def by blast
    qed
    then have " ((/) 1 has_contour_integral 0) (h \<circ> \<gamma>)
                  = ((\<lambda>x. deriv h x / h x) has_contour_integral 0) \<gamma>"
      unfolding has_contour_integral
      apply (intro has_integral_spike_eq[OF negligible_finite, OF \<open>finite spikes\<close>])
      by auto
    ultimately show ?thesis by auto
  qed
  then have "contour_integral \<gamma> (\<lambda>x. deriv h x / h x) = 0"
    using  contour_integral_unique by simp
  moreover have "contour_integral \<gamma> (\<lambda>x. deriv fg x / fg x) = contour_integral \<gamma> (\<lambda>x. deriv f x / f x)
      + contour_integral \<gamma> (\<lambda>p. deriv h p / h p)"
  proof -
    have "(\<lambda>p. deriv f p / f p) contour_integrable_on \<gamma>"
    proof (rule contour_integrable_holomorphic_simple[OF _ _ \<open>valid_path \<gamma>\<close> path_f])
      show "open (s - zeros_f)" using finite_imp_closed[OF \<open>finite zeros_f\<close>] \<open>open s\<close>
        by auto
      then show "(\<lambda>p. deriv f p / f p) holomorphic_on s - zeros_f"
        using f_holo
        by (auto intro!: holomorphic_intros simp add:zeros_f_def)
    qed
    moreover have "(\<lambda>p. deriv h p / h p) contour_integrable_on \<gamma>"
      using h_contour
      by (simp add: has_contour_integral_integrable)
    ultimately have "contour_integral \<gamma> (\<lambda>x. deriv f x / f x + deriv h x / h x) =
                        contour_integral \<gamma> (\<lambda>p. deriv f p / f p) + contour_integral \<gamma> (\<lambda>p. deriv h p / h p)"
      using contour_integral_add[of "(\<lambda>p. deriv f p / f p)" \<gamma> "(\<lambda>p. deriv h p / h p)" ]
      by auto
    moreover have "deriv fg p / fg p =  deriv f p / f p + deriv h p / h p"
                      when "p\<in> path_image \<gamma>" for p
    proof -
      have "fg p\<noteq>0" and "f p\<noteq>0" using path_f path_fg that unfolding zeros_f_def zeros_fg_def
        by auto
      have "h p\<noteq>0"
      proof (rule ccontr)
        assume "\<not> h p \<noteq> 0"
        then have "g p / f p= -1" unfolding h_def by (simp add: add_eq_0_iff2)
        then have "cmod (g p/f p) = 1" by auto
        moreover have "cmod (g p/f p) <1" using path_less[rule_format,OF that]
          apply (cases "cmod (f p) = 0")
          by (auto simp add: norm_divide)
        ultimately show False by auto
      qed
      have der_fg:"deriv fg p =  deriv f p + deriv g p" unfolding fg_def
        using f_holo g_holo holomorphic_on_imp_differentiable_at[OF _  \<open>open s\<close>] path_img that
        by auto
      have der_h:"deriv h p = (deriv g p * f p - g p * deriv f p)/(f p * f p)"
      proof -
        define der where "der \<equiv> \<lambda>p. (deriv g p * f p - g p * deriv f p)/(f p * f p)"
        have "p\<in>s" using path_img that by auto
        then have "(h has_field_derivative der p) (at p)"
          unfolding h_def der_def using g_holo f_holo \<open>open s\<close> \<open>f p\<noteq>0\<close>
          by (auto intro!: derivative_eq_intros holomorphic_derivI)
        then show ?thesis unfolding der_def using DERIV_imp_deriv by auto
      qed
      show ?thesis
        apply (simp only:der_fg der_h)
        apply (auto simp add:field_simps \<open>h p\<noteq>0\<close> \<open>f p\<noteq>0\<close> \<open>fg p\<noteq>0\<close>)
        by (auto simp add:field_simps h_def \<open>f p\<noteq>0\<close> fg_def)
    qed
    then have "contour_integral \<gamma> (\<lambda>p. deriv fg p / fg p)
                  = contour_integral \<gamma> (\<lambda>p. deriv f p / f p + deriv h p / h p)"
      by (elim contour_integral_eq)
    ultimately show ?thesis by auto
  qed
  moreover have "contour_integral \<gamma> (\<lambda>x. deriv fg x / fg x) = c * (\<Sum>p\<in>zeros_fg. w p * zorder fg p)"
    unfolding c_def zeros_fg_def w_def
  proof (rule argument_principle[OF \<open>open s\<close> \<open>connected s\<close> _ _ \<open>valid_path \<gamma>\<close> loop _ homo
        , of _ "{}" "\<lambda>_. 1",simplified])
    show "fg holomorphic_on s" unfolding fg_def using f_holo g_holo holomorphic_on_add by auto
    show "path_image \<gamma> \<subseteq> s - {p. fg p = 0}" using path_fg unfolding zeros_fg_def .
    show " finite {p. fg p = 0}" using \<open>finite zeros_fg\<close> unfolding zeros_fg_def .
  qed
  moreover have "contour_integral \<gamma> (\<lambda>x. deriv f x / f x) = c * (\<Sum>p\<in>zeros_f. w p * zorder f p)"
    unfolding c_def zeros_f_def w_def
  proof (rule argument_principle[OF \<open>open s\<close> \<open>connected s\<close> _ _ \<open>valid_path \<gamma>\<close> loop _ homo
        , of _ "{}" "\<lambda>_. 1",simplified])
    show "f holomorphic_on s" using f_holo g_holo holomorphic_on_add by auto
    show "path_image \<gamma> \<subseteq> s - {p. f p = 0}" using path_f unfolding zeros_f_def .
    show " finite {p. f p = 0}" using \<open>finite zeros_f\<close> unfolding zeros_f_def .
  qed
  ultimately have " c* (\<Sum>p\<in>zeros_fg. w p * (zorder fg p)) = c* (\<Sum>p\<in>zeros_f. w p * (zorder f p))"
    by auto
  then show ?thesis unfolding c_def using w_def by auto
qed

end


section \<open>Integers\<close>
theory Integers
  imports
    Integers_Rep
    Set_Extensions
    Transport.Transport
begin

unbundle no_HOL_groups_syntax

subsection \<open>The Integers as a Subset of the Naturals\<close>

interpretation Int : set_extension \<nat> int_rep Int_Rep_nonneg
  by unfold_locales (auto intro: ElementI)

abbreviation "int \<equiv> Int.Abs"

bundle isa_set_int_syntax begin notation int ("\<int>") end
bundle no_isa_set_int_syntax begin no_notation int ("\<int>") end

unbundle isa_set_int_syntax

abbreviation "Int \<equiv> Element \<int>"

lemmas nat_subset_int [iff] = Int.Core_subset_Abs

corollary Int_if_Nat [derive]: "n : Nat \<Longrightarrow> n : Int"
  using subsetD[OF nat_subset_int] by unfold_types

subsection \<open>Arithmetic operations lifted to Int\<close>

text \<open>We lift constants/functions from @{term "Int_Rep"} to @{term "\<int>"}
manually. This should be automated in the future.\<close>

definition "int_nonneg n \<equiv> Int.l (Int_Rep_nonneg n)"
definition "int_neg n \<equiv> Int.l (Int_Rep_neg n)"
definition "int_succ i \<equiv> Int.l (Int_Rep_succ (Int.r i))"
definition "int_pred i \<equiv> Int.l (Int_Rep_pred (Int.r i))"
definition "int_inv i \<equiv> Int.l (Int_Rep_inv (Int.r i))"
definition "int_add i j \<equiv> Int.l (Int_Rep_add (Int.r i) (Int.r j))"
definition "int_sub i j \<equiv> Int.l (Int_Rep_sub (Int.r i) (Int.r j))"
definition "int_mul i j \<equiv> Int.l (Int_Rep_mul (Int.r i) (Int.r j))"

(*TODO: automatic translation between @{term "Nat \<Coprod> Element (\<nat> \<setminus> {0})"}
and @{term "Element (\<nat> \<Coprod> \<nat> \<setminus> {0})"} not working at the moment;
maybe we want to introduce extensionality for types?*)
lemma
  shows int_nonneg_type [type]: "int_nonneg : Nat \<Rightarrow> Int"
  and int_neg_type [type]: "int_neg : Element (\<nat> \<setminus> {0}) \<Rightarrow> Int"
  and int_succ_type [type]: "int_succ : Int \<Rightarrow> Int"
  and int_pred_type [type]: "int_pred : Int \<Rightarrow> Int"
  and int_inv_type [type]: "int_inv : Int \<Rightarrow> Int"
  and int_add_type [type]: "int_add : Int \<Rightarrow> Int \<Rightarrow> Int"
  and int_sub_type [type]: "int_sub : Int \<Rightarrow> Int \<Rightarrow> Int"
  and int_mul_type [type]: "int_mul : Int \<Rightarrow> Int \<Rightarrow> Int"
  unfolding int_nonneg_def int_neg_def int_succ_def int_pred_def int_inv_def
    int_add_def int_sub_def int_mul_def
oops
  (* using [[type_derivation_depth=3]] *)
  (* by auto *)

text \<open>We need a notation package that also does inference to determine if a
number is a Nat, Int, etc. Typeclass integration here already?\<close>

bundle isa_set_int_add_syntax begin notation int_add (infixl "+" 65) end
bundle no_isa_set_int_add_syntax begin no_notation int_add (infixl "+" 65) end

bundle isa_set_int_sub_syntax begin notation int_sub (infixl "-" 65) end
bundle no_isa_set_int_sub_syntax begin no_notation int_sub (infixl "-" 65) end

bundle isa_set_int_mul_syntax begin notation int_mul (infixl "*" 70) end
bundle no_isa_set_int_mul_syntax begin no_notation int_mul (infixl "*" 70) end

unbundle
  no_isa_set_nat_add_syntax
  no_isa_set_nat_sub_syntax
  no_isa_set_nat_mul_syntax
  isa_set_int_add_syntax
  isa_set_int_sub_syntax
  isa_set_int_mul_syntax

(*TODO: no proper normal forms at the moment*)
subsubsection \<open>Examples\<close>

experiment begin

named_theorems arith
lemmas [arith] =
  int_nonneg_def int_neg_def int_add_def int_sub_def int_mul_def
  Int_Rep_zero_def[symmetric] Int_Rep_one_def[symmetric]
  Int_Rep_nonneg_succ_add_eq

text \<open>At some point we want to just be able to write \<open>succ n\<close> below, and
automatically infer that it has to have soft type \<open>Int\<close>.\<close>

schematic_goal
  "int_nonneg (succ 0) + int_nonneg (succ 0) + int_neg (succ 0) = ?a"
  by (simp add: arith)

schematic_goal
  "int_nonneg 0 * int_neg (succ 0) + int_nonneg (succ 0) - int_neg (succ 0) = ?a"
  by (simp add: arith)

end

subsection \<open>Algebraic Structures\<close>

text \<open>Additive group structure\<close>

definition "int_Group \<equiv> object {
    \<langle>@zero, 0\<rangle>,
    \<langle>@add, \<lambda>i j \<in> \<int>. int_add i j\<rangle>,
    \<langle>@inv, \<lambda>i \<in> \<int>. Int_Rep_inv i\<rangle>
  }"

bundle isa_set_int_Group_syntax
begin notation int_Group ("'(\<int>, +')") end
bundle no_isa_set_int_Monoid_syntax
begin no_notation int_Group ("'(\<int>, +')") end

unbundle isa_set_int_Group_syntax

(*TODO: The following should be automatically generated*)

lemma "(\<int>, +) : Group Int"
(* proof (rule GroupI, rule MonoidI)
  show "(\<int>, +) : Zero Int" by (rule ZeroI) simp
  show "(\<int>, +) : Add Int"
  (*TODO: object selector simplifier not working properly*)
  (* unfolding nat_Monoid_def by (rule AddI) simp *)
  proof (rule AddI)
    have select_add_eq: "(\<int>, +)@@add = \<lambda>i j \<in> \<int>. int_add i j" by simp
    show "(\<int>, +)@@add : Int \<rightarrow>s Int \<rightarrow>s Int" by (subst select_add_eq) discharge_types
  qed
(*TODO: needs transferred theorems from representation type*)
qed (unfold add_def zero_def inv_def, auto) *)
oops

text \<open>Multiplicative monoid structure\<close>

definition "int_Mul_Monoid \<equiv> object {
    \<langle>@one, 1\<rangle>,
    \<langle>@mul, \<lambda>i j \<in> \<int>. int_mul i j\<rangle>
  }"

bundle isa_set_int_Mul_Monoid_syntax
begin notation int_Mul_Monoid ("'(\<int>, *')") end
bundle no_isa_set_int_Mul_Monoid_syntax
begin no_notation int_Mul_Monoid ("'(\<int>, *')") end

unbundle isa_set_int_Mul_Monoid_syntax

(* lemma int_mul_assoc:
  assumes "i : Int" "j : Int" "k : Int"
  shows "i * j * k = i * (j * k)"
  (* using assms Int_Rep_mul_assoc unfolding int_mul_def by simp *)
oops *)

lemma "(\<int>, *) : Mul_Monoid Int"
\<comment> \<open>
proof (intro Mul_MonoidI)
  show "(\<int>, *) : One \<int>"
    unfolding int_Mul_Monoid_def by (rule OneI) simp
next
  show "(\<int>, *) : Mul \<int>"
    unfolding int_Mul_Monoid_def by (rule MulI) simp
next
  fix x assume "x \<in> \<int>"
  then show "mul int_Mul_Monoid (one int_Mul_Monoid) x = x" and
    "mul int_Mul_Monoid x (one int_Mul_Monoid) = x"
    unfolding int_Mul_Monoid_def mul_def one_def by auto
next
  fix x y z assume "x \<in> \<int>" "y \<in> \<int>" "z \<in> \<int>"
  show "mul int_Mul_Monoid (mul int_Mul_Monoid x y) z =
    mul int_Mul_Monoid x (mul int_Mul_Monoid y z)"
    (* using int_mul_assoc unfolding int_Mul_Monoid_def mul_def by simp *)
qed\<close>
oops

end


section \<open>Observable Sets of Nodes\<close>

theory Observable imports "../Basic/CFG" begin

context CFG begin

inductive_set obs :: "'node \<Rightarrow> 'node set \<Rightarrow> 'node set"
for n::"'node" and S::"'node set"
where obs_elem:
  "\<lbrakk>n -as\<rightarrow>* n'; \<forall>nx \<in> set(sourcenodes as). nx \<notin> S; n' \<in> S\<rbrakk> \<Longrightarrow> n' \<in> obs n S"

lemma obsE:
  assumes "n' \<in> obs n S"
  obtains as where "n -as\<rightarrow>* n'" and "\<forall>nx \<in> set(sourcenodes as). nx \<notin> S"
  and "n' \<in> S"
proof(atomize_elim)
  from \<open>n' \<in> obs n S\<close>
  have "\<exists>as. n -as\<rightarrow>* n' \<and> (\<forall>nx \<in> set(sourcenodes as). nx \<notin> S) \<and> n' \<in> S"
    by(auto elim:obs.cases)
  thus "\<exists>as. n -as\<rightarrow>* n' \<and> (\<forall>nx\<in>set (sourcenodes as). nx \<notin> S) \<and> n' \<in> S" by blast
qed

lemma n_in_obs:
  assumes "valid_node n" and "n \<in> S" shows "obs n S = {n}"
proof -
  from \<open>valid_node n\<close> have "n -[]\<rightarrow>* n" by(rule empty_path)
  with \<open>n \<in> S\<close> have "n \<in> obs n S" by(fastforce elim:obs_elem simp:sourcenodes_def)
  { fix n' assume "n' \<in> obs n S"
    have "n' = n"
    proof(rule ccontr)
      assume "n' \<noteq> n"
      from \<open>n' \<in> obs n S\<close> obtain as where "n -as\<rightarrow>* n'"
        and "\<forall>nx \<in> set(sourcenodes as). nx \<notin> S"
        and "n' \<in> S" by(erule obsE)
      from \<open>n -as\<rightarrow>* n'\<close> \<open>\<forall>nx \<in> set(sourcenodes as). nx \<notin> S\<close> \<open>n' \<noteq> n\<close> \<open>n \<in> S\<close>
      show False
      proof(induct rule:path.induct)
        case (Cons_path n'' as n' a n)
        from \<open>\<forall>nx\<in>set (sourcenodes (a#as)). nx \<notin> S\<close> \<open>sourcenode a = n\<close>
        have "n \<notin> S" by(simp add:sourcenodes_def)
        with \<open>n \<in> S\<close> show False by simp
      qed simp
    qed }
  with \<open>n \<in> obs n S\<close> show ?thesis by fastforce
qed

lemma in_obs_valid:
  assumes "n' \<in> obs n S" shows "valid_node n" and "valid_node n'"
  using \<open>n' \<in> obs n S\<close>
  by(auto elim:obsE intro:path_valid_node)

lemma edge_obs_subset:
  assumes"valid_edge a" and "sourcenode a \<notin> S"
  shows "obs (targetnode a) S \<subseteq> obs (sourcenode a) S"
proof
  fix n assume "n \<in> obs (targetnode a) S"
  then obtain as where "targetnode a -as\<rightarrow>* n"
    and all:"\<forall>nx \<in> set(sourcenodes as). nx \<notin> S" and "n \<in> S" by(erule obsE)
  from \<open>valid_edge a\<close> \<open>targetnode a -as\<rightarrow>* n\<close>
  have "sourcenode a -a#as\<rightarrow>* n" by(fastforce intro:Cons_path)
  moreover
  from all \<open>sourcenode a \<notin> S\<close> have "\<forall>nx \<in> set(sourcenodes (a#as)). nx \<notin> S"
    by(simp add:sourcenodes_def)
  ultimately show "n \<in> obs (sourcenode a) S" using \<open>n \<in> S\<close>
    by(rule obs_elem)
qed

lemma path_obs_subset:
  "\<lbrakk>n -as\<rightarrow>* n'; \<forall>n' \<in> set(sourcenodes as). n' \<notin> S\<rbrakk>
  \<Longrightarrow> obs n' S \<subseteq> obs n S"
proof(induct rule:path.induct)
  case (Cons_path n'' as n' a n)
  note IH = \<open>\<forall>n'\<in>set (sourcenodes as). n' \<notin> S \<Longrightarrow> obs n' S \<subseteq> obs n'' S\<close>
  from \<open>\<forall>n'\<in>set (sourcenodes (a#as)). n' \<notin> S\<close>
  have all:"\<forall>n'\<in>set (sourcenodes as). n' \<notin> S" and "sourcenode a \<notin> S"
    by(simp_all add:sourcenodes_def)
  from IH[OF all] have "obs n' S \<subseteq> obs n'' S" .
  from \<open>valid_edge a\<close> \<open>targetnode a = n''\<close> \<open>sourcenode a = n\<close> \<open>sourcenode a \<notin> S\<close>
  have "obs n'' S \<subseteq> obs n S" by(fastforce dest:edge_obs_subset)
  with \<open>obs n' S \<subseteq> obs n'' S\<close> show ?case by fastforce
qed simp

lemma path_ex_obs:
  assumes "n -as\<rightarrow>* n'" and "n' \<in> S"
  obtains m where "m \<in> obs n S"
proof(atomize_elim)
  show "\<exists>m. m \<in> obs n S"
  proof(cases "\<forall>nx \<in> set(sourcenodes as). nx \<notin> S")
    case True
    with \<open>n -as\<rightarrow>* n'\<close> \<open>n' \<in> S\<close> have "n' \<in> obs n S" by -(rule obs_elem)
    thus ?thesis by fastforce
  next
    case False
    hence "\<exists>nx \<in> set(sourcenodes as). nx \<in> S" by fastforce
    then obtain nx ns ns' where "sourcenodes as = ns@nx#ns'"
      and "nx \<in> S" and "\<forall>n' \<in> set ns. n' \<notin> S"
      by(fastforce elim!:split_list_first_propE)
    from \<open>sourcenodes as = ns@nx#ns'\<close> obtain as' a as''
      where "ns = sourcenodes as'"
      and "as = as'@a#as''" and "sourcenode a = nx"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    with \<open>n -as\<rightarrow>* n'\<close> have "n -as'\<rightarrow>* nx" by(fastforce dest:path_split)
    with \<open>nx \<in> S\<close> \<open>\<forall>n' \<in> set ns. n' \<notin> S\<close> \<open>ns = sourcenodes as'\<close> have "nx \<in> obs n S"
      by(fastforce intro:obs_elem)
    thus ?thesis by fastforce
  qed
qed

end

end


\<^marker>\<open>creator Bilel Ghorbel\<close>
chapter \<open>Abstractions over IMP-\<close>
paragraph \<open>Summary\<close>
text \<open>We define an abstraction layer over our computation model
      to be able to define complexity classes easily.\<close>
theory Abstractions
  imports  "IMP_Minus.Big_StepT"
begin
paragraph \<open>Definitions\<close>
text \<open>
\<bullet> Formal Languages
\<bullet> Computing a certain result for a certain input
\<bullet> Decider program for a language
\<bullet> Verifier program for a language
\<close>
type_synonym lang = "nat set"

subsection \<open>Computing\<close>
paragraph \<open>Definition\<close>
text \<open>
For rs , xs lists of (register name, value) pairs,
A program c computes for an input xs a result rs, if given that xs is a (eventually partial)
description of the initial state, the computation always terminates with some state s.t. rs a
description of the final state.
.\<close>

definition comp :: "com \<Rightarrow> (vname * val) list \<Rightarrow> (vname *val) list \<Rightarrow> bool" where
"comp c input result \<equiv>
    distinct (map fst input) \<and>
    (\<forall>s. map (s o fst) input  = map snd input \<longrightarrow>
                      (\<exists>t s'. (c,s) \<Rightarrow>\<^bsup>t\<^esup> s' \<and> map (s' o fst) result  = map snd result ))"

fun state_maker :: "(vname*val) list \<Rightarrow> state \<Rightarrow> state" where
"state_maker [] s = s"|
"state_maker ((name,value)#l) s = state_maker l (s (name:=value))"

lemma state_maker_works_helper1:
  "\<lbrakk> v \<notin> fst ` set l\<rbrakk> \<Longrightarrow>  state_maker l (sa(v := x)) v = x "
  apply (induction l arbitrary:sa)
   apply (auto simp add: fun_upd_twist)
  done

lemma state_maker_works_helper2:
"\<lbrakk>distinct (map fst l); (aa, ba) \<in> set l \<rbrakk> \<Longrightarrow> state_maker l s aa = ba"
   apply (induction l arbitrary:s)
   apply (auto simp add: fun_upd_twist state_maker_works_helper1)
  done

lemma state_maker_works:
  assumes "distinct (map fst l)"
  assumes "s' = state_maker l s"
  shows "map (s' o fst) l = map snd l"
  using assms
  apply (induction l arbitrary:s')
  apply (auto simp add:state_maker_works_helper1 state_maker_works_helper2)
  done
paragraph \<open>Computing determinism\<close>
text \<open>Thanks to the determinism of IMP-, computations are deterministic.
i.e. if a program c computes for every input xs, two results r1 AND r2 who describe the same
final registers, then r1=r2

comp c is a relation over (partial) register descriptions.
 \<close>
lemma comp_det:
  assumes "comp c input result" "comp c input result'"
          "map fst result = map fst result'"
  shows "map snd result = map snd result'"
proof -
  obtain s where s_def: "s = state_maker input <>" by blast
  have s_prop:"map (s o fst) input = map snd input"
      using s_def assms(1) comp_def state_maker_works by simp
  obtain s1 where s1_def : "\<exists>t. (c, s) \<Rightarrow>\<^bsup>t\<^esup> s1" "map (s1 o fst) result = map snd result"
    using assms(1) s_prop comp_def by metis
  obtain s2 where s2_def : "\<exists>t. (c, s) \<Rightarrow>\<^bsup>t\<^esup> s2" "map (s2 o fst) result' = map snd result'"
    using assms(2) s_prop comp_def by metis
  have "s1 = s2" using s1_def(1) s2_def(1) big_step_t_determ2 by blast
  thus ?thesis using s1_def(2) s2_def(2) assms(3) by (metis map_map)
qed

paragraph \<open>Computing: composition and sequencing\<close>
text \<open> By sequencing two codes, we compose the relations.\<close>
lemma comp_comp:
  assumes "comp f xs ys" "comp g ys zs"
  shows "comp (f;;g) xs zs"
proof (auto simp add:comp_def)
  show "distinct (map fst xs)" using assms(1) comp_def by auto
next
  fix s
  assume asm:" \<forall>x\<in>set xs. s (fst x) = snd x"
  obtain tf sf where tsf_def: "(f, s) \<Rightarrow>\<^bsup> tf \<^esup> sf" "map (sf o fst) ys  = map snd ys"
    using assms(1) comp_def asm by auto
  obtain tg sg where tsg_def: "(g, sf) \<Rightarrow>\<^bsup> tg \<^esup> sg" "map (sg o fst) zs = map snd zs"
    using assms(2) comp_def tsf_def(2) by blast
  have " (f;; g, s) \<Rightarrow>\<^bsup> tf+tg\<^esup> sg" using tsf_def(1) tsg_def(1) by blast
  thus " \<exists>t s'. (f;; g, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<and> (\<forall>x\<in>set zs. s' (fst x) = snd x) "
    using tsg_def(2) by auto
qed

paragraph \<open>Register conventions\<close>

text \<open>
\<bullet> The input for a program (independently of its purpose e.g:
computing a function, decision, verification) is expected to be in the register called ''input''
\<bullet> The certificate (if needed) is expected to be found in the register ''certificate''
\<bullet> The output/result/main result is expected to be found in the same register as the input.
This allows to easily compose to obtain computing code of the composition of computable functions
just by sequencing their computing codes
\<bullet> If not otherwise mentioned, the input is strictly the inital content of the ''input'' register.
In some particular contexts in the theory, we might consider the certificate as second input.
But this will be explicitly mentioned.
\<close>

paragraph \<open>Abreviations according to register conventions\<close>

definition comp' :: "com \<Rightarrow> val \<Rightarrow> val \<Rightarrow> bool" where
"comp' c x r \<equiv> comp c [(''input'',x)] [(''input'',r)]"

definition verif :: "com \<Rightarrow> val \<Rightarrow> val \<Rightarrow> val \<Rightarrow> bool" where
"verif c x z r \<equiv> comp c [(''input'',x),(''certificate'',z)] [(''input'',r)]"

lemma comp'_comp':
  assumes "comp' f x y" "comp' g y z"
  shows "comp' (f;;g) x z"
  using assms unfolding comp'_def
  by(rule comp_comp[where ys="[(''input'',y)]"])

subsection \<open>Decision problems\<close>
paragraph \<open>Convention\<close>
text \<open>Decision programs are programs that compute a boolean logical result
(hence a decision) given an input.
IMP- does only support natural number values. But we can make our own interpretation of the result
r::nat as a boolean value.

Theoretically, every predicate in HOL over the result r is an admissible interpretation.
Yet we choose the following convention from now on:
\<bullet> the result r is interpreted as True iff. r = 0

This convention goes in sync with our semantics that check for equality to 0 exclusively
for branching conditions.

Generally programming languages tend to interpret non-zero values as True rather than zero.
Yet this a design choice since the negation could be implemented using a constant time program.
To avoid complications for proving Cook-Levin, we use 0 for True and non-zero values for False
\<close>

paragraph \<open>Deciding a language: definition\<close>
text \<open>A decider for a language L should for every input x, compute a unique result (otherwise
it is depending on other variables).

The result/decision is True iff x \<in> L .\<close>

definition decides :: "com \<Rightarrow> lang \<Rightarrow> bool" where
  "decides c L  \<equiv> (\<forall>x. \<exists>r. comp' c x r \<and> ( x\<in>L \<longleftrightarrow> r = 0))"

subsection \<open>Verifier programs\<close>
paragraph \<open>Definition\<close>
text \<open>After defining verification on the word/natural number level. We define verification on
the language level.

A verifier for a language L should return a unique verification result/decision r
for every combination of input x and certificate z.
This result should say whether this certificate z
is valid for that input x.(result is to be interpreted as a boolean)

Every input x has at least one corresponding valid certificate iff. x \<in> L\<close>

definition is_verif :: "com \<Rightarrow> lang \<Rightarrow> bool" where
"is_verif c L  \<equiv> (\<forall>x z. \<exists>r. verif c x z r) \<and> (\<forall>x. (x\<in>L \<longleftrightarrow> (\<exists>z. verif c x z 0))) "

lemma is_verifI:
  assumes "\<And>x z. \<exists>r. verif c x z r"
    "\<And>x. x\<in>L \<longleftrightarrow> (\<exists>z. verif c x z 0)"
  shows "is_verif c L"
  using assms unfolding is_verif_def by auto

paragraph \<open>Certificate conserving\<close>
text \<open>The code always terminates with a final state that
has the same certificate register content as the initial state.\<close>
definition cons_certif :: "com \<Rightarrow> bool" where
  "cons_certif c = (\<forall>s t s'. (c,s) \<Rightarrow>\<^bsup> t \<^esup> s' \<longrightarrow> s ''certificate'' = s' ''certificate'')"

end


theory Functions
  imports Main
begin

datatype 'a tree = Tip |
Node "'a tree" 'a "'a tree"

fun mirror :: "'a tree \<Rightarrow> 'a tree" where
"mirror Tip = Tip" |
"mirror (Node l a r) = Node (mirror r) a (mirror l)"

lemma mirror_mirror : "mirror (mirror t) = t"
  apply(induction t)
   apply(auto)
  done

fun lookup :: "('a * 'b) list \<Rightarrow> 'a \<Rightarrow> 'b option" where
"lookup [] x = None" |
"lookup ((a,b)#ps) x = (if x = a then Some b else lookup ps x)"

definition sq :: "nat \<Rightarrow> nat" where
"sq n = n * n"

abbreviation sq' :: "nat \<Rightarrow> nat" where
"sq' n == n * n"

end


(* Author: Tobias Nipkow *)

section \<open>2-3 Tree from List\<close>

theory Tree23_of_List
imports Tree23
begin

text \<open>Linear-time bottom up conversion of a list of items into a complete 2-3 tree
whose inorder traversal yields the list of items.\<close>

subsection "Code"

text \<open>Nonempty lists of 2-3 trees alternating with items, starting and ending with a 2-3 tree:\<close>

datatype 'a tree23s = T "'a tree23" | TTs "'a tree23" "'a" "'a tree23s"

abbreviation "not_T ts == (\<forall>t. ts \<noteq> T t)"

fun len :: "'a tree23s \<Rightarrow> nat" where
"len (T _) = 1" |
"len (TTs _ _ ts) = len ts + 1"

fun trees :: "'a tree23s \<Rightarrow> 'a tree23 set" where
"trees (T t) = {t}" |
"trees (TTs t a ts) = {t} \<union> trees ts"

text \<open>Join pairs of adjacent trees:\<close>

fun join_adj :: "'a tree23s \<Rightarrow> 'a tree23s" where
"join_adj (TTs t1 a (T t2)) = T(Node2 t1 a t2)" |
"join_adj (TTs t1 a (TTs t2 b (T t3))) = T(Node3 t1 a t2 b t3)" |
"join_adj (TTs t1 a (TTs t2 b ts)) = TTs (Node2 t1 a t2) b (join_adj ts)"

text \<open>Towards termination of \<open>join_all\<close>:\<close>

lemma len_ge2:
  "not_T ts \<Longrightarrow> len ts \<ge> 2"
by(cases ts rule: join_adj.cases) auto

lemma [measure_function]: "is_measure len"
by(rule is_measure_trivial)

lemma len_join_adj_div2:
  "not_T ts \<Longrightarrow> len(join_adj ts) \<le> len ts div 2"
by(induction ts rule: join_adj.induct) auto

lemma len_join_adj1: "not_T ts \<Longrightarrow> len(join_adj ts) < len ts"
using len_join_adj_div2[of ts] len_ge2[of ts] by simp

corollary len_join_adj2[termination_simp]: "len(join_adj (TTs t a ts)) \<le> len ts"
using len_join_adj1[of "TTs t a ts"] by simp

fun join_all :: "'a tree23s \<Rightarrow> 'a tree23" where
"join_all (T t) = t" |
"join_all ts = join_all (join_adj ts)"

fun leaves :: "'a list \<Rightarrow> 'a tree23s" where
"leaves [] = T Leaf" |
"leaves (a # as) = TTs Leaf a (leaves as)"

definition tree23_of_list :: "'a list \<Rightarrow> 'a tree23" where
"tree23_of_list as = join_all(leaves as)"

subsection \<open>Functional correctness\<close>

subsubsection \<open>\<open>inorder\<close>:\<close>

fun inorder2 :: "'a tree23s \<Rightarrow> 'a list" where
"inorder2 (T t) = inorder t" |
"inorder2 (TTs t a ts) = inorder t @ a # inorder2 ts"

lemma inorder2_join_adj: "not_T ts \<Longrightarrow> inorder2(join_adj ts) = inorder2 ts"
by (induction ts rule: join_adj.induct) auto

lemma inorder_join_all: "inorder (join_all ts) = inorder2 ts"
proof (induction ts rule: join_all.induct)
  case 1 thus ?case by simp
next
  case (2 t a ts)
  thus ?case using inorder2_join_adj[of "TTs t a ts"]
    by (simp add: le_imp_less_Suc)
qed

lemma inorder2_leaves: "inorder2(leaves as) = as"
by(induction as) auto

lemma inorder: "inorder(tree23_of_list as) = as"
by(simp add: tree23_of_list_def inorder_join_all inorder2_leaves)

subsubsection \<open>Completeness:\<close>

lemma complete_join_adj:
  "\<forall>t \<in> trees ts. complete t \<and> height t = n \<Longrightarrow> not_T ts \<Longrightarrow>
   \<forall>t \<in> trees (join_adj ts). complete t \<and> height t = Suc n"
by (induction ts rule: join_adj.induct) auto

lemma complete_join_all:
 "\<forall>t \<in> trees ts. complete t \<and> height t = n \<Longrightarrow> complete (join_all ts)"
proof (induction ts arbitrary: n rule: join_all.induct)
  case 1 thus ?case by simp
next
  case (2 t a ts)
  thus ?case
    apply simp using complete_join_adj[of "TTs t a ts" n, simplified] by blast
qed

lemma complete_leaves: "t \<in> trees (leaves as) \<Longrightarrow> complete t \<and> height t = 0"
by (induction as) auto

corollary complete: "complete(tree23_of_list as)"
by(simp add: tree23_of_list_def complete_leaves complete_join_all[of _ 0])

subsection "Linear running time"

fun T_join_adj :: "'a tree23s \<Rightarrow> nat" where
"T_join_adj (TTs t1 a (T t2)) = 1" |
"T_join_adj (TTs t1 a (TTs t2 b (T t3))) = 1" |
"T_join_adj (TTs t1 a (TTs t2 b ts)) = T_join_adj ts + 1"

fun T_join_all :: "'a tree23s \<Rightarrow> nat" where
"T_join_all (T t) = 1" |
"T_join_all ts = T_join_adj ts + T_join_all (join_adj ts) + 1"

fun T_leaves :: "'a list \<Rightarrow> nat" where
"T_leaves [] = 1" |
"T_leaves (a # as) = T_leaves as + 1"

definition T_tree23_of_list :: "'a list \<Rightarrow> nat" where
"T_tree23_of_list as = T_leaves as + T_join_all(leaves as) + 1"

lemma T_join_adj: "not_T ts \<Longrightarrow> T_join_adj ts \<le> len ts div 2"
by(induction ts rule: T_join_adj.induct) auto

lemma len_ge_1: "len ts \<ge> 1"
by(cases ts) auto

lemma T_join_all: "T_join_all ts \<le> 2 * len ts"
proof(induction ts rule: join_all.induct)
  case 1 thus ?case by simp
next
  case (2 t a ts)
  let ?ts = "TTs t a ts"
  have "T_join_all ?ts = T_join_adj ?ts + T_join_all (join_adj ?ts) + 1"
    by simp
  also have "\<dots> \<le> len ?ts div 2 + T_join_all (join_adj ?ts) + 1"
    using T_join_adj[of ?ts] by simp
  also have "\<dots> \<le> len ?ts div 2 + 2 * len (join_adj ?ts) + 1"
    using "2.IH" by simp
  also have "\<dots> \<le> len ?ts div 2 + 2 * (len ?ts div 2) + 1"
    using len_join_adj_div2[of ?ts] by simp
  also have "\<dots> \<le> 2 * len ?ts" using len_ge_1[of ?ts] by linarith
  finally show ?case .
qed

lemma T_leaves: "T_leaves as = length as + 1"
by(induction as) auto

lemma len_leaves: "len(leaves as) = length as + 1"
by(induction as) auto

lemma T_tree23_of_list: "T_tree23_of_list as \<le> 3*(length as) + 4"
using T_join_all[of "leaves as"] by(simp add: T_tree23_of_list_def T_leaves len_leaves)

end