From 11fd750e5f19e421768ec72c511b631e7b009365 Mon Sep 17 00:00:00 2001 From: Huibo SHI Date: Thu, 3 Apr 2014 15:52:03 +0200 Subject: [PATCH] Remplacer la fonction List.sort par les fonctions d'evaluations. La liste de fonction comme la suite: 1) get_descendant 2) get_child 3) get_parent 4) get_followingSibling 5) get_preSibling 6) get_ancestor --- src/query_tree.ml | 62 +----------------- src/query_tree.mli | 4 +- src/table.ml | 154 +++++++++++++++++++++++++++++++++++--------- src/table_driver.ml | 1 - tests/tiny2.xml | 4 +- tests/tiny3.xml | 6 ++ 6 files changed, 136 insertions(+), 95 deletions(-) create mode 100644 tests/tiny3.xml diff --git a/src/query_tree.ml b/src/query_tree.ml index 404c750..a818047 100644 --- a/src/query_tree.ml +++ b/src/query_tree.ml @@ -5,7 +5,8 @@ let table_query_tree = Hashtbl.create 97 let table_qtree = QTreeHash.create 97 let all_nodes tree = let root = Naive_tree.root tree in - eval_axis tree [root] (Descendant true) + let acc1 = get_descendant tree [root] in + root::acc1 let element_by_tag tree tagset kind = let dom = all_nodes tree in List.filter (fun c -> @@ -89,33 +90,8 @@ let compile_xpath p = match p with | [p] -> compile_single_path p | p::r -> List.fold_left (fun acc p -> mk_node (Binop (Union , acc, compile_single_path p) )) (compile_single_path p) r -let comp_node t n1 n2 = (Naive_tree.preorder t n1) < (Naive_tree.preorder t n2) -let rec union_list t l1 l2 = - match l1,l2 with - | [],l2 -> l2 - | l1, [] -> l1 - | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h2 :: (union_list t l1 ll2) - else if (comp_node t h1 h2) then h1::(union_list t ll1 l2) - else h1 ::(union_list t ll1 ll2) - -let rec inter_list t l1 l2 = - match l1,l2 with - | [],l2 -> [] - | l1, [] -> [] - | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then inter_list t ll1 l2 - else if (comp_node t h2 h1) then inter_list t l1 ll2 - else h1 :: (inter_list t ll1 ll2) - -let rec diff_list t l1 l2 = - match l1,l2 with - | [],l2 -> [] - | l1, [] -> l1 - | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then h1::(diff_list t ll1 l2) - else if (comp_node t h2 h1) then h2 :: (diff_list t l1 ll2) - else diff_list t ll1 ll2 - let do_debug = ref false @@ -155,38 +131,6 @@ and compare_axis a1 a2 = | Ancestor b1, Ancestor b2 -> b1==b2 | _,_ -> false - -let rec eval_query_tree tree start q = - let resultat = - begin - try - Hashtbl.find table_query_tree q - with Not_found -> - let res = - match q.desc with - | Start -> start - | Dom -> all_nodes tree - | Tag (t,k) -> element_by_tag tree t k - | Axis (a,q1) -> let ls = eval_query_tree tree start q1 in - eval_axis tree ls a - | Binop (op,q1,q2)-> begin - let ls1 = eval_query_tree tree start q1 in - let ls2 = eval_query_tree tree start q2 in - match op with - | Union -> union_list tree ls1 ls2 - | Inter -> inter_list tree ls1 ls2 - | Diff -> diff_list tree ls1 ls2 - end - in - let res = List.sort (Table.compare_node tree) res in - Hashtbl.add table_query_tree q res; - compteur := !compteur + (List.length res); - res - end - in - debug tree q resultat; - resultat - let mini_id = ref 0 let mini_table = QTreeHash.create 17 @@ -236,8 +180,6 @@ let rec eval_qtree tree start q = | Diff -> diff_list tree ls1 ls2 end in -(* let res = Tas.sort_of_list tree res in - let res = List.sort (Table.compare_node tree) res in*) QTreeHash.add table_qtree q res; compteur := !compteur + (List.length res); res diff --git a/src/query_tree.mli b/src/query_tree.mli index f34cc3b..e578beb 100644 --- a/src/query_tree.mli +++ b/src/query_tree.mli @@ -16,7 +16,7 @@ val compile_single_path : Xpath.Ast.single_path -> Table.query_tree val compile_xpath : Xpath.Ast.path -> Table.query_tree (** [compile_xpath path] returns un query_tree built with [xpath] *) - +(* val union_list : Naive_tree.t ->Naive_tree.node list -> Naive_tree.node list -> Naive_tree.node list (** union two lists without duplicating *) @@ -34,7 +34,7 @@ val eval_query_tree : Naive_tree.t -> Naive_tree.node list ->Table.query_tree -> [start] the set of nodes departing. [q] query_tree *) - +*) val minimize_qtree : Table.query_tree -> Table.query_tree val eval_qtree : Naive_tree.t -> Naive_tree.node list ->Table.query_tree -> Naive_tree.node list diff --git a/src/table.ml b/src/table.ml index 4e81e21..5876e7e 100644 --- a/src/table.ml +++ b/src/table.ml @@ -131,12 +131,32 @@ let sort_of_list tree l = end -(*28/01/2014 - parametres : tree l'arbre xml - n un noeud - m move - retour :un noeud qui correspond ॆ la relation r -*) +let comp_node t n1 n2 = (Naive_tree.preorder t n1) < (Naive_tree.preorder t n2) + + +let rec union_list t l1 l2 = + match l1,l2 with + | [],l2 -> l2 + | l1, [] -> l1 + | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h2 :: (union_list t l1 ll2) + else if (comp_node t h1 h2) then h1::(union_list t ll1 l2) + else h1 ::(union_list t ll1 ll2) + +let rec inter_list t l1 l2 = + match l1,l2 with + | [],l2 -> [] + | l1, [] -> [] + | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then inter_list t ll1 l2 + else if (comp_node t h2 h1) then inter_list t l1 ll2 + else h1 :: (inter_list t ll1 ll2) + +let rec diff_list t l1 l2 = + match l1,l2 with + | [],l2 -> [] + | l1, [] -> l1 + | h1::ll1, h2::ll2 -> if (comp_node t h1 h2) then h1::(diff_list t ll1 l2) + else if (comp_node t h2 h1) then h2 :: (diff_list t l1 ll2) + else diff_list t ll1 ll2 let print_node_list tree l = List.iter (fun node -> @@ -216,49 +236,123 @@ and eval_star tree ls lr = Tas.sort_of_list tree l List.sort (compare_node tree) l*) +let rec compare_node_list tree l1 l2 = + match l1,l2 with + [],[] -> 0 + | _,[] -> 1 + | [],_ -> -1 + | n1::ll1,n2::ll2 -> let b = compare_node tree n1 n2 in + if b=0 then compare_node_list tree ll1 ll2 + else b + +let get_descendant tree ln = + let rec aux n acc = + if n == Naive_tree.nil then acc + else let n1 = Naive_tree.first_child tree n in + let acc1 = aux n1 (n::acc) in + let n2 = Naive_tree.next_sibling tree n in + let acc2 = aux n2 acc1 in + acc2 + in + let l = List.fold_left (fun acc n -> if List.mem n acc then acc + else let n1 = Naive_tree.first_child tree n in + aux n1 acc) [] ln + in + List.rev l + +let get_child tree ln = + let rec aux n acc = + if n == Naive_tree.nil then acc + else + let n1 = Naive_tree.next_sibling tree n in + aux n1 (n::acc) + in + let ll = List.map (fun n-> + let n1 = Naive_tree.first_child tree n in + let res = aux n1 [] in + List.rev res + ) ln in + List.fold_left (fun acc l -> union_list tree acc l) [] ll + +let get_followingSibling tree ln = + let rec aux n acc = + let n1 = Naive_tree.next_sibling tree n in + if n1 == Naive_tree.nil then acc + else aux n1 (n1::acc) + in + let ll = List.map (fun n -> let res = aux n [] in + List.rev res ) ln in + List.fold_left (fun acc l1 -> union_list tree acc l1) [] ll + + +let rec get_firstBling tree n pred = + if n== Naive_tree.nil then pred + else get_firstBling tree (Naive_tree.prev_sibling tree n) n + +let get_parent tree ln = + let l = List.fold_left (fun acc n -> + let n1 = get_firstBling tree n Naive_tree.nil in + let n2 = Naive_tree.parent_of_first tree n1 in + if n2 == Naive_tree.nil or List.mem n2 acc then acc + else union_list tree [n2] acc + ) [] ln + in + l + + + +let get_ancestor tree ln = + let rec aux tree l1 acc = + match l1 with + [] -> acc + | _ -> let ll1 = get_parent tree l1 in + let acc1 = union_list tree acc ll1 in + aux tree ll1 acc1 + in + let l = aux tree ln [] in + l + +let get_preSibling tree ln = + let rec aux n acc = + let n1 = Naive_tree.prev_sibling tree n in + if n1 == Naive_tree.nil then acc + else aux n1 (n1::acc) + in + let ll = List.map (fun n -> aux n [] ) ln in + List.fold_left (fun acc l1 -> union_list tree acc l1) [] ll + + let rec eval_axis tree ls a = let open Xpath.Ast in - let res= match a with Self -> ls - | Attribute -> let lfc = eval_move tree ls Firstchild in - let lc = eval_star tree lfc [Nextsibling] in - lc + | Attribute -> get_child tree ls - | Child -> let lfc = eval_move tree ls Firstchild in - let lc = eval_star tree lfc [Nextsibling] in - lc + | Child -> get_child tree ls - | Descendant c -> let lfc = eval_move tree ls Firstchild in - let ls2 = eval_star tree lfc [Firstchild;Nextsibling] in + | Descendant c -> let ls2 = get_descendant tree ls in let ldes = if not c then ls2 - else List.merge (compare_node tree) ls2 ls + else union_list tree ls2 ls in ldes - | FollowingSibling -> let lnexts = eval_move tree ls Nextsibling in - let lfs = eval_star tree lnexts [Nextsibling] in - lfs + | FollowingSibling -> get_followingSibling tree ls - | Parent -> let lprevs = eval_star tree ls [Prevsibling] in - let lp = eval_move tree lprevs Revfirstchild in - lp + | Parent -> get_parent tree ls - | Ancestor b -> let ls2 = eval_star tree ls [Revfirstchild;Prevsibling] in - let ls3 = eval_move tree ls2 Revfirstchild in + | Ancestor b -> + let ls3 = get_ancestor tree ls in let lac = if not b then ls3 - else List.merge (compare_node tree ) ls3 ls + else union_list tree ls3 ls in lac - | PrecedingSibling -> let ls2 = eval_star tree ls [Prevsibling] in - let lps = eval_move tree ls2 Prevsibling in - lps + | PrecedingSibling -> get_preSibling tree ls | Preceding -> let ls2 = eval_axis tree ls (Ancestor true) in let ls3 = eval_axis tree ls2 PrecedingSibling in @@ -269,9 +363,7 @@ let rec eval_axis tree ls a = let ls3 = eval_axis tree ls2 FollowingSibling in let lf = eval_axis tree ls3 (Descendant true) in lf - in - List.sort (compare_node tree) res - + diff --git a/src/table_driver.ml b/src/table_driver.ml index 6ac6acb..f690b74 100644 --- a/src/table_driver.ml +++ b/src/table_driver.ml @@ -18,7 +18,6 @@ let main () = close_fd(); doc in - (*Hashtbl.clear Query_tree.table_query_tree; il faut vider le hashtbl?????????????????*) let queries = List.map ( fun q -> parse_xpath q) diff --git a/tests/tiny2.xml b/tests/tiny2.xml index b2aee8d..966b319 100644 --- a/tests/tiny2.xml +++ b/tests/tiny2.xml @@ -1,4 +1,4 @@ - + united states1duteous nine eighteen \ No newline at end of file diff --git a/tests/tiny3.xml b/tests/tiny3.xml new file mode 100644 index 0000000..49a5ae0 --- /dev/null +++ b/tests/tiny3.xml @@ -0,0 +1,6 @@ + + +united states1duteous nine eighteen + +dispatch reported dotard holofernes + \ No newline at end of file -- 2.17.1