From d0dc6fbd661c7a79a2d8f875a204f587e6a5162d Mon Sep 17 00:00:00 2001 From: Lucca Hirschi Date: Thu, 5 Jul 2012 16:03:18 +0200 Subject: [PATCH] Final test in run_test try my.query on my.xml (from thesis) + fixs in run.ml ==> Correct answer. --- run_tests | 15 +++++----- src/asta.ml | 6 ++-- src/asta.mli | 7 +++-- src/formula.ml | 2 +- src/run.ml | 81 ++++++++++++++++++++++++++++---------------------- 5 files changed, 63 insertions(+), 48 deletions(-) diff --git a/run_tests b/run_tests index 13f44fe..4a26469 100755 --- a/run_tests +++ b/run_tests @@ -1,8 +1,9 @@ -#./test.native ./tests/docs/my.xml '/child::site/child::regions' -#echo "________________________________________________________________________________" -#./test.native ./tests/docs/my.xml -f ./tests/queries/Treebank.xml.queries -#echo "________________________________________________________________________________" -#./test.native ./tests/docs/my.xml '/descendant::listitem[not(descendant::keyword/child::emph)]/descendant::parlist' -#echo "________________________________________________________________________________" +./test.native ./tests/docs/my.xml '/child::site/child::regions' +echo "________________________________________________________________________________" +./test.native ./tests/docs/my.xml -f ./tests/queries/Treebank.xml.queries +echo "________________________________________________________________________________" +./test.native ./tests/docs/my.xml '/descendant::listitem[not(descendant::keyword/child::emph)]/descendant::parlist' +echo "________________________________________________________________________________" ./test.native ./tests/docs/my.xml -f ./tests/queries/my.queries.old -#./test.native ./tests/docs/my.xml -f ./tests/queries/my.queries 2> tests/results/my.result \ No newline at end of file +echo "Expected answer: 43 (the b from the second big sub-tree)." +./test.native ./tests/docs/my.xml -f ./tests/queries/my.queries.old 2> tests/results/my.result \ No newline at end of file diff --git a/src/asta.ml b/src/asta.ml index 3189b27..d866005 100644 --- a/src/asta.ml +++ b/src/asta.ml @@ -121,7 +121,9 @@ let init_top ast = ast.top <- (StateSet.empty) let top_states ast = StateSet.elements ast.top -let bot_states ast = ast.bottom +let top_states_s ast = ast.top + +let bot_states_s ast = ast.bottom let selec_states ast = ast.selec @@ -149,6 +151,6 @@ let print fmt asta = print_box_list asta.trans_q; Format.fprintf fmt "@[# Recognizing transitions:@ %a@]" print_box_list asta.trans_r in - Format.fprintf fmt "@[##### ASTA #####@, %a@ @]@." print_box 0 + Format.fprintf fmt "@[##### ASTA #####@. %a@ @]@." print_box 0 let to_file out asta = () diff --git a/src/asta.mli b/src/asta.mli index e3d3c0d..7bbf13d 100644 --- a/src/asta.mli +++ b/src/asta.mli @@ -75,8 +75,11 @@ val init_top : t -> unit val top_states : t -> state list (** Give the list of top states of an ASTA *) -val bot_states : t -> StateSet.t -(** Give the list of bottom states of an ASTA *) +val top_states_s : t -> StateSet.t +(** Give the set of top states of an ASTA *) + +val bot_states_s : t -> StateSet.t +(** Give the set of bottom states of an ASTA *) val selec_states : t -> StateSet.t (** Give the list of selecting states of an ASTA *) diff --git a/src/formula.ml b/src/formula.ml index c75748f..8369571 100644 --- a/src/formula.ml +++ b/src/formula.ml @@ -91,7 +91,7 @@ let rec infer_form ssq ssr f = match expr f with | Atom(dir, b, s) -> let setq, setr = match dir with |`Left -> fst ssq, fst ssr - | `Right -> snd ssq, fst ssr in + | `Right -> snd ssq, snd ssr in (* WG: WE SUPPOSE THAT Q^r and Q^q are disjoint ! *) let mem = StateSet.mem s setq || StateSet.mem s setr in if b then mem else not mem diff --git a/src/run.ml b/src/run.ml index 8a7e066..9ece6ee 100644 --- a/src/run.ml +++ b/src/run.ml @@ -32,7 +32,7 @@ exception Over_max_fail exception Max_fail (* Mapped sets for leaves *) -let map_leaf asta = (Asta.bot_states asta, StateSet.empty) +let map_leaf asta = (Asta.bot_states_s asta, StateSet.empty) let empty = (StateSet.empty,StateSet.empty) (* Build the Oracle *) @@ -112,43 +112,52 @@ let rec tp_max asta run tree tnode = and tnnode = Tree.next_sibling tree tnode in let (fnode,nnode) = (Tree.preorder tree tfnode, Tree.preorder tree tnnode) in - let q_rec n = - try NodeHash.find run n - with Not_found -> (Asta.bot_states asta,StateSet.empty) in - let (qf),(qn) = q_rec fnode,q_rec nnode in - let lab = Tree.tag tree tnode in - let list_tr,_ = Asta.transitions_lab asta lab in (* only take query. *) - let set_node,_ = try NodeHash.find run node - with _ -> raise Max_fail in - let rec result = function - | [] -> [] - | (q,form) :: tl -> - if (Formula.infer_form qf qn form) && (StateSet.mem q set_node) - then form :: (result tl) - else result tl in - let list_form = result list_tr in - let rec add_st (ql,qr) = function - | [] -> ql,qr - | f :: tl -> let sql,sqr = Formula.st f in - let ql' = StateSet.union sql ql - and qr' = StateSet.union sqr qr in - add_st (ql',qr') tl in - let ql,qr = add_st (StateSet.empty, StateSet.empty) list_form in - let qfq,qfr = try NodeHash.find run fnode - with | _ -> map_leaf asta - and qnq,qnr = try NodeHash.find run nnode - with | _ -> map_leaf asta in begin - if Tree.is_leaf tree tfnode - then () - else NodeHash.replace run fnode (StateSet.inter qfq ql,qfr); - if Tree.is_leaf tree tnnode - then () - else NodeHash.replace run nnode (StateSet.inter qnq qr,qnr); - tp_max asta run tree tfnode; - tp_max asta run tree tnnode; + if tnode == Tree.root tree (* we must intersectt with top states *) + then let setq,_ = try NodeHash.find run node + with _ -> raise Max_fail in + NodeHash.replace run node + ((StateSet.inter (Asta.top_states_s asta) setq),StateSet.empty) + else (); + let q_rec n = + try NodeHash.find run n + with Not_found -> map_leaf asta in + let (qfq,qfr),(qnq,qnr) = q_rec fnode,q_rec nnode in + let lab = Tree.tag tree tnode in + let list_tr,_ = Asta.transitions_lab asta lab in (* only take query. *) + let set_node,_ = try NodeHash.find run node + with _ -> raise Max_fail in + let rec result = function + | [] -> [] + | (q,form) :: tl -> + if (Formula.infer_form (qfq,qnq) (qfr,qnr) form) && + (StateSet.mem q set_node) + then form :: (result tl) + else result tl in + let list_form = result list_tr in + let rec add_st (ql,qr) = function + | [] -> ql,qr + | f :: tl -> let sql,sqr = Formula.st f in + let ql' = StateSet.union sql ql + and qr' = StateSet.union sqr qr in + add_st (ql',qr') tl in + let ql,qr = add_st (StateSet.empty, StateSet.empty) list_form in + let qfq,qfr = try NodeHash.find run fnode + with | _ -> map_leaf asta + and qnq,qnr = try NodeHash.find run nnode + with | _ -> map_leaf asta in + begin + if tfnode == Tree.nil + then () + else NodeHash.replace run fnode (StateSet.inter qfq ql,qfr); + if tnnode == Tree.nil + then () + else NodeHash.replace run nnode (StateSet.inter qnq qr,qnr); + tp_max asta run tree tfnode; + tp_max asta run tree tnnode; + end; end - + let compute tree asta = let flag = 2 in (* debug *) let size_tree = 10000 in (* todo *) -- 2.17.1