From 9b23e4b3a2862c73d0b61c96cd68562dac3bf7f6 Mon Sep 17 00:00:00 2001 From: lordi Date: Thu, 23 May 2002 16:12:52 +0000 Subject: [PATCH] intersect improved in speed --- helm/ocaml/mathql_interpreter/eval.ml | 6 +- helm/ocaml/mathql_interpreter/intersect.ml | 118 +++++++++++++-------- helm/ocaml/mathql_interpreter/mqint.ml | 2 +- helm/ocaml/mathql_interpreter/pattern.ml | 2 +- helm/ocaml/mathql_interpreter/union.ml | 60 ++++++----- helm/ocaml/mathql_interpreter/use.ml | 2 +- 6 files changed, 111 insertions(+), 79 deletions(-) diff --git a/helm/ocaml/mathql_interpreter/eval.ml b/helm/ocaml/mathql_interpreter/eval.ml index c36b92fd2..4bc9a88db 100644 --- 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 bd582a3b2..f869838f3 100644 --- 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 56fa38ad9..8aa07a368 100644 --- 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 c9dde8b6a..cc03b61b8 100644 --- 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 2a759535a..5573c192e 100644 --- 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 cb65699e9..899a2bf89 100644 --- 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 -- 2.39.2