Условная замена gsub - PullRequest
       16

Условная замена gsub

8 голосов
/ 02 января 2012

У меня есть текстовые данные (в R), и я хочу заменить некоторые символы другими символами во фрейме данных.Я подумал, что это будет простая задача, используя strsplit для пробелов и создать вектор, в котором я могу использовать сопоставление (% в%), которое затем можно вставить обратно вместе.Но потом я подумал о пунктуации.Между последним словом предложения и пунктуацией в конце нет пробела.

Я думаю, что, вероятно, есть более простой способ достичь того, чего я хочу, чем запутанный беспорядок, который становится моим кодом.Я был бы признателен за решение этой проблемы.

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

Желаемый результат:

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

РЕДАКТИРОВАТЬ: я первоначально дал право на этот условный gsub, потому что, что этомне кажется, хотя gsub не задействован.

Ответы [ 5 ]

8 голосов
/ 02 января 2012

Может быть, это, вдохновленное ответом Джоша О'Брайена, делает это:

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
6 голосов
/ 02 января 2012

В этом решении используется gsubfn в одноименной упаковке:

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."
4 голосов
/ 02 января 2012

Вы можете разделить пробел или границы слова (которые будут соответствовать слову и пунктуации):

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

Тогда вы можете сделать замену.

3 голосов
/ 03 января 2012

Другое решение с использованием Reduce из base.

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

EDIT. Вот полное решение, использующее функцию 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)
2 голосов
/ 02 января 2012

Было не совсем ясно, действительно ли вы хотели преобразовать цифры в их альфа-эквиваленты. Если это так, то здесь гораздо более общая стратегия. В архивах rhelp есть (как минимум) две функции преобразования чисел в текст: Джим Лемон digits2text и Джон Фокс numberstowords. Я также переключился на gregexpr, чтобы перейти к векторизованному подходу:

Вырезание и вставка Функция Лимона из HTML, найденная здесь работает из коробки:

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

Мне нужно было отредактировать числовые слова, потому что были некоторые пропущенные переводы строк, которые испортили синтаксический анализ (и я включаю успешную версию ниже этой демонстрации:

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

Функция Фокса отредактирована с: 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)
    }
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...