/[stem-hr]/StemHR.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /StemHR.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 11 - (show annotations)
Sat Jul 9 10:04:51 2005 UTC (18 years, 8 months ago) by dpavlin
Original Path: stem-hr.pl
File MIME type: text/plain
File size: 2963 byte(s)
more old changes for stemmer

1 #!/usr/bin/perl -w
2 #
3 # Croatian stemmer
4 #
5
6 # promjenjive:
7 # - imenice
8 # - pridjevi
9 # - brojevi
10 # - zamjenice
11 # - prilozi
12 # - glagoli
13 #
14 # nepromjenjive:
15 # - prijedlozi
16 # - veznici
17 # - èestice
18 # - uzvici
19 #
20
21 use strict;
22
23 sub kgh {
24 my ($pre,$replace,$post) = @_;
25 $replace =~ s/[cè]/k/g;
26 $replace =~ s/[z¾]/g/g;
27 $replace =~ s/[s¹]/h/g;
28 return $pre . $replace . $post;
29 }
30
31 # samoglasnici
32 my $sa = '[aeiou]';
33 # suglasnici
34 my $su = '[^aeiou]';
35
36 my $palatal = '(lj|nj|j|æ|¾|¹|¾|¹t|¾d)';
37
38 # glagolni razredi
39 my $g_1r = '[td]';
40 my $g_2r = '[sz]';
41 my $g_3r = '[pb]';
42 my $g_4r = '[kgh]';
43 my $g_5r = '[nm]';
44 my $g_6r = '(:?nu|n)';
45
46 my %rules;
47 my %stem_words;
48 my $words = 0;
49 my $stems = 0;
50
51
52 my $last_stem = '';
53 my $errors = 0;
54 sub check_stem {
55 my $s = shift || return;
56 if ($last_stem) {
57 if ($last_stem ne $s) {
58 print "ERROR==> ";
59 $errors++;
60 }
61 } else {
62 $last_stem = $s;
63 }
64 }
65
66 while(<>) {
67 chomp;
68 next if (/^#/);
69 if (/^$/) {
70 print "\n";
71 $last_stem = '';
72 next;
73 }
74
75 $words++;
76
77 my $orig = $_;
78
79
80 unless (
81 # infinitiv
82 s/(\w)(ti|æi)$/$1.$2 100/g ||
83 # 1. razred
84 s/([^sk])[td](em|e¹|e|emo|ete|oh|osmo|oste|o¹e|ijah|ija¹e|ijasno|ijaste|ijahu|imo|ite|en|ena|eni)$/$1s.ti 101/g ||
85 # 2. razred
86 s/(${sa})[sz](em|e¹|e|e¹emo|emo|ete|u|oh|e|osmo|oste|o¹e|ijah|ija¹e|ijasmo|ijaste|ijahu|imo|ite|uæi|av¹i|ao|la|lo|li|le|la|en|ena|eni)$/$1s.ti 102/ ||
87 # 3. razred
88 s/(p|b|sp|su)(em|e¹|e|emo|ete|u|oh|osmo|oste|o¹e|ah|a¹e|asmo|aste|ahu|ijah|ija¹e|ijahu|i|imo|ite||uæi|av¹i|ao|la|lo|en|ena|eni)$/$1s.ti 103/ ||
89 # 4. razred
90 s/[è¾¹](em|e¹|e|emo|ete|u|ah|ahu|en|ena)$/.æi 104/g ||
91 s/[k](oh|osmo|oste|o¹e|uæi|av¹i|ao|la|lo)$/.æi 105/g ||
92 s/[c](ijah|ija¹e|ijasmo|ijaste|ijahu|i|imo|ite)$/.æi 106/g ||
93 s/[g](nuti|oh|nuh|nu|av¹i|nuv¹i|ao|nuo|nem|ne¹|ni|imo|nut|nimo)$/.æi 107/g ||
94
95 # imenice
96
97 # vrsta a
98 s/(${su}st)a$/$1 13/g ||
99 s/(${su})c[ae]$/$1ce 17/g ||
100 # kgh
101 s/(\w${sa})([è¾¹czs])(i|e|ima)$/kgh($1,$2,' 1')/gex ||
102 s/(${sa}[kgh])(a|u|om)$/$1 2/g ||
103 s/(${su})([è¾¹czs])(i|e|ima)$/kgh($1,"a$2",' 3')/gex ||
104 # imenice na palatal
105 s/${palatal}${palatal}(a|u|em|i|ima|e)$/$1a$2 9/g ||
106 s/${palatal}(a|u|em)$/$1 8/g ||
107 # nepostojano a
108 s/(${su}a{$su})a/$1 4/g ||
109 s/(${su})(${su})(a|u|i|e|om|ima)$/$1a$2 5/g
110 ) {
111
112 # vrsta a
113 s/me$/me 11/g ||
114 s/(eta|ena)$/e 12/g ||
115
116 s/(\w${sa}${su})(o|e|a|u|om|em|i|ima|ina|eta)$/$1 7/g ||
117
118 s/(${su})sa$/$1as 14/g ||
119 s/(${su})ena$/$1e 16/g ||
120 s/(${su})eta$/$1e 17/g ||
121 s/(${su})([oe])$/$1$2 18/g ||
122
123 0;
124
125 }
126
127 if (s/^(.+)\s(\d+)$/$1\t$2/g) {
128 $rules{$2}++;
129 $stems++;
130 $stem_words{$1}++;
131 check_stem($1);
132 } else {
133 $last_stem = $_;
134 }
135
136 printf("%-15s %s\n",$orig,$_);
137
138 }
139 my $nr_stems = keys(%stem_words);
140 printf "\n# %d words, %d stems in %d ops, %.2f%% size [%d errors]\n",$words,$nr_stems,$stems,($nr_stems*100/$words),$errors;
141
142 foreach my $s (keys %stem_words) {
143 print "#stem $stem_words{$s} $s\n";
144 }
145
146 foreach my $r (sort keys %rules) {
147 print "#rule $rules{$r} $r\n";
148 }

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26