(*<*)theory CTL imports Base begin(*>*)

subsection\<open>Computation Tree Logic --- CTL\<close>

text\<open>\label{sec:CTL}
\index{CTL|(}%
The semantics of PDL only needs reflexive transitive closure.
Let us be adventurous and introduce a more expressive temporal operator.
We extend the datatype
\<open>formula\<close> by a new constructor
\<close>
(*<*)
datatype formula = Atom "atom"
                  | Neg formula
                  | And formula formula
                  | AX formula
                  | EF formula(*>*)
                  | AF formula

text\<open>\noindent
which stands for ``\emph{A}lways in the \emph{F}uture'':
on all infinite paths, at some point the formula holds.
Formalizing the notion of an infinite path is easy
in HOL: it is simply a function from \<^typ>\<open>nat\<close> to \<^typ>\<open>state\<close>.
\<close>

definition Paths :: "state \<Rightarrow> (nat \<Rightarrow> state)set" where
"Paths s \<equiv> {p. s = p 0 \<and> (\<forall>i. (p i, p(i+1)) \<in> M)}"

text\<open>\noindent
This definition allows a succinct statement of the semantics of \<^const>\<open>AF\<close>:
\footnote{Do not be misled: neither datatypes nor recursive functions can be
extended by new constructors or equations. This is just a trick of the
presentation (see \S\ref{sec:doc-prep-suppress}). In reality one has to define
a new datatype and a new function.}
\<close>
(*<*)
primrec valid :: "state \<Rightarrow> formula \<Rightarrow> bool" ("(_ \<Turnstile> _)" [80,80] 80) where
"s \<Turnstile> Atom a  =  (a \<in> L s)" |
"s \<Turnstile> Neg f   = (~(s \<Turnstile> f))" |
"s \<Turnstile> And f g = (s \<Turnstile> f \<and> s \<Turnstile> g)" |
"s \<Turnstile> AX f    = (\<forall>t. (s,t) \<in> M \<longrightarrow> t \<Turnstile> f)" |
"s \<Turnstile> EF f    = (\<exists>t. (s,t) \<in> M\<^sup>* \<and> t \<Turnstile> f)" |
(*>*)
"s \<Turnstile> AF f    = (\<forall>p \<in> Paths s. \<exists>i. p i \<Turnstile> f)"

text\<open>\noindent
Model checking \<^const>\<open>AF\<close> involves a function which
is just complicated enough to warrant a separate definition:
\<close>

definition af :: "state set \<Rightarrow> state set \<Rightarrow> state set" where
"af A T \<equiv> A \<union> {s. \<forall>t. (s, t) \<in> M \<longrightarrow> t \<in> T}"

text\<open>\noindent
Now we define \<^term>\<open>mc(AF f)\<close> as the least set \<^term>\<open>T\<close> that includes
\<^term>\<open>mc f\<close> and all states all of whose direct successors are in \<^term>\<open>T\<close>:
\<close>
(*<*)
primrec mc :: "formula \<Rightarrow> state set" where
"mc(Atom a)  = {s. a \<in> L s}" |
"mc(Neg f)   = -mc f" |
"mc(And f g) = mc f \<inter> mc g" |
"mc(AX f)    = {s. \<forall>t. (s,t) \<in> M  \<longrightarrow> t \<in> mc f}" |
"mc(EF f)    = lfp(\<lambda>T. mc f \<union> M\<inverse> `` T)"|(*>*)
"mc(AF f)    = lfp(af(mc f))"

text\<open>\noindent
Because \<^const>\<open>af\<close> is monotone in its second argument (and also its first, but
that is irrelevant), \<^term>\<open>af A\<close> has a least fixed point:
\<close>

lemma mono_af: "mono(af A)"
apply(simp add: mono_def af_def)
apply blast
done
(*<*)
lemma mono_ef: "mono(\<lambda>T. A \<union> M\<inverse> `` T)"
apply(rule monoI)
by(blast)

lemma EF_lemma:
  "lfp(\<lambda>T. A \<union> M\<inverse> `` T) = {s. \<exists>t. (s,t) \<in> M\<^sup>* \<and> t \<in> A}"
apply(rule equalityI)
 apply(rule subsetI)
 apply(simp)
 apply(erule lfp_induct_set)
  apply(rule mono_ef)
 apply(simp)
 apply(blast intro: rtrancl_trans)
apply(rule subsetI)
apply(simp, clarify)
apply(erule converse_rtrancl_induct)
 apply(subst lfp_unfold[OF mono_ef])
 apply(blast)
apply(subst lfp_unfold[OF mono_ef])
by(blast)
(*>*)
text\<open>
All we need to prove now is  \<^prop>\<open>mc(AF f) = {s. s \<Turnstile> AF f}\<close>, which states
that \<^term>\<open>mc\<close> and \<open>\<Turnstile>\<close> agree for \<^const>\<open>AF\<close>\@.
This time we prove the two inclusions separately, starting
with the easy one:
\<close>

theorem AF_lemma1: "lfp(af A) \<subseteq> {s. \<forall>p \<in> Paths s. \<exists>i. p i \<in> A}"

txt\<open>\noindent
In contrast to the analogous proof for \<^const>\<open>EF\<close>, and just
for a change, we do not use fixed point induction.  Park-induction,
named after David Park, is weaker but sufficient for this proof:
\begin{center}
@{thm lfp_lowerbound[of _ "S",no_vars]} \hfill (@{thm[source]lfp_lowerbound})
\end{center}
The instance of the premise \<^prop>\<open>f S \<subseteq> S\<close> is proved pointwise,
a decision that \isa{auto} takes for us:
\<close>
apply(rule lfp_lowerbound)
apply(auto simp add: af_def Paths_def)

txt\<open>
@{subgoals[display,indent=0,margin=70,goals_limit=1]}
In this remaining case, we set \<^term>\<open>t\<close> to \<^term>\<open>p(1::nat)\<close>.
The rest is automatic, which is surprising because it involves
finding the instantiation \<^term>\<open>\<lambda>i::nat. p(i+1)\<close>
for \<open>\<forall>p\<close>.
\<close>

apply(erule_tac x = "p 1" in allE)
apply(auto)
done

text\<open>
The opposite inclusion is proved by contradiction: if some state
\<^term>\<open>s\<close> is not in \<^term>\<open>lfp(af A)\<close>, then we can construct an
infinite \<^term>\<open>A\<close>-avoiding path starting from~\<^term>\<open>s\<close>. The reason is
that by unfolding \<^const>\<open>lfp\<close> we find that if \<^term>\<open>s\<close> is not in
\<^term>\<open>lfp(af A)\<close>, then \<^term>\<open>s\<close> is not in \<^term>\<open>A\<close> and there is a
direct successor of \<^term>\<open>s\<close> that is again not in \mbox{\<^term>\<open>lfp(af
A)\<close>}. Iterating this argument yields the promised infinite
\<^term>\<open>A\<close>-avoiding path. Let us formalize this sketch.

The one-step argument in the sketch above
is proved by a variant of contraposition:
\<close>

lemma not_in_lfp_afD:
 "s \<notin> lfp(af A) \<Longrightarrow> s \<notin> A \<and> (\<exists> t. (s,t) \<in> M \<and> t \<notin> lfp(af A))"
apply(erule contrapos_np)
apply(subst lfp_unfold[OF mono_af])
apply(simp add: af_def)
done

text\<open>\noindent
We assume the negation of the conclusion and prove \<^term>\<open>s \<in> lfp(af A)\<close>.
Unfolding \<^const>\<open>lfp\<close> once and
simplifying with the definition of \<^const>\<open>af\<close> finishes the proof.

Now we iterate this process. The following construction of the desired
path is parameterized by a predicate \<^term>\<open>Q\<close> that should hold along the path:
\<close>

primrec path :: "state \<Rightarrow> (state \<Rightarrow> bool) \<Rightarrow> (nat \<Rightarrow> state)" where
"path s Q 0 = s" |
"path s Q (Suc n) = (SOME t. (path s Q n,t) \<in> M \<and> Q t)"

text\<open>\noindent
Element \<^term>\<open>n+1::nat\<close> on this path is some arbitrary successor
\<^term>\<open>t\<close> of element \<^term>\<open>n\<close> such that \<^term>\<open>Q t\<close> holds.  Remember that \<open>SOME t. R t\<close>
is some arbitrary but fixed \<^term>\<open>t\<close> such that \<^prop>\<open>R t\<close> holds (see \S\ref{sec:SOME}). Of
course, such a \<^term>\<open>t\<close> need not exist, but that is of no
concern to us since we will only use \<^const>\<open>path\<close> when a
suitable \<^term>\<open>t\<close> does exist.

Let us show that if each state \<^term>\<open>s\<close> that satisfies \<^term>\<open>Q\<close>
has a successor that again satisfies \<^term>\<open>Q\<close>, then there exists an infinite \<^term>\<open>Q\<close>-path:
\<close>

lemma infinity_lemma:
  "\<lbrakk> Q s; \<forall>s. Q s \<longrightarrow> (\<exists> t. (s,t) \<in> M \<and> Q t) \<rbrakk> \<Longrightarrow>
   \<exists>p\<in>Paths s. \<forall>i. Q(p i)"

txt\<open>\noindent
First we rephrase the conclusion slightly because we need to prove simultaneously
both the path property and the fact that \<^term>\<open>Q\<close> holds:
\<close>

apply(subgoal_tac
  "\<exists>p. s = p 0 \<and> (\<forall>i::nat. (p i, p(i+1)) \<in> M \<and> Q(p i))")

txt\<open>\noindent
From this proposition the original goal follows easily:
\<close>

 apply(simp add: Paths_def, blast)

txt\<open>\noindent
The new subgoal is proved by providing the witness \<^term>\<open>path s Q\<close> for \<^term>\<open>p\<close>:
\<close>

apply(rule_tac x = "path s Q" in exI)
apply(clarsimp)

txt\<open>\noindent
After simplification and clarification, the subgoal has the following form:
@{subgoals[display,indent=0,margin=70,goals_limit=1]}
It invites a proof by induction on \<^term>\<open>i\<close>:
\<close>

apply(induct_tac i)
 apply(simp)

txt\<open>\noindent
After simplification, the base case boils down to
@{subgoals[display,indent=0,margin=70,goals_limit=1]}
The conclusion looks exceedingly trivial: after all, \<^term>\<open>t\<close> is chosen such that \<^prop>\<open>(s,t)\<in>M\<close>
holds. However, we first have to show that such a \<^term>\<open>t\<close> actually exists! This reasoning
is embodied in the theorem @{thm[source]someI2_ex}:
@{thm[display,eta_contract=false]someI2_ex}
When we apply this theorem as an introduction rule, \<open>?P x\<close> becomes
\<^prop>\<open>(s, x) \<in> M \<and> Q x\<close> and \<open>?Q x\<close> becomes \<^prop>\<open>(s,x) \<in> M\<close> and we have to prove
two subgoals: \<^prop>\<open>\<exists>a. (s, a) \<in> M \<and> Q a\<close>, which follows from the assumptions, and
\<^prop>\<open>(s, x) \<in> M \<and> Q x \<Longrightarrow> (s,x) \<in> M\<close>, which is trivial. Thus it is not surprising that
\<open>fast\<close> can prove the base case quickly:
\<close>

 apply(fast intro: someI2_ex)

txt\<open>\noindent
What is worth noting here is that we have used \methdx{fast} rather than
\<open>blast\<close>.  The reason is that \<open>blast\<close> would fail because it cannot
cope with @{thm[source]someI2_ex}: unifying its conclusion with the current
subgoal is non-trivial because of the nested schematic variables. For
efficiency reasons \<open>blast\<close> does not even attempt such unifications.
Although \<open>fast\<close> can in principle cope with complicated unification
problems, in practice the number of unifiers arising is often prohibitive and
the offending rule may need to be applied explicitly rather than
automatically. This is what happens in the step case.

The induction step is similar, but more involved, because now we face nested
occurrences of \<open>SOME\<close>. As a result, \<open>fast\<close> is no longer able to
solve the subgoal and we apply @{thm[source]someI2_ex} by hand.  We merely
show the proof commands but do not describe the details:
\<close>

apply(simp)
apply(rule someI2_ex)
 apply(blast)
apply(rule someI2_ex)
 apply(blast)
apply(blast)
done

text\<open>
Function \<^const>\<open>path\<close> has fulfilled its purpose now and can be forgotten.
It was merely defined to provide the witness in the proof of the
@{thm[source]infinity_lemma}. Aficionados of minimal proofs might like to know
that we could have given the witness without having to define a new function:
the term
@{term[display]"rec_nat s (\<lambda>n t. SOME u. (t,u)\<in>M \<and> Q u)"}
is extensionally equal to \<^term>\<open>path s Q\<close>,
where \<^term>\<open>rec_nat\<close> is the predefined primitive recursor on \<^typ>\<open>nat\<close>.
\<close>
(*<*)
lemma
"\<lbrakk> Q s; \<forall> s. Q s \<longrightarrow> (\<exists> t. (s,t)\<in>M \<and> Q t) \<rbrakk> \<Longrightarrow>
 \<exists> p\<in>Paths s. \<forall> i. Q(p i)"
apply(subgoal_tac
 "\<exists> p. s = p 0 \<and> (\<forall> i. (p i,p(Suc i))\<in>M \<and> Q(p i))")
 apply(simp add: Paths_def)
 apply(blast)
apply(rule_tac x = "rec_nat s (\<lambda>n t. SOME u. (t,u)\<in>M \<and> Q u)" in exI)
apply(simp)
apply(intro strip)
apply(induct_tac i)
 apply(simp)
 apply(fast intro: someI2_ex)
apply(simp)
apply(rule someI2_ex)
 apply(blast)
apply(rule someI2_ex)
 apply(blast)
by(blast)
(*>*)

text\<open>
At last we can prove the opposite direction of @{thm[source]AF_lemma1}:
\<close>

theorem AF_lemma2: "{s. \<forall>p \<in> Paths s. \<exists>i. p i \<in> A} \<subseteq> lfp(af A)"

txt\<open>\noindent
The proof is again pointwise and then by contraposition:
\<close>

apply(rule subsetI)
apply(erule contrapos_pp)
apply simp

txt\<open>
@{subgoals[display,indent=0,goals_limit=1]}
Applying the @{thm[source]infinity_lemma} as a destruction rule leaves two subgoals, the second
premise of @{thm[source]infinity_lemma} and the original subgoal:
\<close>

apply(drule infinity_lemma)

txt\<open>
@{subgoals[display,indent=0,margin=65]}
Both are solved automatically:
\<close>

 apply(auto dest: not_in_lfp_afD)
done

text\<open>
If you find these proofs too complicated, we recommend that you read
\S\ref{sec:CTL-revisited}, where we show how inductive definitions lead to
simpler arguments.

The main theorem is proved as for PDL, except that we also derive the
necessary equality \<open>lfp(af A) = ...\<close> by combining
@{thm[source]AF_lemma1} and @{thm[source]AF_lemma2} on the spot:
\<close>

theorem "mc f = {s. s \<Turnstile> f}"
apply(induct_tac f)
apply(auto simp add: EF_lemma equalityI[OF AF_lemma1 AF_lemma2])
done

text\<open>

The language defined above is not quite CTL\@. The latter also includes an
until-operator \<^term>\<open>EU f g\<close> with semantics ``there \emph{E}xists a path
where \<^term>\<open>f\<close> is true \emph{U}ntil \<^term>\<open>g\<close> becomes true''.  We need
an auxiliary function:
\<close>

primrec
until:: "state set \<Rightarrow> state set \<Rightarrow> state \<Rightarrow> state list \<Rightarrow> bool" where
"until A B s []    = (s \<in> B)" |
"until A B s (t#p) = (s \<in> A \<and> (s,t) \<in> M \<and> until A B t p)"
(*<*)definition
 eusem :: "state set \<Rightarrow> state set \<Rightarrow> state set" where
"eusem A B \<equiv> {s. \<exists>p. until A B s p}"(*>*)

text\<open>\noindent
Expressing the semantics of \<^term>\<open>EU\<close> is now straightforward:
@{prop[display]"s \<Turnstile> EU f g = (\<exists>p. until {t. t \<Turnstile> f} {t. t \<Turnstile> g} s p)"}
Note that \<^term>\<open>EU\<close> is not definable in terms of the other operators!

Model checking \<^term>\<open>EU\<close> is again a least fixed point construction:
@{text[display]"mc(EU f g) = lfp(\<lambda>T. mc g \<union> mc f \<inter> (M\<inverse> `` T))"}

\begin{exercise}
Extend the datatype of formulae by the above until operator
and prove the equivalence between semantics and model checking, i.e.\ that
@{prop[display]"mc(EU f g) = {s. s \<Turnstile> EU f g}"}
%For readability you may want to annotate {term EU} with its customary syntax
%{text[display]"| EU formula formula    E[_ U _]"}
%which enables you to read and write {text"E[f U g]"} instead of {term"EU f g"}.
\end{exercise}
For more CTL exercises see, for example, Huth and Ryan \<^cite>\<open>"Huth-Ryan-book"\<close>.
\<close>

(*<*)
definition eufix :: "state set \<Rightarrow> state set \<Rightarrow> state set \<Rightarrow> state set" where
"eufix A B T \<equiv> B \<union> A \<inter> (M\<inverse> `` T)"

lemma "lfp(eufix A B) \<subseteq> eusem A B"
apply(rule lfp_lowerbound)
apply(auto simp add: eusem_def eufix_def)
 apply(rule_tac x = "[]" in exI)
 apply simp
apply(rule_tac x = "xa#xb" in exI)
apply simp
done

lemma mono_eufix: "mono(eufix A B)"
apply(simp add: mono_def eufix_def)
apply blast
done

lemma "eusem A B \<subseteq> lfp(eufix A B)"
apply(clarsimp simp add: eusem_def)
apply(erule rev_mp)
apply(rule_tac x = x in spec)
apply(induct_tac p)
 apply(subst lfp_unfold[OF mono_eufix])
 apply(simp add: eufix_def)
apply(clarsimp)
apply(subst lfp_unfold[OF mono_eufix])
apply(simp add: eufix_def)
apply blast
done

(*
definition eusem :: "state set \<Rightarrow> state set \<Rightarrow> state set" where
"eusem A B \<equiv> {s. \<exists>p\<in>Paths s. \<exists>j. p j \<in> B \<and> (\<forall>i < j. p i \<in> A)}"

axiomatization where
M_total: "\<exists>t. (s,t) \<in> M"

consts apath :: "state \<Rightarrow> (nat \<Rightarrow> state)"
primrec
"apath s 0 = s"
"apath s (Suc i) = (SOME t. (apath s i,t) \<in> M)"

definition pcons :: "state \<Rightarrow> (nat \<Rightarrow> state) \<Rightarrow> (nat \<Rightarrow> state)" where
"pcons s p == \<lambda>i. case i of 0 \<Rightarrow> s | Suc j \<Rightarrow> p j"

lemma pcons_PathI: "[| (s,t) : M; p \<in> Paths t |] ==> pcons s p \<in> Paths s";
by(simp add: Paths_def pcons_def split: nat.split);

lemma "lfp(eufix A B) \<subseteq> eusem A B"
apply(rule lfp_lowerbound)
apply(clarsimp simp add: eusem_def eufix_def);
apply(erule disjE);
 apply(rule_tac x = "apath x" in bexI);
  apply(rule_tac x = 0 in exI);
  apply simp;
 apply simp;
apply(clarify);
apply(rule_tac x = "pcons xb p" in bexI);
 apply(rule_tac x = "j+1" in exI);
 apply (simp add: pcons_def split: nat.split);
apply (simp add: pcons_PathI)
done
*)
(*>*)

text\<open>Let us close this section with a few words about the executability of
our model checkers.  It is clear that if all sets are finite, they can be
represented as lists and the usual set operations are easily
implemented. Only \<^const>\<open>lfp\<close> requires a little thought.  Fortunately, theory
\<open>While_Combinator\<close> in the Library~\<^cite>\<open>"HOL-Library"\<close> provides a
theorem stating that in the case of finite sets and a monotone
function~\<^term>\<open>F\<close>, the value of \mbox{\<^term>\<open>lfp F\<close>} can be computed by
iterated application of \<^term>\<open>F\<close> to~\<^term>\<open>{}\<close> until a fixed point is
reached. It is actually possible to generate executable functional programs
from HOL definitions, but that is beyond the scope of the tutorial.%
\index{CTL|)}\<close>
(*<*)end(*>*)


theory ProductMachine
imports FSM

begin

subsection \<open>Product Machine\<close>

fun product_transitions :: "'a FSM \<Rightarrow> 'b FSM \<Rightarrow> ('a \<times> 'b) Transition list" where
  "product_transitions A B = map (\<lambda> (t1,t2). ((t_source t1, t_source t2),t_input t1,t_output t1,(t_target t1,t_target t2))) (filter (\<lambda> (t1,t2) . t_input t1 = t_input t2 \<and> t_output t1 = t_output t2) (cartesian_product_list (wf_transitions A) (wf_transitions B)))"

value "product_transitions M_ex M_ex'"

lemma product_transitions_alt1 : "set (product_transitions A B) = {((t_source t1, t_source t2),t_input t1,t_output t1,(t_target t1, t_target t2)) | t1 t2 . (t1,t2) \<in> set (cartesian_product_list (wf_transitions A) (wf_transitions B)) \<and> t_input t1 = t_input t2 \<and> t_output t1 = t_output t2}"
proof
  show "set (product_transitions A B) \<subseteq> {((t_source t1, t_source t2),t_input t1,t_output t1,(t_target t1, t_target t2)) | t1 t2 . (t1,t2) \<in> set (cartesian_product_list (wf_transitions A) (wf_transitions B)) \<and> t_input t1 = t_input t2 \<and> t_output t1 = t_output t2}"
  proof
    fix x assume "x \<in> set (product_transitions A B)"
    then obtain t1 t2 where "x = ((t_source t1, t_source t2),t_input t1,t_output t1,(t_target t1,t_target t2))"
                        and "t_input t1 = t_input t2 \<and> t_output t1 = t_output t2"
                        and "(t1,t2) \<in> set (cartesian_product_list (wf_transitions A) (wf_transitions B))"
      by force
    then show "x \<in> {((t_source t1, t_source t2),t_input t1,t_output t1,(t_target t1, t_target t2)) | t1 t2 . (t1,t2) \<in> set (cartesian_product_list (wf_transitions A) (wf_transitions B)) \<and> t_input t1 = t_input t2 \<and> t_output t1 = t_output t2}" by blast
  qed

  show "{((t_source t1, t_source t2),t_input t1,t_output t1,(t_target t1, t_target t2)) | t1 t2 . (t1,t2) \<in> set (cartesian_product_list (wf_transitions A) (wf_transitions B)) \<and> t_input t1 = t_input t2 \<and> t_output t1 = t_output t2} \<subseteq> set (product_transitions A B)"
    by force
qed

lemma product_transitions_alt2 : "set (product_transitions A B) = {((t_source t1, t_source t2),t_input t1,t_output t1,(t_target t1, t_target t2)) | t1 t2 . t1 \<in> set (wf_transitions A) \<and> t2 \<in> set (wf_transitions B) \<and> t_input t1 = t_input t2 \<and> t_output t1 = t_output t2}"
(is "?P = ?A2")
proof -
  have "?P = {((t_source t1, t_source t2),t_input t1,t_output t1,(t_target t1, t_target t2)) | t1 t2 . (t1,t2) \<in> set (cartesian_product_list (wf_transitions A) (wf_transitions B)) \<and> t_input t1 = t_input t2 \<and> t_output t1 = t_output t2}"
    using product_transitions_alt1 by assumption
  also have "... = ?A2" by force
  finally show ?thesis by auto
qed

lemma product_transitions_alt3 : "set (product_transitions A B) = {((q1,q2),x,y,(q1',q2')) | q1 q2 x y q1' q2' . (q1,x,y,q1') \<in> set (wf_transitions A) \<and> (q2,x,y,q2') \<in> set (wf_transitions B)}"
(is "?P = ?A3")
proof -
  have "?P = {((t_source t1, t_source t2),t_input t1,t_output t1,(t_target t1, t_target t2)) | t1 t2 . t1 \<in> set (wf_transitions A) \<and> t2 \<in> set (wf_transitions B) \<and> t_input t1 = t_input t2 \<and> t_output t1 = t_output t2}"
    using product_transitions_alt2 by assumption
  also have "... = ?A3" by force
  finally show ?thesis by simp
qed

fun product :: "'a FSM \<Rightarrow> 'b FSM \<Rightarrow> ('a \<times> 'b) FSM" where
  "product A B =
  \<lparr>
    initial = (initial A, initial B),
    inputs = (inputs A) @ (inputs B),
    outputs = (outputs A) @ (outputs B),
    transitions = product_transitions A B,
    \<dots> = FSM.more A
  \<rparr>"

value "product M_ex M_ex'"

abbreviation(input) "left_path p \<equiv> map (\<lambda>t. (fst (t_source t), t_input t, t_output t, fst (t_target t))) p"
abbreviation(input) "right_path p \<equiv> map (\<lambda>t. (snd (t_source t), t_input t, t_output t, snd (t_target t))) p"
abbreviation(input) "zip_path p1 p2 \<equiv> (map (\<lambda> t . ((t_source (fst t), t_source (snd t)), t_input (fst t), t_output (fst t), (t_target (fst t), t_target (snd t)))) (zip p1 p2))"

lemma product_simps[simp]:
  "initial (product A B) = (initial A, initial B)"
  "inputs (product A B) = inputs A @ inputs B"
  "outputs (product A B) = outputs A @ outputs B"
  "transitions (product A B) = product_transitions A B"
unfolding product_def by simp+

lemma product_transitions_io_valid :
  "set (product_transitions A B) = hIO (product A B)"
proof -
  have "\<And> t . t \<in> set (product_transitions A B) \<Longrightarrow> t \<in> hIO (product A B)"
  proof -
    fix t assume *: "t \<in> set (product_transitions A B)"
    then obtain t1 t2 where "t = ((t_source t1, t_source t2), t_input t1, t_output t1, t_target t1, t_target t2)"
                        and "t1 \<in> h A \<and> t2 \<in> h B \<and> t_input t1 = t_input t2 \<and> t_output t1 = t_output t2"
      using product_transitions_alt2[of A B] by blast
    then have "is_io_valid_transition (product A B) t"
      by auto
    then show "t \<in> hIO (product A B)" using *
      by (metis io_valid_transition_simp product_simps(4))
  qed
  moreover have "\<And> t . t \<in> hIO (product A B) \<Longrightarrow>  t \<in> set (product_transitions A B)"
    by (metis io_valid_transition_simp product_simps(4))
  ultimately show ?thesis by blast
qed

lemma product_transition_hIO :
  "((q1,q2),x,y,(q1',q2')) \<in> hIO (product A B) \<longleftrightarrow> (q1,x,y,q1') \<in> h A \<and> (q2,x,y,q2') \<in> h B"
  using product_transitions_io_valid[of A B] product_transitions_alt3[of A B] by blast

lemma zip_path_last : "length xs = length ys \<Longrightarrow> (zip_path (xs @ [x]) (ys @ [y])) = (zip_path xs ys)@(zip_path [x] [y])"
  by (induction xs ys rule: list_induct2; simp)

lemma product_path_from_paths :
  assumes "path A (initial A) p1"
      and "path B (initial B) p2"
      and "p_io p1 = p_io p2"
    shows "path (product A B) (initial (product A B)) (zip_path p1 p2)"
      and "target (zip_path p1 p2) (initial (product A B)) = (target p1 (initial A), target p2 (initial B))"
proof -
  have "initial (product A B) = (initial A, initial B)" by auto
  then have "(initial A, initial B) \<in> nodes (product A B)"
    by (metis nodes.initial)

  have "length p1 = length p2" using assms(3)
    using map_eq_imp_length_eq by blast
  then have c: "path (product A B) (initial (product A B)) (zip_path p1 p2) \<and> target (zip_path p1 p2) (initial (product A B)) = (target p1 (initial A), target p2 (initial B))"
    using assms proof (induction p1 p2 rule: rev_induct2)
    case Nil

    then have "path (product A B) (initial (product A B)) (zip_path [] [])"
      using \<open>initial (product A B) = (initial A, initial B)\<close> \<open>(initial A, initial B) \<in> nodes (product A B)\<close>
      by (metis Nil_is_map_conv path.nil zip_Nil)
    moreover have "target (zip_path [] []) (initial (product A B)) = (target [] (initial A), target [] (initial B))"
      using \<open>initial (product A B) = (initial A, initial B)\<close> by auto
    ultimately show ?case by fast
  next
    case (snoc x xs y ys)

    have "path A (initial A) xs" using snoc.prems(1) by auto
    moreover have "path B (initial B) ys" using snoc.prems(2) by auto
    moreover have "p_io xs = p_io ys" using snoc.prems(3) by auto
    ultimately have *:"path (product A B) (initial (product A B)) (zip_path xs ys)"
                and **:"target (zip_path xs ys) (initial (product A B)) = (target xs (initial A), target ys (initial B))"
      using snoc.IH by blast+
    then have "(target xs (initial A), target ys (initial B)) \<in> nodes (product A B)"
      by (metis (no_types, lifting) path_target_is_node)
    then have "(t_source x, t_source y) \<in> nodes (product A B)"
      using snoc.prems(1-2)  by (metis path_cons_elim path_suffix)

    have "x \<in> h A" using snoc.prems(1) by auto
    moreover have "y \<in> h B" using snoc.prems(2) by auto
    moreover have "t_input x = t_input y" using snoc.prems(3) by auto
    moreover have "t_output x = t_output y" using snoc.prems(3) by auto
    ultimately have "((t_source x, t_source y), t_input x, t_output x, (t_target x, t_target y)) \<in> hIO (product A B)"
    proof -
      have f1: "{((t_source p, t_source pa), t_input p, t_output p, t_target p, t_target pa) | p pa. p \<in> set (wf_transitions A) \<and> pa \<in> set (wf_transitions B) \<and> t_input p = t_input pa \<and> t_output p = t_output pa} = set (io_valid_transitions (product A B))"
        using product_transitions_alt2[of A B] product_transitions_io_valid by blast
      have "\<exists>p pa. ((t_source x, t_source y), t_input x, t_output x, t_target x, t_target y) = ((t_source p, t_source pa), t_input p, t_output p, t_target p, t_target pa) \<and> p \<in> set (wf_transitions A) \<and> pa \<in> set (wf_transitions B) \<and> t_input p = t_input pa \<and> t_output p = t_output pa"
        using \<open>t_input x = t_input y\<close> \<open>t_output x = t_output y\<close> \<open>x \<in> set (wf_transitions A)\<close> \<open>y \<in> set (wf_transitions B)\<close> by blast
      then show ?thesis
        using f1 by blast
    qed

    moreover have "t_source x = target xs (initial A)" using snoc.prems(1) by auto
    moreover have "t_source y = target ys (initial B)" using snoc.prems(2) by auto
    ultimately have "((target xs (initial A), target ys (initial B)), t_input x, t_output x, (t_target x, t_target y)) \<in> h (product A B)"
      using \<open>(t_source x, t_source y) \<in> nodes (product A B)\<close>
      by (metis fst_conv io_valid_transition_simp wf_transition_simp)
    then have ***: "path (product A B) (initial (product A B)) ((zip_path xs ys)@[((target xs (initial A), target ys (initial B)), t_input x, t_output x, (t_target x, t_target y))])"
      using * **
      by (metis (no_types, lifting) fst_conv path_append_last)

    have "t_target x = target (xs@[x]) (initial A)" by auto
    moreover have "t_target y = target (ys@[y]) (initial B)" by auto
    ultimately have ****: "target ((zip_path xs ys)@[((target xs (initial A), target ys (initial B)), t_input x, t_output x, (t_target x, t_target y))]) (initial (product A B)) = (target (xs@[x]) (initial A), target (ys@[y]) (initial B))"
      by fastforce

    have "(zip_path [x] [y]) = [((target xs (initial A), target ys (initial B)), t_input x, t_output x, (t_target x, t_target y))]"
      using \<open>t_source x = target xs (initial A)\<close> \<open>t_source y = target ys (initial B)\<close> by auto
    moreover have "(zip_path (xs @ [x]) (ys @ [y])) = (zip_path xs ys)@(zip_path [x] [y])"
      using zip_path_last[of xs ys x y, OF snoc.hyps]  by assumption
    ultimately have *****:"(zip_path (xs@[x]) (ys@[y])) = (zip_path xs ys)@[((target xs (initial A), target ys (initial B)), t_input x, t_output x, (t_target x, t_target y))]"
      by auto
    then have "path (product A B) (initial (product A B)) (zip_path (xs@[x]) (ys@[y]))"
      using *** by presburger
    moreover have "target (zip_path (xs@[x]) (ys@[y])) (initial (product A B)) = (target (xs@[x]) (initial A), target (ys@[y]) (initial B))"
      using **** ***** by auto
    ultimately show ?case by linarith
  qed

  from c show "path (product A B) (initial (product A B)) (zip_path p1 p2)" by auto
  from c show "target (zip_path p1 p2) (initial (product A B)) = (target p1 (initial A), target p2 (initial B))" by auto
qed

lemma product_transitions_elem :
  assumes "t \<in> set (product_transitions A B)"
  shows "(fst (t_source t), t_input t, t_output t, fst (t_target t)) \<in> h A"
    and "(snd (t_source t), t_input t, t_output t, snd (t_target t)) \<in> h B"
proof -
  obtain t1 t2 where *:   "t = ((t_source t1, t_source t2), t_input t1, t_output t1, t_target t1, t_target t2)"
                 and **:  "t1 \<in> h A"
                 and ***: "t2 \<in> h B"
                 and ****: "t_input t1 = t_input t2 \<and> t_output t1 = t_output t2"
    using assms product_transitions_alt2[of A B] by blast

  from * ** show "(fst (t_source t), t_input t, t_output t, fst (t_target t)) \<in> h A" by auto
  from * *** **** show "(snd (t_source t), t_input t, t_output t, snd (t_target t)) \<in> h B" by auto
qed

lemma paths_from_product_path :
  assumes "path (product A B) (initial (product A B)) p"
  shows   "path A (initial A) (left_path p)"
      and "path B (initial B) (right_path p)"
      and "target (left_path p) (initial A) = fst (target p (initial (product A B)))"
      and "target (right_path p) (initial B) = snd (target p (initial (product A B)))"
proof -
  have "path A (initial A) (left_path p)
            \<and> path B (initial B) (right_path p)
            \<and> target (left_path p) (initial A) = fst (target p (initial (product A B)))
            \<and> target (right_path p) (initial B) = snd (target p (initial (product A B)))"
  using assms proof (induction p rule: rev_induct)
    case Nil
    then show ?case by auto
  next
    case (snoc t p)
    then have "path (product A B) (initial (product A B)) p" by fast
    then have "path A (initial A) (left_path p)"
      and "path B (initial B) (right_path p)"
      and "target (left_path p) (initial A) = fst (target p (initial (product A B)))"
      and "target (right_path p) (initial B) = snd (target p (initial (product A B)))"
      using snoc.IH  by fastforce+

    then have "t_source t = (target (left_path p) (initial A), target (right_path p) (initial B))"
      using snoc.prems by (metis (no_types, lifting) path_cons_elim path_suffix prod.collapse)

    have ***: "target (left_path (p@[t])) (initial A) = fst (target (p@[t]) (initial (product A B)))"
      by fastforce
    have ****: "target (right_path (p@[t])) (initial B) = snd (target (p@[t]) (initial (product A B)))"
      by fastforce

    have "t \<in> h (product A B)" using snoc.prems
      by (meson path_cons_elim path_suffix wf_transition_simp)
    then have "t \<in> set (product_transitions A B)"
      using product_transitions_io_valid[of A B]
      by (metis io_valid_transition_simp wf_transition_simp)

    have "(fst (t_source t), t_input t, t_output t, fst (t_target t)) \<in> h A"
      using product_transitions_elem[OF \<open>t \<in> set (product_transitions A B)\<close>] by simp
    moreover have "target (left_path p) (initial A) = fst (t_source t)"
      using \<open>t_source t = (target (left_path p) (initial A), target (right_path p) (initial B))\<close> by auto
    ultimately have "path A (initial A) ((left_path p)@[(fst (t_source t), t_input t, t_output t, fst (t_target t))])"
      by (simp add: \<open>path A (initial A) (map (\<lambda>t. (fst (t_source t), t_input t, t_output t, fst (t_target t))) p)\<close> path_append_last)
    then have *: "path A (initial A) (left_path (p@[t]))" by auto

    have "(snd (t_source t), t_input t, t_output t, snd (t_target t)) \<in> h B"
      using product_transitions_elem[OF \<open>t \<in> set (product_transitions A B)\<close>] by simp
    moreover have "target (right_path p) (initial B) = snd (t_source t)"
      using \<open>t_source t = (target (left_path p) (initial A), target (right_path p) (initial B))\<close> by auto
    ultimately have "path B (initial B) ((right_path p)@[(snd (t_source t), t_input t, t_output t, snd (t_target t))])"
      by (simp add: \<open>path B (initial B) (map (\<lambda>t. (snd (t_source t), t_input t, t_output t, snd (t_target t))) p)\<close> path_append_last)
    then have **: "path B (initial B) (right_path (p@[t]))" by auto

    show ?case using * ** *** **** by blast
  qed

  then show "path A (initial A) (left_path p)"
      and "path B (initial B) (right_path p)"
      and "target (left_path p) (initial A) = fst (target p (initial (product A B)))"
      and "target (right_path p) (initial B) = snd (target p (initial (product A B)))" by linarith+
qed

lemma product_transition :
  "((q1,q2),x,y,(q1',q2')) \<in> h (product A B) \<longleftrightarrow> (q1,x,y,q1') \<in> h A \<and> (q2,x,y,q2') \<in> h B \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
proof
  show "((q1,q2),x,y,(q1',q2')) \<in> h (product A B) \<Longrightarrow> (q1,x,y,q1') \<in> h A \<and> (q2,x,y,q2') \<in> h B \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
  proof -
    assume "((q1,q2),x,y,(q1',q2')) \<in> h (product A B)"
    then have "(q1,q2) \<in> nodes (product A B)"
      by (metis fst_conv wf_transition_simp)
    then obtain p where "path (product A B) (initial (product A B)) p" and "target p (initial (product A B)) = (q1,q2)"
      by (metis path_to_node)

    have "path A (initial A) (left_path p) \<and> path B (initial B) (right_path p) \<and> target (left_path p) (initial A) = q1 \<and> target (right_path p) (initial B) = q2"
      using paths_from_product_path[OF \<open>path (product A B) (initial (product A B)) p\<close>] \<open>target p (initial (product A B)) = (q1,q2)\<close> by auto
    moreover have "p_io (left_path p) = p_io (right_path p)" by auto
    ultimately have "(\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
      by blast
    moreover have "(q1,x,y,q1') \<in> h A \<and> (q2,x,y,q2') \<in> h B"
      using \<open>((q1,q2),x,y,(q1',q2')) \<in> h (product A B)\<close>
      by (metis product_simps(4) product_transition_hIO product_transitions_io_valid wf_transition_simp)
    ultimately show ?thesis by simp
  qed

  show "(q1,x,y,q1') \<in> h A \<and> (q2,x,y,q2') \<in> h B \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2) \<Longrightarrow> ((q1,q2),x,y,(q1',q2')) \<in> h (product A B)"
  proof -
    assume assm: "(q1,x,y,q1') \<in> h A \<and> (q2,x,y,q2') \<in> h B \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
    then obtain p1 p2 where pr1: "path A (initial A) p1"
                        and pr2: "path B (initial B) p2"
                        and pr3: "target p1 (initial A) = q1"
                        and pr4: "target p2 (initial B) = q2"
                        and pr5: "p_io p1 = p_io p2"
      by blast

    have "(q1,x,y,q1') \<in> h A" and "(q2,x,y,q2') \<in> h B"
      using assm by auto

    have "initial (product A B) \<in> nodes (product A B)"
      by blast
    moreover have "path (product A B) (initial (product A B)) (zip_path p1 p2)"
      using product_path_from_paths(1)[OF pr1 pr2 pr5] by assumption
    moreover have "target (zip_path p1 p2) (initial (product A B)) = (q1,q2)"
      using product_path_from_paths(2)[OF pr1 pr2 pr5] pr3 pr4 by fast
    ultimately have "(q1,q2) \<in> nodes (product A B)"
      using nodes_path[of "product A B" "initial (product A B)" "zip_path p1 p2"] by metis
    then have "t_source ((q1,q2),x,y,(q1',q2')) \<in> nodes (product A B)"
      by auto

    moreover have "((q1,q2),x,y,(q1',q2')) \<in> hIO (product A B)"
      using product_transitions_alt3[of A B] \<open>(q1,x,y,q1') \<in> h A\<close> \<open>(q2,x,y,q2') \<in> h B\<close> by force
    ultimately show "((q1,q2),x,y,(q1',q2')) \<in> h (product A B)"
      using hIO_alt_def[of "product A B"] h_alt_def[of "product A B"] by blast
  qed
qed

lemma product_transition_t :
  "t \<in> h (product A B) \<longleftrightarrow> (fst (t_source t),t_input t,t_output t,fst (t_target t)) \<in> h A \<and> (snd (t_source t), t_input t, t_output t, snd (t_target t)) \<in> h B \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = fst (t_source t) \<and> target p2 (initial B) = snd (t_source t) \<and> p_io p1 = p_io p2)"
proof -
  have "t = ((fst (t_source t), snd (t_source t)), t_input t, t_output t, fst (t_target t), snd (t_target t))"
    by auto
  then show ?thesis
    using product_transition[of "fst (t_source t)" "snd (t_source t)" "t_input t" "t_output t" "fst (t_target t)" "snd (t_target t)" A B] by presburger
qed

lemma product_transition_from_transitions :
  assumes "t1 \<in> h A"
      and "t2 \<in> h B"
      and "t_input t1 = t_input t2"
      and "t_output t1 = t_output t2"
      and "(\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = t_source t1 \<and> target p2 (initial B) = t_source t2 \<and> p_io p1 = p_io p2)"
  shows "((t_source t1,t_source t2),t_input t1,t_output t1,(t_target t1,t_target t2)) \<in> h (product A B)  "
proof-
  note product_transition[of "t_source t1" "t_source t2" "t_input t1" "t_output t1" "t_target t1" "t_target t2" A B]
  moreover have "(t_source t1, t_input t1, t_output t1, t_target t1) \<in> set (wf_transitions A)"
    using assms(1) by auto
  moreover have "(t_source t2, t_input t1, t_output t1, t_target t2) \<in> set (wf_transitions B)"
    using assms(2-4) by auto
  moreover note assms(5)
  ultimately show ?thesis by presburger
qed

lemma product_node_from_path :
  "(q1,q2) \<in> nodes (product A B) \<longleftrightarrow> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
proof
  show "(q1,q2) \<in> nodes (product A B) \<Longrightarrow> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
  proof -
    assume "(q1,q2) \<in> nodes (product A B)"
    then obtain p where "path (product A B) (initial (product A B)) p" and "target p (initial (product A B)) = (q1,q2)"
      by (metis path_to_node)
    then have "path A (initial A) (left_path p) \<and> path B (initial B) (right_path p) \<and> target (left_path p) (initial A) = q1 \<and> target (right_path p) (initial B) = q2 \<and> p_io (left_path p) = p_io (right_path p)"
      using paths_from_product_path[OF \<open>path (product A B) (initial (product A B)) p\<close>] by simp
    then show "(\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
      by blast
  qed

  show "(\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2) \<Longrightarrow> (q1,q2) \<in> nodes (product A B)"
  proof -
    assume "(\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
    then obtain p1 p2 where *: "path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2"
      by blast

    have "initial (product A B) \<in> nodes (product A B)"
      by blast
    moreover have "path (product A B) (initial (product A B)) (zip_path p1 p2)"
      using product_path_from_paths(1)[of A p1 B p2] * by metis
    moreover have "target (zip_path p1 p2) (initial (product A B)) = (q1,q2)"
      using product_path_from_paths(2)[of A p1 B p2] * by metis
    ultimately show "(q1,q2) \<in> nodes (product A B)"
      using nodes_path[of "product A B" "initial (product A B)" "zip_path p1 p2"] by metis
  qed
qed

lemma left_path_zip : "length p1 = length p2 \<Longrightarrow> left_path (zip_path p1 p2) = p1"
  by (induction p1 p2 rule: list_induct2; simp)

lemma right_path_zip : "length p1 = length p2 \<Longrightarrow> p_io p1 = p_io p2 \<Longrightarrow> right_path (zip_path p1 p2) = p2"
  by (induction p1 p2 rule: list_induct2; simp)

lemma zip_path_append_left_right : "length p1 = length p2 \<Longrightarrow> zip_path (p1@(left_path p)) (p2@(right_path p)) = (zip_path p1 p2)@p"
proof (induction p1 p2 rule: list_induct2)
  case Nil
  then show ?case by (induction p; simp)
next
  case (Cons x xs y ys)
  then show ?case by simp
qed

lemma product_path:
  "path (product A B) (q1,q2) p \<longleftrightarrow> (path A q1 (left_path p) \<and> path B q2 (right_path p) \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2))"
proof
  show "path (product A B) (q1,q2) p \<Longrightarrow> (path A q1 (left_path p) \<and> path B q2 (right_path p) \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2))"
  proof -
    assume "path (product A B) (q1,q2) p"
    then have "(q1,q2) \<in> nodes (product A B)"
      by (meson path_begin_node)
    then have ex12: "(\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
      using product_node_from_path[of q1 q2 A B] by blast
    then obtain p1 p2 where *: "path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2"
      by blast
    then have "path (product A B) (initial (product A B)) (zip_path p1 p2)"
      using product_path_from_paths(1)[of A p1 B p2] by metis

    have "path A (initial A) p1" and "path B (initial B) p2" and "target p1 (initial A) = q1" and "target p2 (initial B) = q2" and "p_io p1 = p_io p2"
      using * by linarith+

    have "target (zip_path p1 p2) (initial (product A B)) = (q1,q2)"
      using product_path_from_paths(2)[of A p1 B p2] * by metis

    have "path (product A B) (initial (product A B)) ((zip_path p1 p2) @ p)"
      using path_append[OF \<open>path (product A B) (initial (product A B)) (zip_path p1 p2)\<close>, of p]
            \<open>target (zip_path p1 p2) (initial (product A B)) = (q1,q2)\<close>
            \<open>path (product A B) (q1,q2) p\<close> by metis

    have "path A (initial A) (left_path ((zip_path p1 p2) @ p))"
      and "path B (initial B) (right_path ((zip_path p1 p2) @ p))"
      and "target (left_path ((zip_path p1 p2) @ p)) (initial A) = fst (target ((zip_path p1 p2) @ p) (initial (product A B)))"
      and "target (right_path ((zip_path p1 p2) @ p)) (initial B) = snd (target ((zip_path p1 p2) @ p) (initial (product A B)))"
      using paths_from_product_path[OF \<open>path (product A B) (initial (product A B)) ((zip_path p1 p2) @ p)\<close>] by linarith+

    have "length p1 = length p2"
      using \<open>p_io p1 = p_io p2\<close> map_eq_imp_length_eq by blast

    have "(left_path ((zip_path p1 p2) @ p)) = p1@(left_path p)"
      using left_path_zip[OF \<open>length p1 = length p2\<close>] by (induction p; simp)
    then have "path A (initial A) (p1@(left_path p))"
      using \<open>path A (initial A) (left_path ((zip_path p1 p2) @ p))\<close> by simp
    have lp: "path A q1 (left_path p)"
      using path_suffix[OF \<open>path A (initial A) (p1@(left_path p))\<close>] \<open>target p1 (initial A) = q1\<close> by simp

    have "(right_path ((zip_path p1 p2) @ p)) = p2@(right_path p)"
      using right_path_zip[OF \<open>length p1 = length p2\<close> \<open>p_io p1 = p_io p2\<close>] by (induction p; simp)
    then have "path B (initial B) (p2@(right_path p))"
      using \<open>path B (initial B) (right_path ((zip_path p1 p2) @ p))\<close> by simp
    have rp: "path B q2 (right_path p)"
      using path_suffix[OF \<open>path B (initial B) (p2@(right_path p))\<close>] \<open>target p2 (initial B) = q2\<close> by simp

    show "(path A q1 (left_path p) \<and> path B q2 (right_path p) \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2))"
      using lp rp ex12 by simp
  qed

  show "(path A q1 (left_path p) \<and> path B q2 (right_path p) \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)) \<Longrightarrow> path (product A B) (q1,q2) p"
  proof-
    assume "(path A q1 (left_path p) \<and> path B q2 (right_path p) \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2))"
    then have "path A q1 (left_path p)" and "path B q2 (right_path p)" and "(\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
      by auto
    then obtain p1 p2 where *: "path A (initial A) p1" and "path B (initial B) p2" and "target p1 (initial A) = q1" and "target p2 (initial B) = q2" and "p_io p1 = p_io p2"
      by blast

    have "path A (initial A) (p1@(left_path p))"
      using path_append[OF \<open>path A (initial A) p1\<close>, of "left_path p"] \<open>target p1 (initial A) = q1\<close> \<open>path A q1 (left_path p)\<close> by metis
    have "path B (initial B) (p2@(right_path p))"
      using path_append[OF \<open>path B (initial B) p2\<close>, of "right_path p"] \<open>target p2 (initial B) = q2\<close> \<open>path B q2 (right_path p)\<close> by metis
    have "p_io (p1@(left_path p)) = p_io (p2@(right_path p))"
      using \<open>p_io p1 = p_io p2\<close> by (induction p; simp)

    have "path (product A B) (initial (product A B)) ((zip_path p1 p2)@p)"
      using product_path_from_paths(1)[OF \<open>path A (initial A) (p1@(left_path p))\<close> \<open>path B (initial B) (p2@(right_path p))\<close> \<open>p_io (p1@(left_path p)) = p_io (p2@(right_path p))\<close>]
            zip_path_append_left_right[of p1 p2 p]
      by (metis (no_types, lifting) \<open>p_io p1 = p_io p2\<close> map_eq_imp_length_eq)

    have "path (product A B) (initial (product A B)) (zip_path p1 p2)"
      using product_path_from_paths(1)[OF \<open>path A (initial A) p1\<close> \<open>path B (initial B) p2\<close> \<open>p_io p1 = p_io p2\<close>] by metis
    moreover have "target (zip_path p1 p2) (initial (product A B)) = (q1,q2)"
      using product_path_from_paths(2)[OF \<open>path A (initial A) p1\<close> \<open>path B (initial B) p2\<close> \<open>p_io p1 = p_io p2\<close>] \<open>target p1 (initial A) = q1\<close> \<open>target p2 (initial B) = q2\<close> by metis

    ultimately show "path (product A B) (q1,q2) p"
      using path_suffix[OF \<open>path (product A B) (initial (product A B)) ((zip_path p1 p2)@p)\<close>]
      by presburger
  qed
qed

lemma product_path_rev:
  assumes "p_io p1 = p_io p2"
  shows "path (product A B) (q1,q2) (zip_path p1 p2)
          \<longleftrightarrow> (path A q1 p1 \<and> path B q2 p2 \<and> (\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2))"
proof -
  have "length p1 = length p2" using assms
    using map_eq_imp_length_eq by blast
  then have "(map (\<lambda> t . (fst (t_source t), t_input t, t_output t, fst (t_target t))) (map (\<lambda> t . ((t_source (fst t), t_source (snd t)), t_input (fst t), t_output (fst t), (t_target (fst t), t_target (snd t)))) (zip p1 p2))) = p1"
    by (induction p1 p2 arbitrary: q1 q2 rule: list_induct2; auto)

  moreover have "(map (\<lambda> t . (snd (t_source t), t_input t, t_output t, snd (t_target t))) (map (\<lambda> t . ((t_source (fst t), t_source (snd t)), t_input (fst t), t_output (fst t), (t_target (fst t), t_target (snd t)))) (zip p1 p2))) = p2"
    using \<open>length p1 = length p2\<close> assms by (induction p1 p2 arbitrary: q1 q2 rule: list_induct2; auto)

  ultimately show ?thesis using product_path[of A B q1 q2 "(map (\<lambda> t . ((t_source (fst t), t_source (snd t)), t_input (fst t), t_output (fst t), (t_target (fst t), t_target (snd t)))) (zip p1 p2))"]
    by auto
qed

lemma product_language_state :
  assumes "(\<exists> p1 p2 . path A (initial A) p1 \<and> path B (initial B) p2 \<and> target p1 (initial A) = q1 \<and> target p2 (initial B) = q2 \<and> p_io p1 = p_io p2)"
  shows "LS (product A B) (q1,q2) = LS A q1 \<inter> LS B q2"
proof
  show "LS (product A B) (q1, q2) \<subseteq> LS A q1 \<inter> LS B q2"
  proof
    fix io assume "io \<in> LS (product A B) (q1, q2)"
    then obtain p where "io = p_io p"
                    and "path (product A B) (q1,q2) p"
      by auto
    then obtain p1 p2 where "path A q1 p1"
                        and "path B q2 p2"
                        and "io = p_io p1"
                        and "io = p_io p2"
      using product_path[of A B q1 q2 p] by fastforce
    then show "io \<in> LS A q1 \<inter> LS B q2"
      unfolding LS.simps by blast
  qed

  show "LS A q1 \<inter> LS B q2 \<subseteq> LS (product A B) (q1, q2)"
  proof
    fix io assume "io \<in> LS A q1 \<inter> LS B q2"
    then obtain p1 p2 where "path A q1 p1"
                        and "path B q2 p2"
                        and "io = p_io p1"
                        and "io = p_io p2"
                        and "p_io p1 = p_io p2"
      by auto

    let ?p = "zip_path p1 p2"

    have "length p1 = length p2"
      using \<open>p_io p1 = p_io p2\<close> map_eq_imp_length_eq by blast
    moreover have "p_io ?p = p_io (map fst (zip p1 p2))" by auto
    ultimately have "p_io ?p = p_io p1" by auto

    then have "p_io ?p = io"
      using \<open>io = p_io p1\<close> by auto
    moreover have "path (product A B) (q1, q2) ?p"
      using product_path_rev[OF \<open>p_io p1 = p_io p2\<close>, of A B q1 q2] \<open>path A q1 p1\<close> \<open>path B q2 p2\<close> assms by auto
    ultimately show "io \<in> LS (product A B) (q1, q2)"
      unfolding LS.simps by blast
  qed
qed

lemma product_language : "L (product A B) = L A \<inter> L B"
proof -
  have "path A (initial A) [] \<and>
         path B (initial B) [] \<and>
         target [] (initial A) = initial A \<and> target [] (initial B) = initial B \<and> p_io [] = p_io []" by auto
  then have "\<exists>p1 p2.
       path A (initial A) p1 \<and>
       path B (initial B) p2 \<and>
       target p1 (initial A) = initial A \<and> target p2 (initial B) = initial B \<and> p_io p1 = p_io p2" by blast
  then show ?thesis
    using product_language_state[of A B "initial A" "initial B"] unfolding product.simps by simp
qed

lemma product_nodes : "nodes (product A B) \<subseteq> (nodes A) \<times> (nodes B)"
proof
  fix q assume "q \<in> nodes (product A B)"
  then obtain p where "path (product A B) (initial (product A B)) p"
                and   "q = target p (initial (product A B))"
    by (metis path_to_node)

  let ?p1 = "left_path p"
  let ?p2 = "right_path p"

  have "path A (initial A) ?p1 \<and> path B (initial B) ?p2"
    by (metis \<open>path (product A B) (initial (product A B)) p\<close> product_path[of A B "initial A" "initial B" p] product_simps(1))

  moreover have "target p (initial (product A B)) = (target ?p1 (initial A), target ?p2 (initial B))"
    by (induction p; force)

  ultimately show "q \<in> (nodes A) \<times> (nodes B)"
    by (metis (no_types, lifting) SigmaI \<open>q = target p (initial (product A B))\<close> nodes_path_initial)
qed

lemma product_transition_split_ob :
  assumes "t \<in> h (product A B)"
  obtains t1 t2
  where "t1 \<in> h A \<and> t_source t1 = fst (t_source t) \<and> t_input t1 = t_input t \<and> t_output t1 = t_output t \<and> t_target t1 = fst (t_target t)"
    and "t2 \<in> h B \<and> t_source t2 = snd (t_source t) \<and> t_input t2 = t_input t \<and> t_output t2 = t_output t \<and> t_target t2 = snd (t_target t)"
proof -
  have "t \<in> set (transitions (product A B))"
    using assms by blast

  then have "t \<in> set (map (\<lambda>(t1, t2).
                      ((t_source t1, t_source t2), t_input t1, t_output t1, t_target t1, t_target t2))
               (filter (\<lambda>(t1, t2). t_input t1 = t_input t2 \<and> t_output t1 = t_output t2)
                 (cartesian_product_list (wf_transitions A) (wf_transitions B))))"
    by (metis product_simps(4) product_transitions.elims)

  then obtain t1 t2 where "t = ((t_source t1, t_source t2),t_input t1,t_output t1,(t_target t1,t_target t2))"
                 and "(t1,t2) \<in> set (filter (\<lambda>(t1, t2). t_input t1 = t_input t2 \<and> t_output t1 = t_output t2)
                                      (cartesian_product_list (wf_transitions A) (wf_transitions B)))"
    by (metis (no_types, lifting) case_prod_beta' imageE prod.collapse set_map)

  then have *: "t_source t2 = snd (t_source t) \<and> t_input t2 = t_input t \<and> t_output t2 = t_output t \<and> t_target t2 = snd (t_target t)"
    by auto
  have **: "t_source t1 = fst (t_source t) \<and> t_input t1 = t_input t \<and> t_output t1 = t_output t \<and> t_target t1 = fst (t_target t)"
    by (simp add: \<open>t = ((t_source t1, t_source t2), t_input t1, t_output t1, t_target t1, t_target t2)\<close>)

  have "(t1,t2) \<in> h A \<times> h B"
    using \<open>(t1,t2) \<in> set (filter (\<lambda>(t1, t2). t_input t1 = t_input t2 \<and> t_output t1 = t_output t2) (cartesian_product_list (wf_transitions A) (wf_transitions B)))\<close> cartesian_product_list_set[of "(wf_transitions A)" "(wf_transitions B)"] by auto
  then have "t1 \<in> h A" and "t2 \<in> h B" by auto

  have "t1 \<in> h A \<and> t_source t1 = fst (t_source t) \<and> t_input t1 = t_input t \<and> t_output t1 = t_output t \<and> t_target t1 = fst (t_target t)"
   and "t2 \<in> h B \<and> t_source t2 = snd (t_source t) \<and> t_input t2 = t_input t \<and> t_output t2 = t_output t \<and> t_target t2 = snd (t_target t)"
    using \<open>t1 : h A\<close> * \<open>t2 \<in> h B\<close> ** by auto

  then show ?thesis
    using that by blast
qed

lemma product_transition_split :
  assumes "t \<in> h (product A B)"
  shows "(fst (t_source t), t_input t, t_output t, fst (t_target t)) \<in> h A"
    and "(snd (t_source t), t_input t, t_output t, snd (t_target t)) \<in> h B"
  using product_transition_split_ob[OF assms] prod.collapse by metis+

subsection \<open>Other Lemmata\<close>

lemma  product_target_split:
  assumes "target p (q1,q2) = (q1',q2')"
  shows "target (left_path p) q1 = q1'"
    and "target (right_path p) q2 = q2'"
using assms by (induction p arbitrary: q1 q2; force)+

lemma h_from_paths :
  assumes "\<And> p . path A (initial A) p = path B (initial B) p"
  shows "h A = h B"
proof (rule ccontr)
  assume "h A \<noteq> h B"
  then consider  "(\<exists> tA \<in> h A . tA \<notin> h B)" | "(\<exists> tB \<in> h B . tB \<notin> h A)" by blast
  then show "False" proof (cases)
    case 1
    then obtain tA where "tA \<in> h A" and "tA \<notin> h B" by blast
    then have "t_source tA \<in> nodes A" by auto
    then obtain p where "path A (initial A) p" and "target p (initial A) = t_source tA"
      using path_to_node by metis
    then have "path A (initial A) (p@[tA])" using path_append_last \<open>tA \<in> h A\<close> by metis
    moreover have "\<not> path B (initial B) (p@[tA])" using \<open>tA \<notin> h B\<close> by auto
    ultimately show "False" using assms by metis
  next
    case 2
    then obtain tB where "tB \<in> h B" and "tB \<notin> h A" by blast
    then have "t_source tB \<in> nodes B" by auto
    then obtain p where "path B (initial B) p" and "target p (initial B) = t_source tB"
      using path_to_node by metis
    then have "path B (initial B) (p@[tB])" using path_append_last \<open>tB \<in> h B\<close> by metis
    moreover have "\<not> path A (initial A) (p@[tB])" using \<open>tB \<notin> h A\<close> by auto
    ultimately show "False" using assms by metis
  qed
qed

lemma single_transitions_path :
  assumes "(q,x,y,q') \<in> h M"
  shows "path M q [(q,x,y,q')]"
  using  path.cons[OF assms path.nil[OF wf_transition_target[OF assms]]] by auto

lemma product_from_next :
  assumes "((q1,q2),x,y,(q1',q2')) \<in> h (product (from_FSM M q1) (from_FSM M q2))"
  shows "h (product (from_FSM M q1') (from_FSM M q2')) = h (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2'))"
proof -
  let ?t = "((q1,q2),x,y,(q1',q2'))"

  have "(q1',q2') \<in> nodes (product (from_FSM M q1) (from_FSM M q2))"
    using wf_transition_target[OF assms] by simp
  then have "q1' \<in> nodes (from_FSM M q1)" and "q2' \<in> nodes (from_FSM M q2)"
    using product_nodes[of "from_FSM M q1" "from_FSM M q2"] by blast+

  have "(q1,x,y,q1') \<in> h (from_FSM M q1)" and "(q2,x,y,q2') \<in> h (from_FSM M q2)"
    using product_transition_split[OF assms] by auto

  have s1 : "initial (product (from_FSM M q1') (from_FSM M q2')) = (q1',q2')"
    by auto
  have s2 : "initial (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2')) = (q1',q2')"
    by auto

  have *: "\<And> p . path (product (from_FSM M q1') (from_FSM M q2')) (q1',q2') p = path (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2')) (q1',q2') p"
  proof -
    fix p show "path (product (from_FSM M q1') (from_FSM M q2')) (q1',q2') p = path (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2')) (q1',q2') p"
    proof
      show "path (product (from_FSM M q1') (from_FSM M q2')) (q1', q2') p \<Longrightarrow>
              path (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2')) (q1', q2') p"
      proof -
        assume "path (product (from_FSM M q1') (from_FSM M q2')) (q1', q2') p"
        then have "path (from_FSM M q1') q1' (left_path p)" and "path (from_FSM M q2') q2' (right_path p)"
          using product_path[of "from_FSM M q1'" "from_FSM M q2'" q1' q2' p] by linarith+

        have "path (from_FSM M q1) q1' (left_path p)"
          using from_FSM_path[OF \<open>q1' \<in> nodes (from_FSM M q1)\<close>, of q1' "left_path p"] \<open>path (from_FSM M q1') q1' (left_path p)\<close> by auto
        have "path (from_FSM M q2) q2' (right_path p)"
          using from_FSM_path[OF \<open>q2' \<in> nodes (from_FSM M q2)\<close>, of q2' "right_path p"] \<open>path (from_FSM M q2') q2' (right_path p)\<close> by auto

        have p3: "(\<exists>p1 p2.
                         path (from_FSM M q1) (initial (from_FSM M q1)) p1 \<and>
                         path (from_FSM M q2) (initial (from_FSM M q2)) p2 \<and>
                         target p1 (initial (from_FSM M q1)) = q1' \<and>
                         target p2 (initial (from_FSM M q2)) = q2' \<and> p_io p1 = p_io p2)"
        proof -
          have "path (from_FSM M q1) (initial (from_FSM M q1)) [(q1, x, y, q1')]"
            using single_transitions_path[OF \<open>(q1,x,y,q1') \<in> h (from_FSM M q1)\<close>] by auto
          moreover have "path (from_FSM M q2) (initial (from_FSM M q2)) [(q2, x, y, q2')]"
            using single_transitions_path[OF \<open>(q2,x,y,q2') \<in> h (from_FSM M q2)\<close>] by auto
          moreover have "(target [(q1,x,y,q1')] (initial (from_FSM M q1)) = q1' \<and>
                          target [(q2,x,y,q2')] (initial (from_FSM M q2)) = q2' \<and>
                          p_io [(q1,x,y,q1')] = p_io [(q2,x,y,q2')])"
            by auto
          ultimately show ?thesis by meson
        qed

        have "path (product (from_FSM M q1) (from_FSM M q2)) (q1',q2') p"
          using product_path[of "from_FSM M q1" "from_FSM M q2" q1' q2' p] \<open>path (from_FSM M q1) q1' (left_path p)\<close> \<open>path (from_FSM M q2) q2' (right_path p)\<close> p3 by presburger

        then show "path (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2')) (q1',q2') p"
          using from_FSM_path_rev_initial by metis
      qed
      show "path (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2')) (q1', q2') p \<Longrightarrow>
              path (product (from_FSM M q1') (from_FSM M q2')) (q1', q2') p"
      proof -
        assume "path (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2')) (q1', q2') p"
        then have "path (product (from_FSM M q1) (from_FSM M q2)) (q1',q2') p"
          using from_FSM_path[OF \<open>(q1',q2') \<in> nodes (product (from_FSM M q1) (from_FSM M q2))\<close>] by metis
        then have "path (from_FSM M q1) q1' (left_path p)"
              and "path (from_FSM M q2) q2' (right_path p)"
              and "(\<exists>p1 p2.
                     path (from_FSM M q1) (initial (from_FSM M q1)) p1 \<and>
                     path (from_FSM M q2) (initial (from_FSM M q2)) p2 \<and>
                     target p1 (initial (from_FSM M q1)) = q1' \<and>
                     target p2 (initial (from_FSM M q2)) = q2' \<and> p_io p1 = p_io p2)"
          using product_path[of "from_FSM M q1" "from_FSM M q2" q1' q2' p] by presburger+

        have "path (from_FSM M q1') q1' (left_path p)"
          using from_FSM_path_rev_initial[OF \<open>path (from_FSM M q1) q1' (left_path p)\<close>] by auto
        moreover have "path (from_FSM M q2') q2' (right_path p)"
          using from_FSM_path_rev_initial[OF \<open>path (from_FSM M q2) q2' (right_path p)\<close>] by auto
        moreover have p3: "(\<exists>p1 p2.
                         path (from_FSM M q1') (initial (from_FSM M q1')) p1 \<and>
                         path (from_FSM M q2') (initial (from_FSM M q2')) p2 \<and>
                         target p1 (initial (from_FSM M q1')) = q1' \<and>
                         target p2 (initial (from_FSM M q2')) = q2' \<and> p_io p1 = p_io p2)"
        proof -
          have "path (from_FSM M q1') (initial (from_FSM M q1')) []"
            using path.nil[OF nodes.initial] by metis
          moreover have "path (from_FSM M q2') (initial (from_FSM M q2')) []"
            using path.nil[OF nodes.initial] by metis
          moreover have "(target [] (initial (from_FSM M q1')) = q1' \<and>
                          target [] (initial (from_FSM M q2')) = q2' \<and>
                          p_io [] = p_io [])"
            by auto
          ultimately show ?thesis by blast
        qed

        ultimately show " path (product (from_FSM M q1') (from_FSM M q2')) (q1', q2') p"
          using product_path[of "from_FSM M q1'" "from_FSM M q2'" q1' q2' p] by presburger
      qed
    qed
  qed

  show ?thesis using * h_from_paths s1 s2 by metis
qed

lemma submachine_transition_product_from :
  assumes "is_submachine S (product (from_FSM M q1) (from_FSM M q2))"
      and "((q1,q2),x,y,(q1',q2')) \<in> h S"
 shows "is_submachine (from_FSM S (q1',q2')) (product (from_FSM M q1') (from_FSM M q2'))"
proof -
  have "((q1,q2),x,y,(q1',q2')) \<in> h (product (from_FSM M q1) (from_FSM M q2))"
    using submachine_h[OF assms(1)] assms(2) by blast
  have "(q1',q2') \<in> nodes S" using wf_transition_target[OF assms(2)] by auto
  show ?thesis
    using product_from_next[OF \<open>((q1,q2),x,y,(q1',q2')) \<in> h (product (from_FSM M q1) (from_FSM M q2))\<close>]
          submachine_from[OF assms(1) \<open>(q1',q2') \<in> nodes S\<close>]
  proof -
    have "initial (from_FSM S (q1', q2')) = initial (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2')) \<and> set (wf_transitions (from_FSM S (q1', q2'))) \<subseteq> set (wf_transitions (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2'))) \<and> inputs (from_FSM S (q1', q2')) = inputs (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2')) \<and> outputs (from_FSM S (q1', q2')) = outputs (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2'))"
      using \<open>is_submachine (from_FSM S (q1', q2')) (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2'))\<close> is_submachine.simps by blast
    then show ?thesis
      by (metis (no_types) \<open>set (wf_transitions (product (from_FSM M q1') (from_FSM M q2'))) = set (wf_transitions (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1', q2')))\<close> from_FSM_simps(1) from_FSM_simps(2) from_FSM_simps(3) is_submachine.simps product_simps(1) product_simps(2) product_simps(3))
  qed
qed

lemma submachine_transition_complete_product_from :
  assumes "is_submachine S (product (from_FSM M q1) (from_FSM M q2))"
      and "completely_specified S"
      and "((q1,q2),x,y,(q1',q2')) \<in> h S"
 shows "completely_specified (from_FSM S (q1',q2'))"
proof -
  let ?P = "(product (from_FSM M q1) (from_FSM M q2))"
  let ?P' = "(product (from_FSM M q1') (from_FSM M q2'))"
  let ?F = "(from_FSM S (q1',q2'))"

  have "initial ?P = (q1,q2)"
    by auto
  then have "initial S = (q1,q2)"
    using assms(1) by (metis is_submachine.simps)
  then have "(q1',q2') \<in> nodes S"
    using assms(3)
    using wf_transition_target by fastforce
  then have "nodes ?F \<subseteq> nodes S"
    using from_FSM_nodes by metis
  moreover have "inputs ?F = inputs S"
    by auto
  ultimately show "completely_specified ?F"
    using assms(2) unfolding completely_specified.simps
    using from_FSM_nodes_transitions[of _ S "(q1',q2')"]
    using contra_subsetD by fastforce
qed

lemma from_FSM_product_inputs :
  "set (inputs (product (from_FSM M q1) (from_FSM M q2))) = set (inputs M)"
  unfolding product.simps from_FSM.simps by auto

lemma from_FSM_product_outputs :
  "set (outputs (product (from_FSM M q1) (from_FSM M q2))) = set (outputs M)"
  unfolding product.simps from_FSM.simps by auto

lemma from_FSM_product_initial :
  "initial (product (from_FSM M q1) (from_FSM M q2)) = (q1,q2)" by auto

lemma product_from_next' :
  assumes "t \<in> h (product (from_FSM M (fst (t_source t))) (from_FSM M (snd (t_source t))))"
    shows "h (from_FSM (product (from_FSM M (fst (t_source t))) (from_FSM M (snd (t_source t)))) (fst (t_target t),snd (t_target t))) = h (product (from_FSM M (fst (t_target t))) (from_FSM M (snd (t_target t))))"
proof -
  have "t = ((fst (t_source t),snd (t_source t)),t_input t, t_output t,(fst (t_target t),snd (t_target t)))"
    by (metis prod.collapse)
  then have *: "((fst (t_source t),snd (t_source t)),t_input t, t_output t,(fst (t_target t),snd (t_target t))) \<in> h (product (from_FSM M (fst (t_source t))) (from_FSM M (snd (t_source t))))"
    using assms by presburger

  show ?thesis using product_from_next[OF *] by blast
qed

lemma product_from_next'_path :
  assumes "t \<in> h (product (from_FSM M (fst (t_source t))) (from_FSM M (snd (t_source t))))"
  shows "path (from_FSM (product (from_FSM M (fst (t_source t))) (from_FSM M (snd (t_source t)))) (fst (t_target t),snd (t_target t))) (fst (t_target t),snd (t_target t)) p = path (product (from_FSM M (fst (t_target t))) (from_FSM M (snd (t_target t)))) (fst (t_target t),snd (t_target t)) p"
    (is "path ?P1 ?q p = path ?P2 ?q p")
proof -
  have i1: "initial ?P1 = ?q" by auto
  have i2: "initial ?P2 = ?q" by auto
  have h12: "h ?P1 = h ?P2" using product_from_next'[OF assms] by assumption

  show ?thesis proof (induction p rule: rev_induct)
    case Nil
    then show ?case
      by (metis (full_types) i1 i2 nodes.initial path.nil)
  next
    case (snoc t p)
    show ?case by (meson h12 h_equivalence_path path_begin_node path_prefix snoc.IH)
  qed
qed

lemma product_from_transition_subset:
  assumes "(q1',q2') \<in> nodes (product (from_FSM M q1) (from_FSM M q2))"
  shows "h (product (from_FSM M q1') (from_FSM M q2')) \<subseteq> h (product (from_FSM M q1) (from_FSM M q2))" (is "h ?P' \<subseteq> h ?P")
proof
  fix t assume "t \<in> h ?P'"
  then have "t_source t \<in> nodes ?P'" by (metis wf_transition_simp)
  then obtain p' where "path ?P' (initial ?P') p'" and "target p' (initial ?P') = t_source t"
    by (metis path_to_node)

  have "path (from_FSM M q1') q1' (left_path p')"
       "path (from_FSM M q2') q2' (right_path p')"
       "(\<exists>p1 p2.
           path (from_FSM M q1') (initial (from_FSM M q1')) p1 \<and>
           path (from_FSM M q2') (initial (from_FSM M q2')) p2 \<and>
           target p1 (initial (from_FSM M q1')) = q1' \<and> target p2 (initial (from_FSM M q2')) = q2' \<and> p_io p1 = p_io p2)"
    using product_path[of "from_FSM M q1'" "from_FSM M q2'" q1' q2' p'] \<open>path ?P' (initial ?P') p'\<close> by auto

  have          "(fst (t_source t), t_input t, t_output t, fst (t_target t)) \<in> set (wf_transitions (from_FSM M q1'))"
       and      "(snd (t_source t), t_input t, t_output t, snd (t_target t)) \<in> set (wf_transitions (from_FSM M q2'))"
       and p'': "(\<exists>p1 p2.
                   path (from_FSM M q1') (initial (from_FSM M q1')) p1 \<and>
                   path (from_FSM M q2') (initial (from_FSM M q2')) p2 \<and>
                   target p1 (initial (from_FSM M q1')) = fst (t_source t) \<and>
             target p2 (initial (from_FSM M q2')) = snd (t_source t) \<and> p_io p1 = p_io p2)"
    using product_transition_t[of t "from_FSM M q1'" "from_FSM M q2'"] \<open>t \<in> h ?P'\<close> by presburger+

  obtain p where "path ?P (initial ?P) p" and "target p (initial ?P) = (q1',q2')"
    by (metis assms path_to_node)
  have "path (from_FSM M q1) q1 (left_path p)"
       "path (from_FSM M q2) q2 (right_path p)"
       "(\<exists>p1 p2.
           path (from_FSM M q1) (initial (from_FSM M q1)) p1 \<and>
           path (from_FSM M q2) (initial (from_FSM M q2)) p2 \<and>
           target p1 (initial (from_FSM M q1)) = q1 \<and> target p2 (initial (from_FSM M q2)) = q2 \<and> p_io p1 = p_io p2)"
    using product_path[of "from_FSM M q1" "from_FSM M q2" q1 q2 p] \<open>path ?P (initial ?P) p\<close> by auto

  have "target (left_path p) q1 = q1'" and "target (right_path p) q2 = q2'"
    using product_target_split[of p q1 q2 q1' q2'] \<open>target p (initial ?P) = (q1',q2')\<close> by auto

  have "q1' \<in> nodes (from_FSM M q1)"
    using path_target_is_node[OF \<open>path (from_FSM M q1) q1 (left_path p)\<close>] \<open>target (left_path p) q1 = q1'\<close> by metis
  have "h (from_FSM M q1') \<subseteq> h (from_FSM M q1)"
    using from_FSM_h[OF \<open>q1' \<in> nodes (from_FSM M q1)\<close>] by simp
  then have *: "(fst (t_source t), t_input t, t_output t, fst (t_target t)) \<in> h (from_FSM M q1)"
    using \<open>(fst (t_source t), t_input t, t_output t, fst (t_target t)) \<in> h (from_FSM M q1')\<close> by blast

  have "q2' \<in> nodes (from_FSM M q2)"
    using path_target_is_node[OF \<open>path (from_FSM M q2) q2 (right_path p)\<close>] \<open>target (right_path p) q2 = q2'\<close> by metis
  have "h (from_FSM M q2') \<subseteq> h (from_FSM M q2)"
    using from_FSM_h[OF \<open>q2' \<in> nodes (from_FSM M q2)\<close>] by simp
  then have **: "(snd (t_source t), t_input t, t_output t, snd (t_target t)) \<in> h (from_FSM M q2)"
    using \<open>(snd (t_source t), t_input t, t_output t, snd (t_target t)) \<in> h (from_FSM M q2')\<close> by blast

  have ***: "(\<exists>p1 p2.
               path (from_FSM M q1) (initial (from_FSM M q1)) p1 \<and>
               path (from_FSM M q2) (initial (from_FSM M q2)) p2 \<and>
               target p1 (initial (from_FSM M q1)) = fst (t_source t) \<and>
               target p2 (initial (from_FSM M q2)) = snd (t_source t) \<and> p_io p1 = p_io p2)"
  proof -
    obtain p1' p2' where "path (from_FSM M q1') q1' p1'"
                     and "path (from_FSM M q2') q2' p2'"
                     and "target p1' q1' = fst (t_source t)"
                     and "target p2' q2' = snd (t_source t)"
                     and "p_io p1' = p_io p2'"
      using p'' by auto

    have "path (from_FSM M q1) q1' p1'"
      using from_FSM_path \<open>q1' \<in> nodes (from_FSM M q1)\<close> \<open>path (from_FSM M q1') q1' p1'\<close> by (metis from_from)
    have "path (from_FSM M q2) q2' p2'"
      using from_FSM_path \<open>q2' \<in> nodes (from_FSM M q2)\<close> \<open>path (from_FSM M q2') q2' p2'\<close> by (metis from_from)

    have "path (from_FSM M q1) (initial (from_FSM M q1)) ((left_path p)@p1')"
      using path_append[OF \<open>path (from_FSM M q1) q1 (left_path p)\<close>, of p1']  \<open>target (left_path p) q1 = q1'\<close> \<open>path (from_FSM M q1) q1' p1'\<close> by auto
    moreover have "path (from_FSM M q2) (initial (from_FSM M q2)) ((right_path p)@p2')"
      using path_append[OF \<open>path (from_FSM M q2) q2 (right_path p)\<close>, of p2']  \<open>target (right_path p) q2 = q2'\<close> \<open>path (from_FSM M q2) q2' p2'\<close> by auto
    moreover have "target ((left_path p)@p1') (initial (from_FSM M q1)) = fst (t_source t)"
      using path_target_append[OF \<open>target (left_path p) q1 = q1'\<close> \<open>target p1' q1' = fst (t_source t)\<close>] by auto
    moreover have "target ((right_path p)@p2') (initial (from_FSM M q2)) = snd (t_source t)"
      using path_target_append[OF \<open>target (right_path p) q2 = q2'\<close> \<open>target p2' q2' = snd (t_source t)\<close>] by auto
    moreover have "p_io ((left_path p)@p1') = p_io ((right_path p)@p2')"
      using \<open>p_io p1' = p_io p2'\<close> by auto
    ultimately show ?thesis by blast
  qed

  show "t \<in> h (product (from_FSM M q1) (from_FSM M q2))"
    using product_transition_t[of t "from_FSM M q1" "from_FSM M q2"] * ** *** by blast
qed

lemma product_from_path:
  assumes "(q1',q2') \<in> nodes (product (from_FSM M q1) (from_FSM M q2))"
      and "path (product (from_FSM M q1') (from_FSM M q2')) (q1',q2') p"
    shows "path (product (from_FSM M q1) (from_FSM M q2)) (q1',q2') p"
using h_subset_path[OF product_from_transition_subset[OF assms(1)] assms(2) assms(1)] by assumption

lemma product_from_path_previous :
  assumes "path (product (from_FSM M (fst (t_target t)))
                         (from_FSM M (snd (t_target t))))
                (t_target t) p"                                           (is "path ?Pt (t_target t) p")
      and "t \<in> h (product (from_FSM M q1) (from_FSM M q2))"
    shows "path (product (from_FSM M q1) (from_FSM M q2)) (t_target t) p" (is "path ?P (t_target t) p")
proof -
  have *: "(t_target t) \<in> nodes (product (from_FSM M q1) (from_FSM M q2))"
    using wf_transition_target[OF assms(2)] by (metis)
  then have **: "(fst (t_target t), snd (t_target t)) \<in> nodes (product (from_FSM M q1) (from_FSM M q2))"
    by (metis prod.collapse)
  have ***: "h ?Pt \<subseteq> h ?P"
    using product_from_transition_subset[OF **] by assumption
  show ?thesis
    using h_subset_path[OF *** assms(1) *] by assumption
qed

lemma product_from_transition_shared_node :
  assumes "t \<in> h (product (from_FSM M q1') (from_FSM M q2'))"
  and  "(q1',q2') \<in> nodes (product (from_FSM M q1) (from_FSM M q2))"
shows "t \<in> h (product (from_FSM M q1) (from_FSM M q2))"
  by (meson assms(1) assms(2) contra_subsetD product_from_transition_subset)

lemma product_from_not_completely_specified :
  assumes "\<not> completely_specified_state (product (from_FSM M q1) (from_FSM M q2)) (q1',q2')"
      and "(q1',q2') \<in> nodes (product (from_FSM M q1) (from_FSM M q2))"
    shows  "\<not> completely_specified_state (product (from_FSM M q1') (from_FSM M q2')) (q1',q2')"
  using assms(1) assms(2) from_FSM_product_inputs[of M q1 q2] from_FSM_product_inputs[of M q1' q2'] product_from_transition_shared_node[OF _ assms(2)]
  unfolding completely_specified_state.simps by metis

lemma from_product_initial_paths_ex :
  "(\<exists>p1 p2.
         path (from_FSM M q1) (initial (from_FSM M q1)) p1 \<and>
         path (from_FSM M q2) (initial (from_FSM M q2)) p2 \<and>
         target p1 (initial (from_FSM M q1)) = q1 \<and>
         target p2 (initial (from_FSM M q2)) = q2 \<and> p_io p1 = p_io p2)"
proof -
  have "path (from_FSM M q1) (initial (from_FSM M q1)) []" by blast
  moreover have "path (from_FSM M q2) (initial (from_FSM M q2)) []" by blast
  moreover have "
         target [] (initial (from_FSM M q1)) = q1 \<and>
         target [] (initial (from_FSM M q2)) = q2 \<and> p_io [] = p_io []" by auto
  ultimately show ?thesis by blast
qed

(* TODO: move *)
lemma product_observable :
  assumes "observable M1"
  and     "observable M2"
shows "observable (product M1 M2)" (is "observable ?P")
proof -
  have "\<And> t1 t2 . t1 \<in> h ?P \<Longrightarrow> t2 \<in> h ?P \<Longrightarrow> t_source t1 = t_source t2 \<Longrightarrow> t_input t1 = t_input t2 \<Longrightarrow> t_output t1 = t_output t2 \<Longrightarrow> t_target t1 = t_target t2"
  proof -
    fix t1 t2 assume "t1 \<in> h ?P" and "t2 \<in> h ?P" and "t_source t1 = t_source t2" and "t_input t1 = t_input t2" and "t_output t1 = t_output t2"

    let ?t1L = "(fst (t_source t1), t_input t1, t_output t1, fst (t_target t1))"
    let ?t1R = "(snd (t_source t1), t_input t1, t_output t1, snd (t_target t1))"
    let ?t2L = "(fst (t_source t2), t_input t2, t_output t2, fst (t_target t2))"
    let ?t2R = "(snd (t_source t2), t_input t2, t_output t2, snd (t_target t2))"

    have "t_target ?t1L = t_target ?t2L"
      using product_transition_split(1)[OF \<open>t1 \<in> h ?P\<close>]
            product_transition_split(1)[OF \<open>t2 \<in> h ?P\<close>]
            \<open>observable M1\<close>
            \<open>t_source t1 = t_source t2\<close>
            \<open>t_input t1 = t_input t2\<close>
            \<open>t_output t1 = t_output t2\<close> by auto
    moreover have "t_target ?t1R = t_target ?t2R"
      using product_transition_split(2)[OF \<open>t1 \<in> h ?P\<close>]
            product_transition_split(2)[OF \<open>t2 \<in> h ?P\<close>]
            \<open>observable M2\<close>
            \<open>t_source t1 = t_source t2\<close>
            \<open>t_input t1 = t_input t2\<close>
            \<open>t_output t1 = t_output t2\<close> by auto
    ultimately show "t_target t1 = t_target t2"
      by (metis prod.exhaust_sel snd_conv)
  qed
  then show ?thesis unfolding observable.simps by blast
qed

lemma product_observable_self_transitions :
  assumes "q \<in> nodes (product M M)"
  and     "observable M"
shows "fst q = snd q"
proof -
  let ?P = "product M M"

  have "\<And> p . path ?P (initial ?P) p \<Longrightarrow> fst (target p (initial ?P)) = snd (target p (initial ?P))"
  proof -
    fix p assume "path ?P (initial ?P) p"
    then show "fst (target p (initial ?P)) = snd (target p (initial ?P))"
    proof (induction p rule: rev_induct)
      case Nil
      then show ?case
        by (metis append.right_neutral path_append_target path_nil_elim path_to_node product_simps(1) snd_swap swap_simp)
    next
      case (snoc t p)

      have "path ?P (initial ?P) p" and "path ?P (target p (initial ?P)) [t]"
        using path_append_elim[of ?P "initial ?P" p "[t]", OF \<open>path (product M M) (initial (product M M)) (p @ [t])\<close>] by blast+
      then have "t \<in> h ?P"
        by blast
      have "t_source t = target p (initial ?P)"
        by (metis \<open>path (product M M) (target p (initial (product M M))) [t]\<close> list.distinct(1) list.sel(1) path.simps)

      let ?t1 = "(fst (t_source t), t_input t, t_output t, fst (t_target t))"
      let ?t2 = "(snd (t_source t), t_input t, t_output t, snd (t_target t))"
      have "?t1 \<in> h M" and "?t2 \<in> h M"
        using product_transition_split[OF \<open>t \<in> h ?P\<close>] by auto
      moreover have "t_source ?t1 = t_source ?t2"
        using \<open>t_source t = target p (initial ?P)\<close> snoc.IH[OF \<open>path ?P (initial ?P) p\<close>]
        by (metis fst_conv)
      moreover have "t_input ?t1 = t_input ?t2"
        by auto
      moreover have "t_output ?t1 = t_output ?t2"
        by auto
      ultimately have "t_target ?t1 = t_target ?t2"
        using \<open>observable M\<close> unfolding observable.simps by blast
      then have "fst (t_target t) = snd (t_target t)"
        by auto
      then show ?case unfolding target.simps visited_states.simps
      proof -
        show "fst (last (initial (product M M) # map t_target (p @ [t]))) = snd (last (initial (product M M) # map t_target (p @ [t])))"
          using \<open>fst (t_target t) = snd (t_target t)\<close> last_map last_snoc length_append_singleton length_map by force
      qed
    qed
  qed

  then show ?thesis
    by (metis assms(1) path_to_node)
qed

lemma zip_path_eq_left :
  assumes "length xs1 = length xs2"
  and     "length xs2 = length ys1"
  and     "length ys1 = length ys2"
  and     "zip_path xs1 xs2 = zip_path ys1 ys2"
shows "xs1 = ys1"
  using assms by (induction xs1 xs2 ys1 ys2 rule: list_induct4; auto)

lemma zip_path_eq_right :
  assumes "length xs1 = length xs2"
  and     "length xs2 = length ys1"
  and     "length ys1 = length ys2"
  and     "p_io xs2 = p_io ys2"
  and     "zip_path xs1 xs2 = zip_path ys1 ys2"
shows "xs2 = ys2"
  using assms by (induction xs1 xs2 ys1 ys2 rule: list_induct4; auto)

(* TODO: check *)
declare from_FSM.simps[simp del]
declare product.simps[simp del]
declare from_FSM_simps[simp del]
declare product_simps[simp del]

lemma zip_path_merge :
  "(zip_path (left_path p) (right_path p)) = p"
  by (induction p; auto)

lemma product_from_path' :
  assumes "path (product (from_FSM M q1) (from_FSM M q2)) (q1', q2') p"
shows "path (product (from_FSM M q1') (from_FSM M q2')) (q1', q2') p"
  using assms proof (induction p rule: rev_induct)
  case Nil
  show ?case using product_simps(1) from_FSM_simps(1) nodes.initial
    by (metis nil)
next
  case (snoc t p)

  let ?P' = "(product (from_FSM M q1') (from_FSM M q2'))"

  have "path (from_FSM M q1) q1' (left_path (p@[t]))"
       "path (from_FSM M q2) q2' (right_path (p@[t]))"
    using snoc.prems product_path[of "(from_FSM M q1)" "(from_FSM M q2)" q1' q2' "p@[t]"] by simp+

  have "path (from_FSM M q1') (initial (from_FSM M q1'))  (left_path (p@[t]))"
    using from_FSM_path_rev_initial[OF \<open>path (from_FSM M q1) q1' (left_path (p@[t]))\<close>] by (simp add: from_FSM_simps)
  moreover have "path (from_FSM M q2') (initial (from_FSM M q2')) (right_path (p@[t]))"
    using from_FSM_path_rev_initial[OF \<open>path (from_FSM M q2) q2' (right_path (p@[t]))\<close>] by (simp add: from_FSM_simps)
  moreover have "p_io (left_path (p@[t])) = p_io (right_path (p@[t]))"
    by auto
  ultimately have "path ?P' (initial ?P') (zip_path (left_path (p@[t])) (right_path (p@[t])))"
    using product_path_from_paths(1) by blast
  then show "path ?P' (q1',q2') (p@[t])"
    by (simp add: product_simps(1) from_FSM_simps(1) zip_path_merge)
qed

lemma from_product_from_h :
  assumes "(q1',q2') \<in> nodes (product (from_FSM M q1) (from_FSM M q2))"
shows "h (product (from_FSM M q1') (from_FSM M q2')) = h (from_FSM (product (from_FSM M q1) (from_FSM M q2)) (q1',q2'))"
      (is "h ?P' = h ?Pf")
proof -
  let ?P = "(product (from_FSM M q1) (from_FSM M q2))"

  have "\<And> t . t \<in> h ?P' \<Longrightarrow> t \<in> h ?Pf"
  proof -
    fix t assume "t \<in> h ?P'"
    then have "t_source t \<in> nodes ?P'" by auto
    then obtain p where "path ?P' (q1',q2') p" and "target p (q1',q2') = t_source t"
      using product_simps(1) from_FSM_simps(1)
      by (metis path_to_node)
    then have "path ?P' (q1',q2') (p@[t])"
      using \<open>t \<in> h ?P'\<close> \<open>t_source t \<in> nodes ?P'\<close> by auto
    then have "path ?P (q1',q2') (p@[t])"
      using product_from_path[OF assms] by auto
    then have "path ?Pf (q1',q2') (p@[t])"
      by (simp add: from_FSM_path_rev_initial)
    then show "t \<in> h ?Pf"
      by auto
  qed
  moreover have "\<And> t . t \<in> h ?Pf \<Longrightarrow> t \<in> h ?P'"
  proof -
    fix t assume "t \<in> h ?Pf"
    then have "t_source t \<in> nodes ?Pf" by auto
    then obtain p where "path ?Pf (q1',q2') p" and "target p (q1',q2') = t_source t"
      using from_FSM_simps(1)
      by (metis path_to_node)
    then have "path ?Pf (q1',q2') (p@[t])"
      using \<open>t \<in> h ?Pf\<close> \<open>t_source t \<in> nodes ?Pf\<close> by auto
    then have "path ?P (q1',q2') (p@[t])"
      by (meson assms from_FSM_path)
    then have "path ?P' (q1',q2') (p@[t])"
      using product_from_path' by metis
    then show "t \<in> h ?P'"
      by auto
  qed
  ultimately show ?thesis by blast
qed

lemma product_deadlock :
  assumes "\<not> (\<exists> t \<in> h (product (from_FSM M q1) (from_FSM M q2)).
               t_source t = qq \<and> t_input t = x)"
  and "qq \<in> nodes (product (from_FSM M q1) (from_FSM M q2))"
  and "x \<in> set (inputs M)"
shows "\<not> (\<exists> t1 \<in> h M. \<exists> t2 \<in> h M.
                 t_source t1 = fst qq \<and>
                 t_source t2 = snd qq \<and>
                 t_input t1 = x \<and> t_input t2 = x \<and> t_output t1 = t_output t2)"
proof
  assume "\<exists> t1 \<in> h M. \<exists> t2 \<in> h M.
                 t_source t1 = fst qq \<and>
                 t_source t2 = snd qq \<and>
                 t_input t1 = x \<and> t_input t2 = x \<and> t_output t1 = t_output t2"
  then obtain t1 t2 where "t1 \<in> h M"
                      and "t2 \<in> h M"
                      and "t_source t1 = fst qq"
                      and "t_source t2 = snd qq"
                      and "t_input t1 = x"
                      and "t_input t2 = x"
                      and "t_output t1 = t_output t2"
    by blast

  have "fst qq \<in> nodes (from_FSM M q1)" and "snd qq \<in> nodes (from_FSM M q2)"
    using product_nodes assms(2)
    by fastforce+

  have "t_source t1 \<in> nodes (from_FSM M q1)"
    using \<open>fst qq \<in> nodes (from_FSM M q1)\<close> \<open>t_source t1 = fst qq\<close> by simp
  then have *: "(fst qq, x, t_output t1, t_target t1) \<in> h (from_FSM M q1)"
    using from_FSM_nodes_transitions[OF \<open>t1 \<in> h M\<close>] \<open>t_input t1 = x\<close> \<open>t_source t1 = fst qq\<close>
    by (metis prod.collapse)

  have "t_source t2 \<in> nodes (from_FSM M q2)"
    using \<open>snd qq \<in> nodes (from_FSM M q2)\<close> \<open>t_source t2 = snd qq\<close> by simp
  have **: "(snd qq, x, t_output t1, t_target t2) \<in> h (from_FSM M q2)"
    using from_FSM_nodes_transitions[OF \<open>t2 \<in> h M\<close> \<open>t_source t2 \<in> nodes (from_FSM M q2)\<close>] \<open>t_source t2 = snd qq\<close> \<open>t_input t1 = x\<close> \<open>t_input t2 = x\<close> \<open>t_source t2 = snd qq\<close> \<open>t_output t1 = t_output t2\<close>
    by (metis prod.collapse)

  have ***: "(\<exists>p1 p2.
        path (from_FSM M q1) (initial (from_FSM M q1)) p1 \<and>
        path (from_FSM M q2) (initial (from_FSM M q2)) p2 \<and>
        target p1 (initial (from_FSM M q1)) = fst qq \<and>
        target p2 (initial (from_FSM M q2)) = snd qq \<and> p_io p1 = p_io p2)"
    using assms(2) product_node_from_path[of "fst qq" "snd qq" "from_FSM M q1" "from_FSM M q2"]
          prod.collapse[of qq]
    by auto

  have "(qq, x, t_output t1, (t_target t1, t_target t2)) \<in> h (product (from_FSM M q1) (from_FSM M q2))"
    using product_transition[of "fst qq" "snd qq" "x" "t_output t1" "t_target t1" "t_target t2" "from_FSM M q1" "from_FSM M q2"]
    using * ** *** prod.collapse[of qq] by auto
  moreover have "t_source (qq, x, t_output t1, (t_target t1, t_target t2)) = qq"
            and "t_input (qq, x, t_output t1, (t_target t1, t_target t2)) = x"
    by auto
  ultimately show "False"
    using assms(1) by blast
qed

(* TODO: check *)
declare from_FSM.simps[simp]
declare product.simps[simp]
declare from_FSM_simps[simp]
declare product_simps[simp]

end


(*  Title:     HOL/Inequalities.thy
    Author:    Tobias Nipkow
    Author:    Johannes Hölzl
*)

theory Inequalities
  imports Real_Vector_Spaces
begin

lemma Chebyshev_sum_upper:
  fixes a b::"nat \<Rightarrow> 'a::linordered_idom"
  assumes "\<And>i j. i \<le> j \<Longrightarrow> j < n \<Longrightarrow> a i \<le> a j"
  assumes "\<And>i j. i \<le> j \<Longrightarrow> j < n \<Longrightarrow> b i \<ge> b j"
  shows "of_nat n * (\<Sum>k=0..<n. a k * b k) \<le> (\<Sum>k=0..<n. a k) * (\<Sum>k=0..<n. b k)"
proof -
  let ?S = "(\<Sum>j=0..<n. (\<Sum>k=0..<n. (a j - a k) * (b j - b k)))"
  have "2 * (of_nat n * (\<Sum>j=0..<n. (a j * b j)) - (\<Sum>j=0..<n. b j) * (\<Sum>k=0..<n. a k)) = ?S"
    by (simp only: one_add_one[symmetric] algebra_simps)
      (simp add: algebra_simps sum_subtractf sum.distrib sum.swap[of "\<lambda>i j. a i * b j"] sum_distrib_left)
  also
  { fix i j::nat assume "i<n" "j<n"
    hence "a i - a j \<le> 0 \<and> b i - b j \<ge> 0 \<or> a i - a j \<ge> 0 \<and> b i - b j \<le> 0"
      using assms by (cases "i \<le> j") (auto simp: algebra_simps)
  } then have "?S \<le> 0"
    by (auto intro!: sum_nonpos simp: mult_le_0_iff)
  finally show ?thesis by (simp add: algebra_simps)
qed

lemma Chebyshev_sum_upper_nat:
  fixes a b :: "nat \<Rightarrow> nat"
  shows "(\<And>i j. \<lbrakk> i\<le>j; j<n \<rbrakk> \<Longrightarrow> a i \<le> a j) \<Longrightarrow>
         (\<And>i j. \<lbrakk> i\<le>j; j<n \<rbrakk> \<Longrightarrow> b i \<ge> b j) \<Longrightarrow>
    n * (\<Sum>i=0..<n. a i * b i) \<le> (\<Sum>i=0..<n. a i) * (\<Sum>i=0..<n. b i)"
using Chebyshev_sum_upper[where 'a=real, of n a b]
by (simp del: of_nat_mult of_nat_sum  add: of_nat_mult[symmetric] of_nat_sum[symmetric])

end