SkladnicaTreeFinder.ml
4.48 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
124
125
126
127
128
129
130
131
132
133
(*
18702 plików
7708 znalezionych drzew *)
open SkladnicaTypes
(* module JustString =
struct
type t = string
let compare a b =
Pervasives.compare a b
end
module StringSet = Set.Make(JustString)
let m = ref StringSet.empty
let oc = open_out "ChildrenTypes.txt" *)
let are_true_children = function
ChoiceDef(_,true,_) -> true
| _ -> false
let get_childlist = function
ChoiceDef(_,_,ch) -> ch
| _ -> failwith "get_childlist"
let add_child child = function
Node(from,sto,fs,head,children) -> Node(from,sto,fs,head,child::children)
| _ -> failwith "add_child"
let make_node h = function
Forest(_,_,_,_,_,nodes) -> List.nth nodes h.nid
| _ -> failwith "make_node"
let is_node_chosen = function
Nonterminal(atr,_,_,_) -> atr.chosen
| Terminal(atr,_,_,_,_) -> atr.chosen
let make_tree h forest =
let node = make_node h forest in
match node with
Nonterminal(atr,text,fs,_) -> Node(atr.from,atr.sto,[text,fs],[],[])
| Terminal(atr,a,b,c,d) -> Leaf(atr.from,atr.sto,a,b,c,d)
let make_tree_from_node = function
Nonterminal(atr,text,fs,_) -> Node(atr.from,atr.sto,[text,fs],[],[])
| Terminal(atr,a,b,c,d) -> Leaf(atr.from,atr.sto,a,b,c,d)
let rec establish_head tp childlist forest =
let decide_priority forest = function
[a; b] ->
let g h = expand_tree (make_tree h forest) forest (make_node h forest) in
let rec get_base = function
Node(_,_,_,[head],_) -> get_base head
| Leaf(_,_,_,_,base,_) -> base
| _ -> failwith "decide_priority__get_base" in
let base_a = get_base (g a) and base_b = get_base (g b) in
if (base_a = "być" && base_b <> "to") || base_a = "by" || base_a = "to"
then [b], [a]
else [a], [b]
| _ -> failwith "decide_priority" in
if tp = "formaczas" && List.length childlist = 2 && List.for_all (fun h -> h.head) childlist
then
decide_priority forest childlist
else
if tp = "formarzecz" && List.length childlist = 2 && List.for_all (fun h -> h.head) childlist
then
[List.hd childlist], List.tl childlist
else
if List.length childlist = 1
then
childlist, []
else
let a, b = List.partition (fun h -> h.head) childlist in
if List.length a > 1
then
failwith "decide_priority/ManyHeads"
else
a, b
and add_headchild head forest = function
Node(from,sto,fs,[],children) ->
let child = expand_tree (make_tree head forest) forest (make_node head forest) in
if head.from = from && head.sto = sto
then match make_node head forest with
Nonterminal(_,text,nodefs,_) -> expand_tree (Node(from,sto,fs@[text,nodefs],[],children)) forest (make_node head forest)
| Terminal(_,_,_,_,_) -> expand_tree (Node(from,sto,fs,[child],[])) forest (make_node head forest)
else Node(from,sto,fs,[child],children)
| _ -> failwith "add_headchild"
(* and add_to_set tp childlist head forest =
let string_of_node = function
Nonterminal(_,str,_,_) -> str
| Terminal(_,_,_,_,_) -> "terminal" in
let str_nodelist = String.concat " " @@ List.map (fun ch -> string_of_node @@ make_node ch forest) childlist in
let str_head = string_of_node @@ make_node head forest in
let str = tp ^ " (" ^ str_nodelist ^ "): " ^ str_head in
print_endline str;
m := StringSet.add str !m *)
and expand_tree tree forest = function
Nonterminal(_,tp,_,ch) ->
begin
try
let childlist = get_childlist (List.find are_true_children ch) in
let h, children = establish_head tp childlist forest in
let head = match h with
[a] -> a
| _ -> failwith "expand_tree__head" in
(* add_to_set tp childlist head forest; *)
let new_tree = add_headchild head forest tree in
List.fold_right (fun h acc -> add_child (expand_tree (make_tree h forest) forest (make_node h forest)) acc) children new_tree
with
_ -> failwith "expand_tree"
end
| Terminal(_,_,_,_,_) -> tree
let get_tree filename = function
NoTree(_,_,_,_) -> TreeNotFound
| Forest(atr,text,start,stats,answer,nodes) as forest ->
if answer.base_answer.tree_type <> FULL
then TreeNotFound
else
try
expand_tree (make_tree_from_node (List.hd nodes)) forest (List.hd nodes)
with
_ -> TreeNotFound
let text_of_forest = function
Forest(_,text,_,_,_,_) -> text
| NoTree(_,_,_,_) -> "NoTree"