从R中的字符串中提取不同的单词

Question

我已经看到几个SO帖子似乎接近回答这个问题，但我不知道是否真的这样做请原谅我这是一个重复的帖子。 我有几十个字符串（这是数据框中的一列），包含不同的数字，通常写成单词但有时作为整数。 例如：

Three neonates with one adult

1 adult, ten neonates nearby

Two adults and six neonates

我的最终目标是能够从每个字符串中提取新生儿和成人的数量并获得以下内容：

data.frame(Adults=c(1,1,6), Neonates=c(3,10,6)

但是字符串中数字的数量和位置会有所不同。 我用gsub ， strsplit等看过的所有例子似乎只在用于替换，分割，提取等的模式在字符串中相同或保持在字符串中的恒定位置时才起作用。 因为我知道数字必须是c("one","two",...,"ten") ，我可以循环遍历每个字符串，然后遍历每个可能的数字，看看它是否存在于字符串，然后，如果存在，提取它并转换为数字。 但这似乎效率很低。

非常感激任何的帮助！！

Answer 1

一种可能的方法是使用来自stringr包的str_split和一个自定义函数来包装查找匹配和后期处理。 没有提到数据集大小因此无法测试/评论速度。

library(stringr) #for str_split

customFun = function(
strObj="Three neonates with one adult",
rootOne = "adult",
rootTwo = "neonate"){

#split string
discreteStr = str_split(strObj,pattern = "\\s+",simplify = TRUE)



#find indices of root words
rootOneIndex = grep(rootOne,discreteStr)
rootTwoIndex = grep(rootTwo,discreteStr)

#mapping vectors
charVec = c("one","two","three","four","five","six","seven","eight","nine","ten")
numVec = as.character(1:10)
names(numVec) = charVec

#match index neighbourhood ,-1/+1  and select first match
rootOneMatches = tolower(discreteStr[c(rootOneIndex-1,rootOneIndex+1)])
rootOneMatches = rootOneMatches[!is.na(rootOneMatches)]
rootOneMatches = head(rootOneMatches,1)


rootTwoMatches = tolower(discreteStr[c(rootTwoIndex-1,rootTwoIndex+1)])
rootTwoMatches = rootTwoMatches[!is.na(rootTwoMatches)]
rootTwoMatches = head(rootTwoMatches,1)

#check presence in mapping vectors
rootOneNum = intersect(rootOneMatches,c(charVec,numVec))
rootTwoNum = intersect(rootTwoMatches,c(charVec,numVec))

#final matches and numeric conversion
rootOneFinal = ifelse(!is.na(as.numeric(rootOneNum)),as.numeric(rootOneNum),as.numeric(numVec[rootOneNum]))
rootTwoFinal = ifelse(!is.na(as.numeric(rootTwoNum)),as.numeric(rootTwoNum),as.numeric(numVec[rootTwoNum]))

outDF = data.frame(strObj = strObj,adults = rootOneFinal,neonates = rootTwoFinal,stringsAsFactors=FALSE) 
return(outDF)
}

输出：

inputVec = c("Three neonates with one adult","1 adult, ten neonates nearby","Two adults and six neonates")
outputAggDF = suppressWarnings(do.call(rbind,lapply(inputVec,customFun)))

outputAggDF
#                         strObj adults neonates
#1 Three neonates with one adult      1        3
#2  1 adult, ten neonates nearby      1       10
#3   Two adults and six neonates      2        6

Answer 2

我能够得到最终结果，但我承认我的代码并不漂亮。

string1 <- c("Three neonates with one adult")
string2 <- c("1 adult, ten neonates nearby")
string3 <- c("Two adults and six neonates")
df <- rbind(string1, string2, string3)

#change all written words to numeric values
df <- tolower(df)
df <- ifelse(grepl("one", df), gsub("one", 1, df), df)
df <- ifelse(grepl("two", df), gsub("two", 2, df), df)
df <- ifelse(grepl("three", df), gsub("three", 3, df), df)
df <- ifelse(grepl("four", df), gsub("four", 4, df), df)
df <- ifelse(grepl("five", df), gsub("five", 5, df), df)
df <- ifelse(grepl("six", df), gsub("six", 6, df), df)
df <- ifelse(grepl("seven", df), gsub("seven", 7, df), df)
df <- ifelse(grepl("eight", df), gsub("eight", 8, df), df)
df <- ifelse(grepl("nine", df), gsub("nine", 9, df), df)
df <- ifelse(grepl("ten", df), gsub("ten", 10, df), df)


#extract number and the next two spaces (gets a or n for adult or neonates)
number_let <- gregexpr('[0-9]+..',df)
list_nl <- regmatches(df,number_let)

df <- as.data.frame(df)
new_df <- data.frame(matrix(unlist(list_nl), nrow=nrow(df), byrow=T))
> new_df
   X1   X2
1 3 n  1 a
2 1 a 10 n
3 2 a  6 n

new_df$X1 <- as.character(new_df$X1)
new_df$X2 <- as.character(new_df$X2)

#extract numeric values
FW <- data.frame(matrix(unlist(regmatches(new_df$X1,gregexpr('[0-9]+',new_df$X1))), nrow=nrow(df), byrow=T))
SW <- data.frame(matrix(unlist(regmatches(new_df$X2,gregexpr('[0-9]+',new_df$X2))), nrow=nrow(df), byrow=T))

new_df <- cbind(new_df, FW, SW)
colnames(new_df)[3:4] <- c("FW", "SW")

new_df$FW <- as.numeric(as.character(new_df$FW))
new_df$SW <- as.numeric(as.character(new_df$SW))

#get numeric value separated into neonates and adults
new_df$neonate_1 <- ifelse(grepl("n", new_df$X1), new_df$FW,0)
new_df$neonate_2 <- ifelse(grepl("n", new_df$X2), new_df$SW,0)
new_df$adult_1 <-ifelse(grepl("a", new_df$X1), new_df$FW,0)
new_df$adult_2 <- ifelse(grepl("a", new_df$X2), new_df$SW,0)

#total neonates and adults for each string
new_df$total_neo <- new_df$neonate_1 + new_df$neonate_2
new_df$total_adu <- new_df$adult_1 + new_df$adult_2

#extract the two final columns
Count <- new_df[,9:10]
colnames(Count) <- c("Neonates", "Adults")

> Count
  Neonates Adults
1        3      1
2       10      1
3        6      2

Answer 3

其他人的速度要快一点，但如果你感兴趣，这里的方法略有不同。

在我看来，主要的问题是更换"one" "two"等字符串，输入相当繁琐，高数字是不可能的。

strings <- c("Three neonates with one adult",
"1 adult, ten neonates nearby",
"Two adults and six neonates")

numbers <- c("one","two","three","four","five","six","seven","eight","nine","ten")

splitted <- unlist(strsplit(strings, split="[[:blank:] | [:punct:]]"))

ind_neon <- which((splitted == "neonates") | (splitted == "neonate"))
ind_adul <- which((splitted == "adults") | (splitted == "adult"))

neon <- tolower(splitted[ind_neon-1])
adul <- tolower(splitted[ind_adul-1])

neon2 <- as.numeric(neon)
neon2[is.na(neon2)] <- as.numeric(factor(neon[is.na(neon2)],
               levels=numbers,
               labels=(1:10)))

adul2 <- as.numeric(adul)
adul2[is.na(adul2)] <- as.numeric(factor(adul[is.na(adul2)],
                levels=numbers,
                labels=(1:10)))

adul2
# [1] 1 1 2
neon2
# [1]  3 10  6

Answer 4

肯定有更高效的选项，但这可以解决问题，如果将它们添加到模式向量中，可以使用更多数字。

library(stringr)
library(qdap)
library(tidyr)

带来数据

 v <- tolower(c("Three neonates with one adult",
           "1 adult, ten neonates nearby",
           "Two adults and six neonates"))

为模式分配单词和数字向量

words<- c("one","two","three","four","five","six","seven","eight","nine","ten")
nums <- seq(1, 10)
pattern <- c(words, nums)

提取并粘贴所有数字和类型

w <- paste(unlist(str_extract_all( v, paste(pattern, collapse="|"))),
           unlist(str_extract_all( v, "neonate|adult")))

使用qdap中的mutliple gsub将所有写入的数字替换为相应的整数

w <- mgsub(words, nums, w)
w <- do.call(rbind.data.frame, strsplit(w, " "))
names(w) <- c("numbers", "name")

生成rowid以便您可以传播数据。

w$row <- rep(1:(nrow(w)/2), each=2)
spread(w, name, numbers)[-c(1)]


#    adult neonate
#  1     1       3
#  2     1      10
#  3     2       6

Answer 5

strapply在gsubfn包允许，如下所示，以提取词语。 我找不到任何内置函数将单词转换为数字，反之亦然，但可能有其他用户创建的预构建函数。

> library(gsubfn)
> df <- data.frame(Text = c("Three neonates with one adult","1 adult, ten neonates nearby","Two adults and six neonates"))
> df
                           Text
1 Three neonates with one adult
2  1 adult, ten neonates nearby
3   Two adults and six neonates

> for(i in 1:nrow(df)){
+     
+     df$Adults[i] <- strapply(as.character(df$Text[i]), "(\\w+) adult*")
+     df$Neonates[i] <- strapply(as.character(df$Text[i]), "(\\w+) neonate*")
+     
+ }

> df
                           Text Adults Neonates
1 Three neonates with one adult    one    Three
2  1 adult, ten neonates nearby      1      ten
3   Two adults and six neonates    Two      six

Answer 6

这是一个简单的答案，只使用基础R而没有任何花哨的包装;-)

如果你只有1到10个新生儿/成年人，并且如果他们总是以X adult(s)和Y neonate(s) （即类别之前的数字Y neonate(s)出现在你的字符串中，那么它很简单：

df = data.frame(strings = c("Three neonates with one adult",
                            "1 adult, ten neonates nearby",
                            "Two adults and six neonates"))

littnums = c('one', 'two', 'three', 'four', 'five', 
             'six', 'seven', 'eight', 'nine', 'ten')
nums = 1:10

getnums = function(mystring, mypattern) {
  # split your string at all spaces
  mysplitstring = unlist(strsplit(mystring, split=' '))
  # The number you are looking for is before the pattern
  numBeforePattern = mysplitstring[grep(mypattern, mysplitstring) - 1]
  # Then convert it to a integer or, if it fails, translate it 
  ifelse(is.na(suppressWarnings(as.integer(numBeforePattern))), 
         nums[grep(tolower(numBeforePattern), littnums)], 
         as.integer(numBeforePattern))
}

df$Neonates = sapply(as.vector(df$strings), FUN=getnums, 'neonate')
df$Adults = sapply(as.vector(df$strings), FUN=getnums, 'adult')
df
#                         strings Neonates Adults
# 1 Three neonates with one adult        3      1
# 2  1 adult, ten neonates nearby       10      1
# 3   Two adults and six neonates        6      2

Answer 7

这是另一种方法

你的数据

S <- c("Three neonates with one adult", "1 adult, ten neonates nearby", "Two adults and six neonates")

dplyr和stringr方法

library(stringr)
library(dplyr)

searchfor <- c("neonates", "adult")         
words <- str_extract_all(S, boundary("word"))   # keep only words

接下来的这个声明会抢字之前的所有searchfor话，并保存为一个data.frame

chrnum <- as.data.frame(Reduce(cbind, lapply(searchfor, function(y) lapply(words, function(x) x[which(x %in% y)-1]))))

下一个语句将str_replace_all使用命名向量并转换为数字

replaced <- chrnum %>% 
              mutate_all(funs(as.numeric(str_replace_all(tolower(.), c("one" = "1", "two" = "2", "three" = "3", "four" = "4", "five" = "5", "six" = "6", "seven" = "7", "eight" = "8", "nine" = "9", "ten" = "10"))))) %>%
              setNames(searchfor)

注意您将收到有关强制NA值的警告

产量

  neonates adult
1        3     1
2       10     1
3        6    NA