section \<open>Adaptive Test Cases\<close>

text \<open>An ATC is a single input, acyclic, observable FSM, which is equivalent to a tree whose non-leaf
      states are labeled with inputs and whose edges are labeled with outputs.\<close>

theory Adaptive_Test_Case
  imports State_Separator
begin

definition is_ATC :: "('a,'b,'c) fsm \<Rightarrow> bool" where
  "is_ATC M = (single_input M \<and> acyclic M \<and> observable M)"

lemma is_ATC_from :
  assumes "t \<in> transitions A"
  and     "t_source t \<in> reachable_states A"
  and     "is_ATC A"
shows "is_ATC (from_FSM A (t_target t))"
  using from_FSM_single_input[of A]
        from_FSM_acyclic[OF reachable_states_next[OF assms(2,1)]]
        from_FSM_observable[of A]
        assms(3)
  unfolding is_ATC_def by fast

subsection \<open>Applying Adaptive Test Cases\<close>

(* FSM M passes ATC A if and only if the parallel execution of M and A does not visit a fail_state in A and M produces no output not allowed in A *)
fun pass_ATC' :: "('a,'b,'c) fsm \<Rightarrow> ('d,'b,'c) fsm \<Rightarrow> 'd set \<Rightarrow> nat \<Rightarrow> bool" where
  "pass_ATC' M A fail_states 0 = (\<not> (initial A \<in> fail_states))" |
  "pass_ATC' M A fail_states (Suc k) = ((\<not> (initial A \<in> fail_states)) \<and>
    (\<forall> x \<in> inputs A . h A (initial A,x) \<noteq> {} \<longrightarrow> (\<forall> (yM,qM) \<in> h M (initial M,x) . \<exists> (yA,qA) \<in> h A (initial A,x) . yM = yA \<and> pass_ATC' (from_FSM M qM) (from_FSM A qA) fail_states k)))"

(* Applies pass_ATC' for a depth of at most (size A) (i.e., an upper bound on the length of paths in A) *)
fun pass_ATC :: "('a,'b,'c) fsm \<Rightarrow> ('d,'b,'c) fsm \<Rightarrow> 'd set \<Rightarrow> bool" where
  "pass_ATC M A fail_states = pass_ATC' M A fail_states (size A)"

lemma pass_ATC'_initial :
  assumes "pass_ATC' M A FS k"
  shows "initial A \<notin> FS"
using assms by (cases k; auto)

lemma pass_ATC'_io :
  assumes "pass_ATC' M A FS k"
  and     "is_ATC A"
  and     "observable M"
  and     "(inputs A) \<subseteq> (inputs M)"
  and     "io@[ioA] \<in> L A"
  and     "io@[ioM] \<in> L M"
  and     "fst ioA = fst ioM"
  and     "length (io@[ioA]) \<le> k"
shows "io@[ioM] \<in> L A"
and   "io_targets A (io@[ioM]) (initial A) \<inter> FS = {}"
proof -
  have "io@[ioM] \<in> L A \<and> io_targets A (io@[ioM]) (initial A) \<inter> FS = {}"
    using assms proof (induction k arbitrary: io A M)
    case 0
    then show ?case by auto
  next
    case (Suc k)
    then show ?case proof (cases io)
      case Nil

      obtain tA where "tA \<in> transitions A"
                  and "t_source tA = initial A"
                  and "t_input tA = fst ioA"
                  and "t_output tA = snd ioA"
        using Nil \<open>io@[ioA] \<in> L A\<close> by auto
      then have "fst ioA \<in> (inputs A)"
        using fsm_transition_input by fastforce

      have "(t_output tA,t_target tA) \<in> h A (initial A,t_input tA)"
        using \<open>tA \<in> transitions A\<close> \<open>t_source tA = initial A\<close> unfolding h_simps
        by (metis (no_types, lifting) case_prodI mem_Collect_eq prod.collapse)
      then have "h A (initial A,fst ioA) \<noteq> {}"
        unfolding \<open>t_input tA = fst ioA\<close> by blast

      then have *: "\<And> yM qM . (yM,qM) \<in> h M (initial M,fst ioA) \<Longrightarrow> (\<exists> (yA,qA) \<in> h A (initial A,fst ioA) . yM = yA \<and> pass_ATC' (from_FSM M qM) (from_FSM A qA) FS k)"
        using Suc.prems(1) pass_ATC'_initial[OF Suc.prems(1)] unfolding pass_ATC'.simps
        using \<open>fst ioA \<in> FSM.inputs A\<close> by auto

      obtain tM where "tM \<in> transitions M"
                  and "t_source tM = initial M"
                  and "t_input tM = fst ioA"
                  and "t_output tM = snd ioM"
        using Nil \<open>io@[ioM] \<in> L M\<close> \<open>fst ioA = fst ioM\<close> by auto
      have "(t_output tM,t_target tM) \<in> h M (initial M,fst ioA)"
        using \<open>tM \<in> transitions M\<close> \<open>t_source tM = initial M\<close> \<open>t_input tM = fst ioA\<close> unfolding h_simps
        by (metis (mono_tags, lifting) case_prodI mem_Collect_eq prod.collapse)

      obtain tA' where "tA' \<in> transitions A"
                        and "t_source tA' = initial A"
                        and "t_input tA' = fst ioA"
                        and "t_output tA' = snd ioM"
                        and "pass_ATC' (from_FSM M (t_target tM)) (from_FSM A (t_target tA')) FS k"
        using *[OF \<open>(t_output tM,t_target tM) \<in> h M (initial M,fst ioA)\<close>]
        unfolding h.simps \<open>t_output tM = snd ioM\<close> by fastforce

      then have "path A (initial A) [tA']"
        using single_transition_path[OF \<open>tA' \<in> transitions A\<close>] by auto
      moreover have "p_io [tA'] = [ioM]"
        using \<open>t_input tA' = fst ioA\<close> \<open>t_output tA' = snd ioM\<close> unfolding \<open>fst ioA = fst ioM\<close> by auto
      ultimately have "[ioM] \<in> LS A (initial A)"
        unfolding LS.simps by (metis (mono_tags, lifting) mem_Collect_eq)
      then have "io @ [ioM] \<in> LS A (initial A)"
        using Nil by auto

      have "target (initial A) [tA'] = t_target tA'"
        by auto
      then have "t_target tA' \<in> io_targets A [ioM] (initial A)"
        unfolding io_targets.simps
        using \<open>path A (initial A) [tA']\<close> \<open>p_io [tA'] = [ioM]\<close>
        by (metis (mono_tags, lifting) mem_Collect_eq)
      then have "io_targets A (io @ [ioM]) (initial A) = {t_target tA'}"
        using observable_io_targets[OF _ \<open>io @ [ioM] \<in> LS A (initial A)\<close>] \<open>is_ATC A\<close> Nil
        unfolding is_ATC_def
        by (metis append_self_conv2 singletonD)
      moreover have "t_target tA' \<notin> FS"
        using pass_ATC'_initial[OF \<open>pass_ATC' (from_FSM M (t_target tM)) (from_FSM A (t_target tA')) FS k\<close>]
        unfolding from_FSM_simps(1)[OF fsm_transition_target[OF \<open>tA' \<in> transitions A\<close>]] by assumption
      ultimately have "io_targets A (io @ [ioM]) (initial A) \<inter> FS = {}"
        by auto

      then show ?thesis
        using \<open>io @ [ioM] \<in> LS A (initial A)\<close> by auto
    next
      case (Cons io' io'')

      have "[io'] \<in> L A"
        using Cons \<open>io@[ioA] \<in> L A\<close>
        by (metis append.left_neutral append_Cons language_prefix)
      then obtain tA where "tA \<in> transitions A"
                  and "t_source tA = initial A"
                  and "t_input tA = fst io'"
                  and "t_output tA = snd io'"
        by auto
      then have "fst io' \<in> (inputs A)"
        using fsm_transition_input by metis

      have "(t_output tA,t_target tA) \<in> h A (initial A,t_input tA)"
        using \<open>tA \<in> transitions A\<close> \<open>t_source tA = initial A\<close> unfolding h_simps
        by (metis (no_types, lifting) case_prodI mem_Collect_eq prod.collapse)
      then have "h A (initial A,fst io') \<noteq> {}"
        unfolding \<open>t_input tA = fst io'\<close> by blast

      then have *: "\<And> yM qM . (yM,qM) \<in> h M (initial M,fst io') \<Longrightarrow> (\<exists> (yA,qA) \<in> h A (initial A,fst io') . yM = yA \<and> pass_ATC' (from_FSM M qM) (from_FSM A qA) FS k)"
        using Suc.prems(1) pass_ATC'_initial[OF Suc.prems(1)] unfolding pass_ATC'.simps
        using \<open>fst io' \<in> FSM.inputs A\<close> by auto

      obtain tM where "tM \<in> transitions M"
                  and "t_source tM = initial M"
                  and "t_input tM = fst io'"
                  and "t_output tM = snd io'"
        using Cons \<open>io@[ioM] \<in> L M\<close> \<open>fst ioA = fst ioM\<close> by auto
      have "(t_output tM,t_target tM) \<in> h M (initial M,fst io')"
        using \<open>tM \<in> transitions M\<close> \<open>t_source tM = initial M\<close> \<open>t_input tM = fst io'\<close> unfolding h_simps
        by (metis (mono_tags, lifting) case_prodI mem_Collect_eq prod.collapse)

      obtain tA' where "tA' \<in> transitions A"
                        and "t_source tA' = initial A"
                        and "t_input tA' = fst io'"
                        and "t_output tA' = snd io'"
                        and "pass_ATC' (from_FSM M (t_target tM)) (from_FSM A (t_target tA')) FS k"
        using *[OF \<open>(t_output tM,t_target tM) \<in> h M (initial M,fst io')\<close>]
        unfolding h.simps \<open>t_output tM = snd io'\<close> by fastforce

      then have "tA = tA'"
        using \<open>is_ATC A\<close>
        unfolding is_ATC_def observable.simps
        by (metis \<open>tA \<in> transitions A\<close> \<open>t_input tA = fst io'\<close> \<open>t_output tA = snd io'\<close> \<open>t_source tA = initial A\<close> prod.collapse)
      then have "pass_ATC' (from_FSM M (t_target tM)) (from_FSM A (t_target tA)) FS k"
        using \<open>pass_ATC' (from_FSM M (t_target tM)) (from_FSM A (t_target tA')) FS k\<close> by auto

      have "(inputs (from_FSM A (t_target tA))) \<subseteq> (inputs (from_FSM M (t_target tM)))"
        using Suc.prems(4)
        unfolding from_FSM_simps(2)[OF fsm_transition_target[OF \<open>tM \<in> transitions M\<close>]]
                  from_FSM_simps(2)[OF fsm_transition_target[OF \<open>tA \<in> transitions A\<close>]] by assumption

      have "length (io'' @ [ioA]) \<le> k"
        using Cons \<open>length (io @ [ioA]) \<le> Suc k\<close> by auto

      have "(io' # (io''@[ioA])) \<in> LS A (t_source tA)"
        using \<open>t_source tA = initial A\<close> \<open>io@[ioA] \<in> L A\<close> Cons by auto
      have "io'' @ [ioA] \<in> LS (from_FSM A (t_target tA)) (initial (from_FSM A (t_target tA)))"
        using observable_language_next[OF \<open>(io' # (io''@[ioA])) \<in> LS A (t_source tA)\<close>]
              \<open>is_ATC A\<close> \<open>tA \<in> transitions A\<close> \<open>t_input tA = fst io'\<close> \<open>t_output tA = snd io'\<close>
        using is_ATC_def by blast

      have "(io' # (io''@[ioM])) \<in> LS M (t_source tM)"
        using \<open>t_source tM = initial M\<close> \<open>io@[ioM] \<in> L M\<close> Cons by auto
      have "io'' @ [ioM] \<in> LS (from_FSM M (t_target tM)) (initial (from_FSM M (t_target tM)))"
        using observable_language_next[OF \<open>(io' # (io''@[ioM])) \<in> LS M (t_source tM)\<close>]
              \<open>observable M\<close> \<open>tM \<in> transitions M\<close> \<open>t_input tM = fst io'\<close> \<open>t_output tM = snd io'\<close>
        by blast

      have "observable (from_FSM M (t_target tM))"
        using from_FSM_observable[OF \<open>observable M\<close>] by blast

      have "is_ATC (FSM.from_FSM A (t_target tA))"
        using is_ATC_from[OF \<open>tA \<in> transitions A\<close> _  \<open>is_ATC A\<close>] reachable_states_initial
        unfolding \<open>t_source tA = initial A\<close> by blast

      have "io'' @ [ioM] \<in> LS (from_FSM A (t_target tA)) (initial (from_FSM A (t_target tA)))"
       and "io_targets (from_FSM A (t_target tA)) (io'' @ [ioM]) (initial (from_FSM A (t_target tA))) \<inter> FS = {}"
        using Suc.IH[OF \<open>pass_ATC' (from_FSM M (t_target tM)) (from_FSM A (t_target tA)) FS k\<close>
                        \<open>is_ATC (FSM.from_FSM A (t_target tA))\<close>
                        \<open>observable (from_FSM M (t_target tM))\<close>
                        \<open>(inputs (from_FSM A (t_target tA))) \<subseteq> (inputs (from_FSM M (t_target tM)))\<close>
                        \<open>io'' @ [ioA] \<in> LS (from_FSM A (t_target tA)) (initial (from_FSM A (t_target tA)))\<close>
                        \<open>io'' @ [ioM] \<in> LS (from_FSM M (t_target tM)) (initial (from_FSM M (t_target tM)))\<close>
                        \<open>fst ioA = fst ioM\<close>
                        \<open>length (io'' @ [ioA]) \<le> k\<close>]
        by blast+

      then obtain pA where "path (from_FSM A (t_target tA)) (initial (from_FSM A (t_target tA))) pA" and "p_io pA = io'' @ [ioM]"
        by auto

      have "path A (initial A) (tA#pA)"
        using \<open>path (from_FSM A (t_target tA)) (initial (from_FSM A (t_target tA))) pA\<close> \<open>tA \<in> transitions A\<close>
        by (metis \<open>t_source tA = initial A\<close> cons from_FSM_path_initial fsm_transition_target)
      moreover have "p_io (tA#pA) = io' # io'' @ [ioM]"
        using \<open>t_input tA = fst io'\<close> \<open>t_output tA = snd io'\<close> \<open>p_io pA = io'' @ [ioM]\<close> by auto
      ultimately have "io' # io'' @ [ioM] \<in> L A"
        unfolding LS.simps
        by (metis (mono_tags, lifting) mem_Collect_eq)
      then have "io @ [ioM] \<in> L A"
        using Cons by auto

      have "observable A"
        using Suc.prems(2) is_ATC_def by blast

      have "io_targets A (io @ [ioM]) (FSM.initial A) \<inter> FS = {}"
      proof -
        have "\<And> p . path A (FSM.initial A) p \<Longrightarrow> p_io p = (io' # io'') @ [ioM] \<Longrightarrow> p = tA # (tl p)"
          using \<open>observable A\<close> unfolding observable.simps
          using \<open>tA \<in> transitions A\<close> \<open>t_source tA = initial A\<close> \<open>t_input tA = fst io'\<close> \<open>t_output tA = snd io'\<close> by fastforce

        have "\<And> q . q \<in> io_targets A (io @ [ioM]) (FSM.initial A) \<Longrightarrow> q \<in> io_targets (from_FSM A (t_target tA)) (io'' @ [ioM]) (initial (from_FSM A (t_target tA)))"
        proof -
          fix q assume "q \<in> io_targets A (io @ [ioM]) (FSM.initial A)"
          then obtain p where "q = target (FSM.initial A) p" and "path A (FSM.initial A) p" and "p_io p = (io' # io'') @ [ioM]"
            unfolding io_targets.simps Cons by blast
          then have "p = tA # (tl p)"
            using \<open>\<And> p . path A (FSM.initial A) p \<Longrightarrow> p_io p = (io' # io'') @ [ioM] \<Longrightarrow> p = tA # (tl p)\<close> by blast

          have "path A (FSM.initial A) (tA#(tl p))"
            using \<open>path A (FSM.initial A) p\<close> \<open>p = tA # (tl p)\<close> by simp
          then have "path (from_FSM A (t_target tA)) (initial (from_FSM A (t_target tA))) (tl p)"
            by (meson from_FSM_path_initial fsm_transition_target path_cons_elim)
          moreover have "p_io (tl p) = (io'') @ [ioM]"
            using \<open>p_io p = (io' # io'') @ [ioM]\<close> \<open>p = tA # (tl p)\<close> by auto
          moreover have "q = target (initial (from_FSM A (t_target tA))) (tl p)"
            using \<open>q = target (FSM.initial A) p\<close> \<open>p = tA # (tl p)\<close>
            unfolding target.simps visited_states.simps from_FSM_simps[OF fsm_transition_target[OF \<open>tA \<in> transitions A\<close>]]
            by (cases p; auto)
          ultimately show "q \<in> io_targets (from_FSM A (t_target tA)) (io'' @ [ioM]) (initial (from_FSM A (t_target tA)))"
            unfolding io_targets.simps by blast
        qed
        moreover have "\<And> q . q \<in> io_targets (from_FSM A (t_target tA)) (io'' @ [ioM]) (initial (from_FSM A (t_target tA))) \<Longrightarrow> q \<in> io_targets A (io @ [ioM]) (FSM.initial A)"
        proof -
          fix q assume "q \<in> io_targets (from_FSM A (t_target tA)) (io'' @ [ioM]) (initial (from_FSM A (t_target tA)))"
          then obtain p where "q = target (FSM.initial (FSM.from_FSM A (t_target tA))) p" and "path (FSM.from_FSM A (t_target tA)) (FSM.initial (FSM.from_FSM A (t_target tA))) p" and "p_io p = io'' @ [ioM]"
            unfolding io_targets.simps Cons by blast

          have "q = target (FSM.initial A) (tA#p)"
            unfolding \<open>q = target (FSM.initial (FSM.from_FSM A (t_target tA))) p\<close> from_FSM_simps[OF fsm_transition_target[OF \<open>tA \<in> transitions A\<close>]] by auto
          moreover have "path A (initial A) (tA#p)"
            using \<open>path (FSM.from_FSM A (t_target tA)) (FSM.initial (FSM.from_FSM A (t_target tA))) p\<close>
            unfolding from_FSM_path_initial[OF fsm_transition_target[OF \<open>tA \<in> transitions A\<close>], symmetric]
            using \<open>tA \<in> transitions A\<close> \<open>t_source tA = initial A\<close> cons
            by fastforce
          moreover have "p_io (tA#p) = io @ [ioM]"
            using \<open>p_io p = io'' @ [ioM]\<close> \<open>t_input tA = fst io'\<close> \<open>t_output tA = snd io'\<close> unfolding Cons by simp
          ultimately show "q \<in> io_targets A (io @ [ioM]) (FSM.initial A)"
            unfolding io_targets.simps by fastforce
        qed
        ultimately show ?thesis
          using \<open>io_targets (from_FSM A (t_target tA)) (io'' @ [ioM]) (initial (from_FSM A (t_target tA))) \<inter> FS = {}\<close> by blast
      qed

      then show ?thesis
        using \<open>io @ [ioM] \<in> L A\<close> by simp
    qed
  qed

  then show "io@[ioM] \<in> L A"
        and "io_targets A (io@[ioM]) (initial A) \<inter> FS = {}"
    by simp+
qed

lemma pass_ATC_io :
  assumes "pass_ATC M A FS"
  and     "is_ATC A"
  and     "observable M"
  and     "(inputs A) \<subseteq> (inputs M)"
  and     "io@[ioA] \<in> L A"
  and     "io@[ioM] \<in> L M"
  and     "fst ioA = fst ioM"
shows "io@[ioM] \<in> L A"
and   "io_targets A (io@[ioM]) (initial A) \<inter> FS = {}"
proof -

  have "acyclic A"
    using \<open>is_ATC A\<close> is_ATC_def by blast

  then have "length (io @ [ioA]) \<le> (size A)"
    using \<open>io@[ioA] \<in> L A\<close> unfolding LS.simps
    using acyclic_path_length_limit unfolding acyclic.simps by fastforce

  show "io@[ioM] \<in> L A"
  and  "io_targets A (io@[ioM]) (initial A) \<inter> FS = {}"
    using pass_ATC'_io[OF _ assms(2-7) \<open>length (io @ [ioA]) \<le> (size A)\<close>]
    using assms(1) by simp+
qed

lemma pass_ATC_io_explicit_io_tuple :
  assumes "pass_ATC M A FS"
  and     "is_ATC A"
  and     "observable M"
  and     "(inputs A) \<subseteq> (inputs M)"
  and     "io@[(x,y)] \<in> L A"
  and     "io@[(x,y')] \<in> L M"
shows "io@[(x,y')] \<in> L A"
and   "io_targets A (io@[(x,y')]) (initial A) \<inter> FS = {}"
  apply (metis pass_ATC_io(1) assms fst_conv)
  by (metis pass_ATC_io(2) assms fst_conv)

lemma pass_ATC_io_fail_fixed_io :
  assumes "is_ATC A"
  and     "observable M"
  and     "(inputs A) \<subseteq> (inputs M)"
  and     "io@[ioA] \<in> L A"
  and     "io@[ioM] \<in> L M"
  and     "fst ioA = fst ioM"
  and     "io@[ioM] \<notin> L A \<or> io_targets A (io@[ioM]) (initial A) \<inter> FS \<noteq> {}"
shows "\<not>pass_ATC M A FS"
proof -
  consider (a) "io@[ioM] \<notin> L A" |
           (b) "io_targets A (io@[ioM]) (initial A) \<inter> FS \<noteq> {}"
    using assms(7) by blast
  then show ?thesis proof (cases)
    case a
    then show ?thesis using pass_ATC_io(1)[OF _ assms(1-6)] by blast
  next
    case b
    then show ?thesis using pass_ATC_io(2)[OF _ assms(1-6)] by blast
  qed
qed

lemma pass_ATC'_io_fail :
  assumes "\<not>pass_ATC' M A FS k "
  and     "is_ATC A"
  and     "observable M"
  and     "(inputs A) \<subseteq> (inputs M)"
shows "initial A \<in> FS \<or> (\<exists> io ioA ioM . io@[ioA] \<in> L A
                          \<and> io@[ioM] \<in> L M
                          \<and> fst ioA = fst ioM
                          \<and> (io@[ioM] \<notin> L A \<or> io_targets A (io@[ioM]) (initial A) \<inter> FS \<noteq> {}))"
using assms proof (induction k arbitrary: M A)
  case 0
  then show ?case by auto
next
  case (Suc k)
  then show ?case proof (cases "initial A \<in> FS")
    case True
    then show ?thesis by auto
  next
    case False
    then obtain x where "x \<in> inputs A"
                    and "h A (FSM.initial A, x) \<noteq> {}"
                    and "\<not>(\<forall>(yM, qM)\<in>h M (initial M, x). \<exists>(yA, qA)\<in>h A (FSM.initial A, x). yM = yA \<and> pass_ATC' (FSM.from_FSM M qM) (FSM.from_FSM A qA) FS k)"
      using Suc.prems(1) unfolding pass_ATC'.simps
      by fastforce

    obtain tM where "tM \<in> transitions M"
                and "t_source tM = initial M"
                and "t_input tM = x"
                and "\<not>(\<exists>(yA, qA)\<in>h A (FSM.initial A, x). t_output tM = yA \<and> pass_ATC' (FSM.from_FSM M (t_target tM)) (FSM.from_FSM A qA) FS k)"
      using \<open>\<not>(\<forall>(yM, qM)\<in>h M (initial M, x). \<exists>(yA, qA)\<in>h A (FSM.initial A, x). yM = yA \<and> pass_ATC' (FSM.from_FSM M qM) (FSM.from_FSM A qA) FS k)\<close>
      unfolding h.simps
      by auto

    have "\<not> (\<exists> tA . tA \<in> transitions A \<and> t_source tA = initial A \<and> t_input tA = x \<and> t_output tA = t_output tM \<and> pass_ATC' (FSM.from_FSM M (t_target tM)) (FSM.from_FSM A (t_target tA)) FS k)"
      using \<open>\<not>(\<exists>(yA, qA)\<in>h A (FSM.initial A, x). t_output tM = yA \<and> pass_ATC' (FSM.from_FSM M (t_target tM)) (FSM.from_FSM A qA) FS k)\<close>
      unfolding h.simps by force
    moreover have "\<exists> tA . tA \<in> transitions A \<and> t_source tA = initial A \<and> t_input tA = x"
      using \<open>h A (FSM.initial A, x) \<noteq> {}\<close> unfolding h.simps by force
    ultimately consider
      (a) "\<And> tA . tA \<in> transitions A \<Longrightarrow> t_source tA = initial A \<Longrightarrow> t_input tA = x \<Longrightarrow> t_output tM \<noteq> t_output tA" |
      (b) "\<exists> tA . tA \<in> transitions A \<and> t_source tA = initial A \<and> t_input tA = x \<and> t_output tA = t_output tM \<and> \<not>pass_ATC' (FSM.from_FSM M (t_target tM)) (FSM.from_FSM A (t_target tA)) FS k"
      by force
    then show ?thesis proof cases
      case a
      then have "[(x,t_output tM)] \<notin> L A"
        unfolding LS.simps by fastforce
      moreover have "\<exists> y . [(x,y)] \<in> L A"
        using \<open>h A (FSM.initial A, x) \<noteq> {}\<close> unfolding h.simps LS.simps
      proof -
        obtain pp :: "'d \<times> 'b \<times> 'c \<times> 'd" where
          f1: "pp \<in> FSM.transitions A \<and> t_source pp = FSM.initial A \<and> t_input pp = x"
          using \<open>\<exists>tA. tA \<in> FSM.transitions A \<and> t_source tA = FSM.initial A \<and> t_input tA = x\<close> by blast
        then have "path A (FSM.initial A) [pp]"
          by (metis single_transition_path)
        then have "(t_input pp, t_output pp) # p_io ([]::('d \<times> 'b \<times> 'c \<times> _) list) \<in> {p_io ps |ps. path A (FSM.initial A) ps}"
          by force
        then show "\<exists>c. [(x, c)] \<in> {p_io ps |ps. path A (FSM.initial A) ps}"
          using f1 by force
      qed
      moreover have "[(x,t_output tM)] \<in> L M"
        unfolding LS.simps using \<open>tM \<in> transitions M\<close> \<open>t_input tM = x\<close> \<open>t_source tM = initial M\<close>
      proof -
        have "\<exists>ps. p_io [tM] = p_io ps \<and> path M (FSM.initial M) ps"
          by (metis (no_types) \<open>tM \<in> FSM.transitions M\<close> \<open>t_source tM = FSM.initial M\<close> single_transition_path)
        then show "[(x, t_output tM)] \<in> {p_io ps |ps. path M (FSM.initial M) ps}"
          by (simp add: \<open>t_input tM = x\<close>)
      qed
      ultimately have "(\<exists>io ioA ioM. io @ [ioA] \<in> L A \<and> io @ [ioM] \<in> L M \<and> fst ioA = fst ioM \<and> (io @ [ioM] \<notin> L A))"
        by (metis append_self_conv2 fst_conv)
      then show ?thesis by blast
    next
      case b
      then obtain t' where "t' \<in> transitions A"
                       and "t_source t' = initial A"
                       and "t_input t' = x"
                       and "t_output t' = t_output tM"
                       and "\<not>pass_ATC' (FSM.from_FSM M (t_target tM)) (FSM.from_FSM A (t_target t')) FS k"
        by blast

      have "is_ATC (FSM.from_FSM A (t_target t'))"
        using is_ATC_from[OF \<open>t' \<in> transitions A\<close> _ \<open>is_ATC A\<close>] reachable_states_initial
        unfolding \<open>t_source t' = initial A\<close> by blast

      have "(inputs (from_FSM A (t_target t'))) \<subseteq> (inputs (from_FSM M (t_target tM)))"
        by (simp add: Suc.prems(4) \<open>t' \<in> FSM.transitions A\<close> \<open>tM \<in> FSM.transitions M\<close> fsm_transition_target)

      let ?ioM = "(x,t_output tM)"
      let ?ioA = "(x,t_output t')"

      consider (b1) "initial (from_FSM A (t_target t')) \<in> FS" |
               (b2) "(\<exists>io ioA ioM.
                        io @ [ioA] \<in> LS (from_FSM A (t_target t')) (initial (from_FSM A (t_target t'))) \<and>
                        io @ [ioM] \<in> LS (from_FSM M (t_target tM)) (initial (from_FSM M (t_target tM))) \<and>
                        fst ioA = fst ioM \<and>
                        (io @ [ioM] \<notin> LS (from_FSM A (t_target t')) (initial (from_FSM A (t_target t'))) \<or>
                        io_targets (from_FSM A (t_target t')) (io @ [ioM]) (initial (from_FSM A (t_target t'))) \<inter> FS \<noteq> {}))"
        using Suc.IH[OF \<open>\<not>pass_ATC' (FSM.from_FSM M (t_target tM)) (FSM.from_FSM A (t_target t')) FS k\<close>
                        \<open>is_ATC (FSM.from_FSM A (t_target t'))\<close>
                        from_FSM_observable[OF \<open>observable M\<close>]
                        \<open>(inputs (from_FSM A (t_target t'))) \<subseteq> (inputs (from_FSM M (t_target tM)))\<close>]
        by blast
      then show ?thesis proof cases
        case b1 (* analogous to case a *)

        have "[?ioA] \<in> L A"
          unfolding LS.simps
        proof -
          have "\<exists>ps. [(x, t_output t')] = p_io ps \<and> path A (t_source t') ps"
            using \<open>t' \<in> FSM.transitions A\<close> \<open>t_input t' = x\<close> by force
          then show "[(x, t_output t')] \<in> {p_io ps |ps. path A (FSM.initial A) ps}"
            by (simp add: \<open>t_source t' = FSM.initial A\<close>)
        qed

        have "[?ioM] \<in> L M"
          unfolding LS.simps
        proof -
          have "path M (FSM.initial M) [tM]"
            by (metis \<open>tM \<in> FSM.transitions M\<close> \<open>t_source tM = FSM.initial M\<close> single_transition_path)
          then have "\<exists>ps. [(x, t_output tM)] = p_io ps \<and> path M (FSM.initial M) ps"
            using \<open>t_input tM = x\<close> by force
          then show "[(x, t_output tM)] \<in> {p_io ps |ps. path M (FSM.initial M) ps}"
            by simp
        qed

        have "p_io [t'] = [(x, t_output tM)]"
          using \<open>t_input t' = x\<close> \<open>t_output t' = t_output tM\<close>
          by auto
        moreover have "target (initial A) [t'] = t_target t'"
          using \<open>t_source t' = initial A\<close> by auto
        ultimately have "t_target t' \<in> io_targets A [(x,t_output tM)] (initial A)"
          unfolding io_targets.simps
          using single_transition_path[OF \<open>t' \<in> transitions A\<close>]
          by (metis (mono_tags, lifting) \<open>t_source t' = initial A\<close> mem_Collect_eq)
        then have "initial (from_FSM A (t_target t')) \<in> io_targets A [(x,t_output tM)] (initial A)"
          unfolding io_targets.simps from_FSM_simps[OF fsm_transition_target[OF \<open>t' \<in> transitions A\<close>]] by simp
        then have "io_targets A ([] @ [?ioM]) (initial A) \<inter> FS \<noteq> {}"
          using b1 by (metis IntI append_Nil empty_iff)

        then have "\<exists> io ioA ioM . io@[ioA] \<in> L A
                          \<and> io@[ioM] \<in> L M
                          \<and> fst ioA = fst ioM
                          \<and> io_targets A (io @ [ioM]) (initial A) \<inter> FS \<noteq> {}"
          using \<open>[?ioA] \<in> L A\<close> \<open>[?ioM] \<in> L M\<close>
          by (metis \<open>t_output t' = t_output tM\<close> append.left_neutral)

        then show ?thesis by blast

      next
        case b2 (* obtain io ioA ioM and prepend (x,t_output tM) *)

        then obtain io ioA ioM where
              "io @ [ioA] \<in> LS (from_FSM A (t_target t')) (initial (from_FSM A (t_target t')))"
          and "io @ [ioM] \<in> LS (from_FSM M (t_target tM)) (initial (from_FSM M (t_target tM)))"
          and "fst ioA = fst ioM"
          and "(io @ [ioM] \<notin> LS (from_FSM A (t_target t')) (initial (from_FSM A (t_target t'))) \<or> io_targets (from_FSM A (t_target t')) (io @ [ioM]) (initial (from_FSM A (t_target t'))) \<inter> FS \<noteq> {})"
          by blast

        have "observable A"
              using Suc.prems(2) is_ATC_def by blast

        have "(?ioM # io) @ [ioA] \<in> L A"
          using language_state_prepend_transition[OF \<open>io @ [ioA] \<in> LS (from_FSM A (t_target t')) (initial (from_FSM A (t_target t')))\<close> \<open>t' \<in> transitions A\<close>]
          using \<open>t_input t' = x\<close> \<open>t_source t' = initial A\<close> \<open>t_output t' = t_output tM\<close>
          by simp

        moreover have "(?ioM # io) @ [ioM] \<in> L M"
          using language_state_prepend_transition[OF \<open>io @ [ioM] \<in> L (from_FSM M (t_target tM))\<close> \<open>tM \<in> transitions M\<close>]
          using \<open>t_input tM = x\<close> \<open>t_source tM = initial M\<close>
          by simp

        moreover have "((?ioM # io) @ [ioM] \<notin> L A \<or> io_targets A ((?ioM # io) @ [ioM]) (initial A) \<inter> FS \<noteq> {})"
        proof -
          consider (f1) "io @ [ioM] \<notin> L (from_FSM A (t_target t'))" |
                   (f2) "io_targets (from_FSM A (t_target t')) (io @ [ioM]) (initial (from_FSM A (t_target t'))) \<inter> FS \<noteq> {}"
            using \<open>(io @ [ioM] \<notin> LS (from_FSM A (t_target t')) (initial (from_FSM A (t_target t'))) \<or> io_targets (from_FSM A (t_target t')) (io @ [ioM]) (initial (from_FSM A (t_target t'))) \<inter> FS \<noteq> {})\<close>
            by blast
          then show ?thesis proof cases
            case f1

            have "p_io [t'] = [(x, t_output tM)]"
              using \<open>t_input t' = x\<close> \<open>t_output t' = t_output tM\<close>
              by auto
            moreover have "target (initial A) [t'] = t_target t'"
              using \<open>t_source t' = initial A\<close> by auto
            ultimately have "t_target t' \<in> io_targets A [?ioM] (initial A)"
              unfolding io_targets.simps
              using single_transition_path[OF \<open>t' \<in> transitions A\<close>]
              by (metis (mono_tags, lifting) \<open>t_source t' = initial A\<close> mem_Collect_eq)

            show ?thesis
              using observable_io_targets_language[of "[(x, t_output tM)]" "io@[ioM]" A "initial A" "t_target t'", OF _ \<open>observable A\<close> \<open>t_target t' \<in> io_targets A [?ioM] (initial A)\<close>]
                    f1
              by (metis \<open>observable A\<close> \<open>t' \<in> FSM.transitions A\<close> \<open>t_input t' = x\<close> \<open>t_output t' = t_output tM\<close> \<open>t_source t' = FSM.initial A\<close> append_Cons fst_conv observable_language_next snd_conv)

          next
            case f2

            have "io_targets A (p_io [t'] @ io @ [ioM]) (t_source t') = io_targets A ([?ioM] @ io @ [ioM]) (t_source t')"
              using \<open>t_input t' = x\<close> \<open>t_output t' = t_output tM\<close> by auto
            moreover have "io_targets A (io @ [ioM]) (t_target t') = io_targets (from_FSM A (t_target t')) (io @ [ioM]) (initial (from_FSM A (t_target t')))"
              unfolding io_targets.simps
              using from_FSM_path_initial[OF fsm_transition_target[OF \<open>t' \<in> transitions A\<close>]] by auto
            ultimately have "io_targets A ([?ioM] @ io @ [ioM]) (t_source t') = io_targets (from_FSM A (t_target t')) (io @ [ioM]) (initial (from_FSM A (t_target t')))"
              using observable_io_targets_next[OF \<open>observable A\<close> \<open>t' \<in> transitions A\<close>, of "io @ [ioM]"] by auto

            then show ?thesis
              using f2 \<open>t_source t' = initial A\<close> by auto
          qed
        qed

        ultimately show ?thesis
          using \<open>fst ioA = fst ioM\<close> by blast
      qed
    qed
  qed
qed

lemma pass_ATC_io_fail :
  assumes "\<not>pass_ATC M A FS"
  and     "is_ATC A"
  and     "observable M"
  and     "(inputs A) \<subseteq> (inputs M)"
shows "initial A \<in> FS \<or> (\<exists> io ioA ioM . io@[ioA] \<in> L A
                          \<and> io@[ioM] \<in> L M
                          \<and> fst ioA = fst ioM
                          \<and> (io@[ioM] \<notin> L A \<or> io_targets A (io@[ioM]) (initial A) \<inter> FS \<noteq> {}))"
  using pass_ATC'_io_fail[OF _ assms(2-4)] using assms(1) by auto

lemma pass_ATC_fail :
  assumes "is_ATC A"
  and     "observable M"
  and     "(inputs A) \<subseteq> (inputs M)"
  and     "io@[(x,y)] \<in> L A"
  and     "io@[(x,y')] \<in> L M"
  and     "io@[(x,y')] \<notin> L A"
shows "\<not> pass_ATC M A FS"
  using assms(6) pass_ATC_io_explicit_io_tuple(1)[OF _ assms(1,2,3,4,5)]
  by blast

lemma pass_ATC_reduction :
  assumes "L M2 \<subseteq> L M1"
  and     "is_ATC A"
  and     "observable M1"
  and     "observable M2"
  and     "(inputs A) \<subseteq> (inputs M1)"
  and     "(inputs M2) = (inputs M1)"
  and     "pass_ATC M1 A FS"
shows "pass_ATC M2 A FS"
proof (rule ccontr)
  assume "\<not> pass_ATC M2 A FS"
  have "(inputs A) \<subseteq> (inputs M2)"
    using assms(5,6) by blast

  have "initial A \<notin> FS"
    using \<open>pass_ATC M1 A FS\<close> by (cases "size A"; auto)
  then show "False"
    using pass_ATC_io_fail[OF \<open>\<not> pass_ATC M2 A FS\<close> assms(2,4) \<open>(inputs A) \<subseteq> (inputs M2)\<close>]
    using assms(1) assms(2) assms(3) assms(5) assms(7) pass_ATC_io_fail_fixed_io by blast
qed

lemma pass_ATC_fail_no_reduction :
  assumes "is_ATC A"
  and     "observable T"
  and     "observable M"
  and     "(inputs A) \<subseteq> (inputs M)"
  and     "(inputs T) = (inputs M)"
  and     "pass_ATC M A FS"
  and     "\<not>pass_ATC T A FS"
shows   "\<not> (L T \<subseteq> L M)"
  using pass_ATC_reduction[OF _ assms(1,3,2,4,5,6)] assms(7) by blast

subsection \<open>State Separators as Adaptive Test Cases\<close>

fun pass_separator_ATC :: "('a,'b,'c) fsm \<Rightarrow> ('d,'b,'c) fsm \<Rightarrow> 'a \<Rightarrow> 'd \<Rightarrow> bool" where
  "pass_separator_ATC M S q1 t2 = pass_ATC (from_FSM M q1) S {t2}"

lemma separator_is_ATC :
  assumes "is_separator M q1 q2 A t1 t2"
  and     "observable M"
  and     "q1 \<in> states M"
  shows "is_ATC A"
unfolding is_ATC_def
  using is_separator_simps(1,2,3)[OF assms(1)] by blast

lemma pass_separator_ATC_from_separator_left :
  assumes "observable M"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "is_separator M q1 q2 A t1 t2"
shows "pass_separator_ATC M A q1 t2"
proof (rule ccontr)
  assume "\<not> pass_separator_ATC M A q1 t2"

  then have "\<not> pass_ATC (from_FSM M q1) A {t2}"
    by auto

  have "is_ATC A"
    using separator_is_ATC[OF assms(4,1,2)] by assumption

  have "initial A \<notin> {t2}"
    using separator_initial(2)[OF assms(4)] by blast
  then obtain io ioA ioM where
    "io @ [ioA] \<in> L A"
    "io @ [ioM] \<in> LS M q1"
    "fst ioA = fst ioM"
    "io @ [ioM] \<notin> L A \<or> io_targets A (io @ [ioM]) (initial A) \<inter> {t2} \<noteq> {}"

    using pass_ATC_io_fail[OF \<open>\<not> pass_ATC (from_FSM M q1) A {t2}\<close> \<open>is_ATC A\<close> from_FSM_observable[OF \<open>observable M\<close>] ]
    using is_separator_simps(16)[OF assms(4)]
    using from_FSM_language[OF \<open>q1 \<in> states M\<close>]
    unfolding from_FSM_simps[OF \<open>q1 \<in> states M\<close>] by blast
  then obtain x ya ym where
    "io @ [(x,ya)] \<in> L A"
    "io @ [(x,ym)] \<in> LS M q1"
    "io @ [(x,ym)] \<notin> L A \<or> io_targets A (io @ [(x,ym)]) (initial A) \<inter> {t2} \<noteq> {}"
    by (metis fst_eqD old.prod.exhaust)

  have "io @ [(x,ym)] \<in> L A"
    using is_separator_simps(9)[OF assms(4) \<open>io @ [(x,ym)] \<in> LS M q1\<close> \<open>io @ [(x,ya)] \<in> L A\<close>] by assumption

  have "t1 \<noteq> t2" using is_separator_simps(15)[OF assms(4)] by assumption

  consider (a) "io @ [(x, ym)] \<in> LS M q1 - LS M q2" |
           (b) "io @ [(x, ym)] \<in> LS M q1 \<inter> LS M q2"
    using \<open>io @ [(x,ym)] \<in> LS M q1\<close> by blast
  then have "io_targets A (io @ [(x,ym)]) (initial A) \<inter> {t2} = {}"

  proof (cases)
    case a
    show ?thesis using separator_language(1)[OF assms(4) \<open>io @ [(x,ym)] \<in> L A\<close> a] \<open>t1 \<noteq> t2\<close> by auto
  next
    case b
    show ?thesis using separator_language(3)[OF assms(4) \<open>io @ [(x,ym)] \<in> L A\<close> b] \<open>t1 \<noteq> t2\<close> by auto
  qed

  then show "False"
    using \<open>io @ [(x,ym)] \<in> L A\<close>
    using \<open>io @ [(x,ym)] \<notin> L A \<or> io_targets A (io @ [(x,ym)]) (initial A) \<inter> {t2} \<noteq> {}\<close> by blast
qed

lemma pass_separator_ATC_from_separator_right :
  assumes "observable M"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "is_separator M q1 q2 A t1 t2"
shows "pass_separator_ATC M A q2 t1"
  using assms(1-3) is_separator_sym[OF assms(4)] pass_separator_ATC_from_separator_left by metis

lemma pass_separator_ATC_path_left :
  assumes "pass_separator_ATC S A s1 t2"
  and     "observable S"
  and     "observable M"
  and     "s1 \<in> states S"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "is_separator M q1 q2 A t1 t2"
  and     "(inputs S) = (inputs M)"
  and     "q1 \<noteq> q2"
  and     "path A (initial A) pA"
  and     "path S s1 pS"
  and     "p_io pA = p_io pS"
shows "target (initial A) pA \<noteq> t2"
and   "\<exists> pM . path M q1 pM \<and> p_io pM = p_io pA"
proof -

  have "pass_ATC (from_FSM S s1) A {t2}"
    using \<open>pass_separator_ATC S A s1 t2\<close> by auto

  have "is_ATC A"
    using separator_is_ATC[OF assms(7,3,5)] by assumption

  have "observable (from_FSM S s1)"
    using from_FSM_observable[OF assms(2)] by assumption

  have "(inputs A) \<subseteq> (inputs (from_FSM S s1))"
    using is_separator_simps(16)[OF assms(7)] \<open>(inputs S) = (inputs M)\<close>
    unfolding from_FSM_simps[OF \<open>s1 \<in> states S\<close>] by blast

  have "target (initial A) pA \<noteq> t2 \<and> (\<exists> pM . path M q1 pM \<and> p_io pM = p_io pA)"
  proof (cases pA rule: rev_cases)
    case Nil
    then have "target (initial A) pA \<noteq> t2"
      using separator_initial(2)[OF assms(7)] by auto
    moreover have "(\<exists> pM . path M q1 pM \<and> p_io pM = p_io pA)"
      unfolding Nil using \<open>q1 \<in> states M\<close> by auto
    ultimately show ?thesis by auto
  next
    case (snoc ys y)
    then have "p_io pA = (p_io ys)@[(t_input y,t_output y)]"
      by auto
    then have *: "(p_io ys)@[(t_input y,t_output y)] \<in> L A"
      using language_state_containment[OF \<open>path A (initial A) pA\<close>] by blast
    then have "p_io pS = (p_io ys)@[(t_input y,t_output y)]"
      using \<open>p_io pA = (p_io ys)@[(t_input y,t_output y)]\<close> \<open>p_io pA = p_io pS\<close> by auto
    then have **: "(p_io ys)@[(t_input y,t_output y)] \<in> L (from_FSM S s1)"
      using language_state_containment[OF \<open>path S s1 pS\<close>]
      unfolding from_FSM_language[OF \<open>s1 \<in> states S\<close>] by blast

    have "io_targets A ((p_io ys)@[(t_input y,t_output y)]) (initial A) \<inter> {t2} = {}"
      using pass_ATC_io(2)[OF \<open>pass_ATC (from_FSM S s1) A {t2}\<close> \<open>is_ATC A\<close> \<open>observable (from_FSM S s1)\<close> \<open>(inputs A) \<subseteq> (inputs (from_FSM S s1))\<close> * **]
      unfolding fst_conv by auto
    then have "target (initial A) pA \<noteq> t2"
      using \<open>p_io pA = (p_io ys)@[(t_input y,t_output y)]\<close> \<open>path A (initial A) pA\<close>
      unfolding io_targets.simps
      by blast

    have "p_io ys @ [(t_input y, t_output y)] \<in> LS M q1"
      using separator_language(2,4)[OF assms(7) \<open>(p_io ys)@[(t_input y,t_output y)] \<in> L A\<close>]
      using \<open>io_targets A ((p_io ys)@[(t_input y,t_output y)]) (initial A) \<inter> {t2} = {}\<close> by blast
    then have "\<exists> pM . path M q1 pM \<and> p_io pM = p_io pA"
      using \<open>p_io pA = (p_io ys)@[(t_input y,t_output y)]\<close> by auto

    then show ?thesis using \<open>target (initial A) pA \<noteq> t2\<close> by auto
  qed

  then show "target (initial A) pA \<noteq> t2" and   "\<exists> pM . path M q1 pM \<and> p_io pM = p_io pA"
    by blast+
qed

lemma pass_separator_ATC_path_right :
  assumes "pass_separator_ATC S A s2 t1"
  and     "observable S"
  and     "observable M"
  and     "s2 \<in> states S"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "is_separator M q1 q2 A t1 t2"
  and     "(inputs S) = (inputs M)"
  and     "q1 \<noteq> q2"
  and     "path A (initial A) pA"
  and     "path S s2 pS"
  and     "p_io pA = p_io pS"
shows "target (initial A) pA \<noteq> t1"
and   "\<exists> pM . path M q2 pM \<and> p_io pM = p_io pA"
  using pass_separator_ATC_path_left[OF assms(1-4,6,5) is_separator_sym[OF assms(7)] assms(8) _ assms(10-12)] assms(9) by blast+

lemma pass_separator_ATC_fail_no_reduction :
  assumes "observable S"
  and     "observable M"
  and     "s1 \<in> states S"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "is_separator M q1 q2 A t1 t2"
  and     "(inputs S) = (inputs M)"
  and     "\<not>pass_separator_ATC S A s1 t2"
shows   "\<not> (LS S s1 \<subseteq> LS M q1)"
proof
  assume "LS S s1 \<subseteq> LS M q1"

  have "is_ATC A"
    using separator_is_ATC[OF assms(6,2,4)] by assumption

  have *: "(inputs A) \<subseteq> (inputs (from_FSM M q1))"
    using is_separator_simps(16)[OF assms(6)]
    unfolding is_submachine.simps canonical_separator_simps from_FSM_simps[OF \<open>q1 \<in> states M\<close>] by auto

  have "pass_ATC (from_FSM M q1) A {t2}"
    using pass_separator_ATC_from_separator_left[OF assms(2,4,5,6)] by auto

  have "\<not> pass_ATC (from_FSM S s1) A {t2}"
    using \<open>\<not>pass_separator_ATC S A s1 t2\<close> by auto

  moreover have "pass_ATC (from_FSM S s1) A {t2}"
    using pass_ATC_reduction[OF _ \<open>is_ATC A\<close> from_FSM_observable[OF \<open>observable M\<close>] from_FSM_observable[OF \<open>observable S\<close>] *]
    using \<open>LS S s1 \<subseteq> LS M q1\<close> \<open>pass_ATC (from_FSM M q1) A {t2}\<close>
    unfolding from_FSM_language[OF assms(3)] from_FSM_language[OF assms(4)]
    using \<open>L (FSM.from_FSM S s1) = LS S s1\<close> assms(3) assms(4) assms(7) by auto
  ultimately show "False" by simp
qed

lemma pass_separator_ATC_pass_left :
  assumes "observable S"
  and     "observable M"
  and     "s1 \<in> states S"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "is_separator M q1 q2 A t1 t2"
  and     "(inputs S) = (inputs M)"
  and     "path A (initial A) p"
  and     "p_io p \<in> LS S s1"
  and     "q1 \<noteq> q2"
  and     "pass_separator_ATC S A s1 t2"
shows "target (initial A) p \<noteq> t2"
and   "target (initial A) p = t1 \<or> (target (initial A) p \<noteq> t1 \<and> target (initial A) p \<noteq> t2)" (* useless? *)
proof -

  from \<open>p_io p \<in> LS S s1\<close> obtain pS where "path S s1 pS" and "p_io p = p_io pS"
    by auto

  then show "target (initial A) p \<noteq> t2"
    using pass_separator_ATC_path_left[OF assms(11,1-7,10,8)] by simp

  obtain pM where "path M q1 pM" and "p_io pM = p_io p"
    using pass_separator_ATC_path_left[OF assms(11,1-7,10,8) \<open>path S s1 pS\<close> \<open>p_io p = p_io pS\<close>]  by blast
  then have "p_io p \<in> LS M q1"
    unfolding LS.simps by force

  then show "target (initial A) p = t1 \<or> (target (initial A) p \<noteq> t1 \<and> target (initial A) p \<noteq> t2)"
    using separator_path_targets(1,3,4)[OF assms(6,8)] by blast
qed

lemma pass_separator_ATC_pass_right :
  assumes "observable S"
  and     "observable M"
  and     "s2 \<in> states S"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "is_separator M q1 q2 A t1 t2"
  and     "(inputs S) = (inputs M)"
  and     "path A (initial A) p"
  and     "p_io p \<in> LS S s2"
  and     "q1 \<noteq> q2"
  and     "pass_separator_ATC S A s2 t1"
shows "target (initial A) p \<noteq> t1"
and   "target (initial A) p = t2 \<or> (target (initial A) p \<noteq> t2 \<and> target (initial A) p \<noteq> t2)"
  using pass_separator_ATC_pass_left[OF assms(1,2,3,5,4) is_separator_sym[OF assms(6)] assms(7-9) _ assms(11)] assms(10) by blast+

lemma pass_separator_ATC_completely_specified_left :
  assumes "observable S"
  and     "observable M"
  and     "s1 \<in> states S"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "is_separator M q1 q2 A t1 t2"
  and     "(inputs S) = (inputs M)"
  and     "q1 \<noteq> q2"
  and     "pass_separator_ATC S A s1 t2"
  and     "completely_specified S"
shows "\<exists> p . path A (initial A) p \<and> p_io p \<in> LS S s1 \<and> target (initial A) p = t1"
and   "\<not> (\<exists> p . path A (initial A) p \<and> p_io p \<in> LS S s1 \<and> target (initial A) p = t2)"
proof -
  have p1: "pass_ATC (from_FSM S s1) A {t2}"
    using assms(9) by auto

  have p2: "is_ATC A"
    using separator_is_ATC[OF assms(6,2,4)] by assumption

  have p3: "observable (from_FSM S s1)"
    using from_FSM_observable[OF assms(1)] by assumption

  have p4: "(inputs A) \<subseteq> (inputs (from_FSM S s1))"
    using is_separator_simps(16)[OF assms(6)]
    unfolding from_FSM_simps[OF \<open>s1 \<in> states S\<close>] is_submachine.simps canonical_separator_simps assms(7) by auto

  have "t1 \<noteq> t2" and "observable A"
    using is_separator_simps(15,3)[OF assms(6)] by linarith+

  have path_ext: "\<And> p . path A (initial A) p \<Longrightarrow> p_io p \<in> LS S s1 \<Longrightarrow> (target (initial A) p \<noteq> t2) \<and> (target (initial A) p = t1 \<or> (\<exists> t . path A (initial A) (p@[t]) \<and> p_io (p@[t]) \<in> LS S s1))"
  proof -
    fix p assume "path A (initial A) p" and "p_io p \<in> LS S s1"

    consider (a) "target (initial A) p = t1" |
             (b) "target (initial A) p \<noteq> t1 \<and> target (initial A) p \<noteq> t2"
      using pass_separator_ATC_pass_left(2)[OF assms(1,2,3,4,5,6,7) \<open>path A (initial A) p\<close> \<open>p_io p \<in> LS S s1\<close> assms(8,9)] by blast
    then have "target (initial A) p = t1 \<or> (\<exists> t . path A (initial A) (p@[t]) \<and> p_io (p@[t]) \<in> LS S s1)"
    proof cases
      case a
      then show ?thesis by blast
    next
      case b

      let ?t3 = "target (initial A) p"
      have "?t3 \<noteq> t1" and "?t3 \<noteq> t2"
        using b by auto
      moreover have "?t3 \<in> reachable_states A"
        using \<open>path A (initial A) p\<close> reachable_states_intro by blast
      ultimately have "\<not> deadlock_state A ?t3"
        using is_separator_simps(8)[OF assms(6)] by blast
      then obtain tt where "tt \<in> transitions A" and "t_source tt = ?t3"
        by auto

      then have "path A (initial A) (p@[tt])"
        using \<open>path A (initial A) p\<close> using path_append_transition by metis

      moreover have "p_io (p@[tt]) = (p_io p)@[(t_input tt, t_output tt)]"
        by auto

      ultimately have "(p_io p)@[(t_input tt,t_output tt)] \<in> L A"
        using language_state_containment[of A "initial A" "p@[tt]"] by metis

      let ?x = "t_input tt"
      have "?x \<in> (inputs S)"
        using \<open>tt \<in> transitions A\<close> is_separator_simps(16)[OF assms(6)] assms(7) by auto
      then obtain y where "(p_io p)@[(?x,y)] \<in> LS S s1"
        using completely_specified_language_extension[OF \<open>completely_specified S\<close> \<open>s1 \<in> states S\<close> \<open>p_io p \<in> LS S s1\<close> ] by auto

      then have "p_io p @ [(?x, y)] \<in> LS A (initial A)"
        using pass_ATC_io_explicit_io_tuple(1)[OF p1 p2 p3 p4 \<open>(p_io p)@[(t_input tt,t_output tt)] \<in> L A\<close>]
        unfolding from_FSM_language[OF \<open>s1 \<in> states S\<close>] by auto

      then obtain tt' where "path A (initial A) (p@[tt'])" and "t_input tt' = ?x" and "t_output tt' = y"
        using language_path_append_transition_observable[OF _ \<open>path A (initial A) p\<close> \<open>observable A\<close>] by blast

      then have "p_io (p @ [tt']) \<in> LS S s1"
        using \<open>(p_io p)@[(?x,y)] \<in> LS S s1\<close> by auto
      then show ?thesis
        using \<open>path A (initial A) (p@[tt'])\<close> by meson
    qed

    moreover have "target (initial A) p \<noteq> t2"
      using pass_separator_ATC_pass_left(1)[OF assms(1,2,3,4,5,6,7) \<open>path A (initial A) p\<close> \<open>p_io p \<in> LS S s1\<close> assms(8,9)] by assumption

    ultimately show "(target (initial A) p \<noteq> t2) \<and> (target (initial A) p = t1 \<or> (\<exists> t . path A (initial A) (p@[t]) \<and> p_io (p@[t]) \<in> LS S s1))"
      by simp
  qed

  (* largest path that satisfies (path A (initial A) p) and (p_io p \<in> LS T t1) cannot be extended further and must thus target (Inr q1)  *)

  have "acyclic A"
    using \<open>is_ATC A\<close> is_ATC_def by auto
  then have "finite {p . path A (initial A) p}"
    using acyclic_paths_finite[of A "initial A"] unfolding acyclic.simps
    by (metis (no_types, lifting) Collect_cong)
  then have "finite {p . path A (initial A) p \<and> p_io p \<in> LS S s1}"
    by auto

  have "[] \<in> {p . path A (initial A) p \<and> p_io p \<in> LS S s1}"
    using \<open>s1 \<in> states S\<close> by auto
  then have "{p . path A (initial A) p \<and> p_io p \<in> LS S s1} \<noteq> {}"
    by blast

  have scheme: "\<And> S . finite S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> \<exists> x \<in> S . \<forall> y \<in> S . length y \<le> length x"
    by (meson leI max_length_elem)

  obtain p where "p \<in> {p . path A (initial A) p \<and> p_io p \<in> LS S s1}" and "\<And> p' . p' \<in> {p . path A (initial A) p \<and> p_io p \<in> LS S s1} \<Longrightarrow> length p' \<le> length p"
    using scheme[OF \<open>finite {p . path A (initial A) p \<and> p_io p \<in> LS S s1}\<close> \<open>{p . path A (initial A) p \<and> p_io p \<in> LS S s1} \<noteq> {}\<close>]
    by blast
  then have "path A (initial A) p" and "p_io p \<in> LS S s1" and "\<And> p' . path A (initial A) p' \<Longrightarrow> p_io p' \<in> LS S s1 \<Longrightarrow> length p' \<le> length p"
    by blast+

  have "target (initial A) p = t1"
    using path_ext[OF \<open>path A (initial A) p\<close> \<open>p_io p \<in> LS S s1\<close>] \<open>\<And> p' . path A (initial A) p' \<Longrightarrow> p_io p' \<in> LS S s1 \<Longrightarrow> length p' \<le> length p\<close>
    by (metis (no_types, lifting) Suc_n_not_le_n length_append_singleton)

  then show "\<exists>p. path A (initial A) p \<and> p_io p \<in> LS S s1 \<and> target (initial A) p = t1"
    using \<open>path A (initial A) p\<close> \<open>p_io p \<in> LS S s1\<close> by blast

  show "\<nexists>p. path A (initial A) p \<and> p_io p \<in> LS S s1 \<and> target (initial A) p = t2"
    using path_ext by blast
qed

lemma pass_separator_ATC_completely_specified_right :
  assumes "observable S"
  and     "observable M"
  and     "s2 \<in> states S"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "is_separator M q1 q2 A t1 t2"
  and     "(inputs S) = (inputs M)"
  and     "q1 \<noteq> q2"
  and     "pass_separator_ATC S A s2 t1"
  and     "completely_specified S"
shows "\<exists> p . path A (initial A) p \<and> p_io p \<in> LS S s2 \<and> target (initial A) p = t2"
and   "\<not> (\<exists> p . path A (initial A) p \<and> p_io p \<in> LS S s2 \<and> target (initial A) p = t1)"
  using pass_separator_ATC_completely_specified_left[OF assms(1,2,3,5,4) is_separator_sym[OF assms(6)] assms(7) _ assms(9,10)] assms(8) by blast+

lemma pass_separator_ATC_reduction_distinction :
  assumes "observable M"
  and     "observable S"
  and     "(inputs S) = (inputs M)"
  and     "pass_separator_ATC S A s1 t2"
  and     "pass_separator_ATC S A s2 t1"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "q1 \<noteq> q2"
  and     "s1 \<in> states S"
  and     "s2 \<in> states S"
  and     "is_separator M q1 q2 A t1 t2"
  and     "completely_specified S"
shows "s1 \<noteq> s2"
proof -

  (* As s1 passes A against t2, t1 must be reached during application, while
     at the same time t2 is never reached *)

  have "\<exists>p. path A (initial A) p \<and> p_io p \<in> LS S s1 \<and> target (initial A) p = t1"
    using pass_separator_ATC_completely_specified_left[OF assms(2,1,9,6,7,11,3,8,4,12)] by blast

  (* As s2 passes A against t1, t2 must be reached during application, while
     at the same time t1 is never reached *)

  moreover have "\<not> (\<exists>p. path A (initial A) p \<and> p_io p \<in> LS S s2 \<and> target (initial A) p = t1)"
    using pass_separator_ATC_completely_specified_right[OF assms(2,1,10,6,7,11,3,8,5,12)] by blast

  (* Thus it is not possible for (s1 = s2) to hold *)

  ultimately show "s1 \<noteq> s2" by blast
qed

lemma pass_separator_ATC_failure_left :
  assumes "observable M"
  and     "observable S"
  and     "(inputs S) = (inputs M)"
  and     "is_separator M q1 q2 A t1 t2"
  and     "\<not> pass_separator_ATC S A s1 t2"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "q1 \<noteq> q2"
  and     "s1 \<in> states S"
shows "LS S s1 - LS M q1 \<noteq> {}"
proof -

  have p1: "is_ATC A"
    using separator_is_ATC[OF assms(4,1,6)] by assumption

  have p2: "observable (from_FSM S s1)"
    using from_FSM_observable[OF assms(2)] by assumption

  have p3: "observable (from_FSM M q1)"
    using from_FSM_observable[OF assms(1)] by assumption

  have p4: "(inputs A) \<subseteq> (inputs (from_FSM M q1))"
    using is_separator_simps(16)[OF assms(4)]
    unfolding from_FSM_simps[OF \<open>q1 \<in> states M\<close>] is_submachine.simps canonical_separator_simps assms(3) by auto

  have p5: "(inputs (from_FSM S s1)) = (inputs (from_FSM M q1))"
    using assms(3,6,9) by simp

  have p6: "pass_ATC (from_FSM M q1) A {t2}"
    using pass_separator_ATC_from_separator_left[OF assms(1,6,7,4)] by auto

  have p7: "\<not> pass_ATC (from_FSM S s1) A {t2}"
    using assms(5) by auto

  show ?thesis
    using pass_ATC_fail_no_reduction[OF p1 p2 p3 p4 p5 p6 p7]
    unfolding from_FSM_language[OF \<open>q1 \<in> states M\<close>] from_FSM_language[OF \<open>s1 \<in> states S\<close>] by blast
qed

lemma pass_separator_ATC_failure_right :
  assumes "observable M"
  and     "observable S"
  and     "(inputs S) = (inputs M)"
  and     "is_separator M q1 q2 A t1 t2"
  and     "\<not> pass_separator_ATC S A s2 t1"
  and     "q1 \<in> states M"
  and     "q2 \<in> states M"
  and     "q1 \<noteq> q2"
  and     "s2 \<in> states S"
shows "LS S s2 - LS M q2 \<noteq> {}"
  using pass_separator_ATC_failure_left[OF assms(1-3) is_separator_sym[OF assms(4)] assms(5,7,6) _ assms(9)] assms(8) by blast

subsection \<open>ATCs Represented as Sets of IO Sequences\<close>

fun atc_to_io_set :: "('a,'b,'c) fsm \<Rightarrow> ('d,'b,'c) fsm \<Rightarrow> ('b \<times> 'c) list set" where
  "atc_to_io_set M A = L M \<inter> L A"

lemma atc_to_io_set_code :
  assumes "acyclic A"
  shows "atc_to_io_set M A = acyclic_language_intersection M A"
  using acyclic_language_intersection_completeness[OF assms] unfolding atc_to_io_set.simps by blast

lemma pass_io_set_from_pass_separator :
  assumes "is_separator M q1 q2 A t1 t2"
  and     "pass_separator_ATC S A s1 t2"
  and     "observable M"
  and     "observable S"
  and     "q1 \<in> states M"
  and     "s1 \<in> states S"
  and     "(inputs S) = (inputs M)"
shows "pass_io_set (from_FSM S s1) (atc_to_io_set (from_FSM M q1) A)"
proof (rule ccontr)
  assume "\<not> pass_io_set (from_FSM S s1) (atc_to_io_set (from_FSM M q1) A)"
  then obtain io x y y' where "io@[(x,y)] \<in> (atc_to_io_set (from_FSM M q1) A)" and "io@[(x,y')] \<in> L (from_FSM S s1)" and "io@[(x,y')] \<notin> (atc_to_io_set (from_FSM M q1) A)"
    unfolding pass_io_set_def by blast

  have "is_ATC A"
    using separator_is_ATC[OF assms(1,3,5)]  by assumption
  then have "acyclic A"
    unfolding is_ATC_def by auto
  have "observable (from_FSM S s1)"
    using from_FSM_observable[OF \<open>observable S\<close>] by assumption
  have "(inputs A) \<subseteq> (inputs (from_FSM S s1))"
    by (metis (no_types) assms(1) assms(6) assms(7) from_FSM_simps(2) is_separator_simps(16))

  obtain y'' where "io @ [(x, y'')] \<in> LS A (initial A)"
    using \<open>io@[(x,y)] \<in> (atc_to_io_set (from_FSM M q1) A)\<close> unfolding atc_to_io_set.simps by blast

  have "pass_ATC (from_FSM S s1) A {t2}"
    using \<open>pass_separator_ATC S A s1 t2\<close> by auto

  then have "io @ [(x, y')] \<in> L A"
    using pass_ATC_fail[OF \<open>is_ATC A\<close>
                           \<open>observable (from_FSM S s1)\<close>
                           \<open>(inputs A) \<subseteq> (inputs (from_FSM S s1))\<close>
                           \<open>io @ [(x, y'')] \<in> LS A (initial A)\<close>
                           \<open>io@[(x,y')] \<in> L (from_FSM S s1)\<close>,
                        of "{t2}" ]
    by auto

  have "io_targets A (io @ [(x, y')]) (initial A) \<inter> {t2} = {}"
    using pass_ATC_io(2)[OF \<open>pass_ATC (from_FSM S s1) A {t2}\<close> \<open>is_ATC A\<close> \<open>observable (from_FSM S s1)\<close> \<open>(inputs A) \<subseteq> (inputs (from_FSM S s1))\<close> \<open>io @ [(x, y')] \<in> L A\<close> \<open>io@[(x,y')] \<in> L (from_FSM S s1)\<close>]
    unfolding fst_conv by blast

  then have "io @ [(x, y')] \<in> LS M q1"
    using separator_language(1,3,4)[OF assms(1) \<open>io @ [(x, y')] \<in> L A\<close>]
    by (metis UnE Un_Diff_cancel \<open>io @ [(x, y')] \<in> LS A (initial A)\<close> assms(1) disjoint_insert(2) is_separator_sym separator_language(1) singletonI)
  then show "False"
    using \<open>io @ [(x, y')] \<in> L A\<close> \<open>io@[(x,y')] \<notin> (atc_to_io_set (from_FSM M q1) A)\<close>
    unfolding atc_to_io_set.simps from_FSM_language[OF \<open>q1 \<in> states M\<close>]
    by blast
qed

lemma separator_language_last_left :
  assumes "is_separator M q1 q2 A t1 t2"
  and     "completely_specified M"
  and     "q1 \<in> states M"
  and     "io @ [(x, y)] \<in> L A"
obtains y'' where "io@[(x,y'')] \<in> L A \<inter> LS M q1"
proof -
  obtain p t where "path A (initial A) (p@[t])" and "p_io (p@[t]) = io@[(x,y)]"
    using language_initial_path_append_transition[OF \<open>io @ [(x, y)] \<in> L A\<close>] by blast
  then have "\<not> deadlock_state A (target (initial A) p)"
    unfolding deadlock_state.simps by fastforce
  have "path A (initial A) p"
    using \<open>path A (initial A) (p@[t])\<close> by auto

  have "p_io p \<in> LS M q1"
    using separator_path_targets(1,2,4)[OF assms(1) \<open>path A (initial A) p\<close>]
    using is_separator_simps(4,5)[OF assms(1)]
    using \<open>\<not> deadlock_state A (target (initial A) p)\<close> by fastforce
  then have "io \<in> LS M q1"
    using \<open>p_io (p@[t]) = io@[(x,y)]\<close> by auto

  have "x \<in> (inputs A)"
    using \<open>io @ [(x, y)] \<in> L A\<close> language_io(1)
    by (metis in_set_conv_decomp)
  then have "x \<in> (inputs M)"
    using is_separator_simps(16)[OF assms(1)] by blast

  then obtain y'' where "io@[(x,y'')] \<in> LS M q1"
    using completely_specified_language_extension[OF \<open>completely_specified M\<close> \<open>q1 \<in> states M\<close> \<open>io \<in> LS M q1\<close>] by blast
  then have "io@[(x,y'')] \<in> L A \<inter> LS M q1"
    using is_separator_simps(9)[OF assms(1) _ \<open>io @ [(x, y)] \<in> L A\<close>] by blast
  then show ?thesis
    using that by blast
qed

lemma separator_language_last_right :
  assumes "is_separator M q1 q2 A t1 t2"
  and     "completely_specified M"
  and     "q2 \<in> states M"
  and     "io @ [(x, y)] \<in> L A"
obtains y'' where "io@[(x,y'')] \<in> L A \<inter> LS M q2"
  using separator_language_last_left[OF is_separator_sym[OF assms(1)] assms(2,3,4)] by blast

lemma pass_separator_from_pass_io_set :
  assumes "is_separator M q1 q2 A t1 t2"
  and     "pass_io_set (from_FSM S s1) (atc_to_io_set (from_FSM M q1) A)"
  and     "observable M"
  and     "observable S"
  and     "q1 \<in> states M"
  and     "s1 \<in> states S"
  and     "(inputs S) = (inputs M)"
  and     "completely_specified M"
shows "pass_separator_ATC S A s1 t2"
proof (rule ccontr)
  assume "\<not> pass_separator_ATC S A s1 t2"
  then have "\<not> pass_ATC (from_FSM S s1) A {t2}" by auto

  have "is_ATC A"
    using separator_is_ATC[OF assms(1,3,5)]  by assumption
  then have "acyclic A"
    unfolding is_ATC_def by auto
  have "observable (from_FSM S s1)"
    using from_FSM_observable[OF \<open>observable S\<close>] by assumption
  have "(inputs A) \<subseteq> (inputs (from_FSM S s1))"
    using assms(1) assms(6) assms(7) is_separator_simps(16) by fastforce

  obtain io x y y' where "io @ [(x,y)] \<in> L A"
                         "io @ [(x,y')] \<in> L (from_FSM S s1)"
                         "(io @ [(x,y')] \<notin> L A \<or> io_targets A (io @ [(x,y')]) (initial A) \<inter> {t2} \<noteq> {})"
    using pass_ATC_io_fail[OF \<open>\<not> pass_ATC (from_FSM S s1) A {t2}\<close> \<open>is_ATC A\<close> \<open>observable (from_FSM S s1)\<close> \<open>(inputs A) \<subseteq> (inputs (from_FSM S s1))\<close>]
    using separator_initial(2)[OF assms(1)]
    using prod.exhaust fst_conv
    by (metis empty_iff insert_iff)

  show "False"
  proof (cases "io_targets A (io @ [(x,y')]) (initial A) \<inter> {t2} \<noteq> {}")
    case True
    then have "io @ [(x,y')] \<in> L A"
      unfolding io_targets.simps LS.simps by force

    have "io @ [(x,y')] \<in> LS M q2 - LS M q1"
    proof -
      have "t2 \<noteq> t1"
        by (metis (full_types) \<open>is_separator M q1 q2 A t1 t2\<close> is_separator_simps(15))
      then show ?thesis
        using True separator_language[OF assms(1) \<open>io @ [(x,y')] \<in> L A\<close>]
        by blast
    qed
    then have "io @ [(x,y')] \<notin> LS M q1" by blast

    obtain y'' where "io @ [(x, y'')] \<in> LS M q1 \<inter> L A"
      using separator_language_last_left[OF assms(1,8,5) \<open>io @ [(x,y)] \<in> L A\<close>] by blast
    then have "io @ [(x, y')] \<in> LS M q1 \<inter> LS A (initial A)"
      using \<open>pass_io_set (from_FSM S s1) (atc_to_io_set (from_FSM M q1) A)\<close>
      using \<open>io @ [(x,y')] \<in> L (from_FSM S s1)\<close>
      unfolding pass_io_set_def atc_to_io_set.simps from_FSM_language[OF \<open>q1 \<in> states M\<close>] by blast

    then show "False"
      using \<open>io @ [(x,y')] \<notin> LS M q1\<close> by blast

  next
    case False
    then have "io @ [(x,y')] \<notin> L A"
      using \<open>(io @ [(x,y')] \<notin> L A \<or> io_targets A (io @ [(x,y')]) (initial A) \<inter> {t2} \<noteq> {})\<close>
      by blast

    obtain y'' where "io @ [(x, y'')] \<in> LS M q1 \<inter> L A"
      using separator_language_last_left[OF assms(1,8,5) \<open>io @ [(x,y)] \<in> L A\<close>] by blast
    then have "io @ [(x, y')] \<in> L A"
      using \<open>pass_io_set (from_FSM S s1) (atc_to_io_set (from_FSM M q1) A)\<close>
      using \<open>io @ [(x,y')] \<in> L (from_FSM S s1)\<close>
      unfolding pass_io_set_def atc_to_io_set.simps from_FSM_language[OF \<open>q1 \<in> states M\<close>] by blast

    then show "False"
      using \<open>io @ [(x,y')] \<notin> L A\<close> by blast
  qed
qed

lemma pass_separator_pass_io_set_iff:
  assumes "is_separator M q1 q2 A t1 t2"
  and     "observable M"
  and     "observable S"
  and     "q1 \<in> states M"
  and     "s1 \<in> states S"
  and     "(inputs S) = (inputs M)"
  and     "completely_specified M"
shows "pass_separator_ATC S A s1 t2 \<longleftrightarrow> pass_io_set (from_FSM S s1) (atc_to_io_set (from_FSM M q1) A)"
  using pass_separator_from_pass_io_set[OF assms(1) _ assms(2-7)]
        pass_io_set_from_pass_separator[OF assms(1) _ assms(2-6)] by blast

lemma pass_separator_pass_io_set_maximal_iff:
  assumes "is_separator M q1 q2 A t1 t2"
  and     "observable M"
  and     "observable S"
  and     "q1 \<in> states M"
  and     "s1 \<in> states S"
  and     "(inputs S) = (inputs M)"
  and     "completely_specified M"
shows "pass_separator_ATC S A s1 t2 \<longleftrightarrow> pass_io_set_maximal (from_FSM S s1) (remove_proper_prefixes (atc_to_io_set (from_FSM M q1) A))"
proof -

  have "is_ATC A"
    using separator_is_ATC[OF assms(1,2,4)]  by assumption
  then have "acyclic A"
    unfolding is_ATC_def by auto
  then have "finite (L A)"
    unfolding acyclic_alt_def by assumption
  then have *: "finite (atc_to_io_set (from_FSM M q1) A)"
    unfolding atc_to_io_set.simps by blast

  have **: "\<And>io' io''. io' @ io'' \<in> atc_to_io_set (from_FSM M q1) A \<Longrightarrow> io' \<in> atc_to_io_set (from_FSM M q1) A"
    unfolding atc_to_io_set.simps
    using language_prefix[of _ _ "from_FSM M q1" "initial (from_FSM M q1)"]
    using language_prefix[of _ _ "A" "initial A"] by blast

  show ?thesis
    unfolding pass_separator_pass_io_set_iff[OF assms] remove_proper_prefixes_def
    using pass_io_set_maximal_from_pass_io_set[of "(atc_to_io_set (from_FSM M q1) A)" "(from_FSM S s1)", OF * ] ** by blast
qed

end


subsection \<open>Implementation of Division on Multivariate Polynomials\<close>

theory MPoly_Divide_Code
  imports
    MPoly_Divide
    Polynomials.MPoly_Type_Class_FMap
    Polynomials.MPoly_Type_Univariate
begin

text \<open>
  We now set up code equations for some of the operations that we will need, such as division,
  \<^const>\<open>mpoly_to_poly\<close>, and \<^const>\<open>mpoly_to_mpoly_poly\<close>.
\<close>

lemma mapping_of_MPoly[code]: "mapping_of (MPoly p) = p"
  by (simp add: MPoly_inverse)

lift_definition filter_pm :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow>\<^sub>0 'b :: zero) \<Rightarrow> ('a \<Rightarrow>\<^sub>0 'b)" is
  "\<lambda>P f x. if P x then f x else 0"
  by (erule finite_subset[rotated]) auto

lemma lookup_filter_pm: "lookup (filter_pm P f) x = (if P x then lookup f x else 0)"
  by transfer auto

lemma filter_pm_code [code]: "filter_pm P (Pm_fmap m) = Pm_fmap (fmfilter P m)"
  by (auto intro!: poly_mapping_eqI simp: fmlookup_default_def lookup_filter_pm)

lemma remove_key_conv_filter_pm [code]: "remove_key x m = filter_pm (\<lambda>y. y \<noteq> x) m"
  by transfer auto

lemma finite_poly_coeff_nonzero: "finite {n. poly.coeff p n \<noteq> 0}"
  by (metis MOST_coeff_eq_0 eventually_cofinite)

lemma poly_degree_conv_Max:
  assumes "p \<noteq> 0"
  shows   "Polynomial.degree p = Max {n. poly.coeff p n \<noteq> 0}"
  using assms
proof (intro antisym degree_le Max.boundedI)
  fix n assume "n \<in> {n. poly.coeff p n \<noteq> 0}"
  thus "n \<le> Polynomial.degree p"
    by (simp add: le_degree)
qed (auto simp: poly_eq_iff finite_poly_coeff_nonzero)

lemma mpoly_to_poly_code_aux:
  fixes p :: "'a :: comm_monoid_add mpoly" and x :: nat
  defines "I \<equiv> (\<lambda>m. lookup m x) ` Set.filter (\<lambda>m. \<forall>y\<in>keys m. y = x) (keys (mapping_of p))"
  shows   "I = {n. poly.coeff (mpoly_to_poly x p) n \<noteq> 0}"
    and   "mpoly_to_poly x p = 0 \<longleftrightarrow> I = {}"
    and   "I \<noteq> {} \<Longrightarrow> Polynomial.degree (mpoly_to_poly x p) = Max I"
proof -
  have "n \<in> I \<longleftrightarrow> poly.coeff (mpoly_to_poly x p) n \<noteq> 0" for n
  proof -
    have "I = (\<lambda>m. lookup m x) ` (keys (mapping_of p) \<inter> {m. \<forall>y\<in>keys m. y = x})"
      by (auto simp: I_def Set.filter_def)
    also have "{m. \<forall>y\<in>keys m. y = x} = range (\<lambda>n. monomial n x)" (is "?lhs = ?rhs")
    proof (intro equalityI subsetI)
      fix m assume "m \<in> ?lhs"
      hence "m = monomial (lookup m x) x"
        by transfer (auto simp: fun_eq_iff when_def)
      thus "m \<in> ?rhs" by auto
    qed (auto split: if_splits)
    also have "n \<in> (\<lambda>m. lookup m x) ` (keys (mapping_of p) \<inter> \<dots>) \<longleftrightarrow>
               monomial n x \<in> keys (mapping_of p)" by force
    also have "\<dots> \<longleftrightarrow> poly.coeff (mpoly_to_poly x p) n \<noteq> 0"
      by (simp add: coeff_def in_keys_iff)
    finally show ?thesis .
  qed
  thus I: "I = {n. poly.coeff (mpoly_to_poly x p) n \<noteq> 0}"
    by blast
  show eq_0_iff: "mpoly_to_poly x p = 0 \<longleftrightarrow> I = {}"
    unfolding I by (auto simp: poly_eq_iff)
  show "I \<noteq> {} \<Longrightarrow> Polynomial.degree (mpoly_to_poly x p) = Max I"
    by (subst poly_degree_conv_Max) (use eq_0_iff I in auto)
qed

lemma mpoly_to_poly_code [code]:
  "Polynomial.coeffs (mpoly_to_poly x p) =
     (let I = (\<lambda>m. lookup m x) ` Set.filter (\<lambda>m. \<forall>y\<in>keys m. y = x) (keys (mapping_of p))
      in  if I = {} then [] else map (\<lambda>n. MPoly_Type.coeff p (Poly_Mapping.single x n)) [0..<Max I + 1])"
  (is "?lhs = ?rhs")
proof -
  define I where "I = (\<lambda>m. lookup m x) ` Set.filter (\<lambda>m. \<forall>y\<in>keys m. y = x) (keys (mapping_of p))"
  show ?thesis
  proof (cases "I = {}")
    case True
    thus ?thesis using mpoly_to_poly_code_aux(2)[of x p]
      by (simp add: I_def)
  next
    case False
    have [simp]: "mpoly_to_poly x p \<noteq> 0"
      using mpoly_to_poly_code_aux(2)[of x p] False by (simp add: I_def)
    from False have "?rhs = map (\<lambda>n. MPoly_Type.coeff p (Poly_Mapping.single x n)) [0..<Max I + 1]"
      (is "_ = ?rhs'")
      by (simp add: I_def Let_def)
    also have "\<dots> = ?lhs"
    proof (rule nth_equalityI)
      show "length ?rhs' = length ?lhs"
        using mpoly_to_poly_code_aux(3)[of x p] False
        by (simp add: I_def length_coeffs_degree)
      thus "?rhs' ! n = ?lhs ! n" if "n < length ?rhs'" for n using that
        by (auto simp del: upt_Suc simp: nth_coeffs_coeff)
    qed
    finally show ?thesis ..
  qed
qed

fun mpoly_to_mpoly_poly_impl_aux1 :: "nat \<Rightarrow> ((nat \<Rightarrow>\<^sub>0 nat) \<times> 'a) list \<Rightarrow> nat \<Rightarrow> ((nat \<Rightarrow>\<^sub>0 nat) \<times> 'a) list" where
  "mpoly_to_mpoly_poly_impl_aux1 i [] j = []"
| "mpoly_to_mpoly_poly_impl_aux1 i ((mon', c) # xs) j =
     (if lookup mon' i = j then [(remove_key i mon', c)] else []) @ mpoly_to_mpoly_poly_impl_aux1 i xs j"

lemma mpoly_to_mpoly_poly_impl_aux1_altdef:
  "mpoly_to_mpoly_poly_impl_aux1 i xs j =
     map (\<lambda>(mon, c). (remove_key i mon, c)) (filter (\<lambda>(mon, c). lookup mon i = j) xs)"
  by (induction xs) auto

lemma map_of_mpoly_to_mpoly_poly_impl_aux1:
  "map_of (mpoly_to_mpoly_poly_impl_aux1 i xs j) = (\<lambda>mon.
     (if lookup mon i > 0 then None
      else map_of xs (mon + Poly_Mapping.single i j)))"
  apply (rule ext)
  apply (induction i xs j rule: mpoly_to_mpoly_poly_impl_aux1.induct)
   apply (auto simp: remove_key_lookup)
    apply (meson remove_key_sum)
   apply (metis add_left_cancel lookup_single_eq remove_key_sum)
  apply (metis remove_key_add remove_key_single remove_key_sum single_zero)
  done

lemma lookup0_fmap_of_list_mpoly_to_mpoly_poly_impl_aux1:
  "lookup0 (fmap_of_list (mpoly_to_mpoly_poly_impl_aux1 i xs j)) = (\<lambda>mon.
     lookup0 (fmap_of_list xs) (mon + Poly_Mapping.single i j) when lookup mon i = 0)"
  by (auto simp add: fmlookup_default_def fmlookup_of_list map_of_mpoly_to_mpoly_poly_impl_aux1)

definition mpoly_to_mpoly_poly_impl_aux2 where
  "mpoly_to_mpoly_poly_impl_aux2 i p j = poly.coeff (mpoly_to_mpoly_poly i p) j"

lemma coeff_MPoly: "MPoly_Type.coeff (MPoly f) m = lookup f m"
  by (simp add: coeff_def mpoly.MPoly_inverse)

lemma mpoly_to_mpoly_poly_impl_aux2_code [code]:
  "mpoly_to_mpoly_poly_impl_aux2 i (MPoly (Pm_fmap (fmap_of_list xs))) j =
     MPoly (Pm_fmap (fmap_of_list (mpoly_to_mpoly_poly_impl_aux1 i xs j)))"
  unfolding mpoly_to_mpoly_poly_impl_aux2_def
  by (rule mpoly_eqI)
     (simp add: coeff_coeff_mpoly_to_mpoly_poly coeff_MPoly
                lookup0_fmap_of_list_mpoly_to_mpoly_poly_impl_aux1)

definition mpoly_to_mpoly_poly_impl :: "nat \<Rightarrow> 'a :: comm_ring_1 mpoly \<Rightarrow> 'a mpoly list" where
  "mpoly_to_mpoly_poly_impl x p = (if p = 0 then [] else
     map (mpoly_to_mpoly_poly_impl_aux2 x p) [0..<Suc (MPoly_Type.degree p x)])"

lemma mpoly_to_mpoly_poly_eq_0_iff [simp]: "mpoly_to_mpoly_poly x p = 0 \<longleftrightarrow> p = 0"
proof -
  interpret transfer_mpoly_to_mpoly_poly x .
  define p' where "p' = mpoly_to_mpoly_poly x p"
  have [transfer_rule]: "R p' p"
    by (auto simp: R_def p'_def)
  show ?thesis
    unfolding p'_def [symmetric] by transfer_prover
qed

lemma mpoly_to_mpoly_poly_code [code]:
  "Polynomial.coeffs (mpoly_to_mpoly_poly x p) = mpoly_to_mpoly_poly_impl x p"
  by (intro nth_equalityI)
     (auto simp: mpoly_to_mpoly_poly_impl_def length_coeffs_degree
                 mpoly_to_mpoly_poly_impl_aux2_def coeffs_nth simp del: upt_Suc)

value "mpoly_to_mpoly_poly 0 (Var 0 ^ 2 + Var 0 * Var 1 + Var 1 ^ 2 :: int mpoly)"

value "Rings.divide (Var 0 ^ 2 * Var 1 + Var 0 * Var 1 ^ 2 :: int mpoly) (Var 1)"

end


section \<open> Hybrid Programs Preliminaries \<close>

theory utp_hyprog_prelim
  imports
    "UTP1.utp"
    "Ordinary_Differential_Equations.ODE_Analysis"
    "HOL-Analysis.Analysis"
    "HOL-Library.Function_Algebras"
    "Dynamics.Derivative_extra"
    "Dynamics.ODE_Cert"
    "Dynamics.Matrix_Syntax"
begin recall_syntax

subsection \<open> Basic Lens Results \<close>

utp_lift_notation utp_pred.taut utp_pred.closure

lemma bounded_linear_fst_lens [simp]: "bounded_linear (get\<^bsub>fst\<^sub>L\<^esub>)"
  by (simp add: lens_defs bounded_linear_fst)

lemma bounded_linear_snd_lens [simp]: "bounded_linear (get\<^bsub>snd\<^sub>L\<^esub>)"
  by (simp add: lens_defs bounded_linear_snd)

lemma bounded_linear_lens_comp [simp]:
  "\<lbrakk> bounded_linear (get\<^bsub>x\<^esub>); bounded_linear (get\<^bsub>y\<^esub>) \<rbrakk> \<Longrightarrow> bounded_linear (get\<^bsub>x;\<^sub>Ly\<^esub>)"
  by (simp add: lens_defs comp_def bounded_linear_compose)

subsection \<open> Continuous Variable Lenses \<close>

text \<open> Continuous variables are modelled by lenses whose get and put functions are
  bounded linear transformations between two vector spaces. \<close>

locale cont_lens = vwb_lens +
  assumes bounded_linear_get: "bounded_linear get"
  and bounded_linear_put: "bounded_linear (\<lambda> (s, v). put s v)"
begin

lemma has_derivative_put: "((\<lambda> (s, v). put s v) has_derivative (\<lambda> (s, v). put s v)) (at t within X)"
  using bounded_linear_imp_has_derivative bounded_linear_put by blast

lemma has_derivative_put':
  assumes "bounded_linear f" "(g has_derivative g') (at t within X)"
  shows "((\<lambda>s. put (f s) (g s)) has_derivative (\<lambda>s. put (f s) (g' s))) (at t within X)"
proof -
  have 1: "((\<lambda>s. (f s, g s)) has_derivative (\<lambda>s. (f s, g' s))) (at t within X)"
    by (simp add: assms bounded_linear_imp_has_derivative has_derivative_Pair)

  from has_derivative_compose[OF 1 has_derivative_put]
  show ?thesis
    by (simp add: prod.case_eq_if)

qed

end

lemma cont_lens_vwb [simp]: "cont_lens x \<Longrightarrow> vwb_lens x"
  by (simp add: cont_lens_def)

lemma cont_lens_bounded_linear [simp]: "cont_lens x \<Longrightarrow> bounded_linear get\<^bsub>x\<^esub>"
  by (simp add: cont_lens.bounded_linear_get)

lemma cont_lens_intro:
  assumes
    "vwb_lens x" "bounded_linear get\<^bsub>x\<^esub>" "bounded_linear (\<lambda> (s, v). put\<^bsub>x\<^esub> s v)"
  shows "cont_lens x"
proof -
  interpret vwb_lens x by (simp add: assms)
  show ?thesis by (intro_locales, simp add: cont_lens_axioms_def assms)
qed

lemma cont_lens_one [simp]: "cont_lens id_lens"
proof -
  have b: "bounded_linear (\<lambda> (x, y). y)"
    using bounded_linear_snd by (metis cond_case_prod_eta snd_conv)
  show ?thesis
    by (rule_tac cont_lens_intro, simp_all, simp_all add: lens_defs id_def snd_def b)
qed

lemma cont_lens_fst [simp]: "cont_lens fst\<^sub>L"
  by (rule cont_lens_intro, simp_all, simp add: lens_defs split_beta' bounded_linear_intros)

lemma cont_lens_snd [simp]: "cont_lens snd\<^sub>L"
  by (rule cont_lens_intro, simp_all, simp add: lens_defs split_beta' bounded_linear_intros)

lemma bounded_linear_lens_comp_put:
  assumes "vwb_lens x" "bounded_linear (\<lambda> (s, v). put\<^bsub>x\<^esub> s v)"
    "vwb_lens y" "bounded_linear (\<lambda> (s, v). put\<^bsub>y\<^esub> s v)"
    "bounded_linear get\<^bsub>y\<^esub>"
  shows "bounded_linear (\<lambda>(s, v). put\<^bsub>y\<^esub> s (put\<^bsub>x\<^esub> (get\<^bsub>y\<^esub> s) v))"
proof -
  from bounded_linear_compose[OF assms(2) bounded_linear_Pair[OF bounded_linear_compose[OF assms(5) bounded_linear_fst] bounded_linear_snd]]
  have 1: "bounded_linear (\<lambda> (s, v). put\<^bsub>x\<^esub> (get\<^bsub>y\<^esub> s) v)"
    by (simp add: split_beta')

  from bounded_linear_compose[OF assms(4) bounded_linear_Pair[OF bounded_linear_fst 1]]
  show ?thesis
    by (simp add: split_beta')
qed

lemma cont_lens_comp [simp]:
  fixes x :: "'a::real_normed_vector \<Longrightarrow> 'b::real_normed_vector"
    and y :: "'b \<Longrightarrow> 'c::real_normed_vector"
  assumes "cont_lens x" "cont_lens y"
  shows "cont_lens (x ;\<^sub>L y)"
  using assms
  by (rule_tac cont_lens_intro, simp_all)
     (simp add: bounded_linear_lens_comp_put cont_lens.bounded_linear_put lens_comp_def)

text \<open> We begin by defining some lenses that will be useful in characterising continuous variables \<close>

subsubsection \<open> Finite Cartesian Product Lens \<close>

declare [[coercion vec_nth]]

definition vec_upd :: "'a^'i \<Rightarrow> 'i \<Rightarrow> 'a \<Rightarrow> 'a^'i" where
"vec_upd s k v = (\<chi> x. fun_upd (vec_nth s) k v x)"

lemma vec_nth_upd [simp]: "vec_nth (vec_upd f k v) k = v"
  by (simp add: vec_upd_def)

lemma vec_upd_nth [simp]: "vec_upd f k (vec_nth f k) = f"
  by (simp add: vec_upd_def)

lemma vec_upd_upd [simp]: "vec_upd (vec_upd f k v) k u = vec_upd f k u"
  by (simp add: vec_upd_def fun_eq_iff)

definition vec_lens :: "'i \<Rightarrow> ('a \<Longrightarrow> 'a^'i)" where
[lens_defs]: "vec_lens k = \<lparr> lens_get = (\<lambda> s. vec_nth s k), lens_put = (\<lambda> s. vec_upd s k) \<rparr>"

lemma vec_vwb_lens [simp]: "vwb_lens (vec_lens k)"
  by (unfold_locales, simp_all add: vec_lens_def)

lemma vec_lens_indep [simp]: "i \<noteq> j \<Longrightarrow> vec_lens i \<bowtie> vec_lens j"
  by (unfold_locales, simp_all add: vec_lens_def vec_upd_def fun_eq_iff)

lemma bounded_linear_vec_lens [simp]: "bounded_linear (get\<^bsub>vec_lens i\<^esub>)"
  by (simp add: vec_lens_def bounded_linear_vec_nth)

lemma vec_upd_additive: "vec_upd (s\<^sub>1 + s\<^sub>2) i (v\<^sub>1 + v\<^sub>2) = vec_upd s\<^sub>1 i v\<^sub>1 + vec_upd s\<^sub>2 i v\<^sub>2"
  using vec_lambda_unique by (fastforce simp add: vec_upd_def)

lemma vec_upd_scaleR: "n *\<^sub>R vec_upd s i v = vec_upd (n *\<^sub>R s) i (n *\<^sub>R v)"
  by (simp add: vec_upd_def scaleR_vec_def fun_eq_iff)

lemma vec_upd_bounded_linear: "bounded_linear (\<lambda> (s, v). vec_upd s i v)"
  apply (simp add: vec_upd_def split_beta')
  apply (rule bounded_linear_vec)
  apply (rename_tac x)
  apply (case_tac "x = i")
  apply (simp_all)
  using bounded_linear_snd apply blast
  apply (rule bounded_linear_compose[OF bounded_linear_vec_nth bounded_linear_fst])
  done

lemma has_derivative_vec_upd: "((\<lambda> (s, v). vec_upd s i v) has_derivative (\<lambda> (s, v). vec_upd s i v)) (at t within X)"
  using bounded_linear_imp_has_derivative vec_upd_bounded_linear by blast

lemma vec_cont_lens [simp]: "cont_lens (vec_lens k)"
proof -
  interpret vwb_lens "vec_lens k"
    by simp
  show ?thesis
    by (intro_locales, auto intro: vec_upd_bounded_linear simp add: cont_lens_axioms_def vec_lens_def)
qed

subsubsection \<open> Matrix Lens \<close>

definition mat_lens :: "'i \<Rightarrow> 'j \<Rightarrow> ('a \<Longrightarrow> 'a mat['i, 'j])" where
[lens_defs]: "mat_lens i j = vec_lens j ;\<^sub>L vec_lens i"

lemma mat_vwb_lens [simp]: "vwb_lens (mat_lens i j)"
  by (simp add: mat_lens_def)

lemma mat_lens_indep [simp]: "\<lbrakk> i\<^sub>1 \<noteq> i\<^sub>2 \<or> j\<^sub>1 \<noteq> j\<^sub>2 \<rbrakk> \<Longrightarrow> mat_lens i\<^sub>1 j\<^sub>1 \<bowtie> mat_lens i\<^sub>2 j\<^sub>2"
  by (simp add: mat_lens_def
     ,metis lens_indep_left_comp lens_indep_left_ext lens_indep_right_ext vec_lens_indep vec_vwb_lens vwb_lens_mwb)

lemma bounded_linear_mat_lens [simp]: "bounded_linear (get\<^bsub>mat_lens i k\<^esub>)"
  by (simp add: mat_lens_def)

lemma mat_cont_lens [simp]: "cont_lens (mat_lens i j)"
  by (simp add: mat_lens_def)

subsubsection \<open> Executable Euclidean Space Lens \<close>

definition "eucl_nth k \<equiv> (\<lambda> x. list_of_eucl x ! k)"

lemma bounded_linear_eucl_nth [simp]:
  "k < DIM('a::executable_euclidean_space) \<Longrightarrow> bounded_linear (eucl_nth k :: 'a \<Rightarrow> real)"
  by (simp add: eucl_nth_def bounded_linear_inner_left)

lemmas has_derivative_eucl_nth = bounded_linear.has_derivative[OF bounded_linear_eucl_nth]

lemma has_derivative_eucl_nth_triv:
  "k < DIM('a::executable_euclidean_space) \<Longrightarrow> ((eucl_nth k :: 'a \<Rightarrow> real) has_derivative eucl_nth k) F"
  using bounded_linear_eucl_nth bounded_linear_imp_has_derivative by blast

lemma frechet_derivative_eucl_nth:
  "k < DIM('a::executable_euclidean_space) \<Longrightarrow> \<partial>(eucl_nth k :: 'a \<Rightarrow> real) (at t) = eucl_nth k"
  by (metis (full_types) frechet_derivative_at has_derivative_eucl_nth_triv)

lemma differentiable_eucl_nth:
  "k < DIM('a::executable_euclidean_space) \<Longrightarrow> (eucl_nth k :: 'a \<Rightarrow> real) differentiable (at t)"
  using differentiableI has_derivative_eucl_nth_triv by blast

lemma differentiable_eucl_nth':
  fixes f :: "_ \<Rightarrow> 'a::executable_euclidean_space"
  assumes "f differentiable (at t)" "k < DIM('a)"
  shows "(\<lambda> x. eucl_nth k (f x)) differentiable (at t)"
  by (simp add: assms(1) assms(2) differentiable_compose differentiable_eucl_nth)

lemma frechet_derivative_eucl_nth':
  fixes f :: "_ \<Rightarrow> 'a::executable_euclidean_space"
  assumes "f differentiable (at t)" "k < DIM('a)"
  shows "\<partial> (\<lambda> x. eucl_nth k (f x)) (at t) = (\<lambda> x. eucl_nth k (\<partial> f (at t) x))"
  by (metis (full_types) assms(1) assms(2) frechet_derivative_at frechet_derivative_works has_derivative_eucl_nth)

text \<open> The Euclidean lens extracts the nth component of a Euclidean space \<close>

definition eucl_lens :: "nat \<Rightarrow> (real \<Longrightarrow> 'a::executable_euclidean_space)" ("\<Pi>[_]") where
[lens_defs]: "eucl_lens k = \<lparr> lens_get = eucl_nth k
                            , lens_put = (\<lambda> s v. eucl_of_list(list_update (list_of_eucl s) k v)) \<rparr>"

lemma eucl_vwb_lens [simp]:
  "k < DIM('a::executable_euclidean_space) \<Longrightarrow> vwb_lens (\<Pi>[k] :: real \<Longrightarrow> 'a)"
  apply (unfold_locales)
  apply (simp_all add: lens_defs eucl_of_list_inner eucl_nth_def)
  apply (metis eucl_of_list_list_of_eucl list_of_eucl_nth list_update_id)
  done

lemma eucl_lens_indep [simp]:
  "\<lbrakk> i < DIM('a); j < DIM('a); i \<noteq> j \<rbrakk> \<Longrightarrow> (eucl_lens i :: real \<Longrightarrow> 'a::executable_euclidean_space) \<bowtie> eucl_lens j"
  by (unfold_locales, simp_all add: lens_defs list_update_swap eucl_of_list_inner eucl_nth_def)

lemma bounded_linear_eucl_get [simp]:
  "k < DIM('a::executable_euclidean_space) \<Longrightarrow> bounded_linear (get\<^bsub>\<Pi>[k] :: real \<Longrightarrow> 'a\<^esub>)"
  by (metis bounded_linear_eucl_nth eucl_lens_def lens.simps(1))

text \<open> Characterising lenses that are equivalent to Euclidean lenses \<close>

definition is_eucl_lens :: "(real \<Longrightarrow> 'a::executable_euclidean_space) \<Rightarrow> bool" where
"is_eucl_lens x = (\<exists> k. k < DIM('a) \<and> x \<approx>\<^sub>L \<Pi>[k])"

lemma eucl_lens_is_eucl:
  "k < DIM('a::executable_euclidean_space) \<Longrightarrow> is_eucl_lens (\<Pi>[k] :: real \<Longrightarrow> 'a)"
  by (force simp add: is_eucl_lens_def)

lemma eucl_lens_is_vwb [simp]: "is_eucl_lens x \<Longrightarrow> vwb_lens x"
  using eucl_vwb_lens is_eucl_lens_def lens_equiv_def sublens_pres_vwb by blast

lemma bounded_linear_eucl_lens: "is_eucl_lens x \<Longrightarrow> bounded_linear (get\<^bsub>x\<^esub>)"
  oops

subsection \<open> Hybrid state space \<close>

text \<open> A hybrid state-space consists, minimally, of a suitable topological space that occupies
  the continuous variables. Usually, @{typ 'c} will be a Euclidean space or real vector. \<close>

alphabet 'c::t2_space hybs =
  cvec :: "'c"
(*  cghost :: "'c" *)

text \<open> The remainder of the state-space is discrete and we make no requirements of it \<close>

abbreviation "dst \<equiv> hybs.more\<^sub>L"

notation cvec ("\<^bold>c")
notation dst ("\<^bold>d")

text \<open> We define hybrid expressions, predicates, and relations (i.e. programs) by utilising
  the hybrid state-space type. \<close>

type_synonym ('a, 'c, 's) hyexpr = "('a, ('c, 's) hybs_scheme) uexpr"
type_synonym ('c, 's) hypred = "('c, 's) hybs_scheme upred"
type_synonym ('c, 's) hyrel = "('c, 's) hybs_scheme hrel"

subsection \<open> Syntax \<close>

syntax
  "_vec_lens"  :: "logic \<Rightarrow> svid" ("\<pi>[_]")
  "_eucl_lens" :: "logic \<Rightarrow> svid" ("\<Pi>[_]")
  "_cvec_lens" :: "svid" ("\<^bold>c")
  "_dst_lens"  :: "svid" ("\<^bold>d")

translations
  "_vec_lens x" == "CONST vec_lens x"
  "_eucl_lens x" == "CONST eucl_lens x"
  "_cvec_lens" == "CONST cvec"
  "_dst_lens" == "CONST dst"

end


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
section \<open>Transitive Sets\<close>
theory Mem_Trans
  imports Subset
begin

lemma mem_transI [intro]: "(\<And>x. x \<in> X \<Longrightarrow> x \<subseteq> X) \<Longrightarrow> mem_trans X"
  unfolding mem_trans_def by auto

lemma mem_transI': "(\<And>x y. x \<in> X \<Longrightarrow> y \<in> x \<Longrightarrow> y \<in> X) \<Longrightarrow> mem_trans X"
  by auto

lemma mem_transD [dest]: "mem_trans x \<Longrightarrow> y \<in> x \<Longrightarrow> y \<subseteq> x"
  unfolding mem_trans_def by auto

end


section \<open>Contexts and Subsumption\<close>
text\<open>This theory uses contexts to extend the idea of transition subsumption from \cite{lorenzoli2008} to
EFSM transitions with register update functions. The \emph{subsumption in context} relation is the
main contribution of \cite{foster2018}.\<close>

theory Subsumption
  imports
    "Extended_Finite_State_Machines.EFSM"
begin

definition posterior_separate :: "nat \<Rightarrow> vname gexp list \<Rightarrow> update_function list \<Rightarrow> inputs \<Rightarrow> registers \<Rightarrow> registers option" where
  "posterior_separate a g u i r = (if can_take a g i r then Some (apply_updates u (join_ir i r) r) else None)"

definition posterior :: "transition \<Rightarrow> inputs \<Rightarrow> registers \<Rightarrow> registers option" where
  "posterior t i r = posterior_separate (Arity t) (Guards t) (Updates t) i r"

definition subsumes :: "transition \<Rightarrow> registers \<Rightarrow> transition \<Rightarrow> bool" where
  "subsumes t2 r t1 = (Label t1 = Label t2 \<and> Arity t1 = Arity t2 \<and>
                       (\<forall>i. can_take_transition t1 i r \<longrightarrow> can_take_transition t2 i r) \<and>
                       (\<forall>i. can_take_transition t1 i r \<longrightarrow>
                            evaluate_outputs t1 i r = evaluate_outputs t2 i r) \<and>
                       (\<forall>p1 p2 i. posterior_separate (Arity t1) (Guards t1) (Updates t2) i r = Some p2 \<longrightarrow>
                                  posterior_separate (Arity t1) (Guards t1) (Updates t1) i r = Some p1 \<longrightarrow>
                                  (\<forall>P r'. (p1 $ r' = None) \<or> (P (p2 $ r') \<longrightarrow> P (p1 $ r'))))
                      )"

lemma no_functionality_subsumed:
  "Label t1 = Label t2 \<Longrightarrow>
   Arity t1 = Arity t2 \<Longrightarrow>
   \<nexists>i. can_take_transition t1 i c \<Longrightarrow>
   subsumes t2 c t1"
  by (simp add: subsumes_def posterior_separate_def can_take_transition_def)

lemma subsumes_updates:
  "subsumes t2 r t1 \<Longrightarrow>
   can_take_transition t1 i r \<Longrightarrow>
   evaluate_updates t1 i r $ a = Some x \<Longrightarrow>
   evaluate_updates t2 i r $ a = Some x"
  apply (simp add: subsumes_def posterior_separate_def can_take_transition_def[symmetric])
  apply clarsimp
  apply (erule_tac x=i in allE)+
  apply (erule_tac x="evaluate_updates t1 i r" in allE)
  apply (erule_tac x="evaluate_updates t2 i r" in allE)
  apply (erule_tac x=i in allE)
  apply simp
  apply (simp add: all_comm[of "\<lambda>P r'.
            P (evaluate_updates t2 i r $ r') \<longrightarrow> evaluate_updates t1 i r $ r' = None \<or> P (evaluate_updates t1 i r $ r')"])
  apply (erule_tac x=a in allE)
  by auto

lemma subsumption:
  "(Label t1 = Label t2 \<and> Arity t1 = Arity t2) \<Longrightarrow>
   (\<forall>i. can_take_transition t1 i r \<longrightarrow> can_take_transition t2 i r) \<Longrightarrow>
   (\<forall>i. can_take_transition t1 i r \<longrightarrow>
        evaluate_outputs t1 i r = evaluate_outputs t2 i r) \<Longrightarrow>

   (\<forall>p1 p2 i. posterior_separate (Arity t1) (Guards t1) (Updates t2) i r = Some p2 \<longrightarrow>
              posterior_separate (Arity t1) (Guards t1) (Updates t1) i r = Some p1 \<longrightarrow>
              (\<forall>P r'. (p1 $ r' = None) \<or> (P (p2 $ r') \<longrightarrow> P (p1 $ r')))) \<Longrightarrow>
   subsumes t2 r t1"
  by (simp add: subsumes_def)

lemma bad_guards:
  "\<exists>i. can_take_transition t1 i r \<and> \<not> can_take_transition t2 i r \<Longrightarrow>
   \<not> subsumes t2 r t1"
  by (simp add: subsumes_def)

lemma inconsistent_updates:
  "\<exists>p2 p1. (\<exists>i. posterior_separate (Arity t1) (Guards t1) (Updates t2) i r = Some p2 \<and>
                posterior_separate (Arity t1) (Guards t1) (Updates t1) i r = Some p1) \<and>
           (\<exists>r' P. P (p2 $ r') \<and> (\<exists>y. p1 $ r' = Some y) \<and> \<not> P (p1 $ r')) \<Longrightarrow>

    \<not> subsumes t2 r t1"
  by (metis (no_types, opaque_lifting) option.simps(3) subsumes_def)

lemma bad_outputs:
  "\<exists>i. can_take_transition t1 i r \<and> evaluate_outputs t1 i r \<noteq> evaluate_outputs t2 i r \<Longrightarrow>
   \<not> subsumes t2 r t1"
  by (simp add: subsumes_def)

lemma no_choice_no_subsumption: "Label t = Label t' \<Longrightarrow>
   Arity t = Arity t' \<Longrightarrow>
   \<not> choice t t' \<Longrightarrow>
   \<exists>i. can_take_transition t' i c \<Longrightarrow>
  \<not> subsumes t c t'"
  by (meson bad_guards can_take_def can_take_transition_def choice_def)

lemma subsumption_def_alt: "subsumes t1 c t2 = (Label t2 = Label t1 \<and>
    Arity t2 = Arity t1 \<and>
    (\<forall>i. can_take_transition t2 i c \<longrightarrow> can_take_transition t1 i c) \<and>
    (\<forall>i. can_take_transition t2 i c \<longrightarrow> evaluate_outputs t2 i c = evaluate_outputs t1 i c) \<and>
    (\<forall>i. can_take_transition t2 i c \<longrightarrow>
         (\<forall>r' P.
             P (evaluate_updates t1 i c $ r') \<longrightarrow>
             evaluate_updates t2 i c $ r' = None \<or> P (evaluate_updates t2 i c $ r'))))"
  apply (simp add: subsumes_def posterior_separate_def can_take_transition_def[symmetric])
  by blast

text_raw\<open>\snip{subsumptionReflexive}{1}{2}{%\<close>
lemma subsumes_reflexive: "subsumes t c t"
text_raw\<open>$\langle\isa{proof}\rangle$}%endsnip\<close>
  by (simp add: subsumes_def)

text_raw\<open>\snip{subsumptionTransitive}{1}{2}{%\<close>
lemma subsumes_transitive:
  assumes p1: "subsumes t1 c t2"
      and p2: "subsumes t2 c t3"
  shows "subsumes t1 c t3"
text_raw\<open>}%endsnip\<close>
  using p1 p2
  apply (simp add: subsumes_def)
  by (metis subsumes_update_equality p1 p2 can_take_transition_def option.distinct(1) option.sel posterior_separate_def)

lemma subsumes_possible_steps_replace:
  "(s2', t2') |\<in>| possible_steps e2 s2 r2 l i \<Longrightarrow>
   subsumes t2 r2 t1 \<Longrightarrow>
   ((s2, s2'), t2') = ((ss2, ss2'), t1) \<Longrightarrow>
   (s2', t2) |\<in>| possible_steps (replace e2 ((ss2, ss2'), t1) ((ss2, ss2'), t2)) s2 r2 l i"
proof(induct e2)
  case empty
  then show ?case
    by (simp add: no_outgoing_transitions)
next
  case (insert x e2)
  then show ?case
    apply (simp add: fmember_possible_steps subsumes_def)
    apply standard
    apply (simp add: replace_def)
     apply auto[1]
    by (simp add: can_take)
qed

subsection\<open>Direct Subsumption\<close>
text\<open>When merging EFSM transitions, one must \emph{account for} the behaviour of the other. The
\emph{subsumption in context} relation formalises the intuition that, in certain contexts, a
transition $t_2$ reproduces the behaviour of, and updates the data state in a manner consistent
with, another transition $t_1$, meaning that $t_2$ can be used in place of $t_1$ with no observable
difference in behaviour.

The subsumption in context relation requires us to supply a context in which to test subsumption,
but there is a problem when we try to apply this to inference: Which context should we use? The
\emph{direct subsumption} relation works at EFSM level to determine when and whether one transition
is able to account for the behaviour of another such that we can use one in place of another without
adversely effecting observable behaviour.\<close>

text_raw\<open>\snip{directlySubsumes}{1}{2}{%\<close>
definition directly_subsumes :: "transition_matrix \<Rightarrow> transition_matrix \<Rightarrow> cfstate \<Rightarrow> cfstate \<Rightarrow> transition \<Rightarrow> transition \<Rightarrow> bool" where
  "directly_subsumes e1 e2 s1 s2 t1 t2 \<equiv> (\<forall>c1 c2 t. (obtains s1 c1 e1 0 <> t \<and> obtains s2 c2 e2 0 <> t) \<longrightarrow> subsumes t1 c2 t2)"
text_raw\<open>}%endsnip\<close>

text_raw\<open>\snip{subsumesAllContexts}{1}{2}{%\<close>
lemma subsumes_in_all_contexts_directly_subsumes:
  "(\<And>c. subsumes t2 c t1) \<Longrightarrow> directly_subsumes e1 e2 s s' t2 t1"
text_raw\<open>}%endsnip\<close>
  by (simp add: directly_subsumes_def)

text_raw\<open>\snip{directSubsumption}{1}{2}{%\<close>
lemma direct_subsumption:
  "(\<And>t c1 c2. obtains s1 c1 e1 0 <> t \<Longrightarrow> obtains s2 c2 e2 0 <> t \<Longrightarrow> f c2) \<Longrightarrow>
   (\<And>c. f c \<Longrightarrow> subsumes t1 c t2) \<Longrightarrow>
   directly_subsumes e1 e2 s1 s2 t1 t2"
   text_raw\<open>}%endsnip\<close>
  apply (simp add: directly_subsumes_def)
  by auto

text_raw\<open>\snip{obtainableNoSubsumption}{1}{2}{%\<close>
lemma visits_and_not_subsumes:
  "(\<exists>c1 c2 t. obtains s1 c1 e1 0 <> t \<and> obtains s2 c2 e2 0 <> t \<and> \<not> subsumes t1 c2 t2) \<Longrightarrow>
   \<not> directly_subsumes e1 e2 s1 s2 t1 t2"
text_raw\<open>}%endsnip\<close>
  apply (simp add: directly_subsumes_def)
  by auto

text_raw\<open>\snip{directSubsumptionReflexive}{1}{2}{%\<close>
lemma directly_subsumes_reflexive: "directly_subsumes e1 e2 s1 s2 t t"
text_raw\<open>}%endsnip\<close>
  apply (simp add: directly_subsumes_def)
  by (simp add: subsumes_reflexive)

text_raw\<open>\snip{directSubsumptionTransitive}{1}{2}{%\<close>
lemma directly_subsumes_transitive:
  assumes p1: "directly_subsumes e1 e2 s1 s2 t1 t2"
      and p2: "directly_subsumes e1 e2 s1 s2 t2 t3"
  shows "directly_subsumes e1 e2 s1 s2 t1 t3"
  text_raw\<open>}%endsnip\<close>
  using p1 p2
  apply (simp add: directly_subsumes_def)
  using subsumes_transitive by blast

end