考虑到您提到的记录数量，
我在求和文本字符串的近似匹配以及从匹配的字符串中提取信息时遇到问题第一时间。
我有这样的数据：
text<-c("THEN it goes West","AT it falls East","it goes West", "it falls East", "AT it goes West")
date<-c(2008,2009,2003,2006,2011)
ID<-c(1,2,3,4,5)
data<-cbind(text,date,ID)
data<-as.data.frame(data)
请注意，最新的文本字符串的所有大写字母"THEN"one_answers"AT"都添加到了早期的文本字符串中。
我想要一张这样的桌子：
ID Sum Originaltext Originaldate
[1,] "4" "3" "it goes West" "2003"
[2,] "2" "2" "it falls East" "2006"
这包括：
与最早日期的文本(其他文本源自的"原始"文本)相对应的ID编号。每个的所有近似匹配的总和。与最早日期相对应的文本。以及与最早日期对应的文本的日期。
我有数以千万计的案例，所以我在自动化过程中遇到了困难。
我运行Windows7，可以访问快速计算服务器。
理想
#order them backwards in time
data<-data[order(data$date, decreasing = TRUE),]
#find the strings with the latest date
pattern<-"AT|THEN"
k <- vector("list", length(data$text))
for (j in 1:length(data$text)){
k[[j]]<- grep(pattern,data$text[[j]], ignore.case=FALSE)
}
k<-subset(data$text, k==1)
k<-unique(k)
#this is a problem, because case nos. 1 and 5 are still in the dataset, but they derive from the same tweet.
从这里开始，我可以使用"agrep"，但我不确定在什么上下文中。如有任何帮助，我们将不胜感激！
注意：虽然下面的三个答案确实按照我最初提出的方式回答了我的问题，但我没有提到，即使没有"AT"one_answers"THEN"这两个词，我的文本案例也会有所不同。事实上，它们中的大多数并不完全匹配。我应该把这个放在原来的问题里。然而，我仍然希望得到一个答案。
谢谢！
避免stringr的data.table解决方案。我相信这可以改进
处理文本数据
# make the factor columns character
.data <- lapply(data, function(x) if(is.factor(x)) {as.character(x)} else { x})
library(data.table)
DT <- as.data.table(.data)
DT[, original_text := text]
# using `%like% which is an easy data.table wrapper for grepl
DT[text %like% "^THEN", text := substr(text, 6, nchar(text))]
DT[text %like% "^AT", text := substr(text, 4, nchar(text))]
# or avoiding the two vector scans and replacing in one fell swoop
DT[,text := gsub('(^THEN )|(^AT )', '', text)]
DT[, c(sum=.N, .SD[which.min(date)]) ,by=text]
使用因子级别(可能更快)
# assuming that text is a factor
DTF <- as.data.table(data)
DTF[, original_text := text]
levels_text <- DTF[, levels(text)]
new_levels <- gsub('(^THEN )|(^AT )', x= levels_text ,'')
# reset the levels
setattr(DTF[['text']], 'levels', new_levels)
# coerce to character and do the same count / min date
DTF[, c(sum=.N, .SD[which.min(date)]) ,by=list(text = as.character(text))]
我会给你一个基本的解决方案，但我真的认为这对基本来说是一个大问题，data.table包是需要的(但我不知道如何很好地使用data.table：
dat <- data[order(data$date), ]
Trim <- function (x) gsub("^\s+|\s+$", "", x)
dat$text2 <- Trim(gsub("AT|THEN", "", dat$text))
dat2 <- split(dat, dat$text2)
FUN <- function(x) {
c(ID = x[1, 3], Sum = nrow(x), Original.Text = as.character(x[1, 1]),
Original.Date = as.character(x[1, 2]))
}
data.frame(do.call(rbind, lapply(dat2, FUN)), row.names = NULL)
我真的不知道每个文本字符串的接近程度，所以可能我的精确匹配不合适，但如果是这种情况，请使用agrep来开发一个新变量。很抱歉缺少注释，但我时间紧迫，我认为data.table更合适。
编辑：我仍然认为data.table更好，应该推出，但也许并行运行是明智的。你在一台windows机器上，所以这可以使用计算机的多个核心：
dat <- data[order(data$date), ]
Trim <- function (x) gsub("^\s+|\s+$", "", x)
dat$text2 <- Trim(gsub("AT|THEN", "", dat$text))
dat2 <- split(dat, dat$text2)
FUN <- function(x) {
c(ID = x[1, 3], Sum = nrow(x), Original.Text = as.character(x[1, 1]),
Original.Date = as.character(x[1, 2]))
}
library(parallel)
detectCores() #make sure you have > 1 core
cl <- makeCluster(mc <- getOption("cl.cores", detectCores()))
clusterExport(cl=cl, varlist=c("FUN", "dat2"), envir=environment())
x <- parLapply(cl, dat2, FUN)
stopCluster(cl) #stop the cluster
data.frame(do.call(rbind, x), row.names = NULL)
plyr可能太慢了，但这里有一个适合您的解决方案：
library(stringr)
data$original_text <- data$text
data$text[grep("^THEN", data$text)] <- str_trim(str_sub(data$text[grep("^THEN", data$text)],6))
data$text[grep("^AT", data$text)] <- str_trim(str_sub(data$text[grep("^AT", data$text)],4))
result <- ddply(data, .(text), function(x) {
sum <- nrow(x)
x <- x[which(x$date==min(x$date)),]
return(data.frame(id=unique(x$ID), Sum = sum, Originaltext = unique(x$original_text), Originaldate = unique(x$date)))
})
> result[, -1]
id Sum Originaltext Originaldate
1 4 2 it falls East 2006
2 3 3 it goes West 2003
如果您可以访问多核机器(4个或更多核)，那么这里有一个HPC解决方案
library(multicore)
library(stringr)
data$original_text <- data$text
data$text[grep("^THEN", data$text)] <- str_trim(str_sub(data$text[grep("^THEN", data$text)],6))
data$text[grep("^AT", data$text)] <- str_trim(str_sub(data$text[grep("^AT", data$text)],4))
fux <- function(foo) {
sum <- nrow(x)
x <- x[which(x$date==min(x$date)),]
return(data.frame(id=unique(x$ID), Sum = sum, Originaltext = unique(x$original_text), Originaldate = unique(x$date)))
}
x <- split(data, data$text)
result <- mclapply(x, fux, mc.cores = 4, mc.preschedule = TRUE)