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


section \<open>Isar Integration Tests\<close>
theory Isar_Integration_Tests
imports Soft_Types.Soft_Types_HOL
begin

text \<open>Not all of the examples below work as expected yet.
First, assume a little bit of context:\<close>

declare [[trace_soft_types]]

typedecl set

experiment
  fixes Set :: "set type"
  and Element :: "set \<Rightarrow> set type"
  and list :: "set \<Rightarrow> set"
  and nil :: "set \<Rightarrow> set"
  and cons :: "set \<Rightarrow> set \<Rightarrow> set \<Rightarrow> set"
  assumes nil_type[type]: "nil : (A : Set) \<Rightarrow> Element (list A)"
  and list_cons_type[type]: "cons : (A : Set) \<Rightarrow> Element A \<Rightarrow> Element (list A) \<Rightarrow> Element (list A)"
begin

declare[[auto_elaborate]]

subsection \<open>Top-Level Lemma Statements\<close>

lemma foo: "nil A = B"
proof -
  txt \<open>Assumptions about the type of \<open>A\<close> and \<open>B\<close> are available in the context:\<close>
  print_types
  show ?thesis sorry
qed

text \<open>The assumptions lead to additional premises in the result:\<close>
thm foo

subsection \<open>Local Goals\<close>

text \<open>Currently, the augment operation is not included in "have" statements,
but we would expect it to be:\<close>

notepad
begin
  subsubsection \<open>Example 1\<close>
  fix A B
  have 1: "nil A = B" sorry

  text \<open>Here, \<open>A\<close> and \<open>B\<close> are part of the surrounding context, so the
  assumptions about their type should also live in that context.\<close>
  print_types \<comment> \<open>Types of \<open>A\<close> and \<open>B\<close> are known at this point.\<close>
  thm 1
next
  subsubsection \<open>Example 2\<close>
  have 1: "nil A = B" for A B sorry
  text \<open>Here, \<open>A\<close> and \<open>B\<close> are part of the statement's eigencontext, so the
  assumptions should end up in as premises of the proved fact, similar to a
  top-level lemma statement.\<close>
  thm 1 \<comment> \<open>We get additional assumptions for the proved fact..\<close>
next
  subsubsection \<open>Example 3\<close>
  fix B
  have 1: "nil ? = B" sorry
  text \<open>Similar to Example 1, but one variable is implicit and introduced by elaboration.

  Here, \<open>B\<close> lives in the surrounding context, and \<open>A\<close> is implicitly introduced in the statement
  for the first time. Since the type of \<open>B\<close> depends on \<open>A\<close>, we cannot generalize \<open>A\<close> which must
  be introduced into the resulting context.

  This situation should probably emit a warning. The introduced variable can also not be referred
  to in the text.\<close>
  print_types
  thm 1
next
  subsubsection \<open>Example 4\<close>
  have 1: "nil ? = B" for B sorry
  text \<open>Similar to Example 2, but with one implicit argument.
  Here, the implicit \<open>A\<close> can be fully generalized. It also cannot be referenced
  in the text.\<close>
  print_types \<comment> \<open>FIXME: implicit variable should not appear here.\<close>
  thm 1 \<comment> \<open>FIXME: Should be fully generalized.\<close>
end

subsection \<open>Definitions\<close>

text \<open>Definitions work (for now) by just purging the type information, which is
not needed for the primitive definition.

Ideally, we should infer and save type information for the defined constant, but
we postpone this as future work for now. Users can always derive type information
afterwards.\<close>

definition f where "f A x = cons A x (nil A)"

end

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


theory prop_09
imports Main
        "../../TestTheories/Listi"
        "../../TestTheories/Naturals"
        "$HIPSTER_HOME/IsaHipster"

begin

theorem initMaps : "init (maps x y) = maps x (init y)"
by hipster_induct_schemes

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