Помогите мне заменить цикл на функцию «Применить»

Question

... если это возможно

Моя задача - найти самую длинную серию непрерывных дней, в которых пользователь участвовал в игре.

Вместо того чтобы писать функцию sql, я решил использовать функцию rle R, чтобы получить самые длинные полосы, а затем обновить свою таблицу БД с результатами.

(прикрепленный) фрейм данных выглядит примерно так:

    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

Я попробовал следующее, чтобы получить на пользователя самую длинную полосу

# 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)))
}

К сожалению, этот цикл for занимает слишком много времени, и мне интересно, есть ли способ получить матрицу res с использованием функции из семейства "apply".

Заранее спасибо

Answer 1

Функции apply не всегда (или вообще не работают) быстрее, чем цикл for. Это остаток ассоциированного R с S-Plus (в последнем случае применяется быстрее, чем для). Единственное исключение - lapply, которое часто быстрее, чем for (потому что оно использует C-код). См. Этот связанный вопрос .

Таким образом, вы должны использовать apply в первую очередь для улучшения ясности кода, а не для повышения производительности.

Возможно, окажется полезной презентация Дирка о высокопроизводительных вычислениях . Другим подходом грубой силы является «компиляция точно в срок» с Ra вместо обычной версии R , которая оптимизирована для обработки for циклов.

[Редактировать:] Существует много способов достичь этого, и это ни в коем случае не лучше, даже если оно более компактно. Просто работа с вашим кодом, вот другой подход:

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

Вам, вероятно, нужно будет манипулировать выводом немного дальше.

Answer 2

РЕДАКТИРОВАТЬ: Исправлено. Первоначально я предполагал, что мне придется изменить большинство функций rle (), но оказалось, что для этого потребовалось всего несколько настроек.

Это не ответ о * apply методе, но мне интересно, не может ли это быть более быстрым подходом к процессу в целом. Как говорит Шейн, петли не так уж и плохи. И ... я редко показываю свой код кому-либо, поэтому я был бы рад услышать некоторую критику этого.

#Shane, I told you this was awesome
dat <- getSOTable("/880233/pomogite-mne-zamenit-tsikl-na-funktsiy-primenit", 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 3

другой вариант

# 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 4

Это было предложение Криса о том, как получить данные :

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)

Answer 5

Если у вас действительно длинный список данных, это может показаться проблемой кластеризации. Каждый кластер будет определяться пользователем и датируется с максимальным расстоянием разделения, равным единице. Затем получите самый большой кластер по пользователю. Я отредактирую это, если подумаю над конкретным методом.