(*
    Author:      René Thiemann
                 Akihisa Yamada
    License:     BSD
*)
section \<open>Comparison of Matrices\<close>

text \<open>We use matrices over ordered semirings to again define ordered semirings.
  There are two instances, one for ordinary semirings (where addition is monotone w.r.t. the
  strict ordering in a single argument);
  and one for semirings like the arctic one, where addition is interpreted
  as maximum, and therefore monotonicity of the strict ordering in a single argument is no
  longer provided.

  Both ordered semirings are used for checking termination proofs, where at the moment only
  the ordinary semirings is supported for checking complexity proofs.\<close>

theory Matrix_Comparison
imports
  Matrix
  Matrix.Ordered_Semiring
begin

context ord
begin
definition mat_ge :: "'a mat \<Rightarrow> 'a mat \<Rightarrow> bool" (infix "\<ge>\<^sub>m" 50) where
  "A \<ge>\<^sub>m B = (\<forall> i < dim_row A. \<forall> j < dim_col A. A $$ (i,j) \<ge> B $$ (i,j))"

lemma mat_geI[intro]: assumes "A \<in> carrier_mat nr nc"
  "\<And> i j. i < nr \<Longrightarrow> j < nc \<Longrightarrow> A $$ (i,j) \<ge> B $$ (i,j)"
  shows "A \<ge>\<^sub>m B"
  using assms unfolding mat_ge_def by auto

lemma mat_geD[dest]: assumes "A \<ge>\<^sub>m B" and "i < dim_row A" "j < dim_col A"
  shows "A $$ (i,j) \<ge> B $$ (i,j)"
  using assms unfolding mat_ge_def by auto

definition mat_gt :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> 'a mat \<Rightarrow> 'a mat \<Rightarrow> bool" where
  "mat_gt gt sd A B = (A \<ge>\<^sub>m B \<and> (\<exists> i < sd. \<exists> j < sd. gt (A $$ (i,j)) (B $$ (i,j))))"

lemma mat_gtI[intro]: assumes "A \<ge>\<^sub>m B"
  and "i < sd" "j < sd" "gt (A $$ (i,j)) (B $$ (i,j))"
  shows "mat_gt gt sd A B"
  using assms unfolding mat_gt_def by auto

lemma mat_gtD[dest]: assumes "mat_gt gt sd A B"
  shows "A \<ge>\<^sub>m B" "\<exists> i < sd. \<exists> j < sd. gt (A $$ (i,j)) (B $$ (i,j))"
  using assms unfolding mat_gt_def by auto

definition mat_max :: "'a mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat" ("max\<^sub>m") where
  "max\<^sub>m A B = mat (dim_row A) (dim_col A) (\<lambda> ij. max (A $$ ij) (B $$ ij))"

lemma mat_max_carrier[simp]:
  "max\<^sub>m A B \<in> carrier_mat (dim_row A) (dim_col A)"
  unfolding mat_max_def by auto

lemma mat_max_closed[intro]:
  "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> max\<^sub>m A B \<in> carrier_mat nr nc"
  unfolding mat_max_def by auto

lemma mat_max_index:
  assumes "i < dim_row A" "j < dim_col A"
  shows "(mat_max A B) $$ (i,j) = max (A $$ (i,j)) (B $$ (i,j))"
  unfolding mat_max_def using index_mat assms by auto

definition (in zero) mat_default :: "'a \<Rightarrow> nat \<Rightarrow> 'a mat" ("default\<^sub>m") where
  "default\<^sub>m d n = mat n n (\<lambda> (i,j). if i = j then d else 0)"

lemma mat_default_carrier[simp]: "default\<^sub>m d n \<in> carrier_mat n n"
  unfolding mat_default_def by auto
end

definition mat_mono :: "('a \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> 'a mat \<Rightarrow> bool"
where "mat_mono P sd A = (\<forall> j < sd. \<exists> i < sd. P (A $$ (i,j)))"

context non_strict_order
begin
lemma mat_ge_trans: assumes "A \<ge>\<^sub>m B" "B \<ge>\<^sub>m C"
  and "A \<in> carrier_mat nr nc" "B \<in> carrier_mat nr nc"
shows "A \<ge>\<^sub>m C"
  using assms ge_trans[of "B $$ (i,j)" "A $$ (i,j)" for i j]
  unfolding mat_ge_def carrier_mat_def by auto

lemma mat_ge_refl: "A \<ge>\<^sub>m A"
  unfolding mat_ge_def by (auto simp: ge_refl)

lemma mat_max_comm: "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> max\<^sub>m A B = max\<^sub>m B A"
  unfolding mat_max_def by (intro eq_matI, auto simp: max_comm)

lemma mat_max_ge: "max\<^sub>m A B \<ge>\<^sub>m A"
  unfolding mat_max_def by (intro mat_geI[of _ "dim_row A" "dim_col A"], auto)

lemma mat_max_ge_0: "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> A \<ge>\<^sub>m B \<Longrightarrow> max\<^sub>m A B = A"
  unfolding mat_max_def by (intro eq_matI, auto simp: max_id)

lemma mat_max_mono: "A \<ge>\<^sub>m B \<Longrightarrow>
   A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> C \<in> carrier_mat nr nc \<Longrightarrow>
   max\<^sub>m C A \<ge>\<^sub>m max\<^sub>m C B"
  by (intro mat_geI[of _ nr nc], auto simp: max_mono mat_max_def)
end

lemma mat_plus_left_mono: "A \<ge>\<^sub>m (B :: 'a :: ordered_ab_semigroup mat)
  \<Longrightarrow> A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> C \<in> carrier_mat nr nc
  \<Longrightarrow> A + C \<ge>\<^sub>m B + C"
  by (intro mat_geI[of _ nr nc], auto simp: plus_left_mono)

lemma mat_plus_right_mono: "B \<ge>\<^sub>m (C :: 'a :: ordered_ab_semigroup mat)
  \<Longrightarrow> A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> C \<in> carrier_mat nr nc
  \<Longrightarrow> A + B \<ge>\<^sub>m A + C"
  by (intro mat_geI[of _ nr nc], auto simp: plus_right_mono)

lemma plus_mono: "x\<^sub>1 \<ge> (x\<^sub>2 :: 'a :: ordered_ab_semigroup) \<Longrightarrow>
  y\<^sub>1 \<ge> y\<^sub>2 \<Longrightarrow> x\<^sub>1 + y\<^sub>1 \<ge> x\<^sub>2 + y\<^sub>2"
  using ge_trans[OF plus_left_mono[of x\<^sub>2 x\<^sub>1] plus_right_mono[of y\<^sub>2 y\<^sub>1]] .

text \<open>Since one cannot use @{thm sum_mono} (it requires other
  class constraints like @{class order}), we make our own copy of this
  fact.\<close>

lemma sum_mono_ge:
  assumes ge: "\<And>i. i\<in>K \<Longrightarrow> f (i::'a) \<ge> ((g i)::('b::ordered_semiring_0))"
  shows "(\<Sum>i\<in>K. f i) \<ge> (\<Sum>i\<in>K. g i)"
proof (cases "finite K")
  case True
  thus ?thesis using ge
  proof induct
    case empty
    show ?case by (simp add: ge_refl)
  next
    case insert
    thus ?case using plus_mono by fastforce
  qed
next
  case False then show ?thesis by (simp add: ge_refl)
qed

lemma (in one_mono_ordered_semiring_1) sum_mono_gt:
  assumes le: "\<And>i. i\<in>K \<Longrightarrow> f (i::'b) \<ge> ((g i)::'a)"
  and i: "i \<in> K"
  and gt: "f i \<succ> g i"
  and K: "finite K"
  shows "(\<Sum>i\<in>K. f i) \<succ> (\<Sum>i\<in>K. g i)"
proof -
  have id: "\<And> f. (\<Sum>i\<in>K. f i) = f i + (\<Sum>i\<in> K - {i}. f i)"
    by (rule sum.remove[OF K i])
  have ge: "(\<Sum>i\<in> K - {i}. f i) \<ge> (\<Sum>i\<in> K - {i}. g i)"
    by (rule sum_mono_ge[OF le], auto)
  show ?thesis unfolding id using compat[OF plus_right_mono[OF ge] plus_gt_left_mono[OF gt]] .
qed

lemma scalar_left_mono: assumes
  "u \<in> carrier_vec n" "v \<in> carrier_vec n" "w \<in> carrier_vec n"
  and "\<And> i. i < n \<Longrightarrow> u $ i \<ge> v $ i"
  and "\<And> i. i < n \<Longrightarrow> w $ i \<ge> (0 :: 'a :: ordered_semiring_0)"
  shows "u \<bullet> w \<ge> v \<bullet> w" unfolding scalar_prod_def
  by (intro sum_mono_ge times_left_mono, insert assms, auto)

lemma scalar_right_mono: assumes
  "u \<in> carrier_vec n" "v \<in> carrier_vec n" "w \<in> carrier_vec n"
  and "\<And> i. i < n \<Longrightarrow> v $ i \<ge> w $ i"
  and "\<And> i. i < n \<Longrightarrow> u $ i \<ge> (0 :: 'a :: ordered_semiring_0)"
  shows "u \<bullet> v \<ge> u \<bullet> w"
proof -
  have dim: "dim_vec v = dim_vec w" using assms by auto
  show ?thesis unfolding scalar_prod_def dim
    by (intro sum_mono_ge times_right_mono, insert assms, auto)
qed

lemma mat_mult_left_mono: assumes C0: "C \<ge>\<^sub>m 0\<^sub>m n n"
  and AB: "A \<ge>\<^sub>m (B :: 'a :: ordered_semiring_0 mat)"
  and carr: "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n"
  shows "A * C \<ge>\<^sub>m B * C"
proof -
  {
    fix i j
    assume i: "i < n" "j < n"
    have "row A i \<bullet> col C j \<ge> row B i \<bullet> col C j"
      by (rule scalar_left_mono[of _ n], insert C0 AB carr i, auto)
  }
  thus ?thesis
    by (intro mat_geI[of _ n n], insert carr, auto)
qed

lemma mat_mult_right_mono: assumes A0: "A \<ge>\<^sub>m 0\<^sub>m n n"
  and BC: "B \<ge>\<^sub>m (C :: 'a :: ordered_semiring_0 mat)"
  and carr: "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n"
  shows "A * B \<ge>\<^sub>m A * C"
proof -
  {
    fix i j
    assume i: "i < n" "j < n"
    have "row A i \<bullet> col B j \<ge> row A i \<bullet> col C j"
      by (rule scalar_right_mono[of _ n], insert A0 BC carr i, auto)
  }
  thus ?thesis
    by (intro mat_geI[of _ n n], insert carr, auto)
qed

lemma one_mat_ge_zero: "(1\<^sub>m n :: 'a :: ordered_semiring_1 mat) \<ge>\<^sub>m 0\<^sub>m n n"
  by (intro mat_geI[of _ n n], auto simp: one_ge_zero ge_refl)

context order_pair
begin
lemma mat_ge_gt_trans: assumes sd: "sd \<le> n" and AB: "A \<ge>\<^sub>m B" and BC: "mat_gt gt sd B C"
  and A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
shows "mat_gt gt sd A C"
proof -
  from mat_gtD[OF BC] obtain i j where ij: "i < sd" "j < sd" and gt: "B $$ (i, j) \<succ> C $$ (i, j)"
    and BC: "B \<ge>\<^sub>m C" by auto
  from mat_ge_trans[OF AB BC A B] have AC: "A \<ge>\<^sub>m C" .
  from mat_geD[OF AB, of i j] A sd ij have ge: "A $$ (i,j) \<ge> B $$ (i,j)" by auto
  from compat[OF ge gt] have gt: "A $$ (i, j) \<succ> C $$ (i, j)" .
  with ij AC show ?thesis by auto
qed

lemma mat_gt_ge_trans: assumes sd: "sd \<le> n" and AB: "mat_gt gt sd A B" and BC: "B \<ge>\<^sub>m C"
  and A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
shows "mat_gt gt sd A C"
proof -
  from mat_gtD[OF AB] obtain i j where ij: "i < sd" "j < sd" and gt: "A $$ (i, j) \<succ> B $$ (i, j)"
    and AB: "A \<ge>\<^sub>m B" by auto
  from mat_ge_trans[OF AB BC A B] have AC: "A \<ge>\<^sub>m C" .
  from mat_geD[OF BC, of i j] B sd ij have ge: "B $$ (i,j) \<ge> C $$ (i,j)" by auto
  from compat2[OF gt ge] have gt: "A $$ (i, j) \<succ> C $$ (i, j)" .
  with ij AC show ?thesis by auto
qed

lemma mat_gt_imp_mat_ge: "mat_gt gt sd A B \<Longrightarrow> A \<ge>\<^sub>m B"
  by (rule mat_gtD)

lemma mat_gt_trans: assumes sd: "sd \<le> n" and AB: "mat_gt gt sd A B" and BC: "mat_gt gt sd B C"
  and A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
shows "mat_gt gt sd A C"
  using mat_ge_gt_trans[OF sd mat_gt_imp_mat_ge[OF AB] BC A B] .

lemma mat_default_ge_0: "default\<^sub>m default n \<ge>\<^sub>m 0\<^sub>m n n"
  by (intro mat_geI[of _ n n], auto simp: mat_default_def default_ge_zero ge_refl)
end

definition mat_ordered_semiring :: "nat \<Rightarrow> nat \<Rightarrow> ('a :: ordered_semiring_1 \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'b \<Rightarrow> ('a mat,'b) ordered_semiring_scheme" where
  "mat_ordered_semiring n sd gt b \<equiv> ring_mat TYPE('a) n \<lparr>
    ordered_semiring.geq = (\<ge>\<^sub>m),
    gt = mat_gt gt sd,
    max = max\<^sub>m,
    \<dots> = b\<rparr>"

lemma (in one_mono_ordered_semiring_1) mat_ordered_semiring: assumes sd_n: "sd \<le> n"
  shows "ordered_semiring
    (mat_ordered_semiring n sd (\<succ>) b :: ('a mat,'b) ordered_semiring_scheme)"
  (is "ordered_semiring ?R")
proof -
  interpret semiring ?R unfolding mat_ordered_semiring_def by (rule semiring_mat)
  show ?thesis
    by (unfold_locales, unfold ring_mat_def mat_ordered_semiring_def ordered_semiring_record_simps,
    auto intro: mat_ge_trans mat_ge_refl mat_ge_gt_trans[OF sd_n] mat_gt_ge_trans[OF sd_n] mat_max_comm
    mat_max_ge mat_max_ge_0 mat_max_mono one_mat_ge_zero mat_gt_trans[OF sd_n] mat_gt_imp_mat_ge
    mat_plus_left_mono mat_mult_left_mono mat_mult_right_mono)
qed

context weak_SN_strict_mono_ordered_semiring_1
begin

lemma weak_mat_gt_mono: assumes sd_n: "sd \<le> n" and
    orient: "\<And> A B. A \<in> carrier_mat n n \<Longrightarrow> B \<in> carrier_mat n n \<Longrightarrow> (A,B) \<in> set ABs \<Longrightarrow> mat_gt weak_gt sd A B"
   shows "\<exists> gt. SN_strict_mono_ordered_semiring_1 default gt mono \<and>
     (\<forall> A B. A \<in> carrier_mat n n \<longrightarrow> B \<in> carrier_mat n n \<longrightarrow> (A, B) \<in> set ABs \<longrightarrow> mat_gt gt sd A B)"
proof -
  let ?n = "[0 ..< n]"
  let ?m1x = "[ A $$ (i,j) . A <- map fst ABs, i <- ?n, j <- ?n]"
  let ?m2y = "[ B $$ (i,j) . B <- map snd ABs, i <- ?n, j <- ?n]"
  let ?pairs = "concat (map (\<lambda> x. map (\<lambda> y. (x,y)) ?m2y) ?m1x)"
  let ?strict = "filter (\<lambda> (x,y). weak_gt x y) ?pairs"
  have "\<forall> x y. (x,y) \<in> set ?strict \<longrightarrow> weak_gt x y" by auto
  from weak_gt_mono[OF this] obtain gt where order: "SN_strict_mono_ordered_semiring_1 default gt mono"
    and orient2: "\<And> x y. (x, y) \<in> set ?strict \<Longrightarrow> gt x y" by auto
  show ?thesis
  proof (intro exI allI conjI impI, rule order)
    fix A B
    assume A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
      and AB: "(A, B) \<in> set ABs"
    from orient[OF this] have "mat_gt weak_gt sd A B" by auto
    from mat_gtD[OF this] obtain i j where
      ge: "A \<ge>\<^sub>m B" and ij: "i < sd" "j < sd" and wgt: "weak_gt (A $$ (i,j)) (B $$ (i,j))"
      by auto
    from ij \<open>sd \<le> n\<close> have ij': "i < n" "j < n" by auto
    have gt: "gt (A $$ (i,j)) (B $$ (i,j))"
      by (rule orient2, insert ij' AB wgt, force)
    show "mat_gt gt sd A B" using ij gt ge by auto
  qed
qed
end

lemma sum_mat_mono:
  assumes A: "A \<in> carrier_mat nr nc" and B: "B \<in> carrier_mat nr nc"
  and AB: "A \<ge>\<^sub>m (B :: 'a :: ordered_semiring_0 mat)"
  shows "sum_mat A \<ge> sum_mat B"
proof -
  from A B have id: "dim_row B = dim_row A" "dim_col B = dim_col A" by auto
  show ?thesis unfolding sum_mat_def id
    by (rule sum_mono_ge, insert mat_geD[OF AB] id, auto)
qed

context one_mono_ordered_semiring_1
begin
lemma sum_mat_mono_gt:
  assumes "sd \<le> n"
  and A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
  and AB: "mat_gt (\<succ>) sd A (B :: 'a mat)"
  shows "sum_mat A \<succ> sum_mat B"
proof -
  from A B have id: "dim_row B = dim_row A" "dim_col B = dim_col A" by auto
  from mat_gtD[OF AB] obtain i j where AB: "A \<ge>\<^sub>m B" and
    ij: "i < sd" "j < sd" and gt: "A $$ (i,j) \<succ> B $$ (i,j)" by auto
  show ?thesis unfolding sum_mat_def id
    by (rule sum_mono_gt[of _ _ _ "(i,j)"], insert ij gt mat_geD[OF AB] A B \<open>sd \<le> n\<close>, auto)
qed

lemma mat_plus_gt_left_mono: assumes sd_n: "sd \<le> n" and gt: "mat_gt (\<succ>) sd A B"
  and A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n" and C: "C \<in> carrier_mat n n"
  shows "mat_gt (\<succ>) sd (A + C) (B + C)"
proof -
  note wf = A B C
  from mat_gtD[OF gt] obtain i j
    where AB: "A \<ge>\<^sub>m B" and ij: "i < sd" "j < sd" and gt: "A $$ (i,j) \<succ> B $$ (i,j)" by auto
  from plus_gt_left_mono[OF gt, of "C $$ (i,j)"]
  show ?thesis
    by (intro mat_gtI[OF mat_geI[of _ n n] ij], insert mat_geD[OF AB] wf ij sd_n, auto intro: plus_left_mono)
qed

lemma mat_gt_ge_mono: "sd \<le> n \<Longrightarrow> mat_gt gt sd A B \<Longrightarrow>
   mat_gt gt sd C D \<Longrightarrow>
   A \<in> carrier_mat n n \<Longrightarrow>
   B \<in> carrier_mat n n \<Longrightarrow>
   C \<in> carrier_mat n n \<Longrightarrow>
   D \<in> carrier_mat n n \<Longrightarrow>
   mat_gt gt sd (A + C) (B + D)"
  by (rule mat_gt_ge_trans[OF _ mat_plus_gt_left_mono mat_plus_right_mono[OF mat_gt_imp_mat_ge]],
  auto)

lemma mat_default_gt_mat0: assumes sd_pos: "sd > 0" and sd_n: "sd \<le> n"
  shows "mat_gt (\<succ>) sd (default\<^sub>m default n) (0\<^sub>m n n)"
proof -
  from assms have n: "n > 0" by auto
  show ?thesis
    by (intro mat_gtI[OF mat_default_ge_0 sd_pos sd_pos], insert sd_pos sd_n, auto simp: mat_default_def default_gt_zero)
qed
end

context SN_one_mono_ordered_semiring_1
begin

abbreviation mat_s :: "'a mat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a mat \<Rightarrow> bool" ("(_ \<succ>\<^sub>m _ _ _)" [51,51,51,51] 50)
 where "A \<succ>\<^sub>m n sd B \<equiv> (A \<in> carrier_mat n n \<and> B \<in> carrier_mat n n \<and> B \<ge>\<^sub>m 0\<^sub>m n n \<and> mat_gt (\<succ>) sd A B)"

lemma mat_gt_SN: assumes sd_n: "sd \<le> n" shows "SN {(m1,m2) . m1 \<succ>\<^sub>m n sd m2}"
proof
  fix A
  assume "\<forall> i. (A i, A (Suc i)) \<in> {(m1,m2). m1 \<succ>\<^sub>m n sd m2}"
  hence "\<And> i. (A i, A (Suc i)) \<in> {(m1,m2). m1 \<succ>\<^sub>m n sd m2}" by blast
  hence A: "\<And> i. A i \<in> carrier_mat n n"
    and ge: "\<And> i. A (Suc i) \<ge>\<^sub>m 0\<^sub>m n n"
    and gt: "\<And> i. mat_gt (\<succ>) sd (A i) (A (Suc i))" by auto
  define s where "s = (\<lambda> i. sum_mat (A i))"
  {
    fix i
    from sum_mat_mono_gt[OF sd_n A A gt[of i]]
    have gt: "s i \<succ> s (Suc i)" unfolding s_def .
    from sum_mat_mono[OF A _ ge[of i]]
    have ge: "s (Suc i) \<ge> 0" unfolding s_def by auto
    note ge gt
  }
  with SN show False by auto
qed
end

context SN_strict_mono_ordered_semiring_1
begin

lemma mat_mono: assumes sd_n: "sd \<le> n" and A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n" and C: "C \<in> carrier_mat n n"
  and gt: "mat_gt (\<succ>) sd B C" and gez: "A \<ge>\<^sub>m 0\<^sub>m n n" and mmono: "mat_mono mono sd A"
  shows "mat_gt (\<succ>) sd (A * B) (A * C)" (is "mat_gt _ _ ?AB ?AC")
proof -
  from mat_gtD[OF gt] obtain i j where
    i: "i < sd" and j: "j < sd" and gt: "B $$ (i,j) \<succ> C $$ (i,j)" and BC: "B \<ge>\<^sub>m C" by auto
  from mat_mult_right_mono[OF gez BC A B C] have ge: "?AB \<ge>\<^sub>m ?AC" .
  from mmono[unfolded mat_mono_def] i obtain k where k: "k < sd" and mon: "mono (A $$ (k,i))" by auto
  from mat_geD[OF gez] k i sd_n A have "A $$ (k, i) \<ge> 0" by auto
  note mono = mono[OF mon gt this]
  have id: "dim_vec (col B j) = n" "dim_vec (col C j) = n" using j sd_n B C by auto
  {
    fix i
    assume "i < n"
    hence "row A k $ i * col B j $ i \<ge> row A k $ i * col C j $ i"
      by (intro times_right_mono, insert j k sd_n A B C mat_geD[OF gez] mat_geD[OF BC], auto)
  } note sge = this
  have gt: "row A k \<bullet> col B j \<succ> row A k \<bullet> col C j" unfolding scalar_prod_def id
    by (rule sum_mono_gt[of _ _ _ i, OF sge], insert mono k i j A B C sd_n, auto)
  show ?thesis
    by (rule mat_gtI[OF ge k j], insert k j sd_n A B C gt, auto)
qed
end

definition mat_comp_all :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a mat \<Rightarrow> 'a mat \<Rightarrow> bool"
where "mat_comp_all r A B =
   (\<forall> i < dim_row A. \<forall> j < dim_col A. r (A $$ (i,j)) (B $$ (i,j)))"

lemma mat_comp_allI:
  assumes "A \<in> carrier_mat nr nc" "B \<in> carrier_mat nr nc"
  and "\<And> i j. i < nr \<Longrightarrow> j < nc \<Longrightarrow> r (A $$(i,j)) (B $$ (i,j))"
  shows "mat_comp_all r A B"
  unfolding mat_comp_all_def using assms by simp

lemma mat_comp_allE:
  assumes "mat_comp_all r A B"
  and "A \<in> carrier_mat nr nc" "B \<in> carrier_mat nr nc"
  shows "\<And> i j. i < nr \<Longrightarrow> j < nc \<Longrightarrow> r (A $$ (i,j)) (B $$(i,j))"
  using assms unfolding mat_comp_all_def by auto

context weak_SN_both_mono_ordered_semiring_1
begin

abbreviation weak_mat_gt_arc :: "'a mat \<Rightarrow> 'a mat \<Rightarrow> bool"
where "weak_mat_gt_arc \<equiv> mat_comp_all weak_gt"

lemma weak_mat_gt_both_mono:
   assumes ABs: "set ABs \<subseteq> carrier_mat n n \<times> carrier_mat n n"
   and orient: "\<forall>(A,B) \<in> set ABs. weak_mat_gt_arc A B"
   shows "\<exists> gt. SN_both_mono_ordered_semiring_1 default gt arc_pos \<and>
   (\<forall>(A,B) \<in> set ABs. mat_comp_all gt A B)"
proof -
  let ?pairs = "[ (fst AB $$ (i,j), snd AB $$ (i,j)) . AB <- ABs, i <- [0 ..< n], j <- [0 ..< n]]"
  let ?strict = "filter (\<lambda> (x,y). weak_gt x y) ?pairs"
  have "\<forall> x y. (x,y) \<in> set ?strict \<longrightarrow> weak_gt x y" by auto
  from weak_gt_both_mono[OF this]
  obtain gt
    where order: "SN_both_mono_ordered_semiring_1 default gt arc_pos"
    and orient2: "\<And> x y. (x, y) \<in> set ?strict \<Longrightarrow> gt x y"
    by auto
  {
    fix A B assume AB: "(A,B) \<in> set ABs"
    hence A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
      using AB ABs by auto
    have "mat_comp_all gt A B"
    proof (rule mat_comp_allI[OF A B])
      fix i j
      assume i: "i < n" and j: "j < n"
      from mat_comp_allE[OF _ A B this] orient AB
      have weak_gt: "weak_gt (A $$(i,j)) (B $$ (i,j))" (is "weak_gt ?x ?y") by auto
      have "(?x,?y) \<in> set ?pairs" using A AB i j by force
      with weak_gt
      have gt: "(?x,?y) \<in> set ?strict" by simp
      show "gt ?x ?y" by (rule orient2[OF gt])
    qed
  }
  hence "\<forall>(A, B)\<in>set ABs. mat_comp_all gt A B" by auto
  thus ?thesis using order by auto
qed
end

definition mat_both_ordered_semiring :: "nat \<Rightarrow> ('a :: ordered_semiring_1 \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'b \<Rightarrow> ('a mat,'b) ordered_semiring_scheme" where
  "mat_both_ordered_semiring n gt b \<equiv> ring_mat TYPE('a) n \<lparr>
    ordered_semiring.geq = mat_ge,
    gt = mat_comp_all gt,
    max = mat_max,
    \<dots> = b\<rparr>"

(* checking whether a matrix is arctic positive (first entry is arctic positive) *)
definition mat_arc_posI :: "('a \<Rightarrow> bool) \<Rightarrow> 'a mat \<Rightarrow> bool"
where "mat_arc_posI ap A \<equiv> ap (A $$ (0,0))"

context both_mono_ordered_semiring_1
begin

abbreviation mat_gt_arc :: "'a mat \<Rightarrow> 'a mat \<Rightarrow> bool"
where "mat_gt_arc \<equiv> mat_comp_all gt"

abbreviation mat_arc_pos :: "'a mat \<Rightarrow> bool"
where "mat_arc_pos \<equiv> mat_arc_posI arc_pos"

lemma mat_max_id: fixes A :: "'a mat"
  assumes ge: "mat_ge A B"
  and A: "A \<in> carrier_mat nr nc"
  and B: "B \<in> carrier_mat nr nc"
  shows "mat_max A B = A"
  using mat_max_ge_0[OF A B ge] .

lemma mat_gt_arc_trans:
  assumes A_B: "mat_gt_arc A B"
  and B_C: "mat_gt_arc B C"
  and A: "A \<in> carrier_mat nr nc"
  and B: "B \<in> carrier_mat nr nc"
  and C: "C \<in> carrier_mat nr nc"
  shows "mat_gt_arc A C"
proof (rule mat_comp_allI[OF A C])
  fix i j
  assume i: "i < nr" and j: "j < nc"
  from mat_comp_allE[OF A_B A B i j] mat_comp_allE[OF B_C B C i j]
  show "A $$ (i,j) \<succ> C $$ (i,j)" by (rule gt_trans)
qed

lemma mat_gt_arc_compat:
  assumes ge: "mat_ge A B"
  and gt: "mat_gt_arc B C"
  and A: "A \<in> carrier_mat nr nc"
  and B: "B \<in> carrier_mat nr nc"
  and C: "C \<in> carrier_mat nr nc"
  shows "mat_gt_arc A C"
proof (rule mat_comp_allI[OF A C])
  fix i j assume i: "i < nr" and j: "j < nc"
  have "A $$ (i,j) \<ge> B $$ (i,j)" using ge A i j by auto
  also have "B $$ (i,j) \<succ> C $$ (i,j)"
    using mat_comp_allE[OF gt B C i j] by auto
  finally show "A $$ (i,j) \<succ> C $$ (i,j)" by auto
qed

lemma mat_gt_arc_compat2:
  assumes gt: "mat_gt_arc A B"
  and ge: "mat_ge B C"
  and A: "A \<in> carrier_mat nr nc"
  and B: "B \<in> carrier_mat nr nc"
  and C: "C \<in> carrier_mat nr nc"
  shows "mat_gt_arc A C"
proof (rule mat_comp_allI[OF A C])
  fix i j assume i: "i < nr" and j: "j < nc"
  have "A $$ (i,j) \<succ> B $$ (i,j)"
    using mat_comp_allE[OF gt] A B i j by auto
  also have "B $$ (i,j) \<ge> C $$ (i,j)"
    using ge B i j by auto
  finally show "A $$ (i,j) \<succ> C $$ (i,j)" by auto
qed

lemma mat_gt_arc_imp_mat_ge:
  assumes gt: "mat_gt_arc A B"
  and A: "A \<in> carrier_mat nr nc"
  and B: "B \<in> carrier_mat nr nc"
  shows "mat_ge A B"
  using subst mat_geI[OF A]
  using mat_comp_allE[OF gt A B] gt_imp_ge by auto

lemma (in both_mono_ordered_semiring_1) mat_both_ordered_semiring: assumes n: "n > 0"
  shows "ordered_semiring
    (mat_both_ordered_semiring n (\<succ>) b :: ('a mat,'b) ordered_semiring_scheme)"
  (is "ordered_semiring ?R")
proof -
  interpret semiring ?R unfolding mat_both_ordered_semiring_def by (rule semiring_mat)
  show ?thesis
    apply (unfold_locales)
    unfolding ring_mat_def mat_both_ordered_semiring_def ordered_semiring_record_simps
    apply(
      auto intro: mat_max_comm mat_ge_trans
      mat_plus_left_mono mat_mult_left_mono mat_mult_right_mono mat_ge_refl
      one_mat_ge_zero mat_max_mono mat_max_ge mat_max_id
      mat_gt_arc_trans mat_gt_arc_imp_mat_ge
      mat_gt_arc_compat mat_gt_arc_compat2)
    done
qed

lemma mat0_leastI:
  assumes A: "A \<in> carrier_mat nr nc"
  shows "mat_gt_arc A (0\<^sub>m nr nc)"
proof (rule mat_comp_allI[OF A])
  fix i j
  assume i: "i < nr" and j: "j < nc"
  thus "A $$ (i,j) \<succ> 0\<^sub>m nr nc $$ (i,j)" by (auto simp: zero_leastI)
qed auto

lemma mat0_leastII:
  assumes gt: "mat_gt_arc (0\<^sub>m nr nc) A"
  and A: "A \<in> carrier_mat nr nc"
  shows "A = 0\<^sub>m nr nc"
  apply (rule eq_matI)
  unfolding index_zero_mat
  using A
proof -
  fix i j
  assume i: "i < nr" and j: "j < nc"
  show "A $$ (i,j) = 0"
    using zero_leastII mat_comp_allE[OF gt _ A] i j by auto
qed auto

lemma mat0_leastIII:
  assumes A: "A \<in> carrier_mat nr nc"
  shows "mat_ge A ((0\<^sub>m nr nc) :: 'a mat)"
proof (rule mat_geI[OF A]; unfold index_zero_mat)
  fix i j
  assume i: "i < nr" and j: "j < nc"
  show "A $$ (i,j) \<ge> 0" using zero_leastIII by simp
qed

lemma mat_max_0_id: fixes A :: "'a mat"
  assumes A: "A \<in> carrier_mat nr nc"
  shows "mat_max (0\<^sub>m nr nc) A = A"
  unfolding mat_max_comm[OF zero_carrier_mat A]
  by (rule mat_max_id[OF mat0_leastIII[OF A] A], simp)

lemma mat_arc_pos_one:
  assumes n0: "n > 0"
  shows "mat_arc_posI arc_pos (1\<^sub>m n)"
  unfolding mat_arc_posI_def
  unfolding arc_pos_one index_one_mat(1)[OF n0 n0]
  using arc_pos_one by simp

lemma mat_arc_pos_zero:
  assumes n0: "n > 0"
  shows "\<not> mat_arc_posI arc_pos (0\<^sub>m n n)"
  unfolding mat_arc_posI_def
  unfolding index_zero_mat(1)[OF n0 n0] using arc_pos_zero by simp

lemma mat_gt_arc_plus_mono:
  assumes gt1: "mat_gt_arc A B"
  and gt2: "mat_gt_arc C D"
  and A: "(A::'a mat) \<in> carrier_mat nr nc"
  and B: "(B::'a mat) \<in> carrier_mat nr nc"
  and C: "(C::'a mat) \<in> carrier_mat nr nc"
  and D: "(D::'a mat) \<in> carrier_mat nr nc"
  shows "mat_gt_arc (A + C) (B + D)" (is "mat_gt_arc ?AC ?BD")
proof -
  show ?thesis
  proof (rule mat_comp_allI)
    fix i j
    assume i: "i < nr" and j: "j < nc"
    hence ijC: "i < dim_row C" "j < dim_col C"
      and ijD: "i < dim_row D" "j < dim_col D"
      using C D by auto
    show "?AC $$ (i,j) \<succ> ?BD $$ (i,j)"
      unfolding index_add_mat(1)[OF ijC]
      unfolding index_add_mat(1)[OF ijD]
      using plus_gt_both_mono
      using mat_comp_allE[OF gt1 A B] mat_comp_allE[OF gt2 C D] i j by auto
  qed (insert A B C D, auto)
qed

definition vec_comp_all :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a vec \<Rightarrow> 'a vec \<Rightarrow> bool"
  where "vec_comp_all r v w \<equiv> \<forall>i < dim_vec v. r (v $ i) (w $ i)"

lemma vec_comp_allI:
  assumes "\<And>i. i < dim_vec v \<Longrightarrow> r (v $ i) (w $ i)"
  shows "vec_comp_all r v w"
  unfolding vec_comp_all_def using assms by auto

lemma vec_comp_allE:
  "vec_comp_all r v w \<Longrightarrow> i < dim_vec v \<Longrightarrow> r (v $ i) (w $ i)"
  unfolding vec_comp_all_def by auto

lemma scalar_prod_left_mono:
  assumes u: "u \<in> carrier_vec n"
  and v: "v \<in> carrier_vec n"
  and w: "w \<in> carrier_vec n"
  and uv: "vec_comp_all gt u v"
  shows "scalar_prod u w \<succ> scalar_prod v w"
proof -
  { fix m assume "m \<le> n"
    hence "(\<Sum>i<m. (u $ i) * (w $ i)) \<succ> (\<Sum>i<m. (v $ i) * (w $ i))"
    proof (induct m)
      case 0 show ?case using zero_leastI by simp next
      case (Suc m)
        hence uv: "u $ m \<succ> v $ m"
          using vec_comp_allE[OF uv] u by auto
        show ?case
          unfolding sum.lessThan_Suc
          apply (subst plus_gt_both_mono)
          using times_gt_left_mono Suc times_gt_left_mono[OF uv] by auto
    qed
  }
  from this[OF order.refl]
  show ?thesis
    unfolding scalar_prod_def atLeast0LessThan
    using w by auto
qed

lemma scalar_prod_right_mono:
  assumes u: "u \<in> carrier_vec n"
  and v: "v \<in> carrier_vec n"
  and w: "w \<in> carrier_vec n"
  and vw: "vec_comp_all gt v w"
  shows "scalar_prod u v \<succ> scalar_prod u w"
proof -
  { fix m assume "m \<le> n"
    hence "(\<Sum>i<m. (u $ i) * (v $ i)) \<succ> (\<Sum>i<m. (u $ i) * (w $ i))"
    proof (induct m)
      case 0 show ?case using zero_leastI by simp next
      case (Suc m)
        hence vw: "v $ m \<succ> w $ m"
          using vec_comp_allE[OF vw] v by auto
        show ?case
          unfolding sum.lessThan_Suc
          apply (subst plus_gt_both_mono)
          using times_gt_left_mono Suc times_gt_right_mono[OF vw] by auto
    qed
  }
  from this[OF order.refl]
  show ?thesis
    unfolding scalar_prod_def atLeast0LessThan
    using v w by auto
qed

lemma mat_gt_arc_mult_left_mono:
  assumes gt1: "mat_gt_arc A B"
  and A: "(A::'a mat) \<in> carrier_mat nr n"
  and B: "(B::'a mat) \<in> carrier_mat nr n"
  and C: "(C::'a mat) \<in> carrier_mat n nc"
  shows "mat_gt_arc (A * C) (B * C)" (is "mat_gt_arc ?AC ?BC")
proof (rule mat_comp_allI)
  fix i j assume i: "i < nr" and j: "j < nc"
  hence iA: "i < dim_row A"
    and iB: "i < dim_row B"
    and jC: "j < dim_col C"
    using A B C by auto
  show "?AC $$ (i,j) \<succ> ?BC $$ (i,j)"
    unfolding index_mult_mat(1)[OF iA jC]
    unfolding index_mult_mat(1)[OF iB jC]
  proof(rule scalar_prod_left_mono)
    show "row A i \<in> carrier_vec n" using A by auto
    show "row B i \<in> carrier_vec n" using B by auto
    show "col C j \<in> carrier_vec n" using C by auto
    show rowAB: "vec_comp_all (\<succ>) (row A i) (row B i)"
    proof (intro vec_comp_allI)
      fix j assume j: "j < dim_vec (row A i)"
      have "A $$ (i,j) \<succ> B $$ (i,j)"
        using mat_comp_allE[OF gt1 A B i] j A by simp
      thus "row A i $ j \<succ> row B i $ j"
        using A B C i j by simp
    qed
  qed
qed (insert A B C, auto)

lemma mat_gt_arc_mult_right_mono:
  assumes gt1: "mat_gt_arc B C"
  and A: "(A::'a mat) \<in> carrier_mat nr n"
  and B: "(B::'a mat) \<in> carrier_mat n nc"
  and C: "(C::'a mat) \<in> carrier_mat n nc"
  shows "mat_gt_arc (A * B) (A * C)" (is "mat_gt_arc ?AB ?AC")
proof (rule mat_comp_allI)
  fix i j assume i: "i < nr" and j: "j < nc"
  hence iA: "i < dim_row A"
    and jB: "j < dim_col B"
    and jC: "j < dim_col C"
    using A B C by auto
  show "?AB $$ (i,j) \<succ> ?AC $$ (i,j)"
    unfolding index_mult_mat(1)[OF iA jB]
    unfolding index_mult_mat(1)[OF iA jC]
  proof(rule scalar_prod_right_mono)
    show "row A i \<in> carrier_vec n" using A by auto
    show "col B j \<in> carrier_vec n" using B by auto
    show "col C j \<in> carrier_vec n" using C by auto
    show rowAB: "vec_comp_all (\<succ>) (col B j) (col C j)"
    proof (intro vec_comp_allI)
      fix i assume i: "i < dim_vec (col B j)"
      have "B $$ (i,j) \<succ> C $$ (i,j)"
        using mat_comp_allE[OF gt1 B C] i j B by simp
      thus "col B j $ i \<succ> col C j $ i"
        using A B C i j by simp
    qed
  qed
qed (insert A B C, auto)

lemma mat_arc_pos_plus:
  assumes n0: "n > 0"
  and A: "A \<in> carrier_mat n n"
  and B: "B \<in> carrier_mat n n"
  and arc_pos: "mat_arc_pos A"
  shows "mat_arc_pos (A + B)"
  unfolding mat_arc_posI_def
  apply (subst index_add_mat(1))
  using arc_pos_plus[OF arc_pos[unfolded mat_arc_posI_def]]
  assms by auto

lemma scalar_prod_split_head: assumes
  "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "n > 0"
  shows "row A 0 \<bullet> col B 0 = A $$ (0,0) * B $$ (0,0) + (\<Sum>i = 1..<n. A $$ (0, i) * B $$ (i, 0))"
  unfolding scalar_prod_def
  using assms sum.atLeast_Suc_lessThan by auto

lemma mat_arc_pos_mult:
  assumes n0: "n > 0"
  and A: "A \<in> carrier_mat n n"
  and B: "B \<in> carrier_mat n n"
  and apA: "mat_arc_pos A"
  and apB: "mat_arc_pos B"
  shows "mat_arc_pos (A * B)"
  unfolding mat_arc_posI_def
  apply(subst index_mult_mat(1))
proof -
  let ?prod = "row A 0 \<bullet> col B 0"
  let ?head = "A $$ (0,0) * B $$ (0,0)"
  let ?rest = "\<Sum>i = 1..<n. A $$ (0, i) * B $$ (i, 0)"
  have ap: "arc_pos ?head"
    using apA apB
    unfolding mat_arc_posI_def
    using arc_pos_mult by auto
  have split: "?prod = ?head + ?rest"
    by (rule scalar_prod_split_head[OF A B n0])
  show "arc_pos (row A 0 \<bullet> col B 0)"
    unfolding split
    using ap arc_pos_plus by auto
qed (insert A B n0, auto)

lemma mat_arc_pos_mat_default:
  assumes n0: "n > 0" shows "mat_arc_pos (mat_default default n)"
  unfolding mat_arc_posI_def
  unfolding mat_default_def
  unfolding index_mat(1)[OF n0 n0]
  using arc_pos_default by simp

lemma mat_not_all_ge:
  assumes n_pos: "n > 0"
  and A: "A \<in> carrier_mat n n"
  and B: "B \<in> carrier_mat n n"
  and apB: "mat_arc_pos B"
  shows "\<exists>C. C \<in> carrier_mat n n \<and> mat_ge C (0\<^sub>m n n) \<and> mat_arc_pos C \<and> \<not> mat_ge A (B * C)"
proof -
  define c where "c = A $$ (0,0)"
  from apB have "arc_pos (B $$ (0,0))" unfolding mat_arc_posI_def .
  from not_all_ge[OF this, of c] obtain e where e0: "e \<ge> 0" and ae: "arc_pos e"
    and nc: "\<not> c \<ge> B $$ (0,0) * e" by auto
  let ?f = "\<lambda> i j. if i = 0 \<and> j = 0 then e else 0"
  let ?C = "mat n n (\<lambda> (i,j). ?f i j)"
  have C: "?C \<in> carrier_mat n n" by auto
  have C00: "?C $$ (0,0) = e" using n_pos by auto
  show ?thesis
  proof(intro exI conjI)
    show "?C \<ge>\<^sub>m 0\<^sub>m n n"
      by (rule mat_geI[of _ n n], auto simp: ge_refl e0)
    show "mat_arc_pos ?C"
      unfolding mat_arc_posI_def
      unfolding C00 by (rule ae)
    let ?mult = "B * ?C"
    from n_pos obtain nn where n: "n = Suc nn" by (cases n, auto)
    have col: "col ?C 0 = vec n (?f 0)" using n_pos by auto
    let ?prod = "row B 0 \<bullet> col ?C 0"
    let ?head = "B $$ (0,0) * ?C $$ (0,0)"
    let ?rest = "\<Sum>i = 1..<n. B $$ (0, i) * ?C $$ (i, 0)"

    from n_pos B have "?mult $$ (0,0) = ?prod" by auto
    also have "\<dots> = ?head + ?rest"
      by (rule scalar_prod_split_head[OF B C n_pos])
    also have "?rest = 0"
      by (rule sum.neutral, auto)
    finally have "?mult $$ (0,0) = B $$ (0,0) * e" using n_pos by simp
    with nc c_def have not_ge: "\<not> A $$ (0,0) \<ge> ?mult $$ (0,0)" by simp
    show "\<not> A \<ge>\<^sub>m ?mult"
    proof
      assume "A \<ge>\<^sub>m ?mult"
      from mat_geD[OF this, of 0 0] A B not_ge n_pos show False by auto
    qed
  qed auto
qed

end

context SN_both_mono_ordered_semiring_1
begin

lemma mat_gt_arc_SN:
  assumes n_pos: "n > 0"
  shows "SN {(A,B) \<in> carrier_mat n n \<times> carrier_mat n n. mat_arc_pos B \<and> mat_gt_arc A B}"
  (is "SN ?rel")
proof (rule ccontr)
  assume "\<not> SN ?rel"
  then obtain f A where "f (0 :: nat) = A" and steps: "\<forall> i. (f i, f (Suc i)) \<in> ?rel" unfolding SN_defs by blast
  hence pos: "\<forall> i. arc_pos (f (Suc i) $$ (0,0))" unfolding mat_arc_posI_def by blast
  have gt: "\<forall> i. f i $$ (0,0) \<succ> f (Suc i) $$ (0,0)"
  proof
    fix i
    from steps
    have wf1: "f i \<in> carrier_mat n n"
      and wf2: "f (Suc i) \<in> carrier_mat n n"
      and gt: "mat_gt_arc (f i) (f (Suc i))" by auto
    show "f i $$ (0,0) \<succ>  f (Suc i) $$ (0,0)"
      using mat_comp_allE[OF gt wf1 wf2]
      using index_zero_mat n_pos by force
  qed
  from pos gt SN show False unfolding SN_defs by force
qed

end

end


(*  Author: Tobias Nipkow *)

section "Regular expressions"

theory Regular_Exp
imports Regular_Set
begin

datatype (atoms: 'a) rexp =
  is_Zero: Zero |
  is_One: One |
  Atom 'a |
  Plus "('a rexp)" "('a rexp)" |
  Times "('a rexp)" "('a rexp)" |
  Star "('a rexp)"

primrec lang :: "'a rexp => 'a lang" where
"lang Zero = {}" |
"lang One = {[]}" |
"lang (Atom a) = {[a]}" |
"lang (Plus r s) = (lang r) Un (lang s)" |
"lang (Times r s) = conc (lang r) (lang s)" |
"lang (Star r) = star(lang r)"

abbreviation (input) regular_lang where "regular_lang A \<equiv> (\<exists>r. lang r = A)"

primrec nullable :: "'a rexp \<Rightarrow> bool" where
"nullable Zero = False" |
"nullable One = True" |
"nullable (Atom c) = False" |
"nullable (Plus r1 r2) = (nullable r1 \<or> nullable r2)" |
"nullable (Times r1 r2) = (nullable r1 \<and> nullable r2)" |
"nullable (Star r) = True"

lemma nullable_iff [code_abbrev]: "nullable r \<longleftrightarrow> [] \<in> lang r"
  by (induct r) (auto simp add: conc_def split: if_splits)

primrec rexp_empty where
  "rexp_empty Zero \<longleftrightarrow> True"
| "rexp_empty One \<longleftrightarrow> False"
| "rexp_empty (Atom a) \<longleftrightarrow> False"
| "rexp_empty (Plus r s) \<longleftrightarrow> rexp_empty r \<and> rexp_empty s"
| "rexp_empty (Times r s) \<longleftrightarrow> rexp_empty r \<or> rexp_empty s"
| "rexp_empty (Star r) \<longleftrightarrow> False"

(* TODO Fixme: This code_abbrev rule does not work. Why? *)
lemma rexp_empty_iff [code_abbrev]: "rexp_empty r \<longleftrightarrow> lang r = {}"
  by (induction r) auto

text\<open>Composition on rhs usually complicates matters:\<close>
lemma map_map_rexp:
  "map_rexp f (map_rexp g r) = map_rexp (\<lambda>r. f (g r)) r"
  unfolding rexp.map_comp o_def ..

lemma map_rexp_ident[simp]: "map_rexp (\<lambda>x. x) = (\<lambda>r. r)"
  unfolding id_def[symmetric] fun_eq_iff rexp.map_id id_apply by (intro allI refl)

lemma atoms_lang: "w : lang r \<Longrightarrow> set w \<subseteq> atoms r"
proof(induction r arbitrary: w)
  case Times thus ?case by fastforce
next
  case Star thus ?case by (fastforce simp add: star_conv_concat)
qed auto

lemma lang_eq_ext: "(lang r = lang s) =
  (\<forall>w \<in> lists(atoms r \<union> atoms s). w \<in> lang r \<longleftrightarrow> w \<in> lang s)"
  by (auto simp: atoms_lang[unfolded subset_iff])

subsection \<open>Term ordering\<close>

instantiation rexp :: (order) "{order}"
begin

fun le_rexp :: "('a::order) rexp \<Rightarrow> ('a::order) rexp \<Rightarrow> bool"
where
  "le_rexp Zero _ = True"
| "le_rexp _ Zero = False"
| "le_rexp One _ = True"
| "le_rexp _ One = False"
| "le_rexp (Atom a) (Atom b) = (a <= b)"
| "le_rexp (Atom _) _ = True"
| "le_rexp _ (Atom _) = False"
| "le_rexp (Star r) (Star s) = le_rexp r s"
| "le_rexp (Star _) _ = True"
| "le_rexp _ (Star _) = False"
| "le_rexp (Plus r r') (Plus s s') =
    (if r = s then le_rexp r' s' else le_rexp r s)"
| "le_rexp (Plus _ _) _ = True"
| "le_rexp _ (Plus _ _) = False"
| "le_rexp (Times r r') (Times s s') =
    (if r = s then le_rexp r' s' else le_rexp r s)"

(* The class instance stuff is by Dmitriy Traytel *)

definition less_eq_rexp where "r \<le> s \<equiv> le_rexp r s"
definition less_rexp where "r < s \<equiv> le_rexp r s \<and> r \<noteq> s"

lemma le_rexp_Zero: "le_rexp r Zero \<Longrightarrow> r = Zero"
by (induction r) auto

lemma le_rexp_refl: "le_rexp r r"
by (induction r) auto

lemma le_rexp_antisym: "\<lbrakk>le_rexp r s; le_rexp s r\<rbrakk> \<Longrightarrow> r = s"
by (induction r s rule: le_rexp.induct) (auto dest: le_rexp_Zero)

lemma le_rexp_trans: "\<lbrakk>le_rexp r s; le_rexp s t\<rbrakk> \<Longrightarrow> le_rexp r t"
proof (induction r s arbitrary: t rule: le_rexp.induct)
  fix v t assume "le_rexp (Atom v) t" thus "le_rexp One t" by (cases t) auto
next
  fix s1 s2 t assume "le_rexp (Plus s1 s2) t" thus "le_rexp One t" by (cases t) auto
next
  fix s1 s2 t assume "le_rexp (Times s1 s2) t" thus "le_rexp One t" by (cases t) auto
next
  fix s t assume "le_rexp (Star s) t" thus "le_rexp One t" by (cases t) auto
next
  fix v u t assume "le_rexp (Atom v) (Atom u)" "le_rexp (Atom u) t"
  thus "le_rexp (Atom v) t" by (cases t) auto
next
  fix v s1 s2 t assume "le_rexp (Plus s1 s2) t" thus "le_rexp (Atom v) t" by (cases t) auto
next
  fix v s1 s2 t assume "le_rexp (Times s1 s2) t" thus "le_rexp (Atom v) t" by (cases t) auto
next
  fix v s t assume "le_rexp (Star s) t" thus "le_rexp (Atom v) t" by (cases t) auto
next
  fix r s t
  assume IH: "\<And>t. le_rexp r s \<Longrightarrow> le_rexp s t \<Longrightarrow> le_rexp r t"
    and "le_rexp (Star r) (Star s)" "le_rexp (Star s) t"
  thus "le_rexp (Star r) t" by (cases t) auto
next
  fix r s1 s2 t assume "le_rexp (Plus s1 s2) t" thus "le_rexp (Star r) t" by (cases t) auto
next
  fix r s1 s2 t assume "le_rexp (Times s1 s2) t" thus "le_rexp (Star r) t" by (cases t) auto
next
  fix r1 r2 s1 s2 t
  assume "\<And>t. r1 = s1 \<Longrightarrow> le_rexp r2 s2 \<Longrightarrow> le_rexp s2 t \<Longrightarrow> le_rexp r2 t"
         "\<And>t. r1 \<noteq> s1 \<Longrightarrow> le_rexp r1 s1 \<Longrightarrow> le_rexp s1 t \<Longrightarrow> le_rexp r1 t"
         "le_rexp (Plus r1 r2) (Plus s1 s2)" "le_rexp (Plus s1 s2) t"
  thus "le_rexp (Plus r1 r2) t" by (cases t) (auto split: if_split_asm intro: le_rexp_antisym)
next
  fix r1 r2 s1 s2 t assume "le_rexp (Times s1 s2) t" thus "le_rexp (Plus r1 r2) t" by (cases t) auto
next
  fix r1 r2 s1 s2 t
  assume "\<And>t. r1 = s1 \<Longrightarrow> le_rexp r2 s2 \<Longrightarrow> le_rexp s2 t \<Longrightarrow> le_rexp r2 t"
         "\<And>t. r1 \<noteq> s1 \<Longrightarrow> le_rexp r1 s1 \<Longrightarrow> le_rexp s1 t \<Longrightarrow> le_rexp r1 t"
         "le_rexp (Times r1 r2) (Times s1 s2)" "le_rexp (Times s1 s2) t"
  thus "le_rexp (Times r1 r2) t" by (cases t) (auto split: if_split_asm intro: le_rexp_antisym)
qed auto

instance proof
qed (auto simp add: less_eq_rexp_def less_rexp_def
       intro: le_rexp_refl le_rexp_antisym le_rexp_trans)

end

instantiation rexp :: (linorder) "{linorder}"
begin

lemma le_rexp_total: "le_rexp (r :: 'a :: linorder rexp) s \<or> le_rexp s r"
by (induction r s rule: le_rexp.induct) auto

instance proof
qed (unfold less_eq_rexp_def less_rexp_def, rule le_rexp_total)

end

end


(*<*)
theory Trace
  imports "HOL-Library.Stream"
begin
(*>*)

section \<open>Traces and trace prefixes\<close>

subsection \<open>Infinite traces\<close>

coinductive ssorted :: "'a :: linorder stream \<Rightarrow> bool" where
  "shd s \<le> shd (stl s) \<Longrightarrow> ssorted (stl s) \<Longrightarrow> ssorted s"

lemma ssorted_siterate[simp]: "(\<And>n. n \<le> f n) \<Longrightarrow> ssorted (siterate f n)"
  by (coinduction arbitrary: n) auto

lemma ssortedD: "ssorted s \<Longrightarrow> s !! i \<le> stl s !! i"
  by (induct i arbitrary: s) (auto elim: ssorted.cases)

lemma ssorted_sdrop: "ssorted s \<Longrightarrow> ssorted (sdrop i s)"
  by (coinduction arbitrary: i s) (auto elim: ssorted.cases ssortedD)

lemma ssorted_monoD: "ssorted s \<Longrightarrow> i \<le> j \<Longrightarrow> s !! i \<le> s !! j"
proof (induct "j - i" arbitrary: j)
  case (Suc x)
  from Suc(1)[of "j - 1"] Suc(2-4) ssortedD[of s "j - 1"]
    show ?case by (cases j) (auto simp: le_Suc_eq Suc_diff_le)
qed simp

lemma sorted_stake: "ssorted s \<Longrightarrow> sorted (stake i s)"
  by (induct i arbitrary: s)
    (auto elim: ssorted.cases simp: in_set_conv_nth
      intro!: ssorted_monoD[of _ 0, simplified, THEN order_trans, OF _ ssortedD])

lemma ssorted_monoI: "\<forall>i j. i \<le> j \<longrightarrow> s !! i \<le> s !! j \<Longrightarrow> ssorted s"
  by (coinduction arbitrary: s)
    (auto dest: spec2[of _ "Suc _" "Suc _"] spec2[of _ 0 "Suc 0"])

lemma ssorted_iff_mono: "ssorted s \<longleftrightarrow> (\<forall>i j. i \<le> j \<longrightarrow> s !! i \<le> s !! j)"
  using ssorted_monoI ssorted_monoD by metis

definition "sincreasing s = (\<forall>i. \<exists>j>i. s !! i < s !! j)"

lemma sincreasing_siterate[simp]:
  assumes "(\<And>n. n < f n)"
  shows "sincreasing (siterate f n)"
unfolding sincreasing_def proof
  fix i
  show "\<exists>j>i. siterate f n !! i < siterate f n !! j" (is "\<exists>j. ?P n i j")
  proof (induct i arbitrary: n)
    case (Suc i)
    from Suc[of "f n"] obtain j where "?P (f n) i j" by blast
    then show ?case
      by (intro exI[of _ "Suc j"]) auto
  qed (auto intro!: exI[of _ "Suc 0"] assms)
qed

typedef 'a trace = "{s :: ('a set \<times> nat) stream. ssorted (smap snd s) \<and> sincreasing (smap snd s)}"
  by (intro exI[of _ "smap (\<lambda>i. ({}, i)) nats"])
    (auto simp: stream.map_comp stream.map_ident cong: stream.map_cong)

setup_lifting type_definition_trace

lift_definition \<Gamma> :: "'a trace \<Rightarrow> nat \<Rightarrow> 'a set" is
  "\<lambda>s i. fst (s !! i)" .
lift_definition \<tau> :: "'a trace \<Rightarrow> nat \<Rightarrow> nat" is
  "\<lambda>s i. snd (s !! i)" .

lemma \<tau>_mono[simp]: "i \<le> j \<Longrightarrow> \<tau> s i \<le> \<tau> s j"
  by transfer (auto simp: ssorted_iff_mono)

lemma ex_le_\<tau>: "\<exists>j\<ge>i. x \<le> \<tau> s j"
proof (transfer fixing: i x)
  fix s :: "('a set \<times> nat) stream"
  presume sincreasing: "sincreasing (smap snd s)"
  show "\<exists>j\<ge>i. x \<le> snd (s !! j)" proof (induction x)
    case 0
    show ?case by auto
  next
    case (Suc x)
    then show ?case
      using sincreasing unfolding sincreasing_def
      by (metis Suc_le_eq le_less_trans less_imp_le_nat snth_smap)
  qed
qed simp

lemma le_\<tau>_less: "\<tau> \<sigma> i \<le> \<tau> \<sigma> j \<Longrightarrow> j < i \<Longrightarrow> \<tau> \<sigma> i = \<tau> \<sigma> j"
  by (simp add: antisym)

lemma less_\<tau>D: "\<tau> \<sigma> i < \<tau> \<sigma> j \<Longrightarrow> i < j"
  by (meson \<tau>_mono less_le_not_le not_le_imp_less)

abbreviation "\<Delta> s i \<equiv> \<tau> s i - \<tau> s (i - 1)"

lift_definition map_\<Gamma> :: "('a set \<Rightarrow> 'b set) \<Rightarrow> 'a trace \<Rightarrow> 'b trace" is
  "\<lambda>f s. smap (\<lambda>(x, i). (f x, i)) s"
  by (auto simp: stream.map_comp prod.case_eq_if cong: stream.map_cong)

lemma \<Gamma>_map_\<Gamma>[simp]: "\<Gamma> (map_\<Gamma> f s) i = f (\<Gamma> s i)"
  by transfer (simp add: prod.case_eq_if)

lemma \<tau>_map_\<Gamma>[simp]: "\<tau> (map_\<Gamma> f s) i = \<tau> s i"
  by transfer (simp add: prod.case_eq_if)

lemma map_\<Gamma>_id[simp]: "map_\<Gamma> id s = s"
  by transfer (simp add: stream.map_id)

lemma map_\<Gamma>_comp: "map_\<Gamma> g (map_\<Gamma> f s) = map_\<Gamma> (g \<circ> f) s"
  by transfer (simp add: stream.map_comp comp_def prod.case_eq_if case_prod_beta')

lemma map_\<Gamma>_cong: "\<sigma>\<^sub>1 = \<sigma>\<^sub>2 \<Longrightarrow> (\<And>x. f\<^sub>1 x = f\<^sub>2 x) \<Longrightarrow> map_\<Gamma> f\<^sub>1 \<sigma>\<^sub>1 = map_\<Gamma> f\<^sub>2 \<sigma>\<^sub>2"
  by transfer (auto intro!: stream.map_cong)

subsection \<open>Finite trace prefixes\<close>

typedef 'a prefix = "{p :: ('a set \<times> nat) list. sorted (map snd p)}"
  by (auto intro!: exI[of _ "[]"])

setup_lifting type_definition_prefix

lift_definition last_ts :: "'a prefix \<Rightarrow> nat" is
  "\<lambda>p. (case p of [] \<Rightarrow> 0 | _ \<Rightarrow> snd (last p))" .

lift_definition first_ts :: "nat \<Rightarrow> 'a prefix \<Rightarrow> nat" is
  "\<lambda>n p. (case p of [] \<Rightarrow> n | _ \<Rightarrow> snd (hd p))" .

lift_definition pnil :: "'a prefix" is "[]" by simp

lift_definition plen :: "'a prefix \<Rightarrow> nat" is "length" .

lift_definition psnoc :: "'a prefix \<Rightarrow> 'a set \<times> nat \<Rightarrow> 'a prefix" is
  "\<lambda>p x. if (case p of [] \<Rightarrow> 0 | _ \<Rightarrow> snd (last p)) \<le> snd x then p @ [x] else []"
proof (goal_cases sorted_psnoc)
  case (sorted_psnoc p x)
  then show ?case
    by (induction p) (auto split: if_splits list.splits)
qed

instantiation prefix :: (type) order begin

lift_definition less_eq_prefix :: "'a prefix \<Rightarrow> 'a prefix \<Rightarrow> bool" is
  "\<lambda>p q. \<exists>r. q = p @ r" .

definition less_prefix :: "'a prefix \<Rightarrow> 'a prefix \<Rightarrow> bool" where
  "less_prefix x y = (x \<le> y \<and> \<not> y \<le> x)"

instance
proof (standard, goal_cases less refl trans antisym)
  case (less x y)
  then show ?case unfolding less_prefix_def ..
next
  case (refl x)
  then show ?case by transfer auto
next
  case (trans x y z)
  then show ?case by transfer auto
next
  case (antisym x y)
  then show ?case by transfer auto
qed

end

lemma psnoc_inject[simp]:
  "last_ts p \<le> snd x \<Longrightarrow> last_ts q \<le> snd y \<Longrightarrow> psnoc p x = psnoc q y \<longleftrightarrow> (p = q \<and> x = y)"
  by transfer auto

lift_definition prefix_of :: "'a prefix \<Rightarrow> 'a trace \<Rightarrow> bool" is "\<lambda>p s. stake (length p) s = p" .

lemma prefix_of_pnil[simp]: "prefix_of pnil \<sigma>"
  by transfer auto

lemma plen_pnil[simp]: "plen pnil = 0"
  by transfer auto

lemma plen_mono: "\<pi> \<le> \<pi>' \<Longrightarrow> plen \<pi> \<le> plen \<pi>'"
  by transfer auto

lemma prefix_of_psnocE: "prefix_of (psnoc p x) s \<Longrightarrow> last_ts p \<le> snd x \<Longrightarrow>
  (prefix_of p s \<Longrightarrow> \<Gamma> s (plen p) = fst x \<Longrightarrow> \<tau> s (plen p) = snd x \<Longrightarrow> P) \<Longrightarrow> P"
  by transfer (simp del: stake.simps add: stake_Suc)

lemma le_pnil[simp]: "pnil \<le> \<pi>"
  by transfer auto

lift_definition take_prefix :: "nat \<Rightarrow> 'a trace \<Rightarrow> 'a prefix" is stake
  by (auto dest: sorted_stake)

lemma plen_psnoc[simp]: "last_ts \<pi> \<le> snd x \<Longrightarrow> plen (psnoc \<pi> x) = plen \<pi> + 1"
  by transfer auto

lemma prefix_of_take_prefix[simp]: "prefix_of (take_prefix i \<sigma>) \<sigma>"
  by transfer auto

lift_definition pdrop :: "nat \<Rightarrow> 'a prefix \<Rightarrow> 'a prefix" is drop
  by (auto simp: drop_map[symmetric] sorted_drop)

lemma pdrop_0[simp]: "pdrop 0 \<pi> = \<pi>"
  by transfer auto

lemma prefix_of_antimono: "\<pi> \<le> \<pi>' \<Longrightarrow> prefix_of \<pi>' s \<Longrightarrow> prefix_of \<pi> s"
  by transfer (auto simp del: stake_add simp add: stake_add[symmetric])

lemma ex_prefix_of: "\<exists>s. prefix_of p s"
proof (transfer, intro bexI CollectI conjI)
  fix p :: "('a set \<times> nat) list"
  assume *: "sorted (map snd p)"
  let ?\<sigma> = "p @- smap (Pair undefined) (fromN (snd (last p)))"
  show "stake (length p) ?\<sigma> = p" by (simp add: stake_shift)
  have le_last: "snd (p ! i) \<le> snd (last p)" if "i < length p" for i
    using sorted_nth_mono[OF *, of i "length p - 1"] that
    by (cases p) (auto simp: last_conv_nth nth_Cons')
  with * show "ssorted (smap snd ?\<sigma>)"
    by (force simp: ssorted_iff_mono sorted_iff_nth_mono shift_snth)
  show "sincreasing (smap snd ?\<sigma>)" unfolding sincreasing_def
  proof (rule allI)
    fix i
    show "\<exists>j > i.  smap snd ?\<sigma> !! i < smap snd ?\<sigma> !! j"
    proof (cases "i < length p")
      case True
      with le_last[of i] show ?thesis
        by (auto intro!: exI[of _ "Suc (length p)"])
    next
      case False
      then show ?thesis
        by (auto simp: neq_Nil_conv intro!: exI[of _ "Suc i"])
    qed
  qed
qed

lemma \<tau>_prefix_conv: "prefix_of p s \<Longrightarrow> prefix_of p s' \<Longrightarrow> i < plen p \<Longrightarrow> \<tau> s i = \<tau> s' i"
  by transfer (simp add: stake_nth[symmetric])

lemma \<Gamma>_prefix_conv: "prefix_of p s \<Longrightarrow> prefix_of p s' \<Longrightarrow> i < plen p \<Longrightarrow> \<Gamma> s i = \<Gamma> s' i"
  by transfer (simp add: stake_nth[symmetric])

lemma sincreasing_sdrop:
  assumes "sincreasing s"
  shows "sincreasing (sdrop n s)"
proof (unfold sincreasing_def; safe)
  fix i
  from assms obtain j where "n + i < j" "s !! (n + i) < s !! j"
    unfolding sincreasing_def by auto
  then show "\<exists>j>i. sdrop n s !! i < sdrop n s !! j"
    by (auto simp: sdrop_snth intro!: exI[of _ "j - n"])
qed

lemma ssorted_shift:
  "ssorted (xs @- s) = (sorted xs \<and> ssorted s \<and> (\<forall>x\<in>set xs. \<forall>y\<in>sset s. x \<le> y))"
proof safe
  assume *: "ssorted (xs @- s)"
  then show "sorted xs"
    by (auto simp: ssorted_iff_mono shift_snth sorted_iff_nth_mono split: if_splits)
  from ssorted_sdrop[OF *, of "length xs"] show "ssorted s"
    by (auto simp: sdrop_shift)
  fix x y assume "x \<in> set xs" "y \<in> sset s"
  then obtain i j where "i < length xs" "xs ! i = x" "s !! j = y"
    by (auto simp: set_conv_nth sset_range)
  with ssorted_monoD[OF *, of i "j + length xs"] show "x \<le> y" by auto
next
  assume "sorted xs" "ssorted s" "\<forall>x\<in>set xs. \<forall>y\<in>sset s. x \<le> y"
  then show "ssorted (xs @- s)"
  proof (coinduction arbitrary: xs s)
    case (ssorted xs s)
    with \<open>ssorted s\<close> show ?case
      by (subst (asm) ssorted.simps) (auto 0 4 simp: neq_Nil_conv shd_sset intro: exI[of _ "_ # _"])
  qed
qed

lemma sincreasing_shift:
  assumes "ssorted (xs @- s)" "sincreasing s"
  shows "sincreasing (xs @- s)"
proof (unfold sincreasing_def; safe)
  fix i
  show "\<exists>j>i. (xs @- s) !! i < (xs @- s) !! j"
  proof (cases "i < length xs")
    case True
    with assms(1) have "xs ! i \<le> shd s" unfolding ssorted_shift by (auto simp: shd_sset)
    also obtain j where "\<dots> < s !! j"
      using assms(2) by (auto simp: sincreasing_def dest: spec[of _ 0])
    finally show ?thesis using True by (auto intro!: exI[of _ "j + length xs"])
  next
    case False
    then obtain j where "i - length xs < j" "s !! (i - length xs) < s !! j"
      using assms(2) by (auto simp: sincreasing_def)
    then show ?thesis using False by (auto simp: not_less intro!: exI[of _ "j + length xs"])
  qed
qed

lift_definition replace_prefix :: "'a prefix \<Rightarrow> 'a trace \<Rightarrow> 'a trace" is
   "\<lambda>\<pi> \<sigma>. if ssorted (smap snd (\<pi> @- sdrop (length \<pi>) \<sigma>)) then
     \<pi> @- sdrop (length \<pi>) \<sigma> else smap (\<lambda>i. ({}, i)) nats"
  by (auto split: if_splits simp: stream.map_comp stream.map_ident sdrop_smap[symmetric]
    simp del: sdrop_smap intro!: sincreasing_shift sincreasing_sdrop cong: stream.map_cong)

(*<*)
end
(*>*)


(*  Title:      HOL/Quickcheck_Examples/Quickcheck_Lattice_Examples.thy
    Author:     Lukas Bulwahn
    Copyright   2010 TU Muenchen
*)

theory Quickcheck_Lattice_Examples
imports Main
begin

declare [[quickcheck_finite_type_size=5]]

text {* We show how other default types help to find counterexamples to propositions if
  the standard default type @{typ int} is insufficient. *}

notation
  less_eq  (infix "\<sqsubseteq>" 50) and
  less  (infix "\<sqsubset>" 50) and
  top ("\<top>") and
  bot ("\<bottom>") and
  inf (infixl "\<sqinter>" 70) and
  sup (infixl "\<squnion>" 65)

declare [[quickcheck_narrowing_active = false, quickcheck_timeout = 3600]]

subsection {* Distributive lattices *}

lemma sup_inf_distrib2:
 "((y :: 'a :: distrib_lattice) \<sqinter> z) \<squnion> x = (y \<squnion> x) \<sqinter> (z \<squnion> x)"
  quickcheck[expect = no_counterexample]
by(simp add: inf_sup_aci sup_inf_distrib1)

lemma sup_inf_distrib2_1:
 "((y :: 'a :: lattice) \<sqinter> z) \<squnion> x = (y \<squnion> x) \<sqinter> (z \<squnion> x)"
  quickcheck[expect = counterexample]
  oops

lemma sup_inf_distrib2_2:
 "((y :: 'a :: distrib_lattice) \<sqinter> z') \<squnion> x = (y \<squnion> x) \<sqinter> (z \<squnion> x)"
  quickcheck[expect = counterexample]
  oops

lemma inf_sup_distrib1_1:
 "(x :: 'a :: distrib_lattice) \<sqinter> (y \<squnion> z) = (x \<sqinter> y) \<squnion> (x' \<sqinter> z)"
  quickcheck[expect = counterexample]
  oops

lemma inf_sup_distrib2_1:
 "((y :: 'a :: distrib_lattice) \<squnion> z) \<sqinter> x = (y \<sqinter> x) \<squnion> (y \<sqinter> x)"
  quickcheck[expect = counterexample]
  oops

subsection {* Bounded lattices *}

lemma inf_bot_left [simp]:
  "\<bottom> \<sqinter> (x :: 'a :: bounded_lattice_bot) = \<bottom>"
  quickcheck[expect = no_counterexample]
  by (rule inf_absorb1) simp

lemma inf_bot_left_1:
  "\<bottom> \<sqinter> (x :: 'a :: bounded_lattice_bot) = x"
  quickcheck[expect = counterexample]
  oops

lemma inf_bot_left_2:
  "y \<sqinter> (x :: 'a :: bounded_lattice_bot) = \<bottom>"
  quickcheck[expect = counterexample]
  oops

lemma inf_bot_left_3:
  "x \<noteq> \<bottom> ==> y \<sqinter> (x :: 'a :: bounded_lattice_bot) \<noteq> \<bottom>"
  quickcheck[expect = counterexample]
  oops

lemma inf_bot_right [simp]:
  "(x :: 'a :: bounded_lattice_bot) \<sqinter> \<bottom> = \<bottom>"
  quickcheck[expect = no_counterexample]
  by (rule inf_absorb2) simp

lemma inf_bot_right_1:
  "x \<noteq> \<bottom> ==> (x :: 'a :: bounded_lattice_bot) \<sqinter> \<bottom> = y"
  quickcheck[expect = counterexample]
  oops

lemma inf_bot_right_2:
  "(x :: 'a :: bounded_lattice_bot) \<sqinter> \<bottom> ~= \<bottom>"
  quickcheck[expect = counterexample]
  oops

lemma sup_bot_right [simp]:
  "(x :: 'a :: bounded_lattice_bot) \<squnion> \<bottom> = \<bottom>"
  quickcheck[expect = counterexample]
  oops

lemma sup_bot_left [simp]:
  "\<bottom> \<squnion> (x :: 'a :: bounded_lattice_bot) = x"
  quickcheck[expect = no_counterexample]
  by (rule sup_absorb2) simp

lemma sup_bot_right_2 [simp]:
  "(x :: 'a :: bounded_lattice_bot) \<squnion> \<bottom> = x"
  quickcheck[expect = no_counterexample]
  by (rule sup_absorb1) simp

lemma sup_eq_bot_iff [simp]:
  "(x :: 'a :: bounded_lattice_bot) \<squnion> y = \<bottom> \<longleftrightarrow> x = \<bottom> \<and> y = \<bottom>"
  quickcheck[expect = no_counterexample]
  by (simp add: eq_iff)

lemma sup_top_left [simp]:
  "\<top> \<squnion> (x :: 'a :: bounded_lattice_top) = \<top>"
  quickcheck[expect = no_counterexample]
  by (rule sup_absorb1) simp

lemma sup_top_right [simp]:
  "(x :: 'a :: bounded_lattice_top) \<squnion> \<top> = \<top>"
  quickcheck[expect = no_counterexample]
  by (rule sup_absorb2) simp

lemma inf_top_left [simp]:
  "\<top> \<sqinter> x = (x :: 'a :: bounded_lattice_top)"
  quickcheck[expect = no_counterexample]
  by (rule inf_absorb2) simp

lemma inf_top_right [simp]:
  "x \<sqinter> \<top> = (x :: 'a :: bounded_lattice_top)"
  quickcheck[expect = no_counterexample]
  by (rule inf_absorb1) simp

lemma inf_eq_top_iff [simp]:
  "(x :: 'a :: bounded_lattice_top) \<sqinter> y = \<top> \<longleftrightarrow> x = \<top> \<and> y = \<top>"
  quickcheck[expect = no_counterexample]
  by (simp add: eq_iff)

no_notation
  less_eq  (infix "\<sqsubseteq>" 50) and
  less (infix "\<sqsubset>" 50) and
  inf  (infixl "\<sqinter>" 70) and
  sup  (infixl "\<squnion>" 65) and
  top ("\<top>") and
  bot ("\<bottom>")

end


header{* The subgraph threshold theorem *}

theory Subgraph_Threshold
imports
  Ugraph_Properties
begin

lemma (in edge_space) measurable_pred[measurable]: "Measurable.pred P Q"
  by (simp add: P_def sets_point_measure space_point_measure subset_eq)

text{* This section contains the main theorem. For a fixed nonempty graph $H$, we consider the graph
property of `containing an isomorphic subgraph of $H$'. This is obviously a valid property, since
it is closed under isomorphism.

The corresponding threshold function is

  \[ t(n) = n^{-\frac{1}{\rho'(H)}}, \]

where $\rho'$ denotes @{term max_density}. *}

definition subgraph_threshold :: "ugraph \<Rightarrow> nat \<Rightarrow> real" where
"subgraph_threshold H n = n powr (-(1 / max_density H))"

theorem
  assumes nonempty: "nonempty_graph H" and finite: "finite_graph H" and wellformed: "uwellformed H"
  shows "is_threshold {G. H \<sqsubseteq> G} (subgraph_threshold H)"
proof
  show "ugraph_property {G. H \<sqsubseteq> G}"
    unfolding ugraph_property_def using subgraph_isomorphic_closed by blast
next

  --{* To prove the 0-statement, we introduce the subgraph with the maximum density as $H_0$. Note
       that $\rho(H_0) = \rho'(H)$. *}

  fix p :: "nat \<Rightarrow> real"

  obtain H\<^sub>0 where H\<^sub>0: "density H\<^sub>0 = max_density H" "subgraph H\<^sub>0 H" "nonempty_graph H\<^sub>0" "finite_graph H\<^sub>0" "uwellformed H\<^sub>0"
    using subgraph_has_max_density assms by blast
  hence card: "0 < card (uverts H\<^sub>0)" "0 < card (uedges H\<^sub>0)"
    unfolding nonempty_graph_def finite_graph_def by auto

  let ?v = "card (uverts H\<^sub>0)"
  let ?e = "card (uedges H\<^sub>0)"

  assume p_nz: "nonzero_prob_fun p"
  hence p: "valid_prob_fun p"
    by (fact nonzero_fun_is_valid_fun)

  --{* Firstly, we follow from the assumption that @{term p} is asympotically less than the
       threshold function that the product
       \[ p(n)^{|E(H_0)|} \cdot n^{|V(H_0)|} \]
       tends to $0$. *}

  assume "p \<lless> subgraph_threshold H"
  moreover
  {
    fix n
    have "p n / n powr (-(1 / max_density H)) = p n * n powr (1 / max_density H)"
      by (simp add: powr_minus_divide)
    also have "\<dots> = p n * n powr (1 / density H\<^sub>0)"
      using H\<^sub>0 by simp
    also have "\<dots> = p n * n powr (?v / ?e)"
      using card unfolding density_def by simp
    finally have "p n / n powr (-(1 / max_density H)) = \<dots>"
      .
  }
  ultimately have "(\<lambda>n. p n * n powr (?v / ?e)) ----> 0"
    unfolding subgraph_threshold_def by simp
  moreover have "\<And>n. 1 \<le> n \<Longrightarrow> 0 < p n * n powr (?v / ?e)"
    by (auto simp: p_nz)
  ultimately have "(\<lambda>n. (p n * n powr (?v / ?e)) powr ?e) ----> 0"
    using card(2) by (force intro: tendsto_zero_powrI[OF eventually_sequentiallyI])
  hence limit: "(\<lambda>n. p n powr ?e * n powr ?v) ----> 0"
    by (rule LIMSEQ_cong[OF _ eventually_sequentiallyI[where c = 1]])
       (auto simp: card p_nz powr_powr powr_mult)

  {
    fix n
    assume n: "?v \<le> n"

    interpret ES: edge_space n "(p n)"
      by unfold_locales (auto simp: p)

    let ?graph_of = "ES.edge_ugraph"

    --{* After fixing an @{term n}, we define a family of random variables $X$ indexed by a set of
         vertices $v$ and a set of edges $e$. Each $X$ is an indicator for the event that $(v, e)$
         is isomorphic to $H_0$ and a subgraph of a random graph. The sum of all these variables
         is denoted by $Y$ and counts the total number of copies of $H_0$ in a random graph. *}

    let ?X = "\<lambda>H\<^sub>0'. rind {es \<in> space ES.P. subgraph H\<^sub>0' (?graph_of es) \<and> H\<^sub>0 \<simeq> H\<^sub>0'}"
    let ?I = "{(v, e). v \<subseteq> {1..n} \<and> card v = ?v \<and> e \<subseteq> all_edges v \<and> card e = ?e}"
    let ?Y = "\<lambda>es. \<Sum>H\<^sub>0' \<in> ?I. ?X H\<^sub>0' es"

    --{* Now we prove an upper bound for the probability that a random graph contains a copy of
         @{term H}. Observe that in that case, $Y$ takes a value greater or equal than $1$. *}

    have "prob_in_class p {G. H \<sqsubseteq> G} n = probGn p n (\<lambda>es. H \<sqsubseteq> ?graph_of es)"
      by simp
    also have "\<dots> \<le> probGn p n (\<lambda>es. 1 \<le> ?Y es)"
      proof (rule ES.finite_measure_mono, safe)
        fix es
        assume es: "es \<in> space (MGn p n)"

        assume "H \<sqsubseteq> ?graph_of es"
        hence "H\<^sub>0 \<sqsubseteq> ?graph_of es" --{* since @{term H\<^sub>0} is a subgraph of @{term H} *}
          using H\<^sub>0 by (fast intro: subgraph_isomorphic_pre_subgraph_closed)
        then obtain H\<^sub>0' where H\<^sub>0': "subgraph H\<^sub>0' (?graph_of es)" "H\<^sub>0 \<simeq> H\<^sub>0'"
          unfolding subgraph_isomorphic_def
          by blast

        show "1 \<le> ?Y es"
          proof (rule setsum_lower_or_eq)
            --{* The only relevant step here is to provide the specific instance of $(v, e)$ such
                 that $X_{(v, e)}$ takes a value greater or equal than $1$. This is trivial, as we
                 already obtained that one above (i.e. @{term H\<^sub>0'}). The remainder of the proof is
                 just bookkeeping.*}
            show "1 \<le> ?X H\<^sub>0' es" --{* by definition of $X$ *}
              using H\<^sub>0' es by simp
          next
            have "uverts H\<^sub>0' \<subseteq> {1..n}" "uedges H\<^sub>0' \<subseteq> es"
              using H\<^sub>0'(1) unfolding subgraph_def ES.edge_ugraph_def ES.S_verts_def ES.S_edges_def by simp+
            moreover have "card (uverts H\<^sub>0') = ?v" "card (uedges H\<^sub>0') = ?e"
              by (simp add: isomorphic_cards[OF `H\<^sub>0 \<simeq> H\<^sub>0'`])+
            moreover have "uedges H\<^sub>0' \<subseteq> all_edges (uverts H\<^sub>0')"
              using H\<^sub>0' by (simp add: wellformed_all_edges)
            ultimately show "H\<^sub>0' \<in> ?I"
              by auto
          next
            have "?I \<subseteq> subgraphs (complete {1..n})"
              unfolding complete_def subgraphs_def subgraph_def using all_edges_mono by auto blast
            moreover have "finite (subgraphs (complete {1..n}))"
              by (simp add: complete_finite subgraphs_finite)
            ultimately show "finite ?I"
              by (fact finite_subset)
        qed simp
      qed simp

    --{* Applying Markov's inequality leaves us with estimating the expectation of $Y$, which is
         the sum of the individual $X$. *}
    also have "\<dots> \<le> ES.expectation ?Y / 1"
      by (rule prob_space.markov_inequality) (auto simp: ES.prob_space_P setsum_nonneg)
    also have "\<dots> = ES.expectation ?Y"
      by simp
    also have "\<dots> = (\<Sum>H\<^sub>0' \<in> ?I. ES.expectation (?X H\<^sub>0'))"
      by (rule integral_setsum(1)) simp

    --{* Each expectation is bound by $p(n)^{|E(H_0)|}$. For the proof, we ignore the fact that the
         corresponding graph has to be isomorphic to @{term H\<^sub>0}, which only increases the
         probability and thus the expectation. This only leaves us to compute the probability that
         all edges are present, which is given by @{thm [source] edge_space.cylinder_prob}. *}
    also have "\<dots> \<le> (\<Sum>H\<^sub>0' \<in> ?I. p n ^ ?e)"
      proof (rule setsum_mono)
        fix H\<^sub>0'
        assume H\<^sub>0': "H\<^sub>0' \<in> ?I"
        have "ES.expectation (?X H\<^sub>0') = ES.prob {es \<in> space ES.P. subgraph H\<^sub>0' (?graph_of es) \<and> H\<^sub>0 \<simeq> H\<^sub>0'}"
          by (rule ES.expectation_indicator) (auto simp: ES.sets_eq ES.space_eq)
        also have "\<dots> \<le> ES.prob {es \<in> space ES.P. uedges H\<^sub>0' \<subseteq> es}"
          unfolding subgraph_def by (rule ES.finite_measure_mono) (auto simp: ES.sets_eq ES.space_eq)
        also have "\<dots> = ES.prob (cylinder ES.S_edges (uedges H\<^sub>0') {})"
          unfolding cylinder_def ES.space_eq by simp
        also have "\<dots> = p n ^ card (uedges H\<^sub>0')"
          proof (rule ES.cylinder_empty_prob)
            have "uverts H\<^sub>0' \<subseteq> {1..n}" "uedges H\<^sub>0' \<subseteq> all_edges (uverts H\<^sub>0')"
              using H\<^sub>0' by auto
            hence "uedges H\<^sub>0' \<subseteq> all_edges {1..n}"
              using all_edges_mono by blast
            thus "uedges H\<^sub>0' \<subseteq> ES.S_edges"
              unfolding ES.S_edges_def ES.S_verts_def by simp
          qed
        also have "\<dots> = p n ^ ?e"
          using H\<^sub>0' by fastforce
        finally show "ES.expectation (?X H\<^sub>0') \<le> \<dots>"
          .
      qed

    --{* Since we have a sum of constant summands, we can rewrite it as a product. *}
    also have "\<dots> = card ?I * p n ^ ?e"
      unfolding real_of_nat_def by (rule setsum_constant)

    --{* We have to count the number of possible pairs $(v, e)$. From the definition of the index
         set, note that we first choose $|V(H_0)|$ elements out of a set of @{term n} vertices and
         then $|E(H_0)|$ elements out of all possible edges over these vertices. *}
    also have "\<dots> = ((n choose ?v) * ((?v choose 2) choose ?e)) * p n ^ ?e"
      proof (rule arg_cong[where x = "card ?I"])
        have "card ?I = (\<Sum>v | v \<subseteq> {1..n} \<and> card v = ?v. card (all_edges v) choose ?e)"
          by (rule card_dep_pair_set[where A = "{1..n}" and n = "?v" and f = all_edges])
             (auto simp: finite_subset all_edges_finite)
        also have "\<dots> = (\<Sum>v | v \<subseteq> {1..n} \<and> card v = ?v. (?v choose 2) choose ?e)"
          proof (rule setsum.cong)
            fix v
            assume "v \<in> {v. v \<subseteq> {1..n} \<and> card v = ?v}"
            hence "v \<subseteq> {1..n}" "card v = ?v"
              by auto
            thus "card (all_edges v) choose ?e = (?v choose 2) choose ?e"
              by (simp add: card_all_edges finite_subset)
          qed rule
        also have "\<dots> = card ({v. v \<subseteq> {1..n} \<and> card v = ?v}) * ((?v choose 2) choose ?e)"
          by simp
        also have "\<dots> = (n choose ?v) * ((?v choose 2) choose ?e)"
          by (simp add: n_subsets)
        finally show "card ?I = \<dots>"
          .
      qed
    also have "\<dots> = (n choose ?v) * (((?v choose 2) choose ?e) * p n ^ ?e)"
      by simp

    --{* Here, we use $n^k$ as an upper bound for $\binom n k$. *}
    also have "\<dots> \<le> (n ^ ?v) * (((?v choose 2) choose ?e) * p n ^ ?e)" (is "_ \<le> _ * ?r")
      proof (rule mult_right_mono)
        have "n choose ?v \<le> n ^ ?v"
          by (rule binomial_le_pow) (rule n)
        thus "real (n choose ?v) \<le> real (n ^ ?v)"
          by (metis real_of_nat_le_iff)
      next
        show "0 \<le> ?r" using p by simp
      qed
    also have "\<dots> \<le> ((?v choose 2) choose ?e) * (p n ^ ?e * n ^ ?v)" (is "_ \<le> ?factor * _")
      by simp
    also have "\<dots> = ?factor * (p n powr ?e * n powr ?v)"
      using n card(1) `nonzero_prob_fun p` by (simp add: powr_realpow)

    finally have "prob_in_class p {G. H \<sqsubseteq> G} n \<le> ?factor * (p n powr ?e * n powr ?v)"
      .
  }

  --{* The final upper bound is a multiple of the expression which we have proven to tend to $0$
       in the beginning. *}
  thus "prob_in_class p {G. H \<sqsubseteq> G} ----> 0"
    by (rule LIMSEQ_le_zero[OF tendsto_mult_right_zero[OF limit] eventually_sequentiallyI[OF measure_nonneg] eventually_sequentiallyI])
next
  fix p :: "nat \<Rightarrow> real"
  assume p_threshold: "subgraph_threshold H \<lless> p"

  --{* To prove the 1-statement, we obtain a fixed selector @{term f} as defined in section
       \ref{sec:selector}. *}
  from assms obtain f where f: "is_fixed_selector H f"
    using ex_fixed_selector by blast

  let ?v = "card (uverts H)"
  let ?e = "card (uedges H)"

  --{* We observe that several terms involving $|V(H)|$ are positive. *}
  have v_e_nz: "0 < real ?v" "0 < real ?e"
    using nonempty finite unfolding nonempty_graph_def finite_graph_def by auto
  hence "0 < real ?v ^ ?v" by simp
  hence vpowv_inv_gr_z: "0 < 1 / ?v ^ ?v" by simp

  --{* For a given $n$, let $A$ be a family of events indexed by a set $S$. Each $A$ contains the
       graphs whose induced subgraphs over $S$ contain the selected copy of @{term H} by @{term f}
       over $S$. *}
  let ?A = "\<lambda>n. \<lambda>S. {es \<in> space (edge_space.P n (p n)). subgraph (f S) (induced_subgraph S (edge_space.edge_ugraph n es))}"
  let ?I = "\<lambda>n. {S. S \<subseteq> {1..n} \<and> card S = ?v}"

  assume p_nz: "nonzero_prob_fun p"
  hence p: "valid_prob_fun p"
    by (fact nonzero_fun_is_valid_fun)
  {
    fix n
    --{* At this point, we can assume almost anything about @{term n}: We only have to show that
         a function converges, hence the necessary properties are allowed to be violated for small
         values of @{term n}. *}
    assume n_2v: "2 * ?v \<le> n"
    hence n: "?v \<le> n"
      by simp

    have is_es: "edge_space (p n)"
      by unfold_locales (auto simp: p)

    then interpret edge_space n "p n"
      .

    let ?A = "?A n"
    let ?I = "?I n"

    --{* A nice potpourri with some technical facts about @{text S}. *}
    {
      fix S
      assume "S \<in> ?I"
      hence 0: "S \<subseteq> {1..n}" "?v = card S" "finite S"
        by (auto intro: finite_subset)
      hence 1: "H \<simeq> f S" "uverts (f S) = S"
        using f wellformed_finite unfolding finite_graph_def is_fixed_selector_def by auto
      have 2: "finite_graph (f S)"
        using 0(3) 1(1,2) by (metis wellformed_finite)
      have 3: "nonempty_graph (f S)"
        using 0(2) 1(1,2) by (metis card_eq_0_iff finite finite_graph_def isomorphic_cards(2) nonempty nonempty_graph_def pair_collapse snd_conv)
      note 0 1 2 3
    }
    note I = this

    --{* In the following two blocks, we prove the probabilities of the events $A$ and the
         probability of the intersection of two events $A$. For both cases, we employ the auxiliary
         lemma @{thm [source] edge_space.induced_subgraph_prob} which is not very interesting.
         For the latter however, the tricky part is to argue that such an intersection is equivalent
         to the \emph{union} of the desired copies of @{term H} to be contained in the \emph{union}
         of the induced subgraphs. *}
    {
      fix S
      assume S: "S \<in> ?I"
      note S' = I[OF S]
      have "prob (?A S) = p n ^ ?e"
        using isomorphic_cards(2)[OF S'(4)] S' by (simp add: S_verts_def induced_subgraph_prob)
    }
    note prob_A = this

    {
      fix S T
      assume "S \<in> ?I" note S = I[OF this]
      assume "T \<in> ?I" note T = I[OF this]
      --{* Note that we do not restrict @{term S} and @{term T} to be disjoint, since we need the
           general case later to determine when two events are independent. Additionally, it would
           be unneeded at this point. *}

      have "prob (?A S \<inter> ?A T) = prob {es \<in> space P. subgraph (S \<union> T, uedges (f S) \<union> uedges (f T)) (induced_subgraph (S \<union> T) (edge_ugraph es))}" (is "_ = prob ?M")
        proof (rule arg_cong[where f = prob])
          have "?A S \<inter> ?A T = {es \<in> space P. subgraph (f S) (induced_subgraph S (edge_ugraph es)) \<and> subgraph (f T) (induced_subgraph T (edge_ugraph es))}"
            by blast
          also have "\<dots> = ?M"
            using S T by (auto simp: subgraph_union_induced)
          finally show "?A S \<inter> ?A T = \<dots>"
            .
        qed
      also have "\<dots> = p n ^ card (uedges (S \<union> T, uedges (f S) \<union> uedges (f T)))"
        proof (rule induced_subgraph_prob)
          show "uwellformed (S \<union> T, uedges (f S) \<union> uedges (f T))"
            using S(4,5) T(4,5) unfolding uwellformed_def by auto
        next
          show "S \<union> T \<subseteq> S_verts"
            using S(1) T(1) unfolding S_verts_def by simp
        qed simp
      also have "\<dots> = p n ^ card (uedges (f S) \<union> uedges (f T))"
        by simp

      finally have "prob (?A S \<inter> ?A T) = p n ^ card (uedges (f S) \<union> uedges (f T))"
        .
    }
    note prob_A_intersect = this

    --{* Another technical detail is that our family of events $A$ are a valid instantiation for
         the ``$\Delta$ lemmas'' from section \ref{sec:delta}. *}
    have is_psi: "prob_space_with_indicators P ?I ?A"
      proof
        show "finite ?I"
          by (rule finite_subset[where B = "Pow {1..n}"]) auto
      next
        show "?A ` ?I \<subseteq> sets P"
          unfolding sets_eq space_eq by blast
      next
        let ?V = "{1..?v}"
        have "0 < prob (?A ?V)"
          by (simp add: prob_A n p_nz)
        moreover have "?V \<in> ?I"
          using n by force
        ultimately show "\<exists>i \<in> ?I. 0 < prob (?A i)"
          by blast
      qed

    then interpret prob_space_with_indicators "P" ?I ?A
      .

    --{* We proceed by reducing the claim of the 1-statement that the probability tends to $1$ to
         showing that the expectation that the sum of all indicators of the respective events $A$
         tends to $0$. (The actual reduction is done at the end of the proof, we merely collect
         the facts here.) *}
    have compl_prob: "1 - prob {es \<in> space P. \<not> H \<sqsubseteq> edge_ugraph es} = prob_in_class p {G. H \<sqsubseteq> G} n"
      by (subst prob_compl[symmetric]) (auto simp: space_eq sets_eq intro: arg_cong[where f = prob])

    have "prob {es \<in> space P. \<not> H \<sqsubseteq> edge_ugraph es} \<le> prob {es \<in> space P. Y es = 0}" (is "?compl \<le> _")
      proof (rule finite_measure_mono, safe)
        fix es
        assume "es \<in> space P"
        hence es: "uwellformed (edge_ugraph es)"
          unfolding space_eq by (rule wellformed_and_finite(2))
        assume H: "\<not> H \<sqsubseteq> edge_ugraph es"
        {
          fix S
          assume "S \<subseteq> {1..n}" "card S = ?v"
          moreover hence "finite S" "S \<subseteq> uverts (edge_ugraph es)"
            unfolding uverts_edge_ugraph S_verts_def by (auto intro: finite_subset)
          ultimately have "\<not> subgraph (f S) (induced_subgraph S (edge_ugraph es))"
            using H es by (metis fixed_selector_induced_subgraph[OF f])
          hence "X S es = 0"
            unfolding X_def by simp
        }
        thus "Y es = 0"
          unfolding Y_def by simp
      qed simp

    --{* By applying the $\Delta$ lemma, we obtain our central inequality. The rest of the proof
         gives bounds for @{text \<mu>}, @{text \<Delta>\<^sub>d} and quotients which occur on the right hand side. *}
    hence compl_upper: "?compl \<le> 1 / \<mu> + \<Delta>\<^sub>d / \<mu>^2"
      by (rule order_trans) (fact prob_\<mu>_\<Delta>\<^sub>d)

    --{* Lower bound for the expectation. We use $\left(\frac n k\right)^k$ as lower bound for
         $\binom n k$. *}
    have "1 / ?v ^ ?v * (real n ^ ?v * p n ^ ?e) = (n / ?v) ^ ?v * p n ^ ?e"
      by (simp add: power_divide)
    also have "\<dots> \<le> (n choose ?v) * p n ^ ?e"
      unfolding real_of_nat_def
      proof (rule mult_right_mono, rule binomial_ge_n_over_k_pow_k)
        show "?v \<le> n"
          using n .
        show "0 < ?v"
          using nonempty finite unfolding nonempty_graph_def finite_graph_def by fastforce
        show "0 \<le> p n ^ ?e"
          using p by simp
      qed
    also have "\<dots> = (\<Sum>S \<in> ?I. p n ^ ?e)"
      unfolding real_of_nat_def by (simp add: n_subsets)
    also have "\<dots> = (\<Sum>S \<in> ?I. prob (?A S))"
      by (simp add: prob_A)
    also have "\<dots> = \<mu>"
      unfolding expectation_X_Y X_def using expectation_indicator by force
    finally have ex_lower: "1 / (?v ^ ?v) * (real n ^ ?v * p n ^ ?e) \<le> \<mu>"
      .

    --{* Upper bound for the inverse expectation. Follows trivially from above. *}
    have ex_lower_pos: "0 < 1 / ?v ^ ?v * (real n ^ ?v * p n ^ ?e)"
      proof (rule mult_pos_pos[OF vpowv_inv_gr_z mult_pos_pos])
        have "0 < real n"
          using n nonempty finite unfolding nonempty_graph_def finite_graph_def by auto
        thus "0 < real n ^ ?v"
          by simp
      next
        show "0 < p n ^ card (uedges H)"
          using p_nz by simp
      qed
    hence "1 / \<mu> \<le> 1 / (1 / ?v ^ ?v * (real n ^ ?v * p n ^ ?e))"
      by (rule divide_left_mono[OF ex_lower zero_le_one mult_pos_pos[OF \<mu>_non_zero]])
    hence inv_ex_upper: "1 / \<mu> \<le> ?v ^ ?v * (1 / (real n ^ ?v * p n ^ ?e))"
      by simp

    --{* Recall the definition of @{text "\<Delta>\<^sub>d"}:
         \[ \Delta_d = \sum\limits_{\substack{S \in I,\, T \in I\\S \neq T\\A_S,\, A_T \text{ not independent}}} \Pr[A_S \cap A_T] \]
         We are going to prove an upper bound for that sum, so we can safely augment the index set
         by replacing it with a neccessary condition.

         The idea is that if the two sets $S$ and $T$ are not independent, their intersection is not
         empty. We prove that by contraposition, i.e. if the intersection is empty, then they are
         independent. This in turn can be shown using some basic properties of @{term f}. *}
    {
      fix S T
      assume "S \<in> ?I" "T \<in> ?I"
      hence *: "prob (?A S) * prob (?A T) = p n ^ (2 * ?e)"
        using prob_A by (auto simp: comm_semiring_1_class.normalizing_semiring_rules)

      note S = I[OF `S \<in> ?I`]
      note T = I[OF `T \<in> ?I`]
      assume disj: "S \<inter> T = {}"

      have "prob (?A S \<inter> ?A T) = p n ^ card (uedges (f S) \<union> uedges (f T))"
        using `S \<in> ?I` `T \<in> ?I` by (fact prob_A_intersect)
      also have "\<dots> = p n ^ (card (uedges (f S)) + card (uedges (f T)))"
        proof (rule arg_cong[OF card_Un_disjoint])
          have "finite_graph (f S)" "finite_graph (f T)"
            using S T by (auto simp: wellformed_finite)
          thus "finite (uedges (f S))" "finite (uedges (f T))"
            unfolding finite_graph_def by auto
        next
          have "uedges (f S) \<subseteq> all_edges S" "uedges (f T) \<subseteq> all_edges T"
            using S(4,5) T(4,5) by (metis wellformed_all_edges)+
          moreover have "all_edges S \<inter> all_edges T = {}"
            by (fact all_edges_disjoint[OF disj])
          ultimately show "uedges (f S) \<inter> uedges (f T) = {}"
            by blast
        qed
      also have "\<dots> = p n ^ (2 * ?e)"
        using isomorphic_cards(2)[OF isomorphic_sym[OF S(4)]] isomorphic_cards(2)[OF isomorphic_sym[OF T(4)]] by (simp add: mult_2)
      finally have **: "prob (?A S \<inter> ?A T) = \<dots>"
        .

      from * ** have "indep (?A S) (?A T)"
        unfolding indep_def by force
    }
    note indep = this

    --{* Now we prove an upper bound for @{text "\<Delta>\<^sub>d"}. *}
    have "\<Delta>\<^sub>d = (\<Sum>S \<in> ?I. \<Sum>T | T \<in> ?I \<and> ineq_dep S T. prob (?A S \<inter> ?A T))"
      unfolding \<Delta>\<^sub>d_def ..

    --{* Augmenting the index set as described above. *}
    also have "\<dots> \<le> (\<Sum>S \<in> ?I. \<Sum>T | T \<in> ?I \<and> S \<inter> T \<noteq> {}. prob (?A S \<inter> ?A T))"
      by (rule setsum_mono[OF setsum_mono3]) (auto simp: indep measure_nonneg)

    --{* So far, we are adding the intersection probabilities over pairs of sets which have a
         nonempty intersection. Since we know that these intersections have at least one element
         (as they are nonempty) and at most $|V(H)|$ elements (by definition of $I$). In this step,
         we will partition this sum by cardinality of the intersections. *}
    also have "\<dots> = (\<Sum>S \<in> ?I. \<Sum>T \<in> (\<Union>k \<in> {1..?v}. {T \<in> ?I. card (S \<inter> T) = k}). prob (?A S \<inter> ?A T))"
      proof (rule setsum.cong, rule refl, rule setsum.cong)
        fix S
        assume "S \<in> ?I"
        note I(2,3)[OF this]
        hence "{T. S \<inter> T \<noteq> {}} = (\<Union>k \<in> {1..?v}. {T. card (S \<inter> T) = k})"
          by (simp add: partition_set_of_intersecting_sets_by_card)
        thus "{T \<in> ?I. S \<inter> T \<noteq> {}} = (\<Union>k\<in>{1..?v}. {T \<in> ?I. card (S \<inter> T) = k})"
          by blast
      qed simp
    also have "\<dots> = (\<Sum>S \<in> ?I. \<Sum>k = 1..?v. \<Sum>T | T \<in> ?I \<and> card (S \<inter> T) = k. prob (?A S \<inter> ?A T))"
      by (rule setsum.cong, rule refl, rule setsum.UNION_disjoint) auto
    also have "\<dots> = (\<Sum>k = 1..?v. \<Sum>S \<in> ?I. \<Sum>T | T \<in> ?I \<and> card (S \<inter> T) = k. prob (?A S \<inter> ?A T))"
      by (rule setsum.commute)

    --{* In this step, we compute an upper bound for the intersection probability and argue that
         it only depends on the cardinality of the intersection. *}
    also have "\<dots> \<le> (\<Sum>k = 1..?v. \<Sum>S \<in> ?I. \<Sum>T | T \<in> ?I \<and> card (S \<inter> T) = k. p n powr (2 * ?e - max_density H * k))"
      proof (rule setsum_mono)+
        fix k
        assume k: "k \<in> {1..?v}"
        fix S T
        assume "S \<in> ?I" "T \<in> {T. T \<in> ?I \<and> card (S \<inter> T) = k}"
        hence "T \<in> ?I" and ST_k: "card (S \<inter> T) = k"
          by auto
        note S = I[OF `S \<in> ?I`]
        note T = I[OF `T \<in> ?I`]

        let ?cST = "card (uedges (f S) \<inter> uedges (f T))"

        --{* We already know the intersection probability. *}
        have "prob (?A S \<inter> ?A T) = p n ^ card (uedges (f S) \<union> uedges (f T))"
          using `S \<in> ?I` `T \<in> ?I` by (fact prob_A_intersect)

        --{* Now, we consider the number of edges shared by the copies of @{term H} over @{term S}
             and @{term T}. *}
        also have "\<dots> = p n ^ (card (uedges (f S)) + card (uedges (f T)) - ?cST)"
          using S T unfolding finite_graph_def by (simp add: card_union)
        also have "\<dots> = p n ^ (?e + ?e - ?cST)"
          by (metis isomorphic_cards(2)[OF S(4)] isomorphic_cards(2)[OF T(4)])
        also have "\<dots> = p n ^ (2 * ?e - ?cST)"
          by (simp add: mult_2)
        also have "\<dots> = p n powr (2 * ?e - ?cST)"
          using p_nz by (simp add: powr_realpow)
        also have "\<dots> = p n powr (real (2 * ?e) - real ?cST)"
          using isomorphic_cards[OF S(4)] S(6) by (metis real_of_nat_diff card_mono finite_graph_def inf_le1 mult_le_mono mult_numeral_1 numeral_1_eq_1 one_le_numeral)

        --{* Since the intersection graph is also an isomorphic subgraph of @{term H}, we know that
             its density has to be less than or equal to the maximum density of @{term H}. The proof
             is quite technical. *}
        also have "\<dots> \<le> p n powr (2 * ?e - max_density H * k)"
          proof (rule powr_mono3)
            have "?cST = density (S \<inter> T, uedges (f S) \<inter> uedges (f T)) * k"
              unfolding density_def using k ST_k by simp
            also have "\<dots> \<le> max_density (f S) * k" (* EXTREME METIS!!!1 *)
              proof (rule mult_right_mono, cases "uedges (f S) \<inter> uedges (f T) = {}")
                case True
                hence "density (S \<inter> T, uedges (f S) \<inter> uedges (f T)) = 0"
                  unfolding density_def by simp
                also have "0 \<le> density (f S)"
                  unfolding density_def by simp
                also have "density (f S) \<le> max_density (f S)"
                  using S by (simp add: max_density_is_max subgraph_refl)
                finally show "density (S \<inter> T, uedges (f S) \<inter> uedges (f T)) \<le> max_density (f S)"
                  .
              next
                case False
                show "density (S \<inter> T, uedges (f S) \<inter> uedges (f T)) \<le> max_density (f S)"
                  proof (rule max_density_is_max)
                    show "finite_graph (S \<inter> T, uedges (f S) \<inter> uedges (f T))"
                      using T(3,6) by (metis finite_Int finite_graph_def fst_eqD snd_conv)
                    show "nonempty_graph (S \<inter> T, uedges (f S) \<inter> uedges (f T))"
                      unfolding nonempty_graph_def using k ST_k False by force
                    show "uwellformed (S \<inter> T, uedges (f S) \<inter> uedges (f T))"
                      using S(4,5) T(4,5) unfolding uwellformed_def by (metis Int_iff fst_eqD snd_eqD)
                    show "subgraph (S \<inter> T, uedges (f S) \<inter> uedges (f T)) (f S)"
                      using S(5) by (metis fst_eqD inf_sup_ord(1) snd_conv subgraph_def)
                  qed (simp add: S)
              qed simp
            also have "\<dots> = max_density H * k"
              using assms S by (simp add: isomorphic_max_density[where G\<^sub>1 = H and G\<^sub>2 = "f S"])
            finally have "?cST \<le> max_density H * k"
              .
            thus "2 * ?e - max_density H * k \<le> 2 * ?e - real ?cST"
              by linarith
          qed (auto simp: p_nz)
        finally show "prob (?A S \<inter> ?A T) \<le> \<dots>"
          .
      qed

    --{* Further rewriting the index sets. *}
    also have "\<dots> = (\<Sum>k = 1..?v. \<Sum>(S, T) \<in> (SIGMA S : ?I. {T \<in> ?I. card (S \<inter> T) = k}). p n powr (2 * ?e - max_density H * k))"
      by (rule setsum.cong, rule refl, rule setsum.Sigma) auto
    also have "\<dots> = (\<Sum>k = 1..?v. card (SIGMA S : ?I. {T \<in> ?I. card (S \<inter> T) = k}) * p n powr (2 * ?e - max_density H * k))"
      unfolding real_of_nat_def by (rule setsum.cong) auto

    --{* Here, we compute the cardinality of the index sets and use the same upper bounds for
         the binomial coefficients as for the 0-statement. *}
    also have "\<dots> \<le> (\<Sum>k = 1..?v. ?v ^ k * (real n ^ (2 * ?v - k) * p n powr (2 * ?e - max_density H * k)))"
      proof (rule setsum_mono)
        fix k
        assume k: "k \<in> {1..?v}"
        let ?p = "p n powr (2 * ?e - max_density H * k)"

        have "card (SIGMA S : ?I. {T \<in> ?I. card (S \<inter> T) = k}) = (\<Sum>S \<in> ?I. card {T \<in> ?I. card (S \<inter> T) = k})" (is "?lhs = _")
          by simp
        also have "\<dots> = (\<Sum>S \<in> ?I. (?v choose k) * ((n - ?v) choose (?v - k)))"
          using n k by (fastforce simp: card_set_of_intersecting_sets_by_card)
        also have "\<dots> = (n choose ?v) * ((?v choose k) * ((n - ?v) choose (?v - k)))"
          by (auto simp: n_subsets)
        also have "\<dots> \<le> n ^ ?v * ((?v choose k) * ((n - ?v) choose (?v - k)))"
          using n by (simp add: binomial_le_pow)
        also have "\<dots> \<le> n ^ ?v * ?v ^ k * ((n - ?v) choose (?v - k))"
          using k by (simp add: binomial_le_pow)
        also have "\<dots> \<le> n ^ ?v * ?v ^ k * (n - ?v) ^ (?v - k)"
          using n_2v by (simp add: binomial_le_pow)
        also have "\<dots> \<le> n ^ ?v * ?v ^ k * n ^ (?v - k)"
          by (simp add: power_mono)
        also have "\<dots> = ?v ^ k * (n ^ (?v + (?v - k)))"
          by (simp add: power_add)
        also have "\<dots> = ?v ^ k * n ^ (2 * ?v - k)" (is "_ = ?rhs")
          using k by (simp add: mult_2)
        finally have "?lhs \<le> ?rhs"
          .
        hence "real ?lhs \<le> real ?rhs"
          by blast
        moreover have "0 \<le> ?p"
          by simp
        ultimately have "?lhs * ?p \<le> ?rhs * ?p"
          by (rule mult_right_mono)
        also have "\<dots> = ?v ^ k * (real n ^ (2 * ?v - k) * ?p)"
          by simp
        finally show "?lhs * ?p \<le> \<dots>"
          .
      qed
    finally have delta_upper: "\<Delta>\<^sub>d \<le> (\<Sum>k = 1..?v. ?v ^ k * (real n ^ (2 * ?v - k) * p n powr (2 * ?e - max_density H * k)))"
      .

    --{* At this point, we have established all neccessary bounds. *}
    note is_es is_psi compl_prob compl_upper ex_lower ex_lower_pos inv_ex_upper delta_upper
  }
  note facts = this

  --{* Recall our central inequality. We now prove that both summands tend to $0$. This is mainly
       an exercise in bookkeeping and real arithmetics as no intelligent ideas are involved. *}
  have "(\<lambda>n. 1 / prob_space_with_indicators.\<mu> (MGn p n) (?I n) (?A n)) ----> 0"
    proof (rule LIMSEQ_le_zero)
      have "(\<lambda>n. 1 / (real n ^ ?v * p n ^ ?e)) ----> 0"
        proof (rule LIMSEQ_le_zero[OF _ eventually_sequentiallyI eventually_sequentiallyI])
          fix n
          show "0 \<le> 1 / (real n ^ ?v * p n ^ ?e)"
            using p by simp

          assume n: "1 \<le> n"
          have "1 / (real n ^ ?v * p n ^ ?e) = 1 / (real n powr ?v * p n powr ?e)"
            using n p_nz by (simp add: powr_realpow[symmetric])
          also have "\<dots> = real n powr -real ?v * p n powr -real ?e"
            by (simp add: powr_minus_divide)
          also have "\<dots> = (real n powr -(?v / ?e)) powr ?e * (p n powr -1) powr ?e"
            using v_e_nz by (simp add: powr_powr)
          also have "\<dots> = (real n powr -(?v / ?e) * p n powr -1) powr ?e"
            by (simp add: powr_mult)
          also have "\<dots> = (real n powr -(1 / (?e / ?v)) * p n powr -1) powr ?e"
            by simp
          also have "\<dots> \<le> (real n powr -(1 / max_density H) * p n powr -1) powr ?e"
            apply (rule powr_mono2[OF _ _ mult_right_mono[OF powr_mono[OF le_imp_neg_le[OF divide_left_mono]]]])
            using n v_e_nz by (auto simp:
              max_density_is_max[unfolded density_def, OF finite finite nonempty wellformed subgraph_refl]
              max_density_gr_zero[OF finite nonempty wellformed])
          also have "\<dots> = (real n powr -(1 / max_density H) * (1 / p n powr 1)) powr ?e"
            by (simp add: powr_minus_divide[symmetric])
          also have "\<dots> = (real n powr -(1 / max_density H) / p n) powr ?e"
            using p_nz by simp
          also have "\<dots> = (subgraph_threshold H n / p n) powr ?e"
            unfolding subgraph_threshold_def ..
          finally show "1 / (real n ^ ?v * p n ^ ?e) \<le> (subgraph_threshold H n / p n) powr ?e"
            .
        next
          show "(\<lambda>n. (subgraph_threshold H n / p n) powr real (card (uedges H))) ----> 0"
            using tendsto_zero_powrI[OF eventually_sequentiallyI[OF divide_pos_pos] p_threshold] subgraph_threshold_def p_nz v_e_nz by auto
        qed
      hence "(\<lambda>n. ?v ^ ?v * (1 / (real n ^ ?v * p n ^ ?e))) ----> real (?v ^ ?v) * 0"
        by (rule LIMSEQ_const_mult)
      thus "(\<lambda>n. ?v ^ ?v * (1 / (real n ^ ?v * p n ^ ?e))) ----> 0"
        by simp
    next
      show "\<forall>\<^sup>\<infinity>n. 0 \<le> 1 / prob_space_with_indicators.\<mu> (MGn p n) (?I n) (?A n)"
        by (rule eventually_sequentiallyI[OF less_imp_le[OF divide_pos_pos[OF _ prob_space_with_indicators.\<mu>_non_zero[OF facts(2)]]]]) simp+
    next
      show "\<forall>\<^sup>\<infinity>n. 1 / prob_space_with_indicators.\<mu> (MGn p n) (?I n) (?A n) \<le> ?v ^ ?v * (1 / (real n ^ ?v * p n ^ ?e))"
        using facts(7) by (rule eventually_sequentiallyI)
    qed
  moreover have "(\<lambda>n. prob_space_with_indicators.\<Delta>\<^sub>d (MGn p n) (?I n) (?A n)) \<lless> (\<lambda>n. (prob_space_with_indicators.\<mu> (MGn p n) (?I n) (?A n))^2)"
    proof (rule less_fun_bounds)
      let ?num = "\<lambda>n k. ?v ^ k * (real n ^ (2 * ?v - k) * p n powr (2 * ?e - max_density H * k))"
      let ?den = "\<lambda>n. ((1 / ?v ^ ?v) * (real n ^ ?v * p n ^ ?e))^2"

      --{* We have to show that a sum is asymptotically smaller than a constant term. We do that by
           showing that each summand is asymptotically smaller than the term. *}
      {
        fix k
        assume k: "k \<in> {1..?v}"
        let ?den' = "\<lambda>n. (1 / ?v ^ ?v)^2 * (real n ^ (2 * ?v) * p n ^ (2 * ?e))"
        have den': "?den' = ?den"
          by (subst power_mult_distrib) (simp add: power_mult_distrib power_even_eq)

        have "(\<lambda>n. ?num n k) \<lless> ?den'"
          proof (rule less_fun_const_quot)
            have "(\<lambda>n. (subgraph_threshold H n / p n) powr (max_density H * k)) ----> 0"
              using tendsto_zero_powrI[OF eventually_sequentiallyI[OF divide_pos_pos] p_threshold mult_pos_pos[OF max_density_gr_zero[OF finite nonempty wellformed]]]
              subgraph_threshold_def powr_gt_zero p_nz k by simp
            thus "(\<lambda>n. (real n ^ (2 * ?v - k) * p n powr (2 * ?e - max_density H * k)) / (real n ^ (2 * ?v) * p n ^ (2 * ?e))) ----> 0"
              proof (rule LIMSEQ_cong[OF _ eventually_sequentiallyI])
                fix n :: nat
                assume n: "1 \<le> n"
                have "(real n ^ (2 * ?v - k) * p n powr (2 * ?e - max_density H * k)) / (real n ^ (2 * ?v) * p n ^ (2 * ?e)) =
                      (n powr (2 * ?v - k) * p n powr (2 * ?e - max_density H * k)) / (n powr (2 * ?v) * p n powr (2 * ?e))" (is "?lhs = _")
                  using n p_nz by (simp add: powr_realpow[symmetric])
                also have "\<dots> = (n powr (2 * ?v - k) / n powr (2 * ?v)) * (p n powr (2 * ?e - max_density H * k) / (p n powr (2 * ?e)))"
                  by simp
                also have "\<dots> = (n powr (real (2 * ?v - k) - 2 * ?v)) * p n powr ((2 * ?e - max_density H * k) - (2 * ?e))"
                  by (simp add: powr_divide2)
                also have "\<dots> = n powr -real k * p n powr ((2 * ?e - max_density H * k) - (2 * ?e))"
                  apply (rule arg_cong[where y = "- real k"])
                  using k by fastforce
                also have "\<dots> = n powr -real k * p n powr - (max_density H * k)"
                  by simp
                also have "\<dots> = (n powr -(1 / max_density H)) powr (max_density H * k) * p n powr - (max_density H * k)"
                  using max_density_gr_zero[OF finite nonempty wellformed] by (simp add: powr_powr)
                also have "\<dots> = (n powr -(1 / max_density H)) powr (max_density H * k) * (p n powr -1) powr (max_density H * k)"
                  by (simp add: powr_powr)
                also have "\<dots> = (n powr -(1 / max_density H) * p n powr -1) powr (max_density H * k)"
                  by (simp add: powr_mult)
                also have "\<dots> = (n powr -(1 / max_density H) * (1 / p n powr 1)) powr (max_density H * k)"
                  by (simp add: powr_minus_divide[symmetric])
                also have "\<dots> = (n powr -(1 / max_density H) / p n) powr (max_density H * k)"
                  using p_nz by simp
                also have "\<dots> = (subgraph_threshold H n / p n) powr (max_density H * k)" (is "_ = ?rhs")
                  unfolding subgraph_threshold_def ..
                finally have "?lhs = ?rhs"
                  .
                thus "?rhs = ?lhs"
                  by simp
              qed
          next
            show "(1 / ?v ^ ?v)^2 \<noteq> 0"
              by (rule field_power_not_zero[OF less_imp_neq[symmetric]]) (rule vpowv_inv_gr_z)
          qed

        hence "(\<lambda>n. ?num n k) \<lless> ?den"
          by (rule subst[OF den'])
      }
      hence "(\<lambda>n. \<Sum>k = 1..?v. ?num n k / ?den n) ----> (\<Sum>k = 1..?v. 0)"
        by (rule tendsto_setsum)
      hence "(\<lambda>n. \<Sum>k = 1..?v. ?num n k / ?den n) ----> 0"
        by simp
      moreover have "(\<lambda>n. \<Sum>k = 1..?v. ?num n k / ?den n) = (\<lambda>n. (\<Sum>k = 1..?v. ?num n k) / ?den n)"
        by (simp add: setsum_left_div_distrib)
      ultimately show "(\<lambda>n. \<Sum>k = 1..?v. ?num n k) \<lless> ?den"
        by metis

      show "\<forall>\<^sup>\<infinity>n. prob_space_with_indicators.\<Delta>\<^sub>d (MGn p n) (?I n) (?A n) \<le> (\<Sum>k = 1..?v. ?num n k)"
        using facts(8) by (rule eventually_sequentiallyI)

      show "\<forall>\<^sup>\<infinity>n. ?den n \<le> (prob_space_with_indicators.\<mu> (MGn p n) (?I n) (?A n))^2"
        using facts(5) facts(6) by (rule eventually_sequentiallyI[OF power_mono[OF _ less_imp_le]])

      show "\<forall>\<^sup>\<infinity>n. 0 \<le> prob_space_with_indicators.\<Delta>\<^sub>d (MGn p n) (?I n) (?A n)"
        using facts(2) by (rule eventually_sequentiallyI[OF prob_space_with_indicators.\<Delta>\<^sub>d_nonneg])

      show "\<forall>\<^sup>\<infinity>n. 0 < (prob_space_with_indicators.\<mu> (MGn p n) (?I n) (?A n))^2"
        using facts(2) by (rule eventually_sequentiallyI[OF prob_space_with_indicators.\<mu>_sq_non_zero])

      show "\<forall>\<^sup>\<infinity>n. 0 < ?den n"
        using facts(6) by (rule eventually_sequentiallyI[OF zero_less_power])
    qed
  ultimately have "(\<lambda>n.
      1 / prob_space_with_indicators.\<mu> (MGn p n) (?I n) (?A n) +
      prob_space_with_indicators.\<Delta>\<^sub>d (MGn p n) (?I n) (?A n) / (prob_space_with_indicators.\<mu> (MGn p n) (?I n) (?A n))^2
    ) ----> 0"
    by (subst add_0_left[where a = 0, symmetric]) (rule tendsto_add)

  --{* By now, we can actually perform the reduction mentioned above. *}
  hence "(\<lambda>n. probGn p n (\<lambda>es. \<not> H \<sqsubseteq> edge_space.edge_ugraph n es)) ----> 0"
    proof (rule LIMSEQ_le_zero)
      show "\<forall>\<^sup>\<infinity>n. 0 \<le> probGn p n (\<lambda>es. \<not> H \<sqsubseteq> edge_space.edge_ugraph n es)"
        by (rule eventually_sequentiallyI) (rule measure_nonneg)
    next
      show "\<forall>\<^sup>\<infinity>n.
        probGn p n (\<lambda>es. \<not> H \<sqsubseteq> edge_space.edge_ugraph n es) \<le>
          1 / prob_space_with_indicators.\<mu> (MGn p n) (?I n) (?A n) +
          prob_space_with_indicators.\<Delta>\<^sub>d (MGn p n) (?I n) (?A n) / (prob_space_with_indicators.\<mu> (MGn p n) (?I n) (?A n))^2"
        by (rule eventually_sequentiallyI[OF facts(4)])
    qed
  hence "(\<lambda>n. 1 - probGn p n (\<lambda>es. \<not> H \<sqsubseteq> edge_space.edge_ugraph n es)) ----> 1"
    using tendsto_diff[OF tendsto_const] by fastforce
  thus "prob_in_class p {G. H \<sqsubseteq> G} ----> 1"
    by (rule LIMSEQ_cong[OF _ eventually_sequentiallyI[OF facts(3)]])
qed

end