Commit 8fd6995d authored by bguillaum's avatar bguillaum

add gr output format


git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6665 7838e531-6607-4d57-9587-6c381814729c
parent 4546ba7f
......@@ -126,6 +126,32 @@ module Graph = struct
(* ---------------------------------------------------------------------------------------------------- *)
(* Output functions *)
(* ---------------------------------------------------------------------------------------------------- *)
let to_gr graph =
let buff = Buffer.create 32 in
bprintf buff "graph {\n";
(* list of the nodes *)
IntMap.iter
(fun id node ->
bprintf buff "N%d %s [%s];\n"
id
(match node.Node.pos with Some i -> sprintf "(%d)" i | None -> "")
(Feature_structure.to_gr node.Node.fs)
) graph.map;
(* list of the edges *)
IntMap.iter
(fun id node ->
Massoc.iter
(fun tar edge ->
bprintf buff "N%d -[%s]-> N%d;\n" id (Edge.to_string edge) tar
) node.Node.next
) graph.map;
bprintf buff "}\n";
Buffer.contents buff
let to_dot ?(deco=Deco.empty) graph =
let buff = Buffer.create 32 in
......
......@@ -43,6 +43,7 @@ module Graph : sig
(extention * Id.table)
val find: int -> t -> Node.t
val to_gr: t -> string
val to_dot: ?deco:Deco.t -> t -> string
val to_dep: ?main_feat:string -> ?deco:Deco.t -> t -> string
......
open Printf
open Log
open Utils
open Ast
......@@ -63,13 +64,13 @@ module Feature_structure = struct
let string_of_feature = function
| Feature.Equal (feat_name, atoms) ->
Printf.sprintf "%s=%s" feat_name
sprintf "%s=%s" feat_name
(match atoms with
| [] -> "*"
| h::t -> List.fold_right (fun atom acc -> atom^"|"^acc) t h
)
| Feature.Different (feat_name, atoms) ->
Printf.sprintf "%s<>%s" feat_name
sprintf "%s<>%s" feat_name
(match atoms with
| [] -> "EMPTY"
| h::t -> List.fold_right (fun atom acc -> atom^"|"^acc) t h
......@@ -78,6 +79,12 @@ module Feature_structure = struct
let to_string t = List_.to_string string_of_feature "\\n" t
let gr_of_feature = function
| Feature.Equal (feat_name, [one]) -> sprintf "%s=\"%s\"" feat_name one
| _ -> Log.critical "[Feature_structure.gr_of_feature] all feature in gr must be atomic value"
let to_gr t = List_.to_string gr_of_feature ", " t
let to_dep ?main_feat t =
let main = match main_feat with None -> "label" | Some mf -> mf in
......@@ -102,8 +109,8 @@ module Feature_structure = struct
)
) in
match fs with
| "" -> Printf.sprintf " word=\"%s\"; " wordform
| s -> Printf.sprintf " word=\"%s\"; subword=\"%s\"; " wordform s
| "" -> sprintf " word=\"%s\"; " wordform
| s -> sprintf " word=\"%s\"; subword=\"%s\"; " wordform s
let rec set_feat feature_name atoms = function
......
......@@ -15,6 +15,7 @@ module Feature_structure: sig
val empty: t
val to_string: t -> string
val to_gr: t -> string
val to_dep: ?main_feat: string -> t -> string
(** [set_feat feature_name atoms t] adds the feature ([feature_name],[atoms]) in [t].
......
......@@ -26,3 +26,4 @@ and big_step = {
let to_dot_graph ?(deco=Deco.empty) graph = Graph.to_dot graph ~deco
let to_dep_graph ?main_feat ?(deco=Deco.empty) graph = Graph.to_dep ?main_feat ~deco graph
let to_gr_graph graph = Graph.to_gr graph
......@@ -33,3 +33,4 @@ and big_step = {
val to_dot_graph : ?deco:deco -> graph -> string
val to_dep_graph : ?main_feat:string -> ?deco:deco -> graph -> string
val to_gr_graph: graph -> string
......@@ -17,6 +17,9 @@ module Rewrite_history = struct
bad_nf: Instance.t list;
}
let rec is_empty t =
(t.instance.Instance.rules = []) && List.for_all is_empty t.good_nf
IFDEF DEP2PICT THEN
(** [save_nfs ?main_feat base_name t] does two things:
......@@ -289,22 +292,25 @@ module Gr_stat = struct
let out_ch = open_out stat_file in
(match t with
| Error msg -> fprintf out_ch "ERROR\n%s" msg
| Stat map -> StringMap.iter (fun rule_name occ -> fprintf out_ch "%s:%d\n%!" rule_name occ) map);
| Stat map ->
StringMap.iter (fun rule_name occ -> fprintf out_ch "%s:%d\n%!" rule_name occ) map);
close_out out_ch
let load stat_file =
let lines = File.read stat_file in
match lines with
| "ERROR" :: msg_lines -> Error (List_.to_string (fun x->x) "\n" msg_lines)
| _ ->
Stat
(List.fold_left
(fun acc line ->
match Str.split (Str.regexp ":") line with
| [modu_rule; num] -> StringMap.add modu_rule (int_of_string num) acc
| _ -> Log.fcritical "invalid stat line: %s" line
) StringMap.empty lines
)
try
let lines = File.read stat_file in
match lines with
| "ERROR" :: msg_lines -> Error (List_.to_string (fun x->x) "\n" msg_lines)
| _ ->
Stat
(List.fold_left
(fun acc line ->
match Str.split (Str.regexp ":") line with
| [modu_rule; num] -> StringMap.add modu_rule (int_of_string num) acc
| _ -> Log.fcritical "invalid stat line: %s" line
) StringMap.empty lines
)
with Sys_error msg -> Error (sprintf "Sys_error: %s" msg)
end (* module Gr_stat *)
module Corpus_stat = struct
......@@ -319,18 +325,22 @@ module Corpus_stat = struct
num: int;
}
let empty grs =
let empty ~grs ~seq =
let modules = try List.assoc seq grs.Grs.sequences with Not_found -> [seq] in
let map = List.fold_left
(fun acc modul ->
let rule_map =
List.fold_left
(fun acc2 rule ->
StringMap.add (Rule.get_name rule) (0,StringSet.empty) acc2
) StringMap.empty modul.Modul.rules in
StringMap.add modul.Modul.name rule_map acc
if List.mem modul.Modul.name modules
then
let rule_map =
List.fold_left
(fun acc2 rule ->
StringMap.add (Rule.get_name rule) (0,StringSet.empty) acc2
) StringMap.empty modul.Modul.rules in
StringMap.add modul.Modul.name rule_map acc
else acc
) StringMap.empty grs.Grs.modules in
{ map = map; error = []; num = 0 }
let add modul rule file num map =
let old_rule_map = StringMap.find modul map in
let (old_num, old_file_set) = StringMap.find rule old_rule_map in
......@@ -416,7 +426,7 @@ module Corpus_stat = struct
else tmp := sprintf "%s\n %s&nbsp;&nbsp;" !tmp h
);
compute t
in compute (List.rev file_list);
in compute file_list;
if file_list = [] then tmp := "&nbsp;";
......@@ -431,10 +441,10 @@ module Corpus_stat = struct
fprintf out_ch "<td class=\"stats\">%s" !tmp;
if (!counter > 10)
then (
fprintf out_ch "</div><a style=\"cursor:pointer;\" onClick=\"if (document.getElementById('%s_%s').style.display == 'none') { %s } else { %s }\"><b><p id=\"p_%s_%s\">+ Show more +</p></b></a>\n"
fprintf out_ch "</div><a style=\"cursor:pointer;\" onClick=\"if (document.getElementById('%s_%s').style.display == 'none') { %s } else { %s }\"><b><p id=\"p_%s_%s\">+ Show all +</p></b></a>\n"
modul rule
(sprintf "document.getElementById('%s_%s').style.display = 'block'; document.getElementById('p_%s_%s').innerHTML = '- Show less -';" modul rule modul rule)
(sprintf "document.getElementById('%s_%s').style.display = 'none';; document.getElementById('p_%s_%s').innerHTML = '+ Show more +';" modul rule modul rule)
(sprintf "document.getElementById('%s_%s').style.display = 'block'; document.getElementById('p_%s_%s').innerHTML = '- Show first ten -';" modul rule modul rule)
(sprintf "document.getElementById('%s_%s').style.display = 'none';; document.getElementById('p_%s_%s').innerHTML = '+ Show all +';" modul rule modul rule)
modul rule;
);
fprintf out_ch "</td></tr>\n";
......
......@@ -12,6 +12,8 @@ module Rewrite_history: sig
bad_nf: Instance.t list;
}
val is_empty: t -> bool
IFDEF DEP2PICT THEN
val error_html: ?main_feat:string -> ?init_graph:bool -> ?header:string -> string -> string -> Instance.t option -> unit
......@@ -53,7 +55,7 @@ module Corpus_stat: sig
type t
val empty: Grs.t -> t
val empty: grs:Grs.t -> seq:string -> t
val add_gr_stat: string -> Gr_stat.t -> t -> t
......
......@@ -24,6 +24,8 @@ type grs = Grs.t
type gr = Instance.t
type rew_history = Rewrite_history.t
let is_empty = Rewrite_history.is_empty
let empty_grs = Grs.empty
let load_grs ?doc_output_dir file =
......@@ -82,6 +84,11 @@ let display ~gr ~grs ~seq =
let write_stat filename rew_hist = Gr_stat.save filename (Gr_stat.from_rew_history rew_hist)
let save_index ~dirname ~base_names =
let out_ch = open_out (Filename.concat dirname "index") in
List.iter (fun f -> fprintf out_ch "%s\n" f) base_names;
close_out out_ch
let write_html
?(no_init=false) ?main_feat
~header
......@@ -118,8 +125,8 @@ ENDIF
let make_index ~title ~grs_file ~html ~grs ~output_dir ~base_names =
let init = Corpus_stat.empty grs in
let make_index ~title ~grs_file ~html ~grs ~seq ~output_dir ~base_names =
let init = Corpus_stat.empty grs seq in
let corpus_stat =
List.fold_left
(fun acc base_name ->
......
......@@ -25,6 +25,8 @@ type rew_history
val rewrite: gr:gr -> grs:grs -> seq:string -> rew_history
val is_empty: rew_history -> bool
(** display a gr with a grs in a rew_display
@param gr the grapth to rewrite
@param grs the graph rewriting system
......@@ -53,6 +55,8 @@ val empty_gr : gr
*)
val load_gr : string -> gr
val save_index: dirname:string -> base_names: string list -> unit
val write_html:
?no_init:bool -> ?main_feat:string -> header: string -> rew_history -> string -> unit
......@@ -64,6 +68,7 @@ val make_index:
grs_file: string ->
html: bool ->
grs: grs ->
seq: string ->
output_dir: string ->
base_names: string list ->
unit
......
......@@ -455,7 +455,7 @@ module Rule = struct
(created_name,new_gid) :: created_nodes
)
| Command.SHIFT_EDGE (src_cn,tar_cn) ->
| Command.SHIFT_EDGE (src_cn,tar_cn) ->
let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in
(
......
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