Reemplazo de gsub condicional

Question

Tengo datos de texto (en R) y deseo reemplazar algunos caracteres con otros caracteres en un marco de datos. Pensé que sería una tarea fácil usar strsplit en espacios y crear un vector que pueda luego usar matching (% en%) que luego se puede pegar nuevamente. Pero luego pensé en la puntuación. No hay espacio entre la última palabra de una oración y la puntuación al final.

Me imagino que probablemente haya una manera más simple de lograr lo que quiero que el lío enrevesado que se está convirtiendo en mi código. Apreciaría la dirección con este problema.

#Character String 
x <- "I like 346 ice cream cones. They're 99 percent good! I ate 46." 

#Replacement Values Dataframe 
    symbol text      
1 "346" "three hundred forty six" 
2 "99" "ninety nine"    
3 "46" "forty six" 

#replacement dataframe 
numDF <- 
data.frame(symbol = c("346","99", "46"), 
      text = c("three hundred forty six", "ninety nine","forty six"), 
      stringsAsFactors = FALSE) 

los resultados deseados:

[1] "I like three hundred forty six ice cream cones. They're ninety nine percent good! You ate forty six?") 

EDIT: Originalmente este derecho gsub condicional debido a que lo que parece a mí, aunque no hay gsub involucrados.

Answer 1

Tal vez esto, inspirado por la respuesta de Josh O'Brien, lo hace:

x <- "I like 346 ice cream cones. They're 99 percent good! I ate 46." 
numDF <- structure(c("346", "99", "46", "three hundred forty six", "ninety nine", 
"forty six"), .Dim = c(3L, 2L), .Dimnames = list(c("1", "2", 
"3"), c("symbol", "text"))) 

pat <- paste(numDF[,"symbol"], collapse="|") 
repeat { 
    m <- regexpr(pat, x) 
    if(m==-1) break 
    sym <- regmatches(x,m) 
    regmatches(x,m) <- numDF[match(sym, numDF[,"symbol"]), "text"] 
} 
x 

Answer 2

Esta solución utiliza gsubfn en el paquete del mismo nombre:

library(gsubfn) 

(pat <- paste(numDF$symbol, collapse="|")) 
# [1] "346|99|46" 

gsubfn(pattern = pat, 
     replacement = function(x) { 
      numDF$text[match(x, numDF$symbol)] 
     }, 
     x) 
[1] "I like three hundred forty six ice cream cones. They're ninety nine percent good! I ate forty six." 

Answer 3

Se puede dividir en los límites de espacio en blanco o de palabras (que coincidirá entre una palabra y puntuacion):

> x 
[1] "I like 346 ice cream cones. They're 99 percent good! I ate 46." 
> strsplit(x, split='\\s|\\>|\\<') 
[[1]] 
[1] "I"  "like" "346"  "ice"  "cream" "cones" "."  
[8] ""  "They" "'re"  "99"  "percent" "good" "!"  
[15] ""  "I"  "ate"  "46"  "."  

Entonces puedes hacer tus reemplazos.

Answer 4

No era exactamente claro si realmente quería convertir dígitos en sus equivalentes alfa. Si es así, esta es una estrategia mucho más general. Hay (al menos) dos funciones de conversión de texto a numérico en los archivos de rhelp: digits2text de Jim Lemon y numberstowords de John Fox. También me cambié a gregexpr para llegar a un enfoque vectorizado:

cortar y pegar Lemon's function from the HTML found here trabajado fuera de la caja:

>  m <- gregexpr("[0-9]+", x) 
>  sym <- regmatches(x,m) 
>  regmatches(x,m) <- digits2text(as.numeric(sym[[1]])) 
illion = 0 
digilen = 3 
digitext = three hundred forty six 
[1] 6 4 3 
> 
> x 
[1] "I like three hundred forty six ice cream cones. They're three hundred forty six percent good! I ate three hundred forty six." 

que tenía que hacer algo de edición de los numberstowords porque había algunos saltos de línea que faltan y que en mal estado el análisis (e incluyo a continuación la versión exitosa esta demostración:

>  m <- gregexpr("[0-9]+", x) 
>  sym <- regmatches(x,m) 
>  regmatches(x,m) <- numbers2words(as.numeric(sym[[1]])) 
> 
> x 
[1] "I like three hundred forty six ice cream cones. They're three hundred forty six percent good! I ate three hundred forty six." 

función de Fox editado desde: http://tolstoy.newcastle.edu.au/R/help/05/04/2715.html

numbers2words <- function(x){ 

    helper <- function(x){ 

     digits <- rev(strsplit(as.character(x), "")[[1]]) 
     nDigits <- length(digits) 
     if (nDigits == 1) as.vector(ones[digits]) 
     else if (nDigits == 2) 
      if (x <= 19) as.vector(teens[digits[1]]) 
       else trim(paste(tens[digits[2]], 
          Recall(as.numeric(digits[1])))) 
     else if (nDigits == 3) trim(paste(ones[digits[3]], "hundred", 
      Recall(makeNumber(digits[2:1])))) 
     else { 
      nSuffix <- ((nDigits + 2) %/% 3) - 1 
      if (nSuffix > length(suffixes)) stop(paste(x, "is too large!")) 
      trim(paste(Recall(makeNumber(digits[ 
       nDigits:(3*nSuffix + 1)])), 
       suffixes[nSuffix], 
       Recall(makeNumber(digits[(3*nSuffix):1])))) 
      } 
     } 
    trim <- function(text){ 
     gsub("^\ ", "", gsub("\ *$", "", text)) 
     }  


    makeNumber <- function(...) as.numeric(paste(..., collapse="")) 
    opts <- options(scipen=100) 
    on.exit(options(opts)) 
    ones <- c("", "one", "two", "three", "four", "five", "six", "seven", 

     "eight", "nine") 
    names(ones) <- 0:9 
    teens <- c("ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", 

     "sixteen", " seventeen", "eighteen", "nineteen") 
    names(teens) <- 0:9 
    tens <- c("twenty", "thirty", "forty", "fifty", "sixty", 
       "seventy", "eighty", "ninety") 
    names(tens) <- 2:9 
    x <- round(x) 
    suffixes <- c("thousand", "million", "billion", "trillion") 
    if (length(x) > 1) return(sapply(x, helper)) 
    helper(x) 
    } 

Answer 5

Otra solución usando Reduce de base.

list_df <- apply(numDF, 1, as.list) 
Reduce(function(x, l) gsub(l$symbol, l$text, x), list_df, init = x) 

EDIT. Aquí está la solución completa utilizando la función numbers2words directamente ..

list_df <- as.numeric(regmatches(x, gregexpr('[0-9]+', x))[[1]]) 
Reduce(function(x, l) gsub(l, numbers2words(l), x), list_df, init = x)