(*  Title:       Labelled Transition Systems
    Authors:     Thomas Tuerk <tuerk@in.tum.de>
                 Petra Dietrich <petra@ecs.vuw.ac.nz>

    using Peter Lammich <peter.lammich@uni-muenster.de> work on
    Finite state machines
*)

section \<open> Labeled transition systems \<close>

theory LTS
imports Main "../Automata_Merz/Words"
begin

declare upt_Suc[simp del]

text \<open> This theory defines labeled transition systems (LTS). \<close>

subsection \<open> Auxiliary Definitions \<close>
lemma lists_product :
  "w \<in> lists (\<Sigma>1 \<times> \<Sigma>2) \<longleftrightarrow> (map fst w) \<in> lists \<Sigma>1 \<and>  (map snd w) \<in> lists \<Sigma>2"
by (induct w, auto)

lemma lists_inter : "w \<in> lists (\<Sigma>1 \<inter> \<Sigma>2) = (w \<in> lists \<Sigma>1 \<and> w \<in> lists \<Sigma>2)"
  by (simp add: lists_eq_set)

lemma lists_rev [simp] :
  "(rev w) \<in> lists \<Sigma> \<longleftrightarrow> w \<in> lists \<Sigma>"
by auto

lemma rev_image_lists [simp] :
  "rev ` (lists A) = lists A"
proof (rule set_eqI)
  fix xs
  have "xs \<in> rev ` (lists A) \<longleftrightarrow> rev xs \<in> lists A"
    apply (simp add: image_iff Bex_def)
    apply (metis rev_swap lists_rev)
  done
  thus "xs \<in> rev ` lists A \<longleftrightarrow> xs \<in> lists A"
    by simp
qed

subsection \<open> Basic Definitions \<close>
subsubsection \<open> Transition Relations \<close>

text \<open> Given a set of states $\mathcal{Q}$ and an alphabet $\Sigma$,
a labeled transition system is a subset of $\mathcal{Q} \times \Sigma
\times \mathcal{Q}$.  Given such a relation $\Delta \subseteq
\mathcal{Q} \times \Sigma \times \mathcal{Q}$, a triple $(q, \sigma,
q')$ is an element of $\Delta$ iff starting in state $q$ the state
$q'$ can be reached reading the label $\sigma$.\<close>

type_synonym ('q,'a) LTS = "('q * 'a * 'q) set"

lemma LTS_image_finiteI [intro]:
  assumes "finite \<Delta>"
  shows "finite {(f q,a,f q') | q a q'. (q,a,q') \<in> \<Delta>}" (is "finite ?\<Delta>")
proof -
  have "?\<Delta> = (\<lambda>(q,a,q'). (f q,a,f q')) ` \<Delta>"
    by (fastforce split: prod.split)
  with assms show ?thesis by simp
qed

subsubsection \<open> Finite Runs \<close>

definition LTS_is_fin_run :: "('q,'a) LTS \<Rightarrow> 'a list \<Rightarrow> 'q list \<Rightarrow> bool" where
  "LTS_is_fin_run \<Delta> w r \<longleftrightarrow>
     ((length r = Suc (length w)) \<and>
      (\<forall>i < length w. (r ! i, w ! i, r ! (Suc i)) \<in> \<Delta>))"

lemma LTS_is_fin_run_D1 :
  "LTS_is_fin_run \<Delta> w r \<Longrightarrow> (length r = Suc (length w))"
   unfolding LTS_is_fin_run_def by simp

lemma LTS_is_fin_run_D2 :
  "LTS_is_fin_run \<Delta> w r \<Longrightarrow>
   i < length w \<Longrightarrow>
   (r ! i, w ! i, r ! (Suc i)) \<in> \<Delta>"
   unfolding LTS_is_fin_run_def by simp

lemma LTS_is_fin_run_I[intro!] :
  "\<lbrakk>length r = Suc (length w);
    \<And>i. i < length w \<Longrightarrow> (r ! i, w ! i, r ! (Suc i)) \<in> \<Delta>\<rbrakk> \<Longrightarrow>
   LTS_is_fin_run \<Delta> w r"
   unfolding LTS_is_fin_run_def by blast

lemma LTS_is_fin_run_simps[simp] :
  "LTS_is_fin_run \<Delta> w [] = False" (is ?T1)
  "LTS_is_fin_run \<Delta> w [q] = (w = [])" (is ?T2)
  "LTS_is_fin_run \<Delta> [] r = (length r = 1)" (is ?T3)
  "LTS_is_fin_run \<Delta> (a # w) (q1 # q2 # r) =
     ((q1, a, q2) \<in> \<Delta> \<and> LTS_is_fin_run \<Delta> w (q2 # r))" (is ?T4)
proof -
  show ?T1 ?T2 ?T3 unfolding LTS_is_fin_run_def by auto
next
  show "?T4" (is "?T4_l \<longleftrightarrow> ?T4_r")
  proof (rule iffI)
    assume l: "?T4_l"
    show "?T4_r"
    proof (intro conjI LTS_is_fin_run_I)
      from LTS_is_fin_run_D1[OF l]
      show "length (q2 # r) = Suc (length w)" by simp
    next
      note l_simp = LTS_is_fin_run_D2[OF l]

      from l_simp[of 0] show "(q1, a, q2) \<in> \<Delta>" by simp

      fix i
      assume "i < length w"
      with l_simp[of "Suc i"] show "((q2 # r) ! i, w ! i, (q2 # r) ! Suc i) \<in> \<Delta>"
        by simp
    qed
  next
    assume r: "?T4_r"
    hence r0: "(q1, a, q2) \<in> \<Delta>" and r_run:"LTS_is_fin_run \<Delta> w (q2 # r)" by simp_all

    show "?T4_l"
    proof (intro LTS_is_fin_run_I)
      from LTS_is_fin_run_D1[OF r_run]
      show "length (q1 # q2 # r) = Suc (length (a # w))" by simp
    next
      fix i
      assume i_less: "i < length (a # w)"

      show "((q1 # q2 # r) ! i, (a # w) ! i, (q1 # q2 # r) ! Suc i) \<in> \<Delta>"
      proof (cases i)
        case 0 with r0 show ?thesis by simp
      next
        case (Suc i') with i_less LTS_is_fin_run_D2[OF r_run, of i']
        show ?thesis by simp
      qed
    qed
  qed
qed

lemma LTS_is_fin_run_expand_r2 :
  "LTS_is_fin_run \<Delta> (a # w) r =
    (\<exists>q1 q2 r'. r = (q1 # q2 # r') \<and> (q1, a, q2) \<in> \<Delta> \<and> LTS_is_fin_run \<Delta> w (q2 # r'))"
apply (cases r, simp, rename_tac q1 r')
apply (case_tac r', simp_all)
done

lemma LTS_is_fin_run_expand_r :
  "LTS_is_fin_run \<Delta> (a # w) r =
    (\<exists>q r'. r = (q # r') \<and> (q, a, hd r') \<in> \<Delta> \<and> LTS_is_fin_run \<Delta> w r')"
apply (cases r, simp, rename_tac q1 r')
apply (case_tac r', simp_all)
done

lemma LTS_is_fin_run_expand_r1 :
  "LTS_is_fin_run \<Delta> w r =
    (\<exists>q r'. r = (q # r') \<and> LTS_is_fin_run \<Delta> w (q # r'))"
by (cases r, auto)

lemma LTS_is_fin_run_expand_w :
  "LTS_is_fin_run \<Delta> w (q1 # q2 # r) =
    (\<exists>a w'. w = (a # w') \<and> (q1, a, q2) \<in> \<Delta> \<and> LTS_is_fin_run \<Delta> w' (q2 # r))"
by (cases w, simp_all)

subsubsection \<open> Infinite Runs \<close>

definition LTS_is_inf_run :: "('q,'a) LTS \<Rightarrow> 'a word \<Rightarrow> 'q word \<Rightarrow> bool" where
  "LTS_is_inf_run \<Delta> w r \<longleftrightarrow> (\<forall>i. (r i, w i, r (Suc i)) \<in> \<Delta>)"

lemma LTS_is_inf_run_D :
  "LTS_is_inf_run \<Delta> w r \<Longrightarrow>
   (r i, w i, r (Suc i)) \<in> \<Delta>"
   unfolding LTS_is_inf_run_def by simp

lemma LTS_is_inf_run_I[intro!] :
  "\<lbrakk>\<And>i. (r i, w i, r (Suc i)) \<in> \<Delta>\<rbrakk> \<Longrightarrow>
   LTS_is_inf_run \<Delta> w r"
   unfolding LTS_is_inf_run_def by blast

text \<open> Every suffix of infinite run is an infinite run \<close>

lemma LTS_is_inf_run___suffix :
assumes inf_run: "LTS_is_inf_run \<Delta> w r"
shows "LTS_is_inf_run \<Delta> (suffix k w) (suffix k r)"
using inf_run unfolding LTS_is_inf_run_def suffix_def by simp

text \<open> Every finite chunk of an infinite run is a finite run \<close>

lemma LTS_is_inf_run___extract_fin_run :
assumes inf_run: "LTS_is_inf_run \<Delta> w r"
    and i_le: "i \<le> j"
shows "LTS_is_fin_run \<Delta> (map w [i..<j]) (map r [i..<Suc j])"
using inf_run i_le
unfolding LTS_is_fin_run_def LTS_is_inf_run_def
by simp

lemma LTS_is_inf_run___prefix :
assumes inf_run: "LTS_is_inf_run \<Delta> w r"
shows "LTS_is_fin_run \<Delta> (map w [0..<i]) (map r [0..<Suc i])"
using LTS_is_inf_run___extract_fin_run[OF inf_run, of 0 i] by simp

subsubsection \<open> Reachability \<close>

text \<open> Often it is enough to consider just the first and last state of
a run. This leads to the following definition of reachability. Notice,
that @{term "LTS_is_reachable \<Delta>"} is the reflexive, transitive closure of @{term \<Delta>}. \<close>

fun LTS_is_reachable :: "('q, 'a) LTS \<Rightarrow> 'q \<Rightarrow> 'a list \<Rightarrow> 'q \<Rightarrow> bool" where
   "LTS_is_reachable \<Delta> q [] q' = (q = q')"
 | "LTS_is_reachable \<Delta> q (\<sigma> # w) q' =
      (\<exists>q''. (q, \<sigma>, q'') \<in> \<Delta> \<and> LTS_is_reachable \<Delta> q'' w q')"

text \<open> Let's show the connection with @{term LTS_is_fin_run}.\<close>
lemma LTS_is_reachable_alt_def :
  "LTS_is_reachable \<Delta> q w q' \<longleftrightarrow>
   (\<exists>r. LTS_is_fin_run \<Delta> w r \<and> hd r = q \<and> last r = q')"
proof (induct w arbitrary: q)
  case Nil thus ?case by (auto simp add: length_Suc_conv)
next
  case (Cons \<sigma> w) thus ?case
    using LTS_is_fin_run_expand_r[of \<Delta> \<sigma> w ]
    apply (simp del: ex_simps add: ex_simps[symmetric])
    apply (metis LTS_is_fin_run_simps(1))
  done
qed

lemma LTS_is_reachable_concat :
   "LTS_is_reachable \<Delta> q (w @ w') q' =
    (\<exists>q''. LTS_is_reachable \<Delta> q w q'' \<and> LTS_is_reachable \<Delta> q'' w' q')"
by (induct w arbitrary: q, auto)

lemma LTS_is_reachable_snoc [simp] :
   "LTS_is_reachable \<Delta> q (w @ [\<sigma>]) q' =
    (\<exists>q''. LTS_is_reachable \<Delta> q w q'' \<and> (q'', \<sigma>, q') \<in> \<Delta>)"
by (simp add: LTS_is_reachable_concat)

text \<open> Connection with infinite runs \<close>

lemma LTS_is_inf_run___is_reachable :
assumes inf_run: "LTS_is_inf_run \<Delta> w r"
    and i_le: "i \<le> j"
shows "LTS_is_reachable \<Delta> (r i) (map w [i..<j]) (r j)"
using LTS_is_inf_run___extract_fin_run[OF inf_run i_le] i_le
unfolding LTS_is_reachable_alt_def
  apply (rule_tac exI[where x = "map r [i..<Suc j]"])
  apply (simp add: hd_map last_map)
done

text \<open> Unreachability is often interesting as well. \<close>
definition LTS_is_unreachable where
   "LTS_is_unreachable \<Delta> q q' \<longleftrightarrow> \<not>(\<exists>w. LTS_is_reachable \<Delta> q w q')"

lemma LTS_is_unreachable_not_refl [simp] :
   "\<not>(LTS_is_unreachable \<Delta> q q)"
proof -
  have "LTS_is_reachable \<Delta> q [] q" by simp
  thus "\<not>(LTS_is_unreachable \<Delta> q q)"
    by (metis LTS_is_unreachable_def)
qed

lemma LTS_is_inf_run___is_unreachable :
assumes inf_run: "LTS_is_inf_run \<Delta> w r"
    and i_le: "i \<le> j"
shows "\<not>(LTS_is_unreachable \<Delta> (r i) (r j))"
using LTS_is_inf_run___is_reachable[OF inf_run i_le]
unfolding LTS_is_unreachable_def
  apply (simp add: Bex_def)
  apply (rule_tac exI[where x = "map w [i..< j]"])
  apply (simp)
done

lemma LTS_is_unreachable_reachable_start :
assumes unreach_q_q': "LTS_is_unreachable \<Delta> q q'"
    and reach_q_q'': "LTS_is_reachable \<Delta> q w q''"
shows "LTS_is_unreachable \<Delta> q'' q'"
proof (rule ccontr)
  assume "\<not> (LTS_is_unreachable \<Delta> q'' q')"
  then obtain w' where reach_q''_q': "LTS_is_reachable \<Delta> q'' w' q'"
    by (auto simp add: LTS_is_unreachable_def)

  from reach_q_q'' reach_q''_q' have
    reach_q_q' : "LTS_is_reachable \<Delta> q (w @ w') q'" by (auto simp add: LTS_is_reachable_concat)

  from reach_q_q' unreach_q_q' show "False"
    by (metis LTS_is_unreachable_def)
qed

lemma LTS_is_unreachable_reachable_end :
   "\<lbrakk>LTS_is_unreachable \<Delta> q q'; LTS_is_reachable \<Delta> q'' w q'; w \<in> lists \<Sigma>\<rbrakk> \<Longrightarrow>
    LTS_is_unreachable \<Delta> q q''"
by (metis LTS_is_unreachable_def LTS_is_unreachable_reachable_start)

subsection \<open> Efficient way of computing reachability \<close>

fun LTS_is_reachable_fun where
   "LTS_is_reachable_fun \<Delta> [] Q = Q"
 | "LTS_is_reachable_fun \<Delta> (a # as) Q =
    LTS_is_reachable_fun \<Delta> as {q'. \<exists>q\<in>Q. (q, a, q') \<in> \<Delta>}"

lemma LTS_is_reachable_fun_alt_def :
  "LTS_is_reachable_fun \<Delta> w Q = {q'. \<exists>q \<in> Q. LTS_is_reachable \<Delta> q w q'}"
by (induct w arbitrary: Q) auto

subsection \<open> Deterministic Transition Relations \<close>

text \<open> Often, one is interested in deterministic transition
 systems. There are several slightly different notions of
 deterministic transitions systems in literature. In the following,
 we consider transition systems that are complete as well.
 This allows to represent determistic transition systems as functions.
\<close>

definition LTS_is_deterministic :: "('q, 'a) LTS \<Rightarrow> bool" where
  "LTS_is_deterministic \<Delta> = (\<forall>q \<sigma> q1' q2'. ((q, \<sigma>, q1') \<in> \<Delta> \<and> (q, \<sigma>, q2') \<in> \<Delta>) \<longrightarrow> (q1' = q2'))"

lemma LTS_is_deterministic_I[intro] :
  "\<lbrakk>\<And>q \<sigma> q1' q2'. \<lbrakk>(q, \<sigma>, q1') \<in> \<Delta>; (q, \<sigma>, q2') \<in> \<Delta>\<rbrakk> \<Longrightarrow> (q1' = q2')\<rbrakk> \<Longrightarrow>
   LTS_is_deterministic \<Delta>"
unfolding LTS_is_deterministic_def by auto

definition LTS_is_complete :: "'q set \<Rightarrow> 'a set \<Rightarrow> ('q, 'a) LTS \<Rightarrow> bool" where
  "LTS_is_complete \<Q> \<Sigma> \<Delta> = (\<forall>q\<in>\<Q>. \<forall>\<sigma>\<in>\<Sigma>. \<exists>q'\<in>\<Q>. (q, \<sigma>, q') \<in> \<Delta>)"

definition LTS_is_complete_deterministic :: "'q set \<Rightarrow> 'a set \<Rightarrow> ('q, 'a) LTS \<Rightarrow> bool" where
  "LTS_is_complete_deterministic \<Q> \<Sigma> \<Delta> \<equiv> (LTS_is_deterministic \<Delta> \<and> LTS_is_complete \<Q> \<Sigma> \<Delta>)"

type_synonym ('q,'a) DLTS = "'q * 'a \<Rightarrow> 'q option"

definition DLTS_to_LTS :: "('q, 'a) DLTS \<Rightarrow> ('q, 'a) LTS"
where "DLTS_to_LTS \<delta> \<equiv> {(q, \<sigma>, q') | q \<sigma> q'. \<delta>(q, \<sigma>) = Some q'}"

lemma DLTS_to_LTS_alt_def [simp]:
  "(q, \<sigma>, q') \<in> DLTS_to_LTS \<delta> \<longleftrightarrow> (\<delta>(q, \<sigma>) = Some q')"
by (auto simp add: DLTS_to_LTS_def)

lemma DLTS_to_LTS___LTS_is_deterministic [simp] :
  "LTS_is_deterministic (DLTS_to_LTS \<delta>)"
by (auto simp add: LTS_is_deterministic_def)

lemma DLTS_to_LTS___LTS_is_complete_deterministic :
  "\<lbrakk>\<And>q \<sigma>. \<lbrakk>q \<in> \<Q>; \<sigma> \<in> \<Sigma>\<rbrakk> \<Longrightarrow> \<exists>q'\<in>\<Q>. (\<delta> (q, \<sigma>) = Some q')\<rbrakk> \<Longrightarrow>
   LTS_is_complete_deterministic \<Q> \<Sigma> (DLTS_to_LTS \<delta>)"
by (auto simp add: LTS_is_complete_deterministic_def LTS_is_complete_def)

definition LTS_to_DLTS :: "('q, 'a) LTS \<Rightarrow> ('q, 'a) DLTS" where
  "LTS_to_DLTS \<Delta> \<equiv> (\<lambda>(q,\<sigma>). if (\<exists>q'. (q,\<sigma>,q') \<in> \<Delta>) then Some (SOME q'. (q, \<sigma>, q') \<in> \<Delta>) else None)"

lemma LTS_to_DLTS_in :
  "(q, \<sigma>, q') \<in> \<Delta> \<Longrightarrow> (\<exists>q''. LTS_to_DLTS \<Delta> (q,\<sigma>) = Some q'' \<and> (q, \<sigma>, q'') \<in> \<Delta>)"
by (auto simp add: LTS_to_DLTS_def,
    rule someI2, simp_all)

lemma split_if_eq1:
  "((if Q then x else y) = b) = ((Q --> x = b) & (\<not> Q --> y = b))"
  by simp

lemma LTS_to_DLTS_is_some :
  "LTS_to_DLTS \<Delta> (q,\<sigma>) = Some q' \<Longrightarrow> (q, \<sigma>, q') \<in> \<Delta>"
apply (auto simp add: LTS_to_DLTS_def split_if_eq1)
apply (rule_tac someI_ex)
apply auto
done

lemma LTS_to_DLTS_is_none :
  "(LTS_to_DLTS \<Delta> (q,\<sigma>) = None) \<longleftrightarrow> (\<forall>q'. (q, \<sigma>, q') \<notin> \<Delta>)"
by (simp add: LTS_to_DLTS_def split_if_eq1)

lemma LTS_to_DLTS_is_some_det :
  "LTS_is_deterministic \<Delta> \<Longrightarrow>
   ((LTS_to_DLTS \<Delta> (q, \<sigma>) = Some q') \<longleftrightarrow> (q, \<sigma>, q') \<in> \<Delta>)"
by (metis LTS_to_DLTS_in LTS_is_deterministic_def LTS_to_DLTS_is_some)

lemma DLTS_to_LTS_inv [simp] :
   "LTS_to_DLTS (DLTS_to_LTS \<delta>) = \<delta>"
apply (subst fun_eq_iff, clarify)
apply (auto simp add: DLTS_to_LTS_def LTS_to_DLTS_def)
done

lemma LTS_to_DLTS_inv :
   "LTS_is_deterministic \<Delta> \<Longrightarrow>
    DLTS_to_LTS (LTS_to_DLTS \<Delta>) = \<Delta>"
by (simp add: DLTS_to_LTS_def LTS_to_DLTS_is_some_det, auto)

subsubsection \<open> Unique Runs \<close>

text \<open> In deterministic transition systems, there is at most one run. \<close>
lemma DLTS_is_fin_run_unique :
assumes det_\<Delta>: "LTS_is_deterministic \<Delta>"
    and run_r1: "LTS_is_fin_run \<Delta> w r1"
    and run_r2: "LTS_is_fin_run \<Delta> w r2"
    and start_eq: "hd r1 = hd r2"
shows "r1 = r2"
using assms
  apply (induct w arbitrary: r1 r2)
  apply (auto simp add: length_Suc_conv)[]
  apply (simp add: LTS_is_fin_run_expand_r)
  apply clarify
  apply (simp add: LTS_is_deterministic_def)
done

lemma DLTS_is_inf_run_unique :
assumes det_\<Delta>: "LTS_is_deterministic \<Delta>"
    and run_r1: "LTS_is_inf_run \<Delta> w r1"
    and run_r2: "LTS_is_inf_run \<Delta> w r2"
    and start_eq: "r1 0 = r2 0"
shows "r1 = r2"
proof
  fix i
  show "r1 i = r2 i"
  proof (induct i)
    case 0 with start_eq show ?case by simp
  next
    case (Suc i) note indhyp = this

    from LTS_is_inf_run_D[OF run_r1, of i]
    have r1_next: "(r1 i, w i, r1 (Suc i)) \<in> \<Delta>" .

    from LTS_is_inf_run_D[OF run_r2, of i]
    have r2_next: "(r2 i, w i, r2 (Suc i)) \<in> \<Delta>" .

    from det_\<Delta> r1_next r2_next indhyp
    show ?case unfolding LTS_is_deterministic_def by metis
  qed
qed

lemma LTS_is_reachable___LTS_is_deterministic :
assumes det_\<Delta>: "LTS_is_deterministic \<Delta>"
shows  "\<lbrakk>LTS_is_reachable \<Delta> q w q'; LTS_is_reachable \<Delta> q w q''\<rbrakk> \<Longrightarrow> (q' = q'')"
using DLTS_is_fin_run_unique[OF det_\<Delta>, of w]
unfolding LTS_is_reachable_alt_def
by blast

definition LTS_image_filter_inj_on where
  "LTS_image_filter_inj_on f A =
    (\<forall>x\<in>A. \<forall>y\<in>A. (\<lambda>(v,e,v'). (v, e)) (f x) = (\<lambda>(v,e,v'). (v, e)) (f y) \<longrightarrow>
                             (\<lambda>(v,e,v'). (v, e)) x = (\<lambda>(v,e,v'). (v, e)) y)"

lemma LTS_image_filter_inj_on_id:
  "LTS_image_filter_inj_on id S"
  unfolding LTS_image_filter_inj_on_def by auto

lemma lts_image_filter_inj_on_implies_deterministic :
  "LTS_is_deterministic A \<Longrightarrow>
   LTS_image_filter_inj_on f A \<Longrightarrow> LTS_is_deterministic (f ` A)"
  unfolding LTS_image_filter_inj_on_def LTS_is_deterministic_def
  apply (simp split: prod.splits add: Ball_def image_iff Bex_def)
  apply auto
  apply (metis Pair_inject)
done

text \<open> In complete transition systems, there is a run. \<close>

primrec CLTS_fin_run where
   "CLTS_fin_run \<Q> \<Delta> q [] = [q]"
 | "CLTS_fin_run \<Q> \<Delta> q (a # w) =
    (q # (CLTS_fin_run \<Q> \<Delta> (SOME q'. (q, a, q') \<in> \<Delta> \<and> q' \<in> \<Q>) w))"

lemma hd_CLTS_fin_run [simp] :
 "hd (CLTS_fin_run \<Q> \<Delta> q w) = q"
by (cases w, simp_all)

lemma CLTS_fin_run_correct :
assumes complete_\<Delta>: "LTS_is_complete \<Q> \<Sigma> \<Delta>"
    and w_OK: "w \<in> lists \<Sigma>"
    and q_OK: "q \<in> \<Q>"
shows "LTS_is_fin_run \<Delta> w (CLTS_fin_run \<Q> \<Delta> q w) \<and>
       (CLTS_fin_run \<Q> \<Delta> q w) \<in> lists \<Q>"
using w_OK q_OK
proof (induct w arbitrary: q)
  case Nil thus ?case by simp
next
  case (Cons a w q1)
  note a_in_\<Sigma> = Cons(1)
  note w_in_\<Sigma> = Cons(2)
  note indhyp = Cons(3)
  note q1_in_\<Q> = Cons(4)

  define q2 where "q2 \<equiv> SOME q'. (q1, a, q') \<in> \<Delta> \<and> q' \<in> \<Q>"

  from complete_\<Delta> q1_in_\<Q> a_in_\<Sigma> have
     q2_in_\<Q>: "q2 \<in> \<Q>" and
     step: "(q1, a, q2) \<in> \<Delta>" unfolding LTS_is_complete_def q2_def
     using someI_ex[where P = "\<lambda>q'. (q1, a, q') \<in> \<Delta> \<and> q' \<in> \<Q>"]
     by auto

  from indhyp[OF q2_in_\<Q>] have
     run': "LTS_is_fin_run \<Delta> w (CLTS_fin_run \<Q> \<Delta> q2 w)" and
     run_in_Q: "CLTS_fin_run \<Q> \<Delta> q2 w \<in> lists \<Q>" by simp_all

  obtain r' where r'_intro: "(CLTS_fin_run \<Q> \<Delta> q2 w) = q2 # r'"
    by (cases w) auto

  from run' step run_in_Q
  show ?case
    by (simp add: q2_def[symmetric] r'_intro q1_in_\<Q>)
qed

lemma CLTS_is_fin_run_exists :
assumes complete_\<Delta>: "LTS_is_complete \<Q> \<Sigma> \<Delta>"
    and w_OK: "w \<in> lists \<Sigma>"
    and q_OK: "q \<in> \<Q>"
shows "\<exists>r. LTS_is_fin_run \<Delta> w (q # r)"
using CLTS_fin_run_correct[OF assms]
by (cases w) auto

lemma CLTS_is_reachable_exists :
assumes complete_\<Delta>: "LTS_is_complete \<Q> \<Sigma> \<Delta>"
    and w_OK: "w \<in> lists \<Sigma>"
    and q_OK: "q \<in> \<Q>"
shows "\<exists>q'. LTS_is_reachable \<Delta> q w q'"
proof -
  from CLTS_is_fin_run_exists[OF complete_\<Delta> w_OK q_OK]
  obtain r where run_r: "LTS_is_fin_run \<Delta> w (q # r)" by blast

  have "LTS_is_reachable \<Delta> q w (last (q # r))"
    unfolding LTS_is_reachable_alt_def
    apply (rule exI[where x = "q # r"])
    apply (simp add: run_r)
  done
  thus ?thesis by blast
qed

lemma word_with_props_exists :
assumes q0_OK: "P_q q0"
    and ind: "\<And>q i. P_q q \<Longrightarrow> \<exists>q'. P_q q' \<and> P_qaq q (w i) q'"
shows "\<exists>r. r 0 = q0 \<and> (\<forall>i. P_q (r i) \<and> P_qaq (r i) (w i) (r (Suc i)))"
proof -
  define PP where "PP \<equiv> \<lambda>i q q'. (P_q q' \<and> P_qaq q (w i) q')"
  define rr where "rr \<equiv> rec_nat q0 (\<lambda>i q. (SOME q'. PP i q q'))"

  have rr_0: "rr 0 = q0"
    unfolding rr_def by simp

  { fix i
    have "PP i (rr i) (rr (Suc i))"
    proof (induct i)
      case 0
      show ?case
        apply (simp add: rr_def q0_OK)
        apply (rule someI_ex)
        apply (simp add: PP_def)
        apply (intro ind q0_OK)
      done
    next
      case (Suc i)
      note indhyp = this

      have rr_Suc_Suc_eq: "rr (Suc (Suc i)) = (SOME q'. (PP (Suc i) (rr (Suc i)) q'))"
        unfolding rr_def by simp

      show ?case
        apply (simp add: rr_Suc_Suc_eq)
        apply (rule someI_ex)
        apply (simp add: PP_def)
        apply (intro ind)
        apply (insert indhyp)
        apply (simp add: PP_def)
      done
    qed
  } note PP_prop = this

  { fix i
    from PP_prop rr_0
    have "P_q (rr i)"
      by (cases i) (simp_all add: q0_OK PP_def)
  } note P_q_prop = this

  from PP_prop P_q_prop
  show ?thesis
    apply (rule_tac exI[where x = rr])
    apply (simp_all add: PP_def rr_0)
  done
qed

primrec CLTS_inf_run where
   "CLTS_inf_run \<Q> \<Delta> q w 0 = q"
 | "CLTS_inf_run \<Q> \<Delta> q w (Suc i) =
    (SOME q'. (CLTS_inf_run \<Q> \<Delta> q w i, w i, q') \<in> \<Delta> \<and> q' \<in> \<Q>)"

lemma CLTS_inf_run_correct :
assumes complete_\<Delta>: "LTS_is_complete \<Q> \<Sigma> \<Delta>"
    and w_OK: "\<And>i. w i \<in> \<Sigma>"
    and q_OK: "q \<in> \<Q>"
shows "LTS_is_inf_run \<Delta> w (CLTS_inf_run \<Q> \<Delta> q w)" (is ?T1)
      "\<And>i. (CLTS_inf_run \<Q> \<Delta> q w) i \<in> \<Q>" (is "\<And>i. ?T2 i")
proof -
  have step: "\<And>i. CLTS_inf_run \<Q> \<Delta> q w i \<in> \<Q> \<Longrightarrow>
      (CLTS_inf_run \<Q> \<Delta> q w (Suc i) \<in> \<Q>) \<and>
      (CLTS_inf_run \<Q> \<Delta> q w i, w i, CLTS_inf_run \<Q> \<Delta> q w (Suc i)) \<in> \<Delta>"
  proof -
    fix i
    assume q1_in: "CLTS_inf_run \<Q> \<Delta> q w i \<in> \<Q>"
    with complete_\<Delta> w_OK[of i]
    show "(CLTS_inf_run \<Q> \<Delta> q w (Suc i) \<in> \<Q>) \<and>
      (CLTS_inf_run \<Q> \<Delta> q w i, w i, CLTS_inf_run \<Q> \<Delta> q w (Suc i)) \<in> \<Delta>"
       unfolding LTS_is_complete_def
       using someI_ex[where P = "\<lambda>q'. (CLTS_inf_run \<Q> \<Delta> q w i, w i, q') \<in> \<Delta> \<and> q' \<in> \<Q>"]
       by auto
  qed

  { fix i
    have "(CLTS_inf_run \<Q> \<Delta> q w i \<in> \<Q>) \<and>
      (CLTS_inf_run \<Q> \<Delta> q w i, w i, CLTS_inf_run \<Q> \<Delta> q w (Suc i)) \<in> \<Delta>"
    proof (induct i)
      case 0 with step[of 0] q_OK show ?case by simp
    next
      case (Suc i)
      with step[of i] step[of "Suc i"] show ?case by auto
    qed
  }
  thus ?T1 "\<And>i. ?T2 i" by (simp_all add: LTS_is_inf_run_def)
qed

lemma CLTS_is_inf_run_exists :
assumes complete_\<Delta>: "LTS_is_complete \<Q> \<Sigma> \<Delta>"
    and w_OK: "\<And>i. w i \<in> \<Sigma>"
    and q_OK: "q \<in> \<Q>"
shows "\<exists>r. LTS_is_inf_run \<Delta> w r \<and> r 0 = q"
using CLTS_inf_run_correct[OF complete_\<Delta>, of w q, OF w_OK q_OK]
by (rule_tac exI [where x = "CLTS_inf_run \<Q> \<Delta> q w"]) simp

text \<open> In complete, determistic transition systems, a unique run exists. \<close>

lemma CDLTS_fin_run_correct :
assumes complete_det_\<Delta>: "LTS_is_complete_deterministic \<Q> \<Sigma> \<Delta>"
    and w_OK: "w \<in> lists \<Sigma>"
    and q_OK: "hd r \<in> \<Q>"
shows "LTS_is_fin_run \<Delta> w r \<longleftrightarrow>
       r = CLTS_fin_run \<Q> \<Delta> (hd r) w"
proof -
  from complete_det_\<Delta>
  have det_\<Delta>: "LTS_is_deterministic \<Delta>"
   and complete_\<Delta>: "LTS_is_complete \<Q> \<Sigma> \<Delta>"
     unfolding LTS_is_complete_deterministic_def by simp_all

  from CLTS_fin_run_correct[OF complete_\<Delta> w_OK q_OK]
       DLTS_is_fin_run_unique[OF det_\<Delta>, of w]
  show ?thesis by (metis hd_CLTS_fin_run)+
qed

lemma CDLTS_is_fin_run_exists_unique :
assumes complete_det_\<Delta>: "LTS_is_complete_deterministic \<Q> \<Sigma> \<Delta>"
    and w_OK: "w \<in> lists \<Sigma>"
    and q_OK: "q \<in> \<Q>"
shows "\<exists>!r. LTS_is_fin_run \<Delta> w (q # r)"
using CDLTS_fin_run_correct[OF complete_det_\<Delta> w_OK] q_OK
by (cases w) simp_all

lemma CDLTS_is_reachable_exists_unique :
assumes complete_det_\<Delta>: "LTS_is_complete_deterministic \<Q> \<Sigma> \<Delta>"
    and w_OK: "w \<in> lists \<Sigma>"
    and q_OK: "q \<in> \<Q>"
shows "\<exists>!q'. LTS_is_reachable \<Delta> q w q'"
proof -
  from CDLTS_is_fin_run_exists_unique[OF complete_det_\<Delta> w_OK q_OK]
  show ?thesis
    unfolding LTS_is_reachable_alt_def
    apply (auto)
    apply (metis list.sel(1))
    apply (metis LTS_is_fin_run_expand_r1 list.sel(1))
  done
qed

lemma CDLTS_inf_run_correct :
assumes complete_det_\<Delta>: "LTS_is_complete_deterministic \<Q> \<Sigma> \<Delta>"
    and w_OK: "\<And>i. w i \<in> \<Sigma>"
    and q_OK: "r 0 \<in> \<Q>"
shows "LTS_is_inf_run \<Delta> w r \<longleftrightarrow>
       r = CLTS_inf_run \<Q> \<Delta> (r 0) w"
proof -
  from complete_det_\<Delta>
  have det_\<Delta>: "LTS_is_deterministic \<Delta>"
   and complete_\<Delta>: "LTS_is_complete \<Q> \<Sigma> \<Delta>"
     unfolding LTS_is_complete_deterministic_def by simp_all

  from CLTS_inf_run_correct[OF complete_\<Delta>, of w, OF w_OK q_OK]
       DLTS_is_inf_run_unique[OF det_\<Delta>, of w] q_OK
  show ?thesis by (rule_tac iffI) simp_all
qed

lemma CDLTS_is_inf_run_exists_unique :
assumes complete_det_\<Delta>: "LTS_is_complete_deterministic \<Q> \<Sigma> \<Delta>"
    and w_OK: "\<And>i. w i \<in> \<Sigma>"
    and q_OK: "q \<in> \<Q>"
shows "\<exists>!r. LTS_is_inf_run \<Delta> w r \<and> r 0 = q"
by (metis CLTS_is_inf_run_exists DLTS_is_inf_run_unique
          LTS_is_complete_deterministic_def complete_det_\<Delta>
          q_OK w_OK)

subsubsection \<open> Basic Definitions for DLTSs \<close>

fun DLTS_fin_run_of :: "('q,'a) DLTS \<Rightarrow> 'q \<Rightarrow> 'a list \<Rightarrow> ('q list) option" where
  "DLTS_fin_run_of \<delta> q [] = Some [q]"
| "DLTS_fin_run_of \<delta> q (\<sigma> # w) =
   Option.bind (\<delta> (q, \<sigma>)) (\<lambda>q'. map_option (\<lambda>r. q  # r) (DLTS_fin_run_of \<delta> q' w))"

lemma DLTS_fin_run_of_hd :
assumes r_eq: "DLTS_fin_run_of \<delta> q w = Some r"
shows "\<exists>r'. r = q # r'"
proof (cases w)
  case Nil with r_eq show ?thesis by auto
next
  case (Cons a w')
  note w_eq = Cons(1)

  from r_eq
  show ?thesis
    by (cases "\<delta>(q, a)", auto simp add: w_eq)
qed

lemma LTS_is_fin_run___DLTS_fin_run_of :
shows "LTS_is_fin_run (DLTS_to_LTS \<delta>) w (q # r) =
       (DLTS_fin_run_of \<delta> q w = Some (q # r))"
proof (induct w arbitrary: q r)
  case Nil thus ?case by auto
next
  case (Cons a w q r)
  note ind_hyp = this

  show ?case
  proof (cases "\<delta> (q, a)")
    case None thus ?thesis by (simp add: LTS_is_fin_run_expand_r)
  next
    case (Some q'')
    with ind_hyp DLTS_fin_run_of_hd[of \<delta> q'' w r]
    show ?thesis
      apply (simp add: LTS_is_fin_run_expand_r)
      apply (cases r)
      apply auto
    done
  qed
qed

fun DLTS_reach :: "('q, 'a) DLTS \<Rightarrow> 'q \<Rightarrow> 'a list \<Rightarrow> 'q option" where
    "DLTS_reach \<delta> q [] = Some q"
  | "DLTS_reach \<delta> q (\<sigma> # w) =
     Option.bind (\<delta> (q, \<sigma>)) (\<lambda>q'. DLTS_reach \<delta> q' w)"

lemma DLTS_reach_Concat [simp] :
  "DLTS_reach \<delta> q (w @ w') = Option.bind (DLTS_reach \<delta> q w) (\<lambda>q'. DLTS_reach \<delta> q' w')"
by (induct w arbitrary: q, auto)

lemma DLTS_reach_alt_def :
  "DLTS_reach \<delta> q w = map_option (\<lambda>wl. last wl) (DLTS_fin_run_of \<delta> q w)"
proof (induct w arbitrary: q)
  case Nil thus ?case by simp
next
  case (Cons \<sigma> w q)
  note ind_hyp = this

  show ?case
  proof (cases "\<delta> (q, \<sigma>)")
    case None thus ?thesis by simp
  next
    case (Some q')
    thus ?thesis
      apply (simp add: ind_hyp option.map_comp o_def)
      apply (cases "DLTS_fin_run_of \<delta> q' w")
      apply (simp_all)
      apply (metis DLTS_fin_run_of_hd list.simps(3))
    done
  qed
qed

lemma LTS_is_reachable_determistic :
assumes det_\<Delta>: "LTS_is_deterministic \<Delta>"
shows "LTS_is_reachable \<Delta> q w q' \<longleftrightarrow>
       DLTS_reach (LTS_to_DLTS \<Delta>) q w = Some q'"
proof (induct w arbitrary: q)
  case Nil thus ?case by simp
next
  case (Cons \<sigma> w)
  note ind_hyp = this
  note in_\<Delta> = LTS_to_DLTS_is_some_det [OF det_\<Delta>, symmetric]

  show ?case
  proof (cases "LTS_to_DLTS \<Delta> (q, \<sigma>)")
    case None thus ?thesis by (simp add: in_\<Delta>)
  next
    case (Some q') thus ?thesis by (simp add: ind_hyp in_\<Delta>)
  qed
qed

lemma LTS_is_reachable_DLTS_to_LTS [simp] :
 "LTS_is_reachable (DLTS_to_LTS \<delta>) q w q' =
  (DLTS_reach \<delta> q w = Some q')"
by (metis LTS_is_reachable_determistic DLTS_to_LTS_inv
          DLTS_to_LTS___LTS_is_deterministic)

subsection \<open> Reachablity on Graphs \<close>

definition LTS_forget_labels_pred :: "('a \<Rightarrow> bool) \<Rightarrow> ('q, 'a) LTS \<Rightarrow> ('q \<times> 'q) set" where
  "LTS_forget_labels_pred P \<Delta> = {(q, q') . \<exists>\<sigma>. (q, \<sigma>, q') \<in> \<Delta> \<and> P \<sigma>}"

definition LTS_forget_labels :: "('q, 'a) LTS \<Rightarrow> ('q \<times> 'q) set" where
  "LTS_forget_labels \<Delta> = {(q, q') . \<exists>\<sigma>. (q, \<sigma>, q') \<in> \<Delta>}"

lemma LTS_forget_labels_alt_def :
  "LTS_forget_labels \<Delta> = LTS_forget_labels_pred (\<lambda>\<sigma>. True) \<Delta>"
unfolding LTS_forget_labels_def LTS_forget_labels_pred_def
by simp

lemma rtrancl_LTS_forget_labels_pred :
  "rtrancl (LTS_forget_labels_pred P \<Delta>) =
   {(q, q'). (\<exists>w. LTS_is_reachable \<Delta> q w q' \<and> w \<in> lists {\<sigma>. P \<sigma>})}"
  (is "?ls = ?rs")
proof (intro set_eqI)
  fix qq' :: "('a \<times> 'a)"
  obtain q q' where qq'_eq : "qq' = (q, q')" by (cases qq', auto)

  have imp1 : "(q, q') \<in> ?ls \<Longrightarrow> (q,q') \<in> ?rs"
  proof (induct rule: rtrancl_induct)
    case base thus ?case
      apply simp
      apply (rule exI [where x = "[]"])
      apply simp
    done
  next
    case (step q' q'')
    then obtain w \<sigma> where
      qq'_ind : "LTS_is_reachable \<Delta> q w q'" and
      w_in: "w \<in> lists {\<sigma>. P \<sigma>}" and
      q'q''_ind: "(q', \<sigma>, q'') \<in> \<Delta>" and
      \<sigma>_in: "P \<sigma>" unfolding LTS_forget_labels_pred_def by auto
    hence "LTS_is_reachable \<Delta> q (w @ [\<sigma>]) q'' \<and> (w @ [\<sigma>]) \<in> lists {\<sigma>. P \<sigma>}" by auto
    hence "\<exists>w. LTS_is_reachable \<Delta> q w q'' \<and> w \<in> lists {\<sigma>. P \<sigma>}" by blast
    thus ?case by simp
  qed

  have imp2 : "\<And>w. \<lbrakk>LTS_is_reachable \<Delta> q w q'; w \<in> lists {\<sigma>. P \<sigma>}\<rbrakk> \<Longrightarrow> (q,q') \<in> ?ls"
  proof -
    fix w show "\<lbrakk>LTS_is_reachable \<Delta> q w q'; w \<in> lists {\<sigma>. P \<sigma>}\<rbrakk> \<Longrightarrow> (q,q') \<in> ?ls"
    proof (induct w arbitrary: q)
      case Nil thus ?case by simp
    next
      case (Cons \<sigma> w)
      then obtain q'' where
         in_D: "(q, \<sigma>, q'') \<in> \<Delta>" and
         \<sigma>_P: "P \<sigma>" and
         in_trcl: "(q'', q') \<in> rtrancl (LTS_forget_labels_pred P \<Delta>)"
        by auto

      from in_D \<sigma>_P have in_D': "(q, q'') \<in> (LTS_forget_labels_pred P \<Delta>)"
        unfolding LTS_forget_labels_pred_def by auto

      note converse_rtrancl_into_rtrancl [OF in_D' in_trcl]
      thus ?case by auto
    qed
  qed

  from imp1 imp2 qq'_eq show "(qq' \<in> ?ls) = (qq' \<in> ?rs)" by auto
qed

lemma rtrancl_LTS_forget_labels :
  "rtrancl (LTS_forget_labels \<Delta>) =
   {(q, q'). (\<exists>w. LTS_is_reachable \<Delta> q w q')}"
by (simp add: LTS_forget_labels_alt_def
              rtrancl_LTS_forget_labels_pred)

lemma trancl_LTS_forget_labels_pred:
  fixes \<Delta>
  shows "(LTS_forget_labels_pred P \<Delta>)\<^sup>+
  = {(q, q'). (\<exists>w. LTS_is_reachable \<Delta> q w q' \<and> w\<noteq>[] \<and> w \<in> lists {\<sigma>. P \<sigma>})}"
  apply (simp add: trancl_unfold_left rtrancl_LTS_forget_labels_pred)
  apply (auto simp: LTS_forget_labels_pred_def)
  apply (rule_tac x="\<sigma>#w" in exI)
  apply auto []
  apply (case_tac w)
  apply auto
  done
lemma trancl_LTS_forget_labels:
  fixes \<Delta>
  shows "(LTS_forget_labels \<Delta>)\<^sup>+
  = {(q, q'). \<exists>w. LTS_is_reachable \<Delta> q w q' \<and> w\<noteq>[]}"
  using trancl_LTS_forget_labels_pred[of "\<lambda>_. True" \<Delta>]
  by (simp add: LTS_forget_labels_alt_def)

definition LTS_rename_forget_labels :: "('q \<Rightarrow> 'q2) \<Rightarrow> ('q, 'a) LTS \<Rightarrow>
   ('q2 \<times> 'q2) set" where
"LTS_rename_forget_labels f \<Delta> = {(f q, f q') | q \<sigma> q'. (q, \<sigma>, q') \<in> \<Delta>}"

lemma LTS_rename_forget_labels_alt_def :
  "LTS_rename_forget_labels f \<Delta> =
   {(f q, f q') | q q'. (q, q') \<in> LTS_forget_labels \<Delta>}"
unfolding LTS_forget_labels_def LTS_rename_forget_labels_def
by auto

subsection \<open> Restricting and extending the transition relation \<close>

lemma LTS_is_fin_run_mono :
  "\<lbrakk>\<Delta> \<subseteq> \<Delta>'; LTS_is_fin_run \<Delta> q r\<rbrakk> \<Longrightarrow> LTS_is_fin_run \<Delta>' q r"
unfolding LTS_is_fin_run_def by auto

lemma LTS_is_inf_run_mono :
  "\<lbrakk>\<Delta> \<subseteq> \<Delta>'; LTS_is_inf_run \<Delta> q r\<rbrakk> \<Longrightarrow> LTS_is_inf_run \<Delta>' q r"
unfolding LTS_is_inf_run_def by auto

lemma LTS_is_reachable_mono :
  "\<lbrakk>\<Delta> \<subseteq> \<Delta>'; LTS_is_reachable \<Delta> q w q'\<rbrakk> \<Longrightarrow> LTS_is_reachable \<Delta>' q w q'"
by (induct w arbitrary: q, auto)

subsection \<open> Products \<close>

definition LTS_product :: "('p,'a) LTS \<Rightarrow> ('q,'a) LTS \<Rightarrow> ('p*'q,'a) LTS" where
  "LTS_product \<Delta>1 \<Delta>2 = {((p,q), \<sigma>, (p',q')) | p p' \<sigma> q q'. (p, \<sigma>, p') \<in> \<Delta>1 \<and> (q, \<sigma>, q') \<in> \<Delta>2}"

lemma LTS_product_elem :
  "((p,q), \<sigma>, (p',q')) \<in> LTS_product \<Delta>1 \<Delta>2 = ((p,\<sigma>,p') \<in> \<Delta>1 \<and> (q,\<sigma>,q') \<in> \<Delta>2)"
by (simp add: LTS_product_def)

lemma LTS_product_alt_def [simp] :
  "x \<in> LTS_product \<Delta>1 \<Delta>2 =
   ((fst (fst x),fst (snd x), fst (snd (snd x))) \<in> \<Delta>1 \<and>
    (snd (fst x),fst (snd x), snd (snd (snd x))) \<in> \<Delta>2)"
by (cases x, case_tac a, simp add: LTS_product_elem)

lemma LTS_product_finite:
  assumes "finite \<Delta>1" and "finite \<Delta>2"
  shows "finite (LTS_product \<Delta>1 \<Delta>2)"
proof -
  let ?prod = "{((p,a,p'),q,b,q'). (p,a,p') \<in> \<Delta>1 \<and> (q,b,q') \<in> \<Delta>2 \<and> a = b}"
  let ?f = "\<lambda>((p,a,p'),q,a,q'). ((p,q),a,(p',q'))"

  have "?prod \<subseteq> \<Delta>1 \<times> \<Delta>2" by auto
  with assms have "finite ?prod" by (blast intro: finite_subset)
  moreover have "LTS_product \<Delta>1 \<Delta>2 = ?f ` ?prod" by (auto simp: LTS_product_def image_Collect)
  ultimately show ?thesis by simp
qed

lemma LTS_is_fin_run_product_iff: "LTS_is_fin_run (LTS_product \<Delta>1 \<Delta>2) w r \<longleftrightarrow>
  LTS_is_fin_run \<Delta>1 w (map fst r) \<and> LTS_is_fin_run \<Delta>2 w (map snd r)"
unfolding LTS_is_fin_run_def by auto

lemma LTS_is_inf_run_product_iff: "LTS_is_inf_run (LTS_product \<Delta>1 \<Delta>2) w r \<longleftrightarrow>
  LTS_is_inf_run \<Delta>1 w (fst \<circ> r) \<and> LTS_is_inf_run \<Delta>2 w (snd \<circ> r)"
unfolding LTS_is_inf_run_def by auto

lemma LTS_is_reachable_product :
   "LTS_is_reachable (LTS_product \<Delta>1 \<Delta>2) pq w pq' \<longleftrightarrow>
    (LTS_is_reachable \<Delta>1 (fst pq) w (fst pq') \<and>
     LTS_is_reachable \<Delta>2 (snd pq) w (snd pq'))"
by (induct w arbitrary: pq, auto)

lemma LTS_product_LTS_is_deterministic :
  "\<lbrakk>LTS_is_deterministic \<Delta>1; LTS_is_deterministic \<Delta>2 \<rbrakk> \<Longrightarrow>
   LTS_is_deterministic (LTS_product \<Delta>1 \<Delta>2)"
unfolding LTS_is_deterministic_def LTS_product_def by fast

lemma LTS_product_LTS_is_complete :
  "\<lbrakk>LTS_is_complete \<Q>1 \<Sigma>1 \<Delta>1; LTS_is_complete \<Q>2 \<Sigma>2 \<Delta>2 \<rbrakk> \<Longrightarrow>
   LTS_is_complete (\<Q>1 \<times> \<Q>2) (\<Sigma>1 \<inter> \<Sigma>2) (LTS_product \<Delta>1 \<Delta>2)"
unfolding LTS_is_complete_def LTS_product_def
  by auto

lemma LTS_product_LTS_is_complete_deterministic :
  "\<lbrakk>LTS_is_complete_deterministic \<Q>1 \<Sigma>1 \<Delta>1; LTS_is_complete_deterministic \<Q>2 \<Sigma>2 \<Delta>2 \<rbrakk> \<Longrightarrow>
   LTS_is_complete_deterministic (\<Q>1 \<times> \<Q>2) (\<Sigma>1 \<inter> \<Sigma>2) (LTS_product \<Delta>1 \<Delta>2)"
unfolding LTS_is_complete_deterministic_def
by (simp add: LTS_product_LTS_is_complete LTS_product_LTS_is_deterministic)

subsection \<open> Combination \<close>

definition LTS_comb :: "('p,'a) LTS \<Rightarrow> ('q,'a) LTS \<Rightarrow> ('p + 'q,'a) LTS" where
  "LTS_comb \<Delta>1 \<Delta>2 = {(Inl q1, a, Inl q2) |q1 a q2. (q1, a, q2) \<in> \<Delta>1} \<union>
                     {(Inr q1, a, Inr q2) |q1 a q2. (q1, a, q2) \<in> \<Delta>2}"

lemma LTS_comb_alt_def :
  "(Inl q1, a, Inl q1') \<in> LTS_comb \<Delta>1 \<Delta>2 \<longleftrightarrow> (q1, a, q1') \<in> \<Delta>1"
  "(Inr q2, a, Inr q2') \<in> LTS_comb \<Delta>1 \<Delta>2 \<longleftrightarrow> (q2, a, q2') \<in> \<Delta>2"
  "(Inl q1, a, Inr q2') \<in> LTS_comb \<Delta>1 \<Delta>2 \<longleftrightarrow> False"
  "(Inr q2, a, Inl q1') \<in> LTS_comb \<Delta>1 \<Delta>2 \<longleftrightarrow> False"
unfolding LTS_comb_def
by simp_all

lemma LTS_comb_finite:
  "\<lbrakk> finite \<Delta>1; finite \<Delta>2 \<rbrakk> \<Longrightarrow> finite (LTS_comb \<Delta>1 \<Delta>2)"
by (auto simp: LTS_comb_def)

lemma LTS_comb_alt2_def :
  "(q, a, q') \<in> LTS_comb \<Delta>1 \<Delta>2 \<longleftrightarrow>
   (\<exists>q1 q1'. q = Inl q1 \<and> q' = Inl q1' \<and> (q1, a, q1') \<in> \<Delta>1) \<or>
   (\<exists>q2 q2'. q = Inr q2 \<and> q' = Inr q2' \<and> (q2, a, q2') \<in> \<Delta>2)"
  apply (cases q)
  apply (cases q') apply (simp_all add: LTS_comb_alt_def)
  apply (cases q') apply (simp_all add: LTS_comb_alt_def)
done

lemma LTS_is_fin_run_LTS_comb :
  "LTS_is_fin_run (LTS_comb \<Delta>1 \<Delta>2) w r \<longleftrightarrow>
   (\<exists>r1. map Inl r1 = r \<and> LTS_is_fin_run \<Delta>1 w r1) \<or>
   (\<exists>r2. map Inr r2 = r \<and> LTS_is_fin_run \<Delta>2 w r2)"
proof (induct w arbitrary: r)
  case (Nil r)
  show ?case
  proof (cases "\<exists>q. r = [q]")
    case False thus ?thesis by (auto simp add: length_Suc_conv)
  next
    case True
    then obtain q where r_eq: "r = [q]" by auto
    thus ?thesis
      apply (cases q)
      apply (simp_all add: length_Suc_conv ex_simps[symmetric] del: ex_simps)
    done
  qed
next
  case (Cons a w r)
  note indhyp = Cons(1)

  show ?case
  proof (cases "length r < 2")
    case True thus ?thesis by (cases r, auto)
  next
    case False
    then obtain q1 q2 r' where r_eq: "r = q1 # q2 # r'"
      by (cases r, simp, rename_tac q1 r'', case_tac r'', auto)

    show ?thesis
      apply (simp add: r_eq indhyp LTS_comb_alt2_def map_eq_Cons_conv)
      apply auto
    done
  qed
qed

lemma LTS_is_reachable_comb :
  "LTS_is_reachable (LTS_comb \<Delta>1 \<Delta>2) q w q' \<longleftrightarrow>
   (\<exists>q1 q1'. q = Inl q1 \<and> q' = Inl q1' \<and> LTS_is_reachable \<Delta>1 q1 w q1') \<or>
   (\<exists>q2 q2'. q = Inr q2 \<and> q' = Inr q2' \<and> LTS_is_reachable \<Delta>2 q2 w q2')"
unfolding LTS_is_reachable_alt_def LTS_is_fin_run_LTS_comb
apply (auto simp add: LTS_is_fin_run_expand_r)
apply (metis LTS_is_fin_run_simps(1) hd_map last_map)+
done

lemma LTS_comb_LTS_is_deterministic :
  "\<lbrakk>LTS_is_deterministic \<Delta>1; LTS_is_deterministic \<Delta>2 \<rbrakk> \<Longrightarrow>
   LTS_is_deterministic (LTS_comb \<Delta>1 \<Delta>2)"
unfolding LTS_is_deterministic_def LTS_comb_def
by auto

lemma LTS_comb_LTS_is_complete :
  "\<lbrakk>LTS_is_complete \<Q>1 \<Sigma>1 \<Delta>1; LTS_is_complete \<Q>2 \<Sigma>2 \<Delta>2 \<rbrakk> \<Longrightarrow>
   LTS_is_complete (\<Q>1 <+> \<Q>2) (\<Sigma>1 \<inter> \<Sigma>2) (LTS_comb \<Delta>1 \<Delta>2)"
unfolding LTS_is_complete_def Ball_def LTS_comb_def  Bex_def
apply (auto)
apply (metis InlI)
apply (metis InrI)
done

lemma LTS_comb_LTS_is_complete_deterministic :
  "\<lbrakk>LTS_is_complete_deterministic \<Q>1 \<Sigma>1 \<Delta>1; LTS_is_complete_deterministic \<Q>2 \<Sigma>2 \<Delta>2 \<rbrakk> \<Longrightarrow>
   LTS_is_complete_deterministic (\<Q>1 <+> \<Q>2) (\<Sigma>1 \<inter> \<Sigma>2) (LTS_comb \<Delta>1 \<Delta>2)"
unfolding LTS_is_complete_deterministic_def
by (simp add: LTS_comb_LTS_is_complete  LTS_comb_LTS_is_deterministic)

end


(* Cancelación de funciones inyectivas *)

(*<*)
theory CancelacionInyectiva
imports Main "HOL-Library.LaTeXsugar" "HOL-Library.OptionalSugar"
begin
(*>*)

section \<open>Cancelación de funciones inyectivas\<close>
subsection \<open>Demostración en lenguaje natural \<close>

text \<open>El siguiente teorema que se va a probar es una caracterización de
  las funciones inyectivas. Primero se definirá el significado de
  inyectividad de una función y la propiedad de ser cancelativa por la
  izquierda.

\begin{definicion}
  Una función $f : A \longrightarrow B$ es inyectiva si
  $$\forall x,y \in \ A : f(x) = f(y) \Longrightarrow x = y.$$
\end{definicion}

Antes de definir la propiedad de ser cancelativa por la izquierda se va
 a probar la siguiente propiedad.

\begin{lema}
Sea $f$ una función $f : A \longrightarrow B$. Las siguientes condiciones son equivalentes:
\begin{enumerate}
\item $\forall C: (\forall g,h: C \longrightarrow A) :
    f \circ g = f \circ h \Longrightarrow g = h.$
\item $\forall g,h: \{0,1\} \longrightarrow A : f \circ g = f \circ h
\Longrightarrow g = h.$
\end{enumerate}
\end{lema}

\begin{demostracion}

$1 \Longrightarrow 2$
Trivial, ya que tomando en particular el conjunto $C = \{0,1\}$ se tiene
probado.

$2 \Longrightarrow 1$
La prueba se va a realizar por reducción al  absurdo, es decir,
supongamos que $\exists C : \exists g,h: C \longrightarrow A : f \circ g
= f \circ h$ y $g \neq h.$ Como $g \neq h$ esto implica que $\exists c
 \in C$ tal que $g(c) \neq h(c).$
Consideremos ahora $r: \{0,1\} \longrightarrow A$ tal que
  $$r(x)= \left\{\begin{array}{lcc}
                   c &   si  & x = 0 \\
                   c &  si & x = 1
                 \end{array}
          \right.$$
Definamos entonces $g' = g \circ r$ y $h' = h \circ r.$ Luego se tiene
 que

 $$\begin{array}{l}
(f \circ g')(x)  \\
= (f \circ g \circ r)(x) \\
= ((f \circ g) \circ r))(x) \\
= ((f \circ h) \circ r)(x) @{text " (Hipótesis inducción) "}  \\
= (f \circ h \circ r)(x) \\
= (f \circ h')(x)
      \end{array}$$

Entonces $f \circ g' = f \circ h'$. Luego, usando la hipótesis $g' = h'.$

Por otra parte
$$\begin{array}{l}
g'(0) \\
= (g \circ r)(0) \\
= g(r(0))  \\
= g(c)
\end{array}
\qquad \qquad
\begin{array}{l}
h'(0) \\
= (h \circ r)(0) \\
= h(r(0)) \\
= h(c)
\end{array}$$

Luego $g'(0) \neq h'(0)$ por lo que hemos llegado a un absurdo.
\end{demostracion}

\<close>

text \<open>Puesto que tenemos esta equivalencia, la definición de la
 propiedad de ser cancelativa por la izquierda será:
 \<close>

text \<open>
\begin{definicion}[Cancelativa izquierda]
Una función $f: A \longrightarrow B$ es cancelativa por la izquierda si
 $$\forall g,h: \{0,1\} \longrightarrow A : f \circ g = f \circ h
\Longrightarrow g = h.$$
\end{definicion}

\begin{nota}
Es adecuado usar esta definición, ya que a la hora de especificar la
 definición en Isabelle no se puede cuantificar tipos y esta definición
 no lo requiere. Sin embargo, la otra sí.
\end{nota}

  El teorema es el siguiente:
  \begin{teorema}
    Una función $f$ es inyectiva si y solo si es cancelativa por la
 izquierda.
  \end{teorema}

  Vamos a hacer dos lemas previos, ya que se  descompone la
  doble implicación en dos implicaciones y se va a  demostrar cada una
  de ellos por separado.

  \begin{lema}[Condición necesaria]
    Si $f$ es una función inyectiva, entonces f es cancelativa por la
 izquierda.
  \end {lema}

  \begin{demostracion}
 Hay que probar que $\forall g,h: \{0,1\} \longrightarrow A : f \circ g
= f \circ h$ esto implica que $g = h$. Luego, sean $g,h$ tales que $f
  \circ g = f \circ h,$ veamos que $\forall x. g(x) = h(x).$

  Se tiene que:
$$f \circ g = f \circ h \Longrightarrow (f \circ g)(x) = (f
 \circ h)(x) \stackrel{def.}{\Longrightarrow} f(g(x)) = f(h(x))
 \stackrel{f \,  inyect.}{\Longrightarrow} g(x)=h(x)$$
  \end{demostracion}

  \begin {lema}[Condición suficiente]
   Si f es cancelativa por la izquierda, entonces f es inyectiva.
  \end {lema}

  \begin {demostracion}
    Sea $f: A \longrightarrow B.$
Si el dominio de la función $f$ fuese vacío, f  es inyectiva.
    Supongamos que el dominio de la función $f$ es distinto del vacío y
    que f verifica la propiedad de ser cancelativa por la izquierda.
    Hay que demostrar que $\forall a,b$ tales que $f(a) = f(b)$, esto
    implica que $a = b$.

    Sean $a,b$ tales que $f(a) = f(b)$.

    Consideremos las funciones constantes $g: \{0,1\} \longrightarrow A$
 tal que $g(x) = a,  \ \forall x$  y $h: \{0,1\} \longrightarrow A$ tal
que $h(x) = b, \  \forall x.$
    Veamos que $f \circ g = f \circ h.$ En efecto, $\forall x$

    $$\begin{array}{l}
(f \circ g)(x) \\
 = f(g(x)) \\
= f(a)
\end{array}
\qquad \qquad
\begin{array}{l}
(f \circ h)(x) \\
= f(h(x)) \\
= f(b)
\end{array}$$

    Por hipótesis se tiene que $f(a) = f(b)$ luego $f \circ g = f \circ
 h.$ Por hipótesis se tiene que $f$ es cancelativa por la izquierda, por
  lo tanto, esto implica que $g = h$.
Es decir, que $\forall x, g(x) = h(x)$. Y, por tanto, $a = b$.
\end{demostracion}
\<close>

subsection \<open>Especificación en Isabelle/Hol\<close>

text \<open>Previamente a la especificación del teorema, vamos a definir en
Isabelle la propiedad de que una función sea cancelativa por la izquierda.\<close>

definition cancelativaIzquierda :: "('a \<Rightarrow> 'b) \<Rightarrow> bool" where
  "cancelativaIzquierda  f =
   (\<forall>(g :: bool \<Rightarrow> 'a) h. (f \<circ> g = f \<circ> h \<longrightarrow> g = h))"

text \<open>
\begin{nota}
En esta definición en Isabelle
 hemos definido las funciones $g$ y $h$ en los booleanos$(\{0,1\})$,
aunque solo  haría falta en un conjunto con ,al menos, 2 elementos, ya
que realiza el mismo papel. Pero como el tipo booleano ya está
predefinido en Isabelle utilizamos este.

\end{nota}

\<close>
text \<open>La especificación del teorema es la siguiente: \<close>
theorem caracterizacion_funcion_inyecctiva:
  "inj f \<longleftrightarrow> cancelativaIzquierda f"
  oops

  text \<open>Al igual que en la demostración a mano, se va a demostrar a través
de dos lemas asociados a cada implicación. Son los siguientes:\<close>

lemma "cancelativaIzquierda f \<Longrightarrow> inj f"
  oops

lemma "inj f \<Longrightarrow> cancelativaIzquierda f"
  oops

text \<open>En la especificación anterior, @{term "inj f"} es una
  abreviatura de @{term "inj_on f "} definida en la teoría
  \href{http://bit.ly/2XuPQx5}{Fun.thy}. Además, contiene la definición
  de @{term "inj_on"}
  \begin{itemize}
    \item[] @{thm[mode=Rule] inj_on_def[no_vars]}
      \hfill (@{text inj_on_def})
  \end{itemize}

  Presentaremos distintas demostraciones de los lemas.\<close>

subsection \<open>Demostración estructurada de los lemas\<close>

text \<open>Las demostraciones declarativas son las siguientes:\<close>

lemma condicion_necesaria_detallada:
  assumes "inj f"
  shows "cancelativaIzquierda f"
proof -
  have "\<forall>(g :: bool \<Rightarrow> 'a) h. (f \<circ> g = f \<circ> h \<longrightarrow> g = h)"
  proof (intro allI impI)
    fix g h :: "bool \<Rightarrow> 'a"
    assume "f \<circ> g = f \<circ> h"
    show "g = h"
    proof (rule ext)
      fix x
      have "(f \<circ> g)(x) = (f \<circ> h)(x)"
        by (simp only: \<open>f \<circ> g = f \<circ> h\<close>)
      then have "f(g(x)) = f(h(x))"
        by (simp only: comp_apply)
      then show "g(x) = h(x)"
        using \<open>inj f\<close>
        by (simp only: injD)
    qed
  qed
  then show "cancelativaIzquierda f"
    by (simp only: cancelativaIzquierda_def)
qed

lemma condicion_suficiente_detallada:
  assumes "cancelativaIzquierda f"
  shows "inj f"
proof (rule injI)
  fix a b
  assume "f a = f b"
  let ?g = "\<lambda>x :: bool. a"
  let ?h = "\<lambda>x :: bool. b"
  have "\<forall>(g :: bool \<Rightarrow> 'a) h. (f \<circ> g = f \<circ> h \<longrightarrow> g = h)"
    using assms
    by (simp only: cancelativaIzquierda_def)
  then have "\<forall>h. (f \<circ> ?g = f \<circ> h \<longrightarrow> ?g = h)"
    by (rule allE)
  then have "(f \<circ> ?g = f \<circ> ?h \<longrightarrow> ?g = ?h)"
    by (rule allE)
  moreover
  have "f \<circ> ?g = f \<circ> ?h"
  proof (rule ext)
    fix x :: bool
    have "(f \<circ> (\<lambda>x :: bool. a)) x = f(a) "
      by (simp only: comp_apply)
    also have "... = f(b)"
      by (simp only: \<open>f a = f b\<close>)
    also have "... =  (f \<circ> (\<lambda>x :: bool. b)) x"
      by (simp only: comp_apply)
    finally show "(f \<circ> (\<lambda>x. a)) x =  (f \<circ> (\<lambda>x. b)) x"
      by this
  qed
  ultimately have "?g = ?h"
    by (rule mp)
  then show " a = b"
    by (rule fun_cong)
qed

text \<open>
\begin{nota}
En la demostración de condición suficiente detallada, es necesario
 especificar los tipos tanto de las funciones como de los elementos. Ya
 que en caso de no especificarlo toma el tipo más general
 posible y no se puede demostrar.
\end {nota}

  Otras demostraciones declarativas no detalladas usando demostradores
  automáticos metis, auto y blast son:\<close>

lemma condicion_necesaria_1:
  assumes "inj f"
  shows "cancelativaIzquierda f"
proof -
  have "\<forall>(g :: bool \<Rightarrow> 'a) h. (f \<circ> g = f \<circ> h \<longrightarrow> g = h)"
  proof (intro allI impI)
  fix g h :: "bool \<Rightarrow> 'a"
  assume "f \<circ> g = f \<circ> h"
  then show "g = h"
    using `inj f`
    by (simp add: inj_on_def fun_eq_iff)
  qed
  then show "cancelativaIzquierda f"
    by (simp only: cancelativaIzquierda_def)
qed

subsection \<open>Demostración del teorema en Isabelle/Hol\<close>

text \<open>En consecuencia, la demostración de nuestro teorema: \<close>

theorem caracterizacion_inyectividad:
  "inj f \<longleftrightarrow> cancelativaIzquierda f"
proof (rule iffI)
  show "inj f \<Longrightarrow> cancelativaIzquierda f"
    by (rule condicion_necesaria_detallada)
next
  show "cancelativaIzquierda f \<Longrightarrow> inj f"
    by (simp only: condicion_suficiente_detallada)
qed

text \<open>Su demostración automática es\<close>

theorem "inj f \<longleftrightarrow> cancelativaIzquierda f"
  using condicion_necesaria_detallada
        condicion_suficiente_detallada
  by auto

(*<*)
end
(*>*)


           (*-------------------------------------------*
            |                                           |
            |      LW-CSP-Prover on Isabelle2021        |
            |                                           |
            *-------------------------------------------*)

theory CSP_wfsim
imports  CSP_wsim
begin

(*************************************************************

         1. Weak Simulation
         2. Proposition 3.1 in the ETNET2019 paper
         3.
         4.

 *************************************************************)

(* ----------------------------------------- *
 |              Weak failers simulation      |
 * ----------------------------------------- *)
definition
  weak_failures_sim :: "(('p,'a) proc * ('q,'a) proc) set =>bool"
                 (*    ("(1_ /is-a-weak-simulation)" [1000] 1000)  *)
where
  "weak_failures_sim S == ALL P Q. (P,Q): S -->
                          (ALL e P'. (P ---e---> P' --> (EX Q'. Q ===^e===> Q' & (P',Q') : S))
                          &((P ---Tau--->+)|(~(P---e--->+) --> ~(Q---e--->+))))"

(* ----------------------------------------- *
 |                    lemmas                 |
 * ----------------------------------------- *)

lemma weak_failures_sim_weak_sim:
  "ALL S. weak_failures_sim S --> weak_sim S"
  apply (simp add: weak_failures_sim_def)
  apply (simp add: weak_sim_def)
  done

lemma weak_failures_sim_traces_ref_traces:
  "weak_failures_sim S ==> (P, Q) : S ==> traces P <= traces Q"
  apply (insert weak_failures_sim_weak_sim)
  apply (drule_tac x="S" in spec)
  apply (simp add: weak_sim_traces_ref_traces)
  done

lemma weak_failures_sim_stable:
" weak_failures_sim S ==> (P, Q) : S ==> stable P ==> stable Q"
  apply(simp add: stable_def)
  apply(simp add: weak_failures_sim_def)
  apply(drule_tac x="P" in spec)
  apply(drule_tac x="Q" in spec)
  apply(simp)
  done

lemma inclusive_refs_no_trn:
"weak_failures_sim S ==> (P, Q) : S ==> \<not> P ---(Ev t)--->+ ==> stable P ==> \<not> Q ---(Ev t)--->+"
  apply(simp add: weak_failures_sim_def)
  apply(drule_tac x="P" in spec)
  apply(drule_tac x="Q" in spec)
  apply(simp)
  apply(drule_tac x="Ev t" in spec)
  apply(simp)
  apply(erule conjE)
  apply(erule disjE)
   (*stable case*)
   apply(simp add: stable_def)

  apply(simp)
  done

lemma inclusive_refs_tau_trn:
"weak_failures_sim S \<Longrightarrow> (P, Q) \<in> S \<Longrightarrow> \<not> P ---(Ev t)--->+ \<Longrightarrow> stable P \<Longrightarrow> stable Q"
  apply(simp add: weak_failures_sim_def)
  apply(drule_tac x="P" in spec)
  apply(drule_tac x="Q" in spec)
  apply(simp)
  apply(drule_tac x="Tau" in spec)
  apply(simp add: stable_def)
  done

lemma inclusive_refs:
"ALL S P Q. weak_failures_sim S --> (P,Q):S --> refs(P) <= refs(Q)"
(*"weak_failures_sim S ==> (P,Q):S ==> refs(P) <= refs(Q)"*)
  apply(intro allI)
  apply(intro impI)
(*  apply(simp add: weak_failures_sim_def)*)
  apply(simp add: refs_def)
  apply(simp add: subset_iff)
  apply(rule allI)
  apply(rule impI)
  apply(erule conjE)
  apply(rule conjI)
   apply(simp add: inclusive_refs_no_trn)
  apply(simp add: inclusive_refs_tau_trn)
  done

lemma weak_sim_traces_ref_failures:
  "weak_failures_sim S ==> (P, Q) : S ==> failures P <= failures Q"
  apply (simp add: subset_iff)
  apply (simp add: failures_def)
  apply (intro allI)
  apply (rule impI)
  apply (elim exE conjE)
   (**)
   apply (simp)
  apply (insert weak_sim_seq_trn)
  apply (drule_tac x="S" in spec)
  apply (drule_tac x="s" in spec)
  apply (drule_tac x="P" in spec)
  apply (drule_tac x="Q" in spec)
  apply (drule_tac x="P'" in spec)
  apply (simp)
  apply (simp add:weak_failures_sim_weak_sim)
  apply (erule exE)
  apply (erule exE)
  apply (erule conjE)
  apply (erule conjE)
  apply (rule_tac x="t" in exI)
  apply (simp)
  apply (rule_tac x="Q'" in exI)
  apply (simp)
  apply (intro conjI)
   apply (simp add: weak_failures_sim_stable)
  apply (insert inclusive_refs)
  apply (drule_tac x="S" in spec)
  apply (drule_tac x="P'" in spec)
  apply (drule_tac x="Q'" in spec)
  apply (simp)
  done

(* ----------------------------------------- *
 |               Proposition 5.1             |
 * ----------------------------------------- *)

theorem wfsim_refF:
  "weak_failures_sim S ==> (P,Q) : S ==> Q [F= P"

  apply (simp add: refF_def)
  apply (simp add: weak_failures_sim_traces_ref_traces)
  apply (simp add: weak_sim_traces_ref_failures)
  done

end


theory Kyber_Values
imports
  Crypto_Scheme
  (* Check_Prime *)
  (* NTT_Scheme *)
begin
section \<open>Specification for Kyber\<close>
typedef fin7681 = "{0..<7681::int}"
morphisms fin7681_rep fin7681_abs
by (rule_tac x = 0 in exI, simp)
print_theorems
setup_lifting type_definition_fin7681

lemma CARD_fin7681 [simp]:
"CARD (fin7681) = 7681"
unfolding type_definition.card [OF type_definition_fin7681]
by simp

lemma fin7681_nontriv [simp]:
"1 < CARD(fin7681)"
unfolding CARD_fin7681 by auto

lemma prime_7681: "prime (7681::nat)" by eval

instantiation fin7681 :: comm_ring_1
begin

lift_definition zero_fin7681 :: "fin7681" is "0" by simp

lift_definition one_fin7681 :: "fin7681" is "1" by simp

lift_definition plus_fin7681 :: "fin7681 \<Rightarrow> fin7681 \<Rightarrow> fin7681"
  is "(\<lambda>x y. (x+y) mod 7681)"
by auto

lift_definition uminus_fin7681 :: "fin7681 \<Rightarrow> fin7681"
  is "(\<lambda>x. (uminus x) mod 7681)"
by auto

lift_definition minus_fin7681 :: "fin7681 \<Rightarrow> fin7681 \<Rightarrow> fin7681"
  is "(\<lambda>x y. (x-y) mod 7681)"
by auto

lift_definition times_fin7681 :: "fin7681 \<Rightarrow> fin7681 \<Rightarrow> fin7681"
  is "(\<lambda>x y. (x*y) mod 7681)"
by auto

instance
proof
  fix a b c ::fin7681
  show "a * b * c = a * (b * c)"
    by (transfer, simp add: algebra_simps mod_mult_left_eq mod_mult_right_eq)
  show "a + b + c = a + (b + c)"
    by (transfer, simp add: algebra_simps mod_add_left_eq mod_add_right_eq)
  show "(a + b) * c = a * c + b * c"
    by (transfer, simp add: algebra_simps mod_add_right_eq  mod_mult_right_eq)
qed (transfer; simp add: algebra_simps mod_add_right_eq; fail)+

end

instantiation fin7681 :: finite
begin
instance
proof
  show "finite (UNIV :: fin7681 set)" unfolding type_definition.univ [OF type_definition_fin7681]
  by auto
qed
end

instantiation fin7681 :: equal
begin
lift_definition equal_fin7681 :: "fin7681 \<Rightarrow> fin7681 \<Rightarrow> bool" is "(=)" .
instance by (intro_classes, transfer, auto)
end

instantiation fin7681 :: nontriv
begin
instance
proof
  show "1 < CARD(fin7681)" unfolding CARD_fin7681 by auto
qed
end

instantiation fin7681 :: prime_card
begin
instance
proof
  show "prime CARD(fin7681)" unfolding CARD_fin7681 using prime_7681
  by blast
qed
end

instantiation fin7681 :: qr_spec
begin

definition qr_poly'_fin7681:: "fin7681 itself \<Rightarrow> int poly" where
"qr_poly'_fin7681 \<equiv> (\<lambda>_. Polynomial.monom (1::int) 256 + 1)"

instance proof
have "lead_coeff (qr_poly' TYPE(fin7681)) = 1" unfolding qr_poly'_fin7681_def
by (simp add: degree_add_eq_left degree_monom_eq)
then show "\<not> int CARD(fin7681) dvd
       lead_coeff (qr_poly' TYPE(fin7681))"
  unfolding CARD_fin7681 by auto
next
have "degree (qr_poly' TYPE(fin7681)) = 256" unfolding qr_poly'_fin7681_def
by (simp add: degree_add_eq_left degree_monom_eq)
then show "0 < degree (qr_poly' TYPE(fin7681))"  by auto
qed
end

lift_definition to_int_fin7681 :: "fin7681 \<Rightarrow> int" is "\<lambda>x. x" .

lift_definition of_int_fin7681 :: "int \<Rightarrow> fin7681" is "\<lambda>x. (x mod 7681)"
by simp

interpretation to_int_fin7681_hom: inj_zero_hom to_int_fin7681
  by (unfold_locales; transfer, auto)

interpretation of_int_fin7681_hom: zero_hom of_int_fin7681
  by (unfold_locales, transfer, auto)

lemma to_int_fin7681_of_int_fin7681 [simp]:
"to_int_fin7681 (of_int_fin7681 x) = x mod 7681"
using of_int_fin7681.rep_eq to_int_fin7681.rep_eq by presburger

lemma of_int_fin7681_to_int_fin7681 [simp]:
"of_int_fin7681 (to_int_fin7681 x) = x"
using fin7681_rep to_int_fin7681.rep_eq to_int_fin7681_hom.injectivity
to_int_fin7681_of_int_fin7681 by force

lemma of_int_mod_ring_eq_iff [simp]:
  "(of_int_fin7681 a = of_int_fin7681 b) \<longleftrightarrow>
   ((a mod 7681) = (b mod 7681))"
by (metis of_int_fin7681.abs_eq of_int_fin7681.rep_eq)

interpretation kyber7681: kyber_spec "TYPE(fin7681)" "TYPE(3)" 256 7681 3 8
proof (unfold_locales, goal_cases)
  case 5
  then show ?case using prime_7681 prime_int_numeral_eq by blast
next
  case 6
  then show ?case using CARD_fin7681 by auto
next
  case 8
  then show ?case unfolding qr_poly'_fin7681_def by auto
qed auto

end


theory Sergot

imports Main HOL.Finite_Set

begin

typedecl i  \<comment> \<open>Type for worlds\<close>
typedecl \<mu>  \<comment> \<open>Type for agents\<close>

abbreviation "Ag \<equiv> (UNIV::\<mu> set)" \<comment> \<open>every element of type \<mu> is an agent\<close>
axiomatization where finiteActors: "finite Ag"  \<comment> \<open>The set of agents is finite\<close>

type_synonym \<sigma> = "(i\<Rightarrow>bool)" \<comment> \<open>type for formulas\<close>

abbreviation "reflexive R \<equiv> (\<forall>x. R x x)"
abbreviation "symmetric R \<equiv> (\<forall>x y. R x y \<longrightarrow> R y x)"
abbreviation "transitive R \<equiv> (\<forall>x y z. ((R x y) \<and> (R y z) \<longrightarrow> (R x z)))"
abbreviation "eqrelation R \<equiv> reflexive R \<and> symmetric R \<and> transitive R"

consts tilde :: "i\<Rightarrow>i\<Rightarrow>bool" (infixr "\<^bold>~" 70) \<comment> \<open>accessibility relation (global)\<close>
consts tildeAG :: "i\<Rightarrow>\<mu>\<Rightarrow>i\<Rightarrow>bool" ("_ \<^bold>~_ _" ) \<comment> \<open>accessibility relation agent-relative\<close>

axiomatization where xsub: "\<forall>(x::\<mu>). ((\<tau>a::i)\<^bold>~x(\<tau>b::i) \<longrightarrow> ((\<tau>a::i)\<^bold>~(\<tau>b::i)))"  \<comment> \<open>acc. rel. are subsets\<close>
axiomatization where tildeeqU: "\<forall>x y. x\<^bold>~y" \<comment> \<open>S5U acc. rel.\<close>
lemma tildeeq: "eqrelation tilde" using tildeeqU by simp \<comment> \<open>other acc. rel. are eq. rel.\<close>
axiomatization where tildexeq: "\<forall>(x::\<mu>). eqrelation (\<lambda>a b. ((a::i)\<^bold>~x(b::i)))"

abbreviation tildeG :: "i\<Rightarrow> (\<mu> set)\<Rightarrow>i\<Rightarrow>bool" ("_ ~_ _")
 where "(\<tau>a ~G \<tau>b) \<equiv> (\<tau>a\<^bold>~\<tau>b) \<and> (\<forall>x. ((x \<in> G) \<longrightarrow> ((\<tau>a::i)\<^bold>~x(\<tau>b::i))))"  \<comment> \<open>acc. rel. for groups is intersection of acc rel. for agents\<close>
(*not using a set here for computational efficiency*)

abbreviation mtrue :: "\<sigma>" ("\<^bold>\<top>")
 where "\<^bold>\<top> \<equiv> \<lambda>w. True"
abbreviation mfalse :: "\<sigma>" ("\<^bold>\<bottom>")
 where "\<^bold>\<bottom> \<equiv> \<lambda>w. False"
abbreviation mnot :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<not>_"[52]53)
 where "\<^bold>\<not>\<phi> \<equiv> \<lambda>w. \<not>\<phi>(w)"
abbreviation mand :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<and>"51)
 where "\<phi>\<^bold>\<and>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<and>\<psi>(w)"
abbreviation mor :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<or>"50)
 where "\<phi>\<^bold>\<or>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<or>\<psi>(w)"
abbreviation mimp :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<rightarrow>"49)
 where "\<phi>\<^bold>\<rightarrow>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<longrightarrow>\<psi>(w)"
abbreviation mequ :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<leftrightarrow>"48)
 where "\<phi>\<^bold>\<leftrightarrow>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<longleftrightarrow>\<psi>(w)"
abbreviation mexists :: "('a\<Rightarrow>\<sigma>)\<Rightarrow>\<sigma>" ("\<^bold>\<exists>")
 where "\<^bold>\<exists>\<Phi> \<equiv> \<lambda>w.\<exists>x. \<Phi>(x)(w)"
abbreviation mexistsB :: "('a\<Rightarrow>\<sigma>)\<Rightarrow>\<sigma>" (binder"\<^bold>\<exists>"[8]9)
 where "\<^bold>\<exists>x. \<phi>(x) \<equiv> \<^bold>\<exists>\<phi>"
abbreviation meq :: "\<mu>\<Rightarrow>\<mu>\<Rightarrow>\<sigma>" (infixr"\<^bold>="52) (*-- "Equality" *)
 where "x\<^bold>=y \<equiv> \<lambda>w. x = y"
abbreviation mbox :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<box>_"[52]53)
 where "\<^bold>\<box>\<phi> \<equiv> \<lambda>w.\<forall>v. w \<^bold>~ v \<longrightarrow> \<phi>(v)"
abbreviation mstit :: "\<mu> set \<Rightarrow> \<sigma>\<Rightarrow>\<sigma>" ("\<^bold>[_\<^bold>]_"[52]53)
 where "\<^bold>[G\<^bold>]\<phi> \<equiv> \<lambda>(w::i).\<forall>(v::i). (w ~ G v) \<longrightarrow> \<phi>(v)"
abbreviation mstitwoset :: "(\<mu> \<Rightarrow> bool) \<Rightarrow> \<sigma>\<Rightarrow>\<sigma>" ("\<^bold>[_\<^bold>]2 _"[52]53)
 where "\<^bold>[G\<^bold>]2 \<phi> \<equiv> \<lambda>(w::i).\<forall>x. \<forall>(v::i). (G x) \<longrightarrow> (w \<^bold>~x v) \<longrightarrow> \<phi>(v)"
abbreviation mstitDIA :: "\<mu> set \<Rightarrow> \<sigma>\<Rightarrow>\<sigma>" ("\<^bold><_\<^bold>> _"[52]53)
 where "\<^bold><G\<^bold>> \<phi> \<equiv> \<lambda>(w::i).\<exists>(v::i). (w ~ G v) \<and> \<phi>(v)"
abbreviation mstitDIAwoset :: "(\<mu> \<Rightarrow> bool) \<Rightarrow> \<sigma>\<Rightarrow>\<sigma>" ("\<^bold><_\<^bold>>2 _"[52]53)
 where "\<^bold><G\<^bold>>2 \<phi> \<equiv> \<lambda>(w::i).\<forall>x. \<exists>(v::i). G x \<longrightarrow> (w \<^bold>~x v) \<and> \<phi>(v)"
abbreviation mdia :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<diamond>_"[52]53)
 where "\<^bold>\<diamond>\<phi> \<equiv> \<lambda>w.\<exists>v. w \<^bold>~ v \<longrightarrow> \<phi>(v)"

abbreviation valid :: "\<sigma>\<Rightarrow>bool" ("\<lfloor>_\<rfloor>"[8]109)
 where "\<lfloor>p\<rfloor> \<equiv> \<forall>w. p w"
abbreviation follows_w :: "i \<Rightarrow> \<sigma> \<Rightarrow> bool" (infix"\<^bold>\<Turnstile>"55)
 where "(w \<^bold>\<Turnstile> p) \<equiv> p w "

abbreviation Deltamin :: "\<mu> set \<Rightarrow> \<sigma>\<Rightarrow> i \<Rightarrow> bool" ("\<^bold>\<Delta>\<^sup>m\<^sup>i\<^sup>n\<^sub> _ _ "[52]53)
 where "((\<^bold>\<Delta>\<^sup>m\<^sup>i\<^sup>n\<^sub> (G::\<mu> set) (\<phi>::\<sigma>)) (\<tau>::i)) \<equiv> ((\<^bold>[G\<^bold>]\<phi>) \<tau>) \<and> \<not>(\<exists> H. (H \<subset> G) \<and> ((\<^bold>[H\<^bold>]\<phi>) \<tau>))"

abbreviation boollift :: "(\<mu> \<Rightarrow> bool) \<Rightarrow> (\<mu> \<Rightarrow> bool) \<Rightarrow> bool" ("_ \<^bold>\<subset> _"[52]53)
 where "G \<^bold>\<subset> H \<equiv> ((\<forall>x. G x \<longrightarrow> H x) \<and> (\<exists>y. H y \<and> \<not> G y))"
abbreviation Deltaminwoset :: "(\<mu> \<Rightarrow> bool) \<Rightarrow> \<sigma>\<Rightarrow> i \<Rightarrow> bool" ("\<^bold>\<Delta>\<^sup>m\<^sup>i\<^sup>n2\<^sub> _ _ "[52]53)
 where "((\<^bold>\<Delta>\<^sup>m\<^sup>i\<^sup>n2\<^sub> G (\<phi>::\<sigma>)) (\<tau>::i)) \<equiv> ((\<^bold>[G\<^bold>]2 \<phi>) \<tau>) \<and> \<not>(\<exists> H. (H \<^bold>\<subset> G) \<and> ((\<^bold>[H\<^bold>]2 \<phi>) \<tau>))"

abbreviation deltamax :: "\<mu> set \<Rightarrow> \<sigma> \<Rightarrow> i \<Rightarrow> bool" ("\<^bold>\<Delta>\<^sup>m\<^sup>a\<^sup>x\<^sub> _ _")
 where "(\<^bold>\<Delta>\<^sup>m\<^sup>a\<^sup>x\<^sub> G \<phi>) \<tau> \<equiv> G = {x. (\<exists>H. (((\<^bold>\<Delta>\<^sup>m\<^sup>i\<^sup>n\<^sub> H \<phi>) \<tau>) \<and> x \<in> H))}"

abbreviation deltamaxwoset :: "(\<mu> \<Rightarrow> bool) \<Rightarrow> \<sigma> \<Rightarrow> i \<Rightarrow> bool" ("\<^bold>\<Delta>\<^sup>m\<^sup>a\<^sup>x2\<^sub> _ _")
 where "(\<^bold>\<Delta>\<^sup>m\<^sup>a\<^sup>x2\<^sub> G \<phi>) \<tau> \<equiv> \<forall>x. G x \<longleftrightarrow> (\<exists>H. (((\<^bold>\<Delta>\<^sup>m\<^sup>i\<^sup>n2\<^sub> H \<phi>) \<tau>) \<and> H x))"

abbreviation BigIntersection :: "'a set set \<Rightarrow> 'a set" ("\<^bold>\<inter> _")
 where "\<^bold>\<inter> A \<equiv> {x. (\<exists>M \<in> A. (x \<in> M)) \<and> (\<forall> M \<in> A. x \<in> M)}" (*stupid hack*)

abbreviation Ness :: "\<mu> set \<Rightarrow> \<sigma> \<Rightarrow> i \<Rightarrow> bool" ("Ness\<^sub>_ _")
 where "(Ness\<^sub> G \<phi>) (\<tau>::i) \<equiv> (\<exists>(K::\<mu> set). (\<tau> \<^bold>\<Turnstile> (\<^bold>[K\<^bold>]\<phi>))) \<and> (\<forall>H. (\<tau> \<^bold>\<Turnstile> (\<^bold>[H\<^bold>]\<phi>)) \<longrightarrow> \<not> (\<tau> \<^bold>\<Turnstile> (\<^bold>[H - G\<^bold>]\<phi>)))"

abbreviation Nessmin :: "\<mu> set \<Rightarrow> \<sigma> \<Rightarrow> i \<Rightarrow> bool" ("Ness\<^sup>m\<^sup>i\<^sup>n\<^sub>_ _")
 where "(Ness\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) (\<tau>::i) \<equiv> (Ness\<^sub> G \<phi> \<tau>) \<and> (\<not>(\<exists> H. (H \<subset> G) \<and> (Ness\<^sub> H \<phi> \<tau>)))"

abbreviation Core :: "\<sigma> \<Rightarrow> i \<Rightarrow> \<mu> set" ("Core_ _")
 where "Core \<phi> \<tau> \<equiv> \<^bold>\<inter> {H. ((\<^bold>\<Delta>\<^sup>m\<^sup>i\<^sup>n\<^sub> H \<phi>)(\<tau>::i))}"

abbreviation nessmax :: "\<mu> set \<Rightarrow> \<sigma> \<Rightarrow> i \<Rightarrow> bool" ("Ness\<^sup>m\<^sup>a\<^sup>x\<^sub> _ _")
 where "(Ness\<^sup>m\<^sup>a\<^sup>x\<^sub> G \<phi>) \<tau> \<equiv> G = {x. (\<exists>H. ((Ness\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi> \<tau>) \<and> x \<in> H))}"

abbreviation sole :: "\<mu> set \<Rightarrow> \<sigma> \<Rightarrow> i \<Rightarrow> bool" ("\<^bold>\<Delta>\<^sup>s\<^sup>o\<^sup>l\<^sup>e\<^sub> _ _")
 where "(\<^bold>\<Delta>\<^sup>s\<^sup>o\<^sup>l\<^sup>e\<^sub> G \<phi>) \<equiv>(\<^bold>\<Delta>\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) \<^bold>\<and> (\<^bold>\<Delta>\<^sup>m\<^sup>a\<^sup>x\<^sub> G \<phi>)"

abbreviation Could :: "\<mu> set \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" ("Could\<^sub> _ _")
 where "Could\<^sub> G \<phi> \<equiv> \<^bold><Ag-G\<^bold>> \<^bold>[Ag\<^bold>]\<phi>"

abbreviation liftsetminus :: "(\<mu> \<Rightarrow> bool) \<Rightarrow> (\<mu> \<Rightarrow> bool) \<Rightarrow> (\<mu> \<Rightarrow> bool)" ("_ \<^bold>- _")
 where "G \<^bold>- H \<equiv> \<lambda>v. G v \<and> \<not> H v"
abbreviation liftAg :: "(\<mu> \<Rightarrow> bool)" ("\<^bold>Ag")
 where "\<^bold>Ag \<equiv> \<lambda>v. True"

abbreviation Couldwoset :: "(\<mu> \<Rightarrow> bool) \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" ("Couldwo\<^sub> _ _")
 where "Couldwo\<^sub> G \<phi> \<equiv> \<^bold><\<^bold>Ag \<^bold>- G\<^bold>>2 \<^bold>[\<^bold>Ag\<^bold>]2 \<phi>"

abbreviation Couldmin :: "\<mu> set \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" ("Could\<^sup>m\<^sup>i\<^sup>n\<^sub> _ _")
 where "(Could\<^sup>m\<^sup>i\<^sup>n\<^sub> G \<phi>) (\<tau>::i) \<equiv> ((Could\<^sub> G \<phi>) \<tau>) \<and> \<not>(\<exists> H. (H \<subset> G) \<and> ((Could\<^sub> H \<phi>) \<tau>))"

abbreviation Couldminwoset :: "(\<mu> \<Rightarrow>bool) \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" ("Could\<^sup>m\<^sup>i\<^sup>nwo\<^sub> _ _")
 where "(Could\<^sup>m\<^sup>i\<^sup>nwo\<^sub> G \<phi>) (\<tau>::i) \<equiv> ((Couldwo\<^sub> G \<phi>) \<tau>) \<and> \<not>(\<exists> H. (H \<^bold>\<subset> G) \<and> ((Couldwo\<^sub> H \<phi>) \<tau>))"

abbreviation semanticOR :: "\<sigma> set \<Rightarrow> \<sigma>" ("\<^bold>\<Or> _")
 where "(\<^bold>\<Or> G) (\<tau>::i) \<equiv> \<exists>\<phi> \<in> G. (\<phi> \<tau>)"

abbreviation alt :: "\<mu> \<Rightarrow> i \<Rightarrow> i set" ("alt\<^sub> _(_)")
 where "alt\<^sub> x(\<tau>) \<equiv> {\<tau>b. \<tau> \<^bold>~x \<tau>b}"

abbreviation actiontypes :: "\<mu> \<Rightarrow> i set set" ("\<^bold>A\<^sub> _")
 where "\<^bold>A\<^sub> x \<equiv> {v. \<exists>\<tau>. v = alt\<^sub> x (\<tau>)}"

end