X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftable.ml;h=15d39bcb712b6ae08870ad844bc302b2392ce678;hb=c7229e6e3c000938a74abeb52749f62a65c3bbfd;hp=5876e7ef5667e6b94528c6aa80f8699b4ee1fa91;hpb=11fd750e5f19e421768ec72c511b631e7b009365;p=tatoo.git

diff --git a/src/table.ml b/src/table.ml
index 5876e7e..15d39bc 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)
 
 
@@ -142,6 +64,14 @@ let rec union_list t l1 l2 =
       else if (comp_node t h1 h2) then h1::(union_list t ll1 l2)
       else h1 ::(union_list t ll1 ll2)
 
+let rec merge_list t l1 l2 =
+  match l1,l2 with
+    | [],l2 -> l2
+    | l1,[] -> l1
+    | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h1:: (merge_list t ll1 l2)
+      else if (comp_node t h1 h2) then h2:: (merge_list t l1 ll2)
+      else h1::(merge_list t ll1 ll2)
+
 let rec inter_list t l1 l2 =
   match l1,l2 with
     | [],l2 -> []
@@ -183,59 +113,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
@@ -244,7 +122,11 @@ let rec compare_node_list tree l1 l2 =
     | 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_list_ordred tree ll =
+  let l1 = List.fold_left (fun acc l -> merge_list tree acc l) [] ll in
+  List.rev l1
+
 let get_descendant tree ln =
   let rec aux n acc =
     if n == Naive_tree.nil then  acc
@@ -254,11 +136,10 @@ let get_descendant tree ln =
 	 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 ll = List.map (fun n -> 
+    let n1 = Naive_tree.first_child tree n in
+    aux n1 [] ) ln in
+  get_list_ordred tree ll
 
 let get_child tree ln =
   let rec aux n acc =
@@ -269,10 +150,8 @@ let get_child tree ln =
   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
+    aux n1 [] )  ln in
+  get_list_ordred tree ll
 
   
 let get_followingSibling tree ln =
@@ -281,9 +160,8 @@ let get_followingSibling tree ln =
     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 ll = List.map (fun n -> aux n [] ) ln in
+  get_list_ordred tree ll
   
  
 let rec get_firstBling tree n pred =
@@ -291,16 +169,13 @@ let rec get_firstBling tree n 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 ->
+  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   
+    if n2 != Naive_tree.nil then union_list tree [n2] acc   
+    else acc
   ) [] ln
-  in
-  l
-
-  
+ 
 
 let get_ancestor tree ln =
   let rec aux tree l1 acc =