Самый эффективный способ перебора каждого наблюдения во фрейме данных

Я пытаюсь найти наиболее эффективный способ циклического просмотра фрейма данных и кластеризации наблюдений группами по 5 человек. Например, если у меня есть:

group <- c(1,2,3,4,5,6,7,8,9,10)
people <- c(1,2,3,4,4,3,2,1,2,3)
avg_age <- c(5,10,15,20,25,30,35,40,45,50)
data <- data.frame(group,people,age)

Это должно генерировать

   group people avg_age
1      1      1   5
2      2      2  10
3      3      3  15
4      4      4  20
5      5      4  25
6      6      3  30
7      7      2  35
8      8      1  40
9      9      1  45
10    10      2  50

Затем я хотел бы создать еще один «кластер» из групп, в котором будет не менее 5 человек, со средневзвешенным возрастом для «кластера». Но я хотел бы сделать это наиболее эффективным способом, просматривая набор данных и последовательно добавляя группы, пока не будет создан «кластер» по крайней мере из 5 человек. Тогда наши данные должны выглядеть так:

   group people age cluster tot_ppl avg_age
1      1      1   5       1       6   11.67
2      2      2  10       1       6   11.67
3      3      3  15       1       6   11.67
4      4      4  20       2       8    22.5
5      5      4  25       2       8    22.5
6      6      3  30       3       5      32
7      7      2  35       3       5      32
8      8      1  40       4       6   46.67
9      9      2  45       4       6   46.67
10    10      3  50       4       6   46.67

Я хотел бы сделать что-то подобное в наборе данных с примерно 10 000 наблюдений вместо 10. Кто-нибудь знает, как это сделать?

Вот что у меня есть на данный момент, однако для некоторых образцов данных, с которыми я работаю, на самом деле около 2 миллионов наблюдений, поэтому запуск может занять довольно много времени...

data$cluster <- 0
count=0

while (min(data$cluster)==0)
#while (max(data$cluster)<=10)
{
count = count+1
data$cum <- ave(data$people, by=list(data$zipcode,data$cluster), FUN=cumsum) 
data$a <- floor(data$cum/10)
data$b <- data$cum-data$n1
data$c <- floor(data$b/10)
data$cluster[data$c==0] = data$cluster[data$c==0]+1
}

extravars <- c('cum','a','b','c')
for (inc.source in extravars){
  eval(parse(text = paste("data$",inc.source,"<-NULL",sep="")))         
}

data$tot_ppl <- ave(data$people, by=list(data$zipcode,data$cluster), FUN=sum) 
data$cluster[data$tot_ppl<10]=data$cluster[data$tot_ppl<10]+1
data$tot_ppl <- ave(data$people, by=list(data$zipcode,data$cluster), FUN=sum)

data2 <- data


for (i in 3:(ncol(data2)-3)){
  data2$x <- data2[ ,i]*data2$tot_ppl
  data2$x <- ave(data2$x, by=list(data2$zipcode,data2$cluster), FUN=sum)
  data2$x <- round(data2$x/data2$tot_ppl,digits=2)
  data2[ ,i] = data2$x
}

data2$x <- NULL

Так что, хотя это работает, для запуска требуется несколько часов, поэтому, если кто-нибудь знает способ сделать это более эффективным или улучшить его, я был бы очень признателен. Спасибо!


r loops vectorization
person mjdub    schedule 14.10.2014    source источник
comment
Вы закодировали неэффективный способ? Если да, покажите, какой код вы уже пробовали. Действительно ли это занимает много времени с 10 000 наблюдений?   -  person MrFlick    schedule 15.10.2014

Ответы (1)


arrow_upward
1
arrow_downward

Я не могу придумать умный способ векторизации этой операции, поэтому вы можете просто использовать цикл for в R:

pureR <- function(x, lim) {
    cs <- cumsum(x)
    newGroup <- rep(FALSE, length(x))
    prevSum <- 0
    for (i in 1:length(newGroup)) {
        if (cs[i] - prevSum >= lim) {
            newGroup[i] <- TRUE
            prevSum <- cs[i]
        }
    }
    return(1+c(0, head(cumsum(newGroup), -1)))
}
pureR(dat$people, 5)
# [1] 1 1 1 2 2 3 3 4 4 4

Вы можете использовать пакет Rcpp для ускорения невекторизованных вычислений:

library(Rcpp)
rcpp <- cppFunction("
NumericVector rcpp(NumericVector x, const double limit) {
    NumericVector result(x.size());
    result[0] = 1;
    double acc = x[0];
    for (int i=1; i < x.size(); ++i) {
        if (acc >= limit) {
            result[i] = result[i-1] + 1;
            acc = x[i];
        } else {
            result[i] = result[i-1];
            acc += x[i];
        }
    }
    return result;
}
")
rcpp(dat$people, 5)
# [1] 1 1 1 2 2 3 3 4 4 4

Наконец, мы можем сравнить набор данных с 10 000 наблюдений:

set.seed(144)
dat2 <- dat[sample(1:nrow(dat), 10000, replace=TRUE),]
library(microbenchmark)
microbenchmark(pureR(dat2$people, 5), rcpp(dat2$people, 5))
# Unit: microseconds
#                   expr      min       lq     mean   median       uq       max neval
#  pureR(dat2$people, 5) 7073.571 7287.733 8665.394 7822.639 8749.232 31313.946   100
#   rcpp(dat2$people, 5)   90.309   98.241  129.120  118.351  136.210   324.866   100

Хотя код Rcpp более чем в 60 раз быстрее, чем чистая реализация R, чистая реализация R по-прежнему выполняется менее чем за 10 миллисекунд для набора данных размером 10 000, что, вероятно, вас устроит.

person josliber♦    schedule 15.10.2014