Commits

Sébastien Ferré committed 66e34a3

improved ordering and naming of implicit variables in answer view

Comments (0)

Files changed (4)

       let ext_colors_copy = ext_colors # copy in
       {< place_view =
 	 begin
-	   let view = new Tarpit.incremental_view init_place in
+	   let view = new Tarpit.incremental_view self#place in
 	   view#define (fun obs place -> place#copy ~obs foc);
 	   view
 	 end;
   let item_struct = menu_create_factory#add_item "a structure (...(...))" in
   (* custom entry and completions *)
 (*  let _ = GMisc.label ~text:"Search" ?packing:(opt (fun w -> box#pack w)) () in *)
-  let entry_custom = GEdit.entry ~width_chars:30 ~packing:(box#pack ~expand:true) () in
+  let entry_custom = GEdit.entry ~width_chars:20 ~packing:(box#pack ~expand:true) () in
   let cols_completion = new GTree.column_list in
   let markup = cols_completion#add string in
   let feature = cols_completion#add string in
   let disp = Display.display_name_no_blank ~obs store n in
   object
     inherit cell
+    val n = n
     method name_opt = Some n
+    val disp = disp
     method display = disp
   end
 
 		l)] in
   object
     inherit cell
+    val disp = disp
     method display = disp
   end
 
 	false
 	n_opt
 
+let compare_name_default store n1 n2 =
+  match n1, n2 with
+  | Rdf.Literal _, Rdf.Literal _ -> Name.compare n1 n2
+  | _ -> Pervasives.compare (store#get_pagerank n2) (store#get_pagerank n1)
+
+let compare_name_opt comp opt1 opt2 =
+  match opt1, opt2 with
+  | Some n1, Some n2 -> comp n1 n2
+  | Some _, None -> -1
+  | None, Some _ -> 1
+  | None, None -> 0
+
 let compare_order store order : (Name.t option * 'a) -> (Name.t option * 'a) -> int =
   fun (n1_opt,_) (n2_opt,_) ->
-    match n1_opt, n2_opt with
-    | Some n1, Some n2 ->
-	( match order with
+    compare_name_opt
+      (fun n1 n2 ->
+	match order with
 	| `DESC -> Name.compare n2 n1
 	| `ASC -> Name.compare n1 n2
-	| `DEFAULT ->
-	    ( match n1, n2 with
-	    | Rdf.Literal _, Rdf.Literal _ -> Name.compare n1 n2
-	    | _ -> Pervasives.compare (store#get_pagerank n2) (store#get_pagerank n1) ) )
-    | Some _, None -> -1
-    | None, Some _ -> 1
-    | None, None -> 0
+	| `DEFAULT -> compare_name_default store n1 n2 )
+      n1_opt n2_opt
 
 let index col rel : int ref Intmap.t =
   Rel.fold
 	Intmap.fold
 	  (fun res o counter -> (!counter, if o=0 then None else Some (store#get_name o))::res)
 	  [] index in
-      let sorted_l_index = List.sort (fun (c1,_) (c2,_) -> Pervasives.compare c2 c1) l_index in
+      let sorted_l_index =
+	List.sort
+	  (fun (c1,n1_opt) (c2,n2_opt) ->
+	    Common.compare_pair (Pervasives.compare, compare_name_opt (compare_name_default store)) (c2,n1_opt) (c1,n2_opt))
+	  l_index in
         (* decreasing count *)
       new cell_index ~obs store sorted_l_index
   | `DISTINCT_COUNT ->
       (* removing old columns *)
       let cols = List.filter (fun v -> v = v_count || List.mem v lv) columns in
       (* adding new columns *)
-      let cols = List.filter (fun v -> not (List.mem v columns)) lv @ cols in
+      let cols = cols @ List.filter (fun v -> not (List.mem v columns)) lv in
       let rel = ext#relation (store :> Extension.store) (List.filter ((<>) v_count) cols) in
       {< columns = cols;
 	 lines = rel;
 let new_var_p1 q = get_new_var (vars_p1 q)
 
 (* TODO: should be derived from FOL *)
-let rec accessible_vars_s = function
-  | Is (np,c) ->
-      let acc, lv = accessible_vars_s1 np in
+let rec accessible_vars_s ?(lv = []) = function
+  | Is (np,f) ->
+      let acc, lv = accessible_vars_s1 ~lv np in
       if acc
-      then LSet.union lv (accessible_vars_p1 c)
-      else LSet.empty ()
-  | True -> LSet.empty ()
-  | SAnd l -> List.fold_left (fun res s -> LSet.union res (accessible_vars_s s)) (LSet.empty ()) l
-  | SOr l -> List.fold_left (fun res s -> LSet.union res (accessible_vars_s s)) (LSet.empty ()) l
-  | SNot s -> LSet.empty ()
-  | SMaybe s -> accessible_vars_s s
-and accessible_vars_s1 = function
+      then accessible_vars_p1 ~lv f
+      else lv
+  | True -> lv
+  | SAnd ls -> List.fold_left (fun lv s -> accessible_vars_s ~lv s) lv ls
+  | SOr ls -> List.fold_left (fun lv s -> accessible_vars_s ~lv s) lv ls
+  | SNot s -> lv
+  | SMaybe s -> accessible_vars_s ~lv s
+and accessible_vars_s1 ?(lv = []) = function
   | Det (det, c) ->
-      let acc, lv = accessible_vars_s2 det in
+      let acc, lv = accessible_vars_s2 ~lv det in
       if acc
-      then true, LSet.union lv (accessible_vars_p1 c)
-      else false, LSet.empty ()
-  | NAnd l -> 
+      then true, accessible_vars_p1 ~lv c
+      else false, lv
+  | NAnd l ->
       List.fold_left
 	(fun (acc,lv) np ->
-	  let acc1, lv1 = accessible_vars_s1 np in
-	  acc || acc1, LSet.union lv lv1)
-	(false, LSet.empty ()) l
+	  let acc1, lv = accessible_vars_s1 ~lv np in
+	  acc || acc1, lv)
+	(false, lv) l
   | NOr l ->
       List.fold_left
 	(fun (acc,lv) np ->
-	  let acc1, lv1 = accessible_vars_s1 np in
-	  acc || acc1, LSet.union lv lv1)
-	(false, LSet.empty ()) l
-  | NNot np -> false, LSet.empty ()
-  | NMaybe np -> accessible_vars_s1 np
-and accessible_vars_s2 = function
-  | Name _ -> true, LSet.empty ()
-  | Quote _ -> true, LSet.empty ()
-  | Ref v -> true, LSet.empty ()
-  | Qu (An, v_opt) -> true, Option.fold (fun v -> LSet.singleton v) (LSet.empty ()) v_opt
-  | Qu ((The | Every | Only), _) -> false, LSet.empty ()
-and accessible_vars_p1 = function
-  | Type _ -> LSet.empty ()
+	  let acc1, lv1 = accessible_vars_s1 ~lv np in
+	  acc || acc1, lv)
+	(false, lv) l
+  | NNot np -> false, lv
+  | NMaybe np -> accessible_vars_s1 ~lv np
+and accessible_vars_s2 ?(lv = []) = function
+  | Name _ -> true, lv
+  | Quote _ -> true, lv
+  | Ref v -> true, lv
+  | Qu (An, v_opt) -> true, Option.fold (fun v -> v::lv) lv v_opt
+  | Qu ((The | Every | Only), _) -> false, lv
+and accessible_vars_p1 ?(lv = []) = function
+  | Type _ -> lv
   | Role (_, np) ->
-      let acc, lv = accessible_vars_s1 np in
-      lv (* if acc is false, then lv = [] *)
+      let acc, lv = accessible_vars_s1 ~lv np in
+      lv (* if acc is false, then lv is unchanged *)
   | Struct (_,args) ->
       Array.fold_right
-	(fun np res ->
-	  let acc, lv = accessible_vars_s1 np in
-	  if acc
-	  then LSet.union lv res
-	  else LSet.empty ())
-	args (LSet.empty ())
+	(fun np lv' ->
+	  let acc, lv' = accessible_vars_s1 ~lv:lv' np in
+	  if acc then lv' else lv)
+	args lv
   | Arg (_,_,args,np) ->
-      let acc, lv = accessible_vars_s1 np in
+      let acc, lv' = accessible_vars_s1 ~lv np in
       if acc
       then
-	LSet.union lv
-	  (Array.fold_right
-	     (fun np res ->
-	       let acc, lv = accessible_vars_s1 np in
-	       if acc
-	       then LSet.union lv res
-	       else LSet.empty ())
-	     args (LSet.empty ()))
-      else LSet.empty ()
+	Array.fold_right
+	  (fun np lv'' ->
+	    let acc, lv'' = accessible_vars_s1 ~lv:lv'' np in
+	    if acc then lv'' else lv')
+	  args lv'
+      else lv
   | Pred (_,_,l) ->
       List.fold_right
-	(fun (_,np) res ->
-	  let acc, lv = accessible_vars_s1 np in
-	  if acc
-	  then LSet.union lv res
-	  else LSet.empty ())
-	l (LSet.empty ())
-  | SuchThat (x,s) -> accessible_vars_s s
-  | Thing -> LSet.empty ()
-  | And l -> List.fold_left (fun res f -> LSet.union res (accessible_vars_p1 f)) (LSet.empty ()) l
-  | Or l -> List.fold_left (fun res f -> LSet.union res (accessible_vars_p1 f)) (LSet.empty ()) l
-  | Not f -> LSet.empty ()
-  | Maybe f -> accessible_vars_p1 f
+	(fun (_,np) lv' ->
+	  let acc, lv' = accessible_vars_s1 ~lv:lv' np in
+	  if acc then lv' else lv)
+	l lv
+  | SuchThat (x,s) -> accessible_vars_s ~lv s
+  | Thing -> lv
+  | And l -> List.fold_left (fun lv f -> accessible_vars_p1 ~lv f) lv l
+  | Or l -> List.fold_left (fun lv f -> accessible_vars_p1 ~lv f) lv l
+  | Not f -> lv
+  | Maybe f -> accessible_vars_p1 ~lv f
 
 
 let rec subst_s env = function

src/lisql_concept.ml

       let w, np' = intent_np ~obs store gv (intent_var_prefix_p1 ~obs store f) np in
       w, intent_s ~obs store gv (Is (np', f)) k'
   | Det1 (det,_,k') ->
-      let prefix = intent_var_prefix_p1 ~obs store f in
-      let prefix = if prefix <> "" then prefix else intent_var_prefix_context_s1 ~obs store k' in
+      let prefix = intent_var_prefix_context_s1 ~obs store k' in
+      let prefix = if prefix <> (0,"") then prefix else intent_var_prefix_p1 ~obs store f in
       let w, det' = intent_det ~obs store gv prefix det in
       w, intent_s1 ~obs store gv (Det (det', f)) k'
   | AndN (n,l,k') ->
   | Maybe0 (_,k') -> intent_p1 ~obs store gv f k'
 and intent_p2 ~obs store gv (r : p2) : context_p2 -> Name.t window * Name.t window * s = function
   | Role0 (_,np,k') ->
-      let w2, np' = intent_np ~obs store gv (intent_var_prefix_p2 ~obs store r) np in
+      let w2, np' = intent_np ~obs store gv (intent_var_prefix_p2 ~obs store (reverse_p2 r)) np in
       let w1, s = intent_p1 ~obs store gv (Role (r, np')) k' in
       w1, w2, s (* note: may not be valid with focus inside Compose *)
   | Opt0 (_,k') -> intent_p2 ~obs store gv r k'
 and intent_np ~obs store gv prefix0 : s1 -> Name.t window * s1 = function
   | Det (det,f) ->
       let prefix = intent_var_prefix_p1 ~obs store f in
-      let prefix = if prefix = "" then prefix0 else prefix in
+      let prefix = if prefix <> (0,"") then prefix else prefix0 in
       let w, det' = intent_det ~obs store gv prefix det in
       w, Det (det', f)
   | NAnd lnp ->
-      let lw, lnp' = List.split (List.map (intent_np ~obs store gv "") lnp) in
+      let lw, lnp' = List.split (List.map (intent_np ~obs store gv (0,"")) lnp) in
       `NAnd lw, NAnd lnp'
   | NOr lnp ->
-      let lw, lnp' = List.split (List.map (intent_np ~obs store gv "") lnp) in
+      let lw, lnp' = List.split (List.map (intent_np ~obs store gv (0,"")) lnp) in
       `NOr lw, NOr lnp'
-  | NNot np1 -> intent_np ~obs store gv "" np1
-  | NMaybe np1 -> intent_np ~obs store gv "" np1
+  | NNot np1 -> intent_np ~obs store gv (0,"") np1
+  | NMaybe np1 -> intent_np ~obs store gv (0,"") np1
 and intent_det ~obs store gv prefix : s2 -> Name.t window * s2 = function
   | Name n -> `Const n, Name n
   | Quote _ -> assert false
   | Ref v -> `Ref v, Ref v
   | Qu (_,v_opt) ->
-      let v = match v_opt with None -> gv#get_prefix prefix | Some v -> v in
+      let v = match v_opt with None -> gv#get_prefix (snd prefix) | Some v -> v in
       `Ref v, Qu (An, Some v)
 and intent_var_prefix_p1 ~obs store = function
-  | Type c -> Display.string_of_uri ~obs store c
-  | Role (RAtom (Bwd,p),_) -> Display.string_of_uri ~obs store p
-  | Struct (funct,_) -> Display.string_of_uri ~obs store funct
-  | And l ->
-      (try intent_var_prefix_p1 ~obs store (List.find (function Type _ -> true | _ -> false) l)
-      with _ -> "")
-  | _ -> ""
+  | Type c -> 2, Display.string_of_uri ~obs store c
+  | Role (r,_) -> intent_var_prefix_p2 ~obs store r
+  | Struct (funct,_) -> 4, Display.string_of_uri ~obs store funct
+  | And l -> List.fold_left (fun prefix f -> max prefix (intent_var_prefix_p1 ~obs store f)) (0,"") l
+  | _ -> 0, ""
+and intent_var_prefix_p2 ~obs store = function (* TODO: incomplete *)
+  | RAtom (ori,p) ->
+      let s = Display.string_of_uri ~obs store p in
+      (match ori with Fwd -> 1, "is " ^ s ^ " of" | Bwd -> 3, s)
+  | Opt r -> intent_var_prefix_p2 ~obs store r
+  | Trans r -> intent_var_prefix_p2 ~obs store r
+  | Direct r -> intent_var_prefix_p2 ~obs store r
+  | _ -> 0, ""
 and intent_var_prefix_context_s1 ~obs store = function
-  | Role1 (RAtom (Fwd,p),_,_) -> Display.string_of_uri ~obs store p
+  | Role1 (r,_,_) -> intent_var_prefix_p2 ~obs store (reverse_p2 r)
   | NAndN (_,_,k) -> intent_var_prefix_context_s1 ~obs store k
   | NOrN (_,_,k) -> intent_var_prefix_context_s1 ~obs store k
   | NNot0 (_,k) -> intent_var_prefix_context_s1 ~obs store k
   | NMaybe0 (_,k) -> intent_var_prefix_context_s1 ~obs store k
-  | _ -> ""
-and intent_var_prefix_p2 ~obs store = function
-  | RAtom (Fwd,p) -> Display.string_of_uri ~obs store p
-  | RAnd l ->
-      (try intent_var_prefix_p2 ~obs store (List.find (function RAtom (Fwd,_) -> true | _ -> false) l)
-      with _ -> "")
-  | _ -> ""
+  | _ -> 0, ""
 
 (*
 let rec descr_s1 : context_s1 -> p1 = function