#r #dplyr #count
#r #dplyr #количество
Вопрос:
Для примера у меня есть простой фрейм данных, который представляет собой набор столбцов идентификаторов и значений 0 или 1:
data.frame(replicate(10,sample(0:1,1000,rep=TRUE)))
X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1 1 1 0 1 0 0 1 1 1 0
2 0 0 0 1 0 1 0 0 1 0
3 0 1 1 1 1 0 1 1 1 1
4 0 0 0 1 1 1 1 1 1 0
5 1 0 1 0 1 1 0 1 1 0
6 0 1 1 1 1 1 0 1 1 1
Я хочу написать код или цикл, который для каждого столбца подсчитывает количество 0, пока не встретит еще 1, и продолжает движение по столбцу. Таким образом, в идеале результатом является новый фрейм данных с тем же заголовком столбца ID и списком подсчетов:
X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1 3 1 2 1 2 1 1 1 NA 2
2 1 2 1 1 NA 1 2 NA NA 2
Я не уверен, как это сделать, а также результат строки может быть разной длины. Если каждый столбец должен создавать новый фрейм данных, это нормально.
Комментарии:
1. Используйте
set.seed()так, чтобы ваш data.frame был воспроизводимым.
Ответ №1:
Вот базовое решение R. Я использовал пример размера 10 вместо примера размера 1000, чтобы мы могли видеть, что происходит, и убедиться, что это выглядит правильно.
set.seed(47)
d = data.frame(replicate(10,sample(0:1,10,rep=TRUE)))
d
# X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
# 1 0 0 0 0 0 0 1 1 0 0
# 2 0 1 0 1 0 0 0 0 0 0
# 3 1 1 1 0 1 0 0 0 1 0
# 4 0 0 0 0 0 1 1 1 1 1
# 5 1 1 0 1 0 0 1 1 1 0
# 6 0 1 1 1 1 1 1 1 0 1
# 7 1 1 0 0 1 0 0 1 1 0
# 8 0 0 1 0 1 0 1 0 0 0
# 9 0 0 0 1 1 1 0 0 1 1
# 10 1 1 1 0 1 0 1 1 0 0
results = lapply(d, function(x) with(rle(x), lengths[values == 0]))
max_length = max(lengths(results))
results = lapply(results, function(x) {length(x) = max_length; x})
results = do.call(cbind, results)
results
# X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
# [1,] 2 1 2 1 2 3 2 2 2 3
# [2,] 1 1 2 2 2 1 1 2 1 1
# [3,] 1 2 1 2 NA 2 1 NA 1 2
# [4,] 2 NA 1 1 NA 1 NA NA 1 1
Комментарии:
1. Может сократить шаги 3 и 4 до:
sapply(results,"[", 1:max_length)2. Я пытался придумать способ сделать это, но я думаю, что буду придерживаться более подробной версии для ясности. Спасибо за совет!
Ответ №2:
Один dplyr и purrr вариант может быть:
map(.x = names(df),
~ df %>%
mutate(rleid = with(rle(get(.x)), rep(seq_along(lengths), lengths))) %>%
filter(get(.x) == 0) %>%
group_by(rleid = cumsum(!duplicated(rleid))) %>%
summarise(!!.x := n())) %>%
reduce(full_join, by = c("rleid" = "rleid"))
rleid X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
<int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
1 1 1 1 2 2 9 2 3 4 1 1
2 2 1 1 NA 3 NA 1 1 2 1 1
3 3 1 3 NA NA NA 2 1 NA 2 2
4 4 1 NA NA NA NA 1 NA NA 1 2
Пример данных:
set.seed(123)
df <- data.frame(replicate(10, sample(0:1, 10, rep = TRUE)))
X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1 0 1 1 1 0 0 1 1 0 0
2 1 0 1 1 0 0 0 1 1 1
3 0 1 1 1 0 1 0 1 0 0
4 1 1 1 1 0 0 0 0 1 1
5 1 0 1 0 0 1 1 0 0 0
6 0 1 1 0 0 0 0 0 0 0
7 1 0 1 1 0 0 1 0 1 1
8 1 0 1 0 0 1 1 1 1 0
9 1 0 0 0 0 1 1 0 1 0
10 0 1 0 0 1 0 0 0 0 1
Ответ №3:
Вот альтернативный подход, который использует индексы 1 значений для определения нулевых пробегов (используя данные Грегора):
library(purrr)
map(df, ~ {
y <- diff(c(0, which(.x == 1), nrow(df) 1)) - 1
y[y != 0]
}) %>%
map_df(`length<-`, max(lengths(.)))
# A tibble: 4 x 10
X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 2 1 2 1 2 3 2 2 2 3
2 1 1 2 2 2 1 1 2 1 1
3 1 2 1 2 NA 2 1 NA 1 2
4 2 NA 1 1 NA 1 NA NA 1 1
Или то же самое в базе R:
res <- lapply(df, function(x) {
y <- diff(c(0, which(x == 1), nrow(df) 1)) - 1
y[y != 0]})
data.frame(do.call(cbind, lapply(res, `length<-`, max(lengths(res)))))