Подстановка ближайшего числа в ноль только для отрицательных чисел

#r #dplyr

Вопрос:

Я пытаюсь найти ближайшее к нулю число только среди отрицательных чисел. Когда все столбцы accident1:accident3 будут положительными, верните NA. Если все числа отрицательные, верните максимальное количество отрицательных чисел в accident1:accident3. Если присутствуют как положительные, так и отрицательные числа, возвращайте только наибольшее число ниже нуля (включая ноль).

Данные:

 df <- data.frame(id=1:4, accident1=c(-1,-1,3, NA), accident2=c(-5,100, 2, NA), accident3=c(-4,-3,1,NA))

> df
  id accident1 accident2 accident3
1  1        -1        -5        -4
2  2        -1       100        -3
3  3         3         2         1
4  4        NA        NA        NA
 

Попытка:

 df %>%
  rowwise() %>%
  mutate(magic=
           case_when(
             accident1 < 0 amp; accident2 < 0 amp; accident3 < 0 ~ as.numeric(pmax(accident1, accident2, accident3, na.rm=T)),
             accident1 > 0 amp; accident2 > 0 amp; accident3 > 0 ~ NA_real_,
             (accident1 >0 |accident2<0 |accident3<0) amp; (accident1 >0 |accident2>0 | accident3>0) ~ 
      # need max for cell <0
      as.numeric(pmax(accident1, accident2, accident3, na.rm=T)), TRUE~NA_real_))
 

Результат:

      id accident1 accident2 accident3 magic
  <int>     <dbl>     <dbl>     <dbl> <dbl>
1     1        -1        -5        -4    -1
2     2        -1       100        -3   100
3     3         3         2         1    NA
4     4        NA        NA        NA    NA
 

Желанный:

      id accident1 accident2 accident3 magic
  <int>     <dbl>     <dbl>     <dbl> <dbl>
1     1        -1        -5        -4    -1
2     2        -1       100        -3    -1
3     3         3         2         1    NA
4     4        NA        NA        NA    NA
 

Ответ №1:

Если вы преобразуете фрейм данных в длинный формат, вы можете сделать это немного более компактно. (Это также обобщается на любое количество типов аварий, отсутствующих типов аварий внутри id и т. Д….)

 sfun <- function(x) { 
   x <- na.omit(x)
   ## if x has no non-NA values, all(x>0) will be TRUE
   if (all(x>0))  NA_real_ else max(x[x<=0]) 
}
(df 
   ## convert to long format
   %>% pivot_longer(-id) 
   %>% group_by(id) 
   ## apply summary function to values within id
   %>% summarise(magic=sfun(value))
   ## add original columns back in 
   %>% full_join(df, by = "id")
)
 

Единственное отличие состоит в том, что magic столбец находится перед остальными данными, а не после них (вы можете добавить вызов relocate() , если хотите).

Ответ №2:

Используя sfun функцию из ответа @Ben Bolker, вы также можете сделать это, сохраняя данные в широком формате. Используя rowwise и. c_across

 library(dplyr)

sfun <- function(x) { 
  x <- na.omit(x)
  if (all(x>0))  NA_real_ else max(x[x<=0]) 
}

df %>%
  rowwise() %>%
  mutate(magic = sfun(c_across(starts_with('accident')))) %>%
  ungroup

#     id accident1 accident2 accident3 magic
#  <int>     <dbl>     <dbl>     <dbl> <dbl>
#1     1        -1        -5        -4    -1
#2     2        -1       100        -3    -1
#3     3         3         2         1    NA
#4     4        NA        NA        NA    NA