Най-ефективният начин за преминаване през всяко наблюдение в кадър с данни

Опитвам се да намеря най-ефективния начин за преминаване през рамка от данни и клъстерни наблюдения по групи от 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