Aidez-moi pour remplacer une boucle avec une fonction « apply »

Question

... si cela est possible

Ma tâche est de trouver la plus longue série de jours consécutifs un utilisateur ont participé à un jeu. Au lieu d'écrire une fonction sql, j'ai choisi d'utiliser la fonction r de R, pour obtenir les plus longues séquences, puis mettre à jour ma table db avec les résultats.

Le (ci-joint) dataframe est quelque chose comme ceci:

day  user_id 
2008/11/01 2001 
2008/11/01 2002 
2008/11/01 2003 
2008/11/01 2004 
2008/11/01 2005 
2008/11/02 2001 
2008/11/02 2005 
2008/11/03 2001 
2008/11/03 2003 
2008/11/03 2004 
2008/11/03 2005 
2008/11/04 2001 
2008/11/04 2003 
2008/11/04 2004 
2008/11/04 2005 

J'ai essayé ce qui suit pour obtenir par la plus longue séquence utilisateur

# turn it to a contingency table 
my_table <- table(user_id, day) 

# get the streaks 
rle_table <- apply(my_table,1,rle) 

# verify the longest streak of "1"s for user 2001 
# as.vector(tapply(rle_table$'2001'$lengths, rle_table$'2001'$values, max)["1"]) 

# loop to get the results 
# initiate results matrix 
res<-matrix(nrow=dim(my_table)[1], ncol=2) 

for (i in 1:dim(my_table)[1]) { 
string <- paste("as.vector(tapply(rle_table$'", rownames(my_table)[i], "'$lengths, rle_table$'", rownames(my_table)[i], "'$values, max)['1'])", sep="") 
res[i,]<-c(as.integer(rownames(my_table)[i]) , eval(parse(text=string))) 
} 

Malheureusement, cette boucle est trop long et je me demandais si il existe un moyen de produire la matrice res en utilisant une fonction de la famille "apply".

Nous vous remercions à l'avance

Answer 1

une autre option

# convert to Date 
day_table$day <- as.Date(day_table$day, format="%Y/%m/%d") 
# split by user and then look for contiguous days 
contig <- sapply(split(day_table$day, day_table$user_id), function(.days){ 
    .diff <- cumsum(c(TRUE, diff(.days) != 1)) 
    max(table(.diff)) 
}) 

Answer 2

Les apply fonctions ne sont pas toujours (ou même généralement) plus rapidement qu'une boucle for. C'est un vestige de l'associé de R avec S-Plus (dans ce dernier, appliquer est plus rapide que pour). Une exception est lapply, qui est souvent plus rapide que for (car elle utilise le code C). See this related question.

Vous devriez donc utiliser apply principalement pour améliorer la clarté du code, pas pour améliorer les performances. Vous pouvez find Dirk's presentation on high-performance computing useful. Une autre approche par force brute est "just-in-time compilation" with Ra instead of the normal R version, qui est optimisée pour gérer les boucles for.

[Editer:] Il existe clairement plusieurs façons d'y parvenir, et ce n'est en aucun cas mieux, même si c'est plus compact. Il suffit de travailler avec votre code, voici une autre approche:

dt <- data.frame(table(dat))[,2:3] 
dt.b <- by(dt[,2], dt[,1], rle) 
t(data.frame(lapply(dt.b, function(x) max(x$length)))) 

Vous auriez probablement besoin de manipuler la sortie un peu plus loin.

Answer 3

EDIT: fixe. J'ai supposé à l'origine que je devrais modifier la plupart de rle(), mais il s'avère que seulement quelques ajustements étaient nécessaires.

Ce n'est pas une réponse à propos d'une méthode * apply, mais je me demande si ce n'est pas une approche plus rapide du processus global. Comme le dit Shane, les boucles ne sont pas si mauvaises. Et ... j'ai rarement l'occasion de montrer mon code à quelqu'un, donc je serais heureux d'entendre une critique de ceci.

#Shane, I told you this was awesome 
dat <- getSOTable("http://stackoverflow.com/questions/1504832/help-me-replace-a-for-loop-with-an-apply-function", 1) 
colnames(dat) <- c("day", "user_id") 
#Convert to dates so that arithmetic works properly on them 
dat$day <- as.Date(dat$day) 

#Custom rle for dates 
rle.date <- function (x) 
{ 
    #Accept only dates 
    if (class(x) != "Date") 
     stop("'x' must be an object of class \"Date\"") 
    n <- length(x) 
    if (n == 0L) 
     return(list(lengths = integer(0L), values = x)) 
    #Dates need to be sorted 
    x.sort <- sort(x) 
    #y is a vector indicating at which indices the date is not consecutive with its predecessor 
    y <- x.sort[-1L] != (x.sort + 1)[-n] 
    #i returns the indices of y that are TRUE, and appends the index of the last value 
    i <- c(which(y | is.na(y)), n) 
    #diff tells you the distances in between TRUE/non-consecutive dates. max gets the largest of these. 
    max(diff(c(0L, i))) 
} 

#Loop 
max.consec.use <- matrix(nrow = length(unique(dat$user_id)), ncol = 1) 
rownames(max.consec.use) <- unique(dat$user_id) 

for(i in 1:length(unique(dat$user_id))){ 
    user <- unique(dat$user_id)[i] 
    uses <- subset(dat, user_id %in% user) 
    max.consec.use[paste(user), 1] <- rle.date(uses$day) 
} 

max.consec.use 

Answer 4

Si vous avez une très longue liste de données, cela peut sembler être un problème de clustering. Chaque cluster serait défini par un utilisateur et les dates avec une distance de séparation maximale d'un. Récupérez ensuite le plus gros cluster par utilisateur. Je vais l'éditer si je pense à une méthode spécifique.

Answer 5

Ce fut Chris's suggestion for how to get the data:

dat <- read.table(textConnection(
"day  user_id 
2008/11/01 2001 
2008/11/01 2002 
2008/11/01 2003 
2008/11/01 2004 
2008/11/01 2005 
2008/11/02 2001 
2008/11/02 2005 
2008/11/03 2001 
2008/11/03 2003 
2008/11/03 2004 
2008/11/03 2005 
2008/11/04 2001 
2008/11/04 2003 
2008/11/04 2004 
2008/11/04 2005 
"), header=TRUE)