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