R/WebApiEstimation.R

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

# @file Estimation
#
# 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 the results from individual Achilles reports by data Source definition expression
#'
#' @details
#' Obtain the JSON expression from WebAPI for a given dataSource
#'
#' @param baseUrl        The base URL for the WebApi instance, for example:
#'                       "http://server.org:80/WebAPI".
#' @param estimationId   The Atlas id for the estimation specification
#' @return
#' A list of objects with specifications for estimation
#'
#' @examples
#' \dontrun{
#' # This will obtain pre-computed summary regarding dataSource
#'
#' getEstimationSpecification(baseUrl = "http://server.org:80/WebAPI", estimationId = 3434)
#' }
#'
#'
#' @export
getEstimationSpecification <- function(baseUrl,
                                        estimationId
                                        ){
  .checkBaseUrl(baseUrl)
  estimationId <- as.integer(estimationId)
  url <- sprintf("%s/estimation/%d/", baseUrl, estimationId)
  json <- .getApiResponseParse(url)

  json$parsed$createdDate <- as.POSIXct((json$parsed$createdDate)/1000,origin = "1970-01-01")
  json$parsed$modifiedDate <- as.POSIXct((json$parsed$modifiedDate)/1000,origin = "1970-01-01")
  json$parsed$specification <- jsonlite::fromJSON(txt = json$parsed$specification,
                                                  simplifyVector = TRUE,
                                                  simplifyDataFrame = TRUE,
                                                  flatten = FALSE
                                                  ) %>%
                                                .convertNullToNARecursive()

  json$parsed$specification$cohortDefinitions <- dplyr::as_tibble(json$parsed$specification$cohortDefinitions)
  json$parsed$specification$conceptSets <- dplyr::as_tibble(json$parsed$specification$conceptSets)
  json$parsed$specification$conceptSetCrossReference <- dplyr::as_tibble(json$parsed$specification$conceptSetCrossReference)
  json$parsed$specification$negativeControls <- dplyr::as_tibble(json$parsed$specification$negativeControls)

  targetComparatorOutcomeIdDf <- list()
  temp <- json$parsed$specification$estimationAnalysisSettings$analysisSpecification$targetComparatorOutcomes

  targetComparatorOutcomeIdDf <- data.frame(expand.grid(targetId = temp$targetId %>% unlist() %>% unique(),
                                                 comparatorId = temp$comparatorId %>% unlist() %>% unique(),
                                                 outcomeId = temp$outcomeIds %>% purrr::reduce(c) %>% unique())
  )
  json$parsed$specification$estimationAnalysisSettings$analysisSpecification$targetComparatorOutcomes$targetComparatorOutcomeIdDf <-
    targetComparatorOutcomeIdDf

  cohortIds <- c(targetComparatorOutcomeIdDf$targetId,
                 targetComparatorOutcomeIdDf$comparatorId,
                 targetComparatorOutcomeIdDf$outcomeId
  ) %>% unique()

  cohorts <- list()
  for (i in (1:length(cohortIds))) {
    cohorts[[paste0('cohortId_',cohortIds[i])]] <- StudyManagement::getCohortSpecification(baseUrl, cohortIds[i])
  }
  json$parsed$specification$estimationAnalysisSettings$analysisSpecification$targetComparatorOutcomes$cohorts <- cohorts

  json
}