R/getATC.r

Defines functions get_atc lookup_atc

Documented in get_atc

#' Retrieve ATC code from Wikidata
#'
#' @param query string / search keyword / chemical compound 
#' @return
#' dataframe
#' @export
#' @importFrom magrittr %>%
#'
#' @examples
#' \dontrun{
#' get_atc("Azilsartan", "Timolol")
#' }
#' 

get_atc <- function(...){

    queries <- list(...)
    return(do.call(rbind,lapply(queries, lookup_atc)))

}


lookup_atc <- function(query){

    cat(sprintf("Search for %s \n", query))

    # Find corresponding property to ATC code
    prop <- WikidataR::find_property("ATC code")[[1]]$id

    # Retrieve item based on chemical compound
    results <- WikidataR::find_item(query) %>%
            purrr::map_dfr(function(x) return(data.frame(id = x$id, match = x$match$text, url = x$url)))

    cat(sprintf("Found %i matches \n", nrow(results)))

    if(nrow(results) == 0 ) return(NULL)

    # Retrieve related ATC code
    items <- purrr::map(results$id, function(x) WikidataR::get_item(x))
    atc_codes <- purrr::map(items, function(x) unlist(WikidataR::extract_claims(x,prop), recursive = FALSE)[[1]]) %>%
                purrr::map_chr(function(x) return(ifelse(is.data.frame(x), x$mainsnak$datavalue$value, NA)))

    results$atc_codes <- atc_codes
    results$request <- query

    # Return lines with atc code
    results <- subset(results, !is.na(atc_codes))
    
    cat(sprintf("Return %i record(s) with ATC code \n", nrow(results)))

    return(results)
}
SteveViss/OmniMisc documentation built on March 17, 2020, 12:08 a.m.