Как получить среднее значение ненулевых элементов по строкам, варьируя, какие столбцы используются условием - PullRequest
Новая
       30

Как получить среднее значение ненулевых элементов по строкам, варьируя, какие столбцы используются условием

4 голосов
/ 15 апреля 2019

Предположим, у меня есть следующая таблица данных: 

  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, который принимает среднее значение по строкам следующим образом.

  1. Для каждой строки найдите первый ненулевой элемент, идущий слева направо.
  2. Затем найдите среднее значение всех ненулевых элементов для ПРАВА этого.

Выходные данные должны быть: 

   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

НС возникают потому, что в 1: нет ненулевых элементов, а в 6: нет ненулевых элементов справа от первого ненулевого элемента.

Ответы [ 3 ]

2 голосов
/ 15 апреля 2019

Вот один из вариантов с 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 голосов
/ 15 апреля 2019

Используя apply построчно, мы можем сначала найти индексы в строке, которые не равны 0. Затем вычислим mean для ненулевых значений if есть хотя бы одно ненулевое значение и ненулевое значениенулевое значение отсутствует в последнем столбце else return NA. 

tempmat$TN <- apply(tempmat, 1, function(x) {
           inds <- x != 0
           if (any(inds) & 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
0 голосов
/ 15 апреля 2019

Вы можете выполнять итерации по столбцам, работая только в случае ненулевого значения и после первого ненулевого столбца в этой строке: 

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)][]
...