# ggplot - 逐步在R中找到列表中最频繁的项目

## r plot title size (3)

``````   dat<-data.table(sample(1:50,10000,replace=T))
k<-1
correct <- 0  # total correct predictions
for (i in 2:(nrow(dat)-1)) {
correct <- correct + 1
}
}``````

``````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``````

``````startrow <- dat[,list(.I,.GRP),by=V1][.GRP==k+1]\$.I[1]
correct  <- rep(0L,length(v))
correct[1:(startrow-1)] <- 1L``````

``ct   <- dat[,ct:=1:.N,by=V1]\$ct``

1. 抓住第一个k值和他们的计数，直到`startrow``topk <- sort(tapply(ct[1:(startrow-1)],v[1:(startrow-1)],max))`
2. 请注意，第一项是加入top-k俱乐部的门槛： `thresh <- unname(topk[1])`
3. `startrow`循环到`length(v)` ，每当满足阈值时更新`correct` （这里是一个向量，而不是一个正在运行的总和）; 并且如果达到阈值并且价值还没有在俱乐部中，则更新最高k俱乐部。

``````ff <- function(dat){
vf   <- factor(dat\$V1)
v    <- as.integer(vf)
ct   <- dat[,ct:=1:.N,by=V1]\$ct
n    <- length(v)

ct <- setNames(ct,v)

startrow <- dat[,list(.I,.GRP),by=V1][.GRP==k+1]\$.I[1]
topk     <- sort(tapply(ct[1:(startrow-1)],v[1:(startrow-1)],max))
thresh   <- unname(topk[1])

correct  <- rep(0L,n)
correct[1:(startrow-1)] <- 1L
for (i in startrow:n) {
cti = ct[i]
if ( cti >= thresh ){
correct[i] <- 1L
if ( cti > thresh & !( names(cti) %in% names(topk) ) ){
topk    <- sort(c(cti,topk))[-1]
thresh  <- unname(topk[1])
}
}
}
sum(correct)
}``````

``````set.seed(1)
dat <- data.table(sample(1:50,10000,replace=T))
k   <- 5

f1(dat) # 1012
f3(dat) # 1015
ff(dat) # 1719``````

``````> benchmark(f3(dat),ff(dat),replications=10)[,1:5]
test replications elapsed relative user.self
1 f3(dat)           10    2.68    2.602      2.67
2 ff(dat)           10    1.03    1.000      1.03``````

``````# 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'))``````

``cum_ranks[8, 2]``

``dat[, .(V1, rank=sapply(1:length(V1), function(x) cum_ranks[x, V1[x]]))]``

[新解决方案]

``````library(dplyr)
fC1 <- function(dat){
dat1 <- tbl_df(dat) %>%
group_by(V1) %>%
mutate(count=row_number()-1)  %>%  ungroup() %>% slice(2:n()-1) %>%
filter(count!=0) %>%
mutate(z=cummax(count)) %>%
filter(count==z)
z <- dat1\$z
length(z)
}

set.seed(1234)
dat<-data.table(sample(1:5000, 100000, replace=T))
system.time(a1 <- fC1(dat))[3] #returns 120
elapsed
0.04
system.time(a3m <- f3m(dat, 1))[3] #returns 29, same to the Python result which runs about 60s
elapsed
89.72
system.time(a3 <- f3(dat, 1))[3] #returns 31.
elapsed
95.07 ``````

``````fC1_ <- function(dat){
b <- tbl_df(dat) %>%
group_by(V1) %>%
mutate(count=row_number()-1) %>%
ungroup()  %>%
mutate(L=cummax(count+1))# %>%
b1 <- b %>% slice(2:(n()-1)) %>%
group_by(L) %>%
slice(1) %>%
filter(count+1>=L& count>0)
b2 <- b %>% group_by(L) %>%
slice(1)  %>%
ungroup() %>%
select(-L)  %>%
mutate(L=count)
semi_join(b1, b2, by=c("V1", "L")) %>% nrow
}

set.seed(1234)
dat <- data.table(sample(1:50,10000,replace=T))
fC1_(dat)
#[1] 218
f3m(dat, 1)
#[1] 217
f3(dat, 1)
#[1] 218``````

``````set.seed(1234)
dat<-data.table(sample(1:5000, 100000, replace=T))
system.time(fC1_(dat))[3];fC1_(dat)
#elapsed
#   0.05
#[1] 29``````

``````#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
std::vector<int> countrank(std::vector<int> y, int k) {
std::vector<int> v(y.begin(), y.begin() + k);
std::make_heap(v.begin(), v.end());
std::vector<int> count(y.size());
for(int i=0; i < y.size(); i++){
if(y[i]==0){count[i]=0;}
else{
v.push_back(y[i]); std::push_heap(v.begin(), v.end());
std::pop_heap(v.begin(), v.end()); v.pop_back();
std::vector<int>::iterator it = std::find (v.begin(), v.end(), y[i]);
if (it != v.end()) {count[i]=1;};
}
}
return count;
}``````

`````` fCpp <- function(dat, k) {
dat1 <- tbl_df(dat) %>%
group_by(V1) %>%
mutate(count=row_number())
x <- dat1\$V1
y <- dat1\$count-1
z <- countrank(-y, k)
sum(z[2:(nrow(dat)-1)])
}``````

[ `f3, f3m`功能]

`f3`是来自@Marat Talipov， `f3m``f3m`的一些修改（虽然看起来是多余的）。

``````f3m <- function(dat, k){
n <- nrow(dat)
dat1 <- tbl_df(dat) %>%
group_by(V1) %>%
mutate(count=row_number())
x <- dat1\$V1
y <- dat1\$count
rank <- rep(NA, n)
tablex <- numeric(max(x))
for(i in 2:(n-1)){
if(y[i]==1){rank[i]=NA} #this condition was originally missing
else{
tablex[x[i-1]] = y[i-1]
rank[i]=match(x[i], order(tablex, decreasing = T))
}
}
rank <- rank[2:(n-1)]
sum(rank<=k, na.rm=T)
} ``````