逐步找到R中列表中最常见的项目

Jef*_*eff 6 optimization for-loop r time-series data.table

我想查看一个列表,然后检查该项是否是列表中最常用的项目.与Python相比,我目前拥有的解决方案非常慢.有没有一种有效的方法加快它?

   dat<-data.table(sample(1:50,10000,replace=T))
   k<-1
   correct <- 0  # total correct predictions
   for (i in 2:(nrow(dat)-1)) {
      if (dat[i,V1] %in% dat[1:(i-1),.N,by=V1][order(-N),head(.SD,k)][,V1]) {
         correct <- correct + 1
      }
   }
Run Code Online (Sandbox Code Playgroud)

更一般地说,我最终想看看一个项目是否是直到一个点之前最常见的k项之一,或者它是否具有直到某一点的k个最高值之一.

为了比较,这是Python中非常快速的实现:

dat=[random.randint(1,50) for i in range(10000)]
correct=0
k=1
list={}

for i in dat:
    toplist=heapq.nlargest(k,list.iteritems(),key=operator.itemgetter(1))
    toplist=[j[0] for j in toplist]
    if i in toplist:
        correct+=1
    if list.has_key(i):
        list[i]=list[i]+1
    else:
        list[i]=1
Run Code Online (Sandbox Code Playgroud)

arv*_*000 2

这个解决方案怎么样:

# unique values
unq_vals <- sort(dat[, unique(V1)])

# cumulative count for each unique value by row
cum_count <- as.data.table(lapply(unq_vals, function(x) cumsum(dat$V1==x)))

# running ranking for each unique value by row
cum_ranks <- t(apply(-cum_count, 1, rank, ties.method='max'))
Run Code Online (Sandbox Code Playgroud)

现在(例如)第 8 个观察的第二个唯一值的排名存储在:

cum_ranks[8, 2]
Run Code Online (Sandbox Code Playgroud)

您可以像这样按行获取每个项目的排名(并将其呈现在可读的表格中)。如果rank第 i 行 <= k,则 的第 i 个项目V1属于观察 i 的第 k 个最频繁的项目。

dat[, .(V1, rank=sapply(1:length(V1), function(x) cum_ranks[x, V1[x]]))]
Run Code Online (Sandbox Code Playgroud)

第一个代码块在我的机器上只花费了 0.6883929 秒(根据粗略的now <- Sys.time(); [code block in here]; Sys.time() - now计时),dat <- data.table(sample(1:50, 10000, replace=T))