152 lines
3.6 KiB
Factor
152 lines
3.6 KiB
Factor
! Copyright (C) 2015 John Benediktsson
|
|
! See http://factorcode.org/license.txt for BSD license
|
|
USING: assocs assocs.extras combinators formatting kernel literals
|
|
locals math math.parser sequences splitting unicode ;
|
|
|
|
IN: english
|
|
|
|
<PRIVATE
|
|
|
|
<<
|
|
! Irregular pluralizations
|
|
CONSTANT: singular-to-plural H{
|
|
|
|
! us -> i
|
|
{ "alumnus" "alumni" }
|
|
{ "cactus" "cacti" }
|
|
{ "focus" "foci" }
|
|
{ "fungus" "fungi" }
|
|
{ "nucleus" "nuclei" }
|
|
{ "radius" "radii" }
|
|
{ "stimulus" "stimuli" }
|
|
|
|
! is -> es
|
|
{ "analysis" "analyses" }
|
|
{ "axis" "axes" }
|
|
{ "basis" "bases" }
|
|
{ "crisis" "crises" }
|
|
{ "diagnosis" "diagnoses" }
|
|
{ "ellipsis" "ellipses" }
|
|
{ "hypothesis" "hypotheses" }
|
|
{ "oasis" "oases" }
|
|
{ "paralysis" "paralyses" }
|
|
{ "parenthesis" "parentheses" }
|
|
{ "synopsis" "synopses" }
|
|
{ "synthesis" "syntheses" }
|
|
{ "thesis" "theses" }
|
|
|
|
! ix -> ices
|
|
{ "appendix" "appendices" }
|
|
{ "index" "indices" }
|
|
{ "matrix" "matrices" }
|
|
|
|
! eau -> eaux
|
|
{ "beau" "beaux" }
|
|
{ "bureau" "bureaus" }
|
|
{ "tableau" "tableaux" }
|
|
|
|
! ? -> en
|
|
{ "child" "children" }
|
|
{ "man" "men" }
|
|
{ "ox" "oxen" }
|
|
{ "woman" "women" }
|
|
|
|
! ? -> a
|
|
{ "bacterium" "bacteria" }
|
|
{ "corpus" "corpora" }
|
|
{ "criterion" "criteria" }
|
|
{ "curriculum" "curricula" }
|
|
{ "datum" "data" }
|
|
{ "genus" "genera" }
|
|
{ "medium" "media" }
|
|
{ "memorandum" "memoranda" }
|
|
{ "phenomenon" "phenomena" }
|
|
{ "stratum" "strata" }
|
|
|
|
! no change
|
|
{ "bison" "bison" }
|
|
{ "deer" "deer" }
|
|
{ "fish" "fish" }
|
|
{ "means" "means" }
|
|
{ "moose" "moose" }
|
|
{ "offspring" "offspring" }
|
|
{ "series" "series" }
|
|
{ "sheep" "sheep" }
|
|
{ "species" "species" }
|
|
{ "swine" "swine" }
|
|
|
|
! oo -> ee
|
|
{ "foot" "feet" }
|
|
{ "goose" "geese" }
|
|
{ "tooth" "teeth" }
|
|
|
|
! a -> ae
|
|
{ "antenna" "antennae" }
|
|
{ "formula" "formulae" }
|
|
{ "nebula" "nebulae" }
|
|
{ "vertebra" "vertebrae" }
|
|
{ "vita" "vitae" }
|
|
|
|
! ouse -> ice
|
|
{ "louse" "lice" }
|
|
{ "mouse" "mice" }
|
|
}
|
|
>>
|
|
|
|
CONSTANT: plural-to-singular $[ singular-to-plural assoc-invert ]
|
|
|
|
:: match-case ( master disciple -- master' )
|
|
{
|
|
{ [ master >lower master = ] [ disciple >lower ] }
|
|
{ [ master >upper master = ] [ disciple >upper ] }
|
|
{ [ master >title master = ] [ disciple >title ] }
|
|
[ disciple ]
|
|
} cond ;
|
|
|
|
PRIVATE>
|
|
|
|
: singularize ( word -- singular )
|
|
dup >lower {
|
|
{ [ dup empty? ] [ ] }
|
|
{ [ dup singular-to-plural key? ] [ ] }
|
|
{ [ plural-to-singular ?at ] [ ] }
|
|
{ [ dup "s" tail? not ] [ ] }
|
|
{
|
|
[
|
|
dup "ies" ?tail [
|
|
last "aeiou" member? not
|
|
] [ drop f ] if
|
|
] [ 3 head* "y" append ]
|
|
}
|
|
{ [ dup "es" tail? ] [ 2 head* ] }
|
|
[ but-last ]
|
|
} cond match-case ;
|
|
|
|
: pluralize ( word -- plural )
|
|
dup >lower {
|
|
{ [ dup empty? ] [ ] }
|
|
{ [ dup plural-to-singular key? ] [ ] }
|
|
{ [ singular-to-plural ?at ] [ ] }
|
|
{
|
|
[
|
|
dup "y" ?tail [
|
|
last "aeiou" member? not
|
|
] [ drop f ] if
|
|
] [ but-last "ies" append ]
|
|
}
|
|
{
|
|
[ dup { "s" "ch" "sh" } [ tail? ] with any? ]
|
|
[ dup "es" tail? [ "es" append ] unless ]
|
|
}
|
|
[ "s" append ]
|
|
} cond match-case ;
|
|
|
|
: count-of-things ( count word -- str )
|
|
over 1 = [ pluralize ] unless "%d %s" sprintf ;
|
|
|
|
: a10n ( str -- str' )
|
|
dup length 3 > [
|
|
[ 1 head ] [ length 2 - number>string ] [ 1 tail* ] tri
|
|
3append
|
|
] when ;
|