intersect improved in speed

[helm.git] / helm / ocaml / mathql_interpreter / union.ml

diff --git a/helm/ocaml/mathql_interpreter/union.ml b/helm/ocaml/mathql_interpreter/union.ml
index 2a759535a1b7c08bf54ad4e6d29c2ef76cc4f822..5573c192ed74d77d3dcaaec436c84f4d23e00090 100644 (file)
--- a/helm/ocaml/mathql_interpreter/union.ml
+++ b/helm/ocaml/mathql_interpreter/union.ml
@@ -64,38 +64,44 @@ let union_ex alist1 alist2 =
                             head1)
                            ) in (* header del risultato finale *)
       List.append (* il risultato finale e' la concatenazione ...*)
-       [headr] (* ... dell'header costruito prima ...*)
-       (match (tail1, tail2) with (* e di una coda "unione" *)
-           ([], _) -> tail2 (* va bene perche' l'altra lista e' vuota *)
-        |  (_, []) -> tail1 (* va bene perche' l'altra lista e' vuota *)
-        |  (_,  _) ->
-           let first = (* parte dell'unione che riguarda solo il primo set *)
-            List.map (fun l -> [List.hd l] @
-                      xres_fill_context
-                       (List.tl headr) (List.tl head1) (List.tl l)
-                     ) tail1
-            in
-            List.fold_left
-             (fun par x ->
-              let y = (* elemento candidato ad entrare *)
-               [List.hd x]
-               @
-               xres_fill_context
-                (List.tl headr) (List.tl head2) (List.tl x)
-              in
-               par @ if (List.find_all (fun t -> t = y) par) = [] then
-                      [y]
-                     else
-                      []
-             )
-             first
-             tail2
+       [headr]             (* ... dell'header costruito prima ...*)
+       (Sort.list
+        (fun l m -> List.hd l < List.hd m)
+        (match (tail1, tail2) with      (* e di una coda "unione" *)
+            ([], _) -> tail2 (* va bene perche' l'altra lista e' vuota *)
+         |  (_, []) -> tail1 (* va bene perche' l'altra lista e' vuota *)
+         |  (_,  _) ->
+            let first = (* parte dell'unione che riguarda solo il primo set *)
+             List.map
+              (
+               fun l ->
+                [List.hd l] @
+                xres_fill_context (List.tl headr) (List.tl head1) (List.tl l)
+              )
+              tail1
+             in
+             List.fold_left
+              (fun par x ->
+               let y = (* elemento candidato ad entrare *)
+                [List.hd x]
+                @
+                xres_fill_context
+                 (List.tl headr) (List.tl head2) (List.tl x)
+               in
+                par @ if (List.find_all (fun t -> t = y) par) = [] then
+                       [y]
+                      else
+                       []
+              )
+              first (* List.fold_left *)
+              tail2 (* List.fold_left *)
 (*          first @
             List.map (fun l -> [List.hd l] @
                       xres_fill_context
                        (List.tl headr) (List.tl head2) (List.tl l)
                      ) tail2
 *)
-       ) (* match *)
+        ) (* match *)
+       )
 ;;