R/WebApi.R

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

# @file WebApi
#
# Copyright 2020 Observational Health Data Sciences and Informatics
#
# This file is part of StudyManagement
#
# 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 data sources in the WebAPI instance
#'
#' @details
#' Obtains the data sources configured in the WebAPI instance
#'
#' @param baseUrl   The base URL for the WebApi instance, for example: "http://server.org:80/WebAPI".
#'
#' @return
#' A data frame of data source information
#'
#'
#' @export
getCdmSources <- function(baseUrl) {
  .checkBaseUrl(baseUrl)
  url <- sprintf("%s/source/sources", baseUrl)
  result <- .getApiResponseParse(url)

  for (i in (1:length(result$parsed$daimons))) {
    result$parsed$daimons[[i]]$sourceId <- result$parsed$sourceId[[i]]
  }

  daimons <- result$parsed$daimons %>%
    dplyr::bind_rows() %>%
    tidyr::spread(key = daimonType, value = tableQualifier) %>%
    dplyr::select(-sourceDaimonId) %>%
    base::replace(is.na(.), "") %>%
    dplyr::group_by(sourceId) %>%
    dplyr::summarise_all(max) %>%
    dplyr::mutate_all(dplyr::na_if,"") %>%
    dplyr::rename(
      cdmDatabaseSchema = CDM,
      vocabDatabaseSchema = Vocabulary,
      resultsDatabaseSchema = Results
    )

  result$parsed <- result$parsed %>%
    dplyr::select(-daimons) %>%
    dplyr::left_join(y = daimons, by = "sourceId")

  result$parsed
}


#' Get Priority Vocab Source Key
#'
#' @details
#' Obtains the vocabulary source key of the default OMOP Vocab in Atlas.
#'
#' @param baseUrl   The base URL for the WebApi instance, for example: "http://server.org:80/WebAPI".
#'
#' @return
#' A string with the source key of the default OMOP Vocab in Atlas.
#'
#'
#' @export
getPriorityVocabKey <- function(baseUrl) {
  .checkBaseUrl(baseUrl)
  url <- sprintf("%s/source/priorityVocabulary", baseUrl)
  result <- .getApiResponseParse(url)
  dplyr::tibble(sourceId = result$parsed$sourceId,
                 sourceName = result$parsed$sourceName,
                 sourceKey = result$parsed$sourceKey,
                 sourceDialect = result$parsed$sourceDialect,
                 vocabDatabaseSchema = result$parsed$daimons %>%
                                        dplyr::filter(toupper(daimonType) == toupper('vocabulary')) %>%
                                        dplyr::summarise(max(tableQualifier)) %>%
                                        dplyr::pull()
                )
}

#' Get configuration information for source keys.
#'
#' @details
#' Source keys are commonly used as aliases to identify a data source.
#' A data source is uniquely identified a combination of sourceName and/or CDM name.
#' sourceName/CDM name may also have version information.
#' WebApi calls rely on sourceKey for query. But relying on aliases
#' is not reliable, as the underlying data source may change.
#' This function, will give the configuration information for data sources
#' given source keys. It may be used to unambigously identify the data source
#' in a study.
#'
#' @param baseUrl        The base URL for the WebApi instance, for example:
#'                       "http://server.org:80/WebAPI".
#' @param sourceKeys     A list of string names for the source keys as in
#'                       configuration page of Atlas.
#' @return
#' A list of two objects called native and parsed. Native is the json
#' specification, and parsed is the simplified version returned as a data.frame
#' object. The data.frame object may be used for creating reports.
#'
#' @examples
#' \dontrun{
#' #
#'
#' getSourceKeyConfiguration(baseUrl = "http://server.org:80/WebAPI",
#'                                      sourceKeys = c('source1', 'source2')
#'                                    )$parsed
#' would return a data.frame with items like sourceId, sourceName, sourceDialect,
#' sourceKey, priority, CDM, CEM.
#' }
#'
#'
#' @export
getSourceKeyConfiguration <- function(baseUrl,sourceKeys){
  .checkBaseUrl(baseUrl)
  StudyManagement::getCdmSources(baseUrl) %>%
    dplyr::filter(toupper(sourceKey) %in% toupper(sourceKeys)) %>%
    tidyr::as_tibble()
}


#' compares given source keys to configured sourcekeys. get matched source keys
#'
#' @details
#' compares given source keys to configured sourcekeys. get matched source keys
#'
#' @param baseUrl        The base URL for the WebApi instance, for example:
#'                       "http://server.org:80/WebAPI".
#' @param sourceKeys     A list of string names for the source keys as in
#'                       configuration page of Atlas.
#' @return
#' A list of object representing the source keys in the Atlas webapi configuration
#'
#' @examples
#' \dontrun{
#' #
#'
#' getValidSourceKeys(baseUrl = "http://server.org:80/WebAPI", sourceKeys = c('schema1', 'schema2'))
#' }
#'
#'
#' @export
getValidSourceKeys <- function(baseUrl,sourceKeys){

  StudyManagement::getCdmSources(baseUrl) %$%
    parsed %>%
    dplyr::filter(toupper(sourceKey) %in% toupper(sourceKeys)) %>%
    dplyr::select(sourceKey) %>%
    dplyr::pull()
}


#' #' extracts metadata for a R objects
#' #'
#' #' @details
#' #' Creates a dataframe with meta-data for R-object
#' #'
#' #' @param X   an R-object
#' #'
#' #' @return
#' #' tibble data frame
#' #'
#' #'
#' #' @export
#' getMetaDataForRObject <- function(x){
#'
#'   result <- list(
#'     result = capture.output(str(object = x,
#'                             vec.len = 0,
#'                             digits.d = 0
#'                             )
#'                         ) %>%
#'     stringr::str_replace_all(pattern = "\\.", replacement = "")
#'     ) %>%
#'     data.frame() %>%
#'     dplyr::mutate(
#'             rowNumber = dplyr::row_number(),
#'             hierarchy = (stringr::str_locate(result, '\\$'))[,1] - 1
#'            ) %>%
#'     dplyr::mutate_all(~replace(.,is.na(.),0)) %>%
#'     dplyr::group_by(hierarchy) %>%
#'     dplyr::mutate(rowNumber2 = dplyr::row_number()) %>%
#'     dplyr::ungroup() %>%
#'     dplyr::mutate(result = stringr::str_replace_all(string = result, pattern = "\\$", replacement = "")) %>%
#'     dplyr::mutate(result = stringr::str_replace_all(string = result, pattern = "\\:", replacement = "")) %>%
#'     dplyr::mutate(result = stringr::str_replace_all(string = result, pattern = "List of", replacement = "listOf"))
#' }
#'