Theory Coupled_Simulation

section ‹Coupled Simulation›

theory Coupled_Simulation
  imports Contrasimulation
begin

context lts_tau
begin

subsection ‹Van Glabbeeks's Coupled Simulation›
  
text ‹We mainly use van Glabbeek's coupled simulation from his 2017 CSP paper cite "glabbeek2017"›.
  Later on, we will compare it to other definitions of coupled (delay/weak) simulations.›

definition coupled_simulation ::
  ('s  's  bool)  bool
where
  coupled_simulation R    p q . 
    R p q  
      ( p' a. p a p'  
        ( q'. R p' q'  q ⇒^a q')) 
      ( q'. q ⟼*tau q'  R q' p)

abbreviation coupled_simulated_by :: 's  's  bool ("_ ⊑cs  _" [60, 60] 65)
  where coupled_simulated_by p q   R . coupled_simulation R  R p q
    
abbreviation coupled_similar :: 's  's  bool ("_ ≡cs  _" [60, 60] 65)
  where coupled_similar p q  p ⊑cs q  q ⊑cs p

text ‹We call ⊑cs› "coupled simulation preorder" and ≡cs› coupled similarity.›

subsection ‹Position between Weak Simulation and Weak Bisimulation›

text ‹Coupled simulations are special weak simulations, and symmetric weak bisimulations also
  are coupled simulations.›

lemma coupled_simulation_weak_simulation:
  coupled_simulation R =
    (weak_simulation R  ( p q . R p q  ( q'. q ⟼*tau q'  R q' p)))
  unfolding coupled_simulation_def weak_simulation_def by blast

corollary coupled_simulation_implies_weak_simulation:
  assumes coupled_simulation R
  shows weak_simulation R
  using assms unfolding coupled_simulation_weak_simulation ..

corollary coupledsim_enabled_subs:
  assumes
    p ⊑cs q
    weak_enabled p a
    ¬ tau a
  shows weak_enabled q a
  using assms weak_sim_enabled_subs coupled_simulation_implies_weak_simulation by blast

lemma coupled_simulation_implies_coupling:
  assumes
    coupled_simulation R
    R p q
  shows
     q'. q ⟼*tau q'  R q' p
  using assms unfolding coupled_simulation_weak_simulation by blast

lemma weak_bisim_implies_coupled_sim_gla17:
  assumes
    wbisim:   weak_bisimulation R and
    symmetry:  p q . R p q  R q p
    ―‹symmetry is needed here, which is alright because bisimilarity is symmetric.›
  shows coupled_simulation R
unfolding coupled_simulation_def proof safe
  fix p q p' a
  assume R p q p a  p'
  thus q'. R p' q'  (q ⇒^a  q')
    using wbisim unfolding weak_bisimulation_def by simp
next
  fix p q 
  assume R p q
  thus q'. q ⟼* tau  q'  R q' p 
    using symmetry steps.refl[of q tau] by auto
qed

subsection ‹Coupled Simulation and Silent Steps›

text ‹Coupled simulation shares important patterns with weak simulation when it comes to the
  treatment of silent steps.›

lemma coupledsim_step_gla17:
  coupled_simulation (λ p1 q1 . q1 ⟼* tau p1)
  unfolding coupled_simulation_def
  using lts.steps.simps by metis

corollary coupledsim_step:
  assumes
    p ⟼* tau  q
  shows
    q ⊑cs p
  using assms coupledsim_step_gla17 by auto

text ‹A direct implication of this is that states on a tau loop are coupled similar.›
corollary strongly_tau_connected_coupled_similar:
  assumes
    p ⟼* tau  q
    q ⟼* tau  p
  shows p ≡cs q
  using assms coupledsim_step by auto

lemma silent_steps_retain_coupled_simulation:
assumes 
  coupled_simulation R
  R p q
  p ⟼* A  p'
  A = tau
shows  q' . q ⟼* A q'  R p' q'
  using assms(1,3,2,4) steps_retain_weak_sim
  unfolding coupled_simulation_weak_simulation by blast

lemma coupled_simulation_weak_premise:
  coupled_simulation R =
   ( p q . R p q 
      ( p' a. p ⇒^a p' 
        ( q'. R p' q'  q ⇒^a q')) 
      ( q'. q ⟼*tau q'  R q' p))
  unfolding coupled_simulation_weak_simulation weak_sim_weak_premise by blast

subsection ‹Closure, Preorder and Symmetry Properties›

text ‹The coupled simulation preorder ⊑cs› @{emph ‹is›} a preoder and symmetric at the
  stable states.›

lemma coupledsim_union:
  assumes
    coupled_simulation R1
    coupled_simulation R2
  shows
    coupled_simulation (λ p q . R1 p q  R2 p q)
  using assms unfolding coupled_simulation_def by (blast)  
  
lemma coupledsim_refl:
  p ⊑cs p
  using coupledsim_step steps.refl by auto
    
lemma coupledsim_trans:
  assumes
    p ⊑cs pq
    pq ⊑cs q
  shows
    p ⊑cs q
proof -
  obtain R1 where R1_def: coupled_simulation R1 R1 p pq
    using assms(1) by blast
  obtain R2 where R2_def: coupled_simulation R2 R2 pq q
    using assms(2) by blast
  define R where R_def: R  λ p q .  pq . (R1 p pq  R2 pq q)  (R2 p pq  R1 pq q)
  have weak_simulation R R p q
    using weak_sim_trans_constructive
      R1_def(2) R2_def(2)
      coupled_simulation_implies_weak_simulation[OF R1_def(1)]
      coupled_simulation_implies_weak_simulation[OF R2_def(1)] 
    unfolding R_def by auto
  moreover have ( p q . R p q  ( q'. q ⟼*tau q'  R q' p))
    unfolding R_def
  proof safe
    fix p q pq
    assume r1r2: R1 p pq R2 pq q
    then obtain pq' where R1 pq' p pq ⟼* tau  pq'
      using r1r2 R1_def(1) unfolding coupled_simulation_weak_premise by blast
    then moreover obtain q' where R2 pq' q' q ⟼* tau q'
      using r1r2 R2_def(1) weak_step_tau_tau[OF `pq ⟼* tau  pq'`] tau_tau
      unfolding coupled_simulation_weak_premise by blast
    then moreover obtain q'' where R2 q'' pq' q' ⟼* tau  q''
      using R2_def(1) unfolding coupled_simulation_weak_premise by blast
    ultimately show q'. q ⟼* tau  q'  (pq. R1 q' pq  R2 pq p  R2 q' pq  R1 pq p)
      using steps_concat by blast
  next ―‹analogous with R2 and R1 swapped›
    fix p q pq
    assume r2r1: R2 p pq R1 pq q
    then obtain pq' where R2 pq' p pq ⟼* tau  pq'
      using r2r1 R2_def(1) unfolding coupled_simulation_weak_premise by blast
    then moreover obtain q' where R1 pq' q' q ⟼* tau q'
      using r2r1 R1_def(1) weak_step_tau_tau[OF `pq ⟼* tau  pq'`] tau_tau
      unfolding coupled_simulation_weak_premise by blast
    then moreover obtain q'' where R1 q'' pq' q' ⟼* tau  q''
      using R1_def(1) unfolding coupled_simulation_weak_premise by blast
    ultimately show q'. q ⟼* tau  q'  (pq. R1 q' pq  R2 pq p  R2 q' pq  R1 pq p)
      using steps_concat by blast
  qed
  ultimately have R p q coupled_simulation R
    using coupled_simulation_weak_simulation by auto
  thus ?thesis by blast
qed

interpretation preorder λ p q. p ⊑cs q λ p q. p ⊑cs q  ¬(q ⊑cs p)
  by (standard, blast, fact coupledsim_refl, fact coupledsim_trans)

lemma coupled_similarity_equivalence:
  equivp (λ p q. p ≡cs q)
proof (rule equivpI)
  show reflp coupled_similar
    unfolding reflp_def by blast
next
  show symp coupled_similar
    unfolding symp_def by blast
next
  show transp coupled_similar
    unfolding transp_def using coupledsim_trans by meson
qed

lemma coupledsim_tau_max_eq:
  assumes
    p ⊑cs q
    tau_max q
  shows  p ≡cs q 
  using assms using coupled_simulation_weak_simulation coupling_tau_max_symm by metis

corollary coupledsim_stable_eq:
  assumes
    p ⊑cs q
    stable_state q
  shows  p ≡cs q 
  using assms using coupled_simulation_weak_simulation coupling_stability_symm by metis

subsection ‹Coinductive Coupled Simulation Preorder›

text ⊑cs› can also be characterized coinductively. ⊑cs› is the greatest
  coupled simulation.›

coinductive greatest_coupled_simulation :: 's  's  bool
  where gcs:
     a p' . p a p'  q'. q ⇒^^ a q'  greatest_coupled_simulation p' q'; 
       q' . q ⟼* tau q'  greatest_coupled_simulation q' p
   greatest_coupled_simulation p q

lemma gcs_implies_gws:
  assumes greatest_coupled_simulation p q
  shows greatest_weak_simulation p q
  using assms by (metis greatest_coupled_simulation.cases greatest_weak_simulation.coinduct)

lemma gcs_is_coupled_simulation:
  shows coupled_simulation greatest_coupled_simulation
  unfolding coupled_simulation_def
proof safe
  ―‹identical to ws›
  fix p q p' a
  assume ih:
    greatest_coupled_simulation p q
    p a  p'
  hence (x xa. p x xa  (q'. q ⇒^^ x  q'  greatest_coupled_simulation xa q'))
    by (meson greatest_coupled_simulation.simps)
  then obtain q' where q ⇒^^ a  q'  greatest_coupled_simulation p' q' using ih by blast
  thus q'. greatest_coupled_simulation p' q'  q ⇒^a  q'
    unfolding weak_step_tau2_def by blast
next
  fix p q
  assume
    greatest_coupled_simulation p q
  thus q'. q ⟼* tau  q'  greatest_coupled_simulation q' p
    by (meson greatest_coupled_simulation.simps)
qed

lemma coupled_similarity_implies_gcs:
  assumes p ⊑cs q
  shows greatest_coupled_simulation p q
  using assms
proof (coinduct)
  case (greatest_coupled_simulation p1 q1)
  then obtain R where coupled_simulation R R p1 q1
    weak_simulation R using coupled_simulation_implies_weak_simulation by blast
  then have (x xa. p1 x  xa 
          (q'. q1 ⇒^x  q'  (xa ⊑cs  q'  greatest_coupled_simulation xa q'))) 
        (q'. q1 ⟼* tau  q' 
          (q' ⊑cs  p1  greatest_coupled_simulation q' p1))
    unfolding weak_step_tau2_def
    using coupled_simulation_implies_coupling
       weak_sim_ruleformat[OF weak_simulation R]
    by (metis (no_types, lifting))
  thus ?case by simp
qed

lemma gcs_eq_coupled_sim_by:
  shows p ⊑cs q = greatest_coupled_simulation p q
  using coupled_similarity_implies_gcs gcs_is_coupled_simulation by blast

lemma coupled_sim_by_is_coupled_sim:
  shows
    coupled_simulation (λ p q . p ⊑cs q)
  unfolding gcs_eq_coupled_sim_by using gcs_is_coupled_simulation .

lemma coupledsim_unfold:
  shows p ⊑cs q =
    ((a p'. p a  p'  (q'. q ⇒^a  q'  p' ⊑cs q')) 
       (q'. q ⟼* tau  q'  q' ⊑cs p))
  unfolding gcs_eq_coupled_sim_by weak_step_tau2_def[symmetric]
  by (metis lts_tau.greatest_coupled_simulation.simps)

subsection ‹Coupled Simulation Join›

text ‹The following lemmas reproduce Proposition 3 from cite glabbeek2017› that internal choice
  acts as a least upper bound within the semi-lattice of CSP terms related by ⊑cs› taking ≡cs›
  as equality.›

lemma coupledsim_choice_1:
  assumes 
    p ⊑cs q
     pq a . pqc a pq  (a = τ  (pq = p  pq = q))
  shows
    pqc ⊑cs q
    q ⊑cs pqc
proof -
  define R1 where R1  (λp1 q1. q1 ⟼* tau  p1)
  have R1 q pqc
    using assms(2) steps_one_step R1_def by simp
  moreover have coupled_simulation R1
    unfolding R1_def using coupledsim_step_gla17 .
  ultimately show q_pqc: q ⊑cs pqc by blast
―‹next case›
  define R where R  λ p0 q0 . p0 = q  q0 = pqc  p0 = pqc  q0 = q  p0 = p  q0 = q
  hence R pqc q by blast
  thus pqc ⊑cs  q
    unfolding gcs_eq_coupled_sim_by
  proof (coinduct)
    case (greatest_coupled_simulation p1 q1)
    then show ?case
      unfolding weak_step_tau2_def R_def
    proof safe
      assume q1 = pqc p1 = q
      thus pa qa.
        q = pa  pqc = qa 
        (x xa. pa x  xa 
          (q'. qa ⇒^x  q'  ((xa = q  q' = pqc  xa = pqc  q' = q  xa = p  q' = q)
             greatest_coupled_simulation xa q'))) 
        (q'. qa ⟼* tau  q' 
            ((q' = q  pa = pqc  q' = pqc  pa = q  q' = p  pa = q)
             greatest_coupled_simulation q' pa))
        using `q ⊑cs pqc` step_tau_refl weak_sim_ruleformat tau_def
          coupled_simulation_implies_weak_simulation[OF gcs_is_coupled_simulation] 
        unfolding gcs_eq_coupled_sim_by by fastforce
    next
      assume q1 = q p1 = pqc
      thus pa qa.
        pqc = pa  q = qa 
        (x xa. pa x  xa 
          (q'. qa ⇒^x  q'  ((xa = q  q' = pqc  xa = pqc  q' = q  xa = p  q' = q)
             greatest_coupled_simulation xa q'))) 
        (q'. qa ⟼* tau  q' 
          ((q' = q  pa = pqc  q' = pqc  pa = q  q' = p  pa = q)
             greatest_coupled_simulation q' pa))
        using R1_def coupled_simulation R1 assms(2)
          coupled_similarity_implies_gcs step_tau_refl by fastforce
    next
      assume q1 = q p1 = p
      thus pa qa.
       p = pa  q = qa 
       (x xa. pa x  xa  (q'. qa ⇒^x  q'  ((xa = q  q' = pqc  xa = pqc  q' = q  xa = p  q' = q)  greatest_coupled_simulation xa q'))) 
       (q'. qa ⟼* tau  q'  ((q' = q  pa = pqc  q' = pqc  pa = q  q' = p  pa = q)  greatest_coupled_simulation q' pa))
        using `p ⊑cs q` weak_sim_ruleformat
          coupled_simulation_implies_weak_simulation[OF gcs_is_coupled_simulation]
          coupled_simulation_implies_coupling[OF gcs_is_coupled_simulation]
        unfolding gcs_eq_coupled_sim_by
        by (auto, metis+)
    qed
  qed
qed

lemma coupledsim_choice_2:
  assumes 
    pqc ⊑cs q 
     pq a . pqc a pq  (a = τ  (pq = p  pq = q))
  shows
    p ⊑cs q
proof -
  have pqc τ p using assms(2) by blast
  then obtain q' where q ⟼* tau q' p ⊑cs q'
    using assms(1) tau_tau unfolding coupled_simulation_def by blast
  then moreover have q' ⊑cs q using coupledsim_step_gla17 by blast
  ultimately show ?thesis using coupledsim_trans tau_tau by blast
qed

lemma coupledsim_choice_join:
  assumes 
     pq a . pqc a pq  (a = τ  (pq = p  pq = q))
  shows
    p ⊑cs q  pqc ≡cs q
  using  coupledsim_choice_1[OF _ assms] coupledsim_choice_2[OF _ assms] by blast

subsection ‹Coupled Delay Simulation›

text ⊑cs› can also be characterized in terms of coupled delay simulations, which are
 conceptionally simpler than van Glabbeek's coupled simulation definition.›

text ‹In the greatest coupled simulation, τ›-challenges can be answered by stuttering.›
lemma coupledsim_tau_challenge_trivial:
  assumes 
    p ⊑cs q
    p ⟼* tau p'
  shows
    p' ⊑cs q
  using assms coupledsim_trans coupledsim_step by blast

lemma coupled_similarity_s_delay_simulation:
  delay_simulation (λ p q. p ⊑cs q)
  unfolding delay_simulation_def
proof safe
  fix p q R p' a
  assume assms:
    coupled_simulation R
    R p q
    p a p'
  {
    assume tau a
    then show p' ⊑cs  q
      using assms coupledsim_tau_challenge_trivial steps_one_step by blast
  } {
    show q'. p' ⊑cs  q'  q =⊳a  q'
    proof -
      obtain q''' where q'''_spec: q ⇒^a q''' p' ⊑cs q'''
        using assms coupled_simulation_implies_weak_simulation weak_sim_ruleformat by metis
      show ?thesis
      proof (cases tau a)
        case True
        then have q ⟼* tau q''' using q'''_spec by blast
        thus ?thesis using q'''_spec(2) True assms(1) steps.refl by blast
      next
        case False
        then obtain q' q'' where q'q''_spec:
            q ⟼* tau q' q' a q'' q'' ⟼* tau q'''
          using q'''_spec by blast
        hence q''' ⊑cs q'' using coupledsim_step by blast
        hence p' ⊑cs q'' using q'''_spec(2) coupledsim_trans by blast
        thus ?thesis using q'q''_spec(1,2) False by blast
      qed
    qed
  }
qed

definition coupled_delay_simulation ::
  ('s  's  bool)  bool
  where
  coupled_delay_simulation R  
    delay_simulation R  coupling R

lemma coupled_sim_by_eq_coupled_delay_simulation:
  (p ⊑cs q) = (R. R p q  coupled_delay_simulation R)
  unfolding coupled_delay_simulation_def
proof
  assume p ⊑cs q
  define R where R  coupled_simulated_by
  hence R p q  delay_simulation R  coupling R
    using coupled_similarity_s_delay_simulation coupled_sim_by_is_coupled_sim
        coupled_simulation_implies_coupling p ⊑cs q by blast
  thus R. R p q  delay_simulation R  coupling R by blast
next
  assume R. R p q  delay_simulation R  coupling R
  then obtain R where R p q delay_simulation R coupling R by blast
  hence coupled_simulation R
    using delay_simulation_implies_weak_simulation coupled_simulation_weak_simulation by blast
  thus p ⊑cs q using R p q by blast
qed

subsection ‹Relationship to Contrasimulation and Weak Simulation›

text ‹Coupled simulation is precisely the intersection of contrasimulation and weak simulation.›

lemma weak_sim_and_contrasim_implies_coupled_sim:
  assumes
    contrasimulation R
    weak_simulation R
  shows
    coupled_simulation R
  unfolding coupled_simulation_weak_simulation
  using contrasim_coupled assms by blast

lemma coupledsim_implies_contrasim:
  assumes
    coupled_simulation R
  shows 
    contrasimulation R
proof -
  have contrasim_step R
  unfolding contrasim_step_def
  proof (rule allI impI)+
    fix p q p' a
    assume
      R p q  p ⇒^a  p'
    then obtain q' where q'_def: R p' q' q ⇒^a  q'
      using assms unfolding coupled_simulation_weak_premise by blast
    then obtain q'' where q''_def: R q'' p' q' ⟼* tau  q''
      using assms unfolding coupled_simulation_weak_premise by blast
    then have q ⇒^a  q'' using q'_def(2) steps_concat by blast
    thus q'. q ⇒^a  q'  R q' p'
      using q''_def(1) by blast
  qed
  thus contrasimulation R using contrasim_step_seq_coincide_for_sims
      coupled_simulation_implies_weak_simulation[OF assms] by blast 
qed

lemma coupled_simulation_iff_weak_sim_and_contrasim:
  shows coupled_simulation R  contrasimulation R  weak_simulation R
  using weak_sim_and_contrasim_implies_coupled_sim
    coupledsim_implies_contrasim coupled_simulation_weak_simulation by blast

subsection τ›-Reachability (and Divergence)›

text ‹
  Coupled similarity comes close to (weak) bisimilarity in two respects:

   If there are no τ› transitions, coupled similarity coincides with bisimilarity.

   If there are only finite τ› reachable portions, then coupled similarity contains a
  bisimilarity on the τ›-maximal states. (For this,  τ›-cycles have to be ruled out, which, as
  we show, is no problem because their removal is transparent to coupled similarity.)
›

lemma taufree_coupledsim_symm:
  assumes
     p1 a p2 . (p1 a p2  ¬ tau a)
    coupled_simulation R
    R p q
  shows R q p
  using assms(1,3) coupledsim_implies_contrasim[OF assms(2)] contrasim_taufree_symm
  by blast

lemma taufree_coupledsim_weak_bisim:
  assumes
     p1 a p2 . (p1 a p2  ¬ tau a)
    coupled_simulation R
  shows weak_bisimulation R
  using assms contrasim_taufree_symm symm_contrasim_is_weak_bisim coupledsim_implies_contrasim[OF assms(2)]
  by blast

lemma coupledsim_stable_state_symm:
  assumes
    coupled_simulation R
    R p q
    stable_state q
  shows
    R q p
  using assms steps_left unfolding coupled_simulation_def by metis

text ‹In finite systems, coupling is guaranteed to happen through τ›-maximal states.›
lemma coupledsim_max_coupled:
  assumes 
    p ⊑cs q
     r1 r2 . r1 ⟼* tau r2  r2 ⟼* tau r1  r1 = r2 ―‹contracted tau cycles›
     r. finite {r'. r ⟼* tau r'}
  shows
     q' . q ⟼* tau q'  q' ⊑cs p  tau_max q'
proof -
  obtain q1 where q1_spec: q ⟼* tau q1 q1 ⊑cs p 
    using assms(1) coupled_simulation_implies_coupling coupledsim_implies_contrasim by blast
  then obtain q' where q1 ⟼* tau q' (q''. q' ⟼* tau q''  q' = q'')
    using tau_max_deadlock assms(2,3) by blast
  then moreover have q' ⊑cs p q ⟼* tau q'
    using q1_spec coupledsim_trans coupledsim_step steps_concat[of q1 tau q' q]
    by blast+
  ultimately show ?thesis by blast
qed

text ‹In the greatest coupled simulation, a›-challenges can be answered by a weak move without
  trailing τ›-steps. (This property is what bridges the gap between weak and delay simulation for 
  coupled simulation.)›
lemma coupledsim_step_challenge_short_answer:
  assumes 
    p ⊑cs q
    p a p'
    ¬ tau a
  shows
     q' q1. p' ⊑cs q'  q ⟼* tau q1  q1 a q'
  using assms
  unfolding coupled_sim_by_eq_coupled_delay_simulation
    coupled_delay_simulation_def delay_simulation_def by blast

text ‹If two states share the same outgoing edges with except for one τ›-loop, then they cannot
  be distinguished by coupled similarity.›
lemma coupledsim_tau_loop_ignorance:
  assumes
     a p'. p a p'  p' = pp  a = τ  pp a p'
  shows
    pp ≡cs p
proof -
  define R where R  λ p1 q1. p1 = q1  p1 = pp  q1 = p  p1 = p  q1 = pp
  have coupled_simulation R
    unfolding coupled_simulation_def R_def
  proof (safe)
    fix pa q p' a
    assume
      q a  p'
    thus q'. (p' = q'  p' = pp  q' = p  p' = p  q' = pp)  q ⇒^a  q'
      using assms step_weak_step_tau by auto
  next
    fix pa q
    show q'. q ⟼* tau  q'  (q' = q  q' = pp  q = p  q' = p  q = pp)
      using steps.refl by blast
  next
    fix pa q p' a
    assume
      pp a  p'
    thus q'. (p' = q'  p' = pp  q' = p  p' = p  q' = pp)  p ⇒^a  q'
      using assms by (metis lts.steps.simps tau_def)
  next
    fix pa q
    show q'. p ⟼* tau  q'  (q' = pp  q' = pp  pp = p  q' = p  pp = pp)
      using steps.refl[of p tau] by blast
  next
    fix pa q p' a
    assume
      p a  p'
    thus q'. (p' = q'  p' = pp  q' = p  p' = p  q' = pp)  pp ⇒^a  q'
      using assms step_weak_step_tau by fastforce
  next
    fix pa q
    show q'. pp ⟼* tau  q'  (q' = p  q' = pp  p = p  q' = p  p = pp)
      using steps.refl[of pp tau] by blast
  qed
  moreover have R p pp R pp p unfolding R_def by auto
  ultimately show ?thesis by blast
qed

subsection ‹On the Connection to Weak Bisimulation›

text ‹When one only considers steps leading to τ›-maximal states in a system without infinite
  τ›-reachable regions (e.g. a finite system), then ≡cs› on these steps is a bisimulation.›

text ‹This lemma yields a neat argument why one can use a signature refinement algorithm to
  pre-select the tuples which come into question for further checking of coupled simulation
  by contraposition.›
lemma coupledsim_eventual_symmetry:
  assumes
    contracted_cycles:  r1 r2 . r1 ⟼* tau r2  r2 ⟼* tau r1  r1 = r2 and
    finite_taus:  r. finite {r'. r ⟼* tau r'} and
    cs: p ⊑cs q and
    step: p ⇒^a p' and
    tau_max_p': tau_max p'
  shows
     q'. tau_max q'  q ⇒^a q'  p' ≡cs q'
proof-
  obtain q' where q'_spec: q ⇒^a q' p' ⊑cs q'
    using cs step unfolding coupled_simulation_weak_premise by blast
  then obtain q'' where q''_spec: q' ⟼* tau q'' q'' ⊑cs p'
    using cs unfolding coupled_simulation_weak_simulation by blast
  then obtain q_max where q_max_spec: q'' ⟼* tau q_max tau_max q_max 
    using tau_max_deadlock contracted_cycles finite_taus by force
  hence q_max ⊑cs p' using q''_spec coupledsim_tau_challenge_trivial by blast
  hence q_max ≡cs p' using tau_max_p' coupledsim_tau_max_eq by blast
  moreover have q ⇒^a q_max using q_max_spec q'_spec q''_spec steps_concat by blast
  ultimately show ?thesis using q_max_spec(2) by blast
qed

text ‹Even without the assumption that the left-hand-side step p ⇒^a p'› ends in a τ›-maximal state,
a situation resembling bismulation can be set up -- with the drawback that it only refers to
a τ›-maximal sibling of p'›.›
lemma coupledsim_eventuality_2:
  assumes
    contracted_cycles:  r1 r2 . r1 ⟼* tau r2  r2 ⟼* tau r1  r1 = r2 and
    finite_taus:  r. finite {r'. r ⟼* tau r'} and
    cbisim: p ≡cs q and
    step: p ⇒^a p'
  shows
     p'' q'. tau_max p''  tau_max q'  p ⇒^a p''  q ⇒^a q'  p'' ≡cs q'
proof-
  obtain q' where q'_spec: q ⇒^a q'
    using cbisim step unfolding coupled_simulation_weak_premise by blast
  then obtain q_max where q_max_spec: q' ⟼* tau q_max tau_max q_max
    using tau_max_deadlock contracted_cycles finite_taus by force
  hence q ⇒^a q_max using q'_spec steps_concat by blast
  then obtain p'' where p''_spec: p ⇒^a p'' q_max ⊑cs p''
    using cbisim unfolding coupled_simulation_weak_premise by blast
  then obtain p''' where p'''_spec: p'' ⟼* tau p''' p''' ⊑cs q_max
    using cbisim unfolding coupled_simulation_weak_simulation  by blast
  then obtain p_max where p_max_spec: p''' ⟼* tau p_max tau_max p_max
    using tau_max_deadlock contracted_cycles finite_taus by force
  hence p_max ⊑cs p''' using coupledsim_step by blast
  hence p_max ⊑cs q_max using p'''_spec coupledsim_trans by blast
  hence q_max ≡cs p_max using coupledsim_tau_max_eq q_max_spec by blast
  moreover have  p ⇒^a p_max
    using  p''_spec(1) steps_concat[OF p_max_spec(1) p'''_spec(1)] steps_concat by blast
  ultimately show ?thesis using p_max_spec(2) q_max_spec(2) `q ⇒^a q_max` by blast
qed

lemma coupledsim_eq_reducible_1:
  assumes
    contracted_cycles:  r1 r2 . r1 ⟼* tau r2  r2 ⟼* tau r1  r1 = r2 and
    finite_taus:  r. finite {r'. r ⟼* tau r'} and
    tau_shortcuts:
      r a r'. r ⟼* tau r'  r''. tau_max r''  r τ r''  r' ⊑cs r''  and
    sim_vis_p:
      p' a. ¬tau a  p ⇒^a p'  p'' q'. q ⇒^a q'  p' ⊑cs q' and
    sim_tau_max_p:
      p'. tau_max p'  p ⟼* tau p'  q'. tau_max q'  q ⟼* tau q'  p' ≡cs q'
  shows
    p ⊑cs q
proof-
  have
    ((a p'. p a  p'  (q'. q ⇒^a  q'  p' ⊑cs q')) 
    (q'. q ⟼* tau  q'  q' ⊑cs p))
  proof safe
    fix a p'
    assume
      step: p a  p'
    thus q'. q ⇒^a  q'  p' ⊑cs  q'
    proof (cases tau a)
      case True
      then obtain p'' where p''_spec: p τ p'' tau_max p'' p' ⊑cs p''
        using tau_shortcuts step tau_def steps_one_step[of p τ p']
        by (metis (no_types, lifting))
      then obtain q' where q'_spec: q ⟼* tau q' p'' ≡cs q'
        using sim_tau_max_p steps_one_step[OF step, of tau, OF `tau a`]
          steps_one_step[of p τ p''] tau_def
        by metis
      then show ?thesis using `tau a` p''_spec(3) using coupledsim_trans by blast
    next
      case False
      then show ?thesis using sim_vis_p step_weak_step_tau[OF step] by blast
    qed
  next
    obtain p_max where p ⟼* tau p_max tau_max p_max
      using tau_max_deadlock contracted_cycles finite_taus by blast
    then obtain q_max where q ⟼* tau  q_max q_max ⊑cs p_max
      using sim_tau_max_p[of p_max] by force
    moreover have p_max ⊑cs  p using `p ⟼* tau p_max` coupledsim_step by blast
    ultimately show q'. q ⟼* tau  q'  q' ⊑cs  p
      using coupledsim_trans by blast
  qed
  thus p ⊑cs q using coupledsim_unfold[symmetric] by auto
qed

lemma coupledsim_eq_reducible_2:
  assumes
    cs: p ⊑cs q and
    contracted_cycles: r1 r2 . r1 ⟼* tau r2  r2 ⟼* tau r1  r1 = r2 and
    finite_taus: r. finite {r'. r ⟼* tau r'}
  shows
    sim_vis_p:
      p' a. ¬tau a  p ⇒^a p'  q'. q ⇒^a q'  p' ⊑cs q' and
    sim_tau_max_p:
      p'. tau_max p'  p ⟼* tau p'  q'. tau_max q'  q ⟼* tau q'  p' ≡cs q'
proof-
  fix p' a
  assume
    ¬ tau a
    p ⇒^a  p'
  thus q'. q ⇒^a  q'  p' ⊑cs  q'
    using cs unfolding coupled_simulation_weak_premise by blast
next
  fix p'
  assume step:
    p ⟼* tau p'
    tau_max p'
  hence p ⇒^τ  p'  by auto
  hence  q'. tau_max q'  q ⇒^τ q'  p' ≡cs q'
    using coupledsim_eventual_symmetry[OF _ finite_taus, of p q τ p']
      contracted_cycles cs step(2) by blast
  thus  q'. tau_max q'  q ⟼* tau q'  p' ≡cs q'
    by auto
qed

subsection ‹Reduction Semantics Coupled Simulation›

text ‹The tradition to describe coupled simulation as special delay/weak simulation is quite
  common for coupled simulations on reduction semantics as in cite "gp15" and "Fournet2005"›,
  of which cite "gp15"› can also be found in the AFP cite "Encodability_Process_Calculi-AFP"›.
  The notions coincide (for systems just with τ›-transitions).›

definition coupled_simulation_gp15 ::
  ('s  's  bool)  bool
where
  coupled_simulation_gp15 R   p q p'. R p q  (p ⟼* (λa. True) p') 
    ( q'. (q ⟼* (λa. True) q')  R p' q') 
    ( q'. (q ⟼* (λa. True) q')  R q' p')

lemma weak_bisim_implies_coupled_sim_gp15:
  assumes
    wbisim: weak_bisimulation R and 
    symmetry:  p q . R p q  R q p
  shows coupled_simulation_gp15 R
unfolding coupled_simulation_gp15_def proof safe
  fix p q p'
  assume Rpq: R p q p ⟼* (λa. True)  p'
  have always_tau: a. tau a  (λa. True) a by simp
  hence q'. q ⟼* (λa. True)  q'  R p' q'
    using steps_retain_weak_bisim[OF wbisim Rpq] by auto
  moreover hence q'. q ⟼* (λa. True)  q'  R q' p'
    using symmetry by auto
  ultimately show
    (q'. q ⟼* (λa. True)  q'  R p' q')
    (q'. q ⟼* (λa. True)  q'  R q' p') .
qed

lemma coupledsim_gla17_implies_gp15:
  assumes
    coupled_simulation R
  shows 
    coupled_simulation_gp15 R
  unfolding coupled_simulation_gp15_def
proof safe
  fix p q p'
  assume challenge:
    R p q
    p ⟼*(λa. True)p'
  have tau_true: a. tau a  (λa. True) a by simp
  thus q'. q ⟼* (λa. True)  q'  R p' q'
    using steps_retain_weak_sim assms challenge
    unfolding coupled_simulation_weak_simulation by meson
  then obtain q' where q'_def: q ⟼* (λa. True)  q' R p' q' by blast
  then obtain q'' where q' ⟼* tau  q'' R q'' p'
    using assms unfolding coupled_simulation_weak_simulation by blast
  moreover hence q ⟼* (λa. True)  q''
    using q'_def(1) steps_concat steps_spec tau_true by meson
  ultimately show q'. q ⟼* (λa. True)  q'  R q' p' by blast
qed

lemma coupledsim_gp15_implies_gla17_on_tau_systems:
  assumes
    coupled_simulation_gp15 R
     a . tau a
  shows 
    coupled_simulation R
  unfolding coupled_simulation_def
proof safe
  fix p q p' a
  assume challenge:
    R p q
    p a  p'
  hence p ⟼* (λa. True)  p' using steps_one_step by metis
  then obtain q' where q ⟼* (λa. True)  q' R p' q'
    using challenge(1) assms(1) unfolding coupled_simulation_gp15_def by blast
  hence q ⇒^a  q' using assms(2) steps_concat steps_spec by meson
  thus q'. R p' q'  q ⇒^a  q' using `R p' q'` by blast
next
  fix p q
  assume
    R p q
  moreover have p ⟼* (λa. True) p using steps.refl by blast
  ultimately have q'. q ⟼* (λa. True)  q'  R q' p
    using assms(1) unfolding coupled_simulation_gp15_def by blast
  thus q'. q ⟼* tau  q'  R q' p using assms(2) steps_spec by blast
qed


subsection ‹Coupled Simulation as Two Simulations›

text ‹Historically, coupled similarity has been defined in terms of emph ‹two›› weak simulations
  coupled in some way cite "sangiorgi2012" and "ps1994"›.
  We reproduce these (more well-known) formulations and show that they are equivalent to the
  coupled (delay) simulations we are using.›

―‹From ‹cite "sangiorgi2012"››
definition coupled_simulation_san12 :: 
  ('s  's  bool)  ('s  's  bool)  bool
where
  coupled_simulation_san12 R1 R2 
    weak_simulation R1  weak_simulation (λ p q . R2 q p)
   ( p q . R1 p q  ( q' . q ⟼* tau q'  R2 p q'))
   ( p q . R2 p q  ( p' . p ⟼* tau p'  R1 p' q))
  
lemma weak_bisim_implies_coupled_sim_san12:
  assumes weak_bisimulation R
  shows coupled_simulation_san12 R R
  using assms weak_bisim_weak_sim steps.refl[of _ tau]
  unfolding coupled_simulation_san12_def
  by blast

lemma coupledsim_gla17_resembles_san12:
  shows
    coupled_simulation R1 =
    coupled_simulation_san12 R1 (λ p q . R1 q p)
  unfolding coupled_simulation_weak_simulation coupled_simulation_san12_def by blast

lemma coupledsim_san12_impl_gla17:
  assumes
    coupled_simulation_san12 R1 R2
  shows
    coupled_simulation (λ p q. R1 p q  R2 q p)
  unfolding coupled_simulation_weak_simulation
proof safe
  have weak_simulation R1 weak_simulation (λp q. R2 q p)
    using assms unfolding coupled_simulation_san12_def by auto
  thus weak_simulation (λp q. R1 p q  R2 q p)
    using weak_sim_union_cl by blast
next
  fix p q
  assume
    R1 p q
  hence q'. q ⟼* tau  q'  R2 p q'
    using assms unfolding coupled_simulation_san12_def by auto
  thus q'. q ⟼* tau  q'  (R1 q' p  R2 p q') by blast
next
  fix p q
  assume
    R2 q p
  hence q'. q ⟼* tau  q'  R1 q' p
    using assms unfolding coupled_simulation_san12_def by auto
  thus q'. q ⟼* tau  q'  (R1 q' p  R2 p q') by blast
qed

subsection ‹S-coupled Simulation›

text ‹Originally coupled simulation was introduced as two weak simulations coupled at the stable
  states. We give the definitions from cite "parrow1992" and "ps1994"› and a proof connecting
  this notion to “our” coupled similarity in the absence of divergences following
  cite "sangiorgi2012"›.›

―‹From ‹cite "parrow1992"››
definition coupled_simulation_p92 :: 
  ('s  's  bool)  ('s  's  bool)  bool
where
  coupled_simulation_p92 R1 R2   p q . 
    (R1 p q  
      (( p' a. p a p'  
        ( q'. R1 p' q'  
          (q ⇒^a q'))) 
      (stable_state p  R2 p q))) 
    (R2 p q  
      (( q' a. q a q' 
        ( p'. R2 p' q'  
          (p ⇒^a p'))) 
      (stable_state q  R1 p q)))

lemma weak_bisim_implies_coupled_sim_p92:
  assumes weak_bisimulation R
  shows coupled_simulation_p92 R R
using assms unfolding weak_bisimulation_def coupled_simulation_p92_def by blast
  
lemma coupled_sim_p92_symm:
  assumes coupled_simulation_p92 R1 R2
  shows coupled_simulation_p92 (λ p q. R2 q p) (λ p q. R1 q p)
using assms unfolding coupled_simulation_p92_def by blast
  
definition s_coupled_simulation_san12 :: 
  ('s  's  bool)  ('s  's  bool)  bool
where
  s_coupled_simulation_san12 R1 R2 
    weak_simulation R1  weak_simulation (λ p q . R2 q p)
   ( p q . R1 p q  stable_state p  R2 p q)
   ( p q . R2 p q  stable_state q  R1 p q)

abbreviation s_coupled_simulated_by :: 's  's  bool ("_ ⊑scs  _" [60, 60] 65)
  where s_coupled_simulated_by p q 
     R1 R2 . s_coupled_simulation_san12 R1 R2  R1 p q
    
abbreviation s_coupled_similar :: 's  's  bool ("_ ≡scs  _" [60, 60] 65)
  where s_coupled_similar p q 
     R1 R2 . s_coupled_simulation_san12 R1 R2  R1 p q  R2 p q

lemma s_coupled_sim_is_original_coupled:
  s_coupled_simulation_san12 = coupled_simulation_p92
unfolding coupled_simulation_p92_def
  s_coupled_simulation_san12_def weak_simulation_def by blast
 
corollary weak_bisim_implies_s_coupled_sim:
  assumes weak_bisimulation R
  shows s_coupled_simulation_san12 R R
  using assms s_coupled_sim_is_original_coupled weak_bisim_implies_coupled_sim_p92 by simp
   
corollary s_coupled_sim_symm:
  assumes s_coupled_simulation_san12 R1 R2
  shows s_coupled_simulation_san12 (λ p q. R2 q p) (λ p q. R1 q p)
  using assms coupled_sim_p92_symm s_coupled_sim_is_original_coupled by simp
   
corollary s_coupled_sim_union_cl:
  assumes
    s_coupled_simulation_san12 RA1 RA2
    s_coupled_simulation_san12 RB1 RB2
  shows
    s_coupled_simulation_san12 (λ p q. RA1 p q  RB1 p q) (λ p q. RA2 p q  RB2 p q)
  using assms weak_sim_union_cl unfolding s_coupled_simulation_san12_def by auto
    
corollary s_coupled_sim_symm_union:
  assumes s_coupled_simulation_san12 R1 R2
  shows s_coupled_simulation_san12 (λ p q. R1 p q  R2 q p) (λ p q. R2 p q  R1 q p)
  using s_coupled_sim_union_cl[OF assms s_coupled_sim_symm[OF assms]] .

lemma s_coupledsim_stable_eq:
  assumes
    p ⊑scs q
    stable_state p
  shows  p ≡scs q 
proof -
  obtain R1 R2 where
      R1 p q
      weak_simulation R1
      weak_simulation (λp q. R2 q p)
      p q. R1 p q  stable_state p  R2 p q
      p q. R2 p q  stable_state q  R1 p q
    using assms(1)  unfolding s_coupled_simulation_san12_def by blast
  moreover hence R2 p q using assms(2) by blast
  ultimately show ?thesis unfolding s_coupled_simulation_san12_def by blast
qed

lemma s_coupledsim_symm:
  assumes
    p ≡scs q 
  shows 
    q ≡scs p 
  using assms s_coupled_sim_symm by blast

lemma s_coupledsim_eq_parts:
  assumes
    p ≡scs q
  shows
    p ⊑scs q
    q ⊑scs p
  using assms s_coupledsim_symm by metis+

―‹From cite "sangiorgi2012"›, p.~226›
lemma divergence_free_coupledsims_coincidence_1:
  defines 
    R1  (λ p q . p ⊑cs q  (stable_state p  stable_state q)) and
    R2  (λ p q . q ⊑cs p  (stable_state q  stable_state p))
  assumes
    non_divergent_system:  p . ¬ divergent_state p
  shows
    s_coupled_simulation_san12 R1 R2
  unfolding s_coupled_simulation_san12_def
proof safe
  show weak_simulation R1 unfolding weak_simulation_def
  proof safe
    fix p q p' a
    assume sub_assms:
      R1 p q
      p a  p'
    then obtain q' where q'_def: q ⇒^a q' p' ⊑cs q'
      using coupled_sim_by_is_coupled_sim unfolding R1_def coupled_simulation_def by blast
    show q'. R1 p' q'  q ⇒^a  q'
    proof (cases stable_state p')
      case True
      obtain  q'' where q''_def: q' ⟼* tau q'' q'' ⊑cs  p'
        using coupled_sim_by_is_coupled_sim q'_def(2)
        unfolding coupled_simulation_weak_simulation by blast
      then obtain q''' where q'''_def: q'' ⟼* tau q''' stable_state q'''
        using non_divergence_implies_eventual_stability non_divergent_system by blast
      hence q''' ⊑cs p'
        using coupledsim_step_gla17 coupledsim_trans[OF _ q''_def(2)] by blast
      hence p' ⊑cs q'''
        using `stable_state p'` coupled_sim_by_is_coupled_sim coupledsim_stable_state_symm
        by blast
      moreover have q ⇒^a q''' using q'_def(1) q''_def(1) q'''_def(1) steps_concat by blast
      ultimately show ?thesis using q'''_def(2) unfolding R1_def by blast
    next
      case False
      then show ?thesis using q'_def unfolding R1_def by blast
    qed
  qed
  ―‹analogous to previous case›
  then show weak_simulation (λp q. R2 q p) unfolding R1_def R2_def .
next
  fix p q
  assume
    R1 p q
    stable_state p
  thus R2 p q
    unfolding R1_def R2_def 
    using coupled_sim_by_is_coupled_sim coupledsim_stable_state_symm by blast
next ―‹analogous›
  fix p q
  assume
    R2 p q
    stable_state q
  thus R1 p q
    unfolding R1_def R2_def 
    using coupled_sim_by_is_coupled_sim coupledsim_stable_state_symm by blast
qed

―‹From cite "sangiorgi2012"›, p.~227›
lemma divergence_free_coupledsims_coincidence_2:
  defines 
    R  (λ p q . p ⊑scs q  ( q' . q ⟼* tau q'  p ≡scs q'))
  assumes
    non_divergent_system:  p . ¬ divergent_state p
  shows
    coupled_simulation R
  unfolding coupled_simulation_weak_simulation
proof safe
  show weak_simulation R 
    unfolding weak_simulation_def
  proof safe
    fix p q p' a
    assume sub_assms:
      R p q
      p a  p'
    thus q'. R p' q'  q ⇒^a  q'
      unfolding R_def
    proof (cases p ⊑scs q)
      case True
      then obtain q' where p' ⊑scs  q' q ⇒^a  q'
        using s_coupled_simulation_san12_def sub_assms(2) weak_sim_ruleformat by metis
      thus q'. (p' ⊑scs  q'  (q'a. q' ⟼* tau  q'a  p' ≡scs  q'a))  q ⇒^a  q'
        by blast
    next
      case False
      then obtain q' where q ⟼* tau  q' p ≡scs  q'
          using sub_assms(1) unfolding R_def by blast
      then obtain q'' where q' ⇒^a  q'' p' ⊑scs  q'' 
        using s_coupled_simulation_san12_def sub_assms(2) weak_sim_ruleformat by metis
      hence p' ⊑scs  q''  q ⇒^a  q'' using steps_concat `q ⟼* tau  q'` by blast
      thus q'. (p' ⊑scs  q'  (q'a. q' ⟼* tau  q'a  p' ≡scs  q'a))  q ⇒^a  q'
        by blast
    qed
  qed
next
  fix p q
  assume
    R p q
  thus q'. q ⟼* tau  q'  R q' p unfolding R_def
  proof safe
    fix R1 R2
    assume sub_assms:
      s_coupled_simulation_san12 R1 R2
      R1 p q
    thus q'. q ⟼* tau  q'  (q' ⊑scs  p  (q'a. p ⟼* tau  q'a  q' ≡scs  q'a))
    proof -
      ―‹dropped a superfluous case distinction from @cite{sangiorgi2012}›
      obtain p' where stable_state p' p ⟼* tau p'
        using non_divergent_system non_divergence_implies_eventual_stability by blast
      hence p ⇒^τ  p' using tau_tau by blast
      then obtain q' where q ⟼* tau q' p' ⊑scs q'
        using s_coupled_simulation_san12_def weak_sim_weak_premise sub_assms tau_tau
        by metis
      moreover hence p' ≡scs q' using `stable_state p'` s_coupledsim_stable_eq by blast
      ultimately show ?thesis using `p ⟼* tau p'` s_coupledsim_symm by blast
    qed
  qed (metis s_coupledsim_symm)
qed

text ‹While this proof follows cite "sangiorgi2012"›, we needed to deviate from them by also
  requiring rootedness (shared stability) for the compared states.›
theorem divergence_free_coupledsims_coincidence:
  assumes
    non_divergent_system:  p . ¬ divergent_state p and
    stability_rooted: stable_state p  stable_state q
  shows
    (p ≡cs q) = (p ≡scs q)
proof rule
  assume p ≡cs q
  hence p ⊑cs q q ⊑cs p by auto
  thus p ≡scs q
    using stability_rooted divergence_free_coupledsims_coincidence_1[OF non_divergent_system]
    by blast
next
  assume p ≡scs q
  thus p ≡cs q
    using stability_rooted divergence_free_coupledsims_coincidence_2[OF non_divergent_system]
      s_coupledsim_eq_parts by blast
qed

end ―‹context @{locale lts_tau}
 
text ‹The following example shows that a system might be related by s-coupled-simulation without
  being connected by coupled-simulation.›

datatype ex_state = a0 | a1 | a2 | a3 | b0 | b1 | b2 
  
locale ex_lts = lts_tau trans τ
  for trans :: ex_state  nat  ex_state  bool ("_ _  _" [70, 70, 70] 80) and τ +
  assumes
    sys:
  trans = (λ p act q .
     1 = act  (p = a0  q = a1 
               p = a0  q = a2 
               p = a2  q = a3 
               p = b0  q = b1 
               p = b1  q = b2) 
     0 = act  (p = a1  q = a1))
   τ = 0
begin 
  
lemma no_root_coupled_sim:
  fixes R1 R2
  assumes
    coupled:
      coupled_simulation_san12 R1 R2 and
    root:
      R1 a0 b0 R2 a0 b0
  shows
    False
proof -
  have
    R1sim: 
      weak_simulation R1 and
    R1coupling:
      p q. R1 p q  (q'. q ⟼* tau  q'  R2 p q') and
    R2sim: 
      weak_simulation (λp q. R2 q p)
    using coupled unfolding coupled_simulation_san12_def by auto
  hence R1sim_rf:
       p q. R1 p q 
        (p' a. p a  p' 
          (q'. R1 p' q'  (¬ tau a  q a  q') 
          (tau a  q ⟼* tau  q')))
    unfolding weak_simulation_def by blast
  have a0 1 a1 using sys by auto
  hence q'. R1 a1 q'  b0 1 q'
    using R1sim_rf[OF root(1), rule_format, of 1 a1] tau_def
    by (auto simp add: sys)
  then obtain q' where q': R1 a1 q' b0 1 q' by blast
  have b0_quasi_stable:  q' . b0 ⟼*tau q'  b0 = q'
    using steps_no_step[of b0 tau] tau_def by (auto simp add: sys)
  have b0_only_b1:  q' . b0 1 q'  q' = b1 by (auto simp add: sys)
  have b1_quasi_stable:  q' . b1 ⟼*tau q'  b1 = q'
    using steps_no_step[of b1 tau] tau_def by (auto simp add: sys)
  have  q' . b0 1 q'  q' = b1
    using b0_quasi_stable b0_only_b1 b1_quasi_stable by auto
  hence q' = b1 using q'(2) by blast
  hence R1 a1 b1 using q'(1) by simp
  hence R2 a1 b1
    using b1_quasi_stable R1coupling by auto
  have b1_b2: b1 1 b2
    by (auto simp add: sys)
  hence a1_sim:  q' . R2 q' b2  a1 1  q'
    using `R2 a1 b1` R2sim b1_b2
    unfolding weak_simulation_def tau_def by (auto simp add: sys)
  have a1_quasi_stable:  q' . a1 ⟼*tau q'  a1 = q'
    using steps_loop[of a1] by (auto simp add: sys)
  hence a1_stuck:  q' . ¬ a1 1 q'
    by (auto simp add: sys)
  show ?thesis using a1_sim  a1_stuck by blast
qed

lemma root_s_coupled_sim:
  defines
    R1  λ a b .
      a = a0  b = b0 
      a = a1  b = b1 
      a = a2  b = b1 
      a = a3  b = b2
  and
    R2  λ a b .
      a = a0  b = b0 
      a = a2  b = b1 
      a = a3  b = b2
  shows
    coupled:
      s_coupled_simulation_san12 R1 R2
  unfolding s_coupled_simulation_san12_def
proof safe
  show weak_simulation R1
    unfolding weak_simulation_def proof (clarify)
    fix p q p' a
    show R1 p q  p a  p'  q'. R1 p' q'  (q ⇒^a  q') 
      using step_tau_refl unfolding sys assms tau_def using sys(2) tau_def by (cases p, auto)
  qed
next
  show weak_simulation (λp q. R2 q p)
    unfolding weak_simulation_def proof (clarify)
    fix p q p' a
    show R2 q p  p a  p'  q'. R2 q' p'  (q ⇒^a  q') 
      using steps.refl[of _ tau] tau_def unfolding assms sys
      using sys(2) tau_def by (cases p, auto)
  qed
next
  fix p q
  assume R1 p q stable_state p
  thus R2 p q unfolding assms sys using sys(2) tau_def by auto
next
  fix p q
  assume R2 p q stable_state q
  thus R1 p q unfolding assms sys using tau_def by auto
qed

end ―‹@{locale ex_lts}// example lts›

end