pluralize

英単語の複数形を作ったり、単数形に戻したりします。
ruby on railsのpluralizeを参考にperlに移植してみました。

>irb
irb(main):001:0> require "active_support"
=> true
irb(main):002:0> "child".pluralize
=> "children"
irb(main):003:0> exit

sub pluralize {
	my $s = shift;
	return $s if ($s =~ s/^(ox)$/$1$2en/i);					# ox
	return $s if ($s =~ s/([m|l])ouse$/$1ice/i);			# mouse, louse
	return $s if ($s =~ s/(matr|vert)ix|ex$/$1ices/i);		# matrix, vertex, index
	return $s if ($s =~ s/(x|ch|ss|sh)$/$1es/i);			# search, switch, fix, box, process, address
	return $s if ($s =~ s/([^aeiouy]|qu)ies$/$1y/i);
	return $s if ($s =~ s/([^aeiouy]|qu)y$/$1ies/i);		# query, ability, agency
	return $s if ($s =~ s/(hive)$/$1s/i);					# archive, hive
	return $s if ($s =~ s/(?:([^f])fe|([lr])f)$/$1$2ves/i);	# half, safe, wife
	return $s if ($s =~ s/sis$/ses/i);						# basis, diagnosis
	return $s if ($s =~ s/([ti])um$/$1a/i);					# datum, medium
	return $s if ($s =~ s/(p)erson$/$1eople/i);				# person, salesperson
	return $s if ($s =~ s/(m)an$/$1en/i);					# man, woman, spokesman
	return $s if ($s =~ s/(c)hild$/$1hildren/i);			# child
	return $s if ($s =~ s/(buffal|tomat)o$/$1$2oes/i);		# buffalo, tomato
	return $s if ($s =~ s/(bu)s$/$1$2ses/i);				# bus
	return $s if ($s =~ s/(alias)/$1es/i);					# alias
	return $s if ($s =~ s/(octop|vir)us$/$1i/i);			# octopus, virus - virus has no defined plural (according to Latin/dictionary.com), but viri is better than viruses/viruss
	return $s if ($s =~ s/(ax|cri|test)is$/$1es/i);			# axis, crisis
	return $s if ($s =~ s/s$/s/i);							# no change (compatibility)
	return $s if ($s =~ s/$/s/);
}

sub singularize {
	my $s = shift;
	return $s if ($s =~ s/(matr)ices$/$1ix/i);
	return $s if ($s =~ s/(vert)ices$/$1ex/i);
	return $s if ($s =~ s/^(ox)en/$1/i);
	return $s if ($s =~ s/(alias)es$/$1/i);
	return $s if ($s =~ s/([octop|vir])i$/$1us/i);
	return $s if ($s =~ s/(cris|ax|test)es$/$1is/i);
	return $s if ($s =~ s/(shoe)s$/$1/i);
	return $s if ($s =~ s/(o)es$/$1/i);
	return $s if ($s =~ s/(bus)es$/$1/i);
	return $s if ($s =~ s/([m|l])ice$/$1ouse/i);
	return $s if ($s =~ s/(x|ch|ss|sh)es$/$1/i);
	return $s if ($s =~ s/(m)ovies$/$1$2ovie/i);
	return $s if ($s =~ s/(s)eries$/$1$2eries/i);
	return $s if ($s =~ s/([^aeiouy]|qu)ies$/$1y/i);
	return $s if ($s =~ s/([lr])ves$/$1f/i);
	return $s if ($s =~ s/(tive)s$/$1/i);
	return $s if ($s =~ s/(hive)s$/$1/i);
	return $s if ($s =~ s/([^f])ves$/$1fe/i);
	return $s if ($s =~ s/(^analy)ses$/$1sis/i);
	return $s if ($s =~ s/*1."\n";
print singularize( pluralize("test"))."\n";
print singularize( pluralize("child"))."\n";
print singularize( pluralize("man"))."\n";

*1:a)naly|(b)a|(d)iagno|(p)arenthe|(p)rogno|(s)ynop|(t)he)ses$/$1$2sis/i); return $s if ($s =~ s/([ti])a$/$1um/i); return $s if ($s =~ s/(p)eople$/$1$2erson/i); return $s if ($s =~ s/(m)en$/$1an/i); return $s if ($s =~ s/(s)tatus$/$1$2tatus/i); return $s if ($s =~ s/(c)hildren$/$1$2hild/i); return $s if ($s =~ s/(n)ews$/$1$2ews/i); return $s if ($s =~ s/s$//i); } print pluralize("ox")."\n"; print pluralize("test")."\n"; print pluralize("child")."\n"; print pluralize("man")."\n"; print singularize( pluralize("ox"