# Theory Weak_Equivalence_Implies_Bisimilarity

```theory Weak_Equivalence_Implies_Bisimilarity
imports
Weak_Logical_Equivalence
begin

section ‹Weak Logical Equivalence Implies Weak Bisimilarity›

context indexed_weak_nominal_ts
begin

definition is_distinguishing_formula :: "('idx, 'pred, 'act) formula ⇒ 'state ⇒ 'state ⇒ bool"
("_ distinguishes _ from _" [100,100,100] 100)
where
"x distinguishes P from Q ≡ P ⊨ x ∧ ¬ Q ⊨ x"

lemma is_distinguishing_formula_eqvt (*[eqvt]*) [simp]:
assumes "x distinguishes P from Q" shows "(p ∙ x) distinguishes (p ∙ P) from (p ∙ Q)"
using assms unfolding is_distinguishing_formula_def
by (metis permute_minus_cancel(2) valid_eqvt)

lemma weakly_equivalent_iff_not_distinguished: "(P ≡⋅ Q) ⟷ ¬(∃x. weak_formula x ∧ x distinguishes P from Q)"
by (meson is_distinguishing_formula_def weakly_logically_equivalent_def valid_Not wf_Not)

text ‹There exists a distinguishing weak formula for~@{term P} and~@{term Q} whose support is
contained in~@{term "supp P"}.›

lemma distinguished_bounded_support:
assumes "weak_formula x" and "x distinguishes P from Q"
obtains y where "weak_formula y" and "supp y ⊆ supp P" and "y distinguishes P from Q"
proof -
let ?B = "{p ∙ x|p. supp P ♯* p}"
have "supp P supports ?B"
unfolding supports_def proof (clarify)
fix a b
assume a: "a ∉ supp P" and b: "b ∉ supp P"
have "(a ⇌ b) ∙ ?B ⊆ ?B"
proof
fix x'
assume "x' ∈ (a ⇌ b) ∙ ?B"
then obtain p where 1: "x' = (a ⇌ b) ∙ p ∙ x" and 2: "supp P ♯* p"
let ?q = "(a ⇌ b) + p"
from 1 have "x' = ?q ∙ x"
by simp
moreover from a and b and 2 have "supp P ♯* ?q"
by (metis fresh_perm fresh_star_def fresh_star_plus swap_atom_simps(3))
ultimately show "x' ∈ ?B" by blast
qed
moreover have "?B ⊆ (a ⇌ b) ∙ ?B"
proof
fix x'
assume "x' ∈ ?B"
then obtain p where 1: "x' = p ∙ x" and 2: "supp P ♯* p"
by auto
let ?q = "(a ⇌ b) + p"
from 1 have "x' = (a ⇌ b) ∙ ?q ∙ x"
by simp
moreover from a and b and 2 have "supp P ♯* ?q"
by (metis fresh_perm fresh_star_def fresh_star_plus swap_atom_simps(3))
ultimately show "x' ∈ (a ⇌ b) ∙ ?B"
using mem_permute_iff by blast
qed
ultimately show "(a ⇌ b) ∙ ?B = ?B" ..
qed
then have supp_B_subset_supp_P: "supp ?B ⊆ supp P"
by (metis (erased, lifting) finite_supp supp_is_subset)
then have finite_supp_B: "finite (supp ?B)"
using finite_supp rev_finite_subset by blast
have "?B ⊆ (λp. p ∙ x) ` UNIV"
by auto
then have "|?B| ≤o |UNIV :: perm set|"
by (rule surj_imp_ordLeq)
also have "|UNIV :: perm set| <o |UNIV :: 'idx set|"
by (metis card_idx_perm)
also have "|UNIV :: 'idx set| ≤o natLeq +c |UNIV :: 'idx set|"
by (metis Cnotzero_UNIV ordLeq_csum2)
finally have card_B: "|?B| <o natLeq +c |UNIV :: 'idx set|" .
let ?y = "Conj (Abs_bset ?B) :: ('idx, 'pred, 'act) formula"
have "weak_formula ?y"
proof
show "finite (supp (Abs_bset ?B :: _ set['idx]))"
using finite_supp_B card_B by simp
next
fix x' assume "x' ∈ set_bset (Abs_bset ?B :: _ set['idx])"
with card_B obtain p where "x' = p ∙ x"
using Abs_bset_inverse mem_Collect_eq by auto
then show "weak_formula x'"
using ‹weak_formula x› by (metis weak_formula_eqvt)
qed
moreover from finite_supp_B and card_B and supp_B_subset_supp_P have "supp ?y ⊆ supp P"
by simp
moreover have "?y distinguishes P from Q"
unfolding is_distinguishing_formula_def proof
from assms show "P ⊨ ?y"
by (auto simp add: card_B finite_supp_B) (metis is_distinguishing_formula_def supp_perm_eq valid_eqvt)
next
from assms show "¬ Q ⊨ ?y"
by (auto simp add: card_B finite_supp_B) (metis is_distinguishing_formula_def permute_zero fresh_star_zero)
qed
ultimately show ?thesis ..
qed

lemma weak_equivalence_is_weak_bisimulation: "is_weak_bisimulation weakly_logically_equivalent"
proof -
have "symp weakly_logically_equivalent"
by (metis weakly_logically_equivalent_def sympI)
moreover  ― ‹weak static implication›
{
fix P Q φ assume "P ≡⋅ Q" and "P ⊢ φ"
then have "∃Q'. Q ⇒ Q' ∧ P ≡⋅ Q' ∧ Q' ⊢ φ"
proof -
{
let ?Q' = "{Q'. Q ⇒ Q' ∧ Q' ⊢ φ}"
assume "∀Q'∈?Q'. ¬ P ≡⋅ Q'"
then have "∀Q'∈?Q'. ∃x :: ('idx, 'pred, 'act) formula. weak_formula x ∧ x distinguishes P from Q'"
by (metis weakly_equivalent_iff_not_distinguished)
then have "∀Q'∈?Q'. ∃x :: ('idx, 'pred, 'act) formula. weak_formula x ∧ supp x ⊆ supp P ∧ x distinguishes P from Q'"
by (metis distinguished_bounded_support)
then obtain f :: "'state ⇒ ('idx, 'pred, 'act) formula" where
*: "∀Q'∈?Q'. weak_formula (f Q') ∧ supp (f Q') ⊆ supp P ∧ (f Q') distinguishes P from Q'"
by metis
have "supp (f ` ?Q') ⊆ supp P"
by (rule set_bounded_supp, fact finite_supp, cut_tac "*", blast)
then have finite_supp_image: "finite (supp (f ` ?Q'))"
using finite_supp rev_finite_subset by blast
have "|f ` ?Q'| ≤o |UNIV :: 'state set|"
using card_of_UNIV card_of_image ordLeq_transitive by blast
also have "|UNIV :: 'state set| <o |UNIV :: 'idx set|"
by (metis card_idx_state)
also have "|UNIV :: 'idx set| ≤o natLeq +c |UNIV :: 'idx set|"
by (metis Cnotzero_UNIV ordLeq_csum2)
finally have card_image: "|f ` ?Q'| <o natLeq +c |UNIV :: 'idx set|" .

let ?y = "Conj (Abs_bset (f ` ?Q')) :: ('idx, 'pred, 'act) formula"
have "weak_formula ?y"
proof (standard+)
show "finite (supp (Abs_bset (f ` ?Q') :: _ set['idx]))"
using finite_supp_image card_image by simp
next
fix x assume "x ∈ set_bset (Abs_bset (f ` ?Q') :: _ set['idx])"
with card_image obtain Q' where "Q' ∈ ?Q'" and "x = f Q'"
using Abs_bset_inverse imageE set_bset set_bset_to_set_bset by auto
then show "weak_formula x"
using "*" by metis
qed

let ?z = "⟨⟨τ⟩⟩(Conj (binsert (Pred φ) (bsingleton ?y)))"
have "weak_formula ?z"
by standard (fact ‹weak_formula ?y›)
moreover have "P ⊨ ?z"
proof -
have "P ⇒⟨τ⟩ P"
by simp
moreover
{
fix Q'
assume "Q ⇒ Q' ∧ Q' ⊢ φ"
with "*" have "P ⊨ f Q'"
by (metis is_distinguishing_formula_def mem_Collect_eq)
}
with ‹P ⊢ φ› have "P ⊨ Conj (binsert (Pred φ) (bsingleton ?y))"
by (simp add: binsert.rep_eq finite_supp_image card_image)
ultimately show ?thesis
using valid_weak_action_modality by blast
qed
moreover have "¬ Q ⊨ ?z"
proof
assume "Q ⊨ ?z"
then obtain Q' where 1: "Q ⇒ Q'" and "Q' ⊨ Conj (binsert (Pred φ) (bsingleton ?y))"
using valid_weak_action_modality by auto
then have 2: "Q' ⊢ φ" and 3: "Q' ⊨ ?y"
by (simp add: binsert.rep_eq finite_supp_image card_image)+
from 3 have "⋀Q''. Q ⇒ Q'' ∧ Q'' ⊢ φ ⟶ Q' ⊨ f Q''"
with 1 and 2 and "*" show False
using is_distinguishing_formula_def by blast
qed
ultimately have False
by (metis ‹P ≡⋅ Q› weakly_logically_equivalent_def)
}
then show ?thesis
by blast
qed
}
moreover  ― ‹weak simulation›
{
fix P Q α P' assume "P ≡⋅ Q" and "bn α ♯* Q" and "P → ⟨α,P'⟩"
then have "∃Q'. Q ⇒⟨α⟩ Q' ∧ P' ≡⋅ Q'"
proof -
{
let ?Q' = "{Q'. Q ⇒⟨α⟩ Q'}"
assume "∀Q'∈?Q'. ¬ P' ≡⋅ Q'"
then have "∀Q'∈?Q'. ∃x :: ('idx, 'pred, 'act) formula. weak_formula x ∧ x distinguishes P' from Q'"
by (metis weakly_equivalent_iff_not_distinguished)
then have "∀Q'∈?Q'. ∃x :: ('idx, 'pred, 'act) formula. weak_formula x ∧ supp x ⊆ supp P' ∧ x distinguishes P' from Q'"
by (metis distinguished_bounded_support)
then obtain f :: "'state ⇒ ('idx, 'pred, 'act) formula" where
*: "∀Q'∈?Q'. weak_formula (f Q') ∧ supp (f Q') ⊆ supp P' ∧ (f Q') distinguishes P' from Q'"
by metis
have "supp P' supports (f ` ?Q')"
unfolding supports_def proof (clarify)
fix a b
assume a: "a ∉ supp P'" and b: "b ∉ supp P'"
have "(a ⇌ b) ∙ (f ` ?Q') ⊆ f ` ?Q'"
proof
fix x
assume "x ∈ (a ⇌ b) ∙ (f ` ?Q')"
then obtain Q' where 1: "x = (a ⇌ b) ∙ f Q'" and 2: "Q ⇒⟨α⟩ Q'"
by auto (metis (no_types, lifting) imageE image_eqvt mem_Collect_eq permute_set_eq_image)
with "*" and a and b have "a ∉ supp (f Q')" and "b ∉ supp (f Q')"
by auto
with 1 have "x = f Q'"
by (metis fresh_perm fresh_star_def supp_perm_eq swap_atom)
with 2 show "x ∈ f ` ?Q'"
by simp
qed
moreover have "f ` ?Q' ⊆ (a ⇌ b) ∙ (f ` ?Q')"
proof
fix x
assume "x ∈ f ` ?Q'"
then obtain Q' where 1: "x = f Q'" and 2: "Q ⇒⟨α⟩ Q'"
by auto
with "*" and a and b have "a ∉ supp (f Q')" and "b ∉ supp (f Q')"
by auto
with 1 have "x = (a ⇌ b) ∙ f Q'"
by (metis fresh_perm fresh_star_def supp_perm_eq swap_atom)
with 2 show "x ∈ (a ⇌ b) ∙ (f ` ?Q')"
using mem_permute_iff by blast
qed
ultimately show "(a ⇌ b) ∙ (f ` ?Q') = f ` ?Q'" ..
qed
then have supp_image_subset_supp_P': "supp (f ` ?Q') ⊆ supp P'"
by (metis (erased, lifting) finite_supp supp_is_subset)
then have finite_supp_image: "finite (supp (f ` ?Q'))"
using finite_supp rev_finite_subset by blast
have "|f ` ?Q'| ≤o |UNIV :: 'state set|"
by (metis card_of_UNIV card_of_image ordLeq_transitive)
also have "|UNIV :: 'state set| <o |UNIV :: 'idx set|"
by (metis card_idx_state)
also have "|UNIV :: 'idx set| ≤o natLeq +c |UNIV :: 'idx set|"
by (metis Cnotzero_UNIV ordLeq_csum2)
finally have card_image: "|f ` ?Q'| <o natLeq +c |UNIV :: 'idx set|" .

let ?y = "Conj (Abs_bset (f ` ?Q')) :: ('idx, 'pred, 'act) formula"
have "weak_formula (⟨⟨α⟩⟩?y)"
proof (standard+)
show "finite (supp (Abs_bset (f ` ?Q') :: _ set['idx]))"
using finite_supp_image card_image by simp
next
fix x assume "x ∈ set_bset (Abs_bset (f ` ?Q') :: _ set['idx])"
with card_image obtain Q' where "Q' ∈ ?Q'" and "x = f Q'"
using Abs_bset_inverse imageE set_bset set_bset_to_set_bset by auto
then show "weak_formula x"
using "*" by metis
qed
moreover have "P ⊨ ⟨⟨α⟩⟩?y"
unfolding valid_weak_action_modality proof (standard+)
from ‹P → ⟨α,P'⟩› show "P ⇒⟨α⟩ P'"
by simp
next
{
fix Q'
assume "Q ⇒⟨α⟩ Q'"
with "*" have "P' ⊨ f Q'"
by (metis is_distinguishing_formula_def mem_Collect_eq)
}
then show "P' ⊨ ?y"
qed
moreover have "¬ Q ⊨ ⟨⟨α⟩⟩?y"
proof
assume "Q ⊨ ⟨⟨α⟩⟩?y"
then obtain Q' where 1: "Q ⇒⟨α⟩ Q'" and 2: "Q' ⊨ ?y"
using ‹bn α ♯* Q› by (metis valid_weak_action_modality_fresh)
from 2 have "⋀Q''. Q ⇒⟨α⟩ Q'' ⟶ Q' ⊨ f Q''"
with 1 and "*" show False
using is_distinguishing_formula_def by blast
qed
ultimately have False
by (metis ‹P ≡⋅ Q› weakly_logically_equivalent_def)
}
then show ?thesis by auto
qed
}
ultimately show ?thesis
unfolding is_weak_bisimulation_def by metis
qed

theorem weak_equivalence_implies_weak_bisimilarity: assumes "P ≡⋅ Q" shows "P ≈⋅ Q"
using assms by (metis weakly_bisimilar_def weak_equivalence_is_weak_bisimulation)

end

end
```