Richard Suchenwirth - [name redacted] needed one for Tcl-PLEAC (see BOOK Programming Language Examples Alike Cookbook), so here goes (never written that many returns in my Tcl life ;-): But see Custom curry on how to style such switch branches without a mass of returns, and for German plurals ;-)
LV Richard, is this based on the way that other PLEAC recipes are written? The reason that I ask is that the Perl community has a number of modules for dealing with Natural Languages, including one that generates plurals for English, I believe. There might be some code that could be used for inspiration there. RS: No, I didn't look hard at Perl-PLEAC, just stumbled over some pages in Tcl-Pleac. I noticed Peter had no content for this header, so I surfed the web, got me the plural rules, and wrote it down in some evening minutes. But I think it exposes the power of switch, regexp sufficiently...
proc en:pl word {
switch -- $word {
man {return men}
foot {return feet}
goose {return geese}
louse {return lice}
mouse {return mice}
ox {return oxen}
tooth {return teeth}
calf - elf - half - hoof - leaf - loaf - scarf
- self - sheaf - thief - wolf
{return [string range $word 0 end-1]ves}
knife - life - wife
{return [string range $word 0 end-2]ves}
auto - kangaroo - kilo - memo
- photo - piano - pimento - pro - solo - soprano - studio
- tattoo - video - zoo
{return ${word}s}
cod - deer - fish - offspring - perch - sheep - trout
- species
{return $word}
genus {return genera}
phylum {return phyla}
radius {return radii}
cherub {return cherubim}
mythos {return mythoi}
phenomenon {return phenomena}
formula {return formulae}
}
switch -regexp -- $word {
{[ei]x$} {return [string range $word 0 end-2]ices}
{[sc]h$} - {[soxz]$} {return ${word}es}
{[bcdfghjklmnprstvwxz]y$} {return [string range $word 0 end-1]ies}
{child$} {return ${word}ren}
{eau$} {return ${word}x}
{is$} {return [string range $word 0 end-2]es}
{woman$} {return [string range $word 0 end-2]en}
}
return ${word}s
}No warranty, but enjoy, and feel free to improve!
(2001-12-29): I patched on a few word inflections in a quick-and-dirty manner just to match the example in the Perl Cookbook. Also fixed a typo.
KPV: This clever function misses two of my favorite English plurals. First is the only word in the English language where to form the plural you drop an s: necropolis -> necropoli (a quick search reveals that only some dictionaries recognize that form [L1 ]).
The other word is one which has 3 different plural forms: octopus. The most common, and most accepted plural form is octopuses, but some hyper-correct word mavens look at the ending and think, aha, Latin and make the plural octopi. The ultra-hyper-correct mavens point out that the word is in fact Greek, and so argue that the plural should be octopodes. For more details see [L2 ].
DcK (2007-06-11): I needed to find a singular class name from a plural sql tables for a scaffolding script, so I've adapted this script :
proc en:sing word {
switch -- $word {
men {return man}
feet {return foot}
geese {return goose}
lice {return louse}
mice {return mouse}
oxen {return ox}
teeth {return tooth}
calves - elves - halves - hooves - leaves - loaves - scarves
- selves - sheaves - thieves - wolves
{return [string range $word 0 end-3]f}
knives - lives - wives
{return [string range $word 0 end-3]fe}
autos - kangaroos - kilos - memos
- photos - pianos - pimentos - pros - solos - sopranos - studios
- tattoos - videos - zoos
{return [string range $word 0 end-1]}
cod - deer - fish - offspring - perch - sheep - trout
- species
{return $word}
genera {return genus}
phyla {return phylum}
radii {return radius}
cherubim {return cherub}
mythoi {return mythos}
phenomena {return phenomenon}
formulae {return formula}
octopodes {return octopus}
octopi {return octopus}
}
switch -regexp -- $word {
{[ei]ices$} {return [string range $word 0 end-4]x}
{[sc]hes$} - {[soxz]es$} {return [string range $word 0 end-2]}
{[bcdfghjklmnprstvwxz]ies$} {return [string range $word 0 end-3]y}
{children$} {return [string range $word 0 end-3]}
{eaux$} {return [string range $word 0 end-1]}
{ises$} {return [string range $word 0 end-4]is}
{women$} {return [string range $word 0 end-2]an}
{s$} {return [string range $word 0 end-1]}
}
#Not handled, maybe you should throw an error instead
return $word
}