user16774617
user16774617

Reputation:

Problems generating variable when I have NA data in R code

I have a question regarding the code below. Note that my input data was day = 30/06, Category = FDE and DTT = Hol, and I can get SPV (First Code). However, when I do day = 30/06, Category = ABC and DTT = NA, I can't get SPV (Second Code). I would need to show the line corresponding to that date/category/dtt. How to adjust this?

Executable code below:

For 30/06, FDE, Hol

library(dplyr)

df1 <- structure(
  list(date1= c("2021-06-28","2021-06-28","2021-06-28"),
       date2 = c("2021-06-30","2021-06-30","2021-07-02"),
       DTT= c(NA,"Hol","Hol"),
       Week= c("Wednesday","Wednesday","Friday"),
       Category = c("ABC","FDE","ABC"),
       DR1 = c(4,1,1),
       DR01 = c(4,1,2), DR02= c(4,2,0),DR03= c(9,5,0),
       DR04 = c(5,4,3),DR05 = c(5,4,0)),
  class = "data.frame", row.names = c(NA, -3L))


dmda<-"2021-06-30"
CategoryChosse<-"FDE"
DTest<-"Hol"

  x<-df1 %>% select(starts_with("DR0"))
  
  x<-cbind(df1, setNames(df1$DR1 - x, paste0(names(x), "_PV")))
  PV<-select(x, date2,Week, Category, DTT, DR1, ends_with("PV"))
  
  med<-PV %>%
    group_by(Category,Week,DTT) %>%
    summarize(across(ends_with("PV"), median))
  
  SPV<-df1%>%
    inner_join(med, by = c('Category', 'Week','DTT')) %>%
    mutate(across(matches("^DR0\\d+$"), ~.x + 
                    get(paste0(cur_column(), '_PV')),
                  .names = '{col}_{col}_PV')) %>%
    select(date1:Category, DR01_DR01_PV:last_col())
  
  SPV<-data.frame(SPV)
  
  mat1 <- df1 %>%
    filter(date2 == 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(mat1,"_",mat1, "_PV"))
  
  SPV <- SPV %>%
    filter(date2 == dmda, Category == CategoryChosse, DTT==DTest) %>%
    select(-any_of(dropnames))
  if(length(grep("DR0", names(SPV))) == 0) {
    SPV[mat1] <- NA_real_
  }

> SPV
       date1      date2 DTT      Week Category DR01_DR01_PV DR02_DR02_PV DR03_DR03_PV DR04_DR04_PV DR05_DR05_PV
1 2021-06-28 2021-06-30 Hol Wednesday      FDE            1            1            1            1    

For 30/06, ABC, NA

dmda<-"2021-06-30"
CategoryChosse<-"ABC"
DTest<-NA

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

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

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

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

SPV<-data.frame(SPV)

mat1 <- df1 %>%
    filter(date2 == 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(mat1,"_",mat1, "_PV"))

SPV <- SPV %>%
    filter(date2 == dmda, Category == CategoryChosse, DTT==DTest) %>%
    select(-any_of(dropnames))
if(length(grep("DR0", names(SPV))) == 0) {
    SPV[mat1] <- NA_real_
}

> SPV
[1] date1        date2        DTT          Week         Category     DR01_DR01_PV DR02_DR02_PV DR03_DR03_PV
[9] DR04_DR04_PV DR05_DR05_PV
<0 lines>

Upvotes: 1

Views: 41

Answers (1)

IceCreamToucan
IceCreamToucan

Reputation: 28705

You can write your own function which is like == unless one element is NA, and in that case only returns TRUE when both are NA. Then use that function in filter instead of ==.

In the future please attempt to create a minimal reproducible example like the one below, so that you are asking a specific question rather than asking people to fix your code for you.

See How to make a great R reproducible example

library(dplyr, warn.conflicts = FALSE)

same <- function(x, y){
  case_when(
    is.na(x) != is.na(y) ~ FALSE,
    is.na(x) ~ TRUE,
    TRUE ~ x == y)
}

df <- data.frame(x = c('hol', NA))

x_want <- 'hol'

df %>% 
  filter(same(x, x_want))
#>     x
#> 1 hol

x_want <- NA

df %>% 
  filter(same(x, x_want))
#>      x
#> 1 <NA>

Created on 2021-12-20 by the reprex package (v2.0.1)

Upvotes: 1

Related Questions