grew_graph.ml 42.2 KB
Newer Older
bguillaum's avatar
bguillaum committed
1 2 3 4 5 6 7 8 9 10
(**********************************************************************************)
(*    Libcaml-grew - a Graph Rewriting library dedicated to NLP applications      *)
(*                                                                                *)
(*    Copyright 2011-2013 Inria, Université de Lorraine                           *)
(*                                                                                *)
(*    Webpage: http://grew.loria.fr                                               *)
(*    License: CeCILL (see LICENSE folder or "http://www.cecill.info")            *)
(*    Authors: see AUTHORS file                                                   *)
(**********************************************************************************)

pj2m's avatar
pj2m committed
11 12
open Printf
open Log
13
open Conll
pj2m's avatar
pj2m committed
14

15
open Grew_base
bguillaum's avatar
bguillaum committed
16
open Grew_ast
17 18
open Grew_types

pj2m's avatar
pj2m committed
19
open Grew_edge
20
open Grew_domain
pj2m's avatar
pj2m committed
21 22 23
open Grew_fs
open Grew_node

bguillaum's avatar
bguillaum committed
24
(* ================================================================================ *)
25
module P_deco = struct
bguillaum's avatar
bguillaum committed
26 27 28 29
  type t = {
    nodes: Pid.t list;
    edges: (Pid.t * P_edge.t * Pid.t) list;
  }
pj2m's avatar
pj2m committed
30 31

  let empty = {nodes=[]; edges=[]}
bguillaum's avatar
bguillaum committed
32
end (* module P_deco *)
pj2m's avatar
pj2m committed
33

bguillaum's avatar
bguillaum committed
34
(* ================================================================================ *)
35 36
module P_graph = struct
  type t = P_node.t Pid_map.t
pj2m's avatar
pj2m committed
37

38
  let empty = Pid_map.empty
39

40
  let find = Pid_map.find
pj2m's avatar
pj2m committed
41

42
  let pid_name_list t = Pid_map.fold (fun _ node acc -> (P_node.get_name node)::acc) t []
43

44 45 46 47 48 49 50 51 52 53 54
  let to_json ?domain t =
    `List (
      Pid_map.fold
        (fun pid p_node acc ->
          (`Assoc [
            ("id", `String (Pid.to_string pid));
            ("node", P_node.to_json ?domain p_node)
          ]) :: acc
        ) t []
      )

55
  (* -------------------------------------------------------------------------------- *)
pj2m's avatar
pj2m committed
56
  let map_add_edge map id_src label id_tar =
57
    let node_src =
pj2m's avatar
pj2m committed
58
      (* Not found can be raised when adding an edge from pos to neg *)
59 60
      try Pid_map.find id_src map with Not_found -> P_node.empty in
    match P_node.add_edge label id_tar node_src with
bguillaum's avatar
bguillaum committed
61 62
      | None -> None
      | Some new_node -> Some (Pid_map.add id_src new_node map)
pj2m's avatar
pj2m committed
63

bguillaum's avatar
bguillaum committed
64
  (* -------------------------------------------------------------------------------- *)
bguillaum's avatar
bguillaum committed
65
  let build_filter ?domain table (ast_node, loc) =
66
    let pid = Id.build ~loc ast_node.Ast.node_id table in
bguillaum's avatar
bguillaum committed
67
    let fs = P_fs.build ?domain ast_node.Ast.fs in
68 69
    (pid, fs)

bguillaum's avatar
bguillaum committed
70
  (* -------------------------------------------------------------------------------- *)
Bruno Guillaume's avatar
Bruno Guillaume committed
71
  let build ?domain ?pat_vars (full_node_list : Ast.node list) full_edge_list =
bguillaum's avatar
bguillaum committed
72

73
    (* NB: insert searches for a previous node with the Same name and uses unification rather than constraint *)
74
    (* NB: insertion of new node at the end of the list: not efficient but graph building is not the hard part. *)
bguillaum's avatar
bguillaum committed
75
    let rec insert (ast_node, loc) = function
bguillaum's avatar
bguillaum committed
76
      | [] -> [P_node.build ?domain ?pat_vars (ast_node, loc)]
77
      | (node_id,fs)::tail when ast_node.Ast.node_id = node_id ->
bguillaum's avatar
bguillaum committed
78
        begin
bguillaum's avatar
bguillaum committed
79
          try (node_id, P_node.unif_fs (P_fs.build ?domain ?pat_vars ast_node.Ast.fs) fs) :: tail
bguillaum's avatar
bguillaum committed
80 81
          with Error.Build (msg,_) -> raise (Error.Build (msg,Some loc))
        end
82
      | head :: tail -> head :: (insert (ast_node, loc) tail) in
bguillaum's avatar
bguillaum committed
83

84
    let (named_nodes : (Id.name * P_node.t) list) =
85
      List.fold_left
86 87
        (fun acc ast_node -> insert ast_node acc)
        [] full_node_list in
88

pj2m's avatar
pj2m committed
89 90 91
    let sorted_nodes = List.sort (fun (id1,_) (id2,_) -> Pervasives.compare id1 id2) named_nodes in
    let (sorted_ids, node_list) = List.split sorted_nodes in

92 93
    (* [pos_table] contains the sorted list of node ids *)
    let pos_table = Array.of_list sorted_ids in
94 95

    (* the nodes, in the same order *)
bguillaum's avatar
bguillaum committed
96 97
    let map_without_edges = List_.foldi_left
      (fun i acc elt -> Pid_map.add (Pid.Pos i) elt acc)
bguillaum's avatar
bguillaum committed
98
      Pid_map.empty node_list in
99

bguillaum's avatar
bguillaum committed
100
    let (map : t) =
pj2m's avatar
pj2m committed
101
      List.fold_left
bguillaum's avatar
bguillaum committed
102 103 104
        (fun acc (ast_edge, loc) ->
          let i1 = Id.build ~loc ast_edge.Ast.src pos_table in
          let i2 = Id.build ~loc ast_edge.Ast.tar pos_table in
bguillaum's avatar
bguillaum committed
105
          let edge = P_edge.build ?domain (ast_edge, loc) in
bguillaum's avatar
bguillaum committed
106 107 108
          (match map_add_edge acc (Pid.Pos i1) edge (Pid.Pos i2) with
            | Some g -> g
            | None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s"
bguillaum's avatar
bguillaum committed
109
              (P_edge.to_string ?domain edge)
bguillaum's avatar
bguillaum committed
110
              (Loc.to_string loc)
bguillaum's avatar
bguillaum committed
111 112
          )
        ) map_without_edges full_edge_list in
113
    (map, pos_table)
bguillaum's avatar
bguillaum committed
114

115

bguillaum's avatar
bguillaum committed
116
  (* -------------------------------------------------------------------------------- *)
bguillaum's avatar
bguillaum committed
117 118
  (* a type for extension of graph (a former graph exists):
     in grew the former is a positive basic and an extension is a negative basic ("without") *)
119
  type extension = {
bguillaum's avatar
bguillaum committed
120 121 122
    ext_map: P_node.t Pid_map.t; (* node description for new nodes and for edge "Old -> New"  *)
    old_map: P_node.t Pid_map.t; (* a partial map for new constraints on old nodes "Old [...]" *)
  }
123

bguillaum's avatar
bguillaum committed
124
  (* -------------------------------------------------------------------------------- *)
bguillaum's avatar
bguillaum committed
125
  (* It may raise [P_fs.Fail_unif] in case of contradiction on constraints *)
Bruno Guillaume's avatar
Bruno Guillaume committed
126
  let build_extension ?domain ?pat_vars pos_table full_node_list full_edge_list =
pj2m's avatar
pj2m committed
127

bguillaum's avatar
bguillaum committed
128
    let built_nodes = List.map (P_node.build ?domain ?pat_vars) full_node_list in
pj2m's avatar
pj2m committed
129

130 131
    let (old_nodes, new_nodes) =
      List.partition
132
        (function (id,_) when Array_.dicho_mem id pos_table -> true | _ -> false)
133
        built_nodes in
bguillaum's avatar
bguillaum committed
134

pj2m's avatar
pj2m committed
135 136 137 138 139 140
    let new_sorted_nodes = List.sort (fun (id1,_) (id2,_) -> Pervasives.compare id1 id2) new_nodes in

    let (new_sorted_ids, new_node_list) = List.split new_sorted_nodes in

    (* table contains the sorted list of node ids *)
    let new_table = Array.of_list new_sorted_ids in
141 142 143 144

    (* the nodes, in the same order stored with index -1, -2, ... -N *)
    let ext_map_without_edges =
      List_.foldi_left
bguillaum's avatar
bguillaum committed
145 146 147
        (fun i acc elt -> Pid_map.add (Pid.Neg i) elt acc)
        Pid_map.empty
        new_node_list in
148 149 150

    let old_map_without_edges =
      List.fold_left
bguillaum's avatar
bguillaum committed
151 152 153 154 155 156 157
        (fun acc (id,node) ->
          let pid_pos = Pid.Pos (Array_.dicho_find id pos_table) in
          try
            let old = Pid_map.find pid_pos acc in
            Pid_map.add pid_pos (P_node.unif_fs (P_node.get_fs node) old) acc
          with Not_found -> Pid_map.add pid_pos node acc
        ) Pid_map.empty old_nodes in
pj2m's avatar
pj2m committed
158

159
    let ext_map_with_all_edges =
pj2m's avatar
pj2m committed
160
      List.fold_left
bguillaum's avatar
bguillaum committed
161
        (fun acc (ast_edge, loc) ->
162 163
          let src = ast_edge.Ast.src
          and tar = ast_edge.Ast.tar in
bguillaum's avatar
bguillaum committed
164 165
          let i1 =
            match Id.build_opt src pos_table with
bguillaum's avatar
bguillaum committed
166
              | Some i -> Pid.Pos i
167
              | None -> Pid.Neg (Id.build ~loc src new_table) in
bguillaum's avatar
bguillaum committed
168 169
          let i2 =
            match Id.build_opt tar pos_table with
bguillaum's avatar
bguillaum committed
170
              | Some i -> Pid.Pos i
171
              | None -> Pid.Neg (Id.build ~loc tar new_table) in
bguillaum's avatar
bguillaum committed
172
          let edge = P_edge.build ?domain (ast_edge, loc) in
bguillaum's avatar
bguillaum committed
173 174
          match map_add_edge acc i1 edge i2 with
            | Some map -> map
bguillaum's avatar
bguillaum committed
175
            | None -> Log.fbug "[GRS] [Graph.build_extension] add_edge cannot fail in pattern extension"; exit 2
bguillaum's avatar
bguillaum committed
176
        ) ext_map_without_edges full_edge_list in
pj2m's avatar
pj2m committed
177 178
    ({ext_map = ext_map_with_all_edges; old_map = old_map_without_edges}, new_table)

179
  (* -------------------------------------------------------------------------------- *)
pj2m's avatar
pj2m committed
180 181 182 183 184 185
  (* [tree_and_roots t] returns:
     - a boolean which is true iff the each node has at most one in-edge
     - the list of "roots" (i.e. nodes without in-edge *)
  let tree_and_roots graph =
    let tree_prop = ref true in
    let not_root =
186
      Pid_map.fold
bguillaum's avatar
bguillaum committed
187 188 189 190 191 192 193 194 195 196 197
        (fun _ node acc ->
          Massoc_pid.fold
            (fun acc2 tar _ ->
              if !tree_prop
              then
                if Pid_set.mem tar acc2
                then (tree_prop := false; acc2)
                else Pid_set.add tar acc2
              else Pid_set.add tar acc2
            ) acc (P_node.get_next node)
        ) graph Pid_set.empty in
pj2m's avatar
pj2m committed
198 199

    let roots =
200
      Pid_map.fold
bguillaum's avatar
bguillaum committed
201 202 203 204 205
        (fun id _ acc ->
          if Pid_set.mem id not_root
          then acc
          else id::acc
        ) graph [] in
206

pj2m's avatar
pj2m committed
207 208
    (!tree_prop, roots)

209
  (* -------------------------------------------------------------------------------- *)
pj2m's avatar
pj2m committed
210
  let roots graph = snd (tree_and_roots graph)
211
end (* module P_graph *)
pj2m's avatar
pj2m committed
212

bguillaum's avatar
bguillaum committed
213
(* ================================================================================ *)
214 215
module G_deco = struct
  type t = {
216 217
    nodes: (Gid.t * (string * string list)) list;  (* a list of (node, (pattern_id, features of nodes implied in the step)) *)
    edges: (Gid.t * G_edge.t * Gid.t) list;        (* an edge list *)
218 219 220 221
  }

  let empty = {nodes=[]; edges=[]}
end (* module G_deco *)
222

bguillaum's avatar
bguillaum committed
223
(* ================================================================================ *)
224
module G_graph = struct
225 226 227 228 229 230 231
  type fusion_item = {
    first: Gid.t;
    last: Gid.t;
    word: string;
    efs: (string * string) list;
  }

232
  type t = {
233
    domain: Domain.t option;
234 235 236 237
    meta: string list;            (* meta-informations *)
    map: G_node.t Gid_map.t;      (* node description *)
    fusion: fusion_item list;     (* the list of fusion word considered in UD conll *)
    highest_index: int;           (* the next free integer index *)
238 239
  }

240
  let empty = { domain=None; meta=[]; map=Gid_map.empty; fusion=[]; highest_index=0; }
241

242
  let get_domain t = t.domain
243

bguillaum's avatar
bguillaum committed
244
  let get_highest g = g.highest_index
245 246 247 248

  let find node_id graph = Gid_map.find node_id graph.map

  let equals t t' = Gid_map.equal (fun node1 node2 -> node1 = node2) t.map t'.map
249

bguillaum's avatar
bguillaum committed
250
  let node_exists fct t = Gid_map.exists (fun _ node -> fct node) t.map
251

252 253
  let fold_gid fct t init =
    Gid_map.fold (fun gid _ acc -> fct gid acc) t.map init
254

bguillaum's avatar
bguillaum committed
255
  (* is there an edge e out of node i ? *)
256 257
  let edge_out graph node_id label_cst =
    let domain = get_domain graph in
258
    let node = Gid_map.find node_id graph.map in
bguillaum's avatar
bguillaum committed
259
    Massoc_gid.exists (fun _ e -> Label_cst.match_ ?domain label_cst e) (G_node.get_next node)
260

bguillaum's avatar
bguillaum committed
261
  (* -------------------------------------------------------------------------------- *)
262
  let map_add_edge_opt map id_src label id_tar =
263
    let node_src =
264
      (* Not found can be raised when adding an edge from pos to neg *)
265
      try Gid_map.find id_src map with Not_found -> G_node.empty in
266
    match G_node.add_edge label id_tar node_src with
bguillaum's avatar
bguillaum committed
267 268
      | None -> None
      | Some new_node -> Some (Gid_map.add id_src new_node map)
269

270 271 272 273 274 275 276
  (* -------------------------------------------------------------------------------- *)
  let map_add_edge map id_src label id_tar =
    let node_src = Gid_map.find id_src map in
    match G_node.add_edge label id_tar node_src with
      | Some new_node -> Gid_map.add id_src new_node map
      | None -> Log.fbug "[Graph.map_add_edge] duplicate"; exit 2

277
  (* -------------------------------------------------------------------------------- *)
278
  let add_edge graph id_src label id_tar =
279
    match map_add_edge_opt graph.map id_src label id_tar with
280 281
      | Some new_map -> Some {graph with map = new_map }
      | None -> None
282

bguillaum's avatar
bguillaum committed
283
  (* -------------------------------------------------------------------------------- *)
Bruno Guillaume's avatar
Bruno Guillaume committed
284
  let build ?domain ?(grewpy=false) gr_ast =
285 286 287 288
    let full_node_list =
      if grewpy
      then List.sort (Ast.grewpy_compare) gr_ast.Ast.nodes
      else gr_ast.Ast.nodes
289
    and full_edge_list = gr_ast.Ast.edges in
290

291

bguillaum's avatar
bguillaum committed
292 293
    let rec loop already_bound index prec = function
      | [] -> (Gid_map.empty,[])
294

bguillaum's avatar
bguillaum committed
295 296 297 298 299
      | (ast_node, loc)::tail ->
        let node_id = ast_node.Ast.node_id in
        if List.mem node_id already_bound
        then Error.build ~loc "[GRS] [Graph.build] try to build a graph with twice the same node id '%s'" node_id
        else
300 301
          let (new_tail, table) = loop (node_id :: already_bound) (index+1) (Some index) tail in
          let succ = if tail = [] then None else Some (index+1) in
302
          let new_node = G_node.build ?domain ?prec ?succ ~position:(float index) (ast_node, loc) in
bguillaum's avatar
bguillaum committed
303
            (
304
              Gid_map.add index new_node new_tail,
bguillaum's avatar
bguillaum committed
305 306
              (node_id,index)::table
            ) in
307

bguillaum's avatar
bguillaum committed
308
    let (map_without_edges, table) = loop [] 0 None full_node_list in
309

310 311
    let map =
      List.fold_left
bguillaum's avatar
bguillaum committed
312
        (fun acc (ast_edge, loc) ->
bguillaum's avatar
bguillaum committed
313 314
          let i1 = List.assoc ast_edge.Ast.src table in
          let i2 = List.assoc ast_edge.Ast.tar table in
bguillaum's avatar
bguillaum committed
315
          let edge = G_edge.build ?domain (ast_edge, loc) in
316
          (match map_add_edge_opt acc i1 edge i2 with
bguillaum's avatar
bguillaum committed
317 318
            | Some g -> g
            | None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s"
bguillaum's avatar
bguillaum committed
319
              (G_edge.to_string ?domain edge)
bguillaum's avatar
bguillaum committed
320
              (Loc.to_string loc)
bguillaum's avatar
bguillaum committed
321 322
          )
        ) map_without_edges full_edge_list in
323

324 325 326 327 328 329 330
    {
      domain;
      meta=gr_ast.Ast.meta;
      map;
      fusion = [];
      highest_index = (List.length full_node_list) -1
    }
331

bguillaum's avatar
bguillaum committed
332
  (* -------------------------------------------------------------------------------- *)
bguillaum's avatar
bguillaum committed
333
  let of_conll ?domain conll =
334

335
    let sorted_lines = Conll.root :: (List.sort Conll.compare conll.Conll.lines) in
bguillaum's avatar
bguillaum committed
336

337
    let gtable = (Array.of_list (List.map (fun line -> line.Conll.id) sorted_lines), Conll.Id.to_dot) in
338

339 340 341 342
    let rec loop index prec = function
      | [] -> Gid_map.empty
      | [last] ->
        let loc = Loc.file_opt_line conll.Conll.file last.Conll.line_num in
bguillaum's avatar
bguillaum committed
343
        Gid_map.add index (G_node.of_conll ?domain ~loc ?prec last) Gid_map.empty
344 345
      | line::tail ->
        let loc = Loc.file_opt_line conll.Conll.file line.Conll.line_num in
bguillaum's avatar
bguillaum committed
346
        Gid_map.add index (G_node.of_conll ?domain ~loc ?prec ~succ:(index+1) line)
347
          (loop (index+1) (Some index) tail) in
348 349

    let map_without_edges = loop 0 None sorted_lines in
350

bguillaum's avatar
bguillaum committed
351
    let map_with_edges =
bguillaum's avatar
bguillaum committed
352 353
      List.fold_left
        (fun acc line ->
354 355
          let loc = Loc.file_opt_line conll.Conll.file line.Conll.line_num in
          let dep_id = Id.gbuild ~loc line.Conll.id gtable in
356 357
          List.fold_left
            (fun acc2 (gov, dep_lab) ->
358
              let gov_id = Id.gbuild ~loc gov gtable in
bguillaum's avatar
bguillaum committed
359
              let edge = G_edge.make ?domain ~loc dep_lab in
360
              (match map_add_edge_opt acc2 gov_id edge dep_id with
bguillaum's avatar
bguillaum committed
361 362
                | Some g -> g
                | None -> Error.build "[GRS] [Graph.of_conll] try to build a graph with twice the same edge %s %s"
bguillaum's avatar
bguillaum committed
363
                  (G_edge.to_string ?domain edge)
364
                  (Loc.to_string loc)
bguillaum's avatar
bguillaum committed
365
              )
366
            ) acc line.Conll.deps
367
        ) map_without_edges conll.Conll.lines in
368 369 370

      let fusion =
        List.map
371
          (fun {Conll.first; last; fusion; mw_line_num; mw_efs} ->
372
              let loc = Loc.file_opt_line_opt conll.Conll.file mw_line_num in
373
              (
374 375 376 377 378 379
                {
                  first = Id.gbuild ~loc (first,None) gtable;
                  last = Id.gbuild ~loc (last, None) gtable;
                  word = fusion;
                  efs = mw_efs;
                }
380
              )
381
          ) conll.Conll.multiwords in
382

383 384 385 386 387 388 389
    {
      domain;
      meta = conll.Conll.meta;
      map=map_with_edges;
      fusion;
      highest_index= (List.length sorted_lines) -1
    }
bguillaum's avatar
bguillaum committed
390

391 392
  (* -------------------------------------------------------------------------------- *)
  (** input : "Le/DET/le petit/ADJ/petit chat/NC/chat dort/V/dormir ./PONCT/." *)
393 394 395

  let re = Str.regexp "/\\(ADJ\\|ADJWH\\|ADV\\|ADVWH\\|CC\\|CLO\\|CLR\\|CLS\\|CS\\|DET\\|DETWH\\|ET\\|I\\|NC\\|NPP\\|P\\|P\\+D\\|P\\+PRO\\|PONCT\\|PREF\\|PRO\\|PROREL\\|PROWH\\|V\\|VIMP\\|VINF\\|VPP\\|VPR\\|VS\\)/"

bguillaum's avatar
bguillaum committed
396
  let of_brown ?domain ?sentid brown =
397
    let units = Str.split (Str.regexp " ") brown in
398
      let conll_lines = List.mapi
399
      (fun i item -> match Str.full_split re item with
400
        | [Str.Text form; Str.Delim pos; Str.Text lemma] ->
401
        let pos = String.sub pos 1 ((String.length pos)-2) in
402
        Conll.build_line ~id:(i+1,None) ~form ~lemma ~xpos:pos ~feats:[] ~deps:([(i, "SUC")]) ()
403
        | _ -> Error.build "[Graph.of_brown] Cannot parse Brown item >>>%s<<< (expected \"phon/POS/lemma\") in >>>%s<<<" item brown
404
      ) units in
405 406
      let meta = match sentid with Some id -> ["# sent_id = "^id] | None -> [] in
    of_conll ?domain { Conll.file=None; meta; lines=conll_lines; multiwords=[] }
407

408
  (* -------------------------------------------------------------------------------- *)
409 410 411
  let of_pst ?domain pst =
    let cpt = ref 0 in
    let get_pos () = incr cpt; !cpt - 1 in
412

413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439
    let leaf_list = ref [] in

    let rec loop nodes = function
    | Ast.Leaf (loc, phon) ->
      let fresh_id = get_pos () in
      let node = G_node.pst_leaf ~loc ?domain phon fresh_id in
      leaf_list := fresh_id :: ! leaf_list;
      (fresh_id, Gid_map.add fresh_id node nodes)

    | Ast.T (loc, cat, daughters) ->
      let fresh_id = get_pos () in
      let new_node = G_node.pst_node ~loc ?domain cat fresh_id in
      let with_mother = Gid_map.add fresh_id new_node nodes in
      let new_nodes = List.fold_left
        (fun map daughter ->
          let (daughter_id, new_map) = loop map daughter in
          map_add_edge new_map fresh_id G_edge.sub daughter_id
        ) with_mother daughters in
      (fresh_id, new_nodes) in

    let (_,map) = loop Gid_map.empty pst in

    let rec prec_loop map = function
    | [] | [_] -> map
    | n1 :: n2 :: tail ->
      let new_map = prec_loop map (n2 :: tail) in

440 441 442 443 444 445
      let node1 = Gid_map.find n1 new_map
      and node2 = Gid_map.find n2 new_map in
      new_map
      |> (Gid_map.add n1 (G_node.set_succ n2 node1))
      |> (Gid_map.add n2 (G_node.set_prec n1 node2)) in

446 447 448 449 450 451 452
    {
      domain;
      meta=[];
      map=prec_loop map (List.rev !leaf_list);
      fusion = [];
      highest_index = !cpt
    }
bguillaum's avatar
bguillaum committed
453

bguillaum's avatar
bguillaum committed
454
  (* -------------------------------------------------------------------------------- *)
455
  let del_edge ?edge_ident loc graph id_src label id_tar =
456
    let node_src =
457
      try Gid_map.find id_src graph.map
458
      with Not_found ->
459
        match edge_ident with
bguillaum's avatar
bguillaum committed
460 461
          | None -> Log.fcritical "[RUN] Some edge refers to a dead node, please report"
          | Some id -> Error.run ~loc "[Graph.del_edge] cannot find source node of edge \"%s\"" id in
Bruno Guillaume's avatar
Bruno Guillaume committed
462 463 464
    match G_node.remove_opt id_tar label node_src with
    | None -> None
    | Some new_node -> Some {graph with map = Gid_map.add id_src new_node graph.map}
pj2m's avatar
pj2m committed
465

bguillaum's avatar
bguillaum committed
466
  (* -------------------------------------------------------------------------------- *)
467
  let del_node graph node_id =
468 469 470 471 472 473 474
    let map_wo_node =
      Gid_map.fold
        (fun id value acc ->
          if id = node_id
          then acc
          else Gid_map.add id (G_node.remove_key node_id value) acc
        ) graph.map Gid_map.empty in
Bruno Guillaume's avatar
Bruno Guillaume committed
475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501
    try
      let node = Gid_map.find node_id graph.map in
      let new_map =
        match (G_node.get_prec node, G_node.get_succ node) with
        | (Some id_prec, Some id_succ) ->
          begin
            let prec = Gid_map.find id_prec map_wo_node
            and succ = Gid_map.find id_succ map_wo_node in
            map_wo_node
            |> (Gid_map.add id_prec (G_node.set_succ id_succ prec))
            |> (Gid_map.add id_succ (G_node.set_prec id_prec succ))
          end
        | (Some id_prec, None) ->
          begin
            let prec = Gid_map.find id_prec map_wo_node in
            map_wo_node
            |> (Gid_map.add id_prec (G_node.remove_succ prec))
          end
        | (None, Some id_succ) ->
          begin
            let succ = Gid_map.find id_succ map_wo_node in
            map_wo_node
            |> (Gid_map.add id_succ (G_node.remove_prec succ))
          end
        | (None, None) -> map_wo_node in
      Some { graph with map = new_map }
    with Not_found -> None
pj2m's avatar
pj2m committed
502

bguillaum's avatar
bguillaum committed
503
  (* -------------------------------------------------------------------------------- *)
504
  let insert id1 id2 graph =
bguillaum's avatar
bguillaum committed
505 506
    let node1 = Gid_map.find id1 graph.map in
    let node2 = Gid_map.find id2 graph.map in
507 508 509
    let new_pos = match (G_node.get_position node1, G_node.get_position node2) with
    | (G_node.Ordered pos1, G_node.Ordered pos2) -> (pos1 +. pos2) /. 2.
    | _ -> Error.run "Try to insert into non ordered nodes" in
510
    let new_gid = graph.highest_index + 1 in
bguillaum's avatar
bguillaum committed
511
    let map = graph.map
512
      |> (Gid_map.add new_gid (G_node.fresh ~prec:id1 ~succ:id2 new_pos))
bguillaum's avatar
bguillaum committed
513 514
      |> (Gid_map.add id1 (G_node.set_succ new_gid node1))
      |> (Gid_map.add id2 (G_node.set_prec new_gid node2)) in
515
    (new_gid, { graph with map; highest_index = new_gid })
bguillaum's avatar
bguillaum committed
516 517

  (* -------------------------------------------------------------------------------- *)
518
  let append id graph =
bguillaum's avatar
bguillaum committed
519
    let node = Gid_map.find id graph.map in
520 521 522
    let new_pos = match G_node.get_position node with
    | G_node.Ordered pos -> pos +. 1.
    | _ -> Error.run "Try to append into non ordered nodes" in
523
    let new_gid = graph.highest_index + 1 in
bguillaum's avatar
bguillaum committed
524
    let map = graph.map
525
      |> (Gid_map.add new_gid (G_node.fresh ~prec:id new_pos))
bguillaum's avatar
bguillaum committed
526
      |> (Gid_map.add id (G_node.set_succ new_gid node)) in
527
    (new_gid, { graph with map; highest_index = new_gid })
bguillaum's avatar
bguillaum committed
528 529

  (* -------------------------------------------------------------------------------- *)
530
  let prepend id graph =
bguillaum's avatar
bguillaum committed
531
    let node = Gid_map.find id graph.map in
532 533 534
    let new_pos = match G_node.get_position node with
    | G_node.Ordered pos -> pos -. 1.
    | _ -> Error.run "Try to prepend into non ordered nodes" in
535
    let new_gid = graph.highest_index + 1 in
bguillaum's avatar
bguillaum committed
536
    let map = graph.map
537
      |> (Gid_map.add new_gid (G_node.fresh ~succ:id new_pos))
bguillaum's avatar
bguillaum committed
538
      |> (Gid_map.add id (G_node.set_prec new_gid node)) in
539
    (new_gid, { graph with map; highest_index = new_gid })
bguillaum's avatar
bguillaum committed
540 541

  (* -------------------------------------------------------------------------------- *)
542
  let add_after node_id graph =
bguillaum's avatar
bguillaum committed
543 544
    let node = Gid_map.find node_id graph.map in
    match G_node.get_succ node with
545 546
    | Some gid_succ -> insert node_id gid_succ graph
    | None -> append node_id graph
bguillaum's avatar
bguillaum committed
547 548

  (* -------------------------------------------------------------------------------- *)
549
  let add_before node_id graph =
bguillaum's avatar
bguillaum committed
550 551
    let node = Gid_map.find node_id graph.map in
    match G_node.get_prec node with
552 553 554 555 556 557 558 559
    | Some gid_prec -> insert gid_prec node_id graph
    | None -> prepend node_id graph

  (* -------------------------------------------------------------------------------- *)
  let add_unordered graph =
    let new_gid = graph.highest_index + 1 in
    let map = Gid_map.add new_gid (G_node.fresh_unordered ()) graph.map in
    (new_gid, { graph with map; highest_index = new_gid })
bguillaum's avatar
bguillaum committed
560

bguillaum's avatar
bguillaum committed
561
  (* -------------------------------------------------------------------------------- *)
562
  (* move out-edges (which respect cst [labels,neg]) from id_src are moved to out-edges out off node id_tar *)
563 564
  let shift_out loc strict src_gid tar_gid is_gid_local label_cst graph =
    let domain = get_domain graph in
565 566
    let del_edges = ref [] and add_edges = ref [] in

567
    let src_node = Gid_map.find src_gid graph.map in
568
    let tar_node = Gid_map.find tar_gid graph.map in
569

570 571 572
    let src_next = G_node.get_next src_node in
    let tar_next = G_node.get_next tar_node in

573
    let (new_src_next, new_tar_next) =
574 575
    Massoc_gid.fold
      (fun (acc_src_next,acc_tar_next) next_gid edge ->
576
        if Label_cst.match_ ?domain label_cst edge && not (is_gid_local next_gid)
577
        then
Bruno Guillaume's avatar
Bruno Guillaume committed
578
          match Massoc_gid.add_opt next_gid edge acc_tar_next with
579 580 581 582 583 584 585 586
          | None when strict -> Error.run ~loc "The [shift_out] command tries to build a duplicate edge (with label \"%s\")" (Label.to_string ?domain edge)
          | None ->
            del_edges := (src_gid,edge,next_gid) :: !del_edges;
            (Massoc_gid.remove next_gid edge acc_src_next, acc_tar_next)
          | Some new_acc_tar_next ->
            del_edges := (src_gid,edge,next_gid) :: !del_edges;
            add_edges := (tar_gid,edge,next_gid) :: !add_edges;
            (Massoc_gid.remove next_gid edge acc_src_next, new_acc_tar_next)
587 588 589
        else (acc_src_next,acc_tar_next)
      )
      (src_next, tar_next) src_next in
590

591
    let new_map = graph.map
592
      |> (Gid_map.add src_gid (G_node.set_next new_src_next src_node))
593 594 595 596 597
      |> (Gid_map.add tar_gid (G_node.set_next new_tar_next tar_node)) in
    ( { graph with map = new_map },
      !del_edges,
      !add_edges
    )
pj2m's avatar
pj2m committed
598

bguillaum's avatar
bguillaum committed
599
  (* -------------------------------------------------------------------------------- *)
600 601
  let shift_in loc strict src_gid tar_gid is_gid_local label_cst graph =
    let domain = get_domain graph in
602 603
    let del_edges = ref [] and add_edges = ref [] in
    let new_map =
604 605
      Gid_map.mapi
        (fun node_id node ->
606
          if is_gid_local node_id (* shift does not move pattern edges *)
607 608
          then node
          else
609 610 611 612 613 614 615 616
            let node_next = G_node.get_next node in
            match Massoc_gid.assoc src_gid node_next with
            | [] -> node (* no edges from node to src *)
            | node_src_edges ->
              let node_tar_edges = Massoc_gid.assoc tar_gid node_next in
              let (new_node_src_edges, new_node_tar_edges) =
              List.fold_left
              (fun (acc_node_src_edges,acc_node_tar_edges) edge ->
bguillaum's avatar
bguillaum committed
617
                if Label_cst.match_ ?domain label_cst edge
618 619
                then
                  match List_.usort_insert edge acc_node_tar_edges with
620 621 622 623 624 625 626 627 628
                  | None when strict ->
                    Error.run ~loc "The [shift_in] command tries to build a duplicate edge (with label \"%s\")" (Label.to_string ?domain edge)
                  | None ->
                    del_edges := (node_id,edge,src_gid) :: !del_edges;
                    (List_.usort_remove edge acc_node_src_edges, acc_node_tar_edges)
                  | Some l ->
                    del_edges := (node_id,edge,src_gid) :: !del_edges;
                    add_edges := (node_id,edge,tar_gid) :: !add_edges;
                    (List_.usort_remove edge acc_node_src_edges, l)
629 630 631 632 633 634 635 636
                else (acc_node_src_edges,acc_node_tar_edges)
              )
              (node_src_edges, node_tar_edges) node_src_edges in
              let new_next =
                node_next
                |> (Massoc_gid.replace src_gid new_node_src_edges)
                |> (Massoc_gid.replace tar_gid new_node_tar_edges) in
              G_node.set_next new_next node
637 638 639 640 641
          ) graph.map in
    ( { graph with map = new_map },
      !del_edges,
      !add_edges
    )
642

bguillaum's avatar
bguillaum committed
643
  (* -------------------------------------------------------------------------------- *)
644 645 646
  let shift_edges loc strict src_gid tar_gid is_gid_local label_cst graph =
    let (g1,de1,ae1) = shift_out loc strict src_gid tar_gid is_gid_local label_cst graph in
    let (g2,de2,ae2) = shift_in loc strict src_gid tar_gid is_gid_local label_cst g1 in
647
    (g2, de1 @ de2, ae1 @ ae2)
pj2m's avatar
pj2m committed
648

bguillaum's avatar
bguillaum committed
649
  (* -------------------------------------------------------------------------------- *)
650 651
  let set_feat ?loc graph node_id feat_name new_value =
    let domain = get_domain graph in
652
    let node = Gid_map.find node_id graph.map in
653 654 655 656
    let new_node =
      match feat_name with
        | "position" -> G_node.set_position (float_of_string new_value) node
        | _ ->
bguillaum's avatar
bguillaum committed
657
          let new_fs = G_fs.set_feat ?loc ?domain feat_name new_value (G_node.get_fs node) in
658
          (G_node.set_fs new_fs node) in
659
    { graph with map = Gid_map.add node_id new_node graph.map }
bguillaum's avatar
bguillaum committed
660

bguillaum's avatar
bguillaum committed
661
  (* -------------------------------------------------------------------------------- *)
662
  let update_feat ?loc graph tar_id tar_feat_name item_list =
663 664 665
    let strings_to_concat =
      List.map
        (function
666 667
          | Concat_item.Feat (node_gid, "position") ->
            let node = Gid_map.find node_gid graph.map in
668 669 670 671 672
            begin
              match G_node.get_position node with
              | G_node.Ordered p -> sprintf "%g" p
              | _ -> Error.run ?loc "Try to read position of an unordered node"
            end
bguillaum's avatar
bguillaum committed
673
          | Concat_item.Feat (node_gid, feat_name) ->
bguillaum's avatar
bguillaum committed
674 675
            let node = Gid_map.find node_gid graph.map in
            (match G_fs.get_string_atom feat_name (G_node.get_fs node) with
bguillaum's avatar
bguillaum committed
676
              | Some atom -> atom
bguillaum's avatar
bguillaum committed
677
              | None -> Error.run ?loc "Cannot update_feat, some feature (named \"%s\") is not defined" feat_name
bguillaum's avatar
bguillaum committed
678
            )
bguillaum's avatar
bguillaum committed
679
          | Concat_item.String s -> s
680 681
        ) item_list in
    let new_feature_value = List_.to_string (fun s->s) "" strings_to_concat in
682
    (set_feat ?loc graph tar_id tar_feat_name new_feature_value, new_feature_value)
bguillaum's avatar
bguillaum committed
683

bguillaum's avatar
bguillaum committed
684
  (* -------------------------------------------------------------------------------- *)
685
  let del_feat graph node_id feat_name =
686
    let node = Gid_map.find node_id graph.map in
687 688 689
    match G_fs.del_feat feat_name (G_node.get_fs node) with
      | Some new_fs -> Some { graph with map = Gid_map.add node_id (G_node.set_fs new_fs node) graph.map }
      | None -> None
690

bguillaum's avatar
bguillaum committed
691
  (* -------------------------------------------------------------------------------- *)
692 693
  let to_gr graph =
    let domain = get_domain graph in
694 695 696

    let gr_id id = G_node.get_name id (Gid_map.find id graph.map) in

697
    let buff = Buffer.create 32 in
698

699 700
    bprintf buff "graph {\n";

701 702
    (* meta data *)
    List.iter
703 704
      (fun (s) ->
        bprintf buff "  %s;\n" s
705 706
      ) graph.meta;

707
    (* nodes *)
708 709 710 711 712 713 714 715
    let nodes = Gid_map.fold
      (fun id node acc ->
        if G_node.is_conll_root node
        then acc
        else (id,node)::acc
      ) graph.map [] in

    let sorted_nodes = List.sort (fun (_,n1) (_,n2) -> G_node.position_comp n1 n2) nodes in
716

717 718
    List.iter
      (fun (id,node) ->
719
        bprintf buff "  %s %s;\n" (gr_id id) (G_node.to_gr node)
720
      ) sorted_nodes;
721

722
    (* edges *)
723 724
    List.iter
      (fun (id,node) ->
bguillaum's avatar
bguillaum committed
725 726
        Massoc_gid.iter
          (fun tar edge ->
727
            bprintf buff "  %s -[%s]-> %s;\n" (gr_id id) (G_edge.to_string ?domain edge) (gr_id tar)
bguillaum's avatar
bguillaum committed
728
          ) (G_node.get_next node)
729
      ) sorted_nodes;
730

731 732 733
    bprintf buff "}\n";
    Buffer.contents buff

bguillaum's avatar
bguillaum committed
734
  (* -------------------------------------------------------------------------------- *)
735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760
  let fusion_item_space_after fi =
    try if List.assoc "SpaceAfter" fi.efs = "No" then "" else " "
    with Not_found -> " "

  let space_after gnode =
    match G_fs.get_string_atom "_MISC_SpaceAfter" (G_node.get_fs gnode) with
    | Some "No" -> ""
    | _ -> " "

  let esc s = Str.global_replace (Str.regexp "<") "&lt;" s

  let to_sentence ?main_feat ?(deco=G_deco.empty) graph =

    let is_highlighted_gid gid = List.mem_assoc gid deco.nodes in

    let inside fusion_item gid =
      let first = Gid_map.find fusion_item.first graph.map in
      let last = Gid_map.find fusion_item.last graph.map in
      let node = Gid_map.find gid graph.map in
      match (G_node.get_position first, G_node.get_position node, G_node.get_position last) with
      | (Ordered f, Ordered n, Ordered l) when f <=n && n <= l -> true
      | _ -> false in

    let is_highlighted_fusion_item fusion_item =
      List.exists (fun (gid,_) -> inside fusion_item gid) deco.nodes in

761
    let nodes = Gid_map.fold (fun id elt acc -> (id,elt)::acc) graph.map [] in
762
    let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.position_comp n1 n2) nodes in
763

764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788
    let rec loop skip = function
    | [] -> ""
    | (gid, gnode)::gtail when skip = None ->
      begin
        match List.find_opt (fun fusion_item -> fusion_item.first=gid) graph.fusion with
        | Some fusion_item ->
          (if is_highlighted_fusion_item fusion_item
            then sprintf "<span class=\"highlight\">%s</span>" (esc fusion_item.word)
            else (esc fusion_item.word))
          ^ (fusion_item_space_after fusion_item)
          ^ (loop (Some fusion_item.last) gtail)
        | None ->
          match G_fs.to_word (G_node.get_fs gnode) with
          | None -> (loop None gtail)
          | Some text ->
          (if is_highlighted_gid gid
            then sprintf "<span class=\"highlight\">%s</span>" (esc text)
            else esc (text))
          ^ (space_after gnode)
          ^ (loop None gtail)
      end
    | (gid, gnode)::gtail when skip = Some gid -> loop None gtail
    | (gid, gnode)::gtail -> loop skip gtail in

    Sentence.fr_clean_spaces (loop None snodes)
789

bguillaum's avatar
bguillaum committed
790
  (* -------------------------------------------------------------------------------- *)
791 792 793
  let to_dep ?filter ?main_feat ?(deco=G_deco.empty) graph =
    let domain = get_domain graph in

bguillaum's avatar
bguillaum committed
794
    let nodes = Gid_map.fold (fun id elt acc -> (id,elt)::acc) graph.map [] in
795
    let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.position_comp n1 n2) nodes in
bguillaum's avatar
bguillaum committed
796

797 798 799 800
    let buff = Buffer.create 32 in
    bprintf buff "[GRAPH] { opacity=0; scale = 200; fontname=\"Arial\"; }\n";
    bprintf buff "[WORDS] { \n";

801
    (* nodes *)
802
    List.iter
803
      (fun (id, node) ->
804
        let decorated_feat = try List.assoc id deco.G_deco.nodes with Not_found -> ("",[]) in
bguillaum's avatar
bguillaum committed
805
        let fs = G_node.get_fs node in
806 807
        let pos= match G_node.get_position node with G_node.Ordered x -> Some x | _ -> None in
        let dep_fs = G_fs.to_dep ~decorated_feat ?position:pos ?filter ?main_feat fs in
808 809 810

        let style = match G_fs.get_string_atom "void" fs with
          | Some "y" -> "; forecolor=red; subcolor=red; "
811 812 813
          | _ -> match G_fs.get_string_atom "_UD_empty" fs with
            | Some "Yes" -> "; forecolor=purple; subcolor=purple; "
            | _ -> "" in
bguillaum's avatar
bguillaum committed
814 815 816 817 818

        bprintf buff "N_%s { %s%s }\n"
          (Gid.to_string id)
          dep_fs
          style
819 820
      ) snodes;
    bprintf buff "} \n";
821

822
    (* edges *)
823
    bprintf buff "[EDGES] { \n";
824

bguillaum's avatar
bguillaum committed
825 826 827 828 829 830 831 832 833 834 835 836 837 838 839
    if !Global.debug
    then
      List.iter
        (fun (id, node) ->
          begin
            match G_node.get_prec node with
            | None -> ()
            | Some p -> bprintf buff "N_%s -> N_%s { label=\"__PREC__\"; bottom; style=dot; color=lightblue; forecolor=lightblue; }\n" (Gid.to_string id) (Gid.to_string p)
          end;
          begin
            match G_node.get_succ node with
            | None -> ()
            | Some s -> bprintf buff "N_%s -> N_%s { label=\"__SUCC__\"; bottom; style=dot; color=lightblue; forecolor=lightblue; }\n" (Gid.to_string id) (Gid.to_string s)
          end
        ) snodes;
840

841
    Gid_map.iter
842
      (fun gid elt ->
bguillaum's avatar
bguillaum committed
843 844
        Massoc_gid.iter
          (fun tar g_edge ->
bguillaum's avatar
bguillaum committed
845
            if not (G_edge.is_void ?domain g_edge)
846 847
            then
              let deco = List.mem (gid,g_edge,tar) deco.G_deco.edges in
bguillaum's avatar
bguillaum committed
848
              bprintf buff "N_%s -> N_%s %s\n" (Gid.to_string gid) (Gid.to_string tar) (G_edge.to_dep ?domain ~deco g_edge)
bguillaum's avatar
bguillaum committed
849
          ) (G_node.get_next elt)
850
      ) graph.map;
851 852

    bprintf buff "} \n";
853 854
    Buffer.contents buff

855
  (* -------------------------------------------------------------------------------- *)
bguillaum's avatar
bguillaum committed
856 857 858 859 860 861 862
  let list_num test =
    let rec loop n = function
      | [] -> raise Not_found
      | x::_ when test x -> n
      | _::t -> loop (n+1) t
    in loop 0

863
  (* -------------------------------------------------------------------------------- *)
864 865 866
  let to_conll graph =
    let domain = get_domain graph in

867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917
    let nodes = Gid_map.fold
      (fun gid node acc -> (gid,node)::acc)
      graph.map [] in

    (* sort nodes wrt position *)
    let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.position_comp n1 n2) nodes in

    (* renumbering of nodes to have a consecutive sequence of int 1 --> n, in case of node deletion or addition *)
    let snodes = List.mapi
      (fun i (gid,node) -> (gid, G_node.set_position (float i) node)
      ) snodes in

    let get_num gid =
      let gnode = List.assoc gid snodes in
      if G_node.is_conll_root gnode
      then 0.
      else G_node.get_float (List.assoc gid snodes) in

    (* Warning: [govs_labs] maps [gid]s to [num]s *)
    let govs_labs =
      Gid_map.fold
        (fun src_gid node acc ->
          let src_num = get_num src_gid in
          Massoc_gid.fold
            (fun acc2 tar_gid edge  ->
              let old = try Gid_map.find tar_gid acc2 with Not_found -> [] in
              Gid_map.add tar_gid ((sprintf "%g" src_num, G_edge.to_string ?domain edge)::old) acc2
            ) acc (G_node.get_next node)
        ) graph.map Gid_map.empty in

    let lines = List_.opt_map
    (fun (gid,node) ->
      if G_node.is_conll_root node
      then None
      else
      let gov_labs = try Gid_map.find gid govs_labs with Not_found -> [] in

      let sorted_gov_labs =
        List.sort
          (fun (g1,l1) (g2,l2) ->
            if l1 <> "" && l1.[0] <> 'I' && l1.[0] <> 'D' && l1.[0] <> 'E'
            then -1
            else if l2 <> "" && l2.[0] <> 'I' && l2.[0] <> 'D' && l2.[0] <> 'E'
            then 1
            else
              match compare (String_.to_float g1) (String_.to_float g2) with
                | 0 -> compare l1 l2
                | x -> x
          ) gov_labs in

    let id_of_gid gid = Conll.Id.of_string (string_of_float (get_num gid)) in
918
    let (c2, c3, c4, c5) = Domain.conll_fields domain in
919 920 921 922
    let fs = G_node.get_fs node in
      Some {
      Conll.line_num = 0;
      id = id_of_gid gid;
923 924 925 926 927
      form = (match G_fs.get_string_atom c2 fs with Some p -> p | None -> "_");
      lemma = (match G_fs.get_string_atom c3 fs with Some p -> p | None -> "_");
      upos = (match G_fs.get_string_atom c4 fs with Some p -> p | None -> "_");
      xpos = (match G_fs.get_string_atom c5 fs with Some p -> p | None -> "_");
      feats = (G_fs.to_conll ~exclude: [c2; c3; c4; c5; "position"] fs);
928
      deps = List.map (fun (gov,lab) -> ( Conll.Id.of_string gov, lab)) sorted_gov_labs;
Bruno Guillaume's avatar
Bruno Guillaume committed
929
      efs = G_node.get_efs node;
930 931 932 933 934
    } ) snodes in
    {
      Conll.file = None;
      Conll.meta = graph.meta;
      lines;
935
      multiwords = []; (* multiwords are handled by _UD_* features *)
936 937
    }

938 939
  let to_conll_string graph =
    let conll = to_conll graph in
940
    Conll.to_string (Conll.normalize_multiwords conll)
941

942
  (* -------------------------------------------------------------------------------- *)
943 944
  let to_dot ?main_feat ?(deco=G_deco.empty) graph =
    let domain = get_domain graph in