/[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

Diff of /StemHR.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by dpavlin, Fri Feb 25 23:14:44 2005 UTC revision 4 by dpavlin, Sat Feb 26 00:37:18 2005 UTC
# Line 18  Line 18 
18  # - uzvici  # - uzvici
19  #  #
20    
21  sub rm_a {  use strict;
         s/a//g;  
 }  
22    
23  sub kgh {  sub kgh {
24          my ($pre,$replace,$post) = @_;          my ($pre,$replace,$post) = @_;
25          $replace =~ s/[cè]/k/g;          $replace =~ s/[cè]/k/g;
26          $replace =~ s/[z¾]/g/g;          $replace =~ s/[z¾]/g/g;
27          $replace =~ s/[s¹]/h/g;          $replace =~ s/[s¹]/h/g;
28          return $pre . $replace . $post . "\tkgh";          return $pre . $replace . $post;
29  }  }
30    
31  # samoglasnici  # samoglasnici
# Line 35  my $sa = '[aeiou]'; Line 33  my $sa = '[aeiou]';
33  # suglasnici  # suglasnici
34  my $su = '[^aeiou]';  my $su = '[^aeiou]';
35    
36    my %rules;
37    my %stem_words;
38    my $words = 0;
39    my $stems = 0;
40    
41  while(<>) {  while(<>) {
42          chomp;          chomp;
43            if (/^$/) {
44                    print "\n";
45                    next;
46            }
47    
48            $words++;
49    
50          my $orig = $_;          my $orig = $_;
51    
# Line 44  while(<>) { Line 53  while(<>) {
53          # vrsta a          # vrsta a
54    
55          unless (          unless (
56                    # kgh
57                    s/(${sa})([è¾¹czs])(i|e|ima)$/kgh($1,$2,' 1')/gex ||
58                    s/(${sa}[kgh])(a|u|om)$/$1 2/g ||
59                    s/(${su})([è¾¹czs])(i|e|ima)$/kgh($1,"a$2",' 3')/gex ||
60                  # nepostojano a                  # nepostojano a
61                  s/(${su}a{$su})a/$1 1/g ||                  s/(${su}a{$su})a/$1 4/g ||
62                  s/(${su})(${su})(a|u|i|e|om|ima)$/$1a$2\t3/g                  s/(${su})(${su})(a|u|i|e|om|ima)$/$1a$2 5/g
63          ) {          ) {
                 # kgh  
                 s/(${su}${sa})([è¾¹czs])(i|e|ima)$/kgh($1,$2,'')/gex;  
 #               s/${su}${sa}[c](i|ima) 4//g;  
                 s/(${su}${sa}[kgh])(a|u|om)\t5/$1/g;  
64    
65                  # mno¾ina                  # mno¾ina
66                  s/(${su})(ov|ev)*(i|a|ima|e|in|ina)$/$1\t6/g;                  s/(${su})(ov|ev)*(i|a|ima|e|in|ina)$/$1 6/g;
67                  # jednina                  # jednina
68                  s/(o|e|a|u|om|em)$/\t7/g;                  s/(o|e|a|u|om|em)$/ 7/g;
69          }          }
70    
71            if (s/^(.+)\s(\d+)$/$1\t$2/g) {
72                    $rules{$2}++;
73                    $stems++;
74                    $stem_words{$1}++;
75            }
76    
77          printf("%-15s %s\n",$orig,$_);          printf("%-15s %s\n",$orig,$_);
78    
79    }
80    my $nr_stems = keys(%stem_words);
81    printf "\n# %d words, %d stems in %d ops, %.2f%% size\n",$words,$nr_stems,$stems,($nr_stems*100/$words);
82    
83    foreach my $s (keys %stem_words) {
84            print "#stem $stem_words{$s} $s\n";
85    }
86    
87    foreach my $r (keys %rules) {
88            print "#rule $rules{$r} $r\n";
89  }  }
Legend:
Removed from v.1  
changed lines
  Added in v.4
  ViewVC Help
Powered by ViewVC 1.1.26