3

我无法对文本字符串的近似匹配求和，以及从第一次匹配的字符串中提取信息。

我有看起来像这样的数据：

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”和“AT”。

我想要一个看起来像这样的表：

     ID  Sum Originaltext     Originaldate
[1,] "4" "3" "it goes West"      "2003"      
[2,] "2" "2" "it falls East"     "2006"

这包括：

与最早日期的文本对应的ID号（其他文本源自的“原始”文本）。 每个的所有近似匹配的总和。与最早日期对应的文本。并且文本的日期与最早的日期相对应。

我有数千万个案例，所以我在自动化流程时遇到了麻烦。

我运行 Windows 7，并且可以访问快速计算服务器。

想法

#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”和“THEN”这两个词，我的文本案例也会有所不同。事实上，它们中的大多数并不完全匹配。我应该把它放在原来的问题中。但是，我仍然希望得到一个答案。

谢谢！

4

3 回答 3

4

一种data.table避免stringr. 我相信这可以改进

处理文本数据

# 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))]
于 2012-10-15T23:28:05.097 回答
1

我会给你一个基本的解决方案，但我真的认为这对 base 来说是一个大问题，并且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)
于 2012-10-15T21:36:37.777 回答
1

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)
于 2012-10-15T23:06:50.003 回答