intersect improved in speed

diff --git a/helm/ocaml/mathql_interpreter/eval.ml b/helm/ocaml/mathql_interpreter/eval.ml
index c36b92fd2bedc004bd3b3cfba9d9ac38f4ed2c06..4bc9a88db942c10b00f28f2bdf7737fa5efa4565 100644 (file)
--- a/helm/ocaml/mathql_interpreter/eval.ml
+++ b/helm/ocaml/mathql_interpreter/eval.ml
@@ -39,9 +39,9 @@ let rec patterneval p =
     let h = match head with
                MQString (s) -> Str.global_replace (Str.regexp "\.") "\\\\\." s
             |  MQSlash -> "/"
-            |  MQAnyChr -> "[^/]?"
-            |  MQAst -> "[^/]*"
-            |  MQAstAst -> ".*"
+            |  MQAnyChr -> "[^/#]?"
+            |  MQAst -> "[^/#]*"
+            |  MQAstAst -> "[^#]*"
     in
      h ^ (patterneval tail)
 ;;

diff --git a/helm/ocaml/mathql_interpreter/intersect.ml b/helm/ocaml/mathql_interpreter/intersect.ml
index bd582a3b2ae8c1dbb9e6d56ede86ca1bea274a56..f869838f3fba9facb00ac2d3ba21d151d1c2db5c 100644 (file)
--- a/helm/ocaml/mathql_interpreter/intersect.ml
+++ b/helm/ocaml/mathql_interpreter/intersect.ml
@@ -45,8 +45,7 @@ let xres_join_context h1 l1 h2 l2 =
      and m1 = List.combine h1 l1
      and m2 = List.combine h2 l2
      in
-      try 
-       (List.map
+       List.map
         (fun elem ->
          let value1 = try (List.assoc elem m1) with Not_found -> List.assoc elem m2
          and value2 = try (List.assoc elem m2) with Not_found -> List.assoc elem m1
@@ -54,54 +53,81 @@ let xres_join_context h1 l1 h2 l2 =
           if value1 = value2 then value1 else raise Join_must_be_empty
         )
         hh
-       ) with
-        Join_must_be_empty -> []
 ;;
 
 (*
- * implementazione del comando INTERSECT
+ *
  *)
-let intersect_ex alist1 alist2 =
- let head1 = List.hd alist1
- and tail1 = List.tl alist1
- and head2 = List.hd alist2
- and tail2 = List.tl alist2 (* e fin qui ... *)
+let intersect_tails h1 t1 h2 t2 =
+ let rec aux t1 t2 =
+  match (t1, t2) with
+     ([], _)
+  |  (_, []) -> []
+  |  ((l1::tl1)::tll1, (l2::tl2)::tll2) ->
+       if l1 = l2 then
+        try
+         (*match xres_join_context h1 tl1 h2 tl2 with
+            [] -> aux tll1 tll2
+          | t  ->*) (l1::(xres_join_context h1 tl1 h2 tl2))::(aux tll1 tll2)
+       with
+        Join_must_be_empty -> aux tll1 tll2
+       else
+        if l1 < l2 then
+         aux tll1 t2
+        else
+         aux t1 tll2
+   | _ -> assert false
  in
-  match (head1, head2) with
-     ([], _) -> assert false (* gli header non devono mai essere vuoti *)
-  |  (_, []) -> assert false (* devono contenere almeno [retVal] *)
-  |  (_,  _) ->
-      (match (tail1, tail2) with
-          ([], _) -> [["retVal"]] (* se una delle due code e' vuota... *)
-       |  (_, []) -> [["retVal"]] (* ... l'intersezione e' vuota *)
-       |  (_,  _) ->
-           [head2 @
-            (List.find_all
-            (function t -> not (List.mem t head2))
-            head1
-           )
-          ] (* header del risultato finale *)
-          @
-          List.fold_left
-            (fun par1 elem1 -> par1 @
-             List.map
-             (fun elem2 ->
-              [(List.hd elem1)] @
-              (xres_join_context (List.tl head1) (List.tl elem1)
-                                 (List.tl head2) (List.tl elem2))
-             )
-              (List.find_all
-               (fun elem2 -> (* trova tutti gli elementi della lista tail2 *)
-               ((List.hd elem1) = (List.hd elem2)) && (* che stanno in tail1 *)
-               not ((xres_join_context (List.tl head1) (List.tl elem1)
-                                       (List.tl head2) (List.tl elem2)) = [])
-               (* e per i quali la xres_join_context non sia vuota *)
-              )
-               tail2
-             )
-             )
-           []
-           tail1 (* per ogni elemento di tail1 applica la List.fold_left *)
-      ) (* match *)
+  aux t1 t2
+;;
+
+(*
+ * implementazione del comando INTERSECT
+ *)
+let intersect_ex l1 l2 =
+ match (l1, l2) with
+    ((head1::tail1), (head2::tail2)) ->
+     (match (head1, head2) with
+         ([], _) -> assert false (* gli header non devono mai essere vuoti *)
+      |  (_, []) -> assert false (* devono contenere almeno [retVal] *)
+      |  (_,  _) ->
+          (match (tail1, tail2) with
+              ([], _) -> [["retVal"]] (* se una delle due code e' vuota... *)
+           |  (_, []) -> [["retVal"]] (* ... l'intersezione e' vuota *)
+           |  (_,  _) ->
+               [head2 @
+                (List.find_all
+                (function t -> not (List.mem t head2))
+                head1
+               )
+              ] (* header del risultato finale *)
+              @
+              intersect_tails (List.tl head1) tail1 (List.tl head2) tail2
+              (*
+              List.fold_left
+                (fun par1 elem1 -> par1 @
+                 List.map
+                 (fun elem2 ->
+                  [(List.hd elem1)] @
+                  (xres_join_context (List.tl head1) (List.tl elem1)
+                                     (List.tl head2) (List.tl elem2)
+                   )
+                 )
+                  (List.find_all (* *)
+                   (fun elem2 ->    (* trova tutti gli elementi della lista tail2 *)
+                   ((List.hd elem1) = (List.hd elem2)) && (* che stanno in tail1 *)
+                   not ((xres_join_context (List.tl head1) (List.tl elem1)
+                                           (List.tl head2) (List.tl elem2)) = [])
+                   (* e per i quali la xres_join_context non sia vuota *)
+                  )
+                   tail2 (* List.find_all *)
+                 )
+                 )
+               []
+               tail1 (* per ogni elemento di tail1 applica la List.fold_left *)
+              *)
+          ) (* match *)
+     )
+ | _ -> []
 ;;
 

diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml
index 56fa38ad928d0b9017ac58f0ebaad8b26d57f9f4..8aa07a36879bc5add524bff23822c9f9e2e38521 100644 (file)
--- a/helm/ocaml/mathql_interpreter/mqint.ml
+++ b/helm/ocaml/mathql_interpreter/mqint.ml
@@ -77,7 +77,7 @@ let rec execute_ex q =
    |  MQUse (alist, asvar) ->
        use_ex (execute_ex alist) asvar "backPointer"
    |  MQPattern (apreamble, apattern, afragid) ->
-       let _ = print_endline ("*********" ^ (fi_to_string afragid)); flush stdout in
+       (*let _ = print_endline ("*********" ^ apreamble ^ (fi_to_string afragid)); flush stdout in*)
        pattern_ex apreamble apattern afragid
    |  MQUnion (l1, l2) ->
        union_ex (execute_ex l1) (execute_ex l2)

diff --git a/helm/ocaml/mathql_interpreter/pattern.ml b/helm/ocaml/mathql_interpreter/pattern.ml
index c9dde8b6ab39f4e50f77bef332d7ede617a090c3..cc03b61b8dc3a8d33dc61783d72e166a3685e07f 100644 (file)
--- a/helm/ocaml/mathql_interpreter/pattern.ml
+++ b/helm/ocaml/mathql_interpreter/pattern.ml
@@ -34,7 +34,7 @@ open Eval;;
 let pattern_ex apreamble apattern afragid =
  let c = pgc () in
   let r1 = helm_class_id "MathResource" in
-   let qq = "select att0 from t" ^ r1 ^ " where att0 " ^ (pattern_match apreamble apattern afragid) in
+   let qq = "select att0 from t" ^ r1 ^ " where att0 " ^ (pattern_match apreamble apattern afragid) ^ " order by t" ^ r1 ^ ".att0 asc" in
    (*let _ = print_endline qq in*)
     let res =
      c#exec (qq)

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 *)
+       )
 ;;
 

diff --git a/helm/ocaml/mathql_interpreter/use.ml b/helm/ocaml/mathql_interpreter/use.ml
index cb65699e970c3955067b633c0ca4689028ea7213..899a2bf8923ff9d264f4625a7364e6b51da2bb54 100644 (file)
--- a/helm/ocaml/mathql_interpreter/use.ml
+++ b/helm/ocaml/mathql_interpreter/use.ml
@@ -56,7 +56,7 @@ let use_ex alist asvar usek =
       "from t" ^ r3 ^ ", t" ^ r2 ^ ", t" ^ r1 ^ " " ^
       "where " ^ "t" ^ r1 ^ ".att0 = '" ^ (List.hd xres) ^ "' and t" ^ r1 ^
       ".att1 = t" ^ r2 ^ ".att0 and t" ^ r1 ^ ".att1 = t" ^ r3 ^
-      ".att0"
+      ".att0 order by t" ^ r3 ^ ".att1 asc"
      in
      (*let _ = print_endline ("use: " ^ qq) in*)
      let res = c#exec qq in