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」を使用できますが、どのコンテキストで使用できるかわかりません。どんな助けでも大歓迎です！

注：以下の3つの回答は、最初に尋ねた方法で私の質問に答えますが、「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

基本ソリューションを提供しますが、これは基本にとって大きな問題であり、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 に答える