R/getDependencies.R

In AndrewC160/ROMOPOmics: ROMOPOmics: incorporating 'Omics Data Into The Observational Medical Outcomes Partnership (OMOP) Data Model

#' getDependencies
#'
#' Function accepts a data model from loadDataModel() and returns a list of
#' dependencies between tables based on the presence or absence of index
#' columns (columns that end with "<table_name>_id"). By default the 
#' dependencies of each tableare returned in a list, but if return_matrix is 
#' TRUE this function returns a matrix. If table names are included in as a 
#' vector to 'inc_tabs', only those tables are included in the matrix.
#'
#' @param data_model Data model from loadDataModel(), in single-table format.
#' @param inc_tabs Only include tables with these names.
#' @param return_matrix Return dependencies as integer-format matrix of directional connections.
#'
#' getDependencies()
#'
#' @import tidyverse
#'

getDependencies   <- function(data_model=loadDataModel(),inc_tabs,return_matrix=FALSE){
  if(missing(inc_tabs)){
    inc_tabs  <- unique(data_model$table)
  }
  tb  <- data_model %>%
          filter(table %in% inc_tabs) %>%
          filter(table_index) %>%
          group_by(table) %>%
          select(field,table) %>%
          mutate(field=gsub("_id","",field)) %>%
          filter(field %in% inc_tabs) %>%
          summarize(dependencies=list(field))
  dep_lst   <- tb$dependencies
  names(dep_lst)  <- tb$table
  dep_lst   <- dep_lst[order(names(dep_lst))]
  #Omit self-depenedency.
  dep_lst   <- lapply(names(dep_lst), function(x) {
                lst_ot<- dep_lst[[x]]
                lst_ot<- lst_ot[lst_ot != x]
                return(lst_ot)})
  names(dep_lst)  <- tb$table
  if(return_matrix){
    dep_lst           <- sapply(dep_lst,function(x) as.integer(names(dep_lst) %in% x))
    rownames(dep_lst) <- colnames(dep_lst)
  }
  return(dep_lst)
}