Re: Is there any library for converting common English words to its equivalent numeric value in digits?



Brian wrote:
format can print 74823957 as "seventy-four million, eight hundred and
twenty-three thousand, nine hundred and fifty-seven", but it can't go
the other way.

Here is an implementation of the reverse, written long ago. Sorry about any folded lines. It includes a setf expander so you can write things
like
(incf (english-number) (aref my-array index))

;;;;;;;;;; english-number.cl smh@xxxxxxxxx

(in-package :user)

(macrolet ((e (x &optional ordinalp)
`(let ((english (format nil (if ,ordinalp "~:r" "~r") ,x)))
(list* (subseq english (1+ (or (position #\space english) -1)))
,x
,ordinalp))))
(defparameter *number-words*
(nconc (loop for n from 0 below 20 collect (e n) collect (e n t))
(loop for n from 20 below 100 by 10 collect (e n) collect (e n t))))

(defparameter *number-multipliers*
(loop for n in '(1000 1000000 1000000000 1000000000000)
collect (e n) collect (e n t))))

;; This parses numbers such as are produced by format ~r.
(defun english-number (string)
(flet ((word (string start)
(nth-value 1
(match-re "[a-z]+" string :start start :return :index))))
(let* ((ordinalp nil)
(len (length string))
(start 0)
(minusp (let ((pos (word string 0)))
(if (string= (subseq string (car pos) (cdr pos)) "negative")
(progn (setf start (cdr pos)) -1)
1))))
(values
(* minusp
(loop
while (< start len)
summing (* (loop with sum = 0
while (< start len)
as pos = (word string start)
while pos
as num-string = (subseq string (car pos) (cdr pos))
as num = (cdr (assoc num-string *number-words* :test #'string=))
if num
do (incf sum (car num))
(setf start (cdr pos))
(when (cdr num) (setq ordinalp t))
else if (string= num-string "hundred")
do (setf sum (* 100 sum))
(setf start (cdr pos))
else if (string= num-string "hundredth")
do (setf sum (* 100 sum))
(setf start (cdr pos))
(setf ordinalp t)
else return sum
finally (return sum))
(loop with partial = 1
while (< start len)
as pos = (word string start)
while pos
as num-string = (subseq string (car pos) (cdr pos))
as num = (cdr (assoc num-string *number-multipliers*
:test #'string=))
while num
do (setf partial (* partial (car num)))
(setf start (cdr pos))
(when (cdr num) (setq ordinalp t))
finally (return partial)))))
ordinalp))))

(define-setf-expander english-number (x &environment env)
(multiple-value-bind (vars vals stores setter getter)
(get-setf-expansion x env)
(let ((store (gensym)))
(values vars
vals
`(,store)
`(progn (setf ,(car stores) (format nil "~r" ,store))
,setter)
`(english-number ,getter)))))
.



Relevant Pages