I would like to make an adjustment in md1
. Note that both group_by
of med
and inner_join
of SPV
will depend on group_cols
, however, see the filter of md1
, I have described them all, but I would like to leave it as I did for the others, because it will depend on what I get in group_cols
. In other words:
If I have "Category"
,"Week"
and "DTT"
in group_cols
, do:
filter(date2 == ymd(dmda), Category == CategoryChosse,DTT == DTest)
If I have "Category"
and "Week"
in group_cols
, do:
filter(date2 == ymd(dmda), Category == CategoryChosse)
If I have just "Week"
in group_cols
, do:
filter(date2 == ymd(dmda))
Executable code below
library(dplyr)
library(tidyverse)
library(lubridate)
df1 <- structure(
list(date1= c("2021-06-28","2021-06-28","2021-06-28","2021-06-28"),
date2 = c("2021-06-23","2021-06-24","2021-06-30","2021-07-01"),
DTT= c("Hol","Hol","Hol",0),
Week= c("Wednesday","Thursday","Wednesday","Thursday"),
Category = c("ABC","FDE","ABC","FDE"),
DR1 = c(4,1,1,2),
DR01 = c(4,1,2,3), DR02= c(4,2,0,2),DR03= c(9,5,0,1),
DR04 = c(5,4,3,2),DR05 = c(5,4,0,2)),
class = "data.frame", row.names = c(NA, -4L))
dmda<-"2021-06-30"
CategoryChosse<-"FDE"
DTest<-"Hol"
Wk<-"Wednesday"
Dx<-subset(df1,df1$date2<df1$date1)
x<-Dx %>% select(starts_with("DR0"))
x<-cbind(Dx, setNames(Dx$DR1 - x, paste0(names(x), "_PV")))
PV<-select(x, date2,Week, Category, DTT, DR1, ends_with("PV"))
group_cols <-
if (any(PV$DTT == DTest & PV$Week == Wk & PV$Category == CategoryChosse, na.rm = TRUE)) {
c("Category", "Week", "DTT")
} else if (any(PV$Week == Wk & PV$Category == CategoryChosse & PV$DTT != DTest, na.rm=TRUE)) {
c("Category", "Week")
} else {
"Week"
}
med <- PV %>%
group_by(across(all_of(group_cols))) %>%
summarize(across(ends_with("PV"), median),.groups = 'drop')
SPV <- df1 %>%
inner_join(med, by = group_cols) %>%
mutate(across(matches("^DR0\\d+$"), ~.x +
get(paste0(cur_column(), '_PV')),
.names = '{col}_{col}_PV')) %>%
select(date1:Category, DR01_DR01_PV:last_col())%>%
data.frame()
md1 <- df1 %>%
filter(date2 == ymd(dmda), Category == CategoryChosse,DTT == DTest) %>%
select(starts_with("DR0")) %>%
pivot_longer(cols = everything()) %>%
arrange(desc(row_number())) %>%
mutate(cs = cumsum(value)) %>%
filter(cs == 0) %>%
pull(name)
(dropnames <- paste0(md1,"_",md1, "_PV"))