From: natile Date: Thu, 10 Oct 2002 15:36:52 +0000 (+0000) Subject: Time misurations patched. X-Git-Tag: new_mathql_before_first_merge~6 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=14c77c97790562bd07405a290e3517c2532b7d12;p=helm.git Time misurations patched. --- diff --git a/helm/ocaml/mathql_interpreter/intersect.ml b/helm/ocaml/mathql_interpreter/intersect.ml index 84eb186a6..73bebaa50 100644 --- a/helm/ocaml/mathql_interpreter/intersect.ml +++ b/helm/ocaml/mathql_interpreter/intersect.ml @@ -49,7 +49,7 @@ let rec sum_groups(gr1, gr2) = ;; (* Product between an attribute set and a group of attributes *) -let rec sub_prod (aset, gr) = (*prende un aset e un gr e fa la somma tra tutti i gruppi di aset e gr *) +let rec sub_prod (aset, gr) = (*prende un aset e un gr, fa la somma tra tutti i gruppi di aset e gr*) match aset with [] -> [] | gr1::tl1 -> sum_groups (gr1, gr)::(sub_prod(tl1, gr)) @@ -65,28 +65,11 @@ let rec prod (as1, as2) = ;; (* Intersection between two resource sets, preserves order and gets rid of duplicates *) -let intersect_ex rs1 rs2 = - let rec intersect_aux rs1 rs2 = - match (rs1, rs2) with - [],_ - | _,[] -> [] - | (uri1,_)::tl1, - (uri2,_)::_ when uri1 < uri2 -> intersect_aux tl1 rs2 - | (uri1,_)::_, - (uri2,_)::tl2 when uri2 < uri1 -> intersect_aux rs1 tl2 - | (uri1,as1)::tl1, - (uri2,as2)::tl2 -> (uri1, prod(as1,as2))::intersect_aux tl1 tl2 - in - let before = Sys.time () in - let res = intersect_aux rs1 rs2 in - let after = Sys.time () in - let ll1 = string_of_int (List.length rs1) in - let ll2 = string_of_int (List.length rs2) in - let diff = string_of_float (after -. before) in - print_endline - ("INTERSECT(" ^ ll1 ^ "," ^ ll2 ^ ") = " ^ string_of_int (List.length res) ^ - ": " ^ diff ^ "s") ; - flush stdout ; - res +let rec intersect_ex rs1 rs2 = + match (rs1, rs2) with + [],_ + | _,[] -> [] + | (uri1,_)::tl1, (uri2,_)::_ when uri1 < uri2 -> intersect_ex tl1 rs2 + | (uri1,_)::_, (uri2,_)::tl2 when uri2 < uri1 -> intersect_ex rs1 tl2 + | (uri1,as1)::tl1, (uri2,as2)::tl2 -> (uri1, prod(as1,as2))::intersect_ex tl1 tl2 ;; - diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml index 7731d9e2e..89f635aff 100644 --- a/helm/ocaml/mathql_interpreter/mqint.ml +++ b/helm/ocaml/mathql_interpreter/mqint.ml @@ -51,38 +51,67 @@ let check () = Dbconn.pgc () exception BooleExpTrue +let stat = ref true + +let set_stat b = stat := b + (* valuta una MathQL.set_exp e ritorna un MathQL.resource_set *) let rec exec_set_exp c = function |MathQL.SVar svar -> List.assoc svar c.svars |MathQL.RVar rvar -> [List.assoc rvar c.rvars] | MathQL.Ref vexp -> List.map (fun s -> (s,[])) (exec_val_exp c vexp) - | MathQL.Intersect (sexp1, sexp2) -> intersect_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) + | MathQL.Intersect (sexp1, sexp2) -> + let before = Sys.time() in + let rs1 = exec_set_exp c sexp1 in + let rs2 = exec_set_exp c sexp2 in + let res = intersect_ex rs1 rs2 in + let after = Sys.time() in + let ll1 = string_of_int (List.length rs1) in + let ll2 = string_of_int (List.length rs2) in + let diff = string_of_float (after -. before) in + if !stat then + (print_endline("INTERSECT(" ^ ll1 ^ "," ^ ll2 ^ ") = " ^ string_of_int (List.length res) ^ + ": " ^ diff ^ "s"); + flush stdout); + res | MathQL.Union (sexp1, sexp2) -> let before = Sys.time () in let res = union_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) in - let after = Sys.time () in + let after = Sys.time() in let diff = string_of_float (after -. before) in - print_endline ("UNION: " ^ diff ^ "s") ; - flush stdout ; + if !stat then + (print_endline ("UNION: " ^ diff ^ "s"); + flush stdout); res | MathQL.LetSVar (svar, sexp1, sexp2) -> - let before = Sys.time () in + let before = Sys.time() in let c1 = upd_svars c ((svar, exec_set_exp c sexp1) :: c.svars) in let res = exec_set_exp c1 sexp2 in - print_string ("LETIN " ^ svar ^ " = " ^ string_of_int (List.length res) ^ ": ") ; - print_endline (string_of_float (Sys.time () -. before) ^ "s") ; - flush stdout ; res + if !stat then + (print_string ("LETIN " ^ svar ^ " = " ^ string_of_int (List.length res) ^ ": "); + print_endline (string_of_float (Sys.time() -. before) ^ "s"); + flush stdout); + res | MathQL.LetVVar (vvar, vexp, sexp) -> - let before = Sys.time () in + let before = Sys.time() in let c1 = upd_vvars c ((vvar, exec_val_exp c vexp) :: c.vvars) in let res = exec_set_exp c1 sexp in - print_string ("LETIN " ^ vvar ^ " = " ^ string_of_int (List.length res) ^ ": ") ; - print_endline (string_of_float (Sys.time () -. before) ^ "s") ; - flush stdout ; res - | MathQL.Relation (rop, path, sexp, attl) -> relation_ex rop path (exec_set_exp c sexp) attl + if !stat then + (print_string ("LETIN " ^ vvar ^ " = " ^ string_of_int (List.length res) ^ ": "); + print_endline (string_of_float (Sys.time() -. before) ^ "s"); + flush stdout); + res + | MathQL.Relation (rop, path, sexp, attl) -> + let before = Sys.time() in + let res = relation_ex rop path (exec_set_exp c sexp) attl in + if !stat then + (print_string ("RELATION " ^ (List.hd path) ^ " = " ^ string_of_int(List.length res) ^ ": "); + print_endline (string_of_float (Sys.time() -. before) ^ "s"); + flush stdout); + res | MathQL.Select (rvar, sexp, bexp) -> - let before = Sys.time () in + let before = Sys.time() in let rset = (exec_set_exp c sexp) in let rec select_ex rset = match rset with @@ -92,9 +121,11 @@ let rec exec_set_exp c = function else select_ex tl in let res = select_ex rset in - print_string ("SELECT " ^ rvar ^ " = " ^ string_of_int (List.length res) ^ ": ") ; - print_endline (string_of_float (Sys.time () -. before) ^ "s") ; - flush stdout ; res + if !stat then + (print_string ("SELECT " ^ rvar ^ " = " ^ string_of_int (List.length res) ^ ": "); + print_endline (string_of_float (Sys.time() -. before) ^ "s"); + flush stdout); + res | MathQL.Diff (sexp1, sexp2) -> diff_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) | _ -> assert false @@ -126,7 +157,7 @@ and exec_boole_exp c = function in sub_prod attl in - prod c latt;false + prod c latt; false with BooleExpTrue -> true (* valuta una MathQL.val_exp e ritorna un MathQL.value *) diff --git a/helm/ocaml/mathql_interpreter/relation.ml b/helm/ocaml/mathql_interpreter/relation.ml index 4776e694c..159369ad2 100644 --- a/helm/ocaml/mathql_interpreter/relation.ml +++ b/helm/ocaml/mathql_interpreter/relation.ml @@ -23,64 +23,54 @@ * http://www.cs.unibo.it/helm/. *) -open Union;; -open Dbconn;; -open Utility;; + (* * implementazione del comando Relation *) + + +open Union;; +open Dbconn;; +open Utility;; + + + + let get_prop_id propl = - let prop = List.hd propl in + let prop = List.hd propl in if prop="refObj" then "F" else if prop="backPointer" then "B" else assert false ;; - let relation_ex rop path rset attl = - if path = [] then [] - else - let usek = get_prop_id path in - -let vvar = if attl = [] then "position" - else List.hd attl -in -(*let (uril,atts) = List.split rset in*) -let _ = print_string ("RELATION "^usek) -and t = Sys.time () in -let result = - let c = pgc () in - -let rset_list = (* lista di singoletti:resource_set di un elemento *) -(List.fold_left (fun acc (uri,l) -> - let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ uri ^ "'")) - in - let qq = "select uri, context from t" ^ tv ^ " where prop_id='" ^ usek ^ "' order by uri asc" - in - let res = c#exec qq in - - (List.map - (function [uri;context] -> [(uri,[[(vvar,[context])]])] - | _ -> assert false ) - res#get_list) @ acc - ) - [] rset -) -in - let rec edup = function - [] -> [] - | rs1::tl -> union_ex rs1 (edup tl) - in - edup rset_list - - -in -print_string (" = " ^ string_of_int (List.length result) ^ ": ") ; -print_endline (string_of_float (Sys.time () -. t) ^ "s") ; -flush stdout ; - result + if path = [] then [] + else + let usek = get_prop_id path in + let vvar = if attl = [] then "position" + else List.hd attl + in + let c = pgc () in + let rset_list = (* lista di singoletti:resource_set di un elemento *) + (List.fold_left (fun acc (uri,l) -> + let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ uri ^ "'")) in + let qq = "select uri, context from t" ^ tv ^ " where prop_id='" ^ usek ^ "' order by uri asc" in + let res = c#exec qq in + (List.map + (function + [uri;context] -> [(uri,[[(vvar,[context])]])] + | _ -> assert false ) + res#get_list) @ acc + ) + [] rset + ) + in + let rec edup = function + [] -> [] + | rs1::tl -> union_ex rs1 (edup tl) + in + edup rset_list ;; -