R/WebApiIncidenceRateAnalysis.R

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

# @file CohortDefinition
#
# Copyright 2019 Observational Health Data Sciences and Informatics
#
# This file is part of ROhdsiWebApi
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.


#' Get specifications for incident rate analysis
#'
#' @details
#' Get specifications for incident rate analysis
#'
#' @param baseUrl         The base URL for the WebApi instance, for example:
#'                        "http://server.org:80/WebAPI".
#' @param incidenceRateId    The Atlas ID for incidence rate analysis.
#' @return
#' Get specifications for incident rate analysis
#'
#' @examples
#' \dontrun{
#' getIncidenceRateSpecifications <- function(baseUrl "http://server.org:80/WebAPI",
#'                                          incidenceRateId = 296)
#'                                          )
#' }
#'
#'
#' @export
getIncidenceRateSpecifications <- function(baseUrl,
                                     incidenceRateId) {
  .checkBaseUrl(baseUrl)

  #ir specifications
  url <- sprintf("%1s/ir/%2s", baseUrl, incidenceRateId)
  json <- .getApiResponseParse(url)
  json$parsed$expression <- jsonlite::fromJSON(txt = json$parsed$expression,
                                               simplifyVector = TRUE,
                                               simplifyDataFrame = TRUE,
                                               flatten = FALSE
                                               ) %>%
                            .convertNullToNARecursive()
  json$parsed$expression$targetCohorts$expression <- NULL
  json$parsed$expression$outcomeCohorts$expression <- NULL
  json$parsed$expression$ConceptSets$expression <- NULL
  json$parsed$expression$strata$expression <- NULL

  json$parsed$expression$targetCohorts <- dplyr::as_tibble(json$parsed$expression$targetCohorts)
  json$parsed$expression$outcomeCohorts <- dplyr::as_tibble(json$parsed$expression$outcomeCohorts)
  json$parsed$expression$ConceptSets <- dplyr::as_tibble(json$parsed$expression$ConceptSets)

  json
}

#' Get specifications for incident rate generation information.
#'
#' @details
#' Get specifications for incident rate generation information.
#'
#' @param baseUrl         The base URL for the WebApi instance, for example:
#'                        "http://server.org:80/WebAPI".
#' @param incidenceRateId    The Atlas ID for incidence rate analysis.
#' @return
#' Get specifications for incident rate generation information.
#'
#' @examples
#' \dontrun{
#' # This will obtain a list of Data Frame with results of the Incidence Rate Analysis:
#' getIncidenceRateGenerationInformation <- function(baseUrl "http://server.org:80/WebAPI",
#'                                          incidenceRateId = 296)
#'                                          )
#' }
#'
#'
#' @export
getIncidenceRateGenerationInformation <- function(baseUrl,
                                     incidenceRateId) {
  .checkBaseUrl(baseUrl)
  #generation
  url <- sprintf("%1s/ir/%2s/info", baseUrl, incidenceRateId)
  json <- .getApiResponseParse(url)
  json$parsed$executionInfo <- jsonlite::flatten(json$parsed$executionInfo) %>%
                                dplyr::mutate(
                                        startTime = as.POSIXct(startTime/1000,origin = "1970-01-01")
                                ) %>%
                                dplyr::as_tibble()
  names(json$parsed$executionInfo) <- names(json$parsed$executionInfo) %>%
                                      stringr::str_replace_all(pattern = 'id.', replacement = '') %>%
                                      snakecase::to_lower_camel_case()
  cdmDataSources <- StudyManagement::getCdmSources(baseUrl = baseUrl)
  #TO DO json$parsed$summaryList --
  json$parsed$executionInfo <- json$parsed$executionInfo %>%
                  dplyr::filter(isValid == TRUE & status == 'COMPLETE' & isCanceled == FALSE & canceled == FALSE) %>%
                  dplyr::inner_join(y = cdmDataSources, by = 'sourceId')
  json$parsed$executionInfo$incidenceRateId <- incidenceRateId
  list(native = json$native, parsed = json$parsed$executionInfo)

}

#' Get precomputed incidence rate analysis results from a specified Atlas incidence rate analyis ID
#'
#' @details
#' Get precomputed incidence rate analysis results from a specified Atlas incidence rate analyis ID
#'
#' @param baseUrl         The base URL for the WebApi instance, for example:
#'                        "http://server.org:80/WebAPI".
#' @param incidenceRateId    The Atlas ID for incidence rate analysis.
#' @return
#' Get precomputed incidence rate analysis results from a specified Atlas incidence rate analyis ID
#'
#' @examples
#' \dontrun{
#' # This will obtain a list of Data Frame with results of the Incidence Rate Analysis:
#' getIncidenceRateResults <- function(baseUrl "http://server.org:80/WebAPI",
#'                                          incidenceRateId = 296)
#'                                          )
#' }
#'
#'
#' @export
getIncidenceRateResults <- function(baseUrl,
                                    incidenceRateId,
                                    targetIds,
                                    outcomeIds,
                                    sourceKeys) {
  .checkBaseUrl(baseUrl)

  irResults <- list()
  irResultsLoop = 0
  for (targetIdLoop in targetIds) {
    writeLines('Downloading pre-computed incidence rate analysis results')
    writeLines(paste0('    Target id = ', targetIdLoop))
    for (outcomeIdLoop in outcomeIds) {
      writeLines(paste0('        Outcome id = ', outcomeIdLoop))
      for (sourceKeyLoop in sourceKeys) {
        #cdmDatabase <- irGeneration$parsed %>% dplyr::filter(sourceKey == sourceKeyLoop) %>% select(cdmDatabase) %>% pull()
        writeLines(paste0('            ',sourceKeyLoop))
        irResultsLoop <- irResultsLoop + 1
        url <- sprintf("%1s/ir/%2s/report/%3s?targetId=%4s&outcomeId=%5s", baseUrl, incidenceRateId, sourceKeyLoop, targetIdLoop, outcomeIdLoop)
        json <- .getApiResponseParse(url)


        if (is.null(json$parsed$summary)) {
          irResults[[irResultsLoop]] <- NULL
        } else {
          json$parsed$summary <- dplyr::bind_rows(json$parsed$summary)
          json$parsed$summary$proportionP1K <- (json$parsed$summary$cases/json$parsed$summary$totalPersons)*1000
          json$parsed$summary$rateP1K <- (json$parsed$summary$cases/json$parsed$summary$timeAtRisk)*1000
          json$parsed$summary$sourceKey <- sourceKeyLoop
          json$parsed$summary$incidenceRateId <- incidenceRateId

          json$parsed$stratifyStats$proportionP1K = (json$parsed$stratifyStats$cases/json$parsed$stratifyStats$totalPersons)*1000
          json$parsed$stratifyStats$rateP1K = (json$parsed$stratifyStats$cases/json$parsed$stratifyStats$timeAtRisk)*1000
          json$parsed$stratifyStats$sourceKey <- sourceKeyLoop
          json$parsed$stratifyStats$incidenceRateId <- incidenceRateId

          # call recursive flattenTree, store results in result
          treeMapResult <- list(name = c(), size = c())
          jsonTreeMapData <- RJSONIO::fromJSON(json$parsed$treemapData)
          treeMapResult <- .flattenTree(jsonTreeMapData,treeMapResult)
          treeMapResultDf <- dplyr::tibble(bits = treeMapResult$name, size = treeMapResult$size)
          treeMapResultDf <- treeMapResultDf %>% dplyr::mutate(
            'SatisfiedNumber' = stringr::str_count(string = treeMapResultDf$bits, pattern = '1'),
            'SatisfiedRules' = stringr::str_locate_all(string = treeMapResultDf$bits, pattern = '1') %>% paste()
          )
          json$parsed$treemapData <- treeMapResultDf
          json$parsed$treemapData$sourceKey <- sourceKeyLoop
          json$parsed$treemapData$targetId <- targetIdLoop
          json$parsed$treemapData$outcomeId <- outcomeIdLoop
          json$parsed$treemapData$incidenceRateId <- incidenceRateId

          irResults[[irResultsLoop]] <- json
        }
      }
    }
  }
  irResultsAll <- irResults

  irSummary <- list()
  irStratifyStats <- list()
  irTreemapData <- list()
  for (i in (1:length(irResults))) {
    irSummary[[i]] <- irResults[[i]]$parsed$summary %>% tidyr::as_tibble()
    irStratifyStats[[i]] <- irResults[[i]]$parsed$stratifyStats %>% tidyr::as_tibble()
    irTreemapData[[i]] <- irResults[[i]]$parsed$treemapData %>% tidyr::as_tibble()
  }
  irSummary <- dplyr::bind_rows(irSummary)
  irStratifyStats <- dplyr::bind_rows(irStratifyStats)
  irTreemapData <- dplyr::bind_rows(irTreemapData)

  list(
    summary = irSummary,
    stratifyStats = irStratifyStats,
    treemapData = irTreemapData,
    all = irResultsAll
  )

}


#' Get precomputed incidence rate analysis results from a specified Atlas incidence rate analyis ID
#' for the specified combination of Atlas targetId, Atlas outcomeId and Data Source.
#'
#' @details
#' Obtain a data frame with results
#'
#' @param baseUrl         The base URL for the WebApi instance, for example:
#'                        "http://server.org:80/WebAPI".
#' @param incidenceRateId    The Atlas ID for incidence rate analysis.
#' @return
#' A list of Data Frame objects corresponding to the results of the Incidence Rate Analysis.
#'
#' @examples
#' \dontrun{
#' # This will obtain a list of Data Frame with results of the Incidence Rate Analysis:
#' getIncidenceRateAnalysis <- function(baseUrl "http://server.org:80/WebAPI",
#'                                          incidenceRateId = 296)
#'                                          )
#' }
#'
#'
#' @export
getIncidenceRateAnalysis <- function(baseUrl,
                                     incidenceRateId) {
  .checkBaseUrl(baseUrl)
  writeLines(paste0('Incidence rate Id = ', incidenceRateId))

  #incident rate analysis
  writeLines(paste0('    Downloading specifications'))
  irSpecifications <- StudyManagement::getIncidenceRateSpecifications(baseUrl = baseUrl, incidenceRateId = incidenceRateId)
  #generation
  writeLines(paste0('    Downloading generation'))
  irGeneration <- StudyManagement::getIncidenceRateGenerationInformation(baseUrl = baseUrl, incidenceRateId = incidenceRateId)
  #results
  writeLines('Downloading pre-computed incidence rate analysis results')
  irResults <- StudyManagement::getIncidenceRateResults(baseUrl = baseUrl,
                                                        incidenceRateId = incidenceRateId,
                                                        targetIds = irSpecifications$parsed$expression$targetIds,
                                                        outcomeIds = irSpecifications$parsed$expression$outcomeIds,
                                                        sourceKeys = irGeneration$parsed$sourceKey
                                                        )
  list(specifications = irSpecifications,
       generation = irGeneration,
       results = irResults
      )
}


#' Get precomputed incidence rate analysis results for may incident rate ids.
#'
#' @details
#' Get precomputed incidence rate analysis results for may incident rate ids.
#'
#' @param baseUrl         The base URL for the WebApi instance, for example:
#'                        "http://server.org:80/WebAPI".
#' @param incidenceRateIds    A list of Atlas IDs for incidence rate analysis.
#' @return
#' A list of Data Frame objects corresponding to the results of the Incidence Rate Analysis.
#'
#'
#'
#' @export
getIncidenceRateAnalyses <- function(baseUrl,
                                     incidenceRateIds) {
result <- list()
summary <- list()
stratifyStats <- list()
treemapData <- list()
generation <- list()
for (i in (1:length(incidenceRateIds))) {#i = 1
  incidenceRateId <- incidenceRateIds[i]
  result[[paste0('id_',incidenceRateId)]] <-
    StudyManagement::getIncidenceRateAnalysis(baseUrl = baseUrl,
                                              incidenceRateId = incidenceRateId
                                              )
  summary[[i]] <- result[[paste0('id_',incidenceRateId)]]$results$summary
  stratifyStats[[i]] <- result[[paste0('id_',incidenceRateId)]]$results$stratifyStats
  treemapData[[i]] <- result[[paste0('id_',incidenceRateId)]]$results$treemapData
  generation[[i]] <- result[[paste0('id_',incidenceRateId)]]$generation$parsed
}
  result$all$summary <- dplyr::bind_rows(summary) %>% tidyr::as_tibble()
  result$all$stratifyStats <- dplyr::bind_rows(stratifyStats) %>% tidyr::as_tibble()
  result$all$treemapData <- dplyr::bind_rows(treemapData) %>% tidyr::as_tibble()
  result$all$generation <- dplyr::bind_rows(generation) %>% tidyr::as_tibble()

result
}