X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftable.ml;h=0c9e119964032627b29ef6ff56f6bfcd79d24fbf;hb=65b8c40ffe6dc048d88577931c65bc71cdaa7a44;hp=5876e7ef5667e6b94528c6aa80f8699b4ee1fa91;hpb=11fd750e5f19e421768ec72c511b631e7b009365;p=tatoo.git diff --git a/src/table.ml b/src/table.ml index 5876e7e..0c9e119 100644 --- a/src/table.ml +++ b/src/table.ml @@ -1,10 +1,4 @@ -type move = Self - | Firstchild - | Nextsibling - | Revfirstchild - | Prevsibling - type query_tree_desc = Binop of op * query_tree * query_tree | Axis of Xpath.Ast.axis * query_tree | Start @@ -59,78 +53,6 @@ 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 - let comp_node t n1 n2 = (Naive_tree.preorder t n1) < (Naive_tree.preorder t n2) @@ -183,59 +105,7 @@ and print_binop fmt o = | Inter -> Format.fprintf fmt "Inter" | Diff -> Format.fprintf fmt "Diff" -let rec eval_relation tree m n = - match m with - Self -> n - | Firstchild -> Naive_tree.first_child tree n - | Nextsibling -> Naive_tree.next_sibling tree n - | Revfirstchild -> Naive_tree.parent_of_first tree n - | Prevsibling -> Naive_tree.prev_sibling tree n - -(*28/01/2014 - parametres : tree l'arbre xml - ls l'ensemble de noeuds - m move - retour : l'ensemble de noeuds qui correspondent ॆ la relation r -*) - - - - -let rec eval_move tree ls m = - match m with - Self -> ls - | r -> List.filter (fun n -> n != Naive_tree.nil) - (List.map (eval_relation tree r) ls) - -(*28/01/2014 - parametres : tree l'arbre xml - ls l'ensemble de noeuds - m move - retour : l'ensemble de noeuds qui correspondent ॆ des relations lr -*) - -and eval_star tree ls lr = - let h = Hashtbl.create 17 in - let q = Queue.create () in - List.iter ( fun e -> Queue.add e q ) ls; - while not (Queue.is_empty q ) do - let n = Queue.pop q in - if not (Hashtbl.mem h n) then begin - Hashtbl.add h n (); - List.iter ( fun r -> let m = eval_relation tree r n in - if m != Naive_tree.nil && not (Hashtbl.mem h m ) then begin - - Queue.add m q; end - ) lr - end - done; - let l = Hashtbl.fold (fun k _ acc -> k::acc) h [] in - l - (* - 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