This GitLab instance reached the end of its service life. It won't be possible to create new users or projects.

Please read the deprecation notice for more information concerning the deprecation timeline

Visit migration.git.tu-berlin.de (internal network only) to import your old projects to the new GitLab platform 📥

Commit 3a99aa3e by benkeks

Improve Isabelle proofs

parent a6d32189
...@@ -12,74 +12,74 @@ context lts_tau ...@@ -12,74 +12,74 @@ context lts_tau
begin begin
definition fp_step :: definition fp_step ::
"'s rel \<Rightarrow> 's rel" \<open>'s rel \<Rightarrow> 's rel\<close>
where where
"fp_step R1 \<equiv> { (p,q)\<in>R1. \<open>fp_step R1 \<equiv> { (p,q)\<in>R1.
(\<forall> p' a. p \<longmapsto> a p' \<longrightarrow> (\<forall> p' a. p \<longmapsto>a p' \<longrightarrow>
(\<exists> q'. ((p',q')\<in>R1) \<and> (q \<longmapsto>^ a q'))) (\<exists> q'. ((p',q')\<in>R1) \<and> (q \<Rightarrow>^a q')))
\<and> (\<exists> q'. q \<longmapsto>*tau q' \<and> ((q',p)\<in>R1)) }" \<and> (\<exists> q'. q \<longmapsto>*tau q' \<and> ((q',p)\<in>R1)) }\<close>
lemma mono_fp_step: lemma mono_fp_step:
"mono fp_step" \<open>mono fp_step\<close>
proof (rule, safe) proof (rule, safe)
fix x y::"'s rel" and p q fix x y::\<open>'s rel\<close> and p q
assume assume
"x \<subseteq> y" \<open>x \<subseteq> y\<close>
"(p, q) \<in> fp_step x" \<open>(p, q) \<in> fp_step x\<close>
thus "(p, q) \<in> fp_step y" thus \<open>(p, q) \<in> fp_step y\<close>
unfolding fp_step_def unfolding fp_step_def
by (auto, blast) by (auto, blast)
qed qed
lemma fp_fp_step: lemma fp_fp_step:
assumes assumes
"R = fp_step R" \<open>R = fp_step R\<close>
shows shows
"coupled_simulation (\<lambda> p q. (p, q) \<in> R)" \<open>coupled_simulation (\<lambda> p q. (p, q) \<in> R)\<close>
using assms unfolding fp_step_def coupled_simulation_def using assms unfolding fp_step_def coupled_simulation_def
by fastforce by fastforce
lemma gfp_fp_step_subset_gcs: lemma gfp_fp_step_subset_gcs:
shows "(gfp fp_step) \<subseteq> { (p,q) . greatest_coupled_simulation p q }" shows \<open>(gfp fp_step) \<subseteq> { (p,q) . greatest_coupled_simulation p q }\<close>
unfolding gcs_eq_coupled_sim_by[symmetric] unfolding gcs_eq_coupled_sim_by[symmetric]
proof clarify proof clarify
fix a b fix a b
assume assume
"(a, b) \<in> gfp fp_step" \<open>(a, b) \<in> gfp fp_step\<close>
thus "a \<sqsubseteq>cs b" thus \<open>a \<sqsubseteq>cs b\<close>
using fp_fp_step mono_fp_step gfp_unfold by auto using fp_fp_step mono_fp_step gfp_unfold by auto
qed qed
lemma fp_fp_step_gcs: lemma fp_fp_step_gcs:
assumes assumes
"R = { (p,q) . greatest_coupled_simulation p q }" \<open>R = { (p,q) . greatest_coupled_simulation p q }\<close>
shows shows
"fp_step R = R" \<open>fp_step R = R\<close>
unfolding assms unfolding assms
proof safe proof safe
fix p q fix p q
assume assume
"(p, q) \<in> fp_step {(x, y). greatest_coupled_simulation x y}" \<open>(p, q) \<in> fp_step {(x, y). greatest_coupled_simulation x y}\<close>
hence "(\<forall>p' a. p \<longmapsto>a p' \<longrightarrow> (\<exists>q'. greatest_coupled_simulation p' q' \<and> q \<longmapsto>^ a q')) \<and> hence \<open>(\<forall>p' a. p \<longmapsto>a p' \<longrightarrow> (\<exists>q'. greatest_coupled_simulation p' q' \<and> q \<Rightarrow>^a q')) \<and>
(\<exists>q'. q \<longmapsto>* tau q' \<and> greatest_coupled_simulation q' p)" (\<exists>q'. q \<longmapsto>* tau q' \<and> greatest_coupled_simulation q' p)\<close>
unfolding fp_step_def by auto unfolding fp_step_def by auto
hence "(\<forall>p' a. p \<longmapsto>a p' \<longrightarrow> (\<exists>q'. greatest_coupled_simulation p' q' \<and> q \<longmapsto>^^ a q')) \<and> hence \<open>(\<forall>p' a. p \<longmapsto>a p' \<longrightarrow> (\<exists>q'. greatest_coupled_simulation p' q' \<and> q \<Rightarrow>^^ a q')) \<and>
(\<exists>q'. q \<longmapsto>* tau q' \<and> greatest_coupled_simulation q' p)" using weak_step_tau2_def by simp (\<exists>q'. q \<longmapsto>* tau q' \<and> greatest_coupled_simulation q' p)\<close> using weak_step_tau2_def by simp
thus "greatest_coupled_simulation p q" thus \<open>greatest_coupled_simulation p q\<close>
using lts_tau.gcs by metis using lts_tau.gcs by metis
next next
fix p q fix p q
assume assume
"greatest_coupled_simulation p q" \<open>greatest_coupled_simulation p q\<close>
hence "(p, q) \<in> {(x, y). greatest_coupled_simulation x y} \<and> (\<forall> p' a. p \<longmapsto> a p' \<longrightarrow> hence \<open>(p, q) \<in> {(x, y). greatest_coupled_simulation x y} \<and> (\<forall> p' a. p \<longmapsto>a p' \<longrightarrow>
(\<exists> q'. (greatest_coupled_simulation p' q') \<and> (q \<longmapsto>^ a q'))) (\<exists> q'. (greatest_coupled_simulation p' q') \<and> (q \<Rightarrow>^a q')))
\<and> (\<exists> q'. q \<longmapsto>*tau q' \<and> (greatest_coupled_simulation q' p))" \<and> (\<exists> q'. q \<longmapsto>*tau q' \<and> (greatest_coupled_simulation q' p))\<close>
using gcs_is_coupled_simulation unfolding coupled_simulation_def by blast using gcs_is_coupled_simulation unfolding coupled_simulation_def by blast
thus "(p, q) \<in> fp_step {(x, y). greatest_coupled_simulation x y}" thus \<open>(p, q) \<in> fp_step {(x, y). greatest_coupled_simulation x y}\<close>
unfolding fp_step_def by blast unfolding fp_step_def by blast
qed qed
lemma gfp_fp_step_gcs: "gfp fp_step = { (p,q) . greatest_coupled_simulation p q }" lemma gfp_fp_step_gcs: \<open>gfp fp_step = { (p,q) . greatest_coupled_simulation p q }\<close>
using fp_fp_step_gcs gfp_fp_step_subset_gcs using fp_fp_step_gcs gfp_fp_step_subset_gcs
by (simp add: equalityI gfp_upperbound) by (simp add: equalityI gfp_upperbound)
...@@ -89,11 +89,11 @@ context lts_tau_finite ...@@ -89,11 +89,11 @@ context lts_tau_finite
begin begin
lemma gfp_fp_step_while: lemma gfp_fp_step_while:
shows shows
"gfp fp_step = while (\<lambda>R. fp_step R \<noteq> R) fp_step top" \<open>gfp fp_step = while (\<lambda>R. fp_step R \<noteq> R) fp_step top\<close>
using gfp_while_lattice[OF mono_fp_step] finite_state_rel Finite_Set.finite_set by blast using gfp_while_lattice[OF mono_fp_step] finite_state_rel Finite_Set.finite_set by blast
theorem coupled_sim_fp_step_while: theorem coupled_sim_fp_step_while:
shows "while (\<lambda>R. fp_step R \<noteq> R) fp_step top = { (p,q) . greatest_coupled_simulation p q }" shows \<open>while (\<lambda>R. fp_step R \<noteq> R) fp_step top = { (p,q) . greatest_coupled_simulation p q }\<close>
using gfp_fp_step_while gfp_fp_step_gcs by blast using gfp_fp_step_while gfp_fp_step_gcs by blast
end end
......
section \<open>Fixed Point Algorithm for Coupled Similarity\<close> section \<open>Fixed Point Algorithm for Coupled Similarity\<close>
subsection \<open>The Algorithm\<close>
theory CS_Fixpoint_Algo_Delay theory CS_Fixpoint_Algo_Delay
imports imports
Coupled_Simulation Coupled_Simulation
Finite_Weak_Transition_Systems
"~~/src/HOL/Library/While_Combinator" "~~/src/HOL/Library/While_Combinator"
"~~/src/HOL/Library/Finite_Lattice" "~~/src/HOL/Library/Finite_Lattice"
begin begin
...@@ -12,83 +14,99 @@ context lts_tau ...@@ -12,83 +14,99 @@ context lts_tau
begin begin
definition fp_step :: definition fp_step ::
"'s rel \<Rightarrow> 's rel" \<open>'s rel \<Rightarrow> 's rel\<close>
where where
"fp_step R1 \<equiv> { (p,q)\<in>R1. \<open>fp_step R1 \<equiv> { (p,q)\<in>R1.
(\<forall> p' a. p \<longmapsto> a p' \<longrightarrow> (\<forall> p' a. p \<longmapsto>a p' \<longrightarrow>
(\<exists> q'. ((p',q')\<in>R1) \<and> (q \<longmapsto>^~ a q'))) (tau a \<longrightarrow> (p',q)\<in>R1) \<and>
\<and> (\<exists> q'. q \<longmapsto>*tau q' \<and> ((q',p)\<in>R1)) }" (\<not>tau a \<longrightarrow> (\<exists> q'. ((p',q')\<in>R1) \<and> (q =\<rhd>a q')))) \<and>
(\<exists> q'. q \<longmapsto>*tau q' \<and> ((q',p)\<in>R1)) }\<close>
definition fp_compute_cs :: \<open>'s rel\<close>
where \<open>fp_compute_cs \<equiv> while (\<lambda>R. fp_step R \<noteq> R) fp_step top\<close>
subsection \<open>Correctness\<close>
lemma mono_fp_step: lemma mono_fp_step:
"mono fp_step" \<open>mono fp_step\<close>
proof (rule, safe) proof (rule, safe)
fix x y::"'s rel" and p q fix x y::\<open>'s rel\<close> and p q
assume assume
"x \<subseteq> y" \<open>x \<subseteq> y\<close>
"(p, q) \<in> fp_step x" \<open>(p, q) \<in> fp_step x\<close>
thus "(p, q) \<in> fp_step y" thus \<open>(p, q) \<in> fp_step y\<close>
unfolding fp_step_def unfolding fp_step_def
by (auto, blast) by (auto, blast)
qed qed
thm prod.simps(2)
lemma fp_fp_step: lemma fp_fp_step:
assumes assumes
"R = fp_step R" \<open>R = fp_step R\<close>
shows shows
"coupled_delay_simulation (\<lambda> p q. (p, q) \<in> R)" \<open>coupled_delay_simulation (\<lambda> p q. (p, q) \<in> R)\<close>
using assms unfolding fp_step_def coupled_delay_simulation_def delay_simulation_def using assms unfolding fp_step_def coupled_delay_simulation_def delay_simulation_def
by fastforce by (auto, blast, fastforce+)
lemma gfp_fp_step_subset_gcs: lemma gfp_fp_step_subset_gcs:
shows "(gfp fp_step) \<subseteq> { (p,q) . greatest_coupled_simulation p q }" shows \<open>(gfp fp_step) \<subseteq> { (p,q) . greatest_coupled_simulation p q }\<close>
unfolding gcs_eq_coupled_sim_by[symmetric] unfolding gcs_eq_coupled_sim_by[symmetric]
proof clarify proof clarify
fix a b fix a b
assume assume
"(a, b) \<in> gfp fp_step" \<open>(a, b) \<in> gfp fp_step\<close>
thus "a \<sqsubseteq>cs b" thus \<open>a \<sqsubseteq>cs b\<close>
unfolding coupled_sim_by_eq_delay_coupled_simulation unfolding coupled_sim_by_eq_coupled_delay_simulation
using fp_fp_step mono_fp_step gfp_unfold using fp_fp_step mono_fp_step gfp_unfold
by metis by metis
qed qed
lemma fp_fp_step_gcs: lemma fp_fp_step_gcs:
assumes assumes
"R = { (p,q) . greatest_coupled_simulation p q }" \<open>R = { (p,q) . greatest_coupled_simulation p q }\<close>
shows shows
"fp_step R = R" \<open>fp_step R = R\<close>
unfolding assms unfolding assms
proof safe proof safe
fix p q fix p q
assume assume
"(p, q) \<in> fp_step {(x, y). greatest_coupled_simulation x y}" \<open>(p, q) \<in> fp_step {(x, y). greatest_coupled_simulation x y}\<close>
hence "(\<forall>p' a. p \<longmapsto>a p' \<longrightarrow> (\<exists>q'. greatest_coupled_simulation p' q' \<and> q \<longmapsto>^~ a q')) \<and> hence
(\<exists>q'. q \<longmapsto>* tau q' \<and> greatest_coupled_simulation q' p)" \<open>(\<forall>p' a. p \<longmapsto>a p' \<longrightarrow>
(tau a \<longrightarrow> greatest_coupled_simulation p' q) \<and>
(\<not>tau a \<longrightarrow> (\<exists>q'. greatest_coupled_simulation p' q' \<and> q =\<rhd>a q'))) \<and>
(\<exists>q'. q \<longmapsto>* tau q' \<and> greatest_coupled_simulation q' p)\<close>
unfolding fp_step_def by auto unfolding fp_step_def by auto
hence "(\<forall>p' a. p \<longmapsto>a p' \<longrightarrow> (\<exists>q'. greatest_coupled_simulation p' q' \<and> q \<longmapsto>^ a q')) \<and> hence \<open>(\<forall>p' a. p \<longmapsto>a p' \<longrightarrow> (\<exists>q'. greatest_coupled_simulation p' q' \<and> q \<Rightarrow>^a q')) \<and>
(\<exists>q'. q \<longmapsto>* tau q' \<and> greatest_coupled_simulation q' p)" (\<exists>q'. q \<longmapsto>* tau q' \<and> greatest_coupled_simulation q' p)\<close>
unfolding fp_step_def using weak_step_delay_implies_weak_tau by blast unfolding fp_step_def using weak_step_delay_implies_weak_tau steps.refl by blast
hence "(\<forall>p' a. p \<longmapsto>a p' \<longrightarrow> (\<exists>q'. greatest_coupled_simulation p' q' \<and> q \<longmapsto>^^ a q')) \<and> hence \<open>(\<forall>p' a. p \<longmapsto>a p' \<longrightarrow> (\<exists>q'. greatest_coupled_simulation p' q' \<and> q \<Rightarrow>^^a q')) \<and>
(\<exists>q'. q \<longmapsto>* tau q' \<and> greatest_coupled_simulation q' p)" using weak_step_tau2_def by simp (\<exists>q'. q \<longmapsto>* tau q' \<and> greatest_coupled_simulation q' p)\<close>
thus "greatest_coupled_simulation p q" using weak_step_tau2_def by simp
thus \<open>greatest_coupled_simulation p q\<close>
using lts_tau.gcs by metis using lts_tau.gcs by metis
next next
fix p q fix p q
assume asm: assume asm:
"greatest_coupled_simulation p q" \<open>greatest_coupled_simulation p q\<close>
then have "(p, q) \<in> {(x, y). greatest_coupled_simulation x y}" by blast then have \<open>(p, q) \<in> {(x, y). greatest_coupled_simulation x y}\<close> by blast
moreover from asm have \<open>\<exists> R. R p q \<and> coupled_delay_simulation R\<close> moreover from asm have \<open>\<exists> R. R p q \<and> coupled_delay_simulation R\<close>
unfolding gcs_eq_coupled_sim_by[symmetric] coupled_sim_by_eq_delay_coupled_simulation . unfolding gcs_eq_coupled_sim_by[symmetric] coupled_sim_by_eq_coupled_delay_simulation .
moreover from asm have "(\<forall> p' a. p \<longmapsto> a p' \<longrightarrow> (\<exists> q'. (greatest_coupled_simulation p' q') \<and> (q \<longmapsto>^~ a q')))" moreover from asm have \<open>\<forall> p' a. p \<longmapsto>a p' \<and> \<not>tau a \<longrightarrow>
unfolding gcs_eq_coupled_sim_by[symmetric] coupled_sim_by_eq_delay_coupled_simulation (\<exists> q'. (greatest_coupled_simulation p' q') \<and> (q =\<rhd>a q'))\<close>
unfolding gcs_eq_coupled_sim_by[symmetric] coupled_sim_by_eq_coupled_delay_simulation
by (metis coupled_delay_simulation_def delay_simulation_def)
moreover from asm have \<open>\<forall> p' a. p \<longmapsto>a p' \<and> tau a \<longrightarrow> greatest_coupled_simulation p' q\<close>
unfolding gcs_eq_coupled_sim_by[symmetric] coupled_sim_by_eq_coupled_delay_simulation
by (metis coupled_delay_simulation_def delay_simulation_def) by (metis coupled_delay_simulation_def delay_simulation_def)
moreover have "(\<exists> q'. q \<longmapsto>*tau q' \<and> (greatest_coupled_simulation q' p))" moreover have \<open>(\<exists> q'. q \<longmapsto>*tau q' \<and> (greatest_coupled_simulation q' p))\<close>
using asm gcs_is_coupled_simulation coupled_simulation_implies_coupling by blast using asm gcs_is_coupled_simulation coupled_simulation_implies_coupling by blast
ultimately show "(p, q) \<in> fp_step {(x, y). greatest_coupled_simulation x y}" ultimately show \<open>(p, q) \<in> fp_step {(x, y). greatest_coupled_simulation x y}\<close>
unfolding fp_step_def by blast unfolding fp_step_def by blast
qed qed
lemma gfp_fp_step_gcs: "gfp fp_step = { (p,q) . greatest_coupled_simulation p q }" lemma gfp_fp_step_gcs: \<open>gfp fp_step = { (p,q) . greatest_coupled_simulation p q }\<close>
using fp_fp_step_gcs gfp_fp_step_subset_gcs using fp_fp_step_gcs gfp_fp_step_subset_gcs
by (simp add: equalityI gfp_upperbound) by (simp add: equalityI gfp_upperbound)
...@@ -98,14 +116,14 @@ context lts_tau_finite ...@@ -98,14 +116,14 @@ context lts_tau_finite
begin begin
lemma gfp_fp_step_while: lemma gfp_fp_step_while:
shows shows
"gfp fp_step = while (\<lambda>R. fp_step R \<noteq> R) fp_step top" \<open>gfp fp_step = fp_compute_cs\<close>
unfolding fp_compute_cs_def
using gfp_while_lattice[OF mono_fp_step] finite_state_rel Finite_Set.finite_set by blast using gfp_while_lattice[OF mono_fp_step] finite_state_rel Finite_Set.finite_set by blast
theorem coupled_sim_fp_step_while: theorem coupled_sim_fp_step_while:
shows "while (\<lambda>R. fp_step R \<noteq> R) fp_step top = { (p,q) . greatest_coupled_simulation p q }" shows \<open>fp_compute_cs = { (p,q) . greatest_coupled_simulation p q }\<close>
using gfp_fp_step_while gfp_fp_step_gcs by blast using gfp_fp_step_while gfp_fp_step_gcs by blast
end end
end end
This source diff could not be displayed because it is too large. You can view the blob instead.
section \<open>Preliminaries\<close>
subsection \<open>Some Utilities for Finite Partial Orders\<close>
text \<open>For some reason there seems to be no Isaeblle support for maximal elements in finite regions
of incomplete partial orders (such as the transitive step relation in cycle-compressed transition
systems ;).)\<close>
theory Finite_Partial_Order
imports Main
begin
context preorder
begin
lemma foldl_max_inflation:
\<open>foldl max x0 xs \<le> foldl max x0 (xs @ [x])\<close>
unfolding foldl_append foldl.simps
by (simp add: ord.max_def)
lemma foldl_max_soundness:
shows
\<open>foldl max x0 (x0 # xs) \<in> set (x0 # xs)\<close>
proof (induct xs rule: rev_induct)
case Nil
then show ?case by (auto simp add: max_def)
next
case (snoc x xs)
then show ?case unfolding foldl_append max_def by auto
qed
lemma foldl_max_maximal:
shows
\<open>\<forall> y \<in> set (x0 # xs). foldl max x0 (x0 # xs) \<le> y \<longrightarrow> y \<le> foldl max x0 (x0 # xs)\<close>
proof (induct xs rule: rev_induct)
case Nil
then show ?case by (auto simp add: max_def)
next
case (snoc x xs)
then show ?case unfolding foldl.simps foldl_append
by (metis Un_insert_right append_Nil2 foldl_Cons insert_iff list.simps(15) local.order_refl
local.order_trans ord.max_def set_append snoc.hyps)
qed
end
context order \<comment>\<open>that is: partial order\<close>
begin
lemma finite_max:
fixes q
defines \<open>above_q \<equiv> {q'. q \<le> q'}\<close>
assumes
\<open>finite above_q\<close>
shows
\<open>\<exists> q_max. q_max \<in> above_q \<and> (\<forall> q''\<in> above_q. q_max \<le> q'' \<longrightarrow> q'' = q_max)\<close>
proof -
have \<open>q \<in> above_q\<close> unfolding above_q_def by blast
then obtain above_list where above_list_spec: \<open>set (q#above_list) = above_q\<close>
using \<open>finite above_q\<close> finite_list by auto
define q_max where \<open>q_max \<equiv> foldl max q (q#above_list)\<close>
have \<open>q_max \<in> above_q\<close>
unfolding q_max_def above_list_spec[symmetric] using foldl_max_soundness .
moreover have \<open>\<forall> q'' \<in> above_q. q_max \<le> q'' \<longrightarrow> q'' = q_max\<close>
unfolding q_max_def above_list_spec[symmetric] using foldl_max_maximal antisym by blast
ultimately show ?thesis by blast
qed
end
end
\ No newline at end of file
...@@ -3,11 +3,10 @@ session "Coupled_Simulation" = "HOL" + ...@@ -3,11 +3,10 @@ session "Coupled_Simulation" = "HOL" +
theories [quick_and_dirty, document = false] theories [quick_and_dirty, document = false]
"~~/src/HOL/Library/While_Combinator" "~~/src/HOL/Library/While_Combinator"
"~~/src/HOL/Library/Finite_Lattice" "~~/src/HOL/Library/Finite_Lattice"
theories [quick_and_dirty] theories
CS_Fixpoint_Algo
CS_Game
CS_Fixpoint_Algo_Delay CS_Fixpoint_Algo_Delay
CS_Game_Delay CS_Game_Delay
document_files document_files
"root.tex" "root.tex"
(*"root.bib"*) "root.bib"
"splncs04.bst"
...@@ -8,53 +8,65 @@ begin ...@@ -8,53 +8,65 @@ begin
text \<open>Simple games are games where player0 wins all infinite plays.\<close> text \<open>Simple games are games where player0 wins all infinite plays.\<close>
locale simple_game = locale simple_game =
fixes fixes
game_move :: "'s \<Rightarrow> 's \<Rightarrow> bool" ("_ \<longmapsto>\<heartsuit> _" [70, 70] 80) and game_move :: \<open>'s \<Rightarrow> 's \<Rightarrow> bool\<close> ("_ \<longmapsto>\<heartsuit> _" [70, 70] 80) and
player0_position :: "'s \<Rightarrow> bool" and player0_position :: \<open>'s \<Rightarrow> bool\<close> and
initial :: 's initial :: 's
begin begin
definition player1_position :: "'s \<Rightarrow> bool" definition player1_position :: \<open>'s \<Rightarrow> bool\<close>
where "player1_position s \<equiv> \<not> player0_position s" where \<open>player1_position s \<equiv> \<not> player0_position s\<close>
\<comment>\<open>plays (to be precise: play p refixes) are lists. we model them \<comment>\<open>plays (to be precise: play p refixes) are lists. we model them
with the most recent move at the beginning. (for our purpose it's enough to consider finite plays)\<close> with the most recent move at the beginning. (for our purpose it's enough to consider finite plays)\<close>
type_synonym ('s2) play = "'s2 list" type_synonym ('s2) play = \<open>'s2 list\<close>
type_synonym ('s2) strategy = "'s2 play \<Rightarrow> 's2" type_synonym ('s2) strategy = \<open>'s2 play \<Rightarrow> 's2\<close>
inductive_set plays :: "'s play set" where inductive_set plays :: \<open>'s play set\<close> where
"[initial] \<in> plays" | \<open>[initial] \<in> plays\<close> |
"p#play \<in> plays \<Longrightarrow> p \<longmapsto>\<heartsuit> p' \<Longrightarrow> p'#p#play \<in> plays" \<open>p#play \<in> plays \<Longrightarrow> p \<longmapsto>\<heartsuit> p' \<Longrightarrow> p'#p#play \<in> plays\<close>
\<comment>\<open>plays for a given player 0 strategy\<close> \<comment>\<open>plays for a given player 0 strategy\<close>
inductive_set plays_for_strategy :: "'s strategy \<Rightarrow> 's play set" for f where inductive_set plays_for_strategy :: \<open>'s strategy \<Rightarrow> 's play set\<close> for f where
init: "[initial] \<in> plays_for_strategy f" | init: \<open>[initial] \<in> plays_for_strategy f\<close> |
p0move: "n0#play \<in> plays_for_strategy f \<Longrightarrow> player0_position n0 \<Longrightarrow> n0 \<longmapsto>\<heartsuit> f (n0#play) p0move: \<open>n0#play \<in> plays_for_strategy f \<Longrightarrow> player0_position n0 \<Longrightarrow> n0 \<longmapsto>\<heartsuit> f (n0#play)
\<Longrightarrow> (f (n0#play))#n0#play \<in> plays_for_strategy f" | \<Longrightarrow> (f (n0#play))#n0#play \<in> plays_for_strategy f\<close> |
p1move: "n1#play \<in> plays_for_strategy f \<Longrightarrow> player1_position n1 \<Longrightarrow> n1 \<longmapsto>\<heartsuit> n1' p1move: \<open>n1#play \<in> plays_for_strategy f \<Longrightarrow> player1_position n1 \<Longrightarrow> n1 \<longmapsto>\<heartsuit> n1'
\<Longrightarrow> n1'#n1#play \<in> plays_for_strategy f" \<Longrightarrow> n1'#n1#play \<in> plays_for_strategy f\<close>
lemma strategy_step:
assumes
\<open>n0 # n1 # rest \<in> plays_for_strategy f\<close>
\<open>player0_position n1\<close>
shows
\<open>f (n1 # rest) = n0\<close>
using assms
by (induct rule: plays_for_strategy.cases, auto simp add: simple_game.player1_position_def)
definition positional_strategy :: \<open>'s strategy \<Rightarrow> bool\<close> where
\<open>positional_strategy f \<equiv> \<forall>r1 r2 n. f (n # r1) = f (n # r2)\<close>
text \<open>a strategy is sound if it only decides on enabled transitions.\<close> text \<open>a strategy is sound if it only decides on enabled transitions.\<close>
definition sound_strategy :: "'s strategy \<Rightarrow> bool" where definition sound_strategy :: \<open>'s strategy \<Rightarrow> bool\<close> where
"sound_strategy f \<equiv> \<open>sound_strategy f \<equiv>
\<forall> n0 play . n0#play \<in> plays_for_strategy f \<and> player0_position n0 \<longrightarrow> n0 \<longmapsto>\<heartsuit> f (n0#play)" \<forall> n0 play . n0#play \<in> plays_for_strategy f \<and> player0_position n0 \<longrightarrow> n0 \<longmapsto>\<heartsuit> f (n0#play)\<close>
lemma strategy_plays_subset: lemma strategy_plays_subset:
assumes "play \<in> plays_for_strategy f" assumes \<open>play \<in> plays_for_strategy f\<close>
shows "play \<in> plays" shows \<open>play \<in> plays\<close>
using assms by (induct rule: plays_for_strategy.induct, auto simp add: plays.intros) using assms by (induct rule: plays_for_strategy.induct, auto simp add: plays.intros)
lemma no_empty_plays: lemma no_empty_plays:
assumes "[] \<in> plays" assumes \<open>[] \<in> plays\<close>
shows "False" shows \<open>False\<close>
using assms plays.cases by blast using assms plays.cases by blast
text \<open>player1 wins a play if the play has reached a deadlock where it's player0's turn\<close>
text"player1 wins a play if the play has reached a deadlock where it's player0's turn" definition player1_wins :: \<open>'s play \<Rightarrow> bool\<close> where
definition player1_wins :: "'s play \<Rightarrow> bool" where \<open>player1_wins play \<equiv> player0_position (hd play) \<and> (\<nexists> p' . (hd play) \<longmapsto>\<heartsuit> p')\<close>
"player1_wins play \<equiv> player0_position (hd play) \<and> (\<nexists> p' . (hd play) \<longmapsto>\<heartsuit> p')"
definition player0_winning_strategy :: "'s strategy \<Rightarrow> bool" where definition player0_winning_strategy :: \<open>'s strategy \<Rightarrow> bool\<close> where
"player0_winning_strategy f \<equiv> (\<forall> play \<in> plays_for_strategy f . \<not> player1_wins play)" \<open>player0_winning_strategy f \<equiv> (\<forall> play \<in> plays_for_strategy f . \<not> player1_wins play)\<close>
end end
......
section \<open>Strong Simulation and Bisimulation\<close> section \<open>Notions of Equivalence\<close>
subsection \<open>Strong Simulation and Bisimulation\<close>
theory Strong_Relations theory Strong_Relations
imports Transition_Systems imports Transition_Systems
...@@ -8,37 +10,29 @@ context lts ...@@ -8,37 +10,29 @@ context lts
begin begin
definition simulation :: definition simulation ::
"('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" \<open>('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool\<close>
where
"simulation R \<equiv> \<forall> p q. R p q \<longrightarrow>
(\<forall> p' a. p \<longmapsto> a p' \<longrightarrow>
(\<exists> q'. R p' q' \<and> (q \<longmapsto> a q')))"
definition simulation_on ::
"('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's set \<Rightarrow> 's set \<Rightarrow> bool"
where where
"simulation_on R S1 S2 \<equiv> \<forall> p \<in> S1. \<forall> q \<in> S2. R p q \<longrightarrow> \<open>simulation R \<equiv> \<forall> p q. R p q \<longrightarrow>
(\<forall> p' \<in> S1 . \<forall> a . p \<longmapsto> a p' \<longrightarrow> (\<forall> p' a. p \<longmapsto>a p' \<longrightarrow>
(\<exists> q' \<in> S2 . R p' q' \<and> (q \<longmapsto> a q')))" (\<exists> q'. R p' q' \<and> (q \<longmapsto>a q')))\<close>
definition bisimulation :: definition bisimulation ::
"('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool" \<open>('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool\<close>
where where
"bisimulation R \<equiv> \<forall> p q. R p q \<longrightarrow> \<open>bisimulation R \<equiv> \<forall> p q. R p q \<longrightarrow>
(\<forall> p' a. p \<longmapsto> a p' \<longrightarrow> (\<forall> p' a. p \<longmapsto>a p' \<longrightarrow>
(\<exists> q'. R p' q' \<and> (q \<longmapsto> a q'))) \<and> (\<exists> q'. R p' q' \<and> (q \<longmapsto>a q'))) \<and>
(\<forall> q' a. q \<longmapsto> a q' \<longrightarrow> (\<forall> q' a. q \<longmapsto>a q' \<longrightarrow>
(\<exists> p'. R p' q' \<and> (p \<longmapsto> a p')))" (\<exists> p'. R p' q' \<and> (p \<longmapsto>a p')))\<close>
lemma bisim_ruleformat: lemma bisim_ruleformat:
assumes "bisimulation R" assumes \<open>bisimulation R\<close>
and "R p q" and \<open>R p q\<close>
shows shows
"p \<longmapsto> a p' \<Longrightarrow> (\<exists> q'. R p' q' \<and> (q \<longmapsto> a q'))" \<open>p \<longmapsto>a p' \<Longrightarrow> (\<exists> q'. R p' q' \<and> (q \<longmapsto>a q'))\<close>
"q \<longmapsto> a q' \<Longrightarrow> (\<exists> p'. R p' q' \<and> (p \<longmapsto> a p'))" \<open>q \<longmapsto>a q' \<Longrightarrow> (\<exists> p'. R p' q' \<and> (p \<longmapsto>a p'))\<close>
using assms unfolding bisimulation_def by auto using assms unfolding bisimulation_def by auto
end \<comment>\<open>context lts\<close> end \<comment>\<open>context lts\<close>
end end
section \<open>Transition Systems\<close> subsection \<open>Labeled Transition Systems\<close>
theory Transition_Systems theory Transition_Systems
imports Main imports Finite_Partial_Order
begin begin
locale lts = locale lts =
fixes fixes
trans :: "'s \<Rightarrow> 'a \<Rightarrow> 's \<Rightarrow> bool" trans :: \<open>'s \<Rightarrow> 'a \<Rightarrow> 's \<Rightarrow> bool\<close>
begin begin
abbreviation step_pred :: "'s \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 's \<Rightarrow> bool" where abbreviation step_pred :: \<open>'s \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 's \<Rightarrow> bool\<close>
"step_pred p af q \<equiv> \<exists> a. af a \<and> trans p a q" where
\<open>step_pred p af q \<equiv> \<exists> a. af a \<and> trans p a q\<close>
abbreviation step :: abbreviation step ::
"'s \<Rightarrow> 'a \<Rightarrow> 's \<Rightarrow> bool" \<open>'s \<Rightarrow> 'a \<Rightarrow> 's \<Rightarrow> bool\<close>
("_ \<longmapsto>_ _" [70, 70, 70] 80) ("_ \<longmapsto>_ _" [70, 70, 70] 80)
where where
"p \<longmapsto>a q \<equiv> trans p a q" \<open>p \<longmapsto>a q \<equiv> trans p a q\<close>
inductive steps :: "'s \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 's \<Rightarrow> bool" inductive steps :: \<open>'s \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 's \<Rightarrow> bool\<close>
("_ \<longmapsto>* _ _" [70, 70, 70] 80) ("_ \<longmapsto>* _ _" [70, 70, 70] 80)
where where
refl: "p \<longmapsto>* af p" refl: \<open>p \<longmapsto>* A p\<close> | step: \<open>p \<longmapsto>* A q1 \<Longrightarrow> q1 \<longmapsto>a q \<Longrightarrow> A a \<Longrightarrow> (p \<longmapsto>* A q)\<close>
| step: "p \<longmapsto>* af q1 \<Longrightarrow> q1 \<longmapsto> a q \<Longrightarrow> af a \<Longrightarrow> (p \<longmapsto>* af q)"
lemma steps_one_step: lemma steps_one_step:
assumes assumes
"p \<longmapsto> a p'" \<open>p \<longmapsto>a p'\<close>
"A a" \<open>A a\<close>
shows shows
"p \<longmapsto>* A p'" \<open>p \<longmapsto>* A p'\<close> using steps.step[of p A p a p'] steps.refl[of p A] assms .
using steps.step[of p A p a p'] steps.refl[of p A] assms .
lemma steps_concat:
assumes
\<open>p' \<longmapsto>* A p''\<close>
\<open>p \<longmapsto>* A p'\<close>
shows
\<open>p \<longmapsto>* A p''\<close> using assms
proof (induct arbitrary: p)
case (refl p'' A p')
then show ?case by auto
next
case (step p' A p'' a pp p)
hence \<open>p \<longmapsto>* A p''\<close> by simp
show ?case using steps.step[OF `p \<longmapsto>* A p''` step(3,4)] .
qed
lemma steps_left: lemma steps_left:
assumes assumes
"p \<noteq> p'" \<open>p \<noteq> p'\<close>
"p \<longmapsto>* A p'" \<open>p \<longmapsto>* A p'\<close>
shows shows
"\<exists>p'' a . p \<longmapsto> a p'' \<and> A a" \<open>\<exists>p'' a . p \<longmapsto>a p'' \<and> A a \<and> p'' \<longmapsto>* A p'\<close>
using assms(2,1) by (induct, auto) using assms(1)
by (induct rule:steps.induct[OF assms(2)], blast, metis refl steps_concat steps_one_step)
lemma steps_no_step: lemma steps_no_step:
assumes assumes
"\<And> a p' . p \<longmapsto> a p' \<Longrightarrow> \<not>A a" \<open>\<And> a p' . p \<longmapsto>a p' \<Longrightarrow> \<not>A a\<close>
"p \<noteq> p''" \<open>p \<noteq> p''\<close>
"p \<longmapsto>* A p''" \<open>p \<longmapsto>* A p''\<close>
shows shows
"False" \<open>False\<close>
using steps_left[OF assms(2,3)] assms(1) by blast using steps_left[OF assms(2,3)] assms(1) by blast
lemma steps_no_step_pos: lemma steps_no_step_pos:
assumes assumes
"\<And> a p' . p \<longmapsto> a p' \<Longrightarrow> \<not>A a" \<open>\<And> a p' . p \<longmapsto>a p' \<Longrightarrow> \<not>A a\<close>
"p \<longmapsto>* A p'" \<open>p \<longmapsto>* A p'\<close>
shows shows
"p = p'" \<open>p = p'\<close>
using assms steps_no_step by blast using assms steps_no_step by blast
lemma steps_loop: