调整特定日期/代码的输出表

Question

下面的代码适用于我从df1 数据库中选择的几乎所有日期和代码，但仅适用于09/07 的日期和代码FGE 不适用。我想解决这个问题，你能帮帮我吗？如果需要，我可以更好地解释这段代码的作用。

library(dplyr)
library(tidyverse)
library(lubridate)
library(stringr)

df1 <- structure(
  list(date1= c("2021-06-28","2021-06-28","2021-06-28","2021-06-28","2021-06-28",
               "2021-06-28","2021-06-28","2021-06-28"),
       date2 = c("2021-06-30","2021-06-30","2021-07-02","2021-07-07","2021-07-07","2021-07-09","2021-07-09","2021-07-09"),
       Code = c("FDE","ABC","ABC","ABC","CDE","FGE","ABC","CDE"),
       Week= c("Wednesday","Wednesday","Friday","Wednesday","Wednesday","Friday","Friday","Friday"),
       DR1 = c(4,1,4,3,3,4,3,5),
       DR01 = c(4,1,4,3,3,4,3,6), DR02= c(4,2,6,7,3,2,7,4),DR03= c(9,5,4,3,3,2,1,5),
       DR04 = c(5,4,3,3,6,2,1,9),DR05 = c(5,4,5,3,6,2,1,9),
       DR06 = c(2,4,3,3,5,6,7,8),DR07 = c(2,5,4,4,9,4,7,8),
       DR08 = c(0,0,0,1,2,0,0,0),DR09 = c(0,0,0,0,0,0,0,0),DR010 = c(0,0,0,0,0,0,0,0),DR011 = c(4,0,0,0,0,0,0,0), 
       DR012 = c(0,0,0,3,0,0,0,5),DR013 = c(0,0,1,0,0,0,2,0),DR014 = c(0,0,0,0,0,2,0,0)),
  class = "data.frame", row.names = c(NA, -8L))

dmda<-"2021-07-09"
CodeChosse<-"FGE"

x<-df1 %>% select(starts_with("DR0"))

x<-cbind(df1, setNames(df1$DR1 - x, paste0(names(x), "_PV")))
PV<-select(x, date2,Week, Code, DR1, ends_with("PV"))

med<-PV %>%
  group_by(Code,Week) %>%
  summarize(across(ends_with("PV"), median))

SPV<-df1%>%
  inner_join(med, by = c('Code', 'Week')) %>%
  mutate(across(matches("^DR0\\d+$"), ~.x + 
                  get(paste0(cur_column(), '_PV')),
                .names = '{col}_{col}_PV')) %>%
  select(date1:Code, DR01_DR01_PV:last_col())

SPV<-data.frame(SPV)
    
mat1 <- df1 %>%
  filter(date2 == dmda, Code == CodeChosse) %>%
  select(starts_with("DR0")) %>%
  pivot_longer(cols = everything()) %>%
  arrange(desc(row_number())) %>%
  mutate(cs = cumsum(value)) %>%
  filter(cs == 0) %>%
  pull(name)

(dropnames <- paste0(mat1,"_",mat1, "_PV"))

SPV %>%
  filter(date2 == dmda, Code == CodeChosse) %>%
  select(-dropnames)

   > SPV %>%
+   filter(date2 == dmda, Code == CodeChosse) %>%
+   select(-dropnames)
Error: Can't subset columns that don't exist.
x Column `__PV` doesn't exist.
Run `rlang::last_error()` to see where the error occurred.

对于其他数据/代码，它可以工作，例如：

dmda<-"2021-06-30"
CodeChosse<-"FDE"

> SPV %>%
+   filter(date2 == dmda, Code == CodeChosse) %>%
+   select(-dropnames)
       date1      date2 Code DR01_DR01_PV DR02_DR02_PV DR03_DR03_PV DR04_DR04_PV DR05_DR05_PV DR06_DR06_PV DR07_DR07_PV DR08_DR08_PV
1 2021-06-28 2021-06-30  FDE            4            4            4            4            4            4            4            4
  DR09_DR09_PV DR010_DR010_PV DR011_DR011_PV
1            4              4              4


dmda<-"2021-07-02"
CodeChosse<-"ABC"

> SPV %>%
+   filter(date2 == dmda, Code == CodeChosse) %>%
+   select(-dropnames)
       date1      date2 Code DR01_DR01_PV DR02_DR02_PV DR03_DR03_PV DR04_DR04_PV DR05_DR05_PV DR06_DR06_PV DR07_DR07_PV DR08_DR08_PV
1 2021-06-28 2021-07-02  ABC            4            3            5          4.5          5.5          1.5            2          3.5
  DR09_DR09_PV DR010_DR010_PV DR011_DR011_PV DR012_DR012_PV DR013_DR013_PV
1          3.5            3.5            3.5            3.5              3

dmda<-"2021-07-07"
CodeChosse<-"CDE"

> SPV %>%
+   filter(date2 == dmda, Code == CodeChosse) %>%
+   select(-dropnames)
       date1      date2 Code DR01_DR01_PV DR02_DR02_PV DR03_DR03_PV DR04_DR04_PV DR05_DR05_PV DR06_DR06_PV DR07_DR07_PV DR08_DR08_PV
1 2021-06-28 2021-07-07  CDE            3            3            3            3            3            3            3            3

Answer 1

在这种特殊情况下的问题是mat1 中没有值，因为df1 中的第一行具有非零值，而filter(cs == 0) 删除了所有行。

mat1
#character(0)

您可以使用any_of，如果该列不存在，则不会报错。

library(dplyr)

SPV %>%
  filter(date2 == dmda, Code == CodeChosse) %>%
  select(-any_of(dropnames))