Введите значение из df на основе условия по нескольким столбцам в новую переменную

Question

Я уверен, что я не единственный, кто задал этот вопрос, но после долгих поисков без удачи мне нужно задать вопрос самому.

У меня есть df (rp) примерно так:

rp <- structure(list(agec1 = c(7, 16, 11, 11, 17, 17), 
               agec2 = c(6, 12, 9, 9, 16, 15), 
               agec3 = c(2, 9, 9, 9, 14, NA), 
               agec4 = c(NA, 7, 9, 9, 13, NA), 
               agec5 = c(NA, 4, 7, 7, 10, NA), 
               agec6 = c(NA, NA, 6, 6, 9, NA), 
               agec7 = c(NA, NA, NA, NA, 7, NA), 
               agec8 = c(NA, NA, NA, NA, 5, NA), 
          row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))

Где каждый obs в agecX относится к возрасту детей родителей до 8 детей. Я хотел бы создать новую колонку "agec5_12", которая содержит возраст самого старшего ребенка в возрасте 5-12 лет. Так что мой df будет выглядеть так:

rpage <- structure(list(agec1 = c(7, 16, 11, 11, 17, 17), 
               agec2 = c(6, 12, 9, 9, 16, 15), 
               agec3 = c(2, 9, 9, 9, 14, NA), 
               agec4 = c(NA, 7, 9, 9, 13, NA), 
               agec5 = c(NA, 4, 7, 7, 10, NA), 
               agec6 = c(NA, NA, 6, 6, 9, NA), 
               agec7 = c(NA, NA, NA, NA, 7, NA), 
               agec8 = c(NA, NA, NA, NA, 5, NA), 
               agec5_12 = c(7, 12, 11, 11, 10, NA))
          row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))

Примечания о моих данных:

• Возраст не всегда в одном и том же хронологическом порядке, то есть от младшего к старшему или от старшего к младшему
• Возможно, что в этом ряду не может быть детей в этом диапазоне (в таком случае я бы хотел, чтобы NA возвратили)

Я попытался написать функцию и применить ее, используя rowwise и mutate:

fun.age5_12 <- function(x){
                 x[which(x == max(x[(x > 4) & (x < 13)], na.rm = TRUE))]
                }
rpage <- rp %>%
         select(-c(20:21, 199:200)) %>%
         rowwise() %>% 
         mutate(agec5_12 = fun.age5_12(c(1:8)))

Однако, это возвращает все obs как "12". В идеале я хотел бы сделать это с помощью dplyr. Все предложения, использующие mutate или ifelse и не обязательно с функциями, подойдут.

Спасибо

Answer 1

Поскольку вы просили об этом, вот чистый dplyr способ сделать это -

max5_12 <- function(x) {
  a <- sort(x, decreasing = T)
  a[a >= 5 & a <= 12][1]
}

rp %>% 
  t() %>% 
  as.data.frame() %>% 
  bind_rows(
   summarise_all(., max5_12)
  ) %>% 
  t() %>% 
  as.data.frame() %>% 
  setNames(c(names(rp), "agec5_12"))

   agec1 agec2 agec3 agec4 agec5 agec6 agec7 agec8 agec5_12
V1     7     6     2    NA    NA    NA    NA    NA        7
V2    16    12     9     7     4    NA    NA    NA       12
V3    11     9     9     9     7     6    NA    NA       11
V4    11     9     9     9     7     6    NA    NA       11
V5    17    16    14    13    10     9     7     5       10
V6    17    15    NA    NA    NA    NA    NA    NA       NA

Answer 2

Я думаю, apply решение для такой проблемы всегда будет проще и более читабельным, чем решение dplyr (я полагаю, вы имели в виду tidyverse), но, поскольку вы спросили, есть один способ -

library(dplyr)
library(tidyr)

rp %>% 
  rownames_to_column("parent_id") %>% 
  gather(variable, value, -parent_id) %>% 
  group_by(parent_id) %>%
  arrange(parent_id, desc(value)) %>% 
  mutate(
    agec5_12 = value[between(value, 5, 12)][1]
  ) %>%
  ungroup() %>% 
  spread(variable, value) %>% 
  select(3:10, 2)

# A tibble: 6 x 9
  agec1 agec2 agec3 agec4 agec5 agec6 agec7 agec8 agec5_12
  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
1     7     6     2    NA    NA    NA    NA    NA        7
2    16    12     9     7     4    NA    NA    NA       12
3    11     9     9     9     7     6    NA    NA       11
4    11     9     9     9     7     6    NA    NA       11
5    17    16    14    13    10     9     7     5       10
6    17    15    NA    NA    NA    NA    NA    NA       NA

Answer 3

Еще одно базовое решение R. Мы можем использовать replace для замены чисел вне диапазона от 5 до 12, а затем использовать apply и function(x) ifelse(all(is.na(x)), NA, max(x, na.rm = TRUE)), чтобы найти максимум для каждой строки. Можно также рассмотреть возможность использования max напрямую, но для строк с элементами NA функция max вернет -Inf.

rp$agec5_12 <- apply(replace(rp, rp > 12 | rp < 5, NA), 1, 
                     function(x) ifelse(all(is.na(x)), NA, max(x, na.rm = TRUE)))

Или используйте do.call и pmax.

rp$agec5_12 <- do.call(pmax, c(replace(rp, rp > 12 | rp < 5, NA), na.rm = TRUE))

Вот сравнение производительности трех основных методов R. do.call с pmax кажется самым быстрым.

library(microbenchmark)

perf <- microbenchmark(
  m1 = {sapply(1:nrow(rp), function(i) {
  agec5_12 <- unlist(rp[i,], use.names = FALSE)
  agec5_12 <- agec5_12[agec5_12 >= 5 & agec5_12 <= 12 & !is.na(agec5_12)]
  if (length(agec5_12)) max(agec5_12) else NA_integer_
})},
  m2 = {
    apply(replace(rp, rp > 12 | rp < 5, NA), 1, 
          function(x) ifelse(all(is.na(x)), NA, max(x, na.rm = TRUE)))
  },
  m3 = {rp$agec5_12 <- do.call(pmax, c(replace(rp, rp > 12 | rp < 5, NA), na.rm = TRUE))
}, times = 1000L) 

perf
# Unit: microseconds
# expr     min       lq     mean  median       uq      max neval cld
#   m1 505.318 559.2935 860.3941 608.386 1231.937 9844.699  1000   b
#   m2 526.394 568.0325 831.6851 629.205 1207.262 4748.342  1000   b
#   m3 384.514 425.1250 635.3154 465.736  918.362 8992.393  1000  a 

DATA

rp <- data.frame(
  agec1 = c(7, 16, 11, 11, 17, 17), 
  agec2 = c(6, 12, 9, 9, 16, 15), 
  agec3 = c(2, 9, 9, 9, 14, NA), 
  agec4 = c(NA, 7, 9, 9, 13, NA), 
  agec5 = c(NA, 4, 7, 7, 10, NA), 
  agec6 = c(NA, NA, 6, 6, 9, NA), 
  agec7 = c(NA, NA, NA, NA, 7, NA), 
  agec8 = c(NA, NA, NA, NA, 5, NA)
) 

Answer 4

Самый простой способ для этого - использовать dplyr, purrr и tidyr:

library(dplyr)
library(purrr)
library(tidyr)
rp %>%
  mutate_at(vars(agec1:agec8), funs(ifelse(between(., 5, 12), ., NA))) %>%%
  group_by(id) %>%
  nest() %>%
  mutate(agec5_12 = map(data, max, na.rm = TRUE),
         agec5_12 = ifelse(agec5_12 == -Inf, NA, agec5_12)) %>%
  unnest()

Answer 5

Я знаю, что вы хотели Tidyverse, но вот один из основных способов R:

data.frame(
  agec1 = c(7, 16, 11, 11, 17, 17), 
  agec2 = c(6, 12, 9, 9, 16, 15), 
  agec3 = c(2, 9, 9, 9, 14, NA), 
  agec4 = c(NA, 7, 9, 9, 13, NA), 
  agec5 = c(NA, 4, 7, 7, 10, NA), 
  agec6 = c(NA, NA, 6, 6, 9, NA), 
  agec7 = c(NA, NA, NA, NA, 7, NA), 
  agec8 = c(NA, NA, NA, NA, 5, NA), 
  stringsAsFactors = FALSE
) -> rp

for (i in 1:nrow(rp)) {
  agec5_12 <- unlist(rp[i,], use.names = FALSE)
  agec5_12 <- agec5_12[agec5_12 >= 5 & agec5_12 <= 12 & !is.na(agec5_12)]
  rp[i, "agec5_12"] <- if (length(agec5_12)) max(agec5_12) else NA_integer_
}

rp
##   agec1 agec2 agec3 agec4 agec5 agec6 agec7 agec8 agec5_12
## 1     7     6     2    NA    NA    NA    NA    NA        7
## 2    16    12     9     7     4    NA    NA    NA       12
## 3    11     9     9     9     7     6    NA    NA       11
## 4    11     9     9     9     7     6    NA    NA       11
## 5    17    16    14    13    10     9     7     5       10
## 6    17    15    NA    NA    NA    NA    NA    NA       NA

for показывает идиому, но решение sapply() намного быстрее:

rp1$agec5_12 <- sapply(1:nrow(rp), function(i) {
  agec5_12 <- unlist(rp[i,], use.names = FALSE)
  agec5_12 <- agec5_12[agec5_12 >= 5 & agec5_12 <= 12 & !is.na(agec5_12)]
  if (length(agec5_12)) max(agec5_12) else NA_integer_
})