numbers2words

numbers2words.R

# adapted from John Fox's numbers2words function

require(magrittr); require(Rmpfr)

make.digits <- function(x) {
  # This is a function breaks an input number x into the positive (left)
  # and negative(right) elements and returns these as numbers
  x <- toString(x)
  negative <- substr(x,1,1)=="-"
  if (negative) x <- substring(x,2)
  
  if (length(grep('.',x, fixed=TRUE))==0) {
    left <- x %>% strsplit("") %>% unlist
    right <- NULL
  }
  else {
    y <- x %>% strsplit(".", fixed=TRUE)
    left <- y[[1]][1] %>% strsplit("") %>% unlist
    right <- y[[1]][2] %>% strsplit("") %>% unlist
  }
  list(left,right, negative)
}
make.digits(-19.1)

# Insert commas where needed in large numbers
make.proper <- function(x, sep=",") {
  if (is.numeric(x)) x <- format(x, scientific=FALSE)
  digits <- make.digits(x)
  outlength <- ceiling(length(digits[[1]])/3)-1+length(digits[[1]])
  right <- digits[[2]]
  left <- rep("", outlength)
  left[outlength:1 %% 4==0] <- sep
  left[outlength:1 %% 4!=0] <- digits[[1]]
  if (length(right>0)) paste(c(left, ".", right), collapse="")
      else  paste(left, collapse="")
}
make.proper(300000)
 
# Text to vectors
ttv <- function(x, sep=" ") 
  x %>% gsub('\n', ' ', x=.) %>% strsplit(sep) %>% unlist
  
makeNumber <- function(x) as.numeric(paste(x, collapse=""))

ones <- ttv("zero one two three four five six seven eight nine")

teens <- ttv("ten eleven twelve thirteen fourteen fifteen
              sixteen seventeen eighteen nineteen")

tens <- ttv("zero ten twenty thirty forty fifty 
             sixty seventy eighty ninety")

names(ones)=names(teens)=names(tens)=0:9

suffixes <- ttv("thousand  million billion trillion quadrillion 
                quintillion sextillion septillion octillion nonillion 
                decillion undecillion duodecillion tredecillion 
                quattuordecillion quindecillion sexdecillion 
                septendecillion octodecillion novemdecillion 
                vigintillion centillion")

decimals <- ttv('ten hundred 
    thousand ten-thousand hundred-thousand 
    million ten-million hundred-million 
    billion ten-billion hundred-billion 
    trillion ten-trillion hundred-trillion 
    quadrillion ten-quadrillion hundred-quadrillion')

number2words <- function(x, proper=F){
  if (is.numeric(x)) x <- format(x, scientific=FALSE)
  tdigits  <- make.digits(x)
  ldigits  <- tdigits[[1]]
  rdigits  <- tdigits[[2]]
  negative <- tdigits[[3]]
  
  ndigits <- length(ldigits)
  result <- 
    if (ndigits == 1) ones[ldigits]
    else if (ndigits == 2) 
      if (as.numeric(x) <= 19) teens[ldigits[2]]
      else if (ldigits[2]=="0") tens[ldigits[1]]
      else paste0(tens[ldigits[1]], "-", ones[ldigits[2]])
    else if (ndigits == 3) {
      tail <- makeNumber(ldigits[2:3])
      if (tail == 0) paste(ones[ldigits[1]], "hundred")
      else {
        paste(ones[ldigits[1]], "hundred", number2words(tail))
      }
      }
    else {
      nSuffix <- ((ndigits + 2) %/% 3) - 1
      if (nSuffix > length(suffixes) || ndigits > 63)
        stop(paste(x, "is too large!"))
      pick <- 1:(ndigits - 3*nSuffix)
      
      paste(
      number2words(makeNumber(ldigits[pick])),
      suffixes[nSuffix], 
      ',', 
      number2words(makeNumber(ldigits[-pick]))) %>%
    gsub(' ,', ',', x=.)
  }
  if (length(rdigits)>0) {
    result <-
      if (floor(as.numeric(x))==0) paste(
        rdigits %>% makeNumber %>% number2words,
        paste0(decimals[length(rdigits)], 'ths')
      )
    else 
      result <- paste(
        result, "and", 
        rdigits %>% makeNumber %>% number2words,
        paste0(decimals[length(rdigits)], 'ths')
      )
  }  
  if (negative) result <- paste("minus", result) 
  gsub("^\\s+|\\s+$", "", result)
  if (proper) c(paste(result), make.proper(x))
    else paste(result)
}

number2words(.1)
number2words(94.488)
number2words(-12187.1, proper=T)
number2words(123)
number2words(pi^pi^pi, proper=TRUE)