ENIAMdisambiguation.ml
4.93 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(*
* ENIAMexec implements ENIAM processing stream
* Copyright (C) 2016-2017 Wojciech Jaworski <wjaworski atSPAMfree mimuw dot edu dot pl>
* Copyright (C) 2016-2017 Institute of Computer Science Polish Academy of Sciences
*
* This library is free software: you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
open ENIAMexecTypes
open ENIAM_LCGtypes
open Xstd
let _ = Random.self_init ()
let rec get_nth n = function
[] -> failwith "get_nth"
| (i,_) :: l -> if n = 0 then i else get_nth (n-1) l
let rec select_random_rec selection = function
Ref i -> selection
| Node t ->
let selection = select_random_rec selection t.args in
Xlist.fold t.attrs selection (fun selection (_,t) -> select_random_rec selection t)
| Variant(e,l) ->
let selected,selection =
if StringMap.mem selection e then
StringMap.find selection e, selection
else
let selected =
if e = "" then Xlist.map l fst
else [get_nth (Random.int (Xlist.size l)) l] in
selected, StringMap.add selection e selected in
Printf.printf "select_random_rec: %s [%s]\n%!" e (String.concat ";" selected);
Xlist.fold l selection (fun selection (i,t) ->
if Xlist.mem selected i then select_random_rec selection t else selection)
| Tuple l -> Xlist.fold l selection select_random_rec
| Val _ -> selection
| Dot -> selection
| t -> failwith ("select_random_rec: " ^ ENIAM_LCGstringOf.linear_term 0 t)
let select_random tree =
Int.fold 0 (Array.length tree - 1) StringMap.empty (fun selection i ->
select_random_rec selection tree.(i))
let rec apply_selection_rec selection = function
Ref i -> Ref i
| Node t ->
Node{t with args=apply_selection_rec selection t.args;
attrs=Xlist.map t.attrs (fun (k,v) -> k, apply_selection_rec selection v)}
| Variant(e,l) ->
if not (StringMap.mem selection e) then Dot
(*failwith ("apply_selection_rec: unknown label '" ^ e ^ "'")*) else
let selected = StringMap.find selection e in
Printf.printf "apply_selection_rec: %s [%s]\n%!" e (String.concat ";" selected);
let l = Xlist.fold l [] (fun l (i,t) ->
if Xlist.mem selected i then (i,t) :: l else l) in
(match l with
[] -> (*failwith "apply_selection_rec: empty selection"*) Dot
| [_,t] -> apply_selection_rec selection t
| l ->
let l = Xlist.rev_map l (fun (i,t) ->
i, apply_selection_rec selection t) in
Variant(e,l))
| Tuple l ->
let l = Xlist.rev_map l (apply_selection_rec selection) in
Tuple(List.rev l)
| Val s -> Val s
| Dot -> Dot
| t -> failwith ("apply_selection_rec: " ^ ENIAM_LCGstringOf.linear_term 0 t)
let apply_selection selection tree =
let result_tree = Array.make (Array.length tree) Dot in
Int.iter 0 (Array.length tree - 1) (fun i ->
result_tree.(i) <- apply_selection_rec selection tree.(i));
result_tree
let rec make_rearrange_map tree map next = function
Ref i ->
if IntMap.mem map i then map,next else
let map = IntMap.add map i next in
make_rearrange_map tree map (next+1) tree.(i)
| Node t -> make_rearrange_map tree map next t.args
| Variant(e,l) -> Xlist.fold l (map,next) (fun (map,next) (i,t) -> make_rearrange_map tree map next t)
| Tuple l -> Xlist.fold l (map,next) (fun (map,next) -> make_rearrange_map tree map next)
| Dot -> map,next
| t -> failwith ("make_rearrange_map: " ^ ENIAM_LCGstringOf.linear_term 0 t)
let rec rearrange_refs map = function
Ref i -> Ref (try IntMap.find map i with Not_found -> failwith "rearrange_refs")
| Node t -> Node{t with args=rearrange_refs map t.args}
| Variant(e,l) ->
let l = Xlist.rev_map l (fun (i,t) -> i, rearrange_refs map t) in
Variant(e,List.rev l)
| Tuple l ->
let l = Xlist.rev_map l (rearrange_refs map) in
Tuple(List.rev l)
| Dot -> Dot
| t -> failwith ("make_rearrange_map: " ^ ENIAM_LCGstringOf.linear_term 0 t)
let rearrange_tree tree =
let map = IntMap.add IntMap.empty 0 0 in
let map,next = make_rearrange_map tree map 1 tree.(0) in
let result_tree = Array.make next Dot in
IntMap.iter map (fun orig res ->
result_tree.(res) <- rearrange_refs map tree.(orig));
result_tree
let random_tree tokens lex_sems tree =
print_endline "random_tree";
let selection = select_random tree in
let tree = apply_selection selection tree in
rearrange_tree tree