R/createCustomTable1UsingFeatureExtraction.R

In gowthamrao/StudyManagement: An OHDSI R package to conduct reproducible research.

# library(magrittr)
# minCount = 100
# dialect = 'pdw'
# cohortTable <- "cohort"
# # overides
# endDays <- -1
# longTermStartDays <- NULL
# mediumTermStartDays <- NULL
# shortTermStartDays <- NULL
#
# conceptsOfInterest <-
#   ROhdsiWebApi::resolveConceptSetId(baseUrl = baseUrl,
#                                     setId = 10463,
#                                     formatName = TRUE)
# #########################################################################
#
#
# conceptsOfInterestByDomain <- c(name= conceptsOfInterest$name,
#                                 expression = split(conceptsOfInterest$expression, conceptsOfInterest$expression$domain, drop = TRUE),
#                                 includedConcepts = split(conceptsOfInterest$includedConcepts, conceptsOfInterest$includedConcepts$domain, drop = TRUE),
#                                 mappedConcepts = split(conceptsOfInterest$mappedConcepts, conceptsOfInterest$mappedConcepts$domain, drop = TRUE)
# )
#
# convertConceptsToFeCovariates <- function(conceptIds, analysisId) {
#   return(paste(((conceptIds * 1000) + analysisId), collapse = ","))
# }
#
# defaultDaysParameters <- formals(FeatureExtraction::createCovariateSettings)
# defaultDaysParameters <- defaultDaysParameters[stringr::str_detect(string = names(defaultDaysParameters), pattern = 'Days')]
# .convertToInteger <- function(default, overide = NULL) {
#   a <-  toString(default) %>%
#     stringr::str_replace(pattern = ", ", replacement = "") %>%
#     strtoi() %>%
#     dplyr::coalesce(c(overide,a)) %>%
#     extract2(1)
# }
#
# defaultDaysParameters$longTermStartDays <- .convertToInteger(default = defaultDaysParameters$longTermStartDays, overide = longTermStartDays)
# defaultDaysParameters$mediumTermStartDays <- .convertToInteger(default = defaultDaysParameters$mediumTermStartDays, overide = mediumTermStartDays)
# defaultDaysParameters$shortTermStartDays <- .convertToInteger(default = defaultDaysParameters$shortTermStartDays, overide = shortTermStartDays)
# defaultDaysParameters$endDays <- .convertToInteger(default = defaultDaysParameters$endDays, overide = endDays)
#
# finalDaysParamters <- list(longTermStartDays = dplyr::coalesce(longTermStartDays, paste(toString(defaultDaysParameters$longTermStartDays)),
#                                                                mediumTermStartDays,
#                                                                shortTermStartDays,
#                                                                endDays
# )
#
#
# PreSpecAnalyses <- paste0(system.file(package = "FeatureExtraction"), "/csv/PreSpecAnalyses.csv") %>% readr::read_csv()
#
#
# table1Specifications <-
#   FeatureExtraction::getDefaultTable1Specifications() %>%
#   tibble::as_tibble() %>%
#   dplyr::filter(analysisId <= 20) %>% #keep all demographics that are standard in table 1
#   dplyr::add_row(
#     label = "Medications (-30 to -1 days)",
#     analysisId = 404,
#     covariateIds = convertConceptsToFeCovariates(conceptIds = conceptsOfInterestByDomain$includedConcepts.Drug, analysisId = 404)
#   ) %>%
#   dplyr::add_row(
#     label = "Medications (-Anytime to -1 days)",
#     analysisId = 401,
#     covariateIds = convertConceptsToFeCovariates(conceptIds = drugs, analysisId = 401)
#   ) %>%
#   dplyr::add_row(
#     label = "Concomitant conditions (-30 to -1 days)",
#     analysisId = 212,
#     covariateIds = convertConceptsToFeCovariates(conceptIds = conceptsOfInterestByDomain$includedConcepts.Condition, analysisId = 212)
#   ) %>%
#   dplyr::add_row(
#     label = "Concomitant conditions (-Anytime to -1 days)",
#     analysisId = 209,
#     covariateIds = convertConceptsToFeCovariates(conceptIds = conceptsOfInterestByDomain$includedConcepts.Condition, analysisId = 209)
#   )
#
#
# connectionDetails <-
#   DatabaseConnector::createConnectionDetails(
#     dbms = dbms,
#     server = server,
#     user = NULL,
#     password = NULL,
#     port = port
#   )
#
# covariateSettings <-
#   FeatureExtraction::createCovariateSettings(
#     useDemographicsGender = TRUE,
#     useDemographicsAgeGroup = TRUE,
#     useDemographicsAge = TRUE,
#     useDemographicsRace = TRUE,
#     useDemographicsPriorObservationTime = TRUE,
#     useDemographicsPostObservationTime = TRUE,
#     includedCovariateConceptIds = c(drugs, conditions),
#     addDescendantsToInclude = TRUE,
#     useDrugEraShortTerm = TRUE,
#     useDrugEraAnyTimePrior = TRUE,
#     useConditionGroupEraShortTerm = TRUE,
#     useConditionGroupEraAnyTimePrior = TRUE,
#     #shortTermStartDays = -30,
#     endDays = -1
#   )
#
#
# z <- 0
#
# customTable1 <- list()
#
# # get table 1 using Feature Extraction package
#
# for (i in (1:length(cohortIds))) {
#
#   for (j in (1:length(cdmSources$cdmDatabaseSchema))) {
#
#
#
#     cdmDatabaseSchema <- cdmSources$cdmDatabaseSchema[[j]]
#     sourceKey <- cdmSources$sourceKey[[j]]
#
#     resultsDatabaseSchema <- cdmSources$resultsDatabaseSchema[[j]]
#
#     cohortId <- cohortIds[[i]]
#
#
#
#     sql <- paste0("SELECT count(*) count FROM @resultsDatabaseSchema.cohort where cohort_definition_id = @cohortId")
#
#     connection = DatabaseConnector::connect(connectionDetails = connectionDetails)
#     sql <- SqlRender::render(sql = sql, warnOnMissingParameters = TRUE, resultsDatabaseSchema = resultsDatabaseSchema, cohortId = cohortId)
#     sql <- SqlRender::translate(sql = sql, targetDialect = dialect)
#     results <- DatabaseConnector::querySql(connection, sql)
#     DatabaseConnector::disconnect(connection = connection)
#
#     if (results > minCount) {
#
#       print(paste0('Generating table 1 for ', sourceKey, ' cohort id: ', cohortId, '. This cohort has ', results, ' records.'))
#
#       covariateData <-
#         FeatureExtraction::getDbCovariateData(
#           connectionDetails = connectionDetails,
#           cdmDatabaseSchema = cdmDatabaseSchema,
#           cohortDatabaseSchema = resultsDatabaseSchema,
#           cohortTable = cohortTable,
#           cohortId = cohortId,
#           covariateSettings = covariateSettings,
#           aggregated = TRUE
#         )
#
#       z <-  z + 1
#
#       table1OneColumn <-
#         FeatureExtraction::createTable1(covariateData, specifications = table1Specifications, output = "one columns")
#
#       table1TwoColumns <-
#         FeatureExtraction::createTable1(covariateData, specifications = table1Specifications, output = "two columns")
#
#       identifiers <- tidyr::tibble(cdmDatabaseSchema = cdmDatabaseSchema,
#                                    sourceKey = sourceKey,
#                                    resultsDatabaseSchema = resultsDatabaseSchema,
#                                    cohortId = cohortId)
#
#
#
#       customTable1[[z]] <- list(identifiers = identifiers,
#                                 table1OneColumnPart1 = table1OneColumn$part1,
#                                 table1OneColumnPart2 = table1OneColumn$part2,
#                                 table1TwoColumns = table1TwoColumns
#       )
#
#     } else {
#       print(paste0('Skipping table 1 for ', sourceKey, ' cohort id: ', cohortId, ', because this cohort only has ', results, ' records.'))
#     }
#   }
# }
#
#
# saveRDS(customTable1, file = paste0(rstudioapi::getActiveProject(), '/data/customTable1.rds'))
#
# customTable1 <- readRDS(file = paste0(rstudioapi::getActiveProject(), '/data/customTable1.rds'))