##' @importClassesFrom AnnotationDbi AnnotationDb
##' @importFrom methods setRefClass
setRefClass("OntDb", contains="AnnotationDb")
#' @importMethodsFrom AnnotationDbi keys
#' @importMethodsFrom AnnotationDbi toTable
setMethod("keys", "OntDb",
function(x, keytype, ...){
if(missing(keytype)) keytype <- "id"
term <- toTable(x)
term[, keytype]
}
)
#' @importMethodsFrom AnnotationDbi keytypes
setMethod("keytypes", "OntDb",
function(x) {
c("id", "term")
}
)
#' @importFrom DBI dbReadTable
setMethod("toTable", "OntDb",
function(x) {
dbReadTable(dbconn(x), 'term') |>
setNames(c("id", "term"))
}
)
#' @importMethodsFrom AnnotationDbi select
#' @importMethodsFrom AnnotationDbi dbconn
setMethod("select", "OntDb",
function(x, keys, columns, keytype, ...){
if (missing(keytype)) keytype <- "id"
keytype <- match.arg(keytype, c("id","term"))
strKeys <- paste0("\"", keys, "\"", collapse = ",")
if (keytype == "term") {
sql_key <- paste("SELECT doid FROM do_term WHERE term in (",
strKeys, ")")
doids <- dbQuery(dbconn(x), sql_key)[, 1]
strKeys <- paste0("\"", doids, "\"", collapse = ",")
}
columns <- unique(c("id", columns))
sqls <- paste("SELECT ", paste(columns, collapse = ","),
" FROM term")
columns2 <- setdiff(columns, c("id", "term"))
for (col in columns2) {
leftJoin <- paste0("LEFT JOIN ", col, " USING (id)")
sqls <- c(sqls, leftJoin)
}
sqls <- c(sqls, paste0("WHERE term.id in (", strKeys, ")"))
sqls <- paste(sqls, collapse = " ")
res <- dbQuery(dbconn(x), sqls)
res
}
)
dbQuery <- getFromNamespace("dbQuery", "AnnotationDbi")
#' @importMethodsFrom AnnotationDbi columns
setMethod("columns", "OntDb",
function(x) {
c("id","term", "alias", "synonym", "parent", "children",
"ancestor", "offspring")
}
)
get_onto_data <- function(ont = "HDO", output='list', table="offspring") {
x <- load_onto(ont)
output <- match.arg(output, c("data.frame", "list"))
res <- dbReadTable(dbconn(x), table)
if (output == 'data.frame') return(res)
# column 1 is ID, column 2 is the related term
split(res[,2], res[,1])
}
#' @importFrom digest digest
#' @importFrom AnnotationDbi loadDb
load_onto <- function(onto = "HDO") {
.env <- get_gosemsim_env()
.onto <- sprintf(".onto_%s", onto)
if (exists(.onto, envir=.env)) {
db <- get(.onto, envir=.env)
return(db)
}
dir <- rappdirs::user_data_dir("GOSemSim", appauthor=NULL)
if (!dir.exists(dir)) dir.create(dir)
dbfile0 <- sprintf("%s.sqlite", onto)
dbfile <- normalizePath(file.path(dir, dbfile0))
if (file.exists(dbfile)) {
md5 <- read.delim('https://yulab-smu.top/DOSE/md5.txt', header=FALSE)
md5_remote <- md5[md5[,1] == dbfile0, 2]
md5_local <- digest::digest(dbfile, algo='md5', file=TRUE)
if (md5_remote != md5_local) {
msg <- sprintf("%s is outdated, download the latest version...\n", dbfile0)
cat(msg)
need_dl <- TRUE
} else {
need_dl <- FALSE
}
} else {
msg <- sprintf("%s is not found, download it online...\n", dbfile0)
cat(msg)
need_dl <- TRUE
}
if (need_dl) {
url <- sprintf('https://yulab-smu.top/DOSE/%s.gz', dbfile0)
gzdbfile <- sprintf("%s.gz", dbfile)
mydownload(url, gzdbfile)
R.utils::gunzip(gzdbfile, overwrite = TRUE)
}
db <- loadDb(dbfile)
assign(.onto, db, envir = .env)
return(db)
}
#' @importFrom httr2 request
#' @importFrom httr2 req_progress
#' @importFrom httr2 req_perform
mydownload <- function(url, destfile) {
req <- request(url) |>
req_progress()
req |> req_perform(path = destfile)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.