Укажите количество последовательных значений
У меня есть почасовая ценность. Я хочу подсчитать, сколько последовательных часов это значение было нулевым с тех пор, как последний раз он не был равен нулю. Это простая работа для электронной таблицы или цикла, но я надеюсь на быстрый векторный однострочный набор для выполнения задачи.
x <- c(1, 0, 1, 0, 0, 0, 1, 1, 0, 0) df <- data.frame(x, zcount = NA) df$zcount[1] <- ifelse(df$x[1] == 0, 1, 0) for(i in 2:nrow(df)) df$zcount[i] <- ifelse(df$x[i] == 0, df$zcount[i - 1] + 1, 0) Желаемый результат:
R> df x zcount 1 1 0 2 0 1 3 1 0 4 0 1 5 0 2 6 0 3 7 1 0 8 1 0 9 0 1 10 0 2
- Интерпретация "имеет длину> 1" предупреждение от функции `if`
- cbind a df с пустым df (cbind.fill?)
- Как увидеть исходный код функции R .Internal или .Primitive?
- Извлечение элементов, общих во всех группах столбцов
- Как проверить, вызывает ли вызов функции предупреждение?
- Как суммировать числовые элементы списка
- Условно удалить строки Dataframe с R
- Найдите, сколько раз повторяющиеся строки повторяются в кадре данных R
- Создание вектора, разделенного запятыми
- Стандартный способ удаления нескольких элементов из фрейма данных
- как вернуть число десятичных знаков в R
- Создать имя переменной с «вставкой» в R?
- Есть ли такой «colsd» в R?
Вот путь, rle на rle подходе Джошуа: (EDITED использует seq_len и lapply в соответствии с предложением Марека)
> (!x) * unlist(lapply(rle(x)$lengths, seq_len)) [1] 0 1 0 1 2 3 0 0 1 2
ОБНОВЛЕНИЕ . Просто для пинков, вот еще один способ сделать это, примерно в 5 раз быстрее:
cumul_zeros <- function(x) { x <- !x rl <- rle(x) len <- rl$lengths v <- rl$values cumLen <- cumsum(len) z <- x # replace the 0 at the end of each zero-block in z by the # negative of the length of the preceding 1-block.... iDrops <- c(0, diff(v)) < 0 z[ cumLen[ iDrops ] ] <- -len[ c(iDrops[-1],FALSE) ] # ... to ensure that the cumsum below does the right thing. # We zap the cumsum with x so only the cumsums for the 1-blocks survive: x*cumsum(z) }
Попробуйте пример:
> cumul_zeros(c(1,1,1,0,0,0,0,0,1,1,1,0,0,1,1)) [1] 0 0 0 1 2 3 4 5 0 0 0 1 2 0 0
Теперь сравните время на миллионном векторе:
> x <- sample(0:1, 1000000,T) > system.time( z <- cumul_zeros(x)) user system elapsed 0.15 0.00 0.14 > system.time( z <- (!x) * unlist( lapply( rle(x)$lengths, seq_len))) user system elapsed 0.75 0.00 0.75
Мораль истории: однострочники лучше и понятнее, но не всегда самые быстрые!
Посты Уильяма Дунлапа по R-help – это место, где можно искать все вещи, связанные с длинами прогона. Его f7 из этого сообщения
f7 <- function(x){ tmp<-cumsum(x);tmp-cummax((!x)*tmp)}
и в текущей ситуации f7(!x) . С точки зрения производительности есть
> x <- sample(0:1, 1000000, TRUE) > system.time(res7 <- f7(!x)) user system elapsed 0.076 0.000 0.077 > system.time(res0 <- cumul_zeros(x)) user system elapsed 0.345 0.003 0.349 > identical(res7, res0) [1] TRUE
rle будет «подсчитывать, сколько последовательных часов это значение было нулевым, поскольку последний раз это был не ноль», но не в формате вашего «желаемого выхода».
Обратите внимание на длины для элементов, где соответствующие значения равны нулю:
rle(x) # Run Length Encoding # lengths: int [1:6] 1 1 1 3 2 2 # values : num [1:6] 1 0 1 0 1 0
Однострочный, не совсем супер элегантный:
x <- c(1, 0, 1, 0, 0, 0, 1, 1, 0, 0) unlist(lapply(split(x, c(0, cumsum(abs(diff(!x == 0))))), function(x) (x[1] == 0) * seq(length(x))))