viewvc.cgi/stem-hr/StemHR.pm

#!/usr/bin/perl -w
#
# Croatian stemmer
#

# promjenjive:
# - imenice
# - pridjevi
# - brojevi
# - zamjenice
# - prilozi
# - glagoli
#
# nepromjenjive:
# - prijedlozi
# - veznici
# - èestice
# - uzvici
#

sub rm_a {
        s/a//g;
}

sub kgh {
        my ($pre,$replace,$post) = @_;
        $replace =~ s/[cè]/k/g;
        $replace =~ s/[z¾]/g/g;
        $replace =~ s/[s¹]/h/g;
        return $pre . $replace . $post;
}

# samoglasnici
my $sa = '[aeiou]';
# suglasnici
my $su = '[^aeiou]';

while(<>) {
        chomp;

        my $orig = $_;

        # imenice
        # vrsta a

        unless (
                # kgh
                s/(${sa})([è¾¹czs])(i|e|ima)$/kgh($1,$2,' 1')/gex ||
                s/(${sa}[kgh])(a|u|om)$/$1 2/g ||
                s/(${su})([è¾¹czs])(i|e|ima)$/kgh($1,"a$2",' 3')/gex ||
                # nepostojano a
                s/(${su}a{$su})a/$1 4/g ||
                s/(${su})(${su})(a|u|i|e|om|ima)$/$1a$2 5/g
        ) {

                # mno¾ina
                s/(${su})(ov|ev)*(i|a|ima|e|in|ina)$/$1 6/g;
                # jednina
                s/(o|e|a|u|om|em)$/ 7/g;
        }

        s/\s(\d+)$/\t$1/g;

        printf("%-15s %s\n",$orig,$_);
}
1	dpavlin	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			sub rm_a {
22			s/a//g;
23			}
24
25			sub kgh {
26			my ($pre,$replace,$post) = @_;
27			$replace =~ s/[cè]/k/g;
28			$replace =~ s/[z¾]/g/g;
29			$replace =~ s/[s¹]/h/g;
30	dpavlin	2	return $pre . $replace . $post;
31	dpavlin	1	}
32
33			# samoglasnici
34			my $sa = '[aeiou]';
35			# suglasnici
36			my $su = '[^aeiou]';
37
38			while(<>) {
39			chomp;
40
41			my $orig = $_;
42
43			# imenice
44			# vrsta a
45
46			unless (
47	dpavlin	2	# kgh
48			s/(${sa})([è¾¹czs])(i\|e\|ima)$/kgh($1,$2,' 1')/gex \|\|
49			s/(${sa}[kgh])(a\|u\|om)$/$1 2/g \|\|
50			s/(${su})([è¾¹czs])(i\|e\|ima)$/kgh($1,"a$2",' 3')/gex \|\|
51	dpavlin	1	# nepostojano a
52	dpavlin	2	s/(${su}a{$su})a/$1 4/g \|\|
53			s/(${su})(${su})(a\|u\|i\|e\|om\|ima)$/$1a$2 5/g
54	dpavlin	1	) {
55
56			# mno¾ina
57	dpavlin	2	s/(${su})(ov\|ev)*(i\|a\|ima\|e\|in\|ina)$/$1 6/g;
58	dpavlin	1	# jednina
59	dpavlin	2	s/(o\|e\|a\|u\|om\|em)$/ 7/g;
60	dpavlin	1	}
61
62	dpavlin	2	s/\s(\d+)$/\t$1/g;
63	dpavlin	1
64			printf("%-15s %s\n",$orig,$_);
65			}