fixedpoint.jp - pluralize and singularize




pluralize and singularize

2007/10/18Ruby on Rails が名詞の単複数形を使い分けて名前の衝突の防止に役立てていると書きました。このアイディアはどのフレームワークでも応用できるので、今回はその実装を真似て複数形への変形および単数形への変形を行う関数を Gauche で定義してみました。

Rails 1.2.5 では

でモジュール Inflector のメソッド pluralizesingularize として提供されているものです。

pluralize-and-singularize.scm
(use srfi-1)
(use srfi-13)

(define *uncountable*
  '(equipment information rice money spices series fish sheep))

(define *irregular*
  '((person . people)
    (man . men)
    (child . children)
    (sex . sexes)
    (move . moves)))

(define (specify-clause name str variant)
  `(and-let* ((m (rxmatch ,(string->regexp str :case-fold #t) ,name))
              ,@(map (lambda (i) `(,(string->symbol (format #f "m~d" i)) (m ,i))) (filter integer? variant)))
     (string-append (rxmatch-before m)
                    ,@(map (lambda (v) (if (integer? v) (string->symbol (format #f "m~d" v)) v)) variant))))

(define-macro (plural-case name . args)
  `(or
    ,@(map (lambda (x) (specify-clause name (format #f "^~a$" x) (list (symbol->string x)))) *uncountable*)
    ,@(map (lambda (x) (specify-clause name (format #f "~a$" (car x)) (list (symbol->string (cdr x))))) *irregular*)
    ,@(map (lambda (x) (apply specify-clause name x)) args)))

(define (pluralize name)
  (let ((name (x->string name)))
    (plural-case
     name
     ("(quiz)$" (1 "zes"))
     ("^(ox)$" (1 "en"))
     ("([ml])ouse$" (1 "ice"))
     ("(matr|vert|ind)(?:ix|ex)$" (1 "ices"))
     ("(x|ch|ss|sh)$" (1 "es"))
     ("([^aeiouy]|qu)y$" (1 "ies"))
     ("(hive)$" (1 "s"))
     ("([^f])fe$" (1 "ves"))
     ("([lr])f$" (1 "ves"))
     ("sis$" ("ses"))
     ("([ti])um$" (1 "a"))
     ("(buffal|tomat)o$" (1 "oes"))
     ("(bu)s$" (1 "ses"))
     ("(alias|status)$" (1 "es"))
     ("(octop|vir)us$" (1 "i"))
     ("(ax|test)is$" (1 "es"))
     ("s$" ("s"))
     ("$" ("s"))
     )))

(define-macro (singular-case name . args)
  `(or
    ,@(map (lambda (x) (specify-clause name (format #f "^~a$" x) (list (symbol->string x)))) *uncountable*)
    ,@(map (lambda (x) (specify-clause name (format #f "~a$" (cdr x)) (list (symbol->string (car x))))) *irregular*)
    ,@(map (lambda (x) (apply specify-clause name x)) args)))

(define (singularize name)
  (let ((name (x->string name)))
    (singular-case
     name
     ("(quiz)zes$" (1))
     ("(matr)ices$" (1 "ix"))
     ("(vert|ind)ices$" (1 "ex"))
     ("^(ox)en" (1))
     ("(alias|status)es$" (1))
     ("(octop|vir)i$" (1 "us"))
     ("(cris|ax|test)es$" (1 "is"))
     ("(shoe)s$" (1))
     ("(bus)es$" (1))
     ("(o)es$" (1))
     ("([ml])ice$" (1 "ouse"))
     ("(x|ch|ss|sh)es$" (1))
     ("(m)ovies$" (1 "ovie"))
     ("(s)eries$" (1 "eries"))
     ("([^aeiouy]|qu)ies$" (1 "y"))
     ("([lr])ves$" (1 "f"))
     ("(tive)s$" (1))
     ("(hive)s$" (1))
     ("([^f])ves$" (1 "fe"))
     ("(^analy)ses$" (1 "sis"))
     ("((a)naly|(b)a|(d)iagno|(p)arenthe|(p)rogno|(s)ynop|(t)he)ses$" (1 2 "sis"))
     ("([ti])a$" (1 "um"))
     ("(n)ews$" (1 "ews"))
     ("s$" ())
     ("$" ())
     )))

実行例:

gosh> (pluralize "shelf")
"shelves"
gosh> (pluralize "APPLE")
"APPLEs"
gosh> (singularize 'octopi)
"octopus"

Rails 同様、カバーしていない不規則変化を簡単に追加できるという特徴があります。


© 2006,2007 Takeshi Abe