Using dplyr summarise_if() with a predicate

Question

I want to calculate mean of x1 and x2 on days where the ratio of sum(is.NA) and all observations is >= 0.5 or else NA.

Data:

library(lubridate)
library(dplyr)

x = seq(length.out= 10)
x[seq(1,11,5)] <- NA
data = data.frame(
    tseq = seq(from = Sys.time(), length.out = 11, by = "12 hours"),
    x1 = x,
    x2 = x
    )

means = data %>% group_by(tseq=floor_date(tseq, "days")) %>%
    summarise_all(list( mean = ~ mean(., na.rm = TRUE)))

ratio = data %>% group_by(tseq=floor_date(tseq, "days")) %>%
    summarise_all(list( ratio = ~ sum(is.na(.)) / n()))

> ratio
  tseq                x1_ratio x2_ratio
1 2019-08-26 00:00:00      1        1  
2 2019-08-27 00:00:00      0        0  
3 2019-08-28 00:00:00      0        0  
4 2019-08-29 00:00:00      0.5      0.5
5 2019-08-30 00:00:00      0        0  
6 2019-08-31 00:00:00      0.5      0.5

So here 2019-08-26, 2019-08-29, 2019-08-31 dates would get means. In a vector I could accomplish this by function

isEnough = function(x){
    # is there enough values to calculate mean
    if (sum(is.na(x)) / length(x) < 0.5){
        return(FALSE)
    }
    else return(TRUE)
}

For a data frame I can't find a solution. So far I have tried

data %>% group_by(tseq=floor_date(tseq, "days")) %>%
    summarise_if(.predicate =  isEnough(~ sum(is.na(.)), ~n()),
    .funs = list( mean = ~ mean(., na.rm = TRUE)))
Error in naCount/xLength : non-numeric argument to binary operator

data %>% group_by(tseq=floor_date(tseq, "days")) %>%
    summarise_if(.predicate = list( ~ sum(is.na(.)) / n() > 0.5),
    .func = list( mean = ~ mean(., na.rm = TRUE)))
Error: n() should only be called in a data context

data %>% group_by(tseq=floor_date(tseq, "days")) %>%
    summarise_if(.predicate = (~ sum(is.na(.)) / ~n() > 0.5),
    .func = list( mean = ~ mean(., na.rm = TRUE)))
Error in sum(is.na(.))/~n() > 0.5 : 
  non-numeric argument to binary operator

Answer 1

summarise_if is used to select columns. See it as a derivative of summarise_at, where you specify which columns to use some functions on.

As it appears you want to calculate the mean of x1 and x2 separately, but under same conditions, I start off by gathering the two columns into one, using tidyr's gather:

library(tidyr)
data %>% gather(x, val, x1, x2) %>% 
  group_by(tseqs=floor_date(tseq, "days"), x) %>% 
  summarise(
    ratio=sum(is.na(val))/n(), 
    mean=mean(val, na.rm=TRUE)*ifelse(ratio >= 0.5, NA, 1)
  )
# A tibble: 12 x 4
# Groups:   tseqs [?]
   tseqs               x     ratio  mean
   <dttm>              <chr> <dbl> <dbl>
 1 2019-08-26 00:00:00 x1      1   NaN  
 2 2019-08-26 00:00:00 x2      1   NaN  
 3 2019-08-27 00:00:00 x1      0     2.5
 4 2019-08-27 00:00:00 x2      0     2.5
 5 2019-08-28 00:00:00 x1      0     4.5
 6 2019-08-28 00:00:00 x2      0     4.5
 7 2019-08-29 00:00:00 x1      0.5  NA  
 8 2019-08-29 00:00:00 x2      0.5  NA  
 9 2019-08-30 00:00:00 x1      0     8.5
10 2019-08-30 00:00:00 x2      0     8.5
11 2019-08-31 00:00:00 x1      0.5  NA  
12 2019-08-31 00:00:00 x2      0.5  NA  

Last step is to clean it up, and pack it back into format:

data %>% gather(x, val, x1, x2) %>% 
  group_by(tseqs=floor_date(tseq, "days"), x) %>% 
  summarise(
    ratio=sum(is.na(val))/n(), 
    mean=mean(val, na.rm=TRUE)*ifelse(ratio >= 0.5, NA, 1)
  ) %>%
  select(tseqs, x, mean) %>%
  tidyr::spread(x, mean)
# A tibble: 6 x 3
# Groups:   tseqs [6]
  tseqs                  x1    x2
  <dttm>              <dbl> <dbl>
1 2019-08-26 00:00:00 NaN   NaN  
2 2019-08-27 00:00:00   2.5   2.5
3 2019-08-28 00:00:00   4.5   4.5
4 2019-08-29 00:00:00  NA    NA  
5 2019-08-30 00:00:00   8.5   8.5
6 2019-08-31 00:00:00  NA    NA