Singulars and plurals
18th December 2025
This is a pair of utilities I wrote some time ago to handle image searches, but I thought it would be worth sharing in case it's useful for other applications.
It consists of two functions:
- pluralise takes an English word and returns its plural.
If it's already plural it just returns it.
- singularise takes an English word and returns its singular.
If it's already singular it just returns it.
The typical situation is that you have a library of images tagged with keywords, but for an image containing cats it's inefficient to have to add both the tags "cat" and "cats". These functions ensure that a search for either "cat" or "cats" will find the appropriate image.
For example:
> (pluralise "cat") "cats"
> (pluralise "mouse") "mice"
and the reverse function:
> (singularise "cats") "cat"
> (singularise "mice") "mouse"
Here are the functions:
(defparameter *plurals*
'(("mouse" . "mice") ("person" . "people") ("man" . "men") ("woman" . "women")
("child" . "children") ("bus" . "buses") ("fish" . "fish") ("piano" . "pianos")
("leaf" . "leaves") ("wildlife" . "wildlife") ("goose" . "geese") ("paper" . "paper")))
(defun pluralise (string)
(let ((l (length string)))
(cond
((<= l 1) string)
(t (let* ((keyword (string-downcase string))
(last (char keyword (1- l)))
(irregular (assoc keyword *plurals* :test #'equal)))
(cond
;; Already a plural
((rassoc keyword *plurals* :test #'equal) keyword)
;; Irregulars
(irregular (cdr irregular))
;; dress -> dresses etc
((string= "ss" keyword :start2 (- l 2)) (concatenate 'string keyword "es"))
;; Already a plural
((eq last #\s) keyword)
;; dish -> dishes etc
((string= "sh" keyword :start2 (- l 2)) (concatenate 'string keyword "es"))
;; baby -> babies but key -> keys
((and (eq last #\y) (not (find (char keyword (- l 2)) "aeiou")))
(concatenate 'string (subseq keyword 0 (1- l)) "ies"))
;; mango -> mangoes etc
((eq last #\o) (concatenate 'string (subseq keyword 0 (1- l)) "oes"))
;; Otherwise just add s
(t (concatenate 'string keyword "s"))))))))
(defun singularise (string)
(let ((l (length string)))
(cond
((<= l 2) string)
(t (let* ((keyword (string-downcase string))
(last (char keyword (1- l)))
(irregular (rassoc keyword *plurals* :test #'equal)))
(cond
;; Already singular
((assoc keyword *plurals* :test #'equal) keyword)
;; Irregulars
(irregular (car irregular))
;; horses -> horse etc
((string= "ses" keyword :start2 (- l 3)) (subseq keyword 0 (- l 1)))
;; bushes -> bush etc
((string= "hes" keyword :start2 (- l 3)) (subseq keyword 0 (- l 2)))
;; babies -> baby etc
((string= "ies" keyword :start2 (- l 3))
(concatenate 'string (subseq keyword 0 (- l 3)) "y"))
;; shoes -> shoe etc
((string= "oes" keyword :start2 (- l 3)) (subseq keyword 0 (- l 1)))
;; dresses -> dress etc
((string= "ss" keyword :start2 (- l 2)) keyword)
;; Otherwise just remove s
((eq last #\s) (subseq keyword 0 (1- l)))
;; or leave as is
(t keyword)))))))
You can extend it for words it doesn't handle correctly by adding them to the *plurals* alist.
blog comments powered by Disqus