theory TeslDenotationalArchi

imports TeslDenotationalRelations

begin
section \<open>
  Preservation of the TESL operators by architectural composition
\<close>

text \<open>
  The tick_occurs operator is preserved in a product of runs.
\<close>
lemma tick_occurs_prod:\<open>tick_occurs (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)
                      = (tick_occurs (hamlet r\<^sub>1 n) \<or> tick_occurs (hamlet r\<^sub>2 n))\<close>
unfolding tick_occurs_def hamlet_prod_hamlet by auto

lemma tick_occurs_prod1[intro]:\<open>tick_occurs (hamlet r\<^sub>1 n) \<Longrightarrow> tick_occurs (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
using tick_occurs_prod[of \<open>r\<^sub>1\<close> \<open>r\<^sub>2\<close> \<open>n\<close>] by simp

lemma tick_occurs_prod2[intro]:\<open>tick_occurs (hamlet r\<^sub>2 n) \<Longrightarrow> tick_occurs (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
using tick_occurs_prod[of \<open>r\<^sub>1\<close> \<open>r\<^sub>2\<close> \<open>n\<close>] by simp

lemma tick_occurs_prode[elim]:
  \<open>tick_occurs (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n) \<Longrightarrow> (tick_occurs (hamlet r\<^sub>1 n) \<or> tick_occurs (hamlet r\<^sub>2 n))\<close>
using tick_occurs_prod[of \<open>r\<^sub>1\<close> \<open>r\<^sub>2\<close> \<open>n\<close>] by simp

text \<open>
  The tick_occurs operator is preserved by projection.
\<close>
lemma tick_occurs_proj:
  \<open>tick_occurs (hamlet r n) = (  tick_occurs (hamlet (fst\<^sub>r\<^sub>u\<^sub>n r) n)
                               \<or> tick_occurs (hamlet (snd\<^sub>r\<^sub>u\<^sub>n r) n))\<close>
using tick_occurs_prod[of \<open>fst\<^sub>r\<^sub>u\<^sub>n r\<close> \<open>snd\<^sub>r\<^sub>u\<^sub>n r\<close> \<open>n\<close>]
      hamlet_fst_hamlet[of \<open>r\<close>]
      hamlet_snd_hamlet[of \<open>r\<close>]
      hamlet_prod_hamlet[of \<open>fst\<^sub>r\<^sub>u\<^sub>n r\<close> \<open>snd\<^sub>r\<^sub>u\<^sub>n r\<close>]
by auto

lemma tick_occurs_proj1[intro]:
  \<open>tick_occurs (hamlet (fst\<^sub>r\<^sub>u\<^sub>n r) n) \<Longrightarrow> tick_occurs (hamlet r n)\<close>
using tick_occurs_proj[of \<open>r\<close> \<open>n\<close>] by simp

lemma tick_occurs_proj2[intro]:
  \<open>tick_occurs (hamlet (snd\<^sub>r\<^sub>u\<^sub>n r) n) \<Longrightarrow> tick_occurs (hamlet r n)\<close>
using tick_occurs_proj[of \<open>r\<close> \<open>n\<close>] by simp

lemma tick_occurs_proje[elim]:
  \<open>tick_occurs (hamlet r n) \<Longrightarrow> (  tick_occurs (hamlet (fst\<^sub>r\<^sub>u\<^sub>n r) n)
                                 \<or> tick_occurs (hamlet (snd\<^sub>r\<^sub>u\<^sub>n r) n))\<close>
using tick_occurs_proj[of \<open>r\<close> \<open>n\<close>] by simp

text \<open>
  Shifting a clock from a run to a product of runs.
  Third argument ('b run) is here just for typing the result...
  shift1 just changes the type of the clock,
  shift2 also offsets its time and hamlet components.
\<close>
definition shift\<^sub>1::\<open>('a, 'c)\<H> \<Rightarrow> ('a::orderedrank run) \<Rightarrow> ('b::orderedrank run) \<Rightarrow> ('a\<times>'b, 'c)\<H>\<close>
where \<open>shift\<^sub>1 c r r' \<equiv> ((timep c) \<circ> fst, index c)\<close>

definition shift\<^sub>2::\<open>('b, 'c)\<H> \<Rightarrow> ('a::orderedrank run) \<Rightarrow> ('b::orderedrank run) \<Rightarrow> ('a\<times>'b, 'c)\<H>\<close>
where \<open>shift\<^sub>2 c r r' \<equiv> ((timep c) \<circ> snd, (index c) + rank r)\<close>

text \<open>
  Some basic properties of shifting.
\<close>
lemma time_shift\<^sub>1:\<open>(timep c) (time r\<^sub>1 n) = (timep (shift\<^sub>1 c r\<^sub>1 r\<^sub>2)) (time (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
by (simp add: shift\<^sub>1_def time_prod_time)

lemma time_shift\<^sub>2:\<open>(timep c) (time r\<^sub>2 n) = (timep (shift\<^sub>2 c r\<^sub>1 r\<^sub>2)) (time (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
by (simp add: shift\<^sub>2_def time_prod_time)

text \<open>
  Here, with have a condition to ensure that clock c is within the rank of r1.
\<close>
lemma hamlet_shift\<^sub>1:
  assumes \<open>index c < rank r\<^sub>1\<close>
  shows   \<open>(hamlet r\<^sub>1 n)!(index c) = (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)!(index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2))\<close>
proof -
  have \<open>(hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)!(index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2))
        = ((hamlet r\<^sub>1 n)@(hamlet r\<^sub>2 n))!(index c)\<close>
    by (simp add: hamlet_prod_hamlet shift\<^sub>1_def)
  moreover have \<open>length (hamlet r\<^sub>1 n) = rank r\<^sub>1\<close> by (simp add: rank_any_hamlet)
  ultimately have \<open>(hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)!(index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2))
        = (hamlet r\<^sub>1 n)!(index c)\<close> by (simp add: assms nth_append)
  thus ?thesis ..
qed

lemma hamlet_shift\<^sub>2:
  \<open>(hamlet r\<^sub>2 n)!(index c) = (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)!(index (shift\<^sub>2 c r\<^sub>1 r\<^sub>2))\<close>
proof -
  have \<open>(hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)!(index (shift\<^sub>2 c r\<^sub>1 r\<^sub>2))
        = ((hamlet r\<^sub>1 n)@(hamlet r\<^sub>2 n))!((index c) + (rank r\<^sub>1))\<close>
  by (simp add: hamlet_prod_hamlet shift\<^sub>2_def)
  moreover have \<open>length (hamlet r\<^sub>1 n) = rank r\<^sub>1\<close> by (simp add: rank_any_hamlet)
  ultimately have \<open>(hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)!(index (shift\<^sub>2 c r\<^sub>1 r\<^sub>2))
        = (hamlet r\<^sub>2 n)!(index c)\<close> by (simp add: nth_append)
  thus ?thesis ..
qed

text \<open>
  The ticks operator is preserved in a product of runs.
\<close>
lemma ticks_shift1_shift:\<open>ticks c (hamlet r\<^sub>1 n) \<Longrightarrow> ticks (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
proof -
  assume h:\<open>ticks c (hamlet r\<^sub>1 n)\<close>
  from h have idx:\<open>(index c) < length (hamlet r\<^sub>1 n)\<close> using ticks_idx by blast
  from h have ham:\<open>(hamlet r\<^sub>1 n)!(index c)\<close> by (simp add: ticks_ham)
  from idx have *:\<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < length (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
    unfolding shift\<^sub>1_def by (simp add: hamlet_prod_hamlet)
  from idx have \<open>index c < rank r\<^sub>1\<close> by (simp add: rank_any_hamlet)
  from hamlet_shift\<^sub>1[OF this, of \<open>n\<close> \<open>r\<^sub>2\<close>] ham have \<open>(hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)!(index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2))\<close>
    by simp
  thus ?thesis unfolding ticks_def by (simp add: *)
qed

lemma ticks_shift1_unshift:
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>ticks (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n) \<Longrightarrow> ticks c (hamlet r\<^sub>1 n)\<close>
proof -
  assume h:\<open>ticks (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
  from ticks_ham[OF h]
    have ham:\<open>(hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)!(index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2))\<close>
    by simp
  from assms have idx:\<open>index c < rank r\<^sub>1\<close> unfolding shift\<^sub>1_def by simp
  from hamlet_shift\<^sub>1[OF this, of \<open>n\<close> \<open>r\<^sub>2\<close>] ham have \<open>(hamlet r\<^sub>1 n)!(index c)\<close>
    by simp
  thus ?thesis unfolding ticks_def by (simp add: rank_any_hamlet idx)
qed

lemma ticks_shift1:
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>ticks c (hamlet r\<^sub>1 n) = ticks (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
using assms ticks_shift1_shift ticks_shift1_unshift by blast

lemma ticks_shift2_shift:\<open>ticks c (hamlet r\<^sub>2 n) \<Longrightarrow> ticks (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
proof -
  assume h:\<open>ticks c (hamlet r\<^sub>2 n)\<close>
  from ticks_idx[OF h] have idx:\<open>(index c) < length (hamlet r\<^sub>2 n)\<close> .
  from ticks_ham[OF h] have ham:\<open>(hamlet r\<^sub>2 n)!(index c)\<close> .
  from idx have *:\<open>index (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) < length (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
    unfolding shift\<^sub>2_def by (simp add: hamlet_prod_hamlet rank_any_hamlet)
  from hamlet_shift\<^sub>2[of \<open>r\<^sub>2\<close> \<open>n\<close> \<open>c\<close>] ham have \<open>(hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)!(index (shift\<^sub>2 c r\<^sub>1 r\<^sub>2))\<close>
    by simp
  thus ?thesis unfolding ticks_def by (simp add: *)
qed

lemma ticks_shift2_unshift:
  \<open>ticks (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n) \<Longrightarrow> ticks c (hamlet r\<^sub>2 n)\<close>
proof -
  assume h:\<open>ticks (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
  from ticks_idx[OF h]
    have \<open>index (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) < rank (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)\<close> by (simp add: rank_any_hamlet)
    hence idx:\<open>index c < rank r\<^sub>2\<close> by (simp add: run_prod_rank shift\<^sub>2_def)
  from ticks_ham[OF h]
    have ham:\<open>(hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)!(index (shift\<^sub>2 c r\<^sub>1 r\<^sub>2))\<close>
    by simp
  from hamlet_shift\<^sub>2[of \<open>r\<^sub>2\<close> \<open>n\<close> \<open>c\<close> \<open>r\<^sub>1\<close>] ham have \<open>(hamlet r\<^sub>2 n)!(index c)\<close>
    by simp
  thus ?thesis unfolding ticks_def by (simp add: idx rank_any_hamlet)
qed

lemma ticks_shift2:\<open>ticks c (hamlet r\<^sub>2 n) = ticks (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) n)\<close>
using ticks_shift2_shift ticks_shift2_unshift by blast

text \<open>
  The set of instants when a clock ticks is preserved by architectural composition.
\<close>
lemma tick_set_shift1:
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>{k. ticks c (hamlet r\<^sub>1 k)} = {k. ticks (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) k)}\<close>
using ticks_shift1[OF assms] by blast

lemma tick_set_shift2:
  \<open>{k. ticks c (hamlet r\<^sub>2 k)} = {k. ticks (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) k)}\<close>
using ticks_shift2 by blast

text \<open>
  The instant of the first tick of a clock is preserved by architectural composition.
\<close>
lemma Least_shift1:
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  and     \<open>\<exists>k. ticks c (hamlet r\<^sub>1 k)\<close>
  shows   \<open>(LEAST k. k \<in> {t. ticks c (hamlet r\<^sub>1 t)})
         = (LEAST k. k \<in> {t. ticks (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) t)})\<close>
          (is \<open>(LEAST k. k \<in> ?R) = (LEAST k. k \<in> ?P)\<close>)
proof -
  from tick_set_shift1[OF assms(1)] have \<open>?R = ?P\<close> by simp
  thus ?thesis using assms(2) by auto
qed

lemma Least_shift2:
  assumes \<open>\<exists>k. ticks c (hamlet r\<^sub>2 k)\<close>
  shows   \<open>(LEAST k. k \<in> {t. ticks c (hamlet r\<^sub>2 t)})
         = (LEAST k. k \<in> {t. ticks (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) t)})\<close>
          (is \<open>(LEAST k. k \<in> ?R) = (LEAST k. k \<in> ?P)\<close>)
proof -
  from tick_set_shift2[of \<open>c\<close> \<open>r\<^sub>2\<close> \<open>r\<^sub>1\<close>] have \<open>?R = ?P\<close> by simp
  thus ?thesis by auto
qed

lemma first_tick_shift1:
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>first_tick c (hamlet r\<^sub>1) = first_tick (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2))\<close>
proof (cases \<open>\<exists>k. ticks c (hamlet r\<^sub>1 k)\<close>)
  case False
    hence *:\<open>first_tick c (hamlet r\<^sub>1) = None\<close> unfolding first_tick_def by simp
    from False ticks_shift1[OF assms]
      have \<open>\<nexists>k. ticks (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) k)\<close> by blast
    hence **:\<open>first_tick (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) = None\<close>
      unfolding first_tick_def by simp
    from * show ?thesis by (simp add: **)
next
  case True
    with ticks_shift1[OF assms] have *:\<open>\<exists>k. ticks (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) k)\<close> by blast
    from True have \<open>first_tick c (hamlet r\<^sub>1) = Some (LEAST k. ticks c (hamlet r\<^sub>1 k))\<close>
      unfolding first_tick_def by simp
    also from Least_shift1[OF assms True]
      have \<open>... =  Some (LEAST k. k \<in> {t. ticks (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) t)})\<close>
      by (simp add: True)
    finally show ?thesis unfolding first_tick_def by (simp add: True *)
qed

lemma first_tick_shift2:
  shows   \<open>first_tick c (hamlet r\<^sub>2) = first_tick (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2))\<close>
proof (cases \<open>\<exists>k. ticks c (hamlet r\<^sub>2 k)\<close>)
  case False
    hence *:\<open>first_tick c (hamlet r\<^sub>2) = None\<close> unfolding first_tick_def by simp
    from False ticks_shift2
      have \<open>\<nexists>k. ticks (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) k)\<close> by blast
    hence **:\<open>first_tick (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) = None\<close>
      unfolding first_tick_def by simp
    from * show ?thesis by (simp add: **)
next
  case True
    with ticks_shift2 have *:\<open>\<exists>k. ticks (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) k)\<close> by blast
    from True have \<open>first_tick c (hamlet r\<^sub>2) = Some (LEAST k. ticks c (hamlet r\<^sub>2 k))\<close>
      unfolding first_tick_def by simp
    also from Least_shift2[OF True, of \<open>r\<^sub>1\<close>]
      have \<open>... =  Some (LEAST k. k \<in> {t. ticks (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) t)})\<close>
      by (simp add: True)
    finally show ?thesis unfolding first_tick_def by (simp add: True *)
qed

text \<open>
  tick_count operator
\<close>
lemma tick_count_shift1:
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>tick_count c (hamlet r\<^sub>1) n = tick_count (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<close>
using ticks_shift1[OF assms] unfolding tick_count_def by simp

lemma tick_count_shift2:
  shows   \<open>tick_count c (hamlet r\<^sub>2) n = tick_count (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<close>
using ticks_shift2[of \<open>c\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] unfolding tick_count_def by simp

text \<open>
  tick_count_between operator
\<close>
lemma tick_count_between_shift1:
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>tick_count_between c (hamlet r\<^sub>1) m n
           = tick_count_between (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) m n\<close>
using ticks_shift1[OF assms] unfolding tick_count_between_def by simp

lemma tick_count_between_shift2:
  shows   \<open>tick_count_between c (hamlet r\<^sub>2) m n
          = tick_count_between (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) m n\<close>
using ticks_shift2[of \<open>c\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] unfolding tick_count_between_def by simp

text \<open>
  first_tick_since operator
\<close>
lemma first_tick_since_shift1:
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>first_tick_since c (hamlet r\<^sub>1) r n
          = first_tick_since (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) r n\<close>
using ticks_shift1[OF assms] unfolding first_tick_since_def by simp

lemma first_tick_since_shift2:
  shows \<open>first_tick_since c (hamlet r\<^sub>2) r n
        = first_tick_since (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) r n\<close>
using ticks_shift2[of \<open>c\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] unfolding first_tick_since_def by simp

text \<open>
  has_ticked_since operator
\<close>
lemma has_ticked_since_shift1:
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>has_ticked_since c (hamlet r\<^sub>1) r n
          = has_ticked_since (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) r n\<close>
using ticks_shift1[OF assms] unfolding has_ticked_since_def by simp

lemma has_ticked_since_shift2:
  shows \<open>has_ticked_since c (hamlet r\<^sub>2) r n
        = has_ticked_since (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) r n\<close>
using ticks_shift2[of \<open>c\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] unfolding has_ticked_since_def by simp

text \<open>
  has_first_since operator
\<close>
lemma has_first_since_shift11:
  assumes \<open>index (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>has_first_since a b (hamlet r\<^sub>1) n\<^sub>0 n
          = has_first_since (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0 n\<close>
unfolding has_first_since_def
using first_tick_since_shift1[OF assms(1)] first_tick_since_shift1[OF assms(2)]
      has_ticked_since_shift1[OF assms(1)] has_ticked_since_shift1[OF assms(2)] by blast

lemma has_first_since_shift22:
  \<open>has_first_since (a::('b::orderedrank, 'c)\<H>) (b::('b, 'd)\<H>) (hamlet r\<^sub>2) n\<^sub>0 n
  = has_first_since (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0 n\<close>
unfolding has_first_since_def
using first_tick_since_shift2 first_tick_since_shift2
      has_ticked_since_shift2 has_ticked_since_shift2 by blast

text \<open>
  have_both_ticked operator
\<close>
lemma have_both_ticked_shift11:
  assumes \<open>index (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>have_both_ticked a b (hamlet r\<^sub>1) n
           = have_both_ticked (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<close>
          (is \<open>?H n = ?HS n\<close>)
proof (induction n rule: nat_strong_induct)
  case 0 show ?case
    proof
      { assume \<open>?H 0\<close>
        from  hbt0'[OF this]
          have \<open>has_first_since a b (hamlet r\<^sub>1) 0 0 \<or> has_first_since b a (hamlet r\<^sub>1) 0 0\<close> .
        hence \<open>has_first_since (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 0
             \<or> has_first_since (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 0\<close>
         using has_first_since_shift11[OF assms]
               has_first_since_shift11[OF assms(2) assms(1)] by blast
        hence \<open>?HS 0\<close> using  have_both_ticked.intros by blast
      } thus \<open>?H 0 \<Longrightarrow> ?HS 0\<close> .
    next
      { assume \<open>?HS 0\<close>
        from  hbt0'[OF this]
          have \<open>has_first_since (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 0
              \<or> has_first_since (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 0\<close> .
        hence \<open>has_first_since a b (hamlet r\<^sub>1) 0 0 \<or> has_first_since b a (hamlet r\<^sub>1) 0 0\<close>
         using has_first_since_shift11[OF assms]
               has_first_since_shift11[OF assms(2) assms(1)] by blast
        hence \<open>?H 0\<close> using  have_both_ticked.intros by blast
      } thus \<open>?HS 0 \<Longrightarrow> ?H 0\<close> .
    qed
next
  case (Suc p) show ?case
  proof
    { assume h:\<open>?H (Suc p)\<close>
      from this consider
        (a) \<open>has_first_since a b (hamlet r\<^sub>1) 0 (Suc p)\<close>
      | (b) \<open>has_first_since b a (hamlet r\<^sub>1) 0 (Suc p)\<close>
      | (c) \<open>\<exists>n\<^sub>0. have_both_ticked a b (hamlet r\<^sub>1) n\<^sub>0 \<and> has_first_since a b (hamlet r\<^sub>1) (Suc n\<^sub>0) (Suc p)\<close>
      | (d) \<open>\<exists>n\<^sub>0. have_both_ticked a b (hamlet r\<^sub>1) n\<^sub>0 \<and> has_first_since b a (hamlet r\<^sub>1) (Suc n\<^sub>0) (Suc p)\<close>
      using btn_btn0'[OF h] by blast
      thus \<open>?HS (Suc p)\<close>
      proof cases
        case a thus ?thesis using
          has_first_since_shift11[OF assms, of \<open>0\<close> \<open>Suc p\<close>]
          have_both_ticked.simps[of \<open>shift\<^sub>1 a r\<^sub>1 r\<^sub>2\<close> \<open>shift\<^sub>1 b r\<^sub>1 r\<^sub>2\<close> \<open>hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)\<close> \<open>Suc p\<close>]
        by simp
      next
        case b thus ?thesis using
          has_first_since_shift11[OF assms(2) assms(1), of \<open>0\<close> \<open>Suc p\<close>]
          have_both_ticked.simps[of \<open>shift\<^sub>1 a r\<^sub>1 r\<^sub>2\<close> \<open>shift\<^sub>1 b r\<^sub>1 r\<^sub>2\<close> \<open>hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)\<close> \<open>Suc p\<close>]
        by simp
      next
        case c
        from this obtain n\<^sub>0 where
          n0prop:\<open>have_both_ticked a b (hamlet r\<^sub>1) n\<^sub>0 \<and> has_first_since a b (hamlet r\<^sub>1) (Suc n\<^sub>0) (Suc p)\<close>
          by blast
        hence \<open>has_ticked_since a (hamlet r\<^sub>1) (Suc n\<^sub>0) (Suc p)\<close> using has_first_since_def by blast
        hence \<open>n\<^sub>0 \<le> p\<close> using ht_not_empty by blast
        with Suc.IH n0prop have
          \<open>have_both_ticked (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0\<close> by simp
        moreover from n0prop have
          \<open>has_first_since (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
          using has_first_since_shift11[OF assms] by blast
        ultimately show ?thesis using have_both_ticked.intros(3) by blast
      next
        case d
        from this obtain n\<^sub>0 where
          n0prop:\<open>have_both_ticked a b (hamlet r\<^sub>1) n\<^sub>0 \<and> has_first_since b a (hamlet r\<^sub>1) (Suc n\<^sub>0) (Suc p)\<close>
          by blast
        hence \<open>has_ticked_since b (hamlet r\<^sub>1) (Suc n\<^sub>0) (Suc p)\<close> using has_first_since_def by blast
        hence \<open>n\<^sub>0 \<le> p\<close> using ht_not_empty by blast
        with Suc.IH n0prop have
          \<open>have_both_ticked (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0\<close> by simp
        moreover from n0prop have
          \<open>has_first_since (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
          using has_first_since_shift11[OF assms(2) assms(1)] by blast
        ultimately show ?thesis using have_both_ticked.intros(4) by blast
      qed
    }
  next
    { assume h:\<open>?HS (Suc p)\<close>
      from this consider
        (a) \<open>has_first_since (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 (Suc p)\<close>
      | (b) \<open>has_first_since (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 (Suc p)\<close>
      | (c) \<open>\<exists>n\<^sub>0. have_both_ticked (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0
               \<and> has_first_since (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
      | (d) \<open>\<exists>n\<^sub>0. have_both_ticked (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0
               \<and> has_first_since (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
      using btn_btn0'[OF h] by blast
      thus \<open>?H (Suc p)\<close>
      proof cases
        case a thus ?thesis
          using has_first_since_shift11[OF assms, of \<open>0\<close> \<open>Suc p\<close>] have_both_ticked.intros(1) by simp
      next
        case b thus ?thesis
          using has_first_since_shift11[OF assms(2) assms(1), of \<open>0\<close> \<open>Suc p\<close>]
                    have_both_ticked.simps[of \<open>a\<close> \<open>b\<close> \<open>hamlet r\<^sub>1\<close> \<open>Suc p\<close>] by simp
      next
        case c
          from this obtain n\<^sub>0 where n0prop:
            \<open>have_both_ticked (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0
           \<and> has_first_since (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
            by blast
          hence \<open>has_first_since (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
            by simp
          hence \<open>n\<^sub>0 \<le> p\<close> using ht_not_empty hft_ht by blast
          with Suc.IH n0prop have \<open>have_both_ticked a b (hamlet r\<^sub>1) n\<^sub>0\<close> by simp
          with n0prop show ?thesis
            using have_both_ticked.intros(3) has_first_since_shift11[OF assms] by blast
      next
        case d
          from this obtain n\<^sub>0 where n0prop:
            \<open>have_both_ticked (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0
           \<and> has_first_since (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
            by blast
          hence \<open>has_first_since (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
            by simp
          hence \<open>n\<^sub>0 \<le> p\<close> using ht_not_empty hft_ht by blast
          with Suc.IH n0prop have \<open>have_both_ticked a b (hamlet r\<^sub>1) n\<^sub>0\<close> by simp
          with n0prop show ?thesis
            using have_both_ticked.intros(4) has_first_since_shift11[OF assms(2) assms(1)] by blast
      qed
    }
  qed
qed

lemma have_both_ticked_shift22:
   \<open>have_both_ticked a b (hamlet r\<^sub>2) n
    = have_both_ticked (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<close>
   (is \<open>?H n = ?HS n\<close>)
proof (induction n rule: nat_strong_induct)
  case 0 show ?case
    proof
      { assume \<open>?H 0\<close>
        from  hbt0'[OF this]
          have \<open>has_first_since a b (hamlet r\<^sub>2) 0 0 \<or> has_first_since b a (hamlet r\<^sub>2) 0 0\<close> .
        hence \<open>has_first_since (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 0
             \<or> has_first_since (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 0\<close>
         using has_first_since_shift22[of \<open>a\<close> \<open>b\<close> \<open>r\<^sub>2\<close> \<open>0\<close> \<open>0\<close> \<open>r\<^sub>1\<close>]
               has_first_since_shift22[of \<open>b\<close> \<open>a\<close> \<open>r\<^sub>2\<close> \<open>0\<close> \<open>0\<close> \<open>r\<^sub>1\<close>] by simp
        hence \<open>?HS 0\<close> using  have_both_ticked.intros by blast
      } thus \<open>?H 0 \<Longrightarrow> ?HS 0\<close> .
    next
      { assume \<open>?HS 0\<close>
        from  hbt0'[OF this]
          have \<open>has_first_since (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 0
              \<or> has_first_since (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 0\<close> .
          hence \<open>has_first_since a b (hamlet r\<^sub>2) 0 0
           \<or> has_first_since b a (hamlet r\<^sub>2) 0 0\<close> using
            has_first_since_shift22[of \<open>a\<close> \<open>b\<close> \<open>r\<^sub>2\<close> \<open>0\<close> \<open>0\<close>]
            has_first_since_shift22[of \<open>b\<close> \<open>a\<close> \<open>r\<^sub>2\<close> \<open>0\<close> \<open>0\<close>] by blast
        hence \<open>?H 0\<close> using have_both_ticked.intros(1-2) by blast
      } thus \<open>?HS 0 \<Longrightarrow> ?H 0\<close> .
    qed
next
  case (Suc p) show ?case
  proof
    { assume h:\<open>?H (Suc p)\<close>
      from this consider
        (a) \<open>has_first_since a b (hamlet r\<^sub>2) 0 (Suc p)\<close>
      | (b) \<open>has_first_since b a (hamlet r\<^sub>2) 0 (Suc p)\<close>
      | (c) \<open>\<exists>n\<^sub>0. have_both_ticked a b (hamlet r\<^sub>2) n\<^sub>0 \<and> has_first_since a b (hamlet r\<^sub>2) (Suc n\<^sub>0) (Suc p)\<close>
      | (d) \<open>\<exists>n\<^sub>0. have_both_ticked a b (hamlet r\<^sub>2) n\<^sub>0 \<and> has_first_since b a (hamlet r\<^sub>2) (Suc n\<^sub>0) (Suc p)\<close>
      using btn_btn0'[OF h] by blast
      thus \<open>?HS (Suc p)\<close>
      proof cases
        case a thus ?thesis using
          has_first_since_shift22[of \<open>a\<close> \<open>b\<close> \<open>r\<^sub>2\<close> \<open>0\<close> \<open>Suc p\<close> \<open>r\<^sub>1\<close>]
          have_both_ticked.simps[of \<open>shift\<^sub>2 a r\<^sub>1 r\<^sub>2\<close> \<open>shift\<^sub>2 b r\<^sub>1 r\<^sub>2\<close> \<open>hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)\<close> \<open>Suc p\<close>]
          by simp
      next
        case b thus ?thesis using
          has_first_since_shift22[of \<open>b\<close> \<open>a\<close> \<open>r\<^sub>2\<close> \<open>0\<close> \<open>Suc p\<close> \<open>r\<^sub>1\<close>]
          have_both_ticked.simps[of \<open>shift\<^sub>2 a r\<^sub>1 r\<^sub>2\<close> \<open>shift\<^sub>2 b r\<^sub>1 r\<^sub>2\<close> \<open>hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)\<close> \<open>Suc p\<close>]
          by simp
      next
        case c
          from this obtain n\<^sub>0 where n0prop:
            \<open>have_both_ticked a b (hamlet r\<^sub>2) n\<^sub>0 \<and> has_first_since a b (hamlet r\<^sub>2) (Suc n\<^sub>0) (Suc p)\<close>
            by blast
          hence \<open>has_first_since a b (hamlet r\<^sub>2) (Suc n\<^sub>0) (Suc p)\<close> by simp
          from hft_ht[OF this] have \<open>n\<^sub>0 \<le> p\<close> using  ht_not_empty by blast
          with Suc n0prop have
            \<open>have_both_ticked (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0\<close> by simp
          moreover from n0prop have
            \<open>has_first_since (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
            using has_first_since_shift22 by blast
          ultimately show ?thesis using
            have_both_ticked.simps[of \<open>shift\<^sub>2 a r\<^sub>1 r\<^sub>2\<close> \<open>shift\<^sub>2 b r\<^sub>1 r\<^sub>2\<close> \<open>hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)\<close> \<open>Suc p\<close>]
            by blast
      next
        case d
          from this obtain n\<^sub>0 where n0prop:
            \<open>have_both_ticked a b (hamlet r\<^sub>2) n\<^sub>0 \<and> has_first_since b a (hamlet r\<^sub>2) (Suc n\<^sub>0) (Suc p)\<close>
            by blast
          hence \<open>has_first_since b a (hamlet r\<^sub>2) (Suc n\<^sub>0) (Suc p)\<close> by simp
          from hft_ht[OF this] have \<open>n\<^sub>0 \<le> p\<close> using  ht_not_empty by blast
          with Suc n0prop have
            \<open>have_both_ticked (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0\<close> by simp
          moreover from n0prop have
            \<open>has_first_since (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
            using has_first_since_shift22 by blast
          ultimately show ?thesis using
            have_both_ticked.simps[of \<open>shift\<^sub>2 a r\<^sub>1 r\<^sub>2\<close> \<open>shift\<^sub>2 b r\<^sub>1 r\<^sub>2\<close> \<open>hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)\<close> \<open>Suc p\<close>]
            by blast
      qed
    }
  next
    { assume h:\<open>?HS (Suc p)\<close>
      from this consider
        (a) \<open>has_first_since (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 (Suc p)\<close>
      | (b) \<open>has_first_since (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) 0 (Suc p)\<close>
      | (c) \<open>\<exists>n\<^sub>0. have_both_ticked (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0
               \<and> has_first_since (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
      | (d) \<open>\<exists>n\<^sub>0. have_both_ticked (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0
               \<and> has_first_since (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
      using btn_btn0'[OF h] by blast
      thus \<open>?H (Suc p)\<close>
      proof cases
        case a thus ?thesis using
          has_first_since_shift22[of \<open>a\<close> \<open>b\<close> \<open>r\<^sub>2\<close> \<open>0\<close> \<open>Suc p\<close> \<open>r\<^sub>1\<close>]
          have_both_ticked.simps[of \<open>a\<close> \<open>b\<close> \<open>hamlet r\<^sub>2\<close> \<open>Suc p\<close>] by simp
      next
        case b thus ?thesis using
          has_first_since_shift22[of \<open>b\<close> \<open>a\<close> \<open>r\<^sub>2\<close> \<open>0\<close> \<open>Suc p\<close> \<open>r\<^sub>1\<close>]
          have_both_ticked.simps[of \<open>a\<close> \<open>b\<close> \<open>hamlet r\<^sub>2\<close> \<open>Suc p\<close>] by simp
      next
        case c
          from this obtain n\<^sub>0 where n0prop:
            \<open>have_both_ticked (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0
          \<and> has_first_since (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
            by blast
          hence \<open>n\<^sub>0 \<le> p\<close> using hft_ht ht_not_empty by blast
          with Suc n0prop have \<open>have_both_ticked a b (hamlet r\<^sub>2) n\<^sub>0\<close> by simp
          moreover have \<open>has_first_since a b (hamlet r\<^sub>2) (Suc n\<^sub>0) (Suc p)\<close>
            using n0prop has_first_since_shift22 by blast
          ultimately show ?thesis using have_both_ticked.simps by blast
      next
        case d
          from this obtain n\<^sub>0 where n0prop:
            \<open>have_both_ticked (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<^sub>0
          \<and> has_first_since (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) (Suc n\<^sub>0) (Suc p)\<close>
            by blast
          hence \<open>n\<^sub>0 \<le> p\<close> using hft_ht ht_not_empty by blast
          with Suc n0prop have \<open>have_both_ticked a b (hamlet r\<^sub>2) n\<^sub>0\<close> by simp
          moreover have \<open>has_first_since b a (hamlet r\<^sub>2) (Suc n\<^sub>0) (Suc p)\<close>
            using n0prop has_first_since_shift22 by blast
          ultimately show ?thesis using have_both_ticked.simps by blast
      qed
    }
  qed
qed

text \<open>
  between operator.
\<close>
lemma between_shift1:
  assumes \<open>index (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  and     \<open>index (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>between a b (hamlet r\<^sub>1) n = between (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<close>
unfolding between_def using ticks_shift1[OF assms(1)] ticks_shift1[OF assms(2)] by simp

lemma between_shift2:
  \<open>between a b (hamlet r\<^sub>2) n = between (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) (hamlet (r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2)) n\<close>
unfolding between_def using ticks_shift2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] ticks_shift2[of \<open>b\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] by simp

section \<open>
  Preservation of the TESL relations by architectural composition
\<close>

text \<open>
  Sporadic specifications are preserved by composition.
\<close>
lemma sporadic_shift1:
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  and     \<open>r\<^sub>1 \<in> c sporadic \<tau>\<close>
  shows   \<open>(r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) sporadic \<tau>\<close>
using assms(2) unfolding Sporadic_def
using ticks_shift1[OF assms(1)] time_shift\<^sub>1[of \<open>c\<close> \<open>r\<^sub>1\<close> _ \<open>r\<^sub>2\<close>] by simp

lemma sporadic_shift2:
  assumes \<open>r\<^sub>2 \<in> c sporadic \<tau>\<close>
  shows   \<open>(r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) sporadic \<tau>\<close>
using assms unfolding Sporadic_def
using ticks_shift2[of \<open>c\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] time_shift\<^sub>2[of \<open>c\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] by simp

text \<open>
  Implications are preserved by composition.
\<close>
lemma implies_shift1:
  assumes \<open>index (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  and     \<open>index (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  and     \<open>r\<^sub>1 \<in> a implies b\<close>
  shows   \<open>(r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) implies (shift\<^sub>1 b r\<^sub>1 r\<^sub>2)\<close>
using assms(3) unfolding Implies_def
using ticks_shift1[OF assms(1)] ticks_shift1[OF assms(2)] by simp

lemma implies_shift2:
  assumes \<open>r\<^sub>2 \<in> a implies b\<close>
  shows   \<open>(r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) implies (shift\<^sub>2 b r\<^sub>1 r\<^sub>2)\<close>
using assms unfolding Implies_def
using ticks_shift2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] ticks_shift2[of \<open>b\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] by simp

text \<open>
  Implies every relations are preserved by composition.
\<close>
lemma implies_every_prod1:
  assumes \<open>index (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  and     \<open>index (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>(r\<^sub>1 \<in> a implies b every n) = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) implies (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) every n)\<close>
unfolding ImpliesEvery_def
using ticks_shift1[OF assms(1)] ticks_shift1[OF assms(2)] tick_count_shift1[OF assms(1)] by simp

lemma implies_every_prod2:
  \<open>(r\<^sub>2 \<in> a implies b every n) = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) implies (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) every n)\<close>
unfolding ImpliesEvery_def
using ticks_shift2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      ticks_shift2[of \<open>b\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      tick_count_shift2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] by simp

text \<open>
  Tag relations are preserved by composition.
\<close>
lemma tagrel_prod1:
  \<open>(r\<^sub>1 \<in> TagRelation a R b) = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> TagRelation (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) R (shift\<^sub>1 b r\<^sub>1 r\<^sub>2))\<close>
unfolding TagRelation_def
using time_shift\<^sub>1[of \<open>a\<close> \<open>r\<^sub>1\<close> _ \<open>r\<^sub>2\<close>] time_shift\<^sub>1[of \<open>b\<close> \<open>r\<^sub>1\<close> _ \<open>r\<^sub>2\<close>] by simp

lemma tagrel_prod2:
  \<open>(r\<^sub>2 \<in> TagRelation a R b) = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> TagRelation (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) R (shift\<^sub>2 b r\<^sub>1 r\<^sub>2))\<close>
unfolding TagRelation_def
using time_shift\<^sub>2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] time_shift\<^sub>2[of \<open>b\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] by simp

text \<open>
  Loose tag relations are preserved by projections.
\<close>
lemma loosetagrel_proj1:
  assumes \<open>(r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> LooseTagRelation (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) R (shift\<^sub>1 b r\<^sub>1 r\<^sub>2)\<close>
                                       (is \<open>?P \<in> LooseTagRelation ?SA R ?SB\<close>)
  shows   \<open>r\<^sub>1 \<in> LooseTagRelation a R b\<close>
proof -
  from assms have *:\<open>\<forall>n. tick_occurs (hamlet ?P n)
                         \<longrightarrow> ((timep ?SA)(time ?P n), (timep ?SB)(time ?P n)) \<in> R\<close>
    unfolding LooseTagRelation_def by simp
  { fix n assume h:\<open>tick_occurs (hamlet r\<^sub>1 n)\<close>
    from tick_occurs_prod1[OF this] have \<open>tick_occurs (hamlet ?P n)\<close> .
    with * have \<open>((timep ?SA)(time ?P n), (timep ?SB)(time ?P n)) \<in> R\<close> by simp
    hence \<open>((timep a)(time r\<^sub>1 n), (timep b)(time r\<^sub>1 n)) \<in> R\<close>
      using time_shift\<^sub>1[of \<open>a\<close> \<open>r\<^sub>1\<close> \<open>n\<close> \<open>r\<^sub>2\<close>]
            time_shift\<^sub>1[of \<open>b\<close> \<open>r\<^sub>1\<close> \<open>n\<close> \<open>r\<^sub>2\<close>] by simp
  } thus ?thesis unfolding LooseTagRelation_def by simp
qed

lemma loosetagrel_proj2:
  assumes \<open>(r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> LooseTagRelation (shift\<^sub>2 a r\<^sub>1 r\<^sub>2) R (shift\<^sub>2 b r\<^sub>1 r\<^sub>2)\<close>
          (is \<open>?P \<in> LooseTagRelation ?SA R ?SB\<close>)
  shows   \<open>r\<^sub>2 \<in> LooseTagRelation a R b\<close>
proof -
  from assms have *:\<open>\<forall>n. tick_occurs (hamlet ?P n)
                         \<longrightarrow> ((timep ?SA)(time ?P n), (timep ?SB)(time ?P n)) \<in> R\<close>
    unfolding LooseTagRelation_def by simp
  { fix n assume h:\<open>tick_occurs (hamlet r\<^sub>2 n)\<close>
    from tick_occurs_prod2[OF this] have \<open>tick_occurs (hamlet ?P n)\<close> .
    with * have \<open>((timep ?SA)(time ?P n), (timep ?SB)(time ?P n)) \<in> R\<close> by simp
    hence \<open>((timep a)(time r\<^sub>2 n), (timep b)(time r\<^sub>2 n)) \<in> R\<close>
      using time_shift\<^sub>2[of \<open>a\<close> \<open>r\<^sub>2\<close> \<open>n\<close> \<open>r\<^sub>1\<close>]
            time_shift\<^sub>2[of \<open>b\<close> \<open>r\<^sub>2\<close> \<open>n\<close> \<open>r\<^sub>1\<close>] by simp
  } thus ?thesis unfolding LooseTagRelation_def by simp
qed

text \<open>
  Time delayed relations are preserved by composition.
\<close>
lemma timedelayed_prod1:
  assumes \<open>index (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>(r\<^sub>1 \<in> (a time-delayed by dt on b implies c))
        = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> ((shift\<^sub>1 a r\<^sub>1 r\<^sub>2) time-delayed by dt on (shift\<^sub>1 b r\<^sub>1 r\<^sub>2)
                                           implies (shift\<^sub>1 c r\<^sub>1 r\<^sub>2)))\<close>
unfolding TimeDelayed_def
using time_shift\<^sub>1[of \<open>a\<close> \<open>r\<^sub>1\<close> _ \<open>r\<^sub>2\<close>]
      time_shift\<^sub>1[of \<open>b\<close> \<open>r\<^sub>1\<close> _ \<open>r\<^sub>2\<close>]
      ticks_shift1[OF assms(1)]
      ticks_shift1[OF assms(2)] by simp

lemma timedelayed_prod2:
  \<open>(r\<^sub>2 \<in> (a time-delayed by dt on b implies c))
        = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> ((shift\<^sub>2 a r\<^sub>1 r\<^sub>2) time-delayed by dt on (shift\<^sub>2 b r\<^sub>1 r\<^sub>2)
                                           implies (shift\<^sub>2 c r\<^sub>1 r\<^sub>2)))\<close>
unfolding TimeDelayed_def
using time_shift\<^sub>2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      time_shift\<^sub>2[of \<open>b\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      ticks_shift2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      ticks_shift2[of \<open>c\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] by simp

text \<open>
  Delayed relations are preserved by composition.
\<close>
lemma delayed_prod1:
  assumes \<open>index (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>(r\<^sub>1 \<in> (a delayed by n on b implies c))
        = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> ((shift\<^sub>1 a r\<^sub>1 r\<^sub>2) delayed by n on (shift\<^sub>1 b r\<^sub>1 r\<^sub>2)
                                           implies (shift\<^sub>1 c r\<^sub>1 r\<^sub>2)))\<close>
unfolding Delayed_def
using tick_count_between_shift1[OF assms(2)]
      ticks_shift1[OF assms(1)]
      ticks_shift1[OF assms(3)] by simp

lemma delayed_prod2:
  \<open>(r\<^sub>2 \<in> (a delayed by n on b implies c))
        = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> ((shift\<^sub>2 a r\<^sub>1 r\<^sub>2) delayed by n on (shift\<^sub>2 b r\<^sub>1 r\<^sub>2)
          implies (shift\<^sub>2 c r\<^sub>1 r\<^sub>2)))\<close>
unfolding Delayed_def
using tick_count_between_shift2[of \<open>b\<close> \<open>r\<^sub>2\<close> _ _ \<open>r\<^sub>1\<close>]
      ticks_shift2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      ticks_shift2[of \<open>c\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] by simp

text \<open>
  Filtered relations are preserved by composition.
\<close>
\<^cancel>\<open>declare [[show_sorts]]\<close>
lemma filtered_prod1:
  assumes \<open>index (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>(r\<^sub>1 \<in> (a filtered by s, k (rs, rk)* implies b))
        = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> ((shift\<^sub>1 a r\<^sub>1 r\<^sub>2) filtered by s, k (rs, rk)*
                                           implies (shift\<^sub>1 b r\<^sub>1 r\<^sub>2)))\<close>
unfolding Filtered_def
using ticks_shift1[OF assms(1)]
      ticks_shift1[OF assms(2)]
      tick_count_shift1[OF assms(1)] by simp

lemma filtered_prod2:
  \<open>(r\<^sub>2 \<in> (a filtered by s, k (rs, rk)* implies b))
        = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> ((shift\<^sub>2 a r\<^sub>1 r\<^sub>2) filtered by s, k (rs, rk)*
          implies (shift\<^sub>2 b r\<^sub>1 r\<^sub>2)))\<close>
unfolding Filtered_def
using ticks_shift2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      ticks_shift2[of \<open>b\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      tick_count_shift2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] by simp

text \<open>
  Await relations are preserved by composition.
\<close>
lemma await_prod1:
  assumes \<open>index (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>(r\<^sub>1 \<in> (await a, b implies c))
        = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> (await (shift\<^sub>1 a r\<^sub>1 r\<^sub>2), (shift\<^sub>1 b r\<^sub>1 r\<^sub>2)
                                          implies (shift\<^sub>1 c r\<^sub>1 r\<^sub>2)))\<close>
unfolding Await_def
using have_both_ticked_shift11[OF assms(1-2)]
      ticks_shift1[OF assms(3)] by simp

lemma await_prod2:
  \<open>(r\<^sub>2 \<in> (await a, b implies c))
        = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> (await (shift\<^sub>2 a r\<^sub>1 r\<^sub>2), (shift\<^sub>2 b r\<^sub>1 r\<^sub>2)
                                          implies (shift\<^sub>2 c r\<^sub>1 r\<^sub>2)))\<close>
unfolding Await_def
using have_both_ticked_shift22[of \<open>a\<close> \<open>b\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      ticks_shift2[of \<open>c\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] by simp

text \<open>
  Sustain relations are preserved by composition.
\<close>
lemma sustain_prod1:
  assumes \<open>index (shift\<^sub>1 a r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  assumes \<open>index (shift\<^sub>1 d r\<^sub>1 r\<^sub>2) < rank r\<^sub>1\<close>
  shows   \<open>(r\<^sub>1 \<in> (a sustained from b to c implies d))
        = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> ((shift\<^sub>1 a r\<^sub>1 r\<^sub>2) sustained
                            from (shift\<^sub>1 b r\<^sub>1 r\<^sub>2) to (shift\<^sub>1 c r\<^sub>1 r\<^sub>2) implies (shift\<^sub>1 d r\<^sub>1 r\<^sub>2)))\<close>
unfolding SustainFromTo_def
using between_shift1[OF assms(2-3)]
      ticks_shift1[OF assms(1)]
      ticks_shift1[OF assms(4)] by simp

lemma sustain_prod2:
  \<open>(r\<^sub>2 \<in> (a sustained from b to c implies d))
        = ((r\<^sub>1 \<times>\<^sub>r\<^sub>u\<^sub>n r\<^sub>2) \<in> ((shift\<^sub>2 a r\<^sub>1 r\<^sub>2) sustained
                            from (shift\<^sub>2 b r\<^sub>1 r\<^sub>2) to (shift\<^sub>2 c r\<^sub>1 r\<^sub>2) implies (shift\<^sub>2 d r\<^sub>1 r\<^sub>2)))\<close>
unfolding SustainFromTo_def
using between_shift2[of \<open>b\<close> \<open>c\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      ticks_shift2[of \<open>a\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>]
      ticks_shift2[of \<open>d\<close> \<open>r\<^sub>2\<close> _ \<open>r\<^sub>1\<close>] by simp

end


header {* \isaheader{Static data dependence} *}

theory DataDependence imports "../Basic/DynDataDependence" begin

context CFG_wf begin

definition data_dependence :: "'node \<Rightarrow> 'var \<Rightarrow> 'node \<Rightarrow> bool"
    ("_ influences _ in _" [51,0])
where data_dependences_eq:"n influences V in n' \<equiv> \<exists>as. n influences V in n' via as"

lemma data_dependence_def: "n influences V in n' =
  (\<exists>a' as'. (V \<in> Def n) \<and> (V \<in> Use n') \<and>
                 (n -a'#as'\<rightarrow>* n') \<and> (\<forall>n'' \<in> set (sourcenodes as'). V \<notin> Def n''))"
by(auto simp:data_dependences_eq dyn_data_dependence_def)

end

end


(*  Title:      HOL/Auth/NS_Public.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1996  University of Cambridge

Inductive relation "ns_public" for the Needham-Schroeder Public-Key protocol.
Version incorporating Lowe's fix (inclusion of B's identity in round 2).
*)

section\<open>Verifying the Needham-Schroeder-Lowe Public-Key Protocol\<close>

theory NS_Public imports Public begin

inductive_set ns_public :: "event list set"
  where
         (*Initial trace is empty*)
   Nil:  "[] \<in> ns_public"

         (*The spy MAY say anything he CAN say.  We do not expect him to
           invent new nonces here, but he can also use NS1.  Common to
           all similar protocols.*)
 | Fake: "\<lbrakk>evsf \<in> ns_public;  X \<in> synth (analz (spies evsf))\<rbrakk>
          \<Longrightarrow> Says Spy B X  # evsf \<in> ns_public"

         (*Alice initiates a protocol run, sending a nonce to Bob*)
 | NS1:  "\<lbrakk>evs1 \<in> ns_public;  Nonce NA \<notin> used evs1\<rbrakk>
          \<Longrightarrow> Says A B (Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>)
                 # evs1  \<in>  ns_public"

         (*Bob responds to Alice's message with a further nonce*)
 | NS2:  "\<lbrakk>evs2 \<in> ns_public;  Nonce NB \<notin> used evs2;
           Says A' B (Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs2\<rbrakk>
          \<Longrightarrow> Says B A (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>)
                # evs2  \<in>  ns_public"

         (*Alice proves her existence by sending NB back to Bob.*)
 | NS3:  "\<lbrakk>evs3 \<in> ns_public;
           Says A  B (Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs3;
           Says B' A (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>)
              \<in> set evs3\<rbrakk>
          \<Longrightarrow> Says A B (Crypt (pubEK B) (Nonce NB)) # evs3 \<in> ns_public"

declare knows_Spy_partsEs [elim]
declare knows_Spy_partsEs [elim]
declare analz_into_parts [dest]
declare Fake_parts_insert_in_Un [dest]

(*A "possibility property": there are traces that reach the end*)
lemma "\<exists>NB. \<exists>evs \<in> ns_public. Says A B (Crypt (pubEK B) (Nonce NB)) \<in> set evs"
apply (intro exI bexI)
apply (rule_tac [2] ns_public.Nil [THEN ns_public.NS1, THEN ns_public.NS2,
                                   THEN ns_public.NS3], possibility)
done

(** Theorems of the form X \<notin> parts (spies evs) imply that NOBODY
    sends messages containing X! **)

(*Spy never sees another agent's private key! (unless it's bad at start)*)
lemma Spy_see_priEK [simp]:
      "evs \<in> ns_public \<Longrightarrow> (Key (priEK A) \<in> parts (spies evs)) = (A \<in> bad)"
by (erule ns_public.induct, auto)

lemma Spy_analz_priEK [simp]:
      "evs \<in> ns_public \<Longrightarrow> (Key (priEK A) \<in> analz (spies evs)) = (A \<in> bad)"
by auto

subsection\<open>Authenticity properties obtained from NS2\<close>

(*It is impossible to re-use a nonce in both NS1 and NS2, provided the nonce
  is secret.  (Honest users generate fresh nonces.)*)

(*Unicity for NS1: nonce NA identifies agents A and B*)
lemma unique_NA:
     "\<lbrakk>Crypt(pubEK B)  \<lbrace>Nonce NA, Agent A \<rbrace> \<in> parts(spies evs);
       Crypt(pubEK B') \<lbrace>Nonce NA, Agent A'\<rbrace> \<in> parts(spies evs);
       Nonce NA \<notin> analz (spies evs); evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> A=A' \<and> B=B'"
apply (erule rev_mp, erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all)
(*Fake, NS1*)
apply (blast intro: analz_insertI)+
done

(*Secrecy: Spy does not see the nonce sent in msg NS1 if A and B are secure
  The major premise "Says A B ..." makes it a dest-rule, so we use
  (erule rev_mp) rather than rule_format. *)
theorem Spy_not_see_NA:
      "\<lbrakk>Says A B (Crypt(pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs;
        A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
       \<Longrightarrow> Nonce NA \<notin> analz (spies evs)"
apply (erule rev_mp)
apply (erule ns_public.induct, simp_all, spy_analz)
apply (blast dest: unique_NA intro: no_nonce_NS1_NS2)+
done

(*Authentication for A: if she receives message 2 and has used NA
  to start a run, then B has sent message 2.*)
lemma A_trusts_NS2_lemma [rule_format]:
   "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
    \<Longrightarrow> Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace> \<in> parts (spies evs) \<longrightarrow>
        Says A B (Crypt(pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs \<longrightarrow>
        Says B A (Crypt(pubEK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs"
apply (erule ns_public.induct, simp_all)
(*Fake, NS1*)
apply (blast dest: Spy_not_see_NA)+
done

theorem A_trusts_NS2:
     "\<lbrakk>Says A  B (Crypt(pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs;
       Says B' A (Crypt(pubEK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> Says B A (Crypt(pubEK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs"
by (blast intro: A_trusts_NS2_lemma)

(*If the encrypted message appears then it originated with Alice in NS1*)
lemma B_trusts_NS1 [rule_format]:
     "evs \<in> ns_public
      \<Longrightarrow> Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace> \<in> parts (spies evs) \<longrightarrow>
          Nonce NA \<notin> analz (spies evs) \<longrightarrow>
          Says A B (Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs"
apply (erule ns_public.induct, simp_all)
(*Fake*)
apply (blast intro!: analz_insertI)
done

subsection\<open>Authenticity properties obtained from NS2\<close>

(*Unicity for NS2: nonce NB identifies nonce NA and agents A, B
  [unicity of B makes Lowe's fix work]
  [proof closely follows that for unique_NA] *)

lemma unique_NB [dest]:
     "\<lbrakk>Crypt(pubEK A)  \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace> \<in> parts(spies evs);
       Crypt(pubEK A') \<lbrace>Nonce NA', Nonce NB, Agent B'\<rbrace> \<in> parts(spies evs);
       Nonce NB \<notin> analz (spies evs); evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> A=A' \<and> NA=NA' \<and> B=B'"
apply (erule rev_mp, erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all)
(*Fake, NS2*)
apply (blast intro: analz_insertI)+
done

(*Secrecy: Spy does not see the nonce sent in msg NS2 if A and B are secure*)
theorem Spy_not_see_NB [dest]:
     "\<lbrakk>Says B A (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> Nonce NB \<notin> analz (spies evs)"
apply (erule rev_mp)
apply (erule ns_public.induct, simp_all, spy_analz)
apply (blast intro: no_nonce_NS1_NS2)+
done

(*Authentication for B: if he receives message 3 and has used NB
  in message 2, then A has sent message 3.*)
lemma B_trusts_NS3_lemma [rule_format]:
     "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk> \<Longrightarrow>
      Crypt (pubEK B) (Nonce NB) \<in> parts (spies evs) \<longrightarrow>
      Says B A (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs \<longrightarrow>
      Says A B (Crypt (pubEK B) (Nonce NB)) \<in> set evs"
by (erule ns_public.induct, auto)

theorem B_trusts_NS3:
     "\<lbrakk>Says B A  (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs;
       Says A' B (Crypt (pubEK B) (Nonce NB)) \<in> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> Says A B (Crypt (pubEK B) (Nonce NB)) \<in> set evs"
by (blast intro: B_trusts_NS3_lemma)

subsection\<open>Overall guarantee for B\<close>

(*If NS3 has been sent and the nonce NB agrees with the nonce B joined with
  NA, then A initiated the run using NA.*)
theorem B_trusts_protocol:
     "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk> \<Longrightarrow>
      Crypt (pubEK B) (Nonce NB) \<in> parts (spies evs) \<longrightarrow>
      Says B A  (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs \<longrightarrow>
      Says A B (Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs"
by (erule ns_public.induct, auto)

end


theory week04B_demo imports Main begin

\<comment> \<open>------------------------------------------------------------------\<close>

text \<open>implicit backtracking\<close>
lemma "\<lbrakk>P \<and> Q; R \<and> S\<rbrakk> \<Longrightarrow> S"
  (* doesn't work -- picks the wrong assumption
  apply(erule conjE)
  apply assumption  *)
  apply(erule conjE, assumption)
  done

text \<open>do (n) assumption steps\<close>
lemma "\<lbrakk>P \<and> Q\<rbrakk> \<Longrightarrow> P"
  apply(erule (1) conjE)
  done

text \<open>'by' does extra assumption steps implicitly\<close>
lemma "\<lbrakk>P \<and> Q\<rbrakk> \<Longrightarrow> P"
  by(erule conjE)

text \<open>more automation\<close>

\<comment> \<open>clarsimp: repeated clarify and simp\<close>
lemma "ys = []  \<Longrightarrow> \<forall>xs. xs @ ys = []"
  apply clarsimp
  oops

\<comment> \<open>auto: simplification, classical reasoning, more\<close>
lemma "(\<exists>u::nat. x=y+u) \<longrightarrow> a*(b+c)+y \<le> x + a*b+a*c" thm add_mult_distrib2
  apply (auto simp add: add_mult_distrib2)
  done

\<comment> \<open>limit auto (and any other tactic) to first [n] goals\<close>
lemma "(True \<and> True)"
  apply(rule conjI)
   apply(auto)[1]
  apply(rule TrueI)
  done

\<comment> \<open>also try: fastforce and force\<close>

print_simpset

text \<open>simplification with assumptions, more control:\<close>

lemma "\<forall>x. f x = g x \<and> g x = f x \<Longrightarrow> f [] = f [] @ []"
  \<comment> \<open>would diverge:\<close>
  (*
  apply(simp)
  *)
  apply(simp (no_asm))
  done

\<comment> \<open>------------------------------------------------------\<close>

\<comment> \<open>let expressions\<close>

lemma "let a = f x in g a = x"
  apply (simp add: Let_def)
  oops

thm Let_def

term "let a = f x in g a"
term "(let a = f x in g (a + a)) = (Let (f x) (\<lambda>a. g (a + a)))"
\<comment> \<open>------------------------------------------------------\<close>

\<comment> \<open>splitting case: manually\<close>

lemma "(case n of 0 \<Rightarrow> x | Suc n' \<Rightarrow> x) = x"
  apply (simp only: split: nat.splits)
  apply simp
  done

\<comment> \<open>splitting if: automatic in conclusion\<close>

lemma "\<lbrakk> P; Q \<rbrakk> \<Longrightarrow> (if x then A else B) = z"
  apply simp
  oops

thm if_splits
thm if_split_asm

lemma "\<lbrakk> (if x then A else B) = z; Q \<rbrakk> \<Longrightarrow> P"
   apply(simp split: if_splits) (*
   apply (simp split: if_split_asm)*)
  oops

lemma " ((if x then A else B) =z) \<longrightarrow> (z=A\<or>z=B)"
  apply simp
done

thm conj_cong

lemma "A \<and> (A \<longrightarrow> B)"
  apply (simp cong: conj_cong)
  oops

thm if_cong

lemma "\<lbrakk> (if x then x \<longrightarrow> z else B) = z; Q \<rbrakk> \<Longrightarrow> P"
  apply (simp cong: if_cong)
  oops

thm add_ac
thm mult_ac

lemmas all_ac = add_ac mult_ac
print_theorems

lemma
  fixes f :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infix "\<odot>" 70)
  assumes A: "\<And>x y z. (x \<odot> y) \<odot> z = x \<odot> (y \<odot> z)"
  assumes C: "\<And>x y. x \<odot> y = y \<odot> x"
  assumes AC: "\<And>x y z. x \<odot> (y \<odot> z) = y \<odot> (x \<odot> z)"
  shows "(z \<odot> x) \<odot> (y \<odot> v) = v \<odot> (x \<odot> (y\<odot> z))"
  apply (simp only: C)
  apply (simp only: A C)
  apply (simp only: AC)
  done

text \<open>when all else fails: tracing the simplifier

typing
  declare [[simp_trace]]        turns tracing on,
  declare [[simp_trace=false]]  turns tracing off
(within a proof, write 'using' rather than 'declare')
\<close>

declare [[simp_trace]]
lemma "A \<and> (A \<longrightarrow> B)"
  apply (simp cong: conj_cong)
  oops
declare [[simp_trace=false]]

\<comment> \<open>single stepping: subst\<close>

thm add.commute
thm add.assoc
declare add.assoc [simp]

lemma "a + b = x + ((y::nat) + z)"
thm add.assoc[symmetric]
  apply (simp add: add.assoc [symmetric] del: add.assoc)
thm add.commute
  apply (subst add.commute [where a=x])
  oops

end


theory MDP_RP_Certification
imports
  "../MDP_Reachability_Problem"
  "~~/src/HOL/Library/IArray"
  "~~/src/HOL/Library/Code_Target_Numeral"
begin

context Reachability_Problem
begin

lemma p_ub':
  fixes x
  assumes 1: "s \<in> S" "\<And>s D. s \<in> S1 \<Longrightarrow> D \<in> K s \<Longrightarrow> (\<Sum>t\<in>S. pmf D t * x t) \<le> x s"
  assumes 2: "\<And>s. s \<in> S1 \<Longrightarrow> x s \<noteq> 0 \<Longrightarrow> (\<exists>t\<in>S2. (s, t) \<in> (SIGMA s:S1. \<Union>D\<in>K s. set_pmf D)\<^sup>*)"
  assumes 3: "\<And>s. s \<in> S - S1 - S2 \<Longrightarrow> x s = 0"
  assumes 4: "\<And>s. s \<in> S2 \<Longrightarrow> x s = 1"
  shows "real (p s) \<le> x s"
proof (rule p_ub[OF 1 _ 4])
  fix s assume "s \<in> S" "p s = 0" with 2[of s] p_pos[of s] p_nonneg[of s] p_S2[of s] 3[of s] show "x s = 0"
    by (metis zero_neq_one not_less DiffI)
qed

lemma n_lb':
  fixes x
  assumes "wf R"
  assumes 1: "s \<in> S" "\<And>s D. s \<in> S1 \<Longrightarrow> D \<in> K s \<Longrightarrow> x s \<le> (\<Sum>t\<in>S. pmf D t * x t)"
  assumes 2: "\<And>s D. s \<in> S1 \<Longrightarrow> D \<in> K s \<Longrightarrow> x s \<noteq> 0 \<Longrightarrow> \<exists>t\<in>D. ((t, s) \<in> R \<and> t \<in> S1 \<and> x t \<noteq> 0) \<or> t \<in> S2"
  assumes 3: "\<And>s. s \<in> S - S1 - S2 \<Longrightarrow> x s = 0"
  assumes 4: "\<And>s. s \<in> S2 \<Longrightarrow> x s = 1"
  shows "x s \<le> real (n s)"
proof (rule n_lb[OF 1 _ 4])
  fix s assume *: "s \<in> S" "n s = 0"
  show "x s = 0"
  proof (rule ccontr)
    assume "x s \<noteq> 0"
    with * n_S2[of s] n_nS12[of s] 3[of s] have "s \<in> S1"
      by (metis DiffI zero_neq_one)
    have "0 < n s"
      by (intro n_pos[of "\<lambda>s. x s \<noteq> 0", OF `x s \<noteq> 0` `s \<in> S1` `wf R`])
         (metis ereal_0_less_1 n_S2 2)
    with `n s = 0` show False by auto
  qed
qed

end

no_notation Stream.snth (infixl "!!" 100) -- {* we use @{text "!!"} for IArray *}

subsection {* Computable representation *}

record mdp_reachability_problem =
  state_count :: nat
  distrs :: "(nat \<times> rat) list list iarray"
  states1 :: "bool iarray"
  states2 :: "bool iarray"

record 'a RP_sub_cert =
  solution :: "rat iarray"
  witness :: "('a \<times> nat) iarray"

record RP_cert =
  pos_cert :: "(nat \<times> nat) RP_sub_cert"
  neg_cert :: "nat list RP_sub_cert"

definition "sparse_mult sx y = listsum (map (\<lambda>(n, x). x * y !! n) sx)"

primrec lookup where
  "lookup d [] x = d"
| "lookup d (y#ys) x = (if fst y = x then snd y else lookup d ys x)"

lemma lookup_eq_map_of: "lookup d xs x = (case map_of xs x of Some x \<Rightarrow> x | None \<Rightarrow> d)"
  by (induct xs) simp_all

lemma sparse_mult_eq_setsum_lookup:
  fixes xs :: "(nat \<times> 'a::comm_semiring_1) list"
  assumes "list_all (\<lambda>(n, x). n < M) xs" "distinct (map fst xs)"
  shows "sparse_mult xs y = (\<Sum>i<M. lookup 0 xs i * y !! i)"
proof -
  from `distinct (map fst xs)` have "distinct xs" "inj_on fst (set xs)"
    by (simp_all add: distinct_map)
  then have "sparse_mult xs y = (\<Sum>x\<in>set xs. snd x * y !! fst x)"
    by (auto intro!: setsum.cong simp add: sparse_mult_def listsum_distinct_conv_setsum_set)
  also have "\<dots> = (\<Sum>x\<in>set xs. lookup 0 xs (fst x) * y !! fst x)"
    by (intro setsum.cong refl arg_cong2[where f="op *"]) (simp add: lookup_in_set assms)
  also have "\<dots> = (\<Sum>x\<in>fst ` set xs. lookup 0 xs x * y !! x)"
    using `inj_on fst (set xs)` by (simp add: setsum.reindex)
  also have "\<dots> = (\<Sum>x<M. lookup 0 xs x * y !! x)"
    using assms(1)
    by (intro setsum.mono_neutral_cong_left)
       (auto simp: list_all_iff lookup_eq_map_of map_of_eq_None_iff[THEN iffD2])
  finally show ?thesis .
qed

lemma listsum_eq_setsum_lookup:
  fixes xs :: "(nat \<times> 'a::comm_semiring_1) list"
  assumes "list_all (\<lambda>(n, x). n < M) xs" "distinct (map fst xs)"
  shows "listsum (map snd xs) = (\<Sum>i<M. lookup 0 xs i)"
proof -
  from `distinct (map fst xs)` have "distinct xs" "inj_on fst (set xs)"
    by (simp_all add: distinct_map)
  then have "listsum (map snd xs) = (\<Sum>x\<in>set xs. snd x)"
    by (auto intro!: setsum.cong simp add: sparse_mult_def listsum_distinct_conv_setsum_set)
  also have "\<dots> = (\<Sum>x\<in>set xs. lookup 0 xs (fst x))"
    by (intro setsum.cong refl arg_cong2[where f="op *"]) (simp add: lookup_in_set assms)
  also have "\<dots> = (\<Sum>x\<in>fst ` set xs. lookup 0 xs x)"
    using `inj_on fst (set xs)` by (simp add: setsum.reindex)
  also have "\<dots> = (\<Sum>x<M. lookup 0 xs x)"
    using assms(1)
    by (intro setsum.mono_neutral_cong_left)
       (auto simp: list_all_iff lookup_eq_map_of map_of_eq_None_iff[THEN iffD2])
  finally show ?thesis .
qed

definition
  "valid_mdp_rp mdp \<longleftrightarrow>
    0 < state_count mdp \<and>
    IArray.length (distrs mdp) = state_count mdp \<and>
    IArray.length (states1 mdp) = state_count mdp \<and>
    IArray.length (states2 mdp) = state_count mdp \<and>
    (\<forall>i<state_count mdp. \<not> (states1 mdp !! i \<and> states2 mdp !! i) \<and>
      list_all (\<lambda>ds. distinct (map fst ds) \<and> list_all (\<lambda>(n, x). 0 \<le> x \<and> n < state_count mdp) ds \<and>
                     listsum (map snd ds) = 1) (distrs mdp !! i) \<and>
      \<not> List.null (distrs mdp !! i))"

definition
  "valid_sub_cert mdp c ord check \<longleftrightarrow>
    IArray.length (witness c) = state_count mdp \<and>
    IArray.length (solution c) = state_count mdp \<and>
    (\<forall>i<state_count mdp.
      if states2 mdp !! i then solution c !! i = 1
      else if states1 mdp !! i then 0 \<le> solution c !! i \<and>
        (list_all (\<lambda>ds. ord (sparse_mult ds (solution c)) (solution c !! i)) (distrs mdp !! i)) \<and>
        (0 < solution c !! i \<longrightarrow> check (distrs mdp !! i) (witness c !! i))
      else solution c !! i = 0)"

definition
  "valid_pos_cert mdp c \<longleftrightarrow>
    valid_sub_cert mdp c (op \<le>)
      (\<lambda>D ((j, a), n). j < state_count mdp \<and> snd (witness c !! j) < n \<and> 0 < solution c !! j \<and>
        a < length D \<and> lookup 0 (D ! a) j \<noteq> 0)"

definition
  "valid_neg_cert mdp c \<longleftrightarrow>
    valid_sub_cert mdp c (op \<ge>)
      (\<lambda>D (J, n). list_all2 (\<lambda>j d. j < state_count mdp \<and> snd (witness c !! j) < n \<and>
        lookup 0 d j \<noteq> 0 \<and> 0 < solution c !! j) J D)"

definition
  "valid_cert mdp c \<longleftrightarrow> valid_pos_cert mdp (pos_cert c) \<and> valid_neg_cert mdp (neg_cert c)"

lemma valid_mdp_rpD_length:
  assumes "valid_mdp_rp mdp"
  shows "0 < state_count mdp" "IArray.length (distrs mdp) = state_count mdp"
    "IArray.length (states1 mdp) = state_count mdp" "IArray.length (states2 mdp) = state_count mdp"
  using assms by (auto simp: valid_mdp_rp_def)

lemma valid_mdp_rpD:
  assumes "valid_mdp_rp mdp" "i < state_count mdp"
  shows "\<not> (states1 mdp !! i \<and> states2 mdp !! i)"
    and "\<And>ds n x. ds \<in> set (distrs mdp !! i) \<Longrightarrow> (n, x) \<in> set ds \<Longrightarrow> n < state_count mdp"
    and "\<And>ds n x. ds \<in> set (distrs mdp !! i) \<Longrightarrow> (n, x) \<in> set ds \<Longrightarrow> 0 \<le> x"
    and "\<And>ds. ds \<in> set (distrs mdp !! i) \<Longrightarrow> listsum (map snd ds) = 1"
    and "\<And>ds. ds \<in> set (distrs mdp !! i) \<Longrightarrow> distinct (map fst ds)"
    and "distrs mdp !! i \<noteq> []"
  using assms by (auto simp: valid_mdp_rp_def list_all_iff List.null_def elim!: allE[of _ i])

lemma valid_mdp_rp_sparse_mult:
  assumes "valid_mdp_rp mdp" "i < state_count mdp" "ds \<in> set (distrs mdp !! i)"
  shows "sparse_mult ds y = (\<Sum>i<state_count mdp. lookup 0 ds i * y !! i)"
  using valid_mdp_rpD(2,5)[OF assms] by (intro sparse_mult_eq_setsum_lookup) (auto simp: list_all_iff)

lemma valid_sub_certD:
  assumes "valid_mdp_rp mdp" "valid_sub_cert mdp c ord check" "i < state_count mdp"
  shows "\<not> states1 mdp !! i \<Longrightarrow> \<not> states2 mdp !! i \<Longrightarrow> solution c !! i = 0"
    and "states2 mdp !! i \<Longrightarrow> solution c !! i = 1"
    and "states1 mdp !! i \<Longrightarrow> 0 \<le> solution c !! i"
    and "\<And>ds. states1 mdp !! i \<Longrightarrow> ds \<in> set (distrs mdp !! i) \<Longrightarrow> ord (sparse_mult ds (solution c)) (solution c !! i)"
    and "\<And>ds. states1 mdp !! i \<Longrightarrow> 0 < solution c !! i \<longrightarrow> check (distrs mdp !! i) (witness c !! i)"
  using assms(2,3) valid_mdp_rpD(1)[OF assms(1,3)]
  by (auto simp add: valid_sub_cert_def list_all_iff)

lemma valid_pos_certD:
  assumes "valid_mdp_rp mdp" "valid_pos_cert mdp c" "i < state_count mdp" "states1 mdp !! i"
    "0 < solution c !! i" "witness c !! i = ((j, a), n)"
  shows "snd (witness c !! j) < n \<and> j < state_count mdp \<and> a < length (distrs mdp !! i) \<and>
          lookup 0 ((distrs mdp !! i) ! a) j \<noteq> 0 \<and> 0 < solution c !! j"
  using valid_sub_certD(5)[OF assms(1) assms(2)[unfolded valid_pos_cert_def] assms(3,4)] assms(5-) by auto

lemma valid_neg_certD:
  assumes "valid_mdp_rp mdp" "valid_neg_cert mdp c" "i < state_count mdp" "states1 mdp !! i"
    "0 < solution c !! i" "witness c !! i = (js, n)"
  shows "list_all2 (\<lambda>j ds. j < state_count mdp \<and> snd (witness c !! j) < n \<and> lookup 0 ds j \<noteq> 0 \<and> 0 < solution c !! j) js (distrs mdp !! i)"
  using valid_sub_certD(5)[OF assms(1) assms(2)[unfolded valid_neg_cert_def] assms(3)] assms(4-) by auto

context
  fixes mdp c
  assumes rp: "valid_mdp_rp mdp"
  assumes cert: "valid_cert mdp c"
begin

interpretation pmf_as_function .

abbreviation "S \<equiv> {..< state_count mdp}"
abbreviation "S1 \<equiv> {i. i < state_count mdp \<and> (states1 mdp) !! i}"
abbreviation "S2 \<equiv> {i. i < state_count mdp \<and> (states2 mdp) !! i}"

lift_definition K :: "nat \<Rightarrow> nat pmf set" is
  "\<lambda>i. if i < state_count mdp then
     { (\<lambda>j. of_rat (lookup 0 D j) :: real) | D. D \<in> set (distrs mdp !! i) }
     else { indicator {0} }"
proof (auto split: split_if_asm simp del: IArray.sub_def)
  fix n D assume n: "n < state_count mdp" and D: "D \<in> set (distrs mdp !! n)"
  from valid_mdp_rpD(3)[OF rp this] show nn: "\<And>i. 0 \<le> lookup 0 D i"
    by (auto simp add: lookup_eq_map_of split: option.split dest: map_of_SomeD)
  show "(\<integral>\<^sup>+ x. ereal (real_of_rat (lookup 0 D x)) \<partial>count_space UNIV) = 1"
    using valid_mdp_rpD(2,3,4,5)[OF rp n D]
    apply (subst nn_integral_count_space'[of "{..< state_count mdp}"])
    apply (auto intro: nn simp: of_rat_setsum[symmetric])
    defer
    apply (subst listsum_eq_setsum_lookup[symmetric])
    apply (auto simp: list_all_iff lookup_eq_map_of split: option.split)
    done
next
  show "(\<integral>\<^sup>+ x. ereal (indicator {0} x) \<partial>count_space UNIV) = 1"
    by (subst nn_integral_count_space'[of "{0}"]) auto
qed

interpretation MDP!: Reachability_Problem K S S1 S2
proof
  show "S1 \<inter> S2 = {}" "S1 \<subseteq> S" "S2 \<subseteq> S"
    using valid_mdp_rpD(1)[OF rp] by auto
  show "finite S" "S \<noteq> {}"
    using `valid_mdp_rp mdp` by (auto simp add: valid_mdp_rp_def)
  show "\<And>s. K s \<noteq> {}"
    using valid_mdp_rpD(6)[OF rp] by transfer simp
  show "\<And>s. finite (K s)"
    by transfer simp

  fix s assume "s \<in> S" then show "(\<Union>D\<in>K s. set_pmf D) \<subseteq> S"
    using valid_mdp_rpD(2)[OF rp]
    by transfer (auto simp: lookup_eq_map_of split: option.splits dest!: map_of_SomeD)
qed

definition "P_max s = real (MDP.p s)"
definition "P_min s = real (MDP.n s)"

lemma
  assumes "i < state_count mdp"
  shows P_max: "P_max i \<le> solution (pos_cert c) !! i" (is ?max)
    and P_min: "P_min i \<ge> solution (neg_cert c) !! i" (is ?min)
proof -
  have "valid_pos_cert mdp (pos_cert c)" "valid_neg_cert mdp (neg_cert c)"
    using `valid_cert mdp c` by (auto simp: valid_cert_def)
  note pos = this(1)[unfolded valid_pos_cert_def] and neg = this(2)[unfolded valid_neg_cert_def]

  let ?x = "\<lambda>s. real_of_rat (solution (pos_cert c) !! s)"
  have "real (MDP.p i) \<le> ?x i"
  proof (rule MDP.p_ub')
    show "i \<in> S" using assms by simp
  next
    fix s D assume "s \<in> S1" "D \<in> K s"
    then obtain j where j: "j < length (distrs mdp !! s)"
      "\<And>i. i < state_count mdp \<Longrightarrow> pmf D i = lookup 0 (distrs mdp !! s ! j) i"
      by transfer (auto simp: in_set_conv_nth)
    with valid_sub_certD(4)[OF `valid_mdp_rp mdp` pos, of s "distrs mdp !! s ! j"] `s \<in> S1`
         valid_mdp_rp_sparse_mult[OF `valid_mdp_rp mdp`, of s "distrs mdp !! s ! j" "solution (pos_cert c)"]
    show "(\<Sum>t\<in>S. pmf D t * ?x t) \<le> ?x s"
      by (simp add: of_rat_mult[symmetric] of_rat_setsum[symmetric] of_rat_less_eq j)
  next
    fix s a assume "s \<in> S2" then show "?x s = 1"
      using valid_sub_certD[OF `valid_mdp_rp mdp` pos] by simp
  next
    fix s def X \<equiv> "SIGMA s:S1. \<Union>D\<in>K s. set_pmf D"
    assume "s \<in> S1" "?x s \<noteq> 0"
    with valid_sub_certD(3)[OF rp pos, of s]
    have "0 < ?x s"
      by simp
    with `s\<in>S1` show "\<exists>t\<in>S2. (s, t) \<in> X\<^sup>*"
    proof (induction n\<equiv>"snd (witness (pos_cert c) !! s)" arbitrary: s rule: less_induct)
      case (less s)
      obtain t a n where eq: "witness (pos_cert c) !! s = ((t, a), n)"
        by (metis prod.exhaust)
      from valid_pos_certD[OF rp `valid_pos_cert mdp (pos_cert c)` _ _ _ this] less.prems
      have ord: "snd (witness (pos_cert c) !! t) < snd (witness (pos_cert c) !! s)"
        and t: "lookup 0 (distrs mdp !! s ! a) t \<noteq> 0" "0 < ?x t" "t\<in>S" "a < length (distrs mdp !! s)"
        unfolding eq by auto
      with `s\<in>S1` have X: "(s, t) \<in> X"
        unfolding X_def
        by (transfer fixing: s t a c)
           (auto simp: X_def in_set_conv_nth
                 intro!: exI[of _ "\<lambda>j. real_of_rat (lookup 0 (distrs mdp !! s ! a) j)"]
                         exI[of _ "distrs mdp !! s ! a"] exI[of _ a])
      show ?case
      proof cases
        assume "t \<in> S1"
        with less.hyps[OF ord _ `0 < ?x t`] X show ?thesis
          by auto
      next
        assume "t \<notin> S1"
        with valid_sub_certD[OF `valid_mdp_rp mdp` pos, of t] `0 < ?x t` `t\<in>S`
        have "t \<in> S2"
          by auto
        with X show ?thesis
          by auto
      qed
    qed
  next
    fix s assume "s \<in> S - S1 - S2" then show "?x s = 0"
      using valid_sub_certD(1)[OF `valid_mdp_rp mdp` pos, of s] by simp
  qed
  then show ?max
    by (simp add: P_max_def)

  let ?x = "\<lambda>s. real_of_rat (solution (neg_cert c) !! s)"
  have "?x i \<le> real (MDP.n i)"
  proof (rule MDP.n_lb')
    show "i \<in> S" using assms by simp
  next
    fix s D assume "s \<in> S1" "D \<in> K s"
    then obtain j where j: "j < length (distrs mdp !! s)"
      "\<And>i. i < state_count mdp \<Longrightarrow> pmf D i = lookup 0 (distrs mdp !! s ! j) i"
      by transfer (auto simp: in_set_conv_nth)
    with valid_sub_certD(4)[OF `valid_mdp_rp mdp` neg, of s "distrs mdp !! s ! j"] `s \<in> S1`
         valid_mdp_rp_sparse_mult[OF `valid_mdp_rp mdp`, of s "distrs mdp !! s ! j" "solution (neg_cert c)"]
    show "?x s \<le> (\<Sum>t\<in>S. pmf D t * ?x t)"
      by (simp add: of_rat_mult[symmetric] of_rat_setsum[symmetric] of_rat_less_eq j)
  next
    fix s a assume "s \<in> S2" then show "?x s = 1"
      using valid_sub_certD[OF `valid_mdp_rp mdp` neg] by simp
  next
    show "wf ((S \<times> S \<inter> {(s, t). snd (witness (neg_cert c) !! t) < snd (witness (neg_cert c) !! s)})\<inverse>)" (is "wf ?F")
      using `finite S`
      by (intro finite_acyclic_wf_converse acyclicI_order[where f="\<lambda>s. snd (witness (neg_cert c) !! s)"]) auto

    fix s D assume 2: "s \<in> S1" "D \<in> K s" and "?x s \<noteq> 0"
    then have "0 < ?x s"
      using valid_sub_certD(3)[OF `valid_mdp_rp mdp` neg, of s] by auto

    from 2 obtain a where a: "a < length (distrs mdp !! s)"
      "\<And>i. i < state_count mdp \<Longrightarrow> pmf D i = lookup 0 (distrs mdp !! s ! a) i"
      by transfer (auto simp: in_set_conv_nth)

    obtain js n where eq: "witness (neg_cert c) !! s = (js, n)"
      by (metis prod.exhaust)
    from valid_neg_certD[OF `valid_mdp_rp mdp` `valid_neg_cert mdp (neg_cert c)` _ _ _ eq] a `s \<in> S1` `0 < ?x s`
    have *: "length js = length (distrs mdp !! s)" "js ! a \<in> S"
      "snd (witness (neg_cert c) !! (js ! a)) < snd (witness (neg_cert c) !! s)"
      "lookup 0 (distrs mdp !! s ! a) (js ! a) \<noteq> 0"
      "0 < ?x (js ! a)"
      unfolding eq by (auto dest: list_all2_nthD2 list_all2_lengthD)
    with a `s \<in> S1` have js_a: "js ! a \<in> D" "(js ! a, s) \<in> ?F"
      by (auto simp: set_pmf_iff)

    show "\<exists>t\<in>D. (t, s) \<in> ?F \<and> t \<in> S1 \<and> ?x t \<noteq> 0 \<or> t \<in> S2"
    proof cases
      assume "js ! a \<in> S1" with js_a `0 < ?x (js ! a)` show ?thesis by auto
    next
      assume "js ! a \<notin> S1"
      with `0 < ?x (js ! a)` `js!a \<in> S` valid_sub_certD[OF rp neg, of "js ! a"]
      have "js ! a \<in> S2"
        by (auto simp:  less_le)
      with `js ! a \<in> D` show ?thesis
        by auto
    qed
  next
    fix s assume "s \<in> S - S1 - S2" then show "?x s = 0"
      using valid_sub_certD(1)[OF `valid_mdp_rp mdp` neg, of s] by simp
  qed
  then show ?min
    by (simp add: P_min_def)
qed

end

end


subsection "Subsumption and change of environment"

theory DenotLam5
  imports Main Lambda DeclSemAsDenot ValueProps
begin

lemma e_prim_intro[intro]: "\<lbrakk> VNat n1 \<in> E e1 \<rho>; VNat n2 \<in> E e2 \<rho>; v = VNat (f n1 n2) \<rbrakk>
    \<Longrightarrow> v \<in> E (EPrim f e1 e2) \<rho>" by auto

lemma e_prim_elim[elim]: "\<lbrakk> v \<in> E (EPrim f e1 e2) \<rho>;
   \<And> n1 n2. \<lbrakk> VNat n1 \<in> E e1 \<rho>; VNat n2 \<in> E e2 \<rho>; v = VNat (f n1 n2) \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
  by auto

lemma e_app_elim[elim]: "\<lbrakk> v3 \<in> E (EApp e1 e2) \<rho>;
  \<And> f v2 v2' v3'. \<lbrakk> VFun f \<in> E e1 \<rho>; v2 \<in> E e2 \<rho>; (v2',v3') \<in> set f; v2' \<sqsubseteq> v2; v3 \<sqsubseteq> v3' \<rbrakk> \<Longrightarrow> P
 \<rbrakk> \<Longrightarrow> P"
  by auto

lemma e_app_intro[intro]: "\<lbrakk> VFun f \<in> E e1 \<rho>; v2 \<in> E e2 \<rho>; (v2',v3') \<in> set f; v2' \<sqsubseteq> v2; v3 \<sqsubseteq> v3'\<rbrakk>
     \<Longrightarrow> v3 \<in> E (EApp e1 e2) \<rho>" by auto

lemma e_lam_intro[intro]: "\<lbrakk> v = VFun f;
      \<forall> v1 v2. (v1,v2) \<in> set f \<longrightarrow> v2 \<in> E e ((x,v1)#\<rho>) \<rbrakk>
    \<Longrightarrow> v \<in> E (ELam x e) \<rho>"
  by auto

lemma e_lam_intro2[intro]:
  "\<lbrakk> VFun f \<in> E (ELam x e) \<rho>; v2 \<in> E e ((x,v1)#\<rho>) \<rbrakk>
  \<Longrightarrow> VFun ((v1,v2)#f) \<in> E (ELam x e) \<rho>"
  by auto

lemma e_lam_intro3[intro]: "VFun [] \<in> E (ELam x e) \<rho>"
  by auto

lemma e_if_intro[intro]: "\<lbrakk> VNat n \<in> E e1 \<rho>; n = 0 \<longrightarrow> v \<in> E e3 \<rho>; n \<noteq> 0 \<longrightarrow> v \<in> E e2 \<rho> \<rbrakk>
    \<Longrightarrow> v \<in> E (EIf e1 e2 e3) \<rho>"
  by auto

lemma e_var_intro[elim]: "\<lbrakk> lookup \<rho> x = Some v'; v \<sqsubseteq> v' \<rbrakk> \<Longrightarrow> v \<in> E (EVar x) \<rho>"
  by auto

lemma e_var_elim[elim]: "\<lbrakk> v \<in> E (EVar x) \<rho>;
   \<And> v'. \<lbrakk> lookup \<rho> x = Some v'; v \<sqsubseteq> v' \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
  by auto

lemma e_lam_elim[elim]: "\<lbrakk> v \<in> E (ELam x e) \<rho>;
   \<And> f. \<lbrakk> v = VFun f; \<forall> v1 v2. (v1,v2) \<in> set f \<longrightarrow> v2 \<in> E e ((x,v1)#\<rho>) \<rbrakk>
    \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
  by auto

lemma e_lam_elim2[elim]: "\<lbrakk> VFun ((v1,v2)#f) \<in> E (ELam x e) \<rho>;
   \<lbrakk> v2 \<in> E e ((x,v1)#\<rho>) \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
  by auto

lemma e_if_elim[elim]: "\<lbrakk> v \<in> E (EIf e1 e2 e3) \<rho>;
   \<And> n. \<lbrakk> VNat n \<in> E e1 \<rho>; n = 0 \<longrightarrow> v \<in> E e3 \<rho>; n \<noteq> 0 \<longrightarrow> v \<in> E e2 \<rho> \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
  by auto

definition xenv_le :: "name set \<Rightarrow> env \<Rightarrow> env \<Rightarrow> bool" ("_ \<turnstile> _ \<sqsubseteq> _" [51,51,51] 52) where
  "X \<turnstile> \<rho> \<sqsubseteq> \<rho>' \<equiv> \<forall> x v. x \<in> X \<and> lookup \<rho> x = Some v \<longrightarrow> (\<exists> v'. lookup \<rho>' x = Some v' \<and> v \<sqsubseteq> v')"
declare xenv_le_def[simp]

proposition change_env_le: fixes v::val and \<rho>::env
  assumes de: "v \<in> E e \<rho>" and vp_v: "v' \<sqsubseteq> v" and rr: "FV e \<turnstile> \<rho> \<sqsubseteq> \<rho>'"
  shows "v' \<in> E e \<rho>'"
  using de rr vp_v
proof (induction e arbitrary: v v' \<rho> \<rho>' rule: exp.induct)
  case (EVar x v v' \<rho> \<rho>')
  from EVar obtain v2 where lx: "lookup \<rho> x = Some v2" and v_v2: "v \<sqsubseteq> v2" by auto
  from lx EVar obtain v3 where
    lx2: "lookup \<rho>' x = Some v3" and v2_v3: "v2 \<sqsubseteq> v3" by force
  from v_v2 v2_v3 have v_v3: "v \<sqsubseteq> v3" by (rule val_le_trans)
  from EVar v_v3 have vp_v3: "v' \<sqsubseteq> v3" using val_le_trans by blast
  from lx2 vp_v3 show ?case by (rule e_var_intro)
next
  case (ENat n) then show ?case by simp
next
  case (ELam x e)
  from ELam(2) obtain f where v: "v = VFun f" and
    body: "\<forall> v1 v2. (v1,v2) \<in> set f \<longrightarrow> v2 \<in> E e ((x,v1)#\<rho>)" by auto
  from v ELam(4) obtain f' where vp: "v' = VFun f'" and fp_f: "f' \<lesssim> f" by (case_tac v') auto
  from vp show ?case
  proof (simp, clarify)
    fix v1 v2 assume v12: "(v1,v2)\<in> set f'"
    from v12 fp_f obtain v3 v4 where v34: "(v3,v4) \<in> set f" and
      v31: "v3 \<sqsubseteq> v1" and v24: "v2 \<sqsubseteq> v4" by blast
    from v34 body have v4_E: "v4 \<in> E e ((x,v3)#\<rho>)" by blast
    from ELam(3) v31 have rr2: "FV e \<turnstile> ((x,v3)#\<rho>) \<sqsubseteq> ((x,v1)#\<rho>')" by auto
    from ELam(1) v24 v4_E rr2 show "v2 \<in> E e ((x,v1)#\<rho>')" by blast
  qed
next
  case (EApp e1 e2)
  from EApp(3) obtain f and v2::val and v2' v3' where f_e1: "VFun f \<in> E e1 \<rho>" and
    v2_e2: "v2 \<in> E e2 \<rho>" and v23p_f: "(v2',v3') \<in> set f" and v2p_v2: "v2' \<sqsubseteq> v2" and
    v_v3: "v \<sqsubseteq> v3'" by blast
  from EApp(4) have 1: "FV e1 \<turnstile> \<rho> \<sqsubseteq> \<rho>'" by auto
  have f_f: "VFun f \<sqsubseteq> VFun f" by auto
  from EApp(1) f_e1 1 f_f have f_e1b: "VFun f \<in> E e1 \<rho>'" by blast
  from EApp(4) have 2: "FV e2 \<turnstile> \<rho> \<sqsubseteq> \<rho>'" by auto
  from EApp(2) v2_e2 2 have v2_e2b: "v2 \<in> E e2 \<rho>'" by auto
  from EApp(5) v_v3 have vp_v3p: "v' \<sqsubseteq> v3'" by (rule val_le_trans)
  from f_e1b v2_e2b v23p_f v2p_v2 vp_v3p
  show ?case by auto
next
  case (EPrim f e1 e2)
  from EPrim(3) obtain n1 n2 where n1_e1: "VNat n1 \<in> E e1 \<rho>" and n2_e2: "VNat n2 \<in> E e2 \<rho>" and
    v: "v = VNat (f n1 n2)" by blast
  from EPrim(4) have 1: "FV e1 \<turnstile> \<rho> \<sqsubseteq> \<rho>'" by auto
  from EPrim(1) n1_e1 1 have n1_e1b: "VNat n1 \<in> E e1 \<rho>'" by blast
  from EPrim(4) have 2: "FV e2 \<turnstile> \<rho> \<sqsubseteq> \<rho>'" by auto
  from EPrim(2) n2_e2 2 have n2_e2b: "VNat n2 \<in> E e2 \<rho>'" by blast
  from v EPrim(5) have vp: "v' = VNat (f n1 n2)" by auto
  from n1_e1b n2_e2b vp show ?case by auto
next
  case (EIf e1 e2 e3)
  then show ?case
    apply simp apply clarify
    apply (rename_tac n) apply (rule_tac x=n in exI) apply (rule conjI)
     apply force
    apply force done
qed

\<comment> \<open>Subsumption is admissible\<close>
proposition e_sub: "\<lbrakk> v \<in> E e \<rho>; v' \<sqsubseteq> v \<rbrakk> \<Longrightarrow> v' \<in> E e \<rho>"
  apply (subgoal_tac "FV e \<turnstile> \<rho> \<sqsubseteq> \<rho>") using change_env_le apply blast apply auto done

lemma env_le_ext: fixes \<rho>::env assumes rr: "\<rho> \<sqsubseteq> \<rho>'" shows "((x,v)#\<rho>) \<sqsubseteq> ((x,v)#\<rho>')"
  using rr by (simp add: env_le_def)

lemma change_env: fixes \<rho>::env assumes de: "v \<in> E e \<rho>" and rr: "FV e \<turnstile> \<rho> \<sqsubseteq> \<rho>'" shows "v \<in> E e \<rho>'"
proof -
  have vv: "v \<sqsubseteq> v" by auto
  from de rr vv show ?thesis using change_env_le by blast
qed

lemma raise_env: fixes \<rho>::env assumes de: "v \<in> E e \<rho>" and rr: "\<rho> \<sqsubseteq> \<rho>'" shows "v \<in> E e \<rho>'"
  using de rr change_env env_le_def by auto

lemma env_eq_refl[simp]: fixes \<rho>::env shows "\<rho> \<approx> \<rho>" by (simp add: env_eq_def)

lemma eq_implies_le: fixes \<rho>::env shows "\<rho> \<approx> \<rho>' \<Longrightarrow> \<rho> \<sqsubseteq> \<rho>'"
  by (simp add: env_le_def env_eq_def)

lemma env_swap: fixes \<rho>::env assumes rr: "\<rho> \<approx> \<rho>'" and ve: "v \<in> E e \<rho>" shows "v \<in> E e \<rho>'"
  using rr ve apply (subgoal_tac "\<rho> \<sqsubseteq> \<rho>'") prefer 2 apply (rule eq_implies_le) apply blast
  apply (rule raise_env) apply auto done

lemma env_strengthen: "\<lbrakk> v \<in> E e \<rho>; \<forall> x. x \<in> FV e \<longrightarrow> lookup \<rho>' x = lookup \<rho> x \<rbrakk> \<Longrightarrow> v \<in> E e \<rho>'"
  using change_env by auto

end