Commit d729d44e authored by bguillaum's avatar bguillaum

simplification of annotation code

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8138 7838e531-6607-4d57-9587-6c381814729c
parent d0632382
......@@ -167,9 +167,9 @@ module G_fs = struct
let get_atom = List_.sort_assoc
let get_annot_info fs =
match List.filter (fun (fn,value) -> String.length fn > 1 && String.sub fn 0 2 = "__") fs with
match List.filter (fun (fn,_) -> String.length fn > 1 && String.sub fn 0 2 = "__") fs with
| [] -> None
| [(fn,value)] -> Some (fn,conll_string_of_value value)
| [(fn,_)] -> Some (String.sub fn 2 ((String.length fn) - 2))
| _ -> Error.build "[Fs.get_annot_info] More than one annot feature in the same feature structure"
let get_string_atom feat_name t =
......
......@@ -46,9 +46,9 @@ module G_fs: sig
val to_conll: ?exclude: string list -> t -> string
(** [get_annot_info fs] searches for a feature with name starting with "__".
It returns the feature_name and the string representation of its feature value.
It returns the feature_name without the prefix "__"
raise an [Build] exception if there is more than one such feature. *)
val get_annot_info: t -> (string * string) option
val get_annot_info: t -> string option
val to_string: t -> string
......
......@@ -245,7 +245,7 @@ module G_graph = struct
(fun _ node acc ->
match (G_node.get_annot_info node, acc) with
| (None,_) -> acc
| (Some (f,v), None) -> Some (f,v,G_node.get_position node)
| (Some f, None) -> Some (f,G_node.get_position node)
| (Some _, Some _) -> Error.build "[G_node.get_annot_info] Two nodes with annot info"
) graph.map None in
match annot_info with
......
......@@ -98,7 +98,11 @@ module G_graph: sig
(** [edge_out t id edge] returns true iff there is an out-edge from the node [id] with a label compatible with [edge] *)
val edge_out: t -> Gid.t -> P_edge.t -> bool
val get_annot_info: t -> (string * string * float)
(** [get_annot_info graph] searches for exactly one node with an annot-feature (with name starting with "__").
It returns the annot-feature name without the prefix "__" together with the position.
raise an [Build] exception if there is not exactly one annot-feature (with name starting with "__") *)
val get_annot_info: t -> (string * float)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* Build functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
......
......@@ -88,9 +88,9 @@ module Rewrite_history = struct
let b = sprintf "%s_%d_B" base_name i in
let hpa = Instance.save_dep_svg (Filename.concat out_dir a) alt_1.instance in
let hpb = Instance.save_dep_svg (Filename.concat out_dir b) alt_2.instance in
let (afn,afv,apos) = G_graph.get_annot_info alt_1.instance.Instance.graph
and (bfn,bfv,bpos) = G_graph.get_annot_info alt_2.instance.Instance.graph in
(base_name,i,(afn,afv,apos),(bfn,bfv,bpos),(hpa,hpb))
let (afn,apos) = G_graph.get_annot_info alt_1.instance.Instance.graph
and (bfn,bpos) = G_graph.get_annot_info alt_2.instance.Instance.graph in
(base_name,i,(afn,apos),(bfn,bpos),(hpa,hpb))
| _ -> Error.run "Not two alternatives in an annotation rewriting in %s" base_name
) t.good_nf
......
......@@ -38,7 +38,7 @@ module Rewrite_history: sig
((string * string list) list * string) list
(** [save_annot out_dir base_name t] writes a set of svg_file for an annotation folder. *)
val save_annot: string -> string -> t -> (string * int * (string*string*float) * (string*string*float) * (float option * float option)) list
val save_annot: string -> string -> t -> (string * int * (string*float) * (string*float) * (float option * float option)) list
(** [save_gr base_name t] saves one gr_file for each normal form defined in [t].
Output files are named according to [base_name] and the Gorn adress in the rewriting tree. *)
......
......@@ -1017,7 +1017,7 @@ module Html_annot = struct
sprintf "<script type=\"text/JavaScript\" src=\"%s\"></script>" (Filename.concat static_dir "annot.js")
]
let build static_dir annot_dir bn_rh_list =
let build ~title static_dir annot_dir bn_rh_list =
let alt_list = List_.flat_map
(fun (base_name, rew_hist) ->
List.mapi
......@@ -1030,7 +1030,7 @@ module Html_annot = struct
let len = List.length alt_list in
let cpt = ref 0 in
List_.prev_next_iter
(fun ?prev ?next (base_name,(sentid,i,(afn,afv,apos),(bfn,bfv,bpos),(hpa,hpb))) ->
(fun ?prev ?next (base_name,(sentid,i,(afn,apos),(bfn,bpos),(hpa,hpb))) ->
incr cpt;
let init_pos = match (hpa,hpb) with
| (Some p, Some q) -> max 0. ((min p q) -. 500.)
......@@ -1064,7 +1064,7 @@ module Html_annot = struct
wnl "<td><form action=\"index.php\"><input type=\"submit\" value=\"Index\"></form></td>";
wnl "<td>";
wnl "<form action=\"%s\" method=\"post\">" next_php;
wnl "<input type=\"hidden\" name=\"to_log\" value=\"%s#%s#%s#%g\" />" sentid afn afv apos;
wnl "<input type=\"hidden\" name=\"to_log\" value=\"%s#%g#%s\" />" sentid apos afn;
wnl "<input type=\"hidden\" name=\"hit_id\" value=\"%s_%d\" />" sentid i;
wnl "<input type=\"hidden\" name=\"choice\" value=\"U\" />";
wnl "<input type=\"submit\" value=\"Choose Up\" >";
......@@ -1080,7 +1080,7 @@ module Html_annot = struct
);
wnl "<td>";
wnl "<form action=\"%s\" method=\"post\">" next_php;
wnl "<input type=\"hidden\" name=\"to_log\" value=\"No_choice\" />";
wnl "<input type=\"hidden\" name=\"to_log\" value=\"%s#%g#No_choice\" />" sentid bpos;
wnl "<input type=\"hidden\" name=\"hit_id\" value=\"%s_%d\" />" sentid i;
wnl "<input type=\"hidden\" name=\"choice\" value=\"N\" />";
wnl "<input type=\"submit\" value=\"Don't choose\" >";
......@@ -1096,7 +1096,7 @@ module Html_annot = struct
wnl "<td/>"; (* empty lower left *)
wnl "<td>";
wnl "<form action=\"%s\" method=\"post\">" next_php;
wnl "<input type=\"hidden\" name=\"to_log\" value=\"%s#%s#%s#%g\" />" sentid bfn bfv bpos;
wnl "<input type=\"hidden\" name=\"to_log\" value=\"%s#%g#%s\" />" sentid bpos bfn;
wnl "<input type=\"hidden\" name=\"hit_id\" value=\"%s_%d\" />" sentid i;
wnl "<input type=\"hidden\" name=\"choice\" value=\"D\" />";
wnl "<input type=\"submit\" value=\"Choose Down\" >";
......@@ -1115,7 +1115,6 @@ module Html_annot = struct
close_out out_ch
) alt_list;
printf "--------------> annot_dir=%s\n" annot_dir;
let out_ch = open_out (Filename.concat annot_dir "status.db") in
fprintf out_ch "%s" (Buffer.contents db_buff);
close_out out_ch;
......@@ -1123,7 +1122,6 @@ module Html_annot = struct
(* creation of the file index.php *)
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Annotation task: TODO" in
wnl "<?php require '%s'; ?>" (Filename.concat static_dir "record_choice.php");
wnl "<?php require '%s'; ?>" (Filename.concat static_dir "annot_utils.php");
......
......@@ -73,5 +73,5 @@ module Corpus_stat: sig
end
module Html_annot: sig
val build: string -> string -> (string * Rewrite_history.t) list -> unit
val build: title:string -> string -> string -> (string * Rewrite_history.t) list -> unit
end
......@@ -47,7 +47,10 @@ module G_node: sig
val position_comp: t -> t -> int
val get_annot_info: t -> (string * string) option
(** [get_annot_info node] searches for a feature with name starting with "__".
It returns the feature_name without the prefix "__"
raise an [Build] exception if there is more than one such feature. *)
val get_annot_info: t -> string option
val build_neighbour: t -> t
......
......@@ -160,8 +160,8 @@ let display ~gr ~grs ~seq =
let write_stat filename rew_hist =
handle ~name:"write_stat" (fun () -> Gr_stat.save filename (Gr_stat.from_rew_history rew_hist)) ()
let write_annot static_dir annot_dir base_name_rew_hist_list =
handle ~name:"write_annot" (fun () -> Html_annot.build static_dir annot_dir base_name_rew_hist_list) ()
let write_annot ~title static_dir annot_dir base_name_rew_hist_list =
handle ~name:"write_annot" (fun () -> Html_annot.build ~title static_dir annot_dir base_name_rew_hist_list) ()
let save_index ~dirname ~base_names =
handle ~name:"save_index" (fun () ->
......
......@@ -100,7 +100,7 @@ val raw_graph: Instance.t ->
val save_index: dirname:string -> base_names: string list -> unit
val write_annot: string -> string -> (string * Rewrite_history.t) list -> unit
val write_annot: title:string -> string -> string -> (string * Rewrite_history.t) list -> unit
val write_html:
?no_init: bool ->
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment