R/biolink_similarity.R

Defines functions biolink_similarity

Documented in biolink_similarity

#' Calculate phenotypic similarity between set of terms
#' @param metric metric
#' @param ref_id reference
#' @param query_id query
#' @importFrom tibble as_tibble
#' @importFrom dplyr rename bind_cols
#' @importFrom httr user_agent modify_url GET
#' @importFrom rlang .data
#' @rdname biolink_similarity
#' @export 
biolink_similarity <- function(ref_id, query_id, metric) {
  
  # Check internet connection
  check_internet()
  
  if (!(metric %in% c('phenodigm', 'jaccard', 'simGIC', 'resnik', 'symmetric_resnik'))) {
    stop("Metric not found")
  }
  
  
  names(ref_id) <- rep('ref_id', length(ref_id))
  ref_id <- as.list(ref_id)

  names(query_id) <- rep('query_id', length(query_id))
  query_id <- as.list(query_id)
  
  metric <- list(metric = metric)
  
  args <- append(ref_id, query_id)
  args <- append(args, metric)
  
  url <- modify_url(base_url, path = paste0('api/', 'sim/compare'))
  
  resp <- GET(url, user_agent = ua, query = args)
  
  check_response(resp)
  
  
  parsed <- jsonlite::fromJSON(content(resp, as = "text", encoding = 'UTF-8'), simplifyVector = TRUE)
  
  a <- parsed$matches$pairwise_match[[1]] %>%
    as_tibble()
  
  ref_tbl <- a$reference %>% rename(ref_ic = .data$IC, ref_id = .data$id, ref_label = .data$label)
  
  query_tbl <- a$match %>% rename(query_ic = .data$IC, query_id = .data$id, 
                                  query_label = .data$label)
  
  lcs_tbl <- a$lcs %>% rename(lcs_ic = .data$IC, lcs_id = .data$id, lcs_label = .data$label)
  
  result_tbl <- bind_cols(ref_tbl, query_tbl, lcs_tbl)
  
  result_tbl
  
}
frequena/rbiolink documentation built on May 16, 2020, 10:20 p.m.