R/get_intersect_members.R

In aidanmacnamara/epiChoose:

#' @description Find intersections using binary matrix
#' @details What's this?
#' @return TO ADD
#' @export

get_intersect_members <- function (x, ...){
  
  require(dplyr)
  require(tibble)
  
  x <- x[,sapply(x, is.numeric)][,0<=colMeans(x[,sapply(x, is.numeric)],na.rm=T) & colMeans(x[,sapply(x, is.numeric)],na.rm=T)<=1]
  n <- names(x)
  x %>% rownames_to_column() -> x
  l <- c(...)
  a <- intersect(names(x), l)
  ar <- vector('list',length(n)+1)
  ar[[1]] <- x
  i=2
  
  for (item in n) {
    if (item %in% a){
      if (class(x[[item]])=='integer'){
        ar[[i]] <- paste(item, '>= 1')
        i <- i + 1
      }
    } else {
      if (class(x[[item]])=='integer'){
        ar[[i]] <- paste(item, '== 0')
        i <- i + 1
      }
    }
  }
  
  do.call(filter_, ar) %>% column_to_rownames() -> x
  return(x)
  
}