extras/03_humanReadableExcelWorkbook.R

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

library(StudyManagement)
library(magrittr)

#### path and file location
rdsLoc <- paste0(basePath, '/studySpecificationAndResults/01_rds/rdsFileName.rds')
# read RDS file with results and specifications to be pushed into Excel
# rdsFileName <- readRDS(file = rdsLoc)
outPath <- paste0(basePath, "/studySpecificationAndResults/03_humanReadable")


#Data source
dataSourceSummary <- list()
for (i in (1:nrow(rdsFileName$configuration))) {#i = 1

  sourceName <- rdsFileName$configuration[i,]$sourceName
  sourceKey <- rdsFileName$configuration[i,]$sourceKey

  personCount <- (rdsFileName$dataSources[[sourceKey]]$dashboard$parsed$summary$attributeValue)[2]
  gender <- (rdsFileName$dataSources[[sourceKey]]$dashboard$parsed$gender) %>%
              dplyr::select(conceptName, countValue) %>%
              tidyr::pivot_wider(id_cols = conceptName, names_from = conceptName, values_from = countValue)

  dataSourceSummary[[i]] <- data.frame(
    sourceName = sourceName,
    # personCount = personCount,
    # percentMale = (gender$MALE)/as.numeric(personCount),
    personCount = scales::comma(as.integer(personCount), big.mark = ","),
    percentMale = scales::percent(as.integer(gender$MALE)/as.integer(personCount), big.mark = ",", accuracy = 0.1),
    stringsAsFactors = FALSE
  )
}
dataSourceSummary <- dplyr::bind_rows(dataSourceSummary)
names(dataSourceSummary) <- snakecase::to_sentence_case(names(dataSourceSummary))


wb <- openxlsx::createWorkbook(
  creator = ifelse(.Platform$OS.type == "windows", Sys.getenv("USERNAME"),
                   Sys.getenv("USER")),
  title = NULL,
  subject = NULL,
  category = NULL
)
StudyManagement::createExcelSheetFormat(wb = wb,
                       sheetName = "Data Source",
                       data = dataSourceSummary,
                       mainTitle = "Persons in selected data source")
openxlsx::saveWorkbook(wb = wb, file = paste0(outPath, "/01 data source.xlsx"), overwrite = TRUE)


##############cohort inclusion rule count##############
inclusionRuleStats <- rdsFileName$cohort$all$inclusionRuleStats %>%
  dplyr::mutate(countSatisfying = scales::comma(countSatisfying, big.mark = ","),
                percentExcluded = scales::percent(percentExcluded, big.mark = ",", accuracy = 0.1),
                percentSatisfying = scales::percent(percentSatisfying, big.mark = ",", accuracy = 0.1)
                )
combinations <- inclusionRuleStats %>%
                dplyr::select(sourceKey, cohortDefinitionId, mode) %>%
                unique() %>%
                dplyr::left_join(rdsFileName$configuration, by = c("sourceKey" = "sourceKey")) %>%
                dplyr::left_join(rdsFileName$cohort$all$metaData, by = c("cohortDefinitionId" = "cohortDefinitionId"))


for (mode in (combinations$mode %>% unique())) {
  wb <- openxlsx::createWorkbook(
    creator = ifelse(.Platform$OS.type == "windows", Sys.getenv("USERNAME"),
                     Sys.getenv("USER")),
    title = NULL,
    subject = NULL,
    category = NULL
  )
  for (sourceKey in (combinations$sourceKey %>% unique())) {
    for (cohortDefinitionId in (combinations$cohortDefinitionId %>% unique())) {
      shortKey <- shortSourceKey[stringr::str_detect(sourceKey, shortSourceKey)]
      sheetName <- paste0(shortKey, "_",cohortDefinitionId)

      data <- inclusionRuleStats %>%
        dplyr::filter(mode == !!mode,
                      sourceKey == !!sourceKey,
                      cohortDefinitionId == !!cohortDefinitionId) %>%
        dplyr::arrange(id) %>%
        dplyr::select(name, countSatisfying, percentExcluded, percentSatisfying)
      names(data) <- snakecase::to_sentence_case(names(data))

      combination <- combinations %>%
        dplyr::filter(mode == !!mode,
                      sourceKey == !!sourceKey,
                      cohortDefinitionId == !!cohortDefinitionId)

      if (nrow(data) > 0) {

      StudyManagement::createExcelSheetFormat(wb = wb,
                               sheet = sheetName,
                               data = data,
                               mainTitle = paste0('Id ', cohortDefinitionId, ' - ', combination$nameFormatted),
                               subTitle = paste0(combination$sourceName)
                               )
      }
    }
  }
  openxlsx::saveWorkbook(wb = wb, file = paste0(outPath, "/03 Cohort Inclusion Count ", mode, ".xlsx"), overwrite = TRUE)
}


############## Characterization output ##############
# characterizationResults <- rdsFileName$characterization$id_486$results$all
#
# combination <- characterizationResults %>%
#       dplyr::select(characterizationId, generationId, id, sourceKey, cohortId, strataId,
#                     strataName, timeWindow, analysisId, analysisName,
#                     faType, resultType) %>% unique()
#
# combination2 <- combination %>%
#       dplyr::filter(timeWindow == 'Long Term',
#                     analysisName == 'Condition Group Era Long Term'
#       )
# View(combination2)

######## incidence rate ##########

cohorts <- rdsFileName$cohort$all$metaData %>%
          dplyr::select(id, name, nameFormatted) %>%
          dplyr::mutate(id = as.integer(id))


irResults <- rdsFileName$incidenceRateAnalysis$all$summary %>%
            dplyr::left_join(y = cohorts %>%
                               dplyr::rename(targetId = id,
                                             targetCohortName = name,
                                             targetCohortNameFormatted = nameFormatted)) %>%
            dplyr::left_join(y = cohorts %>%
                               dplyr::rename(outcomeId = id,
                                             outcomeCohortName = name,
                                             outcomeCohortNameFormatted = nameFormatted)) %>%
            dplyr::left_join(rdsFileName$configuration) %>%
            purrr::map_at(c('totalPersons', 'timeAtRisk', 'cases'),
                         scales::comma, big.mark = ",") %>%
            purrr::map_at(c('proportionP1K', 'rateP1K'),
                          scales::comma, big.mark = ",", accuracy = 0.001) %>%
            tidyr::as_tibble() %>%
            dplyr::select(targetCohortNameFormatted, targetCohortName, targetId,
                          outcomeCohortNameFormatted, outcomeCohortName, outcomeId,
                          sourceKey, sourceName,
                          totalPersons, timeAtRisk, cases,
                          proportionP1K, rateP1K
            )

irResultsFirst <- irResults
names(irResultsFirst) <- snakecase::to_sentence_case(names(irResultsFirst))

wb <- openxlsx::createWorkbook(
  creator = ifelse(.Platform$OS.type == "windows", Sys.getenv("USERNAME"),
                   Sys.getenv("USER")),
  title = NULL,
  subject = NULL,
  category = NULL
)
StudyManagement::createExcelSheetFormat(wb = wb,
                                        sheet = "ir Results",
                                        data = irResultsFirst
)


irResultsproportionP1K <- tidyr::pivot_wider(data = irResults,
                                            id_cols = c(targetCohortNameFormatted, targetCohortName, targetId,
                                                        outcomeCohortNameFormatted, outcomeCohortName, outcomeId),
                                            names_from = sourceKey,
                                            values_from = proportionP1K)
names(irResultsproportionP1K) <- snakecase::to_sentence_case(names(irResultsproportionP1K))

StudyManagement::createExcelSheetFormat(wb = wb,
                                        sheet = "Proportion",
                                        data = irResultsproportionP1K
)

irResultsrateP1K <- tidyr::pivot_wider(data = irResults,
                                       id_cols = c(targetCohortNameFormatted, targetCohortName, targetId,
                                                    outcomeCohortNameFormatted, outcomeCohortName, outcomeId),
                                       names_from = sourceKey,
                                       values_from = rateP1K)
names(irResultsrateP1K) <- snakecase::to_sentence_case(names(irResultsrateP1K))

StudyManagement::createExcelSheetFormat(wb = wb,
                                        sheet = "Rate per 1K",
                                        data = irResultsrateP1K
)


irResultsAbsoluteNumberOfCases <- tidyr::pivot_wider(data = irResults,
                                             id_cols = c(targetCohortNameFormatted, targetCohortName, targetId,
                                                         outcomeCohortNameFormatted, outcomeCohortName, outcomeId),
                                             names_from = sourceKey,
                                             values_from = cases)
names(irResultsAbsoluteNumberOfCases) <- snakecase::to_sentence_case(names(irResultsAbsoluteNumberOfCases))

StudyManagement::createExcelSheetFormat(wb = wb,
                                        sheet = "Cases",
                                        data = irResultsAbsoluteNumberOfCases
)


openxlsx::saveWorkbook(wb = wb, file = paste0(outPath, "/04 incident rate analysis.xlsx"), overwrite = TRUE)
################ Estimation ###################