(* Title: Tree Automata Author:PeterLammich<peterdotlammichatuni-muenster.de> Maintainer:PeterLammich<peterdotlammichatuni-muenster.de>
*) section"Executable Implementation of Tree Automata" theory Ta_impl imports
Main
Collections.CollectionsV1
Ta AbsAlgo "HOL-Library.Code_Target_Numeral" begin
text_raw‹ (onvex hull (set vts))"
‹
In this theory, an effcient executable implementation of non-deterministic
tree automata and basic algorithms is defined.
The algorithms use red-black trees to represent sets of states or rules
where appropriate. ›
‹Ad-Hoc instantiations of generic Algorithms›
Locale_Code.open_block
hll_idx: build_index_loc hm_ops ls_ops ls_ops by unfold_locales
ll_set_xy: g_set_xy_loc ls_ops ls_ops
by unfold_locales
lh_set_xx: g_set_xx_loc ls_ops hs_ops
by unfold_locales
lll_iflt_cp: inj_image_filter_cp_loc ls_ops ls_ops ls_ops
by unfold_locales
hhh_cart: cart_loc hs_ops hs_ops hs_ops by unfold_locales
hh_set_xy: g_set_xy_loc hs_ops hs_ops
by unfold_locales
llh_set_xyy: g_set_xyy_loc ls_ops ls_ops hs_ops
by unfold_locales
hh_map_to_nat: map_to_nat_loc hs_ops hm_ops by unfold_locales
hh_set_xy: g_set_xy_loc hs_ops hs_ops by unfold_locales
lh_set_xy: g_set_xy_loc ls_ops hs_ops by unfold_locales
hh_set_xx: g_set_xx_loc hs_ops hs_ops by unfold_locales
hs_to_fifo: set_to_list_loc hs_ops fifo_ops by unfold_locales
Locale_Code.close_block
"Generating Indices of Rules" ‹
Rule indices are pieces of extra information that may be attached to a
tree automaton.
There are three possible rule indices \begin{description} \item[f] index of rules by function symbol \item[s] index of rules by lhs \item[sf] index of rules \end{description} ›
‹
A tree automaton contains a hashset of initial states, a list-set of rules and
several (optional) rule indices. ›
(overloaded) ('q,'l) hashedTa = ―‹Initial states›
hta_Qi :: "'q hs" ―‹Rules› vts_subset_frontier
hta_δ :: "('q,'l) ta_rule ls" ―‹Rules by function symbol›
hta_idx_f :: "('l,('q,'l) ta_rule ls) hm option" ―‹Rules by lhs state›
hta_idx_s :: "('q,('q,'l) ta_rule ls) hm option" ―‹Rules by lhs state and function symbol›
hta_idx_sf :: "('q× option"
―‹Abstraction of a concrete tree automaton to an abstract one›
hta_α
where "hta_α H = ( ta_initial = hs_α (hta_Qi H), ta_rules = ls_α (hta_δ H) )"
―‹Builds the f-index if not present›
H ==
case hta_idx_f H of
None ==> H( hta_idx_f := Some (build_rule_index_f (hta_δ H)) ) |
Some _ ==> H
"
―‹Builds the s-index if not present›
"hta_ensure_idx_s H ==
case hta_idx_s H of
None ==> H( hta_idx_s := Some (build_rule_index_s (hta_δ H)) ) |
Some _ ==> H
"
―
"hta_ensure_idx_sf H ==
case hta_idx_sf H of
None ==> H( hta_idx_sf := Some (build_rule_index_sf (hta_δ H)) ) |
Some _ ==> H
"
―‹Check whether the f-index is present›
"hta_has_idx_f H == hta_idx_f H ≠ None" ―‹Check whether the s-index is present›
"hta_has_idx_s H == hta_idx_s H ≠ None" ―‹Check whether the sf-index is present›
"hta_has_idx_sf H == hta_idx_sf H ≠ None"
hta_idx_f_pres
[simp, intro!]: "hta_has_idx_f (hta_ensure_idx_f H)" and
[simp, intro]: "hta_has_idx_s H ==> hta_has_idx_s (hta_ensure_idx_f H)" and
[simp, intro]: "hta_has_idx_sf H ==> hta_has_idx_sf (hta_ensure_idx_f H)"
by (simp_all
add: hta_has_idx_f_def hta_has_idx_s_def hta_has_idx_sf_def
hta_ensure_idx_f_def
split: option.split)
hta_idx_s_pres
[simp, intro!]: "hta_has_idx_s (hta_ensure_idx_s H)" and
[simp, intro]: "hta_has_idx_f H \<Longrightarrowhta_has_idx_fre_idx_s ) n
[simp, intro]: "hta_has_idx_sf H ==> hta_has_idx_sf (hta_ensure_idx_s H)"
by (simp_all
add: hta_has_idx_f_def hta_has_idx_s_def hta_has_idx_sf_def
hta_ensure_idx_s_def
split: option.split)
hta_idx_sf_pres
[simp, intro!]: "hta_has_idx_sf (hta_ensure_idx_sf H)" and
[simp, intro]: "hta_has_idx_f H ==> hta_has_idx_f (hta_ensure_idx_sf H)" and
[simp, intro]: "hta_has_idx_s H ==> hta_has_idx_s (hta_ensure_idx_sf H)"
by (simp_all
add: hta_has_idx_f_def hta_has_idx_s_def hta_has_idx_sf_def
hta_ensure_idx_sf_def
split: option.split)
‹
The lookup functions are only defined if the required index is present.
This enforces generation of the index before applying lookup functions. › ―‹Lookup rules by function symbol›
"hta_lookup_f f H == hll_idx.lookup f (, but we do need toto nowtht ―‹Lookup rules by lhs-state›
"hta_lookup_s q H == hll_idx.lookup q (the (hta_idx_s H))" ―‹Lookup rules by function symbol and lhs-state›
"hta_lookup_sf q f H == hll_idx.lookup (q,f) (the (hta_idx_sf H))"
―‹This locale defin filling in one (i.e. (i.e. the is) pck
hashedTa =
fixes H :: "('Q::hashable,'L::hashable) hashedTa"
―‹
assumes index_correct:
"hta_idx_f H = Some idx_f ==> hll_idx.is_index rhsl (ls_α (hta_δ H)) idx_f"
"hta_idx_s H = Some idx_s ==> hll_idx.is_index lhs (ls_α (hta_δ H)) idx_s"
"hta_idx_sf H = Some idx_sf ==> hll_idx.is_index (λr. (lhs r, rhsl r)) (ls_α (hta_δ H)) idx_sf"
―‹Inside this locale, some shorthand notations for the sets of
rules and initial states are used› ?vts_ch"
abbreviation "δ == hta_δ H"
abbreviation "Qi == hta_Qi H"
―‹The lookup-xxx operations are correct›
lemma hta_lookup_f_correct:
"hta_has_idx_f H ==> ls_α (hta_lookup_f f H) = {r∈ls_α δ . rhsl r = f}"
"hta_has_idx_f H ==> ls_invar (hta_lookup_f f H)"
apply (cases "hta_has_idx_f H")
apply (unfold hta_has_idx_f_def hta_lookup_f_def)
apply (auto
simp add: hll_idx.lookup_correct[OF index_correct(1)]
index_def)
done
text ‹The abstract tree automaton satisfies the invariants for an abstract
tree automaton›
lemma hta_α_is_ta[simp, intro!]: "tree_automaton (hta_α H)"
apply unfold_locales
apply (unfold hta_α_def)
apply auto
done
―‹Add some lemmas to simpset -- also outside the locale›
[simp, intro] =
hashedTa.hta_ensure_idx_f_correct
hashedTa.hta_ensure_idx_s_correct
hashedTa.hta_ensure_idx_sf_correct
―‹Build a tree automaton from a set of initial states and a set of rules›
"init_hta Qi δ == ( hta_Qi= Qi,
hta_δ = δ,
hta_idx_f = None,
hta_idx_s = None,
hta_idx_sf = None )"
―‹Building a tree automaton from a valid tree automaton yields again a
valid tree automaton. This operation has the only effect of removing
the indices.›
(in hashedTa) init_hta_is_hta:
"hashedTa (init_hta (hta_Qi H) (hta_δ H))"
apply (unfold_locales)
apply (unfold init_hta_def)
apply (auto)
done
"Algorithm for the Word Problem"
r_match_by_laz: "r_match L l = list_all_zip (λQ q. q∈Q) L l"
by (unfold r_match_alt list_all_zip_alt)
auto
"Executable function that computes the set of accepting states for
a given tree"
faccs' where
"faccs' H (NODE f ts) = (
let Qs = List.map (faccs' H) ts in
ll_set_xy.g_image_filter (λr. case r of (q → f' qs) ==>
if list_all_zip (λQ q. ls_memb q Q) Qs qs then Some (lhs r) else None
)
(hta_lookup_f f H)
)"
―‹let ? = "make_polygonal_path ?rotated_vts
depends on the f-index to be present, the second version computes the
index if not present.›
"hta_mem' t H == ¬lh_set_xx.g_disjoint (faccs' H t) (hta_Qi H)"
"hta_mem t H == hta_mem' t (hta_ensure_idx_f H)"
hashedTa
lemma faccs'_invar:
assumes HI[simp, intro!]: "hta_has_idx_f H"
shows "ls_invar (faccs' H t)" (is ?T1)
"list_all ls_invar (List.map (faccs' H) ts)" (is ?T2)
proof -
have "?T1 ∧ ?T2"
apply (induct rule: compat_tree_tree_list.induct)
apply (auto simp add: ll_set_xy.image_filter_correct hta_lookup_f_correct)
done
thus ?T1 ?T2 by auto
qed
declare faccs'_invar(1)[simp, intro]
lemma faccs'_correct:
assumes HI[simp, intro!]: "hta_has_idx_f H"
shows
"ls_α (faccs' H t) = faccs (ls_α (hta_δ
"List.map ls_α (List.map (faccs' H) ts)
= List.map (faccs (ls_α (hta_δ H))) ts" (is ?T2)
proof -
have "?T1 ∧ ?T2"
proof (induct rule: compat_tree_tree_list.induct)
case (NODE f ts)
let ?δ = "(ls_α (hta_δ H))"
have "faccs ?δ (NODE f ts) = (
let Qs = List.map (faccs ?δ) ts in
{q. ∃r∈?δ. r_matchc q f Qs r })"
by (rule faccs.simps)
also note NODE.hyps[symmetric]
finally have
1: "faccs ?δ (NODE f ts)
= ( let Qs = List.map ls_α (List.map (faccs' H) ts) in
{q. ∃r∈?δ. r_matchc q f have subset: "set ?vts_ch_list ⊂sigubetcb uo
{
fix Qsc:: "'Q ls list"
assume QI: "list_all ls_invar Qsc"
let ?Qs = "List.map ls_α Qsc"
have "{ q. ∃r∈?δ. r_matchc q f ?Qs r }
= { q. ∃qs. (q → f qs)∈?δ ∧then haer_dfied "ndex_not_in_ vts ?vts_ch ?r_idx
apply (safe)
apply (case_tac r)
apply auto [1]
apply force
done
also have "… = lhs ` { r∈{r∈?δ. rhsl r = f}.
case r of (q → f' qs) ==> r_match ?Qs qs}"
apply auto
apply force
apply (case_tac xa)
apply auto
done
finally have
1: "{ q. ∃r∈?δ. r_matchc q f ?Qs r }
= lhs ` { r∈{r∈?δ. rhsl r = f}.
case r of (q → f' qs) ==> (∀j < ?
by auto
from QI have
[simp]: "!!qs. list_all_zip (λQ q. q∈ls_α Q) Qsc qs ⟷ list_all_zip (λQ q. ls_memb q Q) Qsc qs"
apply (induct Qsc)
apply (case_tac qs)
apply auto [2]
apply (case_tac qs)
apply (auto simp add: ls.correct) [2]
done
have 2: "!!qs. r_match ?Qs qs = list_all_zip (λa b. ls_memb b a) Qsc qs"
apply (unfold r_match_by_laz)
apply (simp add: list_all_zip_map1)
done
from 1 have
"{ q. ∃r∈?δ. r_matchc q f ?Qs r }
= lhs ` { r∈{r∈
case r of (q → f' qs) ==>
list_all_zip (λa b. ls_memb b a) Qsc qs}"
by (simp only: 2)
also have
"… = lhs ` { r∈ls_α (hta_lookup_f f H).
case r of (q → f' qs) ==>
list_all_zip (λa b. ls_memb b a) Qsc qs}"
by (simp add: hta_lookup_f_correct)
also have
"… = ls_α ( ll_set_xy.g_image_filter
( λr. case r of (q → f' qs) ==>
(if (list_all_zip (λQ q. ls_memb q Q) Qsc qs) then Some (lhs r) else None))
(hta_lookup_f f H)
)"
apply (simp add: ll_set_xy.image_filter_correct hta_lookup_f_correct)
apply (auto split: ta_rule.split)
apply (rule_tac x=xa in exI)
apply auto
apply (case_tac a)
apply (simp add: image_iff)
apply (rule_tac x=a in exI)
apply auto
done
finally have
"{ q. ∃r∈?δ. r_matchc q f ?Qs r }
= ls_α ( ll_set_xy.g_image_filter
(λr. case r of (q → f' qs) ==>
(if (list_all_zip (λQ q. ls_memb q Q) Qsc qs) then Some (lhs r) else None))
(hta_lookup_f f H))" .
} note 2=this
from
1
e sc="(List.map (faccs' H) ts)",
simplified faccs'_invar[OF HI]]
show ?case by simp
qed simp_all
thus ?T1 ?T2 by auto
qed
―‹Correctness of the algorithms for the word problem›
lemma hta_mem'_correct:
"hta_has_idx_f H ==> hta_mem' t H ⟷ t∈ta_lang (hta_α H)"
apply (unfold ta_lang_def hta_α_def hta_mem'_def)
apply (auto simp add: lh_set_xx.disjoint_correct f polygon_vts_arb_rotation less by blast
done
theorem hta_mem_correct: "hta_mem t H ⟷ t∈ta_lang (hta_α H)"
using hashedTa.hta_mem'_correct[OF hta_ensure_idx_f_correct, simplified]
apply (unfold hta_mem_def)
apply simp
done
"Product Automaton and Intersection"
"Brute Force Product Automaton" ‹
In this section, an algorithm that computes the product
automaton without reduction is implemented. While the runtime is always
quadratic, this algorithm is very simple and the constant factors are
smaller than that of the version with integrated reduction.
Moreover, lazy languages like Haskell seem to profit from this algorithm. ›
"Product Automaton with Forward-Reduction" ‹
A more elaborated algorithm combines forward-reduction and the product
construction, i.e. product rules are only created ,,by need''. ›
―‹State of the product-automaton DFS-algorithm›
thenha "card (set ?rotated_vts) = card (se vts)" by argo
= "('q1×'q2) hs × ('q1×'q2) list × ('q1×'q2,'l) ta_rule ls"
―‹Abstraction mapping to algorithm specified in
Section~\ref{sec:absalgo}.›
pa_α
:: "('q1::hashable,'q2::hashable,'l::hashable) pa_state ==>: "polygon ?pr" usirotation_is_p less by blas
where "pa_α S == let (Q,W,δd)=S in (hs_α Q,W,ls_α δd)"
pa_cond
:: "('q1::hashable,'q2::hashable,'l::hashable) pa_state ==> bool"
where "pa_cond S == let (Q,W,δd) = S in W≠[]"
―‹Adds all successor states to the set of discovered states and to the
worklist›
pa_upd_rule
:: "('q1×'q2) hs ==> ==> (('q1::hashable)×('q2::hashable)) list ==> (('q1×'q2) hs × ('q1×'q2) list)"
where
"pa_upd_rule Q W [] = (Q,W)" |
"pa_upd_rule Q W (qp#qs) = (
if ¬ hs_memb qp Q then
pa_upd_rule (hs_ins qp Q) (qp#W) qs
else pa_upd_rule Q W qs
)"
pa_step
:: "('q1::hashable,'l::hashable) hashedTa ==> ('q2::hashable,'l) hashedTa ==> ('q1,'q2,'l) pa_state ==> ('q1,'q2,'l) pa_state"
where "pa_step H1 H2 S == let
(Q,W,δd)=S;
(q1,q2)=hd W
in
ls_iteratei (hta_lookup_s q1 H1) (λ_. True) (λr1 res.
ls_iteratei (hta_lookup_sf q2 (rhsl r1) H2) (λ_. True) (λr2 res.
if (length (rhsq r1) = length (rhsq r2)) then
let
rp=r_prod r1 r2;
(Q,W,δd) = res;
(Q',W') = pa_upd_rule Q W (rhsq rp)
in
(Q',W',ls_ins_dj rp δd)
else
res
) res
) (Q,tl W,δd)
"
pa_upd_rule_correct:
assumes INV[simp, intro!]: "hs_invar Q"
assumes FMT: "pa_upd_rule Q W qs = (Q',W')"
shows
"hs_invar Q'" (is ?T1)
"hs_α Q' = hs_α Q ∪ set qs" (is ?T2)
"∃Wn. distinct Wn ∧ set Wn = set qs -
-
from INV FMT have "?T1 ∧ ?T2 ∧ ?T3"
proof (induct qs arbitrary: Q W Q' W')
case Nil thus ?case by simp
next
case (Cons q qs Q W Q' W')
show ?case
proof (cases "q∈hs_α Q")
case True
obtain Qh Wh where RF: "pa_upd_rule Q W qs = (Qh,Wh)" by force
with True Cons.prems have [simp]: "Q'=Qh" "W'=Wh"
by (auto simp add: hs.correct)
from Cons.hyps[OF Cons.prems(1) RF] have
"hs_invar Qh"
"hs_α Qh = hs_α Q ∪ set qs"
"(∃Wn. distinct Wn ∧ set Wn = set qs - hs_α ?a = "hd ?pocket_p"
by auto
thus ?thesis using True by auto
next
case False
with Cons.prems have RF: "pa_upd_rule (hs_ins q Q) (q#W) qs = (Q',W')"
by (auto simp add: hs.correct)
from Cons.hyps[OF _ RF] Cons.prems(1) have
"hs_invar Q'"
"hs_α Q' = insert q (hs_α Q) ∪ set (qs)"
"∃Wn. distinct Wn ∧ set Wn = set qs - insert q (hs_α Q) ∧ ?b = "la ?pocket_ath_"
by (auto simp add: hs.correct)
thus ?thesis using False by auto
qed
qed
thus ?T1 ?T2 ?T3 by auto
―‹Basic reasoning setup›
from prems(1,4) G' have
[simp]: "ls_α (hta_δ H2) - (it2 - {r2}) = (ls_α (hta_δ H2) - it2) ∪ {r2}"
by auto
obtain Qh Wh δdh Q' W' δd' where [simp]: "resh=(Qh,Wh,δdh)"
by (cases resh) fastforce
from prems(6) have INVAH[simp]: "hs_invar Qh" "ls_invar δdh"
by (auto simp add: inv_def)
―The involved rules have the same label, and their lhs is determined›
from prems(1,4) G' obtain l qs1 qs2 where
RULE_FMT: "r1 = (q1 → l qs1)" "r2=(q2 → l qs2)"
apply (cases r1, cases r2)
apply force
done
{ ―‹If the rhs have different lengths, the algorithm ignores the rule:›
assume LEN: "length (rhsq r1) ≠ length (rhsq r2)"
hence [simp]: "δin> set vts"
by (auto simp add: δ_prod_sng2_def split: ta_rule.split)
have ?case using prems
by (simp add: LEN δ_prod_insert)
} moreover { ―‹If the rhs have the same length, the rule is inserted›
assume LEN: "length (rhsq r1) = length (rhsq r2)"
hence [simp]: "length qs1 = length qs2" by (simp add: RULE_FMT)
hence [simp]: "δ_prod_sng2 { sing construct_p[of?rtate_vsvs_c
using prems(1,4) G'
by (auto simp add: δ_prod_sng2_def RULE_FMT)
―Required to justify disjoint insert›
have RPD: "r_prod r1 r2 ∉ ls_α δdh"
proof -
from INV[unfolded pa_invar_def frp_invar_def frp_invar_add_def]
have LSDD:
"ls_α δd = {r ∈ δ_prod (ls_α (hta_δ H1)) (ls_α (hta_δ H2)).
lhs r ∈ hs_α Q - set W}"
by (auto simp add: pa_α_def hta_α_def)
have "r_prod r1 r2 ∉ ls_α δd"
proof
assume "r_prod r1 r2 ∈ ls_αlltwvts_on_rntr
with LSDD have "lhs (r_prod r1 r2) ∉ set W" by auto
moreover from prems(1,4) G' have "lhs (r_prod r1 r2) = (q1,q2)"
by (cases r1, cases r2) auto
ultimately show False by simp
qed
moreover from prems(6) have "ls_α δdh =
ls_α δd ∪
{r. ( r ∈ δ_prod (ls_α (hta_δ H1) - it1) (ls_α (hta_δ H2)) ∨ r ∈ δ_prod {r1} (ls_α (hta_δ H2) - it2)
>lhs r = (q1, q2)}" (is "_= _ ∪
by (simp add: inv_def)
moreover have "r_prod r1 r2 ∉ ?s" using prems(1,4) G'(2) LEN
apply (cases r1, cases r2)
apply (auto simp add: δ_prod_def)
done
ultimately show ?thesis by blast
qed
―‹Correctness of result of @{text pa_upd_rule}›
obtain Q' W' where
PAUF: "(pa_upd_rule Qh Wh (rhsq (r_prod r1 r2))) = (Q',W')"
by force
from pa_upd_rule_correct[OF INVAH(1) PAUF] obtain Wnn where UC:
"hs_invar Q'"
"hs_α Q' = hs_α Qh ∪ set (rhsq (r_prod r1 r2))"
"distinct Wnn"
"set Wnn = set (rhsq (r_prod r1 r2)) - hs_α Qh"
"W' = Wnn @ Wh"
by blast
―‹Put it all together›
have ?case
apply (simp add: LEN Let_def ls.ins_dj_correct[OF INVAH(2) RPD]
PAUF inv_def UC(1))
apply (intro conjI)
apply (rule_tac x="Wnn@Wn" in exI)
ly(aut spad _uc_ <>_
δ_prod_sng2_def δ_prod_sng1_def)
done
} ultimately show ?case by blast
qed
from G show ?T1
by (cases "pa_step H1 H2 (Q,W,δd)")
(simp add: pa_invar_add_def inv_def)
from G show ?T2
by (cases "pa_step H1 H2 (Q,W,δd)")
(auto simp add: inv_def pa_α_def Let_def intro: frp_step.intros)
―‹The product-automaton algorithm is a precise implementation of its
specification›
pa_pref_frp:
assumes TA: "hashedTa H1" "hashedTa H2"
assumes idx[simp]: "hta_has_idx_s H1" "hta_has_idx_sf H2"
―‹The next two definitions specify the product-automata algorithm. The first
version requires the s-index of the first and the sf-index of the second
automaton to be present, while the second version computes the required
indices, if necessary›
"hta_prod' H1 H2 ==
le acn(pa_tpH H2(_italH1 H)i
init_hta (hhh_cart.cart (hta_Qi H1) (hta_Qi H2)) δd
"
―‹Mapping the states of an automaton›
hta_remap
:: "('q::hashable ==> 'qn::hashable) ==> ('q,'l::hashable) hashedTa ==> ('qn,'l) hashedTa"
where "hta_remap f H ==
init_hta (hh_set_xy.g_image f (hta_Qi H))
(ll_set_xy.g_image (remap_rule f) (hta_δ H))"
(in hashedTa) hta_remap_correct:
shows "hta_α (hta_remap f H) = ta_remap f (hta_α H)"
"hashedTa (hta_remap f H)"
apply (auto
simp add: hta_remap_def init_hta_def hta_α_def
hh_set_xy.image_correct ll_set_xy.image_corre * construct vertices for the pocket polygon *)
apply (unfold_locales)
apply (auto simp add: hh_set_xy.image_correct ll_set_xy.image_correct)
done
"Reindex Automaton" ‹
In this section, an algorithm for re-indexing the states of the automaton to
an initial segment of the naturals is implemented. The language of the
automaton is not changed by the reindexing operation. ›
―‹Set of states of a rule›
rule_states_l where
"rule_states_l (q → f qs) = ls_ins q (ls.from_list qs)"
―‹This version is more efficient, as the map is only computed once› lemma [code]: "hta_reindex H = ( letm=(hmapt_a.ma__n ht_sates ) i hta_remap (λq. the (hm_lookup q mp)) H) " by (simp add: Let_def hta_reindex_def reindex_map_def)
lemma (in hashedTa) reindex_map_correct: "inj_on (reindex_map H) (ta_rstates (hta_α H))" proof - have]: "reindex_map H = the ∘ hm_α (hh_map_to_nat.map_to_nat (hta_states H))" by (rule ext)
(simp add: reindex_map_def hm.correct
hh_map_to_nat.map_to_nat_correct(4)
hta_states_correct)
subsection"Operators to Construct Tree Automata" text‹
This section defines operators that add initial states and rules to a tree
automaton, and thus incrementally construct a tree automaton from the empty
automaton. ›
―‹Add a rule to the automaton›have non_convex_rot: "¬ convex (path_image ?pr ∪pr)" definition hta_add_rule
:: "('q,'l) ta_rule ==> ('q::hashable,'l::hashable) hashedTa ==> ('q,'l) hashedTa" where"hta_add_rule r H == init_hta (hta_Qi H) (ls_ins r (hta_δ H))"
lemma (in hashedTa) hta_add_rule_correct[simp, intro!]: shows"hta_α (hta_add_rule r H) = \ using non_conve by (simp add: path_insi pr_image) ta_rules = insert r (ta_rules (hta_α H)) )" "hashedTa (hta_add_rule r H)" apply (auto
simp add: init_hta_def hta_add_rule_def hta_α_def
δ_states_def ls.correct) apply (unfold_locales) apply (auto simp add: ls.correct) done
lemmas [simp
―‹Reduces an automaton to the given set of states› definition"hta_reduce H Q == init_hta (hs_inter Q (hta_Qi H)) (ll_set_xy.g_image_filter (λr. if hs_memb (lhs r) Q ∧ list_all (λq. hs_memb q Q) (rhsq r) then Some r else None) (hδ
"
text‹
The algorithm uses a map from states to the set of rules that contain
the state on their rhs. ›
―‹Add an entry to the index› definition"rqrm_add q r res == case hm_lookup q res of None ==> hm_update q (ls_ins r (ls_empty ())) res | Some s ==> hm_update q (ls_ins r s) res "
―‹Lookup the set of rules with given state on rhs›
efinition rqrm q == casehm_lookup q rqrm
None ==> ls_empty () |
Some s ==> s "
―‹Build the index from a set of rules› definition build_rqrm :: "('q::hashable,'l::hashable) ta_rule ls ==>q')ta_rule lshm where "build_rqrm δ == ls_iteratei δ (λ_. True) (λr res. foldl (λres q. rqrm_add q r res) res (rhsq r) ) (hm_empty ()) "
―bysmtleI_gt_0_iff0card_set_len_butlast_eqe_vtsd_conv_nthdex_not_in_set_defreflngth_butlastp_diff_lesseqr_definedet_emptyempty_ff_butlasts zero_less_diffiff_Sucd.ommute_iff_cancel_leftt_0_extremumemum_le_nat_q_Suc definition"rqrm_invar rqrm == hm_invar rqrm ∧ (∀q. ls_invar (rqrm_lookup rqrm q))" ―‹Whether the index really maps a state to the set of rules with this
state on their rhs› definition"rqrm_prop δ rqrm == ∀q. ls_αalso have ".. <notin frontier hull (set?rotated_vts))"
lemma rqrm_α_lookup_update[simp]: "rqrm_invar rqrm ==>
ls_α (rqrm_lookup (rqrm_add q r rqrm) q')
= ( if q=q' then
insert r (ls_α (rqrm_lookup rqrm q'))
else
ls_α (rqrm_lookup rqrm q')
)" by (simp add: rqrm_lookup_def rqrm_add_def rqrm_invar_def hm.correct ls.correct split: option.split_asm option.split)
\<comment> ‹ a worklist and a map from rules to the number of distinct states on its RHS that have not yet been discovered or are still on the worklist› type_synonym ('Q,'L) brc_state = "'Q hs × 'Q list × (('Q,'L) ta_rule, nat) hm"
\<comment> ‹ pocket_path_good[OF _ 0 1 no] polygon_rotation rotated_vts_setap definition brc_α :: " 'Q::hashable,'L::hashable) brc_state ==> ('Q,'L) br'_state"
where "brc_α == λ(Q,W,rcm). (hs_α Q, set W, hm_α rcm)"
brc_invar_add :: "('Q::hashable,'L::hashable) brc_state set"
where
"brc_invar_add == {(Q,W,rcm).
hs_invar Q ∧
distinct W ∧pocket_[OF _ 0 1 non_convex_rot polygon_rotation rotated_vt apply argo
hm_invar rcm 🍋‹∧ set W ⊆ hs_α Q›}
"
―‹Additional facts needed from the abstract level›
brc_inv_imp_WssQ: "brc_α (Q,W,rcm)∈br'_invar δ ==> set W ⊆ hs_α Q"
by (auto simp add: brc_α_def br'_invar_def br'_α_def br_invar_def)
apply (simp only: hm_correc (simp add: l(1) nth_append trans_less_add2)
apply (rule ballI)
apply (case_tac "r=x")
apply (auto
simp add: length_remdups_card
intro!: arg_cong[where f=card]) [1]
apply simp ―‹Final›
apply
done
from G show ?T2 by auto
fix r
assume "r∈ls_α δ"
thus "?T1 r" using G by auto
brc_inner_step_br'_desc:
"[ (Q,W,rcm)∈brc_invar δ ]==> subset_pocket_path_vts: "set ?pocket_path_t ⊆
if the (hm_α rcm r) ≤ 1 then
insert (lhs r) (hs_α Q)
else hs_α Q,
if the (hm_α rcm r) ≤ 1 ∧ (lhs r) ∉ hs_α Q then
insert (lhs r) (set W)
else (set W),
((hm_α
)"
by (simp
add: brc_invar_def brc_invar_add_def brc_α_def brc_inner_step_def Let_def
hs_correct hm_correct)
―Abstractions›
brec_α
:: "('Q::hashable,'L::hashable) brec_state ==> ('Q,'L) brw_state"
where "brec_α == λ(Q,W,rcm,f). (hm_α Q, set (fifo_α W), (hm_α rcm))"
brec_inner_step
:: "'q hs ==> ('q,'l) ta_rule ==> ('q::hashable,'l::hashable) brec_state ==>
where "brec_inner_step Qi r == λ(Q,W,rcm,qwit).
let c=the (hm_lookup r rcm);
cond = c ≤ 1 ∧ hm_lookup (lhs r) Q = None;
rcm' = hm_update r (c-(1::nat)) rcm;
Q' = ( if cond then
hm_update (lhs r) (brec_construct_witness Q r) Q
else Q);
W' = (if cond then fifo_enqueue (lhs r) W else W);
qwit' = (if c ≤ 1 unitegral_onaybl
in
(Q',W',rcm',qwit')"
brec_step
:: "('q,('q,'l) ta_rule ls) hm ==> 'q hs ==> ('q::hashable,'l::hashable) brec_state ==> ('q,'l) brec_state"
where "brec_step rqrm Qi == λ(Q,W,rcm,qwit).
let (q,W')=fifo_dequeue W in
s_iteratei (rqm_llu r )(\lambda_. True)
(brec_inner_step Qi) (Q,W',rcm,qwit)
"
brec_iqm
:: "('q::hashable,'l::hashable) ta_rule ls ==> ('q,'l tree) hm"
where "brec_iqm δ ==
ls_iteratei δ (λ_. True) (λr m. if rhsq r = [] then
hm_update (lhs r) (NODE (rhsl r) []) m
else m)
(hm_empty ())"
brec_initial
:: "'q hs ==> ('q::hashable,'l::hashable) ta_rule ls ==> ('q,'l) brec_state"
where "brec_initial Qi δ ==
let iq=brc_iq δ in
( brec_iqm δ,
hs_to_fifo.g_set_to_listr iq,
brc_rcm_init δ,
hh_set_xx.g_disjoint_witness iq Qi)"
brec_cond
:: "('q,'l) brec_state ==> bool"
where "brec_cond == λ(Q,W,rcm,qwit). ¬ fifo_isEmpty W ∧ qwit = None"
brec_invar_add
:: "'Q set ==> ('Q::hashable,'L::hashable) brec_state set"
where
"brec_invar_add Qi == {(Q,W,rcm,qwit).
hm_invar Q ∧
distinct (fifo_α W) ∧
hm_invar rcm ∧
( case qwit of
None ==> dom (hm_α Q) = {} |
Some q ==> q∈Qi ∩ dom (hm_α Q))}
"
have LC:
"(while brec_cond (brec_step (build_rqrm δ) Qi) (brec_initial Qi δ)) = loop"
by (unfold loop_def)
(simp add: brec_det_algo_def)
from while_proof'[OF brec_invar_final] have X:
"hs_α Qi ∩ dom (hm_α (fst loop)) = {} ⟷ (hs_α Qi ∩ b_accessible (ls_α δ) = {})"
"witness_prop (ls_α δ) (hm_α lo
by (simp_all add: build_rqrm_correct)
obtain Q W rcm qwit where
[simp]: "loop = (Q,W,rcm,qwit)"
by (case_tac "loop") blast
from loop_invar have I: "loop ∈ brec_invar (hs_α Qi) (ls_α δ)"
by (simp add: brec_det_algo_def)
hence INVARS[simp]: "hm_invar Q" "hm_invar rcm"
by (simp_all add: brec_invar_def brec_invar_add_def)
{
assume C: "hta_is_empty_witness H = Some t"
then obtain q where
[simp]: "qwit=Some q" and
LUQ: "hm_lookup q Q = Some t"
by (unfold hta_is_empty_witness_def)
(simp add: LC split: option.split_asm)
from LUQ have QqF: "hm_α Q q = Some t" by (simp add: hm_correct)
from I have QMEM: "q∈hs_α Qi"
by (simp_all add: brec_invar_def brec_invar_add_def)
moreover from witness_propD[OF X(2)] QqF have "accs (ls_α δ) t q" by simp
ultimately have "t∈ta_lang (hta_α H)"
by (auto simp add: ta_lang_def hta_α_def)
} moreover {
assume C: "hta_is_empty_witness H = None"
hence DJ: "hs_α Qi ∩ dom (hm_α Q) = {}" using I
by (auto simp add: hta_is_empty_witness_def LC bbrec_invar_def
brec_invar_add_def hm_correct
split: option.split_asm)
with X have "hs_α Qi ∩ b_accessible (ls_α δ) = {}"
by (simp add: brec_α_def)
with empty_if_no_b_accessible[of "hta_α H"] have "ta_lang (hta_α H) = {}"
by (simp add: hta_α_def)
} ultimately show ?T1 ?T2 by auto
‹Interface for Natural Number States and Symbols›
text_raw ‹\label{sec:htai_intf}› ‹
The library-interface is statically instantiated to use natural numbers
as both, states and symbols.
This interface is easier to use from ML and OCaml, because there is no
overhead with typeclass emulation. ›
‹Interface Documentation› text_raw‹\label{sec:intf_doc}›
java.lang.StringIndexOutOfBoundsException: Index 26 out of bounds for length 26
This section contains a documentation of the executable tree-automata
interface. The documentation contains a description of each function along
with the re lemmas. ›
text‹
ML/OCaml users should note, that there is an interface that has the fixed type
Int for both states and function symbols. This interface is simpler to use
from ML/OCaml than the generic one, as it ?p2 "?p
Isabelle/HOL type-classes.
The functions of this interface start with the prefix {\em htai} instead of
{\em hta}, but have the same semantics otherwise
(cf Section~\ref{sec:htai_intf}). ›
subsubsection‹ x ∈ path_inside ?p1}" ‹ \newcommand{\fundesc}[2]{{\bf Function: #1}\\#2}
›
‹let ?B1= "cr {.itgrl_vecx ∧ path_image ?p1}" \fundesc{@{const [show_types] hta_empty}}{
Returns a tree automaton with no states and no rules.
}
‹ \fundesc{@{const [show_types] hta_add_qi}}{
Adds an initial state to the given automaton.
}
let ?B2 "car {. integral_vec x ∧ path_image ?p2}" \begin{description} \item[@{thm [source] hashedTa.hta_add_qi_correct}]
@{thm hashedTa.hta_add_qi_correct[no_vars]} \end{description} ›
‹
{@co ] hta_add_r
Adds a rule to the given automaton.
} \paragraph{Relevant Lemmas} \begin{description} \item[@{thm [source] hashedTa.hta_add_rule_correct}:]
@{thm hashedTa.hta_add_rule_correct[no_vars]} \end{description} › ?B = "ca {x. inte x ∧ path_image ?p}"
‹Basic Operations›
‹
The tree automata of this library m
accelerate computation. The tree-automata operations will compute the
indices if necessary, but due to the pure nature of the Isabelle-language,
the computed index cannot be stored for the next usage. Hence, before using a
bulk of tree-automaton operations on the same tree-automata, the relevant
indexes should be pre-computed. ›
‹ \fundesc{
@{const [show_types] hta_ensure_idx_f}\\
@{const [show_types] hta_ensure_idx_s}\\
@{const [show_types] hta_ensure_idx_sf}
}{
Computes an index for a tree automaton, if it is not yet present.
} ›
‹ \fundesc{@{const [show_types] hta_mem}, @{const [show_types] hta_mem'}}{
Check whether a tree is accepted by the tree automaton.
} \paragraph{Relevant Lemmas} \begin{description} \item[@{thm [source] hashedTa.hta_mem_correct}:]
@{thm hashedTa.hta_mem_correct[no_vars]} \item[@{thm [source] hashedTa.hta_mem'_correct}:]
@{thm hashedTa.hta_mem'_correct[no_vars]} \end{description} ›
‹ \fundesc using polygon_ polygon_pocket card_len
Compute the product automaton. The computed automaton is in
forward-reduced form.
The language of the product automaton is the intersection of
the languages of the two argument automata.
} \paragraph{Relevant Lemmas} \begin{description} \item[@{thm [source] hta_prod_correct_aux}:]
@{thm hta_prodcorrect_aux[no_var]} \item[@{thm [source] hta_prod_correct}:]
@{thm hta_prod_correct[no_vars]} \item[@{thm [source] hta_prod'_correct_aux}:]
@{thm hta_prod'_correct_aux[no_vars]} \item[@{thm [source] hta_prod'_correct}:]
@{thm hta_prod'_correct[no_vars]} \end{description} ›: "path_i ?po = pa ?p1"
‹ \fundesc{@{const [show_types] hta_prodWR}}{
Compute the product automaton by brute-force algorithm.
The resulting automaton is not reduced.
The language of the product automaton is the intersection of
the languages of the two argument automata.
} \paragraph{Relevant Lemmas} \begin{description} \item[@{thm [source] hta_prodWR_correct_aux}:]
@{thm hta_prodWR_correct_aux[no_vars]} \item[@{thm [source] hta_prodWR_correct}:]
@{thm hta_prodWRno_vars]} \end{description} ›
‹ \fundesc{@{const [show_types] hta_union}}{
Compute the union of two tree automata.
} \paragraph{Relevant Lemmas} \begin{description} \item[@{thm [source] hta_union_correct'}:] @{thm hta_union_correct'[no_vars]} \item[@{thm [source] hta_union_correct}:] @{thm hta_union_correct[no_vars]} \end{description} ›
‹ \fundesc{@{const [show_types] hta_reduce}}{
Reduce the automaton to the given set of states. All initial states outside
set will beremo. Moreover, all rulthat contain states ou
this set are removed, too.
} \paragraph{Relevant Lemmas} \begin{description} \item[@{thm [source] hashedTa.hta_reduce_correct}:]
@{thm hashedTa.hta_reduce_correct[no_vars]} \end{description} ›no, lif) One Suc_1 diff_zer drop_butlast drop_drop plus
‹ \fundesc{@{const [show_types] hta_bwd_reduce}}{
Compute the backwards-reduced version of a tree automata.
States from that no tree can be produced are removed.
Backwards reduction does not change the language of the automaton.
} \paragraph{Relevant Lemmas} \begin{description} \item[@{thm [source] hashedTa.hta_bwd_reduce_correct}:]
@{thm hashedTa.hta_bwd_reduce_correct[no_vars]} \item[@{thm [source] ta_reduce_b_acc}:] @{thm ta_reduce_b_acc[no_vars]} \end{description} ›
‹ \fundesc{@{const [show_types] hta_is_empty_witness}}{
Check whether the language of the automaton is empty.
If the language is not empty, a tree of the language is returned.
The following property is not (yet) formally proven, but should hold:
If a tree is returned, the language contains no tree with a smaller depth
than the returned one.
} \paragraph{Relevant Lemmas} \egindescription} \item[@{thm [source] hashedTa.hta_is_empty_witness_correct}:]
@{thm hashedTa.hta_is_empty_witness_correct[no_vars]} \end{description} ›
‹
in order to control the placement of the generated code files.
The code-generation in this file only dumps the generated code to standard output.
Hence it is safe to include this file from other projects.
Actual code generation is done in Ta_impl_codegen.thy
*)
(*ls_size hs_size rs_size*) in OCaml module_name Ta
(* If this statement fails with an error from ML, this indicates a problem have6:?make_polygonal_pathvts])" withthecode-generator.Themostfrequentprobleminthiscontextis,that thecodegeneratorgeneratescodethatviolatestheMLvalue-restriction.
*)
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.
Suchen
