Изменение нескольких столбцов с помощью фреймворка dplyr

У меня есть датафрейм apcd_hud_ex. Я хочу взять некоторые имена столбцов (например, x2014_03_15) и изменить значение столбцов на основе текущего значения столбцов, проанализированной даты в именах столбцов и другого столбца в фрейме данных (SMOKEFREE_DATE). Я могу сделать это в цикле по столбцам, но мне очень хотелось бы знать, как это сделать с помощью dplyr и мутировать. Любая помощь приветствуется!

apcd_hud_ex = structure(list(studyid = 1:5, SMOKEFREE_DATE = structure(c(16283, 
16283, 16071, 16071, 16648), class = "Date"), x2014_03_15 = c(1, 
1, 1, 0, 1), x2014_04_15 = c(1, 1, 1, 1, 1), x2014_05_15 = c(1, 
1, 1, 1, 1), x2014_06_15 = c(1, 1, 1, 1, 1), x2014_07_15 = c(1, 
1, 1, 1, 1), x2014_08_15 = c(1, 1, 1, 1, 1), x2014_09_15 = c(1, 
1, 1, 1, 1), x2014_10_15 = c(1, 1, 1, 1, 1), x2014_11_15 = c(1, 
1, 1, 1, 1), x2014_12_15 = c(1, 1, 1, 1, 1), x2015_01_15 = c(1, 
1, 1, 1, 1)), row.names = c(NA, -5L), class = c("tbl_df", "tbl", 
"data.frame"))

> apcd_hud_ex
# A tibble: 5 x 13
  studyid SMOKEFREE_DATE x2014_03_15 x2014_04_15 x2014_05_15 x2014_06_15 x2014_07_15 x2014_08_15 x2014_09_15 x2014_10_15
    <int> <date>               <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>
1       1 2014-08-01               1           1           1           1           1           1           1           1
2       2 2014-08-01               1           1           1           1           1           1           1           1
3       3 2014-01-01               1           1           1           1           1           1           1           1
4       4 2014-01-01               0           1           1           1           1           1           1           1
5       5 2015-08-01               1           1           1           1           1           1           1           1
# ... with 3 more variables: x2014_11_15 <dbl>, x2014_12_15 <dbl>, x2015_01_15 <dbl>
>


#function for loop
assign_PHRes_enrollIns_fn <- function(SFdate,insValue,insDate){
  val = if_else(insValue == 0,
                0,
                if_else(as.Date(insDate) < as.Date(SFdate,"%Y-%m-%d"),
                        1,
                        2))
  return(val)
}

#vectorized function
assign_PHRes_enrollIns_fn_vec <- Vectorize(assign_PHRes_enrollIns_fn)

dateCols = names(apcd_hud_ex)[which(names(apcd_hud_ex) == "x2014_03_15"):which(names(apcd_hud_ex) == "x2015_01_15")]

Этот цикл по именам столбцов (dateCols) работает:

for(i in 1:length(dateCols)){
  dateCol = dateCols[i]
  insDate = as.Date(paste0(str_sub(dateCol,2,5),"/",str_sub(dateCol,7,8),"/",str_sub(dateCol,10,11)),"%Y/%m/%d")
  apcd_hud_ex[,dateCol] = assign_PHRes_enrollIns_fn_vec(apcd_hud_ex[,"SMOKEFREE_DATE"],apcd_hud_ex[,dateCol],insDate)
}

Теперь обработанный фрейм данных выглядит так, как я и хочу:

> apcd_hud_ex
# A tibble: 5 x 13
  studyid SMOKEFREE_DATE x2014_03_15 x2014_04_15 x2014_05_15 x2014_06_15 x2014_07_15 x2014_08_15 x2014_09_15 x2014_10_15
    <int> <date>               <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>
1       1 2014-08-01               1           1           1           1           1           2           2           2
2       2 2014-08-01               1           1           1           1           1           2           2           2
3       3 2014-01-01               2           2           2           2           2           2           2           2
4       4 2014-01-01               0           2           2           2           2           2           2           2
5       5 2015-08-01               1           1           1           1           1           1           1           1
# ... with 3 more variables: x2014_11_15 <dbl>, x2014_12_15 <dbl>, x2015_01_15 <dbl>

Однако я хотел бы узнать, как это сделать с помощью динамического программирования и dplyr. Я пробовал 2 функции:

newInsValCols_fn1 <- function(df,dateCols){
  insDate = as.Date(paste0(str_sub(dateCols,2,5),"/",str_sub(dateCols,7,8),"/",str_sub(dateCols,10,11)),"%Y/%m/%d")

  df1 <- df %>%
    mutate({{dateCols}} := if_else({{dateCols}} == 0,
                                   0,
                                   if_else(as.Date(insDate) < as.Date(SMOKEFREE_DATE,"%Y-%m-%d"),
                                           1,
                                           2)))
 return(df1)
} 
newInsValCols_fn1(apcd_hud_ex,dateCols)

Что дает ошибку:

 Error: The LHS of `:=` must be a string or a symbol

Итак, я попытался использовать символы:

newInsValCols_fn2 <- function(df,dateCols){
  dateCols_syms = syms(dateCols)
  insDate = as.Date(paste0(str_sub(dateCols,2,5),"/",str_sub(dateCols,7,8),"/",str_sub(dateCols,10,11)),"%Y/%m/%d")
  df1 <- df %>%
    mutate(!!dateCols_syms := if_else({{dateCols}} == 0,
                                      0,
                                      if_else(as.Date(insDate) < as.Date(SMOKEFREE_DATE,"%Y-%m-%d"),
                                              1,
                                              2)))
  return(df1)
} 
newInsValCols_fn2(apcd_hud_ex,dateCols)

который дает ту же ошибку:

Error: The LHS of `:=` must be a string or a symbol

Я также пробовал использовать !!! вместо !!, но это привело к следующей ошибке:

 Error: The LHS of `:=` can't be spliced with `!!!`

Чего-то в моем понимании не хватает.

Динамическое программирование относится к процессу решения более крупной проблемы путем рекурсивного решения более мелких подзадач. Это не тот случай здесь.

danlooo 05.05.2022 16:26

@danlooo Любые предложения о том, как изменить терминологию поста?

abra 05.05.2022 17:13

Используйте только: изменяйте несколько столбцов с помощью фреймворка dplyr.

danlooo 05.05.2022 18:07
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
2
3
64
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Вот как бы я это сделал с dplyr.

library(dplyr)
library(lubridate)

apcd_hud_ex %>%
  mutate(across(
    starts_with('x'),
    ~ case_when(. == 0 ~ 0,
                ymd(gsub('x', '', cur_column())) < SMOKEFREE_DATE ~ 1,
                TRUE ~ 2)
  ))

#> # A tibble: 5 x 13
#>   studyid SMOKEFREE_DATE x2014_03_15 x2014_04_15 x2014_05_15 x2014_06_15 x2014_07_15 x2014_08_15 x2014_09_15 x2014_10_15 x2014_11_15 x2014_12_15 x2015_01_15
#>     <int> <date>               <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>
#> 1       1 2014-08-01               1           1           1           1           1           2           2           2           2           2           2
#> 2       2 2014-08-01               1           1           1           1           1           2           2           2           2           2           2
#> 3       3 2014-01-01               2           2           2           2           2           2           2           2           2           2           2
#> 4       4 2014-01-01               0           2           2           2           2           2           2           2           2           2           2
#> 5       5 2015-08-01               1           1           1           1           1           1           1           1           1           1           1
Ответ принят как подходящий

Вы можете использовать pivot_longer, чтобы изменить только один столбец, что является альтернативой mutate(across()).

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

library(tidyverse)

apcd_hud_ex <- structure(list(studyid = 1:5, SMOKEFREE_DATE = structure(c(
  16283,
  16283, 16071, 16071, 16648
), class = "Date"), x2014_03_15 = c(
  1,
  1, 1, 0, 1
), x2014_04_15 = c(1, 1, 1, 1, 1), x2014_05_15 = c(
  1,
  1, 1, 1, 1
), x2014_06_15 = c(1, 1, 1, 1, 1), x2014_07_15 = c(
  1,
  1, 1, 1, 1
), x2014_08_15 = c(1, 1, 1, 1, 1), x2014_09_15 = c(
  1,
  1, 1, 1, 1
), x2014_10_15 = c(1, 1, 1, 1, 1), x2014_11_15 = c(
  1,
  1, 1, 1, 1
), x2014_12_15 = c(1, 1, 1, 1, 1), x2015_01_15 = c(
  1,
  1, 1, 1, 1
)), row.names = c(NA, -5L), class = c(
  "tbl_df", "tbl",
  "data.frame"
))

apcd_hud_ex %>%
  pivot_longer(starts_with("x")) %>%
  mutate(
    insDate = name %>% str_remove("^x") %>% str_replace_all("_", "-") %>% as.Date(),
    value = case_when(
      value == 0 ~ 0,
      insDate < SMOKEFREE_DATE ~ 1,
      insDate >= SMOKEFREE_DATE ~ 2
    )
  ) %>%
  select(-insDate) %>%
  pivot_wider()
#> # A tibble: 5 × 13
#>   studyid SMOKEFREE_DATE x2014_03_15 x2014_04_15 x2014_05_15 x2014_06_15
#>     <int> <date>               <dbl>       <dbl>       <dbl>       <dbl>
#> 1       1 2014-08-01               1           1           1           1
#> 2       2 2014-08-01               1           1           1           1
#> 3       3 2014-01-01               2           2           2           2
#> 4       4 2014-01-01               0           2           2           2
#> 5       5 2015-08-01               1           1           1           1
#> # … with 7 more variables: x2014_07_15 <dbl>, x2014_08_15 <dbl>,
#> #   x2014_09_15 <dbl>, x2014_10_15 <dbl>, x2014_11_15 <dbl>, x2014_12_15 <dbl>,
#> #   x2015_01_15 <dbl>

Created on 2022-05-05 by the reprex package (v2.0.0)

Это имело дополнительное преимущество, помогающее укрепить мое понимание pivot_longer и pivot_wider.

abra 05.05.2022 17:14

Другие вопросы по теме