section \<open>Random Walks\label{sec:random_walks}\<close>

theory Expander_Graphs_Walks
  imports
    Expander_Graphs_Algebra
    Expander_Graphs_Eigenvalues
    Expander_Graphs_TTS
    Constructive_Chernoff_Bound
begin

unbundle intro_cong_syntax

no_notation Matrix.vec_index (infixl "$" 100)
hide_const Matrix.vec_index
hide_const Matrix.vec
no_notation Matrix.scalar_prod  (infix "\<bullet>" 70)

fun walks' :: "('a,'b) pre_digraph \<Rightarrow> nat \<Rightarrow> ('a list) multiset"
  where
    "walks' G 0 = image_mset (\<lambda>x. [x]) (mset_set (verts G))" |
    "walks' G (Suc n) =
      concat_mset {#{#w @[z].z\<in># vertices_from G (last w)#}. w \<in># walks' G n#}"

definition "walks G l = (case l of 0 \<Rightarrow> {#[]#} | Suc pl \<Rightarrow> walks' G pl)"

lemma Union_image_mono: "(\<And>x. x \<in> A \<Longrightarrow> f x \<subseteq> g x) \<Longrightarrow> \<Union> (f ` A) \<subseteq> \<Union> (g ` A)"
  by auto

context fin_digraph
begin

lemma count_walks':
  assumes "set xs \<subseteq> verts G"
  assumes "length xs = l+1"
  shows "count (walks' G l) xs = (\<Prod>i \<in> {..<l}. count (edges G) (xs ! i, xs ! (i+1)))"
proof -
  have a:"xs \<noteq> []" using assms(2) by auto

  have "count (walks' G (length xs-1)) xs = (\<Prod>i<length xs -1. count (edges G) (xs ! i, xs ! (i + 1)))"
    using a assms(1)
  proof (induction xs rule:rev_nonempty_induct)
    case (single x)
    hence "x \<in> verts G" by simp
    hence "count {#[x]. x \<in># mset_set (verts G)#} [x] = 1"
      by (subst count_image_mset_inj, auto simp add:inj_def)
    then show ?case by simp
  next
    case (snoc x xs)
    have set_xs: "set xs \<subseteq> verts G" using snoc by simp

    define l where "l = length xs - 1"
    have l_xs: "length xs = l + 1" unfolding l_def using snoc by simp
    have "count (walks' G (length (xs @ [x]) - 1)) (xs @ [x]) =
      (\<Sum>ys\<in>#walks' G l. count {#ys @ [z]. z \<in># vertices_from G (last ys)#} (xs @ [x]))"
      by (simp add:l_xs count_concat_mset image_mset.compositionality comp_def)
    also have "... = (\<Sum>ys\<in>#walks' G l.
      (if ys = xs then count {#xs @ [z]. z \<in># vertices_from G (last xs)#} (xs @ [x]) else 0))"
      by (intro arg_cong[where f="sum_mset"] image_mset_cong) (auto intro!: count_image_mset_0_triv)
    also have "... = (\<Sum>ys\<in>#walks' G l.(if ys=xs then count (vertices_from G (last xs)) x else 0))"
      by (subst count_image_mset_inj, auto simp add:inj_def)
    also have "... = count (walks' G l) xs * count (vertices_from G (last xs)) x"
      by (subst sum_mset_delta, simp)
    also have "... = count (walks' G l) xs * count (edges G) (last xs, x)"
      unfolding vertices_from_def count_mset_exp image_mset_filter_mset_swap[symmetric]
        filter_filter_mset by (simp add:prod_eq_iff)
    also have "... = count (walks' G l) xs * count (edges G) ((xs@[x])!l, (xs@[x])!(l+1))"
      using snoc(1) unfolding l_def nth_append last_conv_nth[OF snoc(1)] by simp
    also have "... = (\<Prod>i<l+1. count (edges G) ((xs@[x])!i, (xs@[x])!(i+1)))"
      unfolding l_def snoc(2)[OF set_xs] by (simp add:nth_append)
    finally have "count (walks' G (length (xs @ [x]) - 1)) (xs @ [x]) =
       (\<Prod>i<length (xs@[x]) - 1. count (edges G) ((xs@[x])!i, (xs@[x])!(i+1)))"
      unfolding l_def using snoc(1) by simp
    then show ?case by simp
  qed
  moreover have "l = length xs - 1" using a assms by simp
  ultimately show ?thesis by simp
qed

lemma count_walks:
  assumes "set xs \<subseteq> verts G"
  assumes "length xs = l" "l > 0"
  shows "count (walks G l) xs = (\<Prod>i \<in> {..<l-1}. count (edges G)  (xs ! i, xs ! (i+1)))"
  using assms unfolding walks_def by (cases l, auto simp add:count_walks')

lemma set_walks':
  "set_mset (walks' G l) \<subseteq> {xs. set xs \<subseteq> verts G \<and> length xs = (l+1)}"
proof (induction l)
  case 0
  then show ?case by auto
next
  case (Suc l)

  have "set_mset (walks' G (Suc l)) =
    (\<Union>x\<in>set_mset (walks' G l). (\<lambda>z. x @ [z]) ` set_mset (vertices_from G (last x)))"
    by (simp add:set_mset_concat_mset)
  also have "... \<subseteq> (\<Union>x\<in>{xs. set xs \<subseteq> verts G \<and> length xs = l + 1}.
    (\<lambda>z. x @ [z]) ` set_mset (vertices_from G (last x)))"
    by (intro Union_mono image_mono Suc)
  also have "... \<subseteq> (\<Union>x\<in>{xs. set xs \<subseteq> verts G \<and> length xs = l + 1}. (\<lambda>z. x @ [z]) ` verts G)"
    by (intro Union_image_mono image_mono set_mset_vertices_from)
  also have "... \<subseteq> {xs. set xs \<subseteq> verts G \<and> length xs = (Suc l + 1)}"
    by (intro subsetI) auto
  finally show ?case by simp
qed

lemma set_walks:
  "set_mset (walks G l) \<subseteq> {xs. set xs \<subseteq> verts G \<and> length xs = l}"
  unfolding walks_def using set_walks' by (cases l, auto)

lemma set_walks_2:
  assumes  "xs \<in># walks' G l"
  shows "set xs \<subseteq> verts G" "xs \<noteq> []"
proof -
  have a:"xs \<in> set_mset (walks' G l)"
    using assms by simp
  thus "set xs \<subseteq> verts G"
    using set_walks' by auto
  have "length xs \<noteq> 0"
    using set_walks' a by fastforce
  thus "xs \<noteq> []" by simp
qed

lemma set_walks_3:
  assumes "xs \<in># walks G l"
  shows  "set xs \<subseteq> verts G" "length xs = l"
  using set_walks assms by auto
end

lemma measure_pmf_of_multiset:
  assumes "A \<noteq> {#}"
  shows "measure (pmf_of_multiset A) S = real (size (filter_mset (\<lambda>x. x \<in> S) A)) / size A"
    (is "?L = ?R")
proof -
  have "sum (count A) (S \<inter> set_mset A) = size (filter_mset (\<lambda>x. x \<in> S \<inter> set_mset A) A)"
    by (intro sum_count_2) simp
  also have "... = size (filter_mset (\<lambda>x. x \<in> S) A)"
    by (intro arg_cong[where f="size"] filter_mset_cong) auto
  finally have a: "sum (count A) (S \<inter> set_mset A) = size (filter_mset (\<lambda>x. x \<in> S) A)"
    by simp

  have "?L = measure (pmf_of_multiset A) (S \<inter> set_mset A)"
    using assms by (intro measure_eq_AE AE_pmfI) auto
  also have "... = sum (pmf (pmf_of_multiset A)) (S \<inter> set_mset A)"
    by (intro measure_measure_pmf_finite) simp
  also have "... = (\<Sum>x \<in> S \<inter> set_mset A. count A x / size A)"
    using assms by (intro sum.cong, auto)
  also have "... = (\<Sum>x \<in> S \<inter> set_mset A. count A x) / size A"
    by (simp add:sum_divide_distrib)
  also have "... = ?R"
    using a by simp
  finally show ?thesis
    by simp
qed

lemma pmf_of_multiset_image_mset:
  assumes "A \<noteq> {#}"
  shows "pmf_of_multiset (image_mset f A) = map_pmf f (pmf_of_multiset A)"
  using assms by (intro pmf_eqI) (simp add:pmf_map measure_pmf_of_multiset count_mset_exp
      image_mset_filter_mset_swap[symmetric])

context regular_graph
begin

lemma size_walks':
  "size (walks' G l) = card (verts G) * d^l"
proof (induction l)
  case 0
  then show ?case by simp
next
  case (Suc l)
  have a:"out_degree G (last x) = d" if "x \<in># walks' G l" for x
  proof -
    have "last x \<in> verts G"
      using set_walks_2 that by fastforce
    thus ?thesis
      using reg by simp
  qed

  have "size (walks' G (Suc l)) = (\<Sum>x\<in>#walks' G l. out_degree G (last x))"
    by (simp add:size_concat_mset image_mset.compositionality comp_def verts_from_alt out_degree_def)
  also have "... = (\<Sum>x\<in>#walks' G l. d)"
    by (intro arg_cong[where f="sum_mset"] image_mset_cong a) simp
  also have "... = size (walks' G l) * d" by simp
  also have "... = card (verts G) * d^(Suc l)" using Suc by simp
  finally show ?case by simp
qed

lemma size_walks:
  "size (walks G l) = (if l > 0 then n * d^(l-1) else 1)"
  using size_walks' unfolding walks_def n_def by (cases l, auto)

lemma walks_nonempty:
  "walks G l \<noteq> {#}"
proof -
  have "size (walks G l) > 0"
    unfolding size_walks using d_gt_0 n_gt_0 by auto
  thus "walks G l \<noteq> {#}"
    by auto
qed

end

context regular_graph_tts
begin

lemma g_step_remains_orth:
  assumes "g_inner f (\<lambda>_. 1) = 0"
  shows "g_inner (g_step f) (\<lambda>_. 1) = 0" (is "?L = ?R")
proof -
  have "?L = (A *v (\<chi> i. f (enum_verts i))) \<bullet> 1"
    unfolding g_inner_conv g_step_conv one_vec_def by simp
  also have "... = (\<chi> i. f (enum_verts i)) \<bullet> 1"
    by (intro markov_orth_inv markov)
  also have "... = g_inner f (\<lambda>_. 1)"
    unfolding g_inner_conv one_vec_def by simp
  also have "... = 0" using assms by simp
  finally show ?thesis by simp
qed

lemma spec_bound:
  "spec_bound A \<Lambda>\<^sub>a"
proof -
  have "norm (A *v v) \<le> \<Lambda>\<^sub>a * norm v" if "v \<bullet> 1 = (0::real)" for v::"real^'n"
    unfolding \<Lambda>\<^sub>e_eq_\<Lambda>
    by (intro \<gamma>\<^sub>a_real_bound that)
  thus ?thesis
    unfolding spec_bound_def using \<Lambda>_ge_0 by auto
qed

text \<open>A spectral expansion rule that does not require orthogonality of the vector for the stationary
distribution:\<close>

lemma expansionD3:
  "\<bar>g_inner f (g_step f)\<bar> \<le> \<Lambda>\<^sub>a * g_norm f^2 + (1-\<Lambda>\<^sub>a) * g_inner f (\<lambda>_. 1)^2 / n" (is "?L \<le> ?R")
proof -
  define v where "v = (\<chi> i. f (enum_verts i))"
  define v1 :: "real^ 'n" where "v1 = ((v \<bullet> 1) / n) *\<^sub>R 1"
  define v2 :: "real^ 'n" where "v2 = v - v1"
  have v_eq: "v = v1 + v2"
    unfolding v2_def by simp

  have 0: "A *v v1 = v1"
    unfolding v1_def using markov_apply[OF markov]
    by (simp add:algebra_simps)
  have 1: "v1 v* A = v1"
    unfolding v1_def using markov_apply[OF markov]
    by (simp add:algebra_simps scaleR_vector_matrix_assoc)

  have "v2 \<bullet> 1 = v \<bullet> 1 - v1 \<bullet> 1"
    unfolding v2_def by (simp add:algebra_simps)
  also have "... = v \<bullet> 1  - v \<bullet> 1 * real CARD('n) / real n"
    unfolding v1_def by (simp add:inner_1_1)
  also have "... = 0 "
    using verts_non_empty unfolding card n_def by simp
  finally have 4:"v2 \<bullet> 1 = 0" by simp
  hence 2: "v1 \<bullet> v2 = 0"
    unfolding v1_def by (simp add:inner_commute)

  define f2 where "f2 i = v2 $ (enum_verts_inv i)" for i
  have f2_def: "v2 = (\<chi> i. f2 (enum_verts i))"
    unfolding f2_def Rep_inverse by simp

  have 6: "g_inner f2 (\<lambda>_. 1) = 0"
    unfolding g_inner_conv f2_def[symmetric] one_vec_def[symmetric] 4 by simp

  have "\<bar>v2 \<bullet> (A *v v2)\<bar> = \<bar>g_inner f2 (g_step f2)\<bar>"
    unfolding f2_def g_inner_conv g_step_conv by simp
  also have "... \<le> \<Lambda>\<^sub>a * (g_norm f2)\<^sup>2"
    by (intro expansionD1 6)
  also have "... = \<Lambda>\<^sub>a * (norm v2)^2"
    unfolding g_norm_conv f2_def by simp
  finally have 5:"\<bar>v2 \<bullet> (A *v v2)\<bar> \<le> \<Lambda>\<^sub>a * (norm v2)\<^sup>2" by simp

  have 3: "norm (1 :: real^'n)^2 = n"
    unfolding power2_norm_eq_inner inner_1_1 card n_def by presburger

  have "?L = \<bar>v \<bullet> (A *v v)\<bar>"
    unfolding g_inner_conv g_step_conv v_def by simp
  also have "... = \<bar>v1 \<bullet> (A *v v1) + v2 \<bullet> (A *v v1) + v1 \<bullet> (A *v v2) + v2 \<bullet> (A *v v2)\<bar>"
    unfolding v_eq by (simp add:algebra_simps)
  also have "... = \<bar>v1 \<bullet> v1 + v2 \<bullet> v1 + v1 \<bullet> v2 + v2 \<bullet> (A *v v2)\<bar>"
    unfolding dot_lmul_matrix[where x="v1",symmetric] 0 1 by simp
  also have "... = \<bar>v1 \<bullet> v1 + v2 \<bullet> (A *v v2)\<bar>"
    using 2 by (simp add:inner_commute)
  also have "... \<le> \<bar>norm v1^2\<bar> + \<bar>v2 \<bullet> (A *v v2)\<bar>"
    unfolding power2_norm_eq_inner by (intro abs_triangle_ineq)
  also have "... \<le> norm v1^2 + \<Lambda>\<^sub>a * norm v2^2"
    by (intro add_mono 5) auto
  also have "... = \<Lambda>\<^sub>a * (norm v1^2 + norm v2^2) + (1 - \<Lambda>\<^sub>a) * norm v1^2"
    by (simp add:algebra_simps)
  also have "... = \<Lambda>\<^sub>a * norm v^2 + (1 - \<Lambda>\<^sub>a) * norm v1^2"
    unfolding v_eq pythagoras[OF 2] by simp
  also have "... = \<Lambda>\<^sub>a * norm v^2 + ((1 - \<Lambda>\<^sub>a)) * ((v \<bullet> 1)^2*n)/n^2"
    unfolding v1_def by (simp add:power_divide power_mult_distrib 3)
  also have "... = \<Lambda>\<^sub>a * norm v^2 + ((1 - \<Lambda>\<^sub>a)/n) * (v \<bullet> 1)^2"
    by (simp add:power2_eq_square)
  also have "... = ?R"
    unfolding g_norm_conv g_inner_conv v_def one_vec_def by (simp add:field_simps)
  finally show ?thesis by simp
qed

definition ind_mat where "ind_mat S = diag (ind_vec (enum_verts -` S))"

lemma walk_distr:
  "measure (pmf_of_multiset (walks G l)) {\<omega>. (\<forall>i<l. \<omega> ! i \<in> S i)} =
  foldl (\<lambda>x M. M *v x) stat (intersperse A (map (\<lambda>i. ind_mat (S i)) [0..<l]))\<bullet>1"
  (is "?L = ?R")
proof (cases "l > 0")
  case True
  let ?n = "real n"
  let ?d = "real d"
  let ?W = "{(w::'a list). set w \<subseteq> verts G \<and> length w = l}"
  let ?V = "{(w::'n list). length w = l}"

  have a: "set_mset (walks G l) \<subseteq> ?W"
    using set_walks by auto
  have b: "finite ?W"
    by (intro finite_lists_length_eq) auto

  define lp where "lp = l - 1"

  define xs where "xs = map (\<lambda>i. ind_mat (S i)) [0..<l]"
  have "xs \<noteq> []" unfolding xs_def using True by simp
  then obtain xh xt where xh_xt: "xh#xt=xs" by (cases xs, auto)

  have "length xs = l"
    unfolding xs_def by simp
  hence len_xt: "length xt = lp"
    using True unfolding xh_xt[symmetric] lp_def by simp

  have "xh = xs ! 0"
    unfolding xh_xt[symmetric] by simp
  also have "... = ind_mat (S 0)"
    using True unfolding xs_def by simp
  finally have xh_eq: "xh = ind_mat (S 0)"
    by simp

  have inj_map_enum_verts: "inj_on (map enum_verts) ?V"
    using bij_betw_imp_inj_on[OF enum_verts] inj_on_subset
    by (intro inj_on_mapI) auto

  have "card ?W = card (verts G)^l"
    by (intro card_lists_length_eq) simp
  also have "... = card {w. set w \<subseteq> (UNIV :: 'n set) \<and> length w  = l}"
    unfolding card[symmetric] by (intro card_lists_length_eq[symmetric]) simp
  also have "... = card ?V"
    by (intro arg_cong[where f="card"]) auto
  also have "... = card (map enum_verts ` ?V)"
    by (intro card_image[symmetric] inj_map_enum_verts)
  finally have "card ?W = card (map enum_verts ` ?V)"
    by simp
  hence "map enum_verts ` ?V = ?W"
    using bij_betw_apply[OF enum_verts]
    by (intro card_subset_eq b image_subsetI) auto

  hence bij_map_enum_verts: "bij_betw (map enum_verts) ?V ?W"
    using inj_map_enum_verts unfolding bij_betw_def by auto

  have "?L = size {# w \<in># walks G l. \<forall>i<l. w ! i \<in> S i #} / (?n * ?d^(l-1))"
    using True unfolding size_walks measure_pmf_of_multiset[OF walks_nonempty] by simp
  also have "... = (\<Sum>w\<in>?W. real (count (walks G l) w) * of_bool (\<forall>i<l. w!i \<in> S i))/(?n*?d^(l-1))"
    unfolding size_filter_mset_conv sum_mset_conv_2[OF a b] by simp
  also have "... = (\<Sum>w\<in>?W. (\<Prod>i<l-1. real (count (edges G) (w!i,w!(i+1)))) *
                            (\<Prod>i<l. of_bool (w!i \<in> S i)))/(?n*?d^(l-1))"
    using True by (intro sum.cong arg_cong2[where f="(/)"]) (auto simp add: count_walks)
  also have "... =
    (\<Sum>w\<in>?W. (\<Prod>i<l-1. real (count (edges G) (w!i,w!(i+1)))/?d)*(\<Prod>i<l. of_bool (w!i \<in> S i)))/?n"
    using True unfolding prod_dividef by (simp add:sum_divide_distrib algebra_simps)
  also have "... =
    (\<Sum>w\<in>?V. (\<Prod>i<l-1. count (edges G) (map enum_verts w!i,map enum_verts w!(i+1)) / ?d) *
    (\<Prod>i<l. of_bool (map enum_verts w!i \<in> S i)))/?n"
    by (intro sum.reindex_bij_betw[symmetric] arg_cong2[where f="(/)"] refl bij_map_enum_verts)
  also have "... =
    (\<Sum>w\<in>?V. (\<Prod>i<lp. A $ w!(i+1) $ w!i) * (\<Prod>i<Suc lp. of_bool(enum_verts (w!i) \<in> S i)))/?n"
    unfolding A_def lp_def using True by simp
  also have "... = (\<Sum>w\<in>?V. (\<Prod>i<lp. A $ w!(i+1) $ w!i) *
    (\<Prod>i\<in>insert 0 (Suc ` {..<lp}). of_bool(enum_verts (w!i) \<in> S i)))/?n"
    using lessThan_Suc_eq_insert_0
    by (intro sum.cong arg_cong2[where f="(/)"] arg_cong2[where f="(*)"] prod.cong) auto
  also have "... = (\<Sum>w\<in>?V. (\<Prod>i<lp. of_bool(enum_verts (w!(i+1))\<in>S(i+1))* A$ w!(i+1) $ w!i)
    * of_bool(enum_verts(w!0)\<in>S 0))/?n"
    by (simp add:prod.reindex algebra_simps prod.distrib)
  also have "... =
    (\<Sum>w\<in>?V. (\<Prod>i<lp. (ind_mat (S (i+1))**A) $ w!(i+1) $ w!i) * of_bool(enum_verts (w!0)\<in>S 0))/?n"
    unfolding diag_def ind_vec_def matrix_matrix_mult_def ind_mat_def
    by (intro sum.cong arg_cong2[where f="(/)"] arg_cong2[where f="(*)"] prod.cong refl)
      (simp add:if_distrib if_distribR sum.If_cases)
  also have "... =
    (\<Sum>w\<in>?V. (\<Prod>i<lp. (xs!(i+1)**A) $ w!(i+1) $ w!i) * of_bool(enum_verts (w!0)\<in>S 0))/?n"
    unfolding xs_def lp_def True
    by (intro sum.cong arg_cong2[where f="(/)"] arg_cong2[where f="(*)"] prod.cong refl) auto
  also have "... =
    (\<Sum>w\<in>?V. (\<Prod>i<lp. (xt ! i ** A) $ w!(i+1) $ w!i) * of_bool(enum_verts (w!0)\<in>S 0))/?n"
    unfolding xh_xt[symmetric] by auto
  also have "... = (\<Sum>w\<in>?V. (\<Prod>i<lp. (xt!i**A)$ w!(i+1) $ w!i)*(ind_mat(S 0)*v stat) $w!0)"
    using n_def unfolding matrix_vector_mult_def diag_def stat_def ind_vec_def ind_mat_def card
    by (simp add:sum.If_cases if_distrib if_distribR sum_divide_distrib)
  also have "... = (\<Sum>w\<in>?V. (\<Prod>i<lp. (xt ! i ** A) $ w!(i+1) $ w!i) * (xh *v stat) $ w ! 0)"
    unfolding xh_eq by simp
  also have "... = foldl (\<lambda>x M. M *v x) (xh *v stat) (map (\<lambda>x. x ** A) xt) \<bullet> 1"
    using True unfolding foldl_matrix_mult_expand_2 by (simp add:len_xt lp_def)
  also have "... = foldl (\<lambda>x M. M *v (A *v x)) (xh *v stat) xt \<bullet> 1"
    by (simp add: matrix_vector_mul_assoc foldl_map)
  also have "... = foldl (\<lambda>x M. M *v x) stat (intersperse A (xh#xt)) \<bullet> 1"
    by (subst foldl_intersperse_2, simp)
  also have "... = ?R"  unfolding xh_xt xs_def by simp
  finally show ?thesis by simp
next
  case False
  hence "l = 0" by simp
  thus ?thesis unfolding stat_def by (simp add: inner_1_1)
qed

lemma hitting_property:
  assumes "S \<subseteq> verts G"
  assumes "I \<subseteq> {..<l}"
  defines "\<mu> \<equiv> real (card S) / card (verts G)"
  shows "measure (pmf_of_multiset (walks G l)) {w. set (nths w I) \<subseteq> S} \<le> (\<mu>+\<Lambda>\<^sub>a*(1-\<mu>))^card I"
    (is "?L \<le> ?R")
proof -
  define T where "T = (\<lambda>i. if i \<in> I then S else UNIV)"

  have 0: "ind_mat UNIV = mat 1"
    unfolding ind_mat_def diag_def ind_vec_def Finite_Cartesian_Product.mat_def by vector

  have \<Lambda>_range: "\<Lambda>\<^sub>a \<in> {0..1}"
    using \<Lambda>_ge_0 \<Lambda>_le_1 by simp

  have "S \<subseteq> range enum_verts"
    using assms(1) enum_verts unfolding bij_betw_def by simp
  moreover have "inj enum_verts"
    using bij_betw_imp_inj_on[OF enum_verts] by simp
  ultimately have \<mu>_alt: "\<mu> = real (card (enum_verts -` S)) / CARD ('n)"
    unfolding \<mu>_def card by (subst card_vimage_inj) auto

  have "?L = measure (pmf_of_multiset (walks G l)) {w. \<forall>i<l. w ! i \<in> T i}"
    using walks_nonempty set_walks_3 unfolding T_def set_nths
    by (intro measure_eq_AE AE_pmfI) auto
  also have "... = foldl (\<lambda>x M. M *v x) stat
    (intersperse A (map (\<lambda>i. (if i \<in> I then ind_mat S else mat 1)) [0..<l])) \<bullet> 1"
    unfolding walk_distr T_def by (simp add:if_distrib if_distribR 0 cong:if_cong)
  also have "... \<le> ?R"
    unfolding \<mu>_alt ind_mat_def
    by (intro hitting_property_alg_2[OF \<Lambda>_range assms(2) spec_bound markov])
  finally show ?thesis by simp
qed

lemma uniform_property:
  assumes  "i < l" "x \<in> verts G"
  shows "measure (pmf_of_multiset (walks G l)) {w. w ! i = x} = 1/real (card (verts G))"
    (is "?L = ?R")
proof -
  obtain xi where xi_def: "enum_verts xi = x"
    using assms(2) bij_betw_imp_surj_on[OF enum_verts] by force

  define T where "T = (\<lambda>j. if j = i then {x} else UNIV)"

  have "diag (ind_vec UNIV) = mat 1"
    unfolding diag_def ind_vec_def Finite_Cartesian_Product.mat_def by vector
  moreover have "enum_verts -` {x} = {xi}"
    using bij_betw_imp_inj_on[OF enum_verts]
    unfolding vimage_def xi_def[symmetric] by (auto simp add:inj_on_def)
  ultimately have 0: "ind_mat (T j) = (if j = i then diag (ind_vec {xi}) else mat 1)" for j
    unfolding T_def ind_mat_def by (cases "j = i", auto)

  have "?L = measure (pmf_of_multiset (walks G l)) {w. \<forall>j < l. w ! j \<in> T j}"
    unfolding T_def using assms(1) by simp
  also have "... = foldl (\<lambda>x M. M *v x) stat (intersperse A (map (\<lambda>j. ind_mat (T j)) [0..<l])) \<bullet> 1"
    unfolding walk_distr by simp
  also have "... = 1/CARD('n)"
    unfolding 0 uniform_property_alg[OF assms(1) markov] by simp
  also have "... = ?R"
    unfolding card by simp
  finally show ?thesis  by simp
qed

end

context regular_graph
begin

lemmas expansionD3 =
  regular_graph_tts.expansionD3[OF eg_tts_1,
    internalize_sort "'n :: finite", OF _ regular_graph_axioms,
    unfolded remove_finite_premise, cancel_type_definition, OF verts_non_empty]

lemmas g_step_remains_orth =
  regular_graph_tts.g_step_remains_orth[OF eg_tts_1,
    internalize_sort "'n :: finite", OF _ regular_graph_axioms,
    unfolded remove_finite_premise, cancel_type_definition, OF verts_non_empty]

lemmas hitting_property =
  regular_graph_tts.hitting_property[OF eg_tts_1,
    internalize_sort "'n :: finite", OF _ regular_graph_axioms,
    unfolded remove_finite_premise, cancel_type_definition, OF verts_non_empty]

lemmas uniform_property_2 =
  regular_graph_tts.uniform_property[OF eg_tts_1,
    internalize_sort "'n :: finite", OF _ regular_graph_axioms,
    unfolded remove_finite_premise, cancel_type_definition, OF verts_non_empty]

theorem uniform_property:
  assumes "i < l"
  shows "map_pmf (\<lambda>w. w ! i) (pmf_of_multiset (walks G l)) = pmf_of_set (verts G)" (is "?L = ?R")
proof (rule pmf_eqI)
  fix x :: "'a"
  have a:"measure (pmf_of_multiset (walks G l)) {w. w ! i = x} = 0" (is "?L1 = ?R1")
    if "x \<notin> verts G"
  proof -
    have "?L1 \<le> measure (pmf_of_multiset (walks G l)) {w. set w \<subseteq> verts G \<and> x \<in> set w}"
      using walks_nonempty set_walks_3 assms(1)
      by (intro measure_pmf.pmf_mono[OF refl]) auto
    also have "... \<le> measure (pmf_of_multiset (walks G l)) {}"
      using that by (intro measure_pmf.pmf_mono[OF refl]) auto
    also have "... = 0" by simp
    finally have "?L1 \<le> 0" by simp
    thus ?thesis using measure_le_0_iff by blast
  qed

  have "pmf ?L x = measure (pmf_of_multiset (walks G l)) {w. w ! i = x}"
    unfolding pmf_map by (simp add:vimage_def)
  also have "... = indicator (verts G) x/real (card (verts G))"
    using uniform_property_2[OF assms(1)] a
    by (cases "x \<in> verts G", auto)
  also have "... = pmf ?R x"
    using verts_non_empty by (intro pmf_of_set[symmetric]) auto
  finally show "pmf ?L x = pmf ?R x" by simp
qed

lemma uniform_property_gen:
  fixes S :: "'a set"
  assumes "S \<subseteq> verts G" "i < l"
  defines "\<mu> \<equiv> real (card S) / card (verts G)"
  shows "measure (pmf_of_multiset (walks G l)) {w. w ! i \<in> S} = \<mu>" (is "?L = ?R")
proof -

  have "?L = measure (map_pmf (\<lambda>w. w ! i) (pmf_of_multiset (walks G l))) S"
    unfolding measure_map_pmf by (simp add:vimage_def)
  also have "... = measure (pmf_of_set (verts G)) S"
    unfolding uniform_property[OF assms(2)] by simp
  also have "... = ?R"
    using verts_non_empty Int_absorb1[OF assms(1)]
    unfolding \<mu>_def by (subst measure_pmf_of_set) auto
  finally show ?thesis by simp
qed

theorem kl_chernoff_property:
  assumes "l > 0"
  assumes "S \<subseteq> verts G"
  defines "\<mu> \<equiv> real (card S) / card (verts G)"
  assumes "\<gamma> \<le> 1" "\<mu> + \<Lambda>\<^sub>a * (1-\<mu>) \<in> {0<..\<gamma>}"
  shows "measure (pmf_of_multiset (walks G l)) {w. real (card {i \<in> {..<l}. w ! i \<in> S}) \<ge> \<gamma>*l}
    \<le> exp (- real l * KL_div \<gamma> (\<mu>+\<Lambda>\<^sub>a*(1-\<mu>)))" (is "?L \<le> ?R")
proof -
  let ?\<delta> = "(\<Sum>i<l. \<mu>+\<Lambda>\<^sub>a*(1-\<mu>))/l"

  have a: "measure (pmf_of_multiset (walks G l)) {w. \<forall>i\<in>T. w ! i \<in> S} \<le> (\<mu> + \<Lambda>\<^sub>a*(1-\<mu>)) ^ card T"
    (is "?L1 \<le> ?R1") if "T \<subseteq> {..<l}" for T
  proof -
    have "?L1 = measure (pmf_of_multiset (walks G l)) {w. set (nths w T) \<subseteq> S}"
      unfolding set_nths setcompr_eq_image using that set_walks_3 walks_nonempty
      by (intro measure_eq_AE AE_pmfI) (auto simp add:image_subset_iff)
    also have "... \<le> ?R1"
      unfolding \<mu>_def by (intro hitting_property[OF assms(2) that])
    finally show ?thesis by simp
  qed

  have "?L \<le> exp ( - real l * KL_div \<gamma> ?\<delta>)"
    using assms(1,4,5) a by (intro impagliazzo_kabanets_pmf) simp_all
  also have "... = ?R" by simp
  finally show ?thesis by simp
qed

end

unbundle no_intro_cong_syntax

end


header {* \isaheader{Maps from Naturals by Arrays} *}
theory ArrayMapImpl
imports
  "../spec/MapSpec"
  "../gen_algo/MapGA"
  "../../Lib/Diff_Array"
begin
  text_raw {*\label{thy:ArrayMapImpl}*}

(*@impl Map
  @type 'v iam
  @abbrv iam,im
  Maps of natural numbers implemented by arrays.
*)

  type_synonym 'v iam = "'v option array"

  subsection {* Definitions *}
  definition iam_\<alpha> :: "'v iam \<Rightarrow> nat \<rightharpoonup> 'v" where
    "iam_\<alpha> a i \<equiv> if i < array_length a then array_get a i else None"

  abbreviation (input) iam_invar :: "'v iam \<Rightarrow> bool"
    where "iam_invar \<equiv> \<lambda>_. True"

  definition iam_empty :: "unit \<Rightarrow> 'v iam"
    where "iam_empty \<equiv> \<lambda>_::unit. array_of_list []"

  definition iam_lookup :: "nat \<Rightarrow> 'v iam \<rightharpoonup> 'v"
    where [code_unfold]: "iam_lookup k a \<equiv> iam_\<alpha> a k"

  definition "iam_increment (l::nat) idx \<equiv>
    max (idx + 1 - l) (2 * l + 3)"

  lemma incr_correct: "\<not> idx < l \<Longrightarrow> idx < l + iam_increment l idx"
    unfolding iam_increment_def by auto

  definition iam_update :: "nat \<Rightarrow> 'v \<Rightarrow> 'v iam \<Rightarrow> 'v iam"
    where "iam_update k v a \<equiv> let
    l = array_length a;
    a = if k < l then a else array_grow a (iam_increment l k) None
  in
    array_set a k (Some v)
    "

  lemma [code]: "iam_update k v a \<equiv> array_set_oo
    (\<lambda>_. array_set
           (array_grow a (iam_increment (array_length a) k) None) k (Some v))
    a k (Some v)
    "
    unfolding iam_update_def array_set_oo_def
    apply (rule eq_reflection)
    apply (auto simp add: Let_def)
    done

  definition "iam_update_dj \<equiv> iam_update"

  definition iam_delete :: "nat \<Rightarrow> 'v iam \<Rightarrow> 'v iam"
    where "iam_delete k a \<equiv>
    if k<array_length a then array_set a k None else a"

  lemma [code]: "iam_delete k a \<equiv> array_set_oo (\<lambda>_. a) a k None"
    unfolding iam_delete_def array_set_oo_def by auto

  fun iam_rev_iterateoi_aux
    :: "nat \<Rightarrow> ('v iam) \<Rightarrow> ('\<sigma>\<Rightarrow>bool) \<Rightarrow> (nat \<times> 'v\<Rightarrow>'\<sigma>\<Rightarrow>'\<sigma>) \<Rightarrow> '\<sigma> \<Rightarrow> '\<sigma>"
    where
      "iam_rev_iterateoi_aux 0 a c f \<sigma> = \<sigma>"
    | "iam_rev_iterateoi_aux i a c f \<sigma> = (
        if c \<sigma> then
          iam_rev_iterateoi_aux (i - 1) a c f (
            case array_get a (i - 1) of None \<Rightarrow> \<sigma> | Some x \<Rightarrow> f (i - 1, x) \<sigma>
          )
        else \<sigma>)"

  definition iam_rev_iterateoi :: "'v iam \<Rightarrow> (nat \<times> 'v,'\<sigma>) set_iterator" where
    "iam_rev_iterateoi a \<equiv> iam_rev_iterateoi_aux (array_length a) a"

  function iam_iterateoi_aux
    :: "nat \<Rightarrow> nat \<Rightarrow> ('v iam) \<Rightarrow> ('\<sigma>\<Rightarrow>bool) \<Rightarrow> (nat \<times> 'v\<Rightarrow>'\<sigma>\<Rightarrow>'\<sigma>) \<Rightarrow> '\<sigma> \<Rightarrow> '\<sigma>"
    where
      "iam_iterateoi_aux i len a c f \<sigma> =
        (if i \<ge> len \<or> \<not> c \<sigma> then \<sigma> else let
            \<sigma>' = (case array_get a i of
              None \<Rightarrow> \<sigma>
            | Some x \<Rightarrow> f (i,x) \<sigma>)
          in iam_iterateoi_aux (i + 1) len a c f \<sigma>')"
    by pat_completeness auto
  termination
    by (relation "measure (\<lambda>(i,l,_). l - i)") auto

  declare iam_iterateoi_aux.simps[simp del]

  lemma iam_iterateoi_aux_csimps:
    "i \<ge> len \<Longrightarrow> iam_iterateoi_aux i len a c f \<sigma> = \<sigma>"
    "\<not> c \<sigma> \<Longrightarrow> iam_iterateoi_aux i len a c f \<sigma> = \<sigma>"
    "\<lbrakk> i< len; c \<sigma> \<rbrakk> \<Longrightarrow> iam_iterateoi_aux i len a c f \<sigma> =
      (case array_get a i of
        None \<Rightarrow> iam_iterateoi_aux (i + 1) len a c f \<sigma>
      | Some x \<Rightarrow> iam_iterateoi_aux (i + 1) len a c f (f (i,x) \<sigma>))"
    apply (subst iam_iterateoi_aux.simps, simp)
    apply (subst iam_iterateoi_aux.simps, simp)
    apply (subst iam_iterateoi_aux.simps)
    apply (auto split: option.split_asm option.split)
    done

  definition iam_iterateoi :: "'v iam \<Rightarrow> (nat \<times> 'v,'\<sigma>) set_iterator" where
    "iam_iterateoi a = iam_iterateoi_aux 0 (array_length a) a"

  lemma iam_empty_impl: "map_empty iam_\<alpha> iam_invar iam_empty"
    apply unfold_locales
    unfolding iam_\<alpha>_def[abs_def] iam_empty_def
    by auto

  lemma iam_lookup_impl: "map_lookup iam_\<alpha> iam_invar iam_lookup"
    apply unfold_locales
    unfolding iam_\<alpha>_def[abs_def] iam_lookup_def
    by auto

  lemma array_get_set_iff: "i<array_length a \<Longrightarrow>
    array_get (array_set a i x) j = (if i=j then x else array_get a j)"
    by (auto simp: array_get_array_set_other)

  lemma iam_update_impl: "map_update iam_\<alpha> iam_invar iam_update"
    apply unfold_locales
    unfolding iam_\<alpha>_def[abs_def] iam_update_def
    apply (rule ext)
    apply (auto simp: Let_def array_get_set_iff incr_correct)
    done

  lemma iam_update_dj_impl: "map_update_dj iam_\<alpha> iam_invar iam_update_dj"
    apply (unfold iam_update_dj_def)
    apply (rule update_dj_by_update)
    apply (rule iam_update_impl)
    done

  lemma iam_delete_impl: "map_delete iam_\<alpha> iam_invar iam_delete"
    apply unfold_locales
    unfolding iam_\<alpha>_def[abs_def] iam_delete_def
    apply (rule ext)
    apply (auto simp: Let_def array_get_set_iff)
    done

  lemma iam_rev_iterateoi_aux_foldli_conv :
    "iam_rev_iterateoi_aux n a =
     foldli (List.map_filter (\<lambda>n. map_option (\<lambda>v. (n, v)) (array_get a n)) (rev [0..<n]))"
  by (induct n) (auto simp add: List.map_filter_def fun_eq_iff)

  lemma iam_rev_iterateoi_foldli_conv :
    "iam_rev_iterateoi a =
     foldli (List.map_filter
       (\<lambda>n. map_option (\<lambda>v. (n, v)) (array_get a n))
       (rev [0..<(array_length a)]))"
    unfolding iam_rev_iterateoi_def iam_rev_iterateoi_aux_foldli_conv by simp

  lemma iam_rev_iterateoi_correct :
  fixes m::"'a option array"
  defines "kvs \<equiv> List.map_filter
    (\<lambda>n. map_option (\<lambda>v. (n, v)) (array_get m n)) (rev [0..<(array_length m)])"
  shows "map_iterator_rev_linord (iam_rev_iterateoi m) (iam_\<alpha> m)"
  proof (rule map_iterator_rev_linord_I [of kvs])
    show "iam_rev_iterateoi m = foldli kvs"
      unfolding iam_rev_iterateoi_foldli_conv kvs_def by simp
  next
    def al \<equiv> "array_length m"
    show dist_kvs: "distinct (map fst kvs)" and "sorted (rev (map fst kvs))"
      unfolding kvs_def al_def[symmetric]
      apply (induct al)
      apply (simp_all
        add: List.map_filter_simps set_map_filter image_iff sorted_append
        split: option.split)
    done

    from dist_kvs
    have "\<And>i. map_of kvs i = iam_\<alpha> m i"
      unfolding kvs_def
      apply (case_tac "array_get m i")
      apply (simp_all
        add: iam_\<alpha>_def map_of_eq_None_iff set_map_filter image_iff)
    done
    thus "iam_\<alpha> m = map_of kvs" by auto
  qed

  lemma iam_rev_iterateoi_impl:
    "poly_map_rev_iterateoi iam_\<alpha> iam_invar iam_rev_iterateoi"
    apply unfold_locales
    apply (simp add: iam_\<alpha>_def[abs_def] dom_def)
    apply (simp add: iam_rev_iterateoi_correct)
    done

  lemma iam_iteratei_impl:
    "poly_map_iteratei iam_\<alpha> iam_invar iam_rev_iterateoi"
  proof -
    interpret aux!: poly_map_rev_iterateoi iam_\<alpha> iam_invar iam_rev_iterateoi
      by (rule iam_rev_iterateoi_impl)

    show ?thesis
      apply unfold_locales
      apply (rule map_rev_iterator_linord_is_it)
      by (rule aux.list_rev_it_correct)
  qed

  lemma iam_iterateoi_aux_foldli_conv :
    "iam_iterateoi_aux n (array_length a) a c f \<sigma> =
     foldli (List.map_filter (\<lambda>n. map_option (\<lambda>v. (n, v)) (array_get a n))
       ([n..<array_length a])) c f \<sigma>"
    thm iam_iterateoi_aux.induct
    apply (induct n "array_length a" a c f \<sigma> rule: iam_iterateoi_aux.induct)
    apply (subst iam_iterateoi_aux.simps)
    apply (auto split: option.split simp: map_filter_simps)
    apply (subst (2) upt_conv_Cons)
    apply simp
    apply (simp add: map_filter_simps)
    apply (subst (2) upt_conv_Cons)
    apply simp
    apply (simp add: map_filter_simps)
    done

  lemma iam_iterateoi_foldli_conv :
    "iam_iterateoi a =
     foldli (List.map_filter
       (\<lambda>n. map_option (\<lambda>v. (n, v)) (array_get a n))
       ([0..<(array_length a)]))"
    apply (intro ext)
    unfolding iam_iterateoi_def iam_iterateoi_aux_foldli_conv
    by simp

  (* TODO: Move to Misc *)
  lemmas [simp] = map_filter_simps
  lemma map_filter_append[simp]: "List.map_filter f (la@lb)
    = List.map_filter f la @ List.map_filter f lb"
    by (induct la) (auto split: option.split)

  lemma iam_iterateoi_correct:
  fixes m::"'a option array"
  defines "kvs \<equiv> List.map_filter
    (\<lambda>n. map_option (\<lambda>v. (n, v)) (array_get m n)) ([0..<(array_length m)])"
  shows "map_iterator_linord (iam_iterateoi m) (iam_\<alpha> m)"
  proof (rule map_iterator_linord_I [of kvs])
    show "iam_iterateoi m = foldli kvs"
      unfolding iam_iterateoi_foldli_conv kvs_def by simp
  next
    def al \<equiv> "array_length m::nat"
    show dist_kvs: "distinct (map fst kvs)" and "sorted (map fst kvs)"
      unfolding kvs_def al_def[symmetric]
      apply (induct al)
      apply (simp_all
        add: set_map_filter image_iff sorted_append
        split: option.split)
    done

    from dist_kvs
    have "\<And>i. map_of kvs i = iam_\<alpha> m i"
      unfolding kvs_def
      apply (case_tac "array_get m i")
      apply (simp_all
        add: iam_\<alpha>_def map_of_eq_None_iff set_map_filter image_iff)
    done
    thus "iam_\<alpha> m = map_of kvs" by auto
  qed

  lemma iam_iterateoi_impl:
    "poly_map_iterateoi iam_\<alpha> iam_invar iam_iterateoi"
    apply unfold_locales
    apply (simp add: iam_\<alpha>_def[abs_def] dom_def)
    apply (simp add: iam_iterateoi_correct)
    done

  definition iam_basic_ops :: "(nat,'a,'a iam) omap_basic_ops"
    where [icf_rec_def]: "iam_basic_ops \<equiv> \<lparr>
    bmap_op_\<alpha> = iam_\<alpha>,
    bmap_op_invar = \<lambda>_. True,
    bmap_op_empty = iam_empty,
    bmap_op_lookup = iam_lookup,
    bmap_op_update = iam_update,
    bmap_op_update_dj = iam_update_dj,
    bmap_op_delete = iam_delete,
    bmap_op_list_it = iam_rev_iterateoi,
    bmap_op_ordered_list_it = iam_iterateoi,
    bmap_op_rev_list_it = iam_rev_iterateoi
    \<rparr>"

  setup Locale_Code.open_block
  interpretation iam_basic!: StdBasicOMap iam_basic_ops
    apply (rule StdBasicOMap.intro)
    apply (rule StdBasicMap.intro)
    apply (simp_all add: icf_rec_unf)
    apply (rule iam_empty_impl iam_lookup_impl iam_update_impl
      iam_update_dj_impl iam_delete_impl iam_iteratei_impl
      iam_iterateoi_impl iam_rev_iterateoi_impl)+
    done
  setup Locale_Code.close_block

  definition [icf_rec_def]: "iam_ops \<equiv> iam_basic.dflt_oops"

  setup Locale_Code.open_block
  interpretation iam!: StdOMap iam_ops
    unfolding iam_ops_def
    by (rule iam_basic.dflt_oops_impl)
  interpretation iam!: StdMap_no_invar iam_ops
    by unfold_locales (simp add: icf_rec_unf)
  setup Locale_Code.close_block
  setup {* ICF_Tools.revert_abbrevs "iam"*}

  lemma pi_iam[proper_it]:
    "proper_it' iam_iterateoi iam_iterateoi"
    apply (rule proper_it'I)
    unfolding iam_iterateoi_foldli_conv
    by (rule icf_proper_iteratorI)

  lemma pi_iam_rev[proper_it]:
    "proper_it' iam_rev_iterateoi iam_rev_iterateoi"
    apply (rule proper_it'I)
    unfolding iam_rev_iterateoi_foldli_conv
    by (rule icf_proper_iteratorI)

  interpretation pi_iam: proper_it_loc iam_iterateoi iam_iterateoi
    apply unfold_locales by (rule pi_iam)

  interpretation pi_iam_rev: proper_it_loc iam_rev_iterateoi iam_rev_iterateoi
    apply unfold_locales by (rule pi_iam_rev)

text {* Code generator test *}
definition "test_codegen \<equiv> (
  iam.add ,
  iam.add_dj ,
  iam.ball ,
  iam.bex ,
  iam.delete ,
  iam.empty ,
  iam.isEmpty ,
  iam.isSng ,
  iam.iterate ,
  iam.iteratei ,
  iam.iterateo ,
  iam.iterateoi ,
  iam.list_it ,
  iam.lookup ,
  iam.max ,
  iam.min ,
  iam.restrict ,
  iam.rev_iterateo ,
  iam.rev_iterateoi ,
  iam.rev_list_it ,
  iam.reverse_iterateo ,
  iam.reverse_iterateoi ,
  iam.sel ,
  iam.size ,
  iam.size_abort ,
  iam.sng ,
  iam.to_list ,
  iam.to_map ,
  iam.to_rev_list ,
  iam.to_sorted_list ,
  iam.update ,
  iam.update_dj)"

export_code test_codegen in SML

end


subsection \<open> Evaluating ITrees \<close>

theory ITree_Eval
  imports Interaction_Trees
begin

text \<open> The following type encodes the possible results obtained from a given event trace. \<close>

datatype ('e, 'r) itres =
  VisR "'e set" \<comment> \<open> Accept trace, present a choice \<close>
  | RetR 'r \<comment> \<open> Accept trace, return a value \<close>
  | RejR \<comment> \<open> Reject trace \<close>

text \<open> The next function allows to calculate the result of a given trace. The number of permitted
  internal events is bounded to ensure that the function terminates. \<close>

fun trres' :: "'e list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ('e, 's) itree \<Rightarrow> ('e, 's) itres" where
"trres' tr n mx (Ret x) = RetR x" |
"trres' tr (Suc n) mx (Sil P) = trres' tr n mx P" |
"trres' tr 0 mx (Sil P) = RejR" |
"trres' (e # tr) n mx (Vis F) = (if e \<in> pdom F then trres' tr mx mx (F e) else RejR)" |
"trres' [] n mx (Vis F) = VisR (pdom F)"

abbreviation "trres tr n P \<equiv> trres' tr n n P"

lemma trres_Sils:
  "m \<le> n \<Longrightarrow> trres tr n (Sils m P) = trres' tr (n - m) n P"
  by (induct m arbitrary: n tr P, auto)
     (metis Sils_Sil_shift Suc_diff_le Suc_leD Suc_le_D diff_Suc_Suc trres'.simps(2))

text \<open> We fix this as a constant, which can be instantiated later. \<close>

consts MAX_SIL_STEPS :: nat

definition "after_tr P tr = trres tr MAX_SIL_STEPS P"

definition "has_tr P tr = (trres tr MAX_SIL_STEPS P \<noteq> RejR)"

end


(*  Title:       Proving the Correctness of Disk Paxos

    Author:      Mauro J. Jaskelioff, Stephan Merz, 2005
    Maintainer:  Mauro J. Jaskelioff <mauro at fceia.unr.edu.ar>
*)

theory DiskPaxos imports DiskPaxos_Invariant begin

subsection {* Inner Module *}

record
Istate =
  iinput :: "Proc \<Rightarrow> InputsOrNi"
  ioutput :: "Proc \<Rightarrow> InputsOrNi"
  ichosen :: InputsOrNi
  iallInput :: "InputsOrNi set"

definition IInit :: "Istate \<Rightarrow> bool"
where
  "IInit s =  (range (iinput s) \<subseteq> Inputs
             \<and> ioutput s = (\<lambda>p. NotAnInput)
             \<and> ichosen s = NotAnInput
             \<and> iallInput s = range (iinput s))"

definition IChoose :: "Istate \<Rightarrow> Istate \<Rightarrow> Proc \<Rightarrow> bool"
where
  "IChoose s s' p = (ioutput s p = NotAnInput
                   \<and> (if (ichosen s = NotAnInput)
                        then (\<exists>ip \<in> iallInput s.  ichosen s' = ip
                                            \<and> ioutput s' = (ioutput s) (p := ip))
                        else (  ioutput s' = (ioutput s) (p:= ichosen s)
                               \<and> ichosen s' = ichosen s))
                    \<and> iinput s' = iinput s \<and> iallInput s'= iallInput s)"

definition IFail :: "Istate \<Rightarrow> Istate \<Rightarrow> Proc \<Rightarrow> bool"
where
  "IFail s s' p =   (ioutput s' = (ioutput s) (p:= NotAnInput)
                  \<and> (\<exists>ip \<in> Inputs.  iinput s' = (iinput s)(p:= ip)
                                   \<and> iallInput s' = iallInput s \<union> {ip})
                  \<and> ichosen s' = ichosen s)"

definition INext :: "Istate \<Rightarrow> Istate \<Rightarrow> bool"
  where "INext s s' = (\<exists>p. IChoose s s' p \<or> IFail s s' p)"

definition s2is :: "state \<Rightarrow> Istate"
where
  "s2is s = \<lparr>iinput = inpt s,
             ioutput = outpt s,
             ichosen=chosen s,
             iallInput = allInput s\<rparr>"

theorem R1:
  "\<lbrakk> HInit s; is = s2is s\<rbrakk> \<Longrightarrow> IInit is"
  by(auto simp add: HInit_def IInit_def s2is_def Init_def)

theorem R2b:
  assumes inv: "HInv s"
  and inv': "HInv s'"
  and nxt: "HNext s s'"
  and srel: "is=s2is s \<and> is'=s2is s'"
  shows "(\<exists>p. IFail is is' p \<or> IChoose is is' p) \<or> is = is'"
proof(auto)
  assume chg_vars: "is\<noteq>is'"
  with srel
  have s_change: "   inpt s \<noteq> inpt s' \<or> outpt s \<noteq> outpt s'
                  \<or> chosen s \<noteq> chosen s' \<or> allInput s \<noteq> allInput s'"
    by(auto simp add: s2is_def)
  from inv
  have inv2c5: "\<forall>p.   inpt s p \<in> allInput s
                    \<and> (chosen s = NotAnInput \<longrightarrow> outpt s p = NotAnInput)"
    by(auto simp add: HInv_def HInv2_def Inv2c_def Inv2c_inner_def)
  from nxt s_change inv2c5
  have "inpt s' \<noteq> inpt s \<or> outpt s' \<noteq> outpt s"
    by(auto simp add: HNext_def Next_def HNextPart_def)
  with nxt
  have "\<exists>p. Fail s s' p \<or> EndPhase2 s s' p"
    by(auto simp add: HNext_def Next_def
      StartBallot_def Phase0Read_def Phase1or2Write_def
      Phase1or2Read_def Phase1or2ReadThen_def Phase1or2ReadElse_def
      EndPhase1or2_def EndPhase1_def EndPhase0_def)
  then obtain p where fail_or_endphase2: "Fail s s' p \<or> EndPhase2 s s' p"
    by auto
  from inv
  have inv2c: "Inv2c_inner s p"
    by(auto simp add: HInv_def HInv2_def Inv2c_def)
  from fail_or_endphase2 have "IFail is is' p \<or> IChoose is is' p"
  proof
    assume fail: "Fail s s' p "
    hence phase': "phase s' p = 0"
      and  outpt: "outpt s' = (outpt s) (p:= NotAnInput)"
      by(auto simp add: Fail_def)
    have "IFail is is' p"
    proof -
      from fail srel
      have "ioutput is' = (ioutput is) (p:= NotAnInput)"
        by(auto simp add: Fail_def s2is_def)
      moreover
      from nxt
      have all_nxt: "allInput s'= allInput s \<union> (range (inpt s'))"
        by(auto simp add: HNext_def HNextPart_def)
      from fail srel
      have "\<exists>ip \<in> Inputs.  iinput is' = (iinput is)(p:= ip)"
        by(auto simp add: Fail_def s2is_def)
      then obtain ip where ip_Input: "ip\<in>Inputs" and "iinput is' = (iinput is)(p:= ip)"
        by auto
      with inv2c5 srel all_nxt
      have "  iinput is' = (iinput is)(p:= ip)
        \<and> iallInput is' = iallInput is \<union> {ip}"
        by(auto simp add: s2is_def)
      moreover
      from outpt srel nxt inv2c
      have "ichosen is' = ichosen is"
        by(auto simp add: HNext_def HNextPart_def s2is_def Inv2c_inner_def)
      ultimately
      show ?thesis
        using ip_Input
        by(auto simp add: IFail_def)
    qed
    thus ?thesis
      by auto
  next
    assume endphase2: "EndPhase2 s s' p"
    from endphase2
    have "phase s p =2"
      by(auto simp add: EndPhase2_def)
    with inv2c Ballot_nzero
    have bal_dblk_nzero: "bal(dblock s p)\<noteq> 0"
      by(auto simp add: Inv2c_inner_def)
    moreover
    from inv
    have inv2a_dblock: "Inv2a_innermost s p (dblock s p)"
      by(auto simp add: HInv_def HInv2_def Inv2a_def Inv2a_inner_def blocksOf_def)
    ultimately
    have p22: "inp (dblock s p) \<in> allInput s"
      by(auto simp add: Inv2a_innermost_def)
    from inv
    have "allInput s \<subseteq> Inputs"
      by(auto simp add: HInv_def HInv1_def)
    with p22 NotAnInput endphase2
    have outpt_nni: "outpt s' p \<noteq> NotAnInput"
      by(auto simp add: EndPhase2_def)
    show ?thesis
    proof(cases "chosen s = NotAnInput")
      case True
      with inv2c5
      have p31: "\<forall>q. outpt s q = NotAnInput"
        by auto
      with endphase2
      have p32: "\<forall>q \<in> UNIV -{p}. outpt s' q = NotAnInput"
        by(auto simp add: EndPhase2_def)
      hence some_eq: "(\<And>x. outpt s' x \<noteq> NotAnInput \<Longrightarrow> x = p)"
        by auto
      from p32 True nxt some_equality[of "\<lambda>p. outpt s' p \<noteq> NotAnInput", OF outpt_nni some_eq]
      have p33: "chosen s' = outpt s' p"
        by(auto simp add: HNext_def HNextPart_def)
      with endphase2
      have "chosen s' = inp(dblock s p) \<and> outpt s' = (outpt s)(p:=inp(dblock s p))"
        by(auto simp add: EndPhase2_def)
      with True p22
      have "if (chosen s = NotAnInput)
                        then (\<exists>ip \<in> allInput s.  chosen s' = ip
                                            \<and> outpt s' = (outpt s) (p := ip))
                        else (  outpt s' = (outpt s) (p:= chosen s)
                               \<and> chosen s' = chosen s)"
        by auto
      moreover
      from endphase2 inv2c5 nxt
      have "inpt s' = inpt s \<and> allInput s'= allInput s"
        by(auto simp add: EndPhase2_def HNext_def HNextPart_def)
      ultimately
      show ?thesis
        using srel p31
        by(auto simp add: IChoose_def s2is_def)
    next
      case False
      with nxt
      have p31: "chosen s' = chosen s"
        by(auto simp add: HNext_def HNextPart_def)
      from inv'
      have inv6: "HInv6 s'"
        by(auto simp add: HInv_def)
      have p32: "outpt s' p = chosen s"
      proof-
        from endphase2
        have "outpt s' p  = inp(dblock s p)"
          by(auto simp add: EndPhase2_def)
        moreover
        from inv6 p31
        have "outpt s' p \<in> {chosen s, NotAnInput}"
          by(auto simp add: HInv6_def)
        ultimately
        show ?thesis
          using outpt_nni
          by auto
      qed
      from srel False
      have "IChoose is is' p"
      proof(clarsimp simp add: IChoose_def s2is_def)
        from endphase2 inv2c
        have "outpt s p = NotAnInput"
          by(auto simp add: EndPhase2_def Inv2c_inner_def)
        moreover
        from endphase2 p31 p32 False
        have "outpt s' = (outpt s) (p:= chosen s) \<and> chosen s' = chosen s"
          by(auto simp add: EndPhase2_def)
        moreover
        from endphase2 nxt inv2c5
        have "inpt s' = inpt s \<and> allInput s'= allInput s"
          by(auto simp add: EndPhase2_def HNext_def HNextPart_def)
        ultimately
        show "  outpt s p = NotAnInput
              \<and> outpt s' = (outpt s)(p := chosen s) \<and> chosen s' = chosen s
              \<and> inpt s' = inpt s \<and> allInput s' = allInput s"
          by auto
      qed
      thus ?thesis
        by auto
    qed
  qed
  thus "\<exists>p. IFail is is' p \<or> IChoose is is' p"
    by auto
qed

end


theory RRC
imports OpSem
begin

datatype PC =
  L1
| L2
| L3

consts t1 :: T
consts t2 :: T
consts t3 :: T
consts t4 :: T
consts x :: L

definition "thrdsvars \<equiv>  t1 \<noteq> t2 \<and>
                         t1 \<noteq> t3 \<and>
                         t1 \<noteq> t4 \<and>
                         t2 \<noteq> t3 \<and>
                         t2 \<noteq> t4 \<and>
                         t3 \<noteq> t4"

record mp_state =
  pc :: "T \<Rightarrow> PC"
  state :: surrey_state
  a :: V
  b :: V
  c :: V
  d :: V

definition
  "update_pc t nv pcf \<equiv> pcf (t := nv)"

definition
  "locals_id s s' \<equiv> a s = a s' \<and> b s = b s' \<and> c s = c s' \<and> d s = d s'"

lemmas mp_simps [simp] =
  locals_id_def
  update_pc_def
  thrdsvars_def

definition prog :: "T \<Rightarrow>  mp_state \<Rightarrow> mp_state \<Rightarrow> bool " where
"prog t s s' \<equiv>
(
if t = t1
then
  if (pc s) t = L1
    then
      pc s = update_pc t L2 (pc s) \<and>
      ((state s) [x := 1]\<^sub>t (state s')) \<and>
      locals_id s s'
  else
    False
else
if t = t2
then
  if (pc s) t = L1
    then
      pc s' = update_pc t L2 (pc s) \<and>
      ((state s) [x := 2]\<^sub>t (state s')) \<and>
      locals_id s s'
  else
    False
else
if t = t3
then
  if (pc s) t = L1
    then
      pc s' = update_pc t L2 (pc s) \<and>
      (state s) [a s' \<leftarrow> x]\<^sub>t (state s')  \<and>
      b s' = b s \<and> c s' = c s \<and> d s' = d s
  else
  if (pc s) t = L2
    then
      pc s' = update_pc t L3 (pc s) \<and>
      (state s) [b s' \<leftarrow> x]\<^sub>t (state s') \<and>
      a s' = a s \<and> c s' = c s \<and> d s' = d s
  else
    False
else
if t = t4
then
  if (pc s) t = L1
    then
      pc s' = update_pc t L2 (pc s) \<and>
      (state s) [c s' \<leftarrow> x]\<^sub>t (state s') \<and>
      a s' = a s \<and> b s' = b s \<and> d s' = d s
  else
  if (pc s) t = L2
    then
      pc s' = update_pc t L3 (pc s) \<and>
      (state s) [d s' \<leftarrow> x]\<^sub>t (state s') \<and>
      a s' = a s \<and> b s' = b s \<and> c s' = c s
  else
    False
else
  False
)"

definition prog_inv :: "T \<Rightarrow> PC \<Rightarrow> mp_state \<Rightarrow> bool " where
"prog_inv t p s \<equiv>
  if t = t1
  then
    (case p of
          L1 \<Rightarrow> [\<zero>\<^sub>x 1]\<^sub>0 (state s) \<and> [\<one>\<^sub>x 1] (state s)  \<comment> \<open>\<not> p_vorder (state s) 0 x 1\<close>
        | _ \<Rightarrow> True

    )
  else
    if t = t2 then
      (case p of
          L1 \<Rightarrow> [\<zero>\<^sub>x 2]\<^sub>0 (state s) \<and> [\<one>\<^sub>x 2] (state s)
        | _ \<Rightarrow> True
      )
  else
    if t = t3 then
      (case p of
          L1 \<Rightarrow> init_val (state s) x 0 \<and>  [\<one>\<^sub>x 1] (state s) \<and> [\<one>\<^sub>x 2] (state s)
        | L2 \<Rightarrow> init_val (state s) x 0 \<and> enc_t (state s) t x (a s) \<and>  (a s = 1 \<longrightarrow> [\<one>\<^sub>x (a s)] (state s)) \<and> [\<one>\<^sub>x 2] (state s)
        | L3 \<Rightarrow> (a s \<noteq> b s \<longrightarrow> [(a s) \<leadsto>\<^sub>x (b s)] (state s)) \<and>  (a s = 1 \<longrightarrow> [\<one>\<^sub>x (a s)] (state s)) \<and> (b s = 2 \<longrightarrow> [\<one>\<^sub>x (b s)] (state s))
      )
  else
    if t = t4 then
      (case p of
          L1 \<Rightarrow> init_val (state s) x 0 \<and>  [\<one>\<^sub>x 1] (state s) \<and> [\<one>\<^sub>x 2] (state s)
        | L2 \<Rightarrow> init_val (state s) x 0 \<and>  enc_t (state s) t x (c s) \<and>  (c s = 2 \<longrightarrow> [\<one>\<^sub>x (c s)] (state s)) \<and> [\<one>\<^sub>x 1] (state s)
        | L3 \<Rightarrow> (c s \<noteq> d s \<longrightarrow> [(c s) \<leadsto>\<^sub>x (d s)] (state s)) \<and>  (c s = 2 \<longrightarrow> [\<one>\<^sub>x (c s)] (state s)) \<and> (d s = 1 \<longrightarrow> [\<one>\<^sub>x (d s)] (state s))
      )
  else
    False
"

(*initial_state \<sigma> I*)
definition init_map  :: "(L \<Rightarrow> V) \<Rightarrow> bool" where
  "init_map \<phi> \<equiv> \<phi> x = 0"

definition init_s  :: "surrey_state  \<Rightarrow> bool"
  where
    "init_s ss \<equiv> \<exists> \<phi>. initial_state ss \<phi> \<and> init_map \<phi>"

definition init  :: "mp_state  \<Rightarrow> bool"
  where
    "init s \<equiv> (pc s) t1 = L1
      \<and> (pc s) t2 = L1 \<and> (pc s) t3 = L1 \<and> (pc s) t4 = L1  \<and>
      a s = 0  \<and> b s = 0  \<and> c s = 0 \<and> d s = 0
    \<and> init_s (state s) \<and> thrdsvars"

lemma init_inv : "init s \<Longrightarrow> thrdsvars \<Longrightarrow> prog_inv t1 L1 s \<and>
                                           prog_inv t2 L1 s \<and>
                                           prog_inv t3 L1 s \<and>
                                           prog_inv t4 L1 s"
  apply(intro conjI)
  apply(unfold init_def prog_inv_def thrdsvars_def init_val_def init_s_def writes_on_def)
  apply(simp_all add: value_def initial_state_def init_map_def init_val_def opsem_def)
  apply(unfold writes_on_def)
  by auto

lemma t1_local :
  assumes "prog_inv t1 ((pc s) t1) s"
  and "thrdsvars"
  and "prog t1 s s'"
shows  "prog_inv t1 ((pc s') t1) s'"
  using assms
  apply(simp add: prog_def)
  by (metis PC.distinct(1) fun_upd_same update_pc_def)

lemma t1_global :
  assumes "prog_inv t1 ((pc s) t1) s"
   and "t = t2 \<or> t = t3 \<or> t = t4"
   and "prog_inv t ((pc s) t) s"
  and "thrdsvars"
  and "prog t s s'"
shows  "prog_inv t1 ((pc s') t1) s'"
  using assms
  apply(elim disjE, simp)
  apply(unfold prog_inv_def prog_def thrdsvars_def  update_pc_def)
    apply(cases "pc s t2", auto)
  apply(cases "pc s t1", auto)
  apply (metis One_nat_def nat.inject no_val_WrX_diff_val_pres numeral_2_eq_2 zero_neq_one)
  apply (metis amo_Wr_diff_val_pres n_not_Suc_n numeral_2_eq_2)
  apply(cases "pc s t1", auto)
  apply(cases "pc s t3", auto)
  apply (metis RdX_def init_val_pres isRd.simps(1) no_val_def read_pres_not_p_vorder)
  using amo_intro_step no_val_def apply blast
  apply (metis RdX_def init_val_pres isRd.simps(1) no_val_def read_pres_not_p_vorder)
  using amo_intro_step no_val_def apply blast
  apply(cases "pc s t3", auto)+
  apply(cases "pc s t1", auto)
  apply(cases "pc s t4", auto)
  apply (metis RdX_def init_val_pres isRd.simps(1) no_val_def read_pres_not_p_vorder)
  using amo_intro_step no_val_def apply blast
  apply (metis RdX_def init_val_pres isRd.simps(1) no_val_def read_pres_not_p_vorder)
  using amo_intro_step no_val_def apply blast
  apply (metis RdX_def init_val_pres isRd.simps(1) no_val_def read_pres_not_p_vorder)
  using amo_intro_step no_val_def apply blast
  apply (metis PC.simps(8) fun_upd_def)
  by (metis PC.simps(9) fun_upd_def)+

lemma t2_local :
  assumes "prog_inv t2 ((pc s) t2) s"
  and "thrdsvars"
  and "prog t2 s s'"
shows  "prog_inv t2 ((pc s') t2) s'"
  using assms
  apply(unfold prog_inv_def prog_def thrdsvars_def update_pc_def)
  apply(cases "pc s t2")
    apply simp
   apply(elim conjE)
  apply simp
  by auto

lemma t2_global :
  assumes "prog_inv t2 ((pc s) t2) s"
   and "t = t1 \<or> t = t3 \<or> t = t4"
   and "prog_inv t ((pc s) t) s"
  and "thrdsvars"
  and "prog t s s'"
shows  "prog_inv t2 ((pc s') t2) s'"
  using assms
  apply(elim disjE, simp)
  apply(unfold prog_inv_def prog_def thrdsvars_def  update_pc_def)
  apply clarsimp+
  apply(cases "pc s t1", auto)
  apply(cases "pc s t2", simp)
  apply (metis PC.distinct(1) fun_upd_same)
  apply simp+
  apply (metis PC.distinct(1) fun_upd_same)
    apply (metis PC.distinct(1) fun_upd_same)
    apply(cases "pc s t3", auto)
      apply(cases "pc s t2", simp)
       apply (intro conjI)
  apply (metis RdX_def init_val_pres isRd.simps(1) no_val_def read_pres_not_p_vorder)
  using amo_intro_step no_val_def zero_neq_numeral apply blast
  apply (simp add: amo_intro_step)
  using read_pres_not_p_vorder
  apply simp
      apply(cases "pc s t2", simp_all)
    apply (intro conjI)
  apply (metis RdX_def init_val_pres isRd.simps(1) no_val_def read_pres_not_p_vorder)
  using amo_intro_step no_val_def zero_neq_numeral apply blast
      apply(cases "pc s t2", simp_all)
    apply (intro conjI)
  apply (metis RdX_def init_val_pres isRd.simps(1) no_val_def read_pres_not_p_vorder)
  using amo_intro_step no_val_def zero_neq_numeral apply blast
   apply(cases "pc s t2", simp)
    apply(cases "pc s t4", auto)
  apply (metis RdX_def init_val_pres isRd.simps(1) no_val_def read_pres_not_p_vorder)
  using amo_intro_step no_val_def zero_neq_numeral apply blast
  apply (metis RdX_def init_val_pres isRd.simps(1) no_val_def read_pres_not_p_vorder)
  using amo_intro_step no_val_def zero_neq_numeral apply blast
  apply (metis PC.simps(8) Suc_1 fun_upd_def)
  by (metis PC.simps(9) Suc_1 fun_upd_def)

lemma t3_local :
  assumes "prog_inv t3 ((pc s) t3) s"
  and "thrdsvars"
  and "prog t3 s s'"
shows  "prog_inv t3 ((pc s') t3) s'"
  using assms
  apply(unfold prog_inv_def prog_def thrdsvars_def update_pc_def)
  apply(cases " pc s t3")
    apply simp
  apply(elim conjE)
    apply(intro conjI)
  using init_val_pres apply blast
  using enc_RdX_intro apply blast
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
   apply simp
   apply(elim conjE)
    apply(intro conjI)
  using enc_read_p_vorder
  apply (metis RdX_def avar.simps(1) enc_pvord_step isRd.simps(1) rd_val.simps(1))
 using amo_read_pres
  apply (metis RdX_def isRd.simps(1))
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  by auto

lemma t3_global:
  assumes "prog_inv t3 ((pc s) t3) s"
   and "t = t1 \<or> t = t2 \<or> t = t4"
   and "prog_inv t ((pc s) t) s"
  and "thrdsvars"
  and "prog t s s'"
shows  "prog_inv t3 ((pc s') t3) s'"
  using assms
  apply(elim disjE, simp)
  apply(unfold prog_inv_def prog_def thrdsvars_def  update_pc_def)
  apply clarsimp
    apply(cases "pc s t1", auto)
    apply(cases "pc s t3")
      apply simp
      apply(case_tac "pc s' t3 \<noteq> pc s t3")
  apply (metis PC.distinct(1) fun_upd_def)
      apply simp
      apply(intro conjI)
  using init_val_pres apply blast
  apply (metis PC.distinct(1) fun_upd_def)
        apply (metis PC.distinct(1) fun_upd_same)
        apply (metis PC.distinct(1) fun_upd_def)
        apply (metis PC.distinct(1) fun_upd_same update_pc_def)
    apply(cases "pc s t2", auto)
    apply(cases "pc s t3")
      apply simp
          apply(case_tac "pc s' t3 \<noteq> pc s t3")
       apply simp+
      apply(intro conjI)
  using init_val_pres apply blast
  using amo_pres_step_wr
      apply (metis WrX_def isWr.simps(2) n_not_Suc_n numeral_2_eq_2 option.inject wr_val.simps(1))
  using amo_intro_step no_val_def zero_neq_numeral apply blast
    apply (simp add: amo_intro_step)
  apply (metis WrX_def amo_intro_step amo_pres_step_wr enc_pres init_val_pres isWr.simps(2) no_val_def option.inject wr_val.simps(1) zero_neq_numeral)
  apply (metis (no_types, lifting) PC.simps(9) WrX_def amo_intro_step amo_pres_step_wr isWr.simps(2) no_val_def option.inject p_vorder_write_pres wr_val.simps(1) zero_neq_numeral)
  apply(cases "pc s t3", auto)
  apply(cases "pc s t4", auto)
  apply (meson amo_def init_val_pres isRd.simps(1) read_pres_not_p_vorder)
  apply(cases "pc s t4", auto)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  using init_val_pres apply blast
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply(cases "pc s t4", auto)
  using init_val_pres apply blast
  using enc_pres apply blast
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  using init_val_pres apply blast
  using enc_pres apply blast
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply(cases "pc s t4", auto)
  using init_val_pres apply blast
  using enc_pres apply blast
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  using init_val_pres apply blast
  using enc_pres apply blast
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply(cases "pc s t4", auto)
  apply(cases "pc s t4", auto)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply(cases "pc s t4", auto)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply(cases "pc s t4", auto)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply(cases "pc s t4", auto)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply(cases "pc s t4", auto)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply(cases "pc s t4", auto)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
    apply(cases "pc s t4", auto)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
    apply(cases "pc s t4", auto)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply(cases "pc s t4", auto)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  by (metis RdX_def amo_read_pres isRd.simps(1))

lemma t4_local :
  assumes "prog_inv t4 ((pc s) t4) s"
  and "thrdsvars"
  and "prog t4 s s'"
shows  "prog_inv t4 ((pc s') t4) s'"
  using assms
  apply(unfold prog_inv_def prog_def thrdsvars_def update_pc_def)
  apply(cases " pc s t4")
    apply simp
  apply(elim conjE)
    apply(intro conjI)
  using init_val_pres apply blast
  using enc_RdX_intro apply blast
    apply (metis RdX_def amo_read_pres isRd.simps(1))
    apply (metis RdX_def amo_read_pres isRd.simps(1))
   apply simp
  apply(elim conjE)
   apply(intro conjI impI)
  apply (metis RdX_def avar.simps(1) enc_pvord_step isRd.simps(1) rd_val.simps(1))
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  by auto

lemma t4_global:
  assumes "prog_inv t4 ((pc s) t4) s"
   and "t = t1 \<or> t = t2 \<or> t = t3"
   and "prog_inv t ((pc s) t) s"
  and "thrdsvars"
  and "prog t s s'"
shows  "prog_inv t4 ((pc s') t4) s'"
  using assms
  apply(elim disjE, simp)
  apply(unfold prog_inv_def prog_def thrdsvars_def  update_pc_def)
  apply clarsimp
    apply(cases "pc s t1", auto)
    apply(cases "pc s t4")
      apply simp
      apply(case_tac "pc s' t4 \<noteq> pc s t4")
  apply (metis PC.distinct(1) fun_upd_def)
      apply simp
      apply(intro conjI)
  using init_val_pres apply blast
  apply (metis PC.distinct(1) fun_upd_same)
        apply (metis PC.distinct(1) fun_upd_same)
        apply (metis PC.distinct(1) fun_upd_def)
        apply (metis PC.distinct(1) fun_upd_same update_pc_def)
    apply(cases "pc s t2", auto)
    apply(cases "pc s t4")
      apply simp
          apply(case_tac "pc s' t4 \<noteq> pc s t4")
       apply simp+
      apply(intro conjI)
  using init_val_pres apply blast
  using amo_pres_step_wr
  apply (metis WrX_def isWr.simps(2) n_not_Suc_n numeral_2_eq_2 option.inject wr_val.simps(1))
  using amo_intro_step no_val_def zero_neq_numeral apply blast
     apply (simp add: amo_intro_step)
  using enc_pres init_val_pres apply auto[1]
  apply (simp add: amo_intro_step no_val_def)
  apply (metis WrX_def amo_pres_step_wr isWr.simps(2) n_not_Suc_n numeral_2_eq_2 option.inject wr_val.simps(1))
   apply (simp add: amo_intro_step)+
   apply(case_tac "pc s t4", auto)
  using amo_intro_step no_val_def zero_neq_numeral apply blast+
  apply (metis WrX_def amo_pres_step_wr isWr.simps(2) n_not_Suc_n numeral_2_eq_2 option.inject wr_val.simps(1))
  apply (metis WrX_def isWr.simps(2) p_vorder_write_pres)
  using amo_intro_step no_val_def zero_neq_numeral apply blast
  apply (metis WrX_def isWr.simps(2) p_vorder_write_pres)
  using amo_intro_step no_val_def zero_neq_numeral apply blast
  apply (metis WrX_def amo_pres_step_wr isWr.simps(2) n_not_Suc_n numeral_2_eq_2 option.inject wr_val.simps(1))
  apply(case_tac "pc s t4", auto)
  apply(case_tac "pc s t3", auto)
  using init_val_pres apply blast
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  using init_val_pres apply blast
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply(case_tac "pc s t3", auto)
  using init_val_pres apply blast
  using enc_pres apply blast
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  using init_val_pres apply blast
  using enc_pres apply blast
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply(case_tac "pc s t3", auto)
  using init_val_pres apply blast
  using enc_pres apply blast
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  using init_val_pres apply blast
  using enc_pres apply blast
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply(case_tac "pc s t3", auto)
  apply(case_tac "pc s t3", auto)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply(case_tac "pc s t3", auto)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply(case_tac "pc s t3", auto)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply (metis RdX_def amo_read_pres isRd.simps(1))
  apply(case_tac "pc s t3", auto)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply(case_tac "pc s t3", auto)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply(case_tac "pc s t3", auto)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply(case_tac "pc s t3", auto)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  apply (metis RdX_def isRd.simps(1) read_pres_p_vorder)
  apply (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)
  by (metis RdX_def amo_def isRd.simps(1) read_pres_not_p_vorder)

lemma sub_goal_t3:
  assumes "prog_inv t3 L3 s"
  and "thrdsvars"
  shows "(a s) = 1 \<and> (b s) = 2 \<longrightarrow> d_vorder (state s) (a s) x (b s)"
  using assms
  apply(simp add: prog_inv_def)
  using pvord_to_dvord
  by fastforce

lemma sub_goal_t4:
  assumes "prog_inv t4 L3 s"
  and "thrdsvars"
  shows "(c s) = 2 \<and> (d s) = 1 \<longrightarrow> d_vorder (state s) (c s) x (d s)"
  using assms
  apply(simp add: prog_inv_def)
  using pvord_to_dvord
  by fastforce

lemma goal:
  assumes "prog_inv t1 L3 s"
  and "prog_inv t2 L3 s"
  and "prog_inv t3 L3 s"
  and "prog_inv t4 L3 s"
  and "thrdsvars"
shows "a s = 1 \<and> b s = 2 \<and> c s = 2 \<longrightarrow> d s \<noteq> 1"
  using assms apply simp
  apply(frule_tac sub_goal_t3[where s=s], simp)
  apply(drule_tac sub_goal_t4[where s=s])
  apply(simp add: prog_inv_def)
  using d_vorder_one_way by auto

theorem final_inv:
  assumes "wfs (state s)"
  and "thrdsvars"
  and "t \<in> {t1, t2, t3, t4}"
  and "t' \<in> {t1, t2, t3, t4}"
  and "prog_inv t ((pc s) t) s"
  and "prog_inv t' ((pc s) t') s"
  and "prog t' s s'"
shows "prog_inv t ((pc s') t) s'"
  using assms apply (simp del: thrdsvars_def)
  by (meson t1_global t1_local t2_global t2_local t3_global t3_local t4_global t4_local)

end