#r #dplyr #data.table #boolean #aggregate
#r #dplyr #data.table #логическое #агрегировать
Вопрос:
Предположим, у меня есть следующая таблица данных:
tempmat=matrix(c(1,1,0,4,1,0,0,4,0,1,0,4, 0,0,1,4, 0,0,0,5),5,4,byrow=T)
tempmat=rbind(rep(0,4),tempmat)
tempmat=data.table(tempmat)
names(tempmat)=paste0('prod1vint',1:4)
Что выглядит так:
prod1vint1 prod1vint2 prod1vint3 prod1vint4
1: 0 0 0 0
2: 1 1 0 4
3: 1 0 0 4
4: 0 1 0 4
5: 0 0 1 4
6: 0 0 0 5
Я хочу определить новый столбец, TN, который принимает среднее значение по строкам следующим образом.
- Для каждой строки найдите первый ненулевой элемент, идущий слева направо.
- Затем найдите среднее значение всех ненулевых элементов СПРАВА от этого.
Вывод должен быть:
prod1vint1 prod1vint2 prod1vint3 prod1vint4 TN
1: 0 0 0 0 NA
2: 1 1 0 4 2.5
3: 1 0 0 4 4
4: 0 1 0 4 4
5: 0 0 1 4 4
6: 0 0 0 5 NA
NA возникают потому, что в 1: нет ненулевых элементов, а в 6: нет ненулевых элементов справа от первого ненулевого элемента.
Комментарии:
1. может быть:
tempmat[, TN := mean(unlist(.SD)[abs(.SD)>0][-1L]), by=tempmat[, seq_len(.N)]]? но если вам нужна скорость, вы можете рассмотреть Rcpp
Ответ №1:
Вот один из вариантов с melt
library(data.table)
library(dplyr)
TN <- melt(tempmat[, rid := seq_len(.N)], id.var = 'rid')[,
{i1 <- cumsum(value) > 0
mean(na_if(value[i1][-1], 0), na.rm = TRUE)}, rid]$V1
tempmat[, TN := TN][]
Или используя tidyverse
library(tidyverse)
tempmat %>%
mutate(TN = pmap(., ~ c(...) %>%
keep(., cumsum(.) > 0) %>%
tail(-1) %>%
na_if(0) %>%
mean(na.rm = TRUE)))
Или другой вариант — транспонировать набор данных, а затем выполнить операцию colwise
t(tempmat) %>%
as.data.frame %>%
summarise_all(list(~ mean(na_if(.[cumsum(.) > 0], 0)[-1],
na.rm = TRUE))) %>%
unlist %>%
mutate(tempmat, TN = .)
Или используя векторизованный подход
library(matrixStats)
m1 <- rowCumsums(as.matrix(tempmat)) > 0
m1[cbind(seq_len(nrow(m1)), max.col(m1, 'first'))] <- FALSE
rowMeans(na_if(tempmat * NA^!m1, 0), na.rm = TRUE)
Или используя apply
apply(tempmat, 1, FUN = function(x)
mean(na_if(x[cumsum(x) > 0], 0)[-1], na.rm = TRUE))
Ответ №2:
Используя apply по строкам, мы можем сначала найти индексы в строке, которые не равны 0. Затем вычислите mean для ненулевых if значений, по крайней мере, одно ненулевое значение, а ненулевое значение отсутствует в последнем else возврате столбца NA .
tempmat$TN <- apply(tempmat, 1, function(x) {
inds <- x != 0
if (any(inds) amp; which.max(inds) != length(x))
mean(Filter(function(f) f > 0, x[(which.max(inds) 1) : length(x)]))
else
NA
})
tempmat
# prod1vint1 prod1vint2 prod1vint3 prod1vint4 TN
#1: 0 0 0 0 NA
#2: 1 1 0 4 2.5
#3: 1 0 0 4 4.0
#4: 0 1 0 4 4.0
#5: 0 0 1 4 4.0
#6: 0 0 0 5 NA
Комментарии:
1. Интересно, вы думаете, что может быть что-то более эффективное, чем подход apply? Я считаю, что apply не особенно хорошо масштабируется.
Ответ №3:
Вы можете перебирать столбцы, работая только при ненулевом значении и после первого ненулевого столбца в этой строке:
DT[, `:=`(n = 0L, s = 0, v = NA_real_)]
for (k in sprintf("prod1vint%s", 1:4))
DT[get(k) != 0, `:=`(s = s (n > 0)*get(k), n = n 1L)]
DT[n > 1L, v := s/(n - 1)][]
prod1vint1 prod1vint2 prod1vint3 prod1vint4 n s v
1: 0 0 0 0 0 0 NA
2: 1 1 0 4 3 5 2.5
3: 1 0 0 4 2 4 4.0
4: 0 1 0 4 2 4 4.0
5: 0 0 1 4 2 4 4.0
6: 0 0 0 5 1 0 NA
Поскольку это векторизовано, не принуждает к матрице и работает выборочно, я ожидаю, что это довольно эффективно. get Часть неудобна. но этого можно было бы избежать, например…
DT[, `:=`(n = 0L, s = 0, v = NA_real_)]
for (k in sprintf("prod1vint%s", 1:4)){
expr = substitute(DT[k != 0, `:=`(s = s (n > 0)*k, n = n 1L)], list(k = as.name(k)))
eval(expr)
}
DT[n > 1L, v := s/(n - 1)][]