library(data.table)
source("R/globals.R") ## global variables and functions
#' @title Obtain a curation
#' @description \code{getCuration} requests a particular curation
#' according to user specified parameters from PharmacoDB web service.
#' @param curation the curation to be requested:
#'
#' "cell" is listing of cell lines in each study and corresponding synonyms
#'
#' "drug" is listing of drugs in each study and corresponding synonyms
#' "tissue" is listing of cell lines in each study, their corresponding tissue types,
#' and matching of tissue types in each study to COSMIC tissue types
#'
#' "histology" is listing of cell lines in each study, their corresponding histological subtypes,
#' matching between subtypes based on manual curation by BHK lab
#'
#' "gene_expression" is listing of gene expression metadata by study
#'
#' @param study optional vector of studies to subset curation
#' '
#' @param subtype optional vector of subtype so only curation for that subtype is displayed
#' only valid for "tissue", "histology" and "gene expression" curations
#'
#' @return list containing curations if found or NA if curation not found
#'
#' @examples
#' getCuration("cell")
#' ## get the complete cell line curation
#' getCuration("drug", study=c("CGP", "CCLE"))
#' ## get all drugs in CGP and in CCLE
#' getCuration("tissue", study=c("CCLE", "GRAY", "GNE"), subtype=c("breast", "testis"))
#' ## get all breast and testis cancer cell lines tested in CCLE and GRAY
#' getCuration("histology", subtype = "carcinoma")
#' ## get all cell lines which are carcinomas
#' getCuration("gene_expression", "MEIS")
#' ## returns warning since "MEIS" study does not exist
#' @export
getCuration <- function(curation = c("cell", "drug", "tissue", "histology", "gene_expression"), study = NULL, subtype = NULL) {
curation <- match.arg(curation)
## Check that subtype parameter used properly
if (!is.null(subtype) & curation %in% c("cell", "drug")) {
stop("Subtype or profile should not be specified for cell or drug curation.")
}
## Case with no subtypes - specified curation and optional study parameter
if (is.null(subtype)) {
curationFrames <- getCurationByStudy(curation, study)
}
## Case with a subtype
if (!is.null(subtype)) {
curationFrames <- getCurationByType(curation, subtype)
if (!is.null(study)) { ## Filter by study here
curationFrames <- filterByStudy(curationFrames, study)
}
}
return(curationFrames)
}
## Helper function to process a JSON curation and convert it into a dataframe
## json: json string
processJSONCuration <- function(json) {
df <- processJSON(json, "curation")
df <- do.call("rbind", df)
df <- data.frame(df)
return(df)
}
## Obtain a curation by study
## type: type of curation
## study: studies in which curation is requested
getCurationByStudy <- function(type, study) {
if (is.null(study)) {
url <- paste0(host, "/curation/", type, "/")
json <- getURL(url, ssl.verifypeer= FALSE)
df <- processJSONCuration(json)
}
else {
url <- sapply(study, function (x) paste0(host, "/curation/", type, "/", x, "/"))
df <- lapply(url, function (x) {
if (url.exists(x)) {
json <- getURL(x)
frame <- processJSONCuration(json)
return(frame)
}
else {
warning(paste("Curation at", x, "does not exist"))
NA
}
})
}
return(df)
}
## Obtain a curation by type
## type: type of curation
## subtype: subtypes requested
getCurationByType <- function(type, subtype) {
url <- sapply(subtype, function (x) paste0(host, "/curation/", type, "/type/", x, "/"))
df <- lapply(url, function (x) {
if (url.exists(x)) {
json <- getURL(x, ssl.verifypeer = FALSE)
frame <- processJSONCuration(json)
return(frame)
}
else {
warning(paste("Curation at", x, "does not exist"))
NA
}
})
return(df)
}
## filter obtained curations by type
## frames: list of curation
## study: studies to keep in curation
filterByStudy <- function(frames, study) {
curationFrames <- lapply(frames, function (frame) {
if (is.null(nrow(frame))) {
return(NA)
}
else {
frame[frame$study_name %in% study, ]
}})
return(curationFrames)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.