Warunkowa wymiana gsub

Question

Mam dane tekstowe (w R) i chcę zamienić niektóre znaki na inne znaki w ramce danych. Pomyślałem, że byłoby to łatwe zadanie za pomocą strsplit na spacje i stworzyć wektor, który można następnie użyć dopasowania (% w%), które następnie można wkleić razem. Ale wtedy pomyślałem o interpunkcji. Nie ma spacji między ostatnim wyrazem zdania a interpunkcją na końcu.

Sądzę, że istnieje prawdopodobnie prostszy sposób osiągnięcia tego, czego chcę, niż zawiły bałagan, który staje się moim kodem. Byłbym wdzięczny za wskazówki dotyczące tego problemu.

#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) 

Oczekiwane rezultaty:

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

EDIT: I pierwotnie zatytułowany warunkową gsub to dlatego, że to, co wydaje się do mnie, chociaż nie ma udział gsub.

Answer 1

Może ten, zainspirowany odpowiedzi Josh O'Briena, to robi:

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

Rozwiązanie to wykorzystuje gsubfn w opakowaniu o tej samej nazwie:

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

można podzielić na granicach białych lub tekstu (który będzie pasował pomiędzy słowem i interpunkcji):

> 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"  "."  

Wtedy możesz zrobić swoje zamienniki.

Answer 4

To nie było dokładnie wiadomo, czy naprawdę chciał konwertować cyfry do ich odpowiedników alfa. Jeśli tak, to o wiele bardziej ogólna strategia. Istnieją (przynajmniej) dwie funkcje konwersji liczbowej na tekst w archiwach rhelp: Jim Lemon's digits2text i John Fox's numberstowords. Ja również przełączony na gregexpr dostać się do vectorized podejścia:

wycinanie i wklejanie Lemon's function from the HTML found here pracował z pudełka:

>  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." 

muszę zrobić kilka edycji z numberstowords ponieważ było kilka brakujących karetki że pomieszane parsowania (i to udaną wersję poniżej tej demonstracji:

>  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." 

funkcyjnego Fox edytowany od: 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

Inne rozwiązanie z wykorzystaniem Reduce z base.

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

EDYCJA. Oto kompletne rozwiązanie wykorzystujące bezpośrednio funkcję numbers2words ..

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