I have defined such a labled transition system as below, and a function to judge given a list whether it could be reached.
type_synonym ('q,'a) LTS = "('q * 'a set * 'q) set"
primrec LTS_is_reachable :: "('q, 'a) LTS \<Rightarrow> 'q \<Rightarrow> 'a list \<Rightarrow> 'q \<Rightarrow> bool" where
"LTS_is_reachable \<Delta> q [] q' = (q = q')"|
"LTS_is_reachable \<Delta> q (a # w) q' =
(\<exists>q'' \<sigma>. a \<in> \<sigma> \<and> (q, \<sigma>, q'') \<in> \<Delta> \<and> LTS_is_reachable \<Delta> q'' w q')"
But the problem is that i don't know how to prove below lemma.
lemma "LTS_is_reachable {([], {v}, [v])} [] x [v] \<Longrightarrow> x = [v]"
In order to use the definition you have to make a case distinction on x to make the definition patterns appear:
lemma "LTS_is_reachable {([], {v}, [v])} [] x [v] ⟹ x = [v]"
apply (cases x; cases ‹tl x›)
apply auto
done
EDIT: as a side remark, it feels more natural to me to first define a function returning the set of all reachable states and then check if v is with the set. I expect this version to be easier to reason with.
Related
The labeled transition of Isballe is defined below, which contains the prior node and the successor node, the set represents the condition.
type_synonym ('q,'a) LTS = "('q * 'a set * 'q) set"
After the LTS, we need to define a function of the reachable from Node a to Node b. The definition of LTS_is_reachable like:
inductive LTS_is_reachable :: "('q, 'a) LTS ⇒ ('q * 'q) set ⇒ 'q ⇒ 'a list ⇒ 'q ⇒ bool" for Δ and Δ' where
LTS_Empty[intro!]: "LTS_is_reachable Δ Δ' q [] q" |
LTS_Step1: "LTS_is_reachable Δ Δ' q l q'" if "(q, q'') ∈ Δ'" and "LTS_is_reachable Δ Δ' q'' l q'" |
LTS_Step2[intro!]: "LTS_is_reachable Δ Δ' q (a # w) q'" if "a ∈ σ" and "(q, σ, q'') ∈ Δ" and "LTS_is_reachable Δ Δ' q'' w q'"
where the LTS_empty denotes node q could arrive at self by empty list, LTS_Step1 denotes if there exists node q and p in Delta', then q could reach p no condition, and LTS_Step2 denotes that node q could reach node q'' by the alphbet sigma.
Finally, I try to prove a lemma
lemma removeFromAtoEndTrans:"LTS_is_reachable Δ (insert (ini, end) Δ') ini l end ⟹ l ≠ [] ⟹ ∀(q, σ, p) ∈ Δ. q ≠ ini ∧ q ≠ end ⟹ ∀(end, p) ∈ Δ'. p = end ⟹ LTS_is_reachable Δ Δ' ini l end"
This lemma said that if the list l isn't empty, we could remove ini-> end from Delta2. It obviously holds. Through the tool nitpick, it can not find any counter-examples. But I could think about any ideas to prove it. Any helps would be appreciated.
type_synonym ('q,'a) LTS = "('q * 'a set * 'q) set"
primrec LTS_is_reachable :: "('q, 'a) LTS \<Rightarrow> 'q \<Rightarrow> 'a list \<Rightarrow> 'q \<Rightarrow> bool" where
"LTS_is_reachable \<Delta> q [] q' = (q = q')"|
"LTS_is_reachable \<Delta> q (a # w) q' =
(\<exists>q'' \<sigma>. a \<in> \<sigma> \<and> (q, \<sigma>, q'') \<in> \<Delta> \<and> LTS_is_reachable \<Delta> q'' w q')"
lemma DeltLTSlemma:"LTS_is_reachable Δ q x y \<Longrightarrow>LTS_is_reachable {(f a, b, f c)| a b c. (a,b,c)\<in> Δ } (f q) x (f y)"
apply(induct x arbitrary:q)
apply auto
done
I've defined a fun LTS_is_reachable as above, and give a lemma to prove it. But for introduce a new relation in the LTS system, i change the form into the inductive predivate below. This lemma can not work, and I am not able to handle this.
type_synonym ('q,'a) LTS = "('q * 'a set * 'q) set"
inductive LTS_is_reachable :: "('q, 'a) LTS \<Rightarrow> 'q \<Rightarrow> 'a list \<Rightarrow> 'q \<Rightarrow> bool" where
LTS_Empty:"LTS_is_reachable \<Delta> q [] q"|
LTS_Step:"(\<exists>q'' \<sigma>. a \<in> \<sigma> \<and> (q, \<sigma>, q'') \<in> \<Delta> \<and> LTS_is_reachable \<Delta> q'' w q') \<Longrightarrow> LTS_is_reachable \<Delta> q (a # w) q'"|
LTS_Epi:"(\<exists>q''. (q,{},q'') \<in> \<Delta> \<and> LTS_is_reachable \<Delta> q'' l q') \<Longrightarrow> LTS_is_reachable \<Delta> q l q'"
inductive_cases LTS_Step_cases[elim!]:"LTS_is_reachable \<Delta> q (a # w) q'"
inductive_cases LTS_Epi_cases[elim!]:"LTS_is_reachable \<Delta> q l q'"
inductive_cases LTS_Empty_cases[elim!]:"LTS_is_reachable \<Delta> q [] q"
lemma "LTS_is_reachable {(q, v, y)} q x y ⟹ LTS_is_reachable {(f q, v, f y)} (f q) x (f y)"
proof(induct x arbitrary:q)
case Nil
then show ?case
by (metis (no_types, lifting) LTS_Empty LTS_Epi LTS_Epi_cases Pair_inject list.distinct(1) singletonD singletonI)
next
case (Cons a x)
then show ?case
qed
Thank you very much for your help.
Using your inductive definition of LTS_is_reachable, you can prove your original lemma DeltLTSlemma by rule induction, that is, by using proof (induction rule: LTS_is_reachable.induct). You can learn more about rule induction in Section 3.5 of Programming and Proving in
Isabelle/HOL. As a side remark, note that you can avoid using inductive_cases since nowadays structured proofs (i.e., Isar proofs) are strongly preferred over unstructured proofs (i.e., apply-scripts).
type_synonym ('q,'a) LTS = "('q * 'a set * 'q) set"
primrec LTS_is_reachable :: "('q, 'a) LTS \<Rightarrow> 'q \<Rightarrow> 'a list \<Rightarrow> 'q \<Rightarrow> bool" where
"LTS_is_reachable \<Delta> q [] q' = (q = q')"|
"LTS_is_reachable \<Delta> q (a # w) q' =
(\<exists>q'' \<sigma>. a \<in> \<sigma> \<and> (q, \<sigma>, q'') \<in> \<Delta> \<and> LTS_is_reachable \<Delta> q'' w q')"
lemma subLTSlemma:"LTS_is_reachable l1 q x y \<Longrightarrow> LTS_is_reachable (l1 \<union> l2) q x
If the transition system L1 satisfies the reachability of X, then whether the transition system containing L1 also satisfies this property. I met some difficulties in proving this lemma. Please help me prove it. Isar will be better.
I am trying to solve Exercise 4.6 in “Programming and Proving in Isabelle/HOL”. It asks to define a function elems :: "'a list ⇒ 'a set" that converts a list into a set, and to prove the lemma "x ∈ elems xs ⟹ ∃ ys zs . xs = ys # x # zs ∧ x ∉ elems ys". Until now, I have come that far:
fun elems :: "'a list ⇒ 'a set" where
"elems [] = {}" |
"elems (x # xs) = {x} ∪ elems xs"
lemma first_occ: "x ∈ elems xs ⟹ ∃ ys zs . xs = ys # x # zs ∧ x ∉ elems ys"
proof (induction xs)
case Nil
thus ?case by simp
next
case (Cons u us)
show ?case
proof cases
assume "x = u"
thus ?case
proof
⟨…⟩
At this point, I get the error message “Failed to apply initial proof method”. This is strange, since the goal, ?case, is the proposition ∃ ys zs . u # us = ys # x # zs ∧ x ∉ elems ys, and it should be possible to prove existential propositions by showing the proposition under the ∃ for a specific witness.
the problem with your line proof is that it proof is meant to apply some default rule. In the above proof, Isabelle is not able to figure out that you want to perform existential introduction. So, you probably want to explicitly tell the system to do so, e.g., by continue with something like proof (intro exI).
I hope, this helps,
René
I have a partially-defined operator (disj_union below) on sets that I would like to lift to a quotient type (natq). Morally, I think this should be ok, because it is always possible to find in the equivalence class some representative for which the operator is defined [*]. However, I cannot complete the proof that the lifted definition preserves the equivalence, because disj_union is only partially defined. In my theory file below, I propose one way I have found to define my disj_union operator, but I don't like it because it features lots of abs and Rep functions, and I think it would be hard to work with (right?).
What is a good way to define this kind of thing using quotients in Isabelle?
theory My_Theory imports
"~~/src/HOL/Library/Quotient_Set"
begin
(* A ∪-operator that is defined only on disjoint operands. *)
definition "X ∩ Y = {} ⟹ disj_union X Y ≡ X ∪ Y"
(* Two sets are equivalent if they have the same cardinality. *)
definition "card_eq X Y ≡ finite X ∧ finite Y ∧ card X = card Y"
(* Quotient sets of naturals by this equivalence. *)
quotient_type natq = "nat set" / partial: card_eq
proof (intro part_equivpI)
show "∃x. card_eq x x" by (metis card_eq_def finite.emptyI)
show "symp card_eq" by (metis card_eq_def symp_def)
show "transp card_eq" by (metis card_eq_def transp_def)
qed
(* I want to lift my disj_union operator to the natq type.
But I cannot complete the proof, because disj_union is
only partially defined. *)
lift_definition natq_add :: "natq ⇒ natq ⇒ natq"
is "disj_union"
oops
(* Here is another attempt to define natq_add. I think it
is correct, but it looks hard to prove things about,
because it uses abstraction and representation functions
explicitly. *)
definition natq_add :: "natq ⇒ natq ⇒ natq"
where "natq_add X Y ≡
let (X',Y') = SOME (X',Y').
X' ∈ Rep_natq X ∧ Y' ∈ Rep_natq Y ∧ X' ∩ Y' = {}
in abs_natq (disj_union X' Y')"
end
[*] This is a little bit like how capture-avoiding substitution is only defined on the condition that bound variables do not clash; a condition that can always be satisfied by renaming to another representative in the alpha-equivalence class.
What about something like this (just an idea):
definition disj_union' :: "nat set ⇒ nat set ⇒ nat set"
where "disj_union' X Y ≡
let (X',Y') = SOME (X',Y').
card_eq X' X ∧ card_eq Y' Y ∧ X' ∩ Y' = {}
in disj_union X' Y'"
lift_definition natq_add :: "natq ⇒ natq ⇒ natq"
is "disj_union'" oops
For the record, here is Ondřej's suggestion (well, a slight amendment thereof, in which only one of the operands is renamed, not both) carried out to completion...
(* A version of disj_union that is always defined. *)
definition disj_union' :: "nat set ⇒ nat set ⇒ nat set"
where "disj_union' X Y ≡
let Y' = SOME Y'.
card_eq Y' Y ∧ X ∩ Y' = {}
in disj_union X Y'"
(* Can always choose a natural that is not in a given finite subset of ℕ. *)
lemma nats_infinite:
fixes A :: "nat set"
assumes "finite A"
shows "∃x. x ∉ A"
proof (rule ccontr, simp)
assume "∀x. x ∈ A"
hence "A = UNIV" by fast
hence "finite UNIV" using assms by fast
thus False by fast
qed
(* Can always choose n naturals that are not in a given finite subset of ℕ. *)
lemma nat_renaming:
fixes x :: "nat set" and n :: nat
assumes "finite x"
shows "∃z'. finite z' ∧ card z' = n ∧ x ∩ z' = {}"
using assms
apply (induct n)
apply (intro exI[of _ "{}"], simp)
apply (clarsimp)
apply (rule_tac x="insert (SOME y. y ∉ x ∪ z') z'" in exI)
apply (intro conjI, simp)
apply (rule someI2_ex, rule nats_infinite, simp, simp)+
done
lift_definition natq_add :: "natq ⇒ natq ⇒ natq"
is "disj_union'"
apply (unfold disj_union'_def card_eq_def)
apply (rule someI2_ex, simp add: nat_renaming)
apply (rule someI2_ex, simp add: nat_renaming)
apply (metis card.union_inter_neutral disj_union_def empty_iff finite_Un)
done