X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftable.ml;h=4e81e2156a089d46257aad3f9af7dfe0a6021b9d;hb=bf8537a562ad461cdecc45978c36e5ad2b35766f;hp=3d372eca395d5486d03342d0b6e717b432dcc2a8;hpb=333d2789a5dd6b7395b5fedbcdd670e103e0eb4b;p=tatoo.git diff --git a/src/table.ml b/src/table.ml index 3d372ec..4e81e21 100644 --- a/src/table.ml +++ b/src/table.ml @@ -20,10 +20,116 @@ and query_tree = { } +module QTree = struct + type t = query_tree + let rec equal q1 q2 = + q1 == q2 || + (q1.id == q2.id && q1.id != -1) || + match q1.desc, q2.desc with + | Binop(op1,qt1,qt2),Binop(op2,qt3,qt4)-> op1==op2&& (equal qt1 qt3 && equal qt2 qt4) + + | Axis(a1,qt1),Axis(a2,qt2) -> compare_axis a1 a2 && equal qt1 qt2 + | Tag(t1,k1),Tag(t2,k2) -> t1==t2&& k1==k2 + | Dom,Dom | Start,Start -> true + | _,_ ->false + and compare_axis a1 a2 = + match a1,a2 with + Self ,Self | Attribute, Attribute | Child , Child | Parent , Parent + | FollowingSibling , FollowingSibling + | PrecedingSibling , PrecedingSibling + | Preceding , Preceding | Following , Following -> true + | Descendant b1, Descendant b2 -> b1==b2 + | Ancestor b1, Ancestor b2 -> b1==b2 + | _,_ -> false + let rec hash q = + if q.hash != -1 then q.hash + else match q.desc with + Dom -> 1 + | Start -> 3 + | Tag(s,_) -> 5 + 17*QNameSet.hash s + | Axis(a,q) -> 7 + 17 * Hashtbl.hash a + 23* hash q + | Binop(op,q1,q2) -> 11 + 17* Hashtbl.hash op + 23* hash q1 + 27* hash q2 +end +module QTreeHash = Hashtbl.Make(QTree) + +let compare_node tree a b = + compare (Naive_tree.preorder tree a ) (Naive_tree.preorder tree b ) + +module Tas = struct +type 'a tas = + | Vide + | Noeud of 'a tas * 'a * 'a tas + +let comp_node tree a b = (Naive_tree.preorder tree a )< (Naive_tree.preorder tree b ) + +let rec size t = + match t with + Vide -> 0 + | Noeud (t1,racine,t2) -> 1+ size t1 + size t2 + +let rec height t = + match t with + Vide -> 0 + | Noeud (t1,racine,t2) -> 1 + max (height t1) (height t2) + +let equilibre t = + let rec aux t = + match t with + Vide -> 0 + | Noeud (t1,racine,t2) -> 1 + min (aux t1) (aux t2) + in + let max_h = height t in + let min_h = aux t in + if max_h- min_h >1 then false + else true + +let is_tas t = + if not (equilibre t) then false + else + let rec aux n t = + match t with + Vide -> true + | Noeud (Vide,racine,Vide) -> racine >= n + | Noeud (t1,racine, t2) -> (aux racine t1) && (aux racine t2) + in + aux 0 t + +let rec pop tree t = + match t with + Vide -> failwith "Tas vide" + | Noeud (t1, racine, t2) -> begin + match t1,t2 with + Vide,t2 -> t2 + | t1,Vide -> t1 + | Noeud (t3,r1,t4),Noeud (t5,r2,t6) -> if comp_node tree r1 r2 then Noeud (pop tree t1, r1,t2) + else Noeud (pop tree t2, r2, t1) + end + +let rec push tree t a = + match t with + Vide -> Noeud(Vide,a,Vide) + | Noeud (t1,r,t2) -> if comp_node tree a r then Noeud (t2,a,push tree t1 r) + else Noeud(t2,r, push tree t1 a) + +let tas_of_list tree l = + List.fold_left (push tree) Vide l + +let is_empty t = (size t )== 0 + +let rec list_of_tas tree t = + match t with + Vide -> [] + | Noeud(t1,r,t2) -> r::(list_of_tas tree (pop tree t)) + +let sort_of_list tree l = + let t = tas_of_list tree l in + list_of_tas tree t + +end (*28/01/2014 parametres : tree l'arbre xml @@ -73,8 +179,7 @@ let rec eval_relation tree m n = *) -let compare_node tree a b = - compare (Naive_tree.preorder tree a ) (Naive_tree.preorder tree b ) + let rec eval_move tree ls m = match m with @@ -106,52 +211,42 @@ and eval_star tree ls lr = end done; let l = Hashtbl.fold (fun k _ acc -> k::acc) h [] in - List.sort (compare_node tree) l - -(*28/01/2014 - parametres : tree l'arbre xml - ls l'ensemble de noeuds - a axis - retour : l'ensemble de noeuds qui correspondent ॆ l'axe -*) + l + (* + Tas.sort_of_list tree l + List.sort (compare_node tree) l*) -let keep_elements t l = (* - List.filter (fun n -> match Naive_tree.kind t n with - | Element | Text | Document | Attribute -> true | _ -> false) l - *) l -let keep_attributs t l = (* - List.filter (fun n -> match Naive_tree.kind t n with - | Attribute ->true | _ -> false) *) l 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 - keep_attributs tree lc + lc | Child -> let lfc = eval_move tree ls Firstchild in let lc = eval_star tree lfc [Nextsibling] in - keep_elements tree lc + lc | Descendant c -> let lfc = eval_move tree ls Firstchild in let ls2 = eval_star tree lfc [Firstchild;Nextsibling] in let ldes = - if not c then ls2 - else List.merge (compare_node tree) ls2 ls + if not c then ls2 + else List.merge (compare_node tree) ls2 ls in - keep_elements tree ldes + ldes | FollowingSibling -> let lnexts = eval_move tree ls Nextsibling in let lfs = eval_star tree lnexts [Nextsibling] in - keep_elements tree lfs + lfs | Parent -> let lprevs = eval_star tree ls [Prevsibling] in let lp = eval_move tree lprevs Revfirstchild in - keep_elements tree lp + lp | Ancestor b -> let ls2 = eval_star tree ls [Revfirstchild;Prevsibling] in let ls3 = eval_move tree ls2 Revfirstchild in @@ -159,23 +254,23 @@ let rec eval_axis tree ls a = if not b then ls3 else List.merge (compare_node tree ) ls3 ls in - keep_elements tree lac + lac | PrecedingSibling -> let ls2 = eval_star tree ls [Prevsibling] in let lps = eval_move tree ls2 Prevsibling in - keep_elements tree lps + lps | Preceding -> let ls2 = eval_axis tree ls (Ancestor true) in let ls3 = eval_axis tree ls2 PrecedingSibling in let lp = eval_axis tree ls3 (Descendant true) in - keep_elements tree lp + lp | Following -> let ls2 = eval_axis tree ls (Ancestor true) in let ls3 = eval_axis tree ls2 FollowingSibling in let lf = eval_axis tree ls3 (Descendant true) in - keep_elements tree lf - - + lf + in + List.sort (compare_node tree) res