prepdataNKJP
5.08 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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
#! /usr/bin/perl
#
# Przygotowuje (pod)korpus w formacie NKJP do analizy Świgrą
#
# Argumentami skryptu jest ścieżka do korpusu źródłowego i ścieżka
# wewnątrz której skrypt utworzy wynikową hierarchię katalogów.
#
use strict;
use utf8;
use open ':utf8', ':std';
use XML::LibXML;
use File::Find;
die "Wymagane argumenty: ścieżka źródłowa i docelowa\n"
unless @ARGV == 2;
my ($srcdir, $outdir) = (shift,shift);
mkdir($outdir,0777) unless -d $outdir;
my $parser = XML::LibXML->new();
$parser->expand_xinclude(1);
my $xpc = XML::LibXML::XPathContext->new;
$xpc->registerNs('n', 'http://www.tei-c.org/ns/1.0');
find({
wanted => \&process_one_file,
preprocess => \&sort_the_files,
no_chdir => 1
},
$srcdir);
sub sort_the_files {
# print STDERR join(', ', @_, "\n");
sort @_
}
sub process_one_file {
return unless $_ =~ m|/ann_morphosyntax.xml$|;
print STDERR "$File::Find::dir\n";
my $doc = $parser->parse_file( $_ );
my $root = $doc->documentElement();
my $nkjpid = $xpc->find('//n:TEI/n:teiHeader/@xml:id',$root);
die "Brak identyfikatora w nagłówku" unless $nkjpid;
mkdir("$outdir/$nkjpid",0777) or die "Nie dało się utworzyć katalogu $nkjpid";
my @pars = $xpc->findnodes('//n:text/n:body//n:p',$root);
print STDERR "tekst $nkjpid";
# Dla każdego akapitu w pliku:
foreach my $p (@pars) {
my $pid = $p->getAttribute('xml:id');
die "Brak identyfikatora próbki" unless $pid;
my @sents = $p->getChildrenByTagName('s');
(print STDERR "\nPusty akapit $pid w tekście $nkjpid!\n"), next unless @sents>0;
print STDERR '.';
mkdir("$outdir/$nkjpid/$pid",0777) or die "Nie dało się utworzyć katalogu $pid";
open PKT, '>', "$outdir/$nkjpid/$pid/$pid.packet.xml" or die "Nie dało się utworzyć paczki $pid";
print PKT "<packet name=\"$nkjpid/$pid\">\n";
# print $p->nodeName, ' ', $pid, ":\n";
# Dla każdego zdania w akapicie:
foreach my $s (@sents) {
my $sid = $s->getAttribute('xml:id');
# print "s $sid: ";
my @toks = $s->getElementsByTagName('seg'); # nie Children, bo mogą być w choice’ach!!
(print STDERR "Zdanie $sid w tekście $nkjpid nie zawiera żadnych tokenów!\n"), next unless @toks>0;
open SENT, '>', "$outdir/$nkjpid/$pid/$sid.doa" or die "Nie dało się utworzyć pliku $pid/$sid";
print PKT " <forest file=\"$sid.xml\" />\n";
my $text = '';
my $nrtok = 0;
# Dla każdego tokenu w zdaniu:
foreach my $t (@toks) {
my $tid = $t->getAttribute('xml:id');
die "Token bez identyfikatora w zdaniu $sid" unless $tid;
# <seg> powinno zawierać jedną <fs type="morph">:
my @tmp = $t->getChildrenByTagName('*');
die "Token $tid ma więcej niż jednego potomka $(\(scalar(@tmp)))" unless @tmp == 1;
my $tfs = $tmp[0];
die "Token $tid ma dziwną zawartość"
unless $tfs->getName eq 'fs' && $tfs->getAttribute('type') eq 'morph';
# sprawdzamy, czy bezspacjowy:
my $nps = $xpc->find('./n:f[@name="nps"]/n:binary/@value',$tfs)->string_value eq 'true';
$text .= ' ' unless !$text || $nps;
# pobieramy ortha:
my $token = $xpc->find('n:f[@name="orth"]/n:string',$tfs) || die "Brak orth";
$text .= $token;
get_interps($tfs, $token, $nrtok, $tid, $nps);
$nrtok++;
}
print SENT "info(sample_id,'$nkjpid/$pid').\n";
print SENT "info(sent_id,'$nkjpid/$pid/$sid').\n";
print SENT "info(startnode, 0).\n";
print SENT "info(endnode, $nrtok).\n";
# print STDERR "$pid/$sid: $text\n";
$text =~ s/'/\\'/g;
print SENT "info(tekst,'$text').\n";
print SENT "info(morph_ok, tak).\n";
print SENT ":-analiza('$text').\n";
close SENT;
}
print PKT "</packet>\n";
close PKT;
}
print STDERR "\n";
}
sub get_interps {
my ($tfs,$token,$nrtok,$tid,$nps) = @_;
my $nrtok1 = $nrtok + 1;
$token =~ s/'/\\'/g;
# przeglądamy lexy:
# my @interps = ();
# zapamiętujemy, która interpretacja została wybrana przez anotatorów (może być tylko jedna):
my $disambid = $xpc->findnodes('n:f[@name="disamb"]/n:fs[@type="tool_report"]/n:f[@name="choice"]/@fVal',$tfs)
->string_value;
$disambid =~ s/^#//;
# print "*** $disambid\n";
my @tmp = $xpc->findnodes('n:f[@name="interps"]',$tfs);
die "Więcej niż jedna ($(\(scalar(@tmp))) sekcja interps)" unless @tmp == 1;
for my $i ($tmp[0]->getChildrenByTagName('*')) {
die "Dziwna zawartość struktury interps"
unless $i->getName eq 'fs' && $i->getAttribute('type') eq 'lex';
my $base = $xpc->find('n:f[@name="base"]/n:string',$i);
$base =~ s/'/\\'/g;
my $pos = $xpc->find('n:f[@name="ctag"]/n:symbol/@value',$i);
for my $msd ($xpc->findnodes('n:f[@name="msd"]//n:symbol',$i)) {
my $tag2 = $msd->getAttribute('value');
my $msdid = $msd->getAttribute('xml:id');
# push @interps, [$token, $base, $pos, $tag2, $msdid eq $disambid, $msdid];
print SENT "input($nrtok,$nrtok1,'$token','$base',"
.($tag2? "$pos:$tag2" : $pos)
.","
.($msdid eq $disambid?'nkjp:tak':'nkjp:nie')
.",'$tid','$msdid',"
.($nps ? 'nps' : 'sp')
.").\n";
# print join(' ', @{$interps[$#interps]}, "\n");
}
}
# return @interps;
}