From 1a0b53a77b411d5fb0420343a13a5856ca324cc5 Mon Sep 17 00:00:00 2001 From: lgatto Date: Sat, 10 Feb 2024 00:50:02 +0100 Subject: [PATCH 01/11] refactored Ontology and Ontologies --- DESCRIPTION | 4 +- NAMESPACE | 3 +- NEWS.md | 6 ++ R/AllClasses.R | 35 +++++---- R/AllGenerics.R | 3 +- R/methods-Ontologies.R | 160 +++++++++++++++++++++++++++-------------- R/utils.R | 47 +----------- man/makeOntologies.Rd | 20 ------ man/makeOntology.Rd | 19 ----- 9 files changed, 141 insertions(+), 156 deletions(-) delete mode 100644 man/makeOntologies.Rd delete mode 100644 man/makeOntology.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 13f1020..92dca0f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rols Type: Package Title: An R interface to the Ontology Lookup Service -Version: 2.31.0 +Version: 2.99.0 Authors@R: c(person(given = "Laurent", family = "Gatto", email = "laurent.gatto@uclouvain.be", role = c("aut","cre")), @@ -13,7 +13,7 @@ Description: The rols package is an interface to the Ontology Lookup Service (OLS) to access and query hundred of ontolgies directly from R. Depends: methods -Imports: httr, progress, jsonlite, utils, Biobase, +Imports: httr2, jsonlite, utils, Biobase, BiocGenerics (>= 0.23.1) Suggests: GO.db, knitr (>= 1.1.0), BiocStyle (>= 2.5.19), testthat, lubridate, DT, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index 62bbe7c..12c673b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,7 @@ import(methods) import(utils) -import(httr) +import(httr2) import(jsonlite) -import(progress) importFrom(Biobase, validMsg) importFrom(BiocGenerics, Ontology) importClassesFrom(Biobase, Versioned) diff --git a/NEWS.md b/NEWS.md index a559562..bfb8950 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# rols 2.99 + +## CHANGES IN VERSION 2.99.0 + +- Refactoring to use REST API for OLS4. + # rols 2.29 ## CHANGES IN VERSION 2.29.1 diff --git a/R/AllClasses.R b/R/AllClasses.R index 58f78a9..136cc75 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -1,7 +1,8 @@ setClassUnion("NullOrChar", c("NULL", "character")) setClassUnion("NullOrList", c("NULL", "list")) -## a param is [CV label, accession, name|synonym, value] +############################################################ +## A param is [CV label, accession, name|synonym, value] .CVParam <- setClass("CVParam", representation = representation( label = "character", @@ -12,7 +13,7 @@ setClassUnion("NullOrList", c("NULL", "list")) contains = "Versioned", prototype = prototype( user = FALSE, - new("Versioned", versions=c(CVParam="0.2.0"))), + new("Versioned", versions = c(CVParam="0.2.0"))), validity = function(object) { msg <- validMsg(NULL, NULL) if (object@user) { @@ -34,19 +35,27 @@ setClassUnion("NullOrList", c("NULL", "list")) if (is.null(msg)) TRUE else msg }) - +############################################################ +## A single ontology .Ontology <- setClass("Ontology", - slots = c(loaded = "NullOrChar", - updated = "NullOrChar", - status = "NullOrChar", - message = "NullOrChar", - version = "NullOrChar", - numberOfTerms = "integer", - numberOfProperties = "integer", - numberOfIndividuals = "integer", - config = "list" - )) + slots = c( + languages = "list", + lang = "character", + ontologyId = "character", + loaded = "NullOrChar", + updated = "NullOrChar", + status = "NullOrChar", + message = "NullOrChar", + version = "NullOrChar", + numberOfTerms = "integer", + numberOfProperties = "integer", + numberOfIndividuals = "integer", + config = "list", + links = "list" + )) +############################################################ +## A list of Ontology instances .Ontologies <- setClass("Ontologies", slots = c(x = "list")) .Term <- setClass("Term", diff --git a/R/AllGenerics.R b/R/AllGenerics.R index f9e142d..d9c7294 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -1,5 +1,4 @@ -setGeneric("Ontologies", function(object) standardGeneric("Ontologies")) -## setGeneric("Ontology", function(object) standardGeneric("Ontology")) +setGeneric("Ontologies", function() standardGeneric("Ontologies")) setGeneric("olsPrefix", function(object, ...) standardGeneric("olsPrefix")) setGeneric("olsDesc", function(object, ...) standardGeneric("olsDesc")) diff --git a/R/methods-Ontologies.R b/R/methods-Ontologies.R index 6e9309c..76b8360 100644 --- a/R/methods-Ontologies.R +++ b/R/methods-Ontologies.R @@ -3,24 +3,17 @@ setMethod("Ontologies", "missing", function() makeOntologies()) -setMethod("Ontologies", "numeric", - function(object) makeOntologies(object)) - setMethod("Ontology", "character", function(object) { + ## make urls from ontologyId url <- ontologyUrl(object) - x <- GET(url) - stop_for_status(x) - cx <- content(x) - makeOntology(cx) + httr2:::check_request(request(url)) + makeOntology(url) }) -setMethod("Ontology", "Ontology", - function(object) object) ########################################## ## show methods - setMethod("show", "Ontology", function(object) { cat("Ontology: ", olsTitle(object), @@ -70,21 +63,21 @@ setMethod("olsUpdated", "Ontology", setMethod("olsUpdated", "Ontologies", function(object) sapply(object@x, olsUpdated)) -setMethod("olsRoot", "character", - function(object) { - url <- ontologyUrl(object) - url <- paste0(url, "/terms/roots") - x <- GET(url) - stop_for_status(x) - cx <- content(x) - ans <- lapply(cx[["_embedded"]][[1]], makeTerm) - names(ans) <- sapply(ans, termId) - Terms(x = ans) - }) -setMethod("olsRoot", "Ontology", - function(object) olsRoot(olsPrefix(object))) -setMethod("olsRoot", "Ontologies", - function(object) lapply(object@x, olsRoot)) +## setMethod("olsRoot", "character", +## function(object) { +## url <- ontologyUrl(object) +## url <- paste0(url, "/terms/roots") +## x <- GET(url) +## stop_for_status(x) +## cx <- content(x) +## ans <- lapply(cx[["_embedded"]][[1]], makeTerm) +## names(ans) <- sapply(ans, termId) +## Terms(x = ans) +## }) +## setMethod("olsRoot", "Ontology", +## function(object) olsRoot(olsPrefix(object))) +## setMethod("olsRoot", "Ontologies", +## function(object) lapply(object@x, olsRoot)) setMethod("olsPrefix", "character", function(object) olsPrefix(Ontology(object))) @@ -159,33 +152,34 @@ as.data.frame.Ontologies <- function(x) { setAs("Ontologies", "list", function(from) from@x) -setMethod("all.equal", c("Ontologies", "Ontologies"), - function(target, current) { - msg <- Biobase::validMsg(NULL, NULL) - if (length(target) != length(current)) { - msg <- Biobase::validMsg(msg, "The 2 Ontologies are of different lengths") - } else { - tg <- target@x - ct <- current@x - if (any(sort(names(tg)) != sort(names(ct)))) { - msg <- validMsg(msg, "Ontology names don't match") - } else { - ## reorder before comparing Ontolgy objects one - ## by one - tg <- tg[order(names(tg))] - ct <- ct[order(names(ct))] - for (i in seq_along(tg)) { - eq <- all.equal(tg[[i]], ct[[i]]) - if (is.character(eq)) { - eq <- paste0("Ontology '", names(tg)[i], "': ", eq) - msg <- validMsg(msg, eq) - } - } - } - } - if (is.null(msg)) return(TRUE) - else msg - }) +## ## Ontologies aren't names anymore (for now) +## setMethod("all.equal", c("Ontologies", "Ontologies"), +## function(target, current) { +## msg <- Biobase::validMsg(NULL, NULL) +## if (length(target) != length(current)) { +## msg <- Biobase::validMsg(msg, "The 2 Ontologies are of different lengths") +## } else { +## tg <- target@x +## ct <- current@x +## if (any(sort(names(tg)) != sort(names(ct)))) { +## msg <- validMsg(msg, "Ontology names don't match") +## } else { +## ## reorder before comparing Ontolgy objects one +## ## by one +## tg <- tg[order(names(tg))] +## ct <- ct[order(names(ct))] +## for (i in seq_along(tg)) { +## eq <- all.equal(tg[[i]], ct[[i]]) +## if (is.character(eq)) { +## eq <- paste0("Ontology '", names(tg)[i], "': ", eq) +## msg <- validMsg(msg, eq) +## } +## } +## } +## } +## if (is.null(msg)) return(TRUE) +## else msg +## }) setMethod("all.equal", c("Ontology", "Ontology"), function(target, current) { @@ -204,3 +198,65 @@ setMethod("all.equal", c("Ontology", "Ontology"), msg <- Biobase::validMsg(msg, all.equal(c1, c2)) if (is.null(msg)) TRUE else msg }) + + +ontologyFromJson <- function(x) { + .Ontology(languages = x[["languages"]], + lang = x[["lang"]], + ontologyId = x[["ontologyId"]], + loaded = x[["loaded"]], + updated = x[["updated"]], + status = x[["status"]], + message = x[["message"]], + version = x[["version"]], + numberOfTerms = x[["numberOfTerms"]], + numberOfProperties = x[["numberOfProperties"]], + numberOfIndividuals = x[["numberOfIndividuals"]], + config = x[["config"]], + links = x[["_links"]]) +} + +########################################## +## Helper functions + +##' @title Makes an Ontologies instance with all ontologies +##' +##' @return An object of class Ontologies, i.e. a list on Ontology +##' instances. +##' +##' @noRd +makeOntologies <- function() { + url <- "https://www.ebi.ac.uk/ols4/api/ontologies/" + next_req <- function(resp, req) { + .next <- resp_body_json(resp)[["_links"]][["next"]]$href + if (is.null(.next)) + return(NULL) + request(.next) + } + x <- lapply( + req_perform_iterative( + request(url), + next_req, + progress = TRUE), + function(resp) { + body <- resp_body_json(resp) + body[["_embedded"]][["ontologies"]] + }) |> unlist(recursive = FALSE) + .Ontologies(x = lapply(x, ontologyFromJson)) +} + +makeOntology <- function(url) { + request(url) |> + req_perform() |> + resp_body_json() |> + ontologyFromJson() +} + +setMethod("ontologyUrl", "character", + function(object) + paste0("https://www.ebi.ac.uk/ols4/api/ontologies/", + object, "/")) + +setMethod("ontologyUrl", "Ontology", + function(object) + ontologyUrl(olsNamespace(object))) diff --git a/R/utils.R b/R/utils.R index 5b8f2ce..9b8373b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,13 +1,3 @@ -setMethod("ontologyUrl", "character", - function(object) - paste0("http://www.ebi.ac.uk/ols/beta/api/ontologies/", object, "/")) - -setMethod("ontologyUrl", "Ontology", - function(object) { - nsp <- olsNamespace(object) - paste0("http://www.ebi.ac.uk/ols/beta/api/ontologies/", nsp, "/") - }) - ## This will not always be the correct URI (see for example ## Orphaned/ORBO and https://github.com/EBISPOT/OLS/issues/35) setMethod("ontologyUri", "missing", @@ -37,45 +27,10 @@ setMethod("ontologyUri", "Ontology", uri }) -.termId <- function(x) x@obo_id -##' @title Makes an Ontology instance based on the response from -##' /api/ontologies/{ontology_id} -##' @param x A valid onology prefix -##' @return An object of class Ontology -makeOntology <- function(x) - .Ontology(loaded = x$loaded, - updated = x$updated, - status = x$status, - message = x$message, - version = x$version, - numberOfTerms = x$numberOfTerms, - numberOfProperties = x$numberOfProperties, - numberOfIndividuals = x$numberOfIndividuals, - config = x$config) +.termId <- function(x) x@obo_id -##' @title Makes an Ontologies instance based on the response from -##' api/ontologies @return -##' @return An object of class Ontologies -##' @param pagesize A numeric indicating the number of elements per -##' page (default in method is 150). -makeOntologies <- function(pagesize = 150) { - x <- GET(paste0("http://www.ebi.ac.uk/ols/beta/api/ontologies?page=0&size=", - pagesize)) - warn_for_status(x) - cx <- content(x) - if (cx$page$totalElements > pagesize) { - pagesize <- cx$page$totalElements - x <- GET(paste0("http://www.ebi.ac.uk/ols/beta/api/ontologies?page=0&size=", - pagesize)) - warn_for_status(x) - cx <- content(x) - } - ans <- lapply(cx[["_embedded"]][[1]], makeOntology) - names(ans) <- sapply(ans, olsNamespace) - .Ontologies(x = ans) -} ##' @title Makes a Term instance based on the response from ##' /api/ontologies/{ontology}/terms/{iri} diff --git a/man/makeOntologies.Rd b/man/makeOntologies.Rd deleted file mode 100644 index db7d075..0000000 --- a/man/makeOntologies.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{makeOntologies} -\alias{makeOntologies} -\title{Makes an Ontologies instance based on the response from - api/ontologies @return} -\usage{ -makeOntologies(pagesize = 150) -} -\arguments{ -\item{pagesize}{A numeric indicating the number of elements per -page (default in method is 150).} -} -\value{ -An object of class Ontologies -} -\description{ -Makes an Ontologies instance based on the response from - api/ontologies @return -} diff --git a/man/makeOntology.Rd b/man/makeOntology.Rd deleted file mode 100644 index 2fa9257..0000000 --- a/man/makeOntology.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{makeOntology} -\alias{makeOntology} -\title{Makes an Ontology instance based on the response from - /api/ontologies/{ontology_id}} -\usage{ -makeOntology(x) -} -\arguments{ -\item{x}{A valid onology prefix} -} -\value{ -An object of class Ontology -} -\description{ -Makes an Ontology instance based on the response from - /api/ontologies/{ontology_id} -} From 53d121c8d2d8bbcb438316d54bb06e1362bf0ac6 Mon Sep 17 00:00:00 2001 From: lgatto Date: Sat, 10 Feb 2024 13:01:51 +0100 Subject: [PATCH 02/11] Terms/Term (except Term constructor) working --- DESCRIPTION | 4 +- NAMESPACE | 1 - R/AllClasses.R | 20 ++++++--- R/AllGenerics.R | 3 +- R/methods-Ontologies.R | 20 +++------ R/methods-Terms.R | 91 +++++++++++++++++++++++++++++++++------ R/utils.R | 96 ++++++++++++++++++++---------------------- 7 files changed, 146 insertions(+), 89 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 92dca0f..940190f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,7 +13,7 @@ Description: The rols package is an interface to the Ontology Lookup Service (OLS) to access and query hundred of ontolgies directly from R. Depends: methods -Imports: httr2, jsonlite, utils, Biobase, +Imports: httr2, utils, Biobase, BiocGenerics (>= 0.23.1) Suggests: GO.db, knitr (>= 1.1.0), BiocStyle (>= 2.5.19), testthat, lubridate, DT, rmarkdown, @@ -21,7 +21,7 @@ biocViews: ImmunoOncology, Software, Annotation, MassSpectrometry, GO VignetteBuilder: knitr License: GPL-2 Encoding: UTF-8 -URL: http://lgatto.github.com/rols/ +URL: http://lgatto.github.io/rols/ BugReports: https://github.com/lgatto/rols/issues Collate: AllClasses.R AllGenerics.R utils.R cvparam.R methods-OlsSearch.R methods-Ontologies.R methods-Terms.R diff --git a/NAMESPACE b/NAMESPACE index 12c673b..654e543 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,6 @@ import(methods) import(utils) import(httr2) -import(jsonlite) importFrom(Biobase, validMsg) importFrom(BiocGenerics, Ontology) importClassesFrom(Biobase, Versioned) diff --git a/R/AllClasses.R b/R/AllClasses.R index 136cc75..6d4bf26 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -1,10 +1,11 @@ setClassUnion("NullOrChar", c("NULL", "character")) setClassUnion("NullOrList", c("NULL", "list")) +setClassUnion("NullOrLogical", c("NULL", "logical")) ############################################################ ## A param is [CV label, accession, name|synonym, value] .CVParam <- setClass("CVParam", - representation = representation( + slots = c( label = "character", accession = "character", name = "character", @@ -60,22 +61,29 @@ setClassUnion("NullOrList", c("NULL", "list")) .Term <- setClass("Term", slots = c(iri = "character", - label = "character", + lang = "character", description = "NullOrList", - annotation = "list", - synonym = "NullOrList", + synonyms = "NullOrList", + annotation = "NullOrList", + label = "character", ontology_name = "character", ontology_prefix = "character", ontology_iri = "character", is_obsolete = "logical", + term_replaced_by = "NullOrChar", is_defining_ontology = "logical", has_children = "logical", is_root = "logical", - short_form = "character", + short_form = "NullOrChar", obo_id = "NullOrChar", + in_subset = "NullOrList", + obo_definition_citation = "NullOrList", + obo_xref = "NullOrList", + obo_synonym = "NullOrChar", + is_preferred_root = "logical", links = "list")) -Terms <- setClass("Terms", slots = c(x = "list")) +.Terms <- setClass("Terms", slots = c(x = "list")) .OlsSearch <- setClass("OlsSearch", slots = c(q = "character", diff --git a/R/AllGenerics.R b/R/AllGenerics.R index d9c7294..0319e29 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -1,4 +1,5 @@ -setGeneric("Ontologies", function() standardGeneric("Ontologies")) +setGeneric("Ontologies", function(object) standardGeneric("Ontologies")) +setGeneric("Terms", function(x, ...) standardGeneric("Terms")) setGeneric("olsPrefix", function(object, ...) standardGeneric("olsPrefix")) setGeneric("olsDesc", function(object, ...) standardGeneric("olsDesc")) diff --git a/R/methods-Ontologies.R b/R/methods-Ontologies.R index 76b8360..b89a6b0 100644 --- a/R/methods-Ontologies.R +++ b/R/methods-Ontologies.R @@ -1,7 +1,7 @@ ########################################## ## Constructors setMethod("Ontologies", "missing", - function() makeOntologies()) + function(object) makeOntologies()) setMethod("Ontology", "character", function(object) { @@ -227,21 +227,14 @@ ontologyFromJson <- function(x) { ##' @noRd makeOntologies <- function() { url <- "https://www.ebi.ac.uk/ols4/api/ontologies/" - next_req <- function(resp, req) { - .next <- resp_body_json(resp)[["_links"]][["next"]]$href - if (is.null(.next)) - return(NULL) - request(.next) - } x <- lapply( req_perform_iterative( request(url), next_req, progress = TRUE), - function(resp) { - body <- resp_body_json(resp) - body[["_embedded"]][["ontologies"]] - }) |> unlist(recursive = FALSE) + resp_embedded, + what = "ontologies") |> + unlist(recursive = FALSE) .Ontologies(x = lapply(x, ontologyFromJson)) } @@ -255,8 +248,7 @@ makeOntology <- function(url) { setMethod("ontologyUrl", "character", function(object) paste0("https://www.ebi.ac.uk/ols4/api/ontologies/", - object, "/")) + object)) setMethod("ontologyUrl", "Ontology", - function(object) - ontologyUrl(olsNamespace(object))) + function(object) object@links$self$href) diff --git a/R/methods-Terms.R b/R/methods-Terms.R index 213b3ce..5703737 100644 --- a/R/methods-Terms.R +++ b/R/methods-Terms.R @@ -1,17 +1,54 @@ ########################################## ## Constructors -## These methods query an Ontology (or its prefix) for all or one term -setMethod("terms", "character", - function(x, ...) .terms(x, ...)) -setMethod("terms", "Ontology", - function(x, ...) .terms(olsNamespace(x), ...)) - -setMethod("term", c("character", "character"), - function(object, id, ...) .term(object, id, ...)) -setMethod("term", c("Ontology", "character"), - function(object, id,...) .term(object, id, ...)) +## Using the ontologyId +setMethod("Terms", "character", + function(x, pagesize = 1000) + makeTerms(x, pagesize)) + +## Using an Ontology instance +setMethod("Terms", "Ontology", + function(x, pagesize = 1000) + makeTerms(x, pagesize)) + + +##' @title Constructs the query for all term from a given ontology +##' +##' @param oid `character(1)` with an ontologyIf or an `Ontology` +##' instance. +##' +##' @param pagesize `numerci(1)` indicating the number of results per +##' page to return. Default is `1000`. +##' +##' @return An object of class Terms +##' +makeTerms <- function(oid, pagesize) { + ont <- Ontology(oid) + url <- paste0(ont@links$terms$href) + ## url <- paste(ontologyUrl(ont), "terms", sep = "/") + url <- paste0(url, "?&size=", as.integer(pagesize)) + x <- lapply( + req_perform_iterative( + request(url), + next_req, + progress = TRUE), + resp_embedded, + what = "terms") |> + unlist(recursive = FALSE) + ans <- lapply(x, termFromJson) + names(ans) <- sapply(ans, termId) + .Terms(x = ans) +} +## These methods query an Ontology (or its prefix) for all or one term +## setMethod("terms", "character", +## function(x, ...) .terms(x, ...)) +## setMethod("terms", "Ontology", +## function(x, ...) .terms(olsNamespace(x), ...)) +## setMethod("term", c("character", "character"), +## function(object, id, ...) .term(object, id, ...)) +## setMethod("term", c("Ontology", "character"), +## function(object, id,...) .term(object, id, ...)) partOf <- function(id) { @@ -193,10 +230,9 @@ setMethod("show", "Terms", ## Accessors setMethod("termSynonym", "Term", - function(object) unlist(object@synonym)) + function(object) unlist(object@synonyms)) setMethod("termSynonym", "Terms", - function(object) sapply(object@x, termSynonym)) - + function(object) lapply(object@x, termSynonym)) setMethod("isObsolete", "Term", function(object) object@is_obsolete) @@ -243,7 +279,7 @@ setMethod("termNamespace", "Terms", setMethod("length", "Terms", function(x) length(x@x)) -setMethod("unique", "Terms", function(x) x[!duplicated(names(x@x))]) +## setMethod("unique", "Terms", function(x) x[!duplicated(names(x@x))]) setMethod("[", "Terms", function(x, i, j="missing", drop="missing") Terms(x = x@x[i])) @@ -333,3 +369,30 @@ setAs("Terms", "data.frame", as.Terms.data.frame <- function(x) as(x, "data.frame") + +############################################# +## utils +termFromJson <- function(x) { + .Term(iri = x[["iri"]], + lang = x[["lang"]], + description = x[["description"]], + synonyms = x[["synonyms"]], + annotation = x[["annotation"]], + label = x[["label"]], + ontology_name = x[["ontology_name"]], + ontology_prefix = x[["ontology_prefix"]], + ontology_iri = x[["ontology_iri"]], + is_obsolete = x[["is_obsolete"]], + term_replaced_by = x[["term_replaced_by"]], + is_defining_ontology = x[["is_defining_ontology"]], + has_children = x[["has_children"]], + is_root = x[["is_root"]], + short_form = x[["short_form"]], + obo_id = x[["obo_id"]], + in_subset = x[["in_subset"]], + obo_definition_citation = x[["obo_definition_citation"]], + obo_xref = x[["obo_xref"]], + obo_synonym = x[["obo_synonym"]], + is_preferred_root = x[["is_preferred_root"]], + links = x[["_links"]]) +} diff --git a/R/utils.R b/R/utils.R index 9b8373b..a6a4026 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,3 +1,18 @@ +##################################### +## httr2 utils +next_req <- function(resp, req) { + .next <- resp_body_json(resp)[["_links"]][["next"]]$href + if (is.null(.next)) + return(NULL) + request(.next) +} + +resp_embedded <- function(resp, what) { + body <- resp_body_json(resp) + body[["_embedded"]][[what]] +} + + ## This will not always be the correct URI (see for example ## Orphaned/ORBO and https://github.com/EBISPOT/OLS/issues/35) setMethod("ontologyUri", "missing", @@ -32,37 +47,43 @@ setMethod("ontologyUri", "Ontology", .termId <- function(x) x@obo_id -##' @title Makes a Term instance based on the response from -##' /api/ontologies/{ontology}/terms/{iri} -##' @param x The content from the response -##' @return An object of class Term -makeTerm <- function(x) - .Term(iri = x$iri, - label = x$label, - description = x$description, - annotation = x$annotation, - synonym = x$synonym, - ontology_name = x$ontology_name, - ontology_prefix = x$ontology_prefix, - ontology_iri = x$ontology_iri, - is_obsolete = x$is_obsolete, - is_defining_ontology = x$is_defining_ontology, - has_children = x$has_children, - is_root = x$is_root, - short_form = x$short_form, - obo_id = x$obo_id, - links = x$`_links`) +## ##' @title Makes a Term instance based on the response from +## ##' /api/ontologies/{ontology}/terms/{iri} +## ##' @param x The content from the response +## ##' @return An object of class Term +## makeTerm <- function(x) +## .Term(iri = x$iri, +## label = x$label, +## description = x$description, +## annotation = x$annotation, +## synonym = x$synonym, +## ontology_name = x$ontology_name, +## ontology_prefix = x$ontology_prefix, +## ontology_iri = x$ontology_iri, +## is_obsolete = x$is_obsolete, +## is_defining_ontology = x$is_defining_ontology, +## has_children = x$has_children, +## is_root = x$is_root, +## short_form = x$short_form, +## obo_id = x$obo_id, +## links = x$`_links`) + ##' @title Constructs the query for a single term from a given ##' ontology -##' @param oid A character with an ontology or an ontology -##' @param termid A character with a term id -##' @return An object of class Term +##' +##' @param oid `character(1)` containg the ontologyId or an `Ontology` +##' instance. +##' +##' @param termid `character(1)` with a term id. +##' +##' @return An object of class `Term` .term <- function(oid, termid) { ont <- Ontology(oid) + ## url <- paste0(ont@links$terms$href, "/") url <- paste0(ontologyUrl(ont), "terms", "/") - uri <- URLencode(ontologyUri(ont), TRUE) + ## uri <- URLencode(ontologyUri(ont), TRUE) url <- paste0(url, uri, sub(":", "_", termid)) x <- GET(url) stop_for_status(x) @@ -70,33 +91,6 @@ makeTerm <- function(x) makeTerm(cx) } -##' @title Constructs the query for all term from a given ontology -##' @param oid A character with an ontology or an ontology -##' @param pagesize How many results per page to return -##' @return An object of class Terms -.terms <- function(oid, pagesize = 1000) { - ont <- Ontology(oid) - url <- paste(ontologyUrl(ont), "terms", sep = "/") - url <- paste0(url, "?&size=", pagesize) - x <- GET(url) - stop_for_status(x) - cx <- content(x) - ans <- lapply(cx[["_embedded"]][[1]], makeTerm) - ## -- Iterating - .next <- cx[["_links"]][["next"]]$href - pb <- progress_bar$new(total = cx[["page"]][["totalPages"]]) - pb$tick() - while (!is.null(.next)) { - pb$tick() - x <- GET(.next) - warn_for_status(x) - cx <- content(x) - ans <- append(ans, lapply(cx[["_embedded"]][[1]], makeTerm)) - .next <- cx[["_links"]][["next"]][[1]] - } - names(ans) <- sapply(ans, termId) - Terms(x = ans) -} ##' @title Constructs the query for all properties from a given ontology ##' @param oid A character with an ontology or an ontology From 9fc67c93663a3ddbc20f359a75aba7f9d186ddc6 Mon Sep 17 00:00:00 2001 From: lgatto Date: Sun, 11 Feb 2024 00:14:58 +0100 Subject: [PATCH 03/11] Related terms, roxygen and file refactoring --- DESCRIPTION | 4 +- NAMESPACE | 15 +- R/AllClasses.R | 107 +----- R/AllGenerics.R | 3 + R/{methods-OlsSearch.R => OlsSearch.R} | 31 +- R/Ontologies.R | 483 +++++++++++++++++++++++ R/Properties.R | 66 ++++ R/Terms.R | 512 +++++++++++++++++++++++++ R/cvparam.R | 47 ++- R/methods-Ontologies.R | 254 ------------ R/methods-Properties.R | 61 --- R/methods-Terms.R | 398 ------------------- R/utils.R | 186 +++------ R/zzz.R | 4 +- man/Ontology-class.Rd | 76 ++-- man/Term-class.Rd | 42 +- man/dot-properties.Rd | 19 - man/dot-term.Rd | 21 - man/dot-terms.Rd | 19 - man/makeProperty.Rd | 19 - man/makeTerm.Rd | 19 - tests/testthat/test_Onologies.R | 33 +- 22 files changed, 1273 insertions(+), 1146 deletions(-) rename R/{methods-OlsSearch.R => OlsSearch.R} (82%) create mode 100644 R/Ontologies.R create mode 100644 R/Properties.R create mode 100644 R/Terms.R delete mode 100644 R/methods-Ontologies.R delete mode 100644 R/methods-Properties.R delete mode 100644 R/methods-Terms.R delete mode 100644 man/dot-properties.Rd delete mode 100644 man/dot-term.Rd delete mode 100644 man/dot-terms.Rd delete mode 100644 man/makeProperty.Rd delete mode 100644 man/makeTerm.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 940190f..16dbc89 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,8 +13,8 @@ Description: The rols package is an interface to the Ontology Lookup Service (OLS) to access and query hundred of ontolgies directly from R. Depends: methods -Imports: httr2, utils, Biobase, - BiocGenerics (>= 0.23.1) +Imports: httr2, httr, jsonlite, + utils, Biobase, BiocGenerics (>= 0.23.1) Suggests: GO.db, knitr (>= 1.1.0), BiocStyle (>= 2.5.19), testthat, lubridate, DT, rmarkdown, biocViews: ImmunoOncology, Software, Annotation, MassSpectrometry, GO diff --git a/NAMESPACE b/NAMESPACE index 654e543..67ae5c2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,8 @@ import(methods) import(utils) import(httr2) +import(httr) +import(jsonlite) importFrom(Biobase, validMsg) importFrom(BiocGenerics, Ontology) importClassesFrom(Biobase, Versioned) @@ -8,8 +10,8 @@ importClassesFrom(Biobase, Versioned) exportClasses(CVParam, Term, Terms, Ontology, Ontologies, - OlsSearch, - Property, Properties) + OlsSearch) + ## Property, Properties) S3method(as.data.frame, OlsSearch) @@ -20,12 +22,15 @@ exportMethods(show, unique, ## Ontology/ies Ontology, Ontologies, + Terms, + ## Term, olsRoot, olsPrefix, olsDesc, olsTitle, olsStatus, olsNamespace, + olsLinks, ## Term/s all.equal, termLabel, @@ -34,9 +39,9 @@ exportMethods(show, termOntology, termDesc, term, terms, - termId, + termId) ## Property/ies - properties) + ## properties) export(charIsCVParam, CVParam, @@ -50,7 +55,7 @@ export(charIsCVParam, CVParam, termSynonym, children, parents, ancestors, descendants, - derivesFrom, partOf, + ## derivesFrom, partOf, as.Term.data.frame, as.Terms.data.frame, ## Search/select diff --git a/R/AllClasses.R b/R/AllClasses.R index 6d4bf26..117ad96 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -1,108 +1,3 @@ setClassUnion("NullOrChar", c("NULL", "character")) setClassUnion("NullOrList", c("NULL", "list")) -setClassUnion("NullOrLogical", c("NULL", "logical")) - -############################################################ -## A param is [CV label, accession, name|synonym, value] -.CVParam <- setClass("CVParam", - slots = c( - label = "character", - accession = "character", - name = "character", - value = "character", - user = "logical"), - contains = "Versioned", - prototype = prototype( - user = FALSE, - new("Versioned", versions = c(CVParam="0.2.0"))), - validity = function(object) { - msg <- validMsg(NULL, NULL) - if (object@user) { - if (!all(c(object@label, object@accession) == "")) - msg <- "Label and accession must be empty in UserParams." - } else { - x <- c(object@label, object@accession, - object@name, object@value) == "" - if (!all(x)) { - ._term <- term(object@label, object@accession) - ._label <- termLabel(._term) - ._synonyms <- termSynonym(._term) - if (!(object@name %in% c(._label, ._synonyms))) - msg <- paste0("CVParam accession and name/synomyms do not match. Got [", - paste(c(._label, ._synonyms), collapse = ", "), - "], expected '", object@name, "'.") - } - } - if (is.null(msg)) TRUE else msg - }) - -############################################################ -## A single ontology -.Ontology <- setClass("Ontology", - slots = c( - languages = "list", - lang = "character", - ontologyId = "character", - loaded = "NullOrChar", - updated = "NullOrChar", - status = "NullOrChar", - message = "NullOrChar", - version = "NullOrChar", - numberOfTerms = "integer", - numberOfProperties = "integer", - numberOfIndividuals = "integer", - config = "list", - links = "list" - )) - -############################################################ -## A list of Ontology instances -.Ontologies <- setClass("Ontologies", slots = c(x = "list")) - -.Term <- setClass("Term", - slots = c(iri = "character", - lang = "character", - description = "NullOrList", - synonyms = "NullOrList", - annotation = "NullOrList", - label = "character", - ontology_name = "character", - ontology_prefix = "character", - ontology_iri = "character", - is_obsolete = "logical", - term_replaced_by = "NullOrChar", - is_defining_ontology = "logical", - has_children = "logical", - is_root = "logical", - short_form = "NullOrChar", - obo_id = "NullOrChar", - in_subset = "NullOrList", - obo_definition_citation = "NullOrList", - obo_xref = "NullOrList", - obo_synonym = "NullOrChar", - is_preferred_root = "logical", - links = "list")) - -.Terms <- setClass("Terms", slots = c(x = "list")) - -.OlsSearch <- setClass("OlsSearch", - slots = c(q = "character", - ontology = "character", - type = "character", - slim = "character", - fieldList = "character", - queryFields = "character", - exact = "logical", - groupField = "logical", - obsoletes = "logical", - local = "character", - childrenOf = "character", - rows = "integer", - start = "integer", - url = "character", - numFound = "integer", - response = "data.frame")) - -.Property <- setClass("Property", - contains = "Term") -Properties <- setClass("Properties", contains = "Terms") +## setClassUnion("NullOrLogical", c("NULL", "logical")) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 0319e29..a4e00bc 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -10,7 +10,10 @@ setGeneric("olsLoaded", function(object, ...) standardGeneric("olsLoaded")) setGeneric("olsUpdated", function(object, ...) standardGeneric("olsUpdated")) setGeneric("olsStatus", function(object, ...) standardGeneric("olsStatus")) setGeneric("olsNamespace", function(object, ...) standardGeneric("olsNamespace")) +setGeneric("olsLinks", function(object, ...) standardGeneric("olsLinks")) +setGeneric("olsConfig", function(object, ...) standardGeneric("olsConfig")) +setGeneric("termLinks", function(object, ...) standardGeneric("termLinks")) setGeneric("termLabel", function(object, ...) standardGeneric("termLabel")) setGeneric("termPrefix", function(object, ...) standardGeneric("termPrefix")) setGeneric("terms", function(x, ...) standardGeneric("terms")) diff --git a/R/methods-OlsSearch.R b/R/OlsSearch.R similarity index 82% rename from R/methods-OlsSearch.R rename to R/OlsSearch.R index 0512eb9..fd25daa 100644 --- a/R/methods-OlsSearch.R +++ b/R/OlsSearch.R @@ -1,3 +1,22 @@ +.OlsSearch <- setClass("OlsSearch", + slots = c(q = "character", + ontology = "character", + type = "character", + slim = "character", + fieldList = "character", + queryFields = "character", + exact = "logical", + groupField = "logical", + obsoletes = "logical", + local = "character", + childrenOf = "character", + rows = "integer", + start = "integer", + url = "character", + numFound = "integer", + response = "data.frame")) + + emptyQueryDataFrame <- structure(list(id = character(0), iri = character(0), short_form = character(0), obo_id = character(0), @@ -47,9 +66,9 @@ OlsSearch <- function(q, ## Make actual query, with rows = 1 to get the total number of ## results found url0 <- sub("rows=[0-9]+", "rows=1", url) - x <- GET(url) - stop_for_status(x) - cx <- content(x, as = "raw") + x <- httr::GET(url) + httr::stop_for_status(x) + cx <- httr::content(x, as = "raw") txt <- rawToChar(cx) ans <- jsonlite::fromJSON(txt) numFound <- ans[["response"]][["numFound"]] @@ -67,9 +86,9 @@ OlsSearch <- function(q, olsSearch <- function(object, all = FALSE) { if (all) x <- allRows(x) - x <- GET(object@url) - stop_for_status(x) - cx <- content(x, as = "raw") + x <- httr::GET(object@url) + httr::stop_for_status(x) + cx <- httr::content(x, as = "raw") txt <- rawToChar(cx) ans <- jsonlite::fromJSON(txt) if (!length(ans[['response']][['docs']])) { diff --git a/R/Ontologies.R b/R/Ontologies.R new file mode 100644 index 0000000..c67b2b0 --- /dev/null +++ b/R/Ontologies.R @@ -0,0 +1,483 @@ +##' @title Ontologies +##' +##' @aliases Ontologies Ontology +##' @aliases olsLinks olsLinks,Ontology +##' @aliases olsConfig olsConfig,Ontology +##' @aliases olsVersion,character olsVersion,Ontology olsVersion,Ontologies +##' @aliases olsLoaded,character olsLoaded,Ontology olsLoaded,Ontologies +##' @aliases olsUpdated,character olsUpdated,Ontology olsUpdated,Ontologies +##' @aliases olsPrefix,character olsPrefix,Ontology olsPrefix,Ontologies +##' @aliases olsDesc,character olsDesc,Ontology olsDesc,Ontologies +##' @aliases olsTitle,character olsTitle,Ontology olsTitle,Ontologies +##' @aliases olsStatus,character olsStatus,Ontology olsStatus,Ontologies +##' @aliases olsNamespace,character olsNamespace,Ontology olsNamespace,Ontologies +##' @aliases ontologyUrl ontologyUrl,character ontologyUrl,Ontology +##' +##' @description +##' +##' The rols package provides an interface to PRIDE's Ontology Lookup +##' Servive (OLS) and can be used to query one or multiple ontologies, +##' stored as `Ontology` and `Ontologies` instances, and containing +##' various information as provided by OLS. +##' +##' @details +##' +##' Ontologies are referred to by their namespace, which is lower +##' case: the Gene Onology is "go", the Mass spectrometry ontology is +##' "ms", etc. The ontologies also have prefixes, which are upper +##' case: the Gene Onology prefix "GO", the Mass spectrometry ontology +##' prefix "MS". One exception to this rule is the Drosophila +##' Phenotype Ontology, whose namespace and prefix are "dpo" and +##' "FBcv" respectively (there might be more). This is particularly +##' confusing as the FlyBase Controlled Vocabulary has "fbcv" and +##' "FBcv" as namespace and prefix respectively. +##' +##' When using a character to initialise an ontology or query a term, +##' "fbcv" (this is case insensitive) will refer to the the FlyBase +##' Controlled Vocabulary. The the Drosophila Phenotype Ontology will +##' have to be referred as "dpo" (also case insensitive). +##' +##' @section Constructors: +##' +##' Objects can be created in multiple ways. The [Ontologies()] +##' function will initialise all available ontolgies as an +##' `Ontologies` object, while a call to [Ontology()] with an ontology +##' namespace or prefix as argument will initialise the ontology of +##' interest as an `Ontology` instance. +##' +##' `Ontolgies` instances can be subset with `[` and `[[` (using their +##' namespace, see Details) and iterated over with +##' `lapply`. `Ontolgies` can be converted into a simple `data.frame` +##' containing the ontology prefixes, namespaces and titles using +##' `as(., "data.frame")`. `Ontologies` can also be coerced to lists +##' of `Ontology` ojects with `as(., "list")`. +##' +##' @section Accessors: +##' +##' - `olsDesc(object = "Ontology")` returns the description of an +##' ontology. Also works for `Ontologies` objects and a `character` +##' describing an ontology namespace or prefix (see Details). +##' +##' - `olsPrefix(object = "Ontology")` retruns the prefix of an +##' ontology. Also works for `Ontologies` objects and a `character` +##' describing an ontology namespace or prefix (see Details). +##' +##' - `olsVersion(object = "Ontology")` returns the version of the +##' ontology. Also works with an a `character` defining an ontology +##' namespace or prefix (see Details) or an object of class +##' `Ontologies`, in which case it returns a list of versions. +##' +##' - `olsLoaded(object = "Ontology")` returns the loading date of the +##' ontology. Also works with a `character` containing the ontology +##' namespace or prefix (see Details) or an object of class +##' `Ontologies`. +##' +##' - `olsUpdated(object = "Ontology")` returns the update date of the +##' ontology. Also works with a `character` containing the ontology +##' namespace or prefix (see Details) or an object of class +##' `Ontologies`. +##' +##' - `olsStatus(object = "Ontology")` returns the status of the +##' ontology. Also works with a `character` containing the ontology +##' namespace or prefix (see Details) or an object of class +##' `Ontologies`. +##' +##' - `olsTitle(object = "Ontology")` returns the title of an +##' ontology. Also works with a `character` containing the ontology +##' namespace or prefix (see Details) or an object of class +##' `Ontologies`. +##' +##' - `olsNamespace(object = "Ontology")` returns the namespace of an +##' ontology. Also works with a `character` containing the ontology +##' namespace or prefix (see Details) or an object of class +##' `Ontologies`. +##' +##' - `olsLinks(object = "Ontology")` returns a named `character` with +##' hyperlink to the ontology itself, and other associated concepts +##' such as its terms. +##' +##' - `olsConfig(object = "Ontology")` returns a list of additional +##' unstructured, partly redundant information about the ontology. +##' +##' - `ontologyUrl(object = "Ontology") return the hyperlink to the +##' ontology itself. It can also be used with a `character` defining +##' the namespace or prefix of an ontology, in which case it is +##' created from the base OLS API URL. +##' +##' @section Ontology terms: +##' +##' Once an ontology has been created an an `Ontology` instance, all +##' its terms can be requested using the `Terms()` constructor. See +##' [Terms()] for details. +##' +##' @author Laurent Gatto +##' +##' @rdname ontologies +##' +##' @examples +##' +##' ############################# +##' ## All ontologies +##' (onts <- Ontologies()) +##' +##' ############################# +##' ## Alzheimer's Disease Ontology (ADO) +##' ## 1. From the ontologies object +##' (ado1 <- onts[['ado']]) +##' ## 2. Create from its namespace +##' (ado2 <- Ontology('ado')) ## also works with ADO +##' +##' all.equal(ado1, ado2) +##' +##' olsVersion(ado1) +##' olsPrefix(ado1) +##' olsNamespace(ado1) +##' olsTitle(ado1) +##' olsDesc(ado1) +##' olsLinks(ado1) +##' str(olsConfig(ado1)) +NULL + +############################################################ +## A single ontology +.Ontology <- setClass("Ontology", + slots = c( + languages = "list", + lang = "character", + ontologyId = "character", + loaded = "NullOrChar", + updated = "NullOrChar", + status = "NullOrChar", + message = "NullOrChar", + version = "NullOrChar", + numberOfTerms = "integer", + numberOfProperties = "integer", + numberOfIndividuals = "integer", + config = "list", + links = "list" + )) + +############################################################ +## A list of Ontology instances +.Ontologies <- setClass("Ontologies", slots = c(x = "list")) + +########################################## +## Constructors + +##' @exportMethod +setMethod("Ontologies", "missing", + function(object) makeOntologies()) + +##' @exportMethod +setMethod("Ontology", "character", + function(object) { + ## make urls from ontologyId + url <- ontologyUrl(object) + makeOntology(url) + }) + +##' @exportMethod +setMethod("Ontology", "Ontology", + function(object) object) + +########################################## +## show methods +##' @exportMethod +setMethod("show", "Ontology", + function(object) { + cat("Ontology: ", olsTitle(object), + " (", olsNamespace(object) , ")", sep = "") + cat(" ", strwrap(olsDesc(object)), sep = "\n ") + cat(" Loaded:", olsLoaded(object), + "Updated:", olsUpdated(object), + "Version:", olsVersion(object), "\n") + cat(" ", object@numberOfTerms, "terms ", + object@numberOfProperties, "properties ", + object@numberOfIndividuals, "individuals\n") + }) + +##' @exportMethod +setMethod("show", "Ontologies", + function(object) { + cat("Object of class 'Ontologies' with", + length(object), "entries\n") + if (length(object) > 4) + cat(" ", paste(head(olsPrefix(object), n=2), + collapse = ", "), + "...", + paste(tail(olsPrefix(object), n=2), + collapse = ", "), "\n") + else + cat(paste(olsPrefix(object)[1:length(object)], + collapse = ", "), "\n") + }) + +########################################## +## Accessors + +##' @exportMethod +setMethod("olsVersion", "character", + function(object) olsVersion(Ontology(object))) +##' @exportMethod +setMethod("olsVersion", "Ontology", + function(object) object@config$version) +##' @exportMethod +setMethod("olsVersion", "Ontologies", + function(object) sapply(object@x, olsVersion)) + +##' @exportMethod +setMethod("olsLoaded", "character", + function(object) olsLoaded(Ontology(object))) +##' @exportMethod +setMethod("olsLoaded", "Ontology", + function(object) substr(object@loaded, 1, 10)) +##' @exportMethod +setMethod("olsLoaded", "Ontologies", + function(object) sapply(object@x, olsLoaded)) +##' @exportMethod +setMethod("olsLinks", "Ontology", + function(object) { + links <- unlist(object@links) + names(links) <- sub("\\.href", "", names(links)) + links + }) +##' @exportMethod +setMethod("olsConfig", "Ontology", + function(object) object@config) +##' @exportMethod +setMethod("olsUpdated", "character", + function(object) olsUpdated(Ontology(object))) +##' @exportMethod +setMethod("olsUpdated", "Ontology", + function(object) substr(object@updated, 1, 10)) +##' @exportMethod +setMethod("olsUpdated", "Ontologies", + function(object) sapply(object@x, olsUpdated)) +##' @exportMethod +setMethod("olsPrefix", "character", + function(object) olsPrefix(Ontology(object))) +##' @exportMethod +setMethod("olsPrefix", "Ontology", + function(object) object@config$preferredPrefix) +##' @exportMethod +setMethod("olsPrefix", "Ontologies", + function(object) sapply(object@x, olsPrefix)) +##' @exportMethod +setMethod("olsDesc", "character", + function(object) olsDesc(Ontology(object))) +##' @exportMethod +setMethod("olsDesc", "Ontology", + function(object) object@config$description) +##' @exportMethod +setMethod("olsDesc", "Ontologies", + function(object) sapply(object@x, olsDesc)) +##' @exportMethod +setMethod("olsTitle", "character", + function(object) olsTitle(Ontology(object))) +##' @exportMethod +setMethod("olsTitle", "Ontology", + function(object) object@config$title) +##' @exportMethod +setMethod("olsTitle", "Ontologies", + function(object) sapply(object@x, olsTitle)) +##' @exportMethod +setMethod("olsStatus", "character", + function(object) olsStatus(Ontology(object))) +##' @exportMethod +setMethod("olsStatus", "Ontology", + function(object) object@status) +##' @exportMethod +setMethod("olsStatus", "Ontologies", + function(object) sapply(object@x, olsStatus)) +##' @exportMethod +setMethod("olsNamespace", "character", + function(object) olsNamespace(Ontology(object))) +##' @exportMethod +setMethod("olsNamespace", "Ontology", + function(object) object@config$namespace) +##' @exportMethod +setMethod("olsNamespace", "Ontologies", + function(object) sapply(object@x, olsNamespace)) +##' @exportMethod +setMethod("ontologyUrl", "character", + function(object) + paste0("https://www.ebi.ac.uk/ols4/api/ontologies/", + object)) +##' @exportMethod +setMethod("ontologyUrl", "Ontology", + function(object) olsLinks(object)[["self"]]) + + +########################################## +## Data manipulation +##' @exportMethod +setMethod("lapply", "Ontologies", + function(X, FUN, ...) lapply(X@x, FUN, ...)) +##' @exportMethod +setMethod("[", "Ontologies", + function(x, i, j="missing", drop="missing") + new("Ontologies", x = x@x[i])) +##' @exportMethod +setMethod("[[", "Ontologies", + function(x, i, j="missing", drop="missing") { + if (is.numeric(i)) { + i <- as.integer(i) + return(x@x[[i]]) + } + if (is.character(i)) { + nms <- olsNamespace(x) + k <- which(nms %in% i) + if (!length(k)) + stop("Ontology not found.") + if (length(k) > 1) + stop("Ontology not unique.") + return(x[[k]]) + } + stop("'i' must be a character or a numeric.") + }) +##' @exportMethod +setMethod("length", "Ontologies", function(x) length(x@x)) + +## This will not always be the correct URI (see for example +## Orphaned/ORBO and https://github.com/EBISPOT/OLS/issues/35) +## setMethod("ontologyUri", "missing", +## function(encode = TRUE) { +## uri <- "http://purl.obolibrary.org/obo/" +## if (encode) +## uri <- gsub("%", "%25", URLencode(uri, TRUE)) +## uri +## }) + +## setMethod("ontologyUri", "Ontology", +## function(object, encode = TRUE, withPrefix = FALSE) { +## uri <- object@config$baseUris +## if (is.null(uri) | length(uri) == 0) +## return(ontologyUri()) +## if (length(uri) > 1) { +## msg <- paste0("More than one URI available:\n ", +## paste(unlist(uri), collapse = ", "), "\n ", +## "Choosing the first one.\n") +## warning(msg) +## } +## uri <- uri[[1]][1] +## if (!withPrefix) +## uri <- sub("/[A-Za-z]+_$", "/", uri) +## if (encode) +## uri <- gsub("%", "%25", URLencode(uri, TRUE)) +## uri +## }) + +########################################## +## Coercion + +##' @import methods +##' @exportMethod +setAs("Ontologies", "data.frame", + function(from) as.data.frame.Ontologies(from)) + +##' @exportS3Method +as.data.frame.Ontologies <- function(x) { + .as_vector <- function(x) { + if (is.list(x)) + x <- sapply(x, paste, collapse = "; ") + x + } + pre <- .as_vector(olsPrefix(x)) + nms <- .as_vector(olsNamespace(x)) + ttl <- .as_vector(olsTitle(x)) + data.frame(Prefix = pre, + Namespace = nms, + Title = ttl) +} + +##' @exportMethod +setAs("Ontologies", "list", + function(from) from@x) + +## ## Ontologies aren't names anymore (for now) +## setMethod("all.equal", c("Ontologies", "Ontologies"), +## function(target, current) { +## msg <- Biobase::validMsg(NULL, NULL) +## if (length(target) != length(current)) { +## msg <- Biobase::validMsg(msg, "The 2 Ontologies are of different lengths") +## } else { +## tg <- target@x +## ct <- current@x +## if (any(sort(names(tg)) != sort(names(ct)))) { +## msg <- validMsg(msg, "Ontology names don't match") +## } else { +## ## reorder before comparing Ontolgy objects one +## ## by one +## tg <- tg[order(names(tg))] +## ct <- ct[order(names(ct))] +## for (i in seq_along(tg)) { +## eq <- all.equal(tg[[i]], ct[[i]]) +## if (is.character(eq)) { +## eq <- paste0("Ontology '", names(tg)[i], "': ", eq) +## msg <- validMsg(msg, eq) +## } +## } +## } +## } +## if (is.null(msg)) return(TRUE) +## else msg +## }) + +##' @exportMethod +setMethod("all.equal", c("Ontology", "Ontology"), + function(target, current) { + msg <- Biobase::validMsg(NULL, NULL) + sn <- slotNames("Ontology") + sn0 <- sn[sn != "config"] + for (i in sn0) { + eq <- all.equal(slot(current, i), slot(target, i)) + if (is.character(eq)) + msg <- validMsg(msg, paste0(i, ": ", eq)) + } + c1 <- slot(current, "config") + c2 <- slot(target, "config") + c1 <- c1[order(names(c1))] + c2 <- c2[order(names(c2))] + msg <- Biobase::validMsg(msg, all.equal(c1, c2)) + if (is.null(msg)) TRUE else msg + }) + + +########################################## +## Helper functions +makeOntologies <- function() { + url <- "https://www.ebi.ac.uk/ols4/api/ontologies/" + x <- lapply( + req_perform_iterative( + request(url), + next_req, + max_reqs = Inf, + progress = TRUE), + resp_embedded, + what = "ontologies") |> + unlist(recursive = FALSE) + .Ontologies(x = lapply(x, ontologyFromJson)) +} + +makeOntology <- function(url) { + request(url) |> + req_perform() |> + resp_body_json() |> + ontologyFromJson() +} + +ontologyFromJson <- function(x) { + .Ontology(languages = x[["languages"]], + lang = x[["lang"]], + ontologyId = x[["ontologyId"]], + loaded = x[["loaded"]], + updated = x[["updated"]], + status = x[["status"]], + message = x[["message"]], + version = x[["version"]], + numberOfTerms = x[["numberOfTerms"]], + numberOfProperties = x[["numberOfProperties"]], + numberOfIndividuals = x[["numberOfIndividuals"]], + config = x[["config"]], + links = x[["_links"]]) +} diff --git a/R/Properties.R b/R/Properties.R new file mode 100644 index 0000000..fab99cd --- /dev/null +++ b/R/Properties.R @@ -0,0 +1,66 @@ +.Property <- setClass("Property", + contains = "Term") +Properties <- setClass("Properties", contains = "Terms") + + +## ########################################## +## ## Constructors +## setMethod("properties", "character", +## function(object, ...) .properties(object, ...)) +## setMethod("properties", "Ontology", +## function(object, ...) .properties(olsNamespace(object), ...)) + +## setMethod("properties", "Term", +## function(object, ...) { +## urls <- getPropertyLinks(object) +## if (length(urls) == 0) { +## message("No properties for term ", termId(object)) +## return(NULL) +## } +## ans <- lapply(urls, makeProperties) +## ans <- unlist(lapply(ans, "slot", "x")) +## names(ans) <- sub("\\.href\\.", "/", names(ans)) +## Properties(x = ans) +## }) + +## setMethod("properties", "Terms", +## function(object, ...) { +## lapply(object@x, properties, ...) +## }) + +## ########################################## +## ## show methods + +## setMethod("show", "Property", +## function(object) { +## ids <- termId(object) +## cat("A Property from the", termPrefix(object), "ontology:", ids, "\n") +## cat(" Label: ", termLabel(object),"\n", sep = "") +## }) + + +## setMethod("show", "Properties", +## function(object) { +## cat("Object of class 'Properties' with", length(object), +## ifelse(length(object) > 1, +## "entries\n", +## "entry\n")) +## onts <- unique(termPrefix(object)) +## if (length(onts) == 1) +## cat(" From the", onts, "ontology\n") +## else if (length(onts) < 6) +## cat(" From the", paste(onts, collapse = ", "), "ontologies\n") +## else cat(" From ", length(onts), "ontologies\n") +## n <- length(object) +## if (n > 4) +## cat(" ", paste(head(termLabel(object), n=2), collapse = ", "), +## "...", +## paste(tail(termLabel(object), n=2), collapse = ", "), "\n") +## else +## cat(paste(termLabel(object)[1:n], collapse = ", "), "\n") +## }) + +## ########################################## +## ## Data manipulation + +## setMethod("length", "Properties", function(x) length(x@x)) diff --git a/R/Terms.R b/R/Terms.R new file mode 100644 index 0000000..eb581b5 --- /dev/null +++ b/R/Terms.R @@ -0,0 +1,512 @@ +##' @title Ontology Terms +##' +##' @aliases Term Terms Terms,character Terms,Ontology +##' @aliases termLinks termLinks,Term +##' @aliases children parents ancestors descendants +##' @aliases termSynonym termSynonym,Term termSynonym,Terms +##' @aliases isObsolete isObsolete,Term isObsolete,Terms +##' @aliases isRoot isRoot,Term isRoot,Terms +##' @aliases termLabel termLabel,Term termLabel,Terms +##' @aliases termId termId,Term termId,Terms +##' @aliases termPrefix termPrefix,Term termPrefix,Terms +##' @aliases termDesc termDesc,Term termDesc,Terms +##' @aliases termOntology termOntology,Term termOntology,Terms +##' @aliases termNamespace termNamespace,Term termNamespace,Terms +##' +##' @description +##' +##' The `Term` class describes an ontology term. A set of terms are +##' instantiated as a `Terms` class. +##' +##' @section Contructors: +##' +##' Objects can be created using the `Term()` and `Terms()` +##' constructers. The latter is used with an object of class +##' `Ontology` or a `character` describing a valid ontology prefix to +##' download and instantiate all terms of an ontology of interest. The +##' former takes an `Ontology` object (or an ontology prefix) and +##' a term identifer to instantiate that specific term. +##' +##' For any given `Term` object, the `children`, `parents`, +##' `ancestors` and `descendants` terms can be generated with the +##' `children()`, `parents()`, `ancestor()` and `descendants()` +##' function. `Terms` instances can be subset with `[` and `[[` and +##' iterated over with `lapply`. +##' +##' @section Accessors: +##' +##' - `isObsolete(object = "Term")` returns a `TRUE` if the term is +##' obsolete, `FALSE` otherwise. Also works on `Terms` instances. +##' +##' - `isRoot(object = "Term")` returns a `TRUE` if the term is a root +##' term, `FALSE` otherwise. Also works on `Terms` instances. +##' +##' - `termDesc(object = "Term")` returns a `character` with the +##' term's description. Also works on `Terms` instances. +##' +##' - `termId(object = "Term")` returns a `character` with the term's +##' identifier. Also works on `Terms` instances. +##' +##' - `termLabel(object = "Term")` returns a `character` with the +##' term's label. Also works on `Terms` instances. +##' +##' - `termNamespace(object = "Term")` returns a `character` with the +##' term's namespace. Also works on `Terms` instances. +##' +##' - `termOntology(object = "Term")` returns a `character` with the +##' term's ontology (where it was retrieved from). Also works on +##' `Terms` instances. +##' +##' - `termPrefix(object = "Term")` returns a `character` with the +##' term's (ontology) prefix (where it was retrieved from). Also +##' works on `Terms` instances. +##' +##' - `termSynonym(object = "Term")` returns a `character` with the +##' term's synpnym(s). Also works on `Terms` instances. +##' +##' - `termLinks(object = "Term")` returns a named `character` with +##' hyperlink to/from the term. +##' +##' @section Related terms: +##' +##' - `children(object = "Term")` returns a new `Terms` instance with +##' the `object`'s children or `NULL` if there are no children. +##' +##' - `parents(object = "Term")` returns a new `Terms` instance with +##' the `object`'s parents or `NULL` if there are no parents. +##' +##' - `ancestors(object = "Term")` returns a new `Terms` instance with +##' the `object`'s ancestors or `NULL` if there are no ancestors. +##' +##' - `descendants(object = "Term")` returns a new `Terms` instance +##' with the `object`'s descendants or `NULL` if there are no +##' descendants. +##' +##' @section Coercion: +##' +##' - `as(x, "data.fram")` coerces a `Term` or `Terms` instance into a +##' `data.frame` of length 1 (for the former) or length `length(x)` +##' for the latter. The result will contain the following columns: +##' id, label, description of the term(s), their ontology, whether +##' they are obsolete, have children or are root node, the first +##' synonym only, their iri and whether they are defining the +##' ontology. Any missing value will be reported as `NA`. +##' +##' @rdname terms +##' +##' @author Laurent Gatto +##' +##' @examples +##' +##' ## Alzheimer's Disease Ontology (ADO) +##' (adoterms <- Terms('ado')) +##' +##' ## Focus on squamous epithelium +##' (trm <- adoterms[["UBERON:0006914"]]) +##' +##' ## Accessors +##' termLabel(trm) +##' head(termLabel(adoterms)) +##' termId(trm) +##' termDesc(trm) +##' termOntology(trm) +##' termNamespace(trm) +##' termSynonym(trm) ## none +##' +##' ## Related terms +##' children(trm) +##' descendants(trm) ## includes child +##' +##' parents(trm) +##' ancestors(trm) ## includes parent +NULL + +############################################################ +## A single term +.Term <- setClass("Term", + slots = c(iri = "character", + lang = "character", + description = "NullOrList", + synonyms = "NullOrList", + annotation = "NullOrList", + label = "character", + ontology_name = "character", + ontology_prefix = "character", + ontology_iri = "character", + is_obsolete = "logical", + term_replaced_by = "NullOrChar", + is_defining_ontology = "logical", + has_children = "logical", + is_root = "logical", + short_form = "NullOrChar", + obo_id = "NullOrChar", + in_subset = "NullOrList", + obo_definition_citation = "NullOrList", + obo_xref = "NullOrList", + obo_synonym = "NullOrList", + is_preferred_root = "logical", + links = "list")) + +############################################################ +## A list of terms +.Terms <- setClass("Terms", slots = c(x = "list")) + +########################################## +## Constructors +##' exportMethod +setMethod("Terms", "character", ## ontologyId + function(x, pagesize = 1000, obsolete = NULL) + makeTerms(x, pagesize, obsolete)) + +##' exportMethod +setMethod("Terms", "Ontology", + function(x, pagesize = 1000, obsolete = NULL) + makeTerms(x, pagesize, obsolete)) + + +## These methods query an Ontology (or its prefix) for all or one term +## setMethod("terms", "character", +## function(x, ...) .terms(x, ...)) +## setMethod("term", c("character", "character"), +## function(object, id, ...) .term(object, id, ...)) +## setMethod("term", c("Ontology", "character"), +## function(object, id,...) .term(object, id, ...)) + + +children <- function(object) { + stopifnot(inherits(object, "Term")) + if (!object@has_children) + return(NULL) + url <- termLinks(object)[["children"]] + x <- lapply( + req_perform_iterative( + request(url), + next_req, + max_reqs = Inf, + progress = TRUE), + resp_embedded, + what = "terms") |> + unlist(recursive = FALSE) + ans <- lapply(x, termFromJson) + names(ans) <- sapply(ans, termId) + .Terms(x = ans) +} + + + +parents <- function(object) { + stopifnot(inherits(object, "Term")) + if (object@is_root) + return(NULL) + url <- termLinks(object)[["parents"]] + x <- lapply( + req_perform_iterative( + request(url), + next_req, + max_reqs = Inf, + progress = TRUE), + resp_embedded, + what = "terms") |> + unlist(recursive = FALSE) + ans <- lapply(x, termFromJson) + names(ans) <- sapply(ans, termId) + .Terms(x = ans) +} + +ancestors <- function(object) { + stopifnot(inherits(object, "Term")) + if (object@is_root) + return(NULL) + url <- termLinks(object)[["ancestors"]] + x <- lapply( + req_perform_iterative( + request(url), + next_req, + max_reqs = Inf, + progress = TRUE), + resp_embedded, + what = "terms") |> + unlist(recursive = FALSE) + ans <- lapply(x, termFromJson) + names(ans) <- sapply(ans, termId) + .Terms(x = ans) +} + +descendants <- function(object) { + stopifnot(inherits(object, "Term")) + if (!object@has_children) + return(NULL) + url <- termLinks(object)[["descendants"]] + x <- lapply( + req_perform_iterative( + request(url), + next_req, + max_reqs = Inf, + progress = TRUE), + resp_embedded, + what = "terms") |> + unlist(recursive = FALSE) + ans <- lapply(x, termFromJson) + names(ans) <- sapply(ans, termId) + .Terms(x = ans) +} + +########################################## +## show methods + +##' exportMethod +setMethod("show", "Term", + function(object) { + ids <- .termId(object) + cat("A Term from the", termPrefix(object), "ontology:", ids, "\n") + cat(" Label: ", termLabel(object),"\n ", sep = "") + desc <- termDesc(object) + if (is.null(desc)) cat("No description\n") + else for (i in 1:seq_along(desc)) + cat(strwrap(desc[[i]]), sep = "\n ") + }) + +##' exportMethod +setMethod("show", "Terms", + function(object) { + cat("Object of class 'Terms' with", length(object), "entries\n") + onts <- unique(termPrefix(object)) + if (length(onts) == 1) + cat(" From the", onts, "ontology\n") + else if (length(onts) < 6) + cat(" From the", paste(onts, collapse = ", "), "ontologies\n") + else cat(" From ", length(onts), "ontologies\n") + n <- length(object) + if (n > 4) + cat(" ", paste(head(termId(object), n=2), collapse = ", "), + "...", + paste(tail(termId(object), n=2), collapse = ", "), "\n") + else + cat(paste(termId(object)[1:n], collapse = ", "), "\n") + }) + +########################################## +## Accessors +##' exportMethod +setMethod("termSynonym", "Term", + function(object) unlist(object@synonyms)) +##' exportMethod +setMethod("termSynonym", "Terms", + function(object) lapply(object@x, termSynonym)) +##' exportMethod +setMethod("isObsolete", "Term", + function(object) object@is_obsolete) +##' exportMethod +setMethod("isObsolete", "Terms", + function(object) sapply(object@x, isObsolete)) +##' exportMethod +setMethod("isRoot", "Term", + function(object) object@is_root) +##' exportMethod +setMethod("isRoot", "Terms", + function(object) sapply(object@x, isRoot)) +##' exportMethod +setMethod("termLabel", "Term", + function(object) object@label) +##' exportMethod +setMethod("termLabel", "Terms", + function(object) sapply(object@x, termLabel)) +##' exportMethod +setMethod("termId", "Term", + function(object) .termId(object)) +##' exportMethod +setMethod("termId", "Terms", + function(object) sapply(object@x, .termId)) +##' exportMethod +setMethod("termLinks", "Term", + function(object) { + links <- unlist(object@links) + names(links) <- sub("\\.href", "", names(links)) + links + }) +##' exportMethod +setMethod("termPrefix", "Term", + function(object) object@ontology_prefix) +##' exportMethod +setMethod("termPrefix", "Terms", + function(object) sapply(object@x, termPrefix)) +##' exportMethod +setMethod("termDesc", "Term", + function(object) unlist(object@description)) +##' exportMethod +setMethod("termDesc", "Terms", + function(object) sapply(object@x, termDesc)) +##' exportMethod +setMethod("termOntology", "Term", + function(object) unlist(object@ontology_name)) +##' exportMethod +setMethod("termOntology", "Terms", + function(object) sapply(object@x, termOntology)) +##' exportMethod +setMethod("termNamespace", "Term", + function(object) unlist(object@annotation$has_obo_namespace)) +##' exportMethod +setMethod("termNamespace", "Terms", + function(object) sapply(object@x, termNamespace)) + +########################################## +## Data manipulation +##' exportMethod +setMethod("length", "Terms", function(x) length(x@x)) +##' exportMethod +setMethod("unique", "Terms", function(x) x[!duplicated(names(x@x))]) +##' exportMethod +setMethod("[", "Terms", + function(x, i, j="missing", drop="missing") Terms(x = x@x[i])) +##' exportMethod +setMethod("[[", "Terms", + function(x, i, j="missing", drop="missing") x@x[[i]]) +##' exportMethod +setMethod("lapply", "Terms", + function(X, FUN, ...) lapply(X@x, FUN, ...)) +##' exportMethod +setMethod("all.equal", c("Term", "Term"), + function(target, current) { + msg <- Biobase::validMsg(NULL, NULL) + snms <- slotNames("Term") + for (i in snms[-grep("links", snms)]) { + eq <- all.equal(slot(target, i), slot(current, i)) + if (is.character(eq)) { + eq <- paste0("Slot '", i, "': ", eq) + msg <- Biobase:::validMsg(msg, eq) + } + } + lt <- slot(target, "links") + lc <- slot(current, "links") + ot <- order(names(lt)) + oc <- order(names(lc)) + msg <- Biobase:::validMsg(msg, all.equal(lt[ot], lc[oc])) + if (is.null(msg)) return(TRUE) + else msg + }) + + +## setMethod("all.equal", c("Terms", "Terms"), +## function(target, current) { +## msg <- Biobase::validMsg(NULL, NULL) +## if (length(target) != length(current)) { +## msg <- Biobase::validMsg(msg, "2 Terms are of different lengths") +## } else { +## tg <- target@x +## ct <- current@x +## if (any(sort(names(tg)) != sort(names(ct)))) { +## msg <- Biobase::validMsg(msg, "Term ids don't match") +## } else { +## ot <- order(names(tg)) +## oc <- order(names(ct)) +## tg <- tg[ot] +## ct <- ct[oc] +## for (i in seq_along(tg)) { +## eq <- all.equal(tg[[i]], ct[[i]]) +## if (is.character(eq)) { +## eq <- paste0("Term id '", names(tg)[i], "': ", eq) +## msg <- Biobase:::validMsg(msg, eq) +## } +## } +## } +## } +## if (is.null(msg)) return(TRUE) +## else msg +## }) + +##' exportMethod +setAs("Term", "data.frame", + function(from) + data.frame( + id = fix_null(termId(from)), + label = fix_null(termLabel(from)), + description = fix_null(termDesc(from)), + ontology = fix_null(termOntology(from)), + is_obsolete = fix_null(isObsolete(from)), + has_children = fix_null(from@has_children), + is_root = fix_null(isRoot(from)), + first_synonym = fix_null(termSynonym(from)), + iri = fix_null(from@iri), + is_defining_ontology = fix_null(from@is_defining_ontology), + stringsAsFactors = FALSE) + ) + +##' exportS3Method +as.Term.data.frame <- function(x) + as(x, "data.frame") + +##' exportMethod +setAs("Terms", "data.frame", + function(from) do.call(rbind, lapply(from, as, "data.frame"))) + +##' exportS3Method +as.Terms.data.frame <- function(x) + as(x, "data.frame") + +############################################# +## helper functions +makeTerms <- function(oid, pagesize, obsolete) { + ont <- Ontology(oid) + url <- paste0(olsLinks(ont)[["terms"]], "?") + if (!is.null(obsolete)) + url <- paste0(url, "obsoletes=", + ifelse(obsolete, "true", "false")) + url <- paste0(url, "&size=", as.integer(pagesize)) + + x <- lapply( + req_perform_iterative( + request(url), + next_req, + max_reqs = Inf, + progress = TRUE), + resp_embedded, + what = "terms") |> + unlist(recursive = FALSE) + ans <- lapply(x, termFromJson) + names(ans) <- sapply(ans, termId) + .Terms(x = ans) +} + +termFromJson <- function(x) { + .Term(iri = x[["iri"]], + lang = x[["lang"]], + description = x[["description"]], + synonyms = x[["synonyms"]], + annotation = x[["annotation"]], + label = x[["label"]], + ontology_name = x[["ontology_name"]], + ontology_prefix = x[["ontology_prefix"]], + ontology_iri = x[["ontology_iri"]], + is_obsolete = x[["is_obsolete"]], + term_replaced_by = x[["term_replaced_by"]], + is_defining_ontology = x[["is_defining_ontology"]], + has_children = x[["has_children"]], + is_root = x[["is_root"]], + short_form = x[["short_form"]], + obo_id = x[["obo_id"]], + in_subset = x[["in_subset"]], + obo_definition_citation = x[["obo_definition_citation"]], + obo_xref = x[["obo_xref"]], + obo_synonym = x[["obo_synonym"]], + is_preferred_root = x[["is_preferred_root"]], + links = x[["_links"]]) +} + +fix_null <- function(x) { + if (is.null(x)) return(NA) + if (is.list(x)) return(x[[1]]) + return(x) +} + +.termId <- function(x) x@obo_id + +.term <- function(oid, termid) { + ont <- Ontology(oid) + url <- olsLinks(ont)[["terms"]] + uri <- URLencode(ontologyUri(ont), TRUE) + url <- paste0(url, uri, sub(":", "_", termid)) + x <- GET(url) + stop_for_status(x) + cx <- content(x) + makeTerm(cx) +} diff --git a/R/cvparam.R b/R/cvparam.R index f48e846..6b3b1c3 100644 --- a/R/cvparam.R +++ b/R/cvparam.R @@ -1,3 +1,38 @@ +############################################################ +## A param is [CV label, accession, name|synonym, value] +.CVParam <- setClass("CVParam", + slots = c( + label = "character", + accession = "character", + name = "character", + value = "character", + user = "logical"), + contains = "Versioned", + prototype = prototype( + user = FALSE, + new("Versioned", versions = c(CVParam="0.2.0"))), + validity = function(object) { + msg <- validMsg(NULL, NULL) + if (object@user) { + if (!all(c(object@label, object@accession) == "")) + msg <- "Label and accession must be empty in UserParams." + } else { + x <- c(object@label, object@accession, + object@name, object@value) == "" + if (!all(x)) { + ._term <- term(object@label, object@accession) + ._label <- termLabel(._term) + ._synonyms <- termSynonym(._term) + if (!(object@name %in% c(._label, ._synonyms))) + msg <- paste0("CVParam accession and name/synomyms do not match. Got [", + paste(c(._label, ._synonyms), collapse = ", "), + "], expected '", object@name, "'.") + } + } + if (is.null(msg)) TRUE else msg + }) + + ## trim leading and trailing whitespace trim <- function (x) gsub("^\\s+|\\s+$", "", x) @@ -9,7 +44,7 @@ CVParam <- function(label, if (missing(label)) { ## a User param ans <- new("CVParam", name = name, user = TRUE) - } else { + } else { ## a CV param if (missing(name) & missing(accession)) { stop("You need to provide at least one of 'name' or 'accession'") @@ -24,15 +59,15 @@ CVParam <- function(label, resp <- olsSearch(resp) accession <- resp@response$obo_id } - + ans <- new("CVParam", label = label, name = name, accession = accession) } if (!missing(value)) ans@value <- value - + if (validObject(ans)) return(ans) -} +} setAs("CVParam", "character", function(from, to = "character") { @@ -113,7 +148,7 @@ as.character.CVParam <- function(x, ...) as(x, "character") if (x[2] == "" | !grepl("[A-Za-z]", x[1])) return(FALSE) acc <- strsplit(x[2], ":")[[1]] if (length(acc) != 2) return(FALSE) - if (acc[1] != x[1]) return(FALSE) + if (acc[1] != x[1]) return(FALSE) } else { if (x[2] != "") return(FALSE) ## User param: 3 and 4 are present @@ -134,7 +169,7 @@ notvalidCVchars<- c("[ , , , ]", "[, , , ]", "[MS, AB:123, , ]", "[, , foo, ]", "[, , , bar]", "[foo, , , ]", "[, bar, , ]", - "[, foo, bar, ]", + "[, foo, bar, ]", "[MS, , , bar]", "[MS, , foo, ]") diff --git a/R/methods-Ontologies.R b/R/methods-Ontologies.R deleted file mode 100644 index b89a6b0..0000000 --- a/R/methods-Ontologies.R +++ /dev/null @@ -1,254 +0,0 @@ -########################################## -## Constructors -setMethod("Ontologies", "missing", - function(object) makeOntologies()) - -setMethod("Ontology", "character", - function(object) { - ## make urls from ontologyId - url <- ontologyUrl(object) - httr2:::check_request(request(url)) - makeOntology(url) - }) - - -########################################## -## show methods -setMethod("show", "Ontology", - function(object) { - cat("Ontology: ", olsTitle(object), - " (", olsNamespace(object) , ")", sep = "") - cat(" ", strwrap(olsDesc(object)), sep = "\n ") - cat(" Loaded:", olsLoaded(object), - "Updated:", olsUpdated(object), - "Version:", olsVersion(object), "\n") - cat(" ", object@numberOfTerms, "terms ", - object@numberOfProperties, "properties ", - object@numberOfIndividuals, "individuals\n") - }) - -setMethod("show", "Ontologies", - function(object) { - cat("Object of class 'Ontologies' with", length(object), "entries\n") - if (length(object) > 4) - cat(" ", paste(head(olsPrefix(object), n=2), collapse = ", "), - "...", - paste(tail(olsPrefix(object), n=2), collapse = ", "), "\n") - else - cat(paste(olsPrefix(object)[1:length(object)], collapse = ", "), "\n") - }) - -########################################## -## Accessors - -setMethod("olsVersion", "character", - function(object) olsVersion(Ontology(object))) -setMethod("olsVersion", "Ontology", - function(object) object@config$version) -setMethod("olsVersion", "Ontologies", - function(object) sapply(object@x, olsVersion)) - -setMethod("olsLoaded", "character", - function(object) olsLoaded(Ontology(object))) -setMethod("olsLoaded", "Ontology", - function(object) substr(object@loaded, 1, 10)) -setMethod("olsLoaded", "Ontologies", - function(object) sapply(object@x, olsLoaded)) - - -setMethod("olsUpdated", "character", - function(object) olsUpdated(Ontology(object))) -setMethod("olsUpdated", "Ontology", - function(object) substr(object@updated, 1, 10)) -setMethod("olsUpdated", "Ontologies", - function(object) sapply(object@x, olsUpdated)) - -## setMethod("olsRoot", "character", -## function(object) { -## url <- ontologyUrl(object) -## url <- paste0(url, "/terms/roots") -## x <- GET(url) -## stop_for_status(x) -## cx <- content(x) -## ans <- lapply(cx[["_embedded"]][[1]], makeTerm) -## names(ans) <- sapply(ans, termId) -## Terms(x = ans) -## }) -## setMethod("olsRoot", "Ontology", -## function(object) olsRoot(olsPrefix(object))) -## setMethod("olsRoot", "Ontologies", -## function(object) lapply(object@x, olsRoot)) - -setMethod("olsPrefix", "character", - function(object) olsPrefix(Ontology(object))) -setMethod("olsPrefix", "Ontology", - function(object) object@config$preferredPrefix) -setMethod("olsPrefix", "Ontologies", - function(object) sapply(object@x, olsPrefix)) - -setMethod("olsDesc", "character", - function(object) olsDesc(Ontology(object))) -setMethod("olsDesc", "Ontology", - function(object) object@config$description) -setMethod("olsDesc", "Ontologies", - function(object) sapply(object@x, olsDesc)) - -setMethod("olsTitle", "character", - function(object) olsTitle(Ontology(object))) -setMethod("olsTitle", "Ontology", - function(object) object@config$title) -setMethod("olsTitle", "Ontologies", - function(object) sapply(object@x, olsTitle)) - -setMethod("olsStatus", "character", - function(object) olsStatus(Ontology(object))) -setMethod("olsStatus", "Ontology", - function(object) object@status) -setMethod("olsStatus", "Ontologies", - function(object) sapply(object@x, olsStatus)) - -setMethod("olsNamespace", "character", - function(object) olsNamespace(Ontology(object))) -setMethod("olsNamespace", "Ontology", - function(object) object@config$namespace) -setMethod("olsNamespace", "Ontologies", - function(object) sapply(object@x, olsNamespace)) - - - -########################################## -## Data manipulation - -setMethod("lapply", "Ontologies", - function(X, FUN, ...) lapply(X@x, FUN, ...)) -setMethod("[", "Ontologies", - function(x, i, j="missing", drop="missing") - new("Ontologies", x = x@x[i])) -setMethod("[[", "Ontologies", - function(x, i, j="missing", drop="missing") x@x[[i]]) -setMethod("length", "Ontologies", function(x) length(x@x)) - - -########################################## -## Coercion - -setAs("Ontologies", "data.frame", - function(from) as.data.frame.Ontologies(from)) - -as.data.frame.Ontologies <- function(x) { - .as_vector <- function(x) { - if (is.list(x)) - x <- sapply(x, paste, collapse = "; ") - x - } - pre <- .as_vector(olsPrefix(x)) - nms <- .as_vector(olsNamespace(x)) - ttl <- .as_vector(olsTitle(x)) - data.frame(Prefix = pre, - Namespace = nms, - Title = ttl) -} - -setAs("Ontologies", "list", - function(from) from@x) - -## ## Ontologies aren't names anymore (for now) -## setMethod("all.equal", c("Ontologies", "Ontologies"), -## function(target, current) { -## msg <- Biobase::validMsg(NULL, NULL) -## if (length(target) != length(current)) { -## msg <- Biobase::validMsg(msg, "The 2 Ontologies are of different lengths") -## } else { -## tg <- target@x -## ct <- current@x -## if (any(sort(names(tg)) != sort(names(ct)))) { -## msg <- validMsg(msg, "Ontology names don't match") -## } else { -## ## reorder before comparing Ontolgy objects one -## ## by one -## tg <- tg[order(names(tg))] -## ct <- ct[order(names(ct))] -## for (i in seq_along(tg)) { -## eq <- all.equal(tg[[i]], ct[[i]]) -## if (is.character(eq)) { -## eq <- paste0("Ontology '", names(tg)[i], "': ", eq) -## msg <- validMsg(msg, eq) -## } -## } -## } -## } -## if (is.null(msg)) return(TRUE) -## else msg -## }) - -setMethod("all.equal", c("Ontology", "Ontology"), - function(target, current) { - msg <- Biobase::validMsg(NULL, NULL) - sn <- slotNames("Ontology") - sn0 <- sn[sn != "config"] - for (i in sn0) { - eq <- all.equal(slot(current, i), slot(target, i)) - if (is.character(eq)) - msg <- validMsg(msg, paste0(i, ": ", eq)) - } - c1 <- slot(current, "config") - c2 <- slot(target, "config") - c1 <- c1[order(names(c1))] - c2 <- c2[order(names(c2))] - msg <- Biobase::validMsg(msg, all.equal(c1, c2)) - if (is.null(msg)) TRUE else msg - }) - - -ontologyFromJson <- function(x) { - .Ontology(languages = x[["languages"]], - lang = x[["lang"]], - ontologyId = x[["ontologyId"]], - loaded = x[["loaded"]], - updated = x[["updated"]], - status = x[["status"]], - message = x[["message"]], - version = x[["version"]], - numberOfTerms = x[["numberOfTerms"]], - numberOfProperties = x[["numberOfProperties"]], - numberOfIndividuals = x[["numberOfIndividuals"]], - config = x[["config"]], - links = x[["_links"]]) -} - -########################################## -## Helper functions - -##' @title Makes an Ontologies instance with all ontologies -##' -##' @return An object of class Ontologies, i.e. a list on Ontology -##' instances. -##' -##' @noRd -makeOntologies <- function() { - url <- "https://www.ebi.ac.uk/ols4/api/ontologies/" - x <- lapply( - req_perform_iterative( - request(url), - next_req, - progress = TRUE), - resp_embedded, - what = "ontologies") |> - unlist(recursive = FALSE) - .Ontologies(x = lapply(x, ontologyFromJson)) -} - -makeOntology <- function(url) { - request(url) |> - req_perform() |> - resp_body_json() |> - ontologyFromJson() -} - -setMethod("ontologyUrl", "character", - function(object) - paste0("https://www.ebi.ac.uk/ols4/api/ontologies/", - object)) - -setMethod("ontologyUrl", "Ontology", - function(object) object@links$self$href) diff --git a/R/methods-Properties.R b/R/methods-Properties.R deleted file mode 100644 index 0d8eb34..0000000 --- a/R/methods-Properties.R +++ /dev/null @@ -1,61 +0,0 @@ -########################################## -## Constructors -setMethod("properties", "character", - function(object, ...) .properties(object, ...)) -setMethod("properties", "Ontology", - function(object, ...) .properties(olsNamespace(object), ...)) - -setMethod("properties", "Term", - function(object, ...) { - urls <- getPropertyLinks(object) - if (length(urls) == 0) { - message("No properties for term ", termId(object)) - return(NULL) - } - ans <- lapply(urls, makeProperties) - ans <- unlist(lapply(ans, "slot", "x")) - names(ans) <- sub("\\.href\\.", "/", names(ans)) - Properties(x = ans) - }) - -setMethod("properties", "Terms", - function(object, ...) { - lapply(object@x, properties, ...) - }) - -########################################## -## show methods - -setMethod("show", "Property", - function(object) { - ids <- termId(object) - cat("A Property from the", termPrefix(object), "ontology:", ids, "\n") - cat(" Label: ", termLabel(object),"\n", sep = "") - }) - - -setMethod("show", "Properties", - function(object) { - cat("Object of class 'Properties' with", length(object), - ifelse(length(object) > 1, - "entries\n", - "entry\n")) - onts <- unique(termPrefix(object)) - if (length(onts) == 1) - cat(" From the", onts, "ontology\n") - else if (length(onts) < 6) - cat(" From the", paste(onts, collapse = ", "), "ontologies\n") - else cat(" From ", length(onts), "ontologies\n") - n <- length(object) - if (n > 4) - cat(" ", paste(head(termLabel(object), n=2), collapse = ", "), - "...", - paste(tail(termLabel(object), n=2), collapse = ", "), "\n") - else - cat(paste(termLabel(object)[1:n], collapse = ", "), "\n") - }) - -########################################## -## Data manipulation - -setMethod("length", "Properties", function(x) length(x@x)) diff --git a/R/methods-Terms.R b/R/methods-Terms.R deleted file mode 100644 index 5703737..0000000 --- a/R/methods-Terms.R +++ /dev/null @@ -1,398 +0,0 @@ -########################################## -## Constructors - -## Using the ontologyId -setMethod("Terms", "character", - function(x, pagesize = 1000) - makeTerms(x, pagesize)) - -## Using an Ontology instance -setMethod("Terms", "Ontology", - function(x, pagesize = 1000) - makeTerms(x, pagesize)) - - -##' @title Constructs the query for all term from a given ontology -##' -##' @param oid `character(1)` with an ontologyIf or an `Ontology` -##' instance. -##' -##' @param pagesize `numerci(1)` indicating the number of results per -##' page to return. Default is `1000`. -##' -##' @return An object of class Terms -##' -makeTerms <- function(oid, pagesize) { - ont <- Ontology(oid) - url <- paste0(ont@links$terms$href) - ## url <- paste(ontologyUrl(ont), "terms", sep = "/") - url <- paste0(url, "?&size=", as.integer(pagesize)) - x <- lapply( - req_perform_iterative( - request(url), - next_req, - progress = TRUE), - resp_embedded, - what = "terms") |> - unlist(recursive = FALSE) - ans <- lapply(x, termFromJson) - names(ans) <- sapply(ans, termId) - .Terms(x = ans) -} - -## These methods query an Ontology (or its prefix) for all or one term -## setMethod("terms", "character", -## function(x, ...) .terms(x, ...)) -## setMethod("terms", "Ontology", -## function(x, ...) .terms(olsNamespace(x), ...)) -## setMethod("term", c("character", "character"), -## function(object, id, ...) .term(object, id, ...)) -## setMethod("term", c("Ontology", "character"), -## function(object, id,...) .term(object, id, ...)) - - -partOf <- function(id) { - stopifnot(inherits(id, "Term")) - url <- id@links$part_of[[1]] - if (is.null(url)) { - message("No 'part of' terms.") - return(NULL) - } - x <- GET(url) - stop_for_status(x) - cx <- content(x) - ans <- lapply(cx[["_embedded"]][[1]], makeTerm) - names(ans) <- sapply(ans, termId) - Terms(x = ans) -} - -derivesFrom <- function(id) { - stopifnot(inherits(id, "Term")) - url <- id@links$derives_from[[1]] - if (is.null(url)) { - message("No 'derives from' terms.") - return(NULL) - } - x <- GET(url) - stop_for_status(x) - cx <- content(x) - ans <- lapply(cx[["_embedded"]][[1]], makeTerm) - names(ans) <- sapply(ans, termId) - Terms(x = ans) -} - -children <- function(id) { - pagesize <- 20 - stopifnot(inherits(id, "Term")) - url0 <- id@links$children[[1]] - if (is.null(url0)) { - message("No children terms.") - return(NULL) - } - url <- paste0(url0, "?page=0&size=", pagesize) - x <- GET(url) - stop_for_status(x) - cx <- content(x) - if (cx$page$totalElements > pagesize) { - pagesize <- cx$page$totalElements - url <- paste0(url0, "?page=0&size=", pagesize) - x <- GET(url) - warn_for_status(x) - cx <- content(x) - } - ans <- lapply(cx[["_embedded"]][[1]], makeTerm) - names(ans) <- sapply(ans, termId) - Terms(x = ans) -} - -parents <- function(id) { - pagesize <- 20 - stopifnot(inherits(id, "Term")) - url0 <- id@links$parents[[1]] - if (is.null(url0)) { - message("No parent terms.") - return(NULL) - } - url <- paste0(url0, "?page=0&size=", pagesize) - x <- GET(url) - stop_for_status(x) - cx <- content(x) - if (cx$page$totalElements > pagesize) { - pagesize <- cx$page$totalElements - url <- paste0(url0, "?page=0&size=", pagesize) - x <- GET(url) - warn_for_status(x) - cx <- content(x) - } - ans <- lapply(cx[["_embedded"]][[1]], makeTerm) - names(ans) <- sapply(ans, termId) - Terms(x = ans) -} - -ancestors <- function(id) { - pagesize <- 20 - stopifnot(inherits(id, "Term")) - url0 <- id@links$ancestors[[1]] - if (is.null(url0)) { - message("No ancestor terms.") - return(NULL) - } - url <- paste0(url0, "?page=0&size=", pagesize) - x <- GET(url) - stop_for_status(x) - cx <- content(x) - if (cx$page$totalElements > pagesize) { - pagesize <- cx$page$totalElements - url <- paste0(url0, "?page=0&size=", pagesize) - x <- GET(url) - warn_for_status(x) - cx <- content(x) - } - ans <- lapply(cx[["_embedded"]][[1]], makeTerm) - names(ans) <- sapply(ans, termId) - Terms(x = ans) -} - -descendants <- function(id) { - pagesize <- 20 - stopifnot(inherits(id, "Term")) - url0 <- id@links$descendants[[1]] - if (is.null(url0)) { - message("No descendant terms.") - return(NULL) - } - url <- paste0(url0, "?page=0&size=", pagesize) - x <- httr::GET(url) - stop_for_status(x) - cx <- content(x) - if(cx$page$totalElements > pagesize){ - pagesize <- cx$page$totalElements - - #Figure out how many pages the results will divide into. - url_pages <- c(0:(ceiling(pagesize/1000)-1)) - - #Make as many URLs as there are pages anticipated. - url <- paste0(url0, "?page=",url_pages,"&size=", pagesize) - - #Loop through queries of each URL. - cx <- lapply(url, function(x) { - a <- GET(x) - warn_for_status(a) - a <- content(a)}) - }else{ - #Put singular into a list for lapply()'s sake. - cx <- list(cx) - } - ans <- lapply(cx, function(x) - lapply(x[["_embedded"]][[1]], makeTerm)) - - #Concatenate all results into one list. - ans <- do.call(c,ans) - - names(ans) <- sapply(ans, termId) - Terms(x = ans) -} - -########################################## -## show methods - -setMethod("show", "Term", - function(object) { - ids <- .termId(object) - cat("A Term from the", termPrefix(object), "ontology:", ids, "\n") - cat(" Label: ", termLabel(object),"\n ", sep = "") - desc <- termDesc(object) - if (is.null(desc)) cat("No description\n") - else for (i in 1:seq_along(desc)) - cat(strwrap(desc[[i]]), sep = "\n ") - }) - - -setMethod("show", "Terms", - function(object) { - cat("Object of class 'Terms' with", length(object), "entries\n") - onts <- unique(termPrefix(object)) - if (length(onts) == 1) - cat(" From the", onts, "ontology\n") - else if (length(onts) < 6) - cat(" From the", paste(onts, collapse = ", "), "ontologies\n") - else cat(" From ", length(onts), "ontologies\n") - n <- length(object) - if (n > 4) - cat(" ", paste(head(termId(object), n=2), collapse = ", "), - "...", - paste(tail(termId(object), n=2), collapse = ", "), "\n") - else - cat(paste(termId(object)[1:n], collapse = ", "), "\n") - }) - -########################################## -## Accessors - -setMethod("termSynonym", "Term", - function(object) unlist(object@synonyms)) -setMethod("termSynonym", "Terms", - function(object) lapply(object@x, termSynonym)) - -setMethod("isObsolete", "Term", - function(object) object@is_obsolete) -setMethod("isObsolete", "Terms", - function(object) sapply(object@x, isObsolete)) - -setMethod("isRoot", "Term", - function(object) object@is_root) -setMethod("isRoot", "Terms", - function(object) sapply(object@x, isRoot)) - -setMethod("termLabel", "Term", - function(object) object@label) -setMethod("termLabel", "Terms", - function(object) sapply(object@x, termLabel)) - -setMethod("termId", "Term", - function(object) .termId(object)) -setMethod("termId", "Terms", - function(object) sapply(object@x, .termId)) - -setMethod("termPrefix", "Term", - function(object) object@ontology_prefix) -setMethod("termPrefix", "Terms", - function(object) sapply(object@x, termPrefix)) - -setMethod("termDesc", "Term", - function(object) unlist(object@description)) -setMethod("termDesc", "Terms", - function(object) sapply(object@x, termDesc)) - -setMethod("termOntology", "Term", - function(object) unlist(object@ontology_name)) -setMethod("termOntology", "Terms", - function(object) sapply(object@x, termOntology)) - -setMethod("termNamespace", "Term", - function(object) unlist(object@annotation$has_obo_namespace)) -setMethod("termNamespace", "Terms", - function(object) sapply(object@x, termNamespace)) - -########################################## -## Data manipulation - -setMethod("length", "Terms", function(x) length(x@x)) - -## setMethod("unique", "Terms", function(x) x[!duplicated(names(x@x))]) - -setMethod("[", "Terms", - function(x, i, j="missing", drop="missing") Terms(x = x@x[i])) - -setMethod("[[", "Terms", - function(x, i, j="missing", drop="missing") x@x[[i]]) - -setMethod("lapply", "Terms", - function(X, FUN, ...) lapply(X@x, FUN, ...)) - -setMethod("all.equal", c("Term", "Term"), - function(target, current) { - msg <- Biobase::validMsg(NULL, NULL) - snms <- slotNames("Term") - for (i in snms[-grep("links", snms)]) { - eq <- all.equal(slot(target, i), slot(current, i)) - if (is.character(eq)) { - eq <- paste0("Slot '", i, "': ", eq) - msg <- Biobase:::validMsg(msg, eq) - } - } - lt <- slot(target, "links") - lc <- slot(current, "links") - ot <- order(names(lt)) - oc <- order(names(lc)) - msg <- Biobase:::validMsg(msg, all.equal(lt[ot], lc[oc])) - if (is.null(msg)) return(TRUE) - else msg - }) - - -setMethod("all.equal", c("Terms", "Terms"), - function(target, current) { - msg <- Biobase::validMsg(NULL, NULL) - if (length(target) != length(current)) { - msg <- Biobase::validMsg(msg, "2 Terms are of different lengths") - } else { - tg <- target@x - ct <- current@x - if (any(sort(names(tg)) != sort(names(ct)))) { - msg <- Biobase::validMsg(msg, "Term ids don't match") - } else { - ot <- order(names(tg)) - oc <- order(names(ct)) - tg <- tg[ot] - ct <- ct[oc] - for (i in seq_along(tg)) { - eq <- all.equal(tg[[i]], ct[[i]]) - if (is.character(eq)) { - eq <- paste0("Term id '", names(tg)[i], "': ", eq) - msg <- Biobase:::validMsg(msg, eq) - } - } - } - } - if (is.null(msg)) return(TRUE) - else msg - }) - -fix_null <- function(x) { - if (is.null(x)) return(NA) - if (is.list(x)) return(x[[1]]) - return(x) -} - -setAs("Term", "data.frame", - function(from) - data.frame( - id = fix_null(termId(from)), - label = fix_null(termLabel(from)), - description = fix_null(termDesc(from)), - ontology = fix_null(termOntology(from)), - is_obsolete = fix_null(isObsolete(from)), - has_children = fix_null(from@has_children), - is_root = fix_null(isRoot(from)), - first_synonym = fix_null(termSynonym(from)), - iri = fix_null(from@iri), - is_defining_ontology = fix_null(from@is_defining_ontology), - stringsAsFactors = FALSE) - ) - -as.Term.data.frame <- function(x) - as(x, "data.frame") - -setAs("Terms", "data.frame", - function(from) do.call(rbind, lapply(from, as, "data.frame"))) - -as.Terms.data.frame <- function(x) - as(x, "data.frame") - -############################################# -## utils -termFromJson <- function(x) { - .Term(iri = x[["iri"]], - lang = x[["lang"]], - description = x[["description"]], - synonyms = x[["synonyms"]], - annotation = x[["annotation"]], - label = x[["label"]], - ontology_name = x[["ontology_name"]], - ontology_prefix = x[["ontology_prefix"]], - ontology_iri = x[["ontology_iri"]], - is_obsolete = x[["is_obsolete"]], - term_replaced_by = x[["term_replaced_by"]], - is_defining_ontology = x[["is_defining_ontology"]], - has_children = x[["has_children"]], - is_root = x[["is_root"]], - short_form = x[["short_form"]], - obo_id = x[["obo_id"]], - in_subset = x[["in_subset"]], - obo_definition_citation = x[["obo_definition_citation"]], - obo_xref = x[["obo_xref"]], - obo_synonym = x[["obo_synonym"]], - is_preferred_root = x[["is_preferred_root"]], - links = x[["_links"]]) -} diff --git a/R/utils.R b/R/utils.R index a6a4026..82d748d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,5 +1,6 @@ ##################################### ## httr2 utils +##' @import httr2 next_req <- function(resp, req) { .next <- resp_body_json(resp)[["_links"]][["next"]]$href if (is.null(.next)) @@ -13,143 +14,52 @@ resp_embedded <- function(resp, what) { } -## This will not always be the correct URI (see for example -## Orphaned/ORBO and https://github.com/EBISPOT/OLS/issues/35) -setMethod("ontologyUri", "missing", - function(encode = TRUE) { - uri <- "http://purl.obolibrary.org/obo/" - if (encode) - uri <- gsub("%", "%25", URLencode(uri, TRUE)) - uri - }) - -setMethod("ontologyUri", "Ontology", - function(object, encode = TRUE, withPrefix = FALSE) { - uri <- object@config$baseUris - if (is.null(uri) | length(uri) == 0) - return(ontologyUri()) - if (length(uri) > 1) { - msg <- paste0("More than one URI available:\n ", - paste(unlist(uri), collapse = ", "), "\n ", - "Choosing the first one.\n") - warning(msg) - } - uri <- uri[[1]][1] - if (!withPrefix) - uri <- sub("/[A-Za-z]+_$", "/", uri) - if (encode) - uri <- gsub("%", "%25", URLencode(uri, TRUE)) - uri - }) - - - -.termId <- function(x) x@obo_id - - -## ##' @title Makes a Term instance based on the response from +## ##' @title Constructs the query for all properties from a given ontology +## ##' @param oid A character with an ontology or an ontology +## ##' @param pagesize How many results per page to return +## ##' @return An object of class Terms +## .properties <- function(oid, pagesize = 200) { +## ont <- Ontology(oid) +## url <- paste(ontologyUrl(ont), "properties", sep = "/") +## url <- paste0(url, "?&size=", pagesize) +## makeProperties(url) +## } + +## makeProperties <- function(url) { +## x <- GET(url) +## stop_for_status(x) +## cx <- content(x) +## ans <- lapply(cx[["_embedded"]][[1]], makeProperty) +## ## -- Iterating +## .next <- cx[["_links"]][["next"]]$href +## while (!is.null(.next)) { +## x <- GET(.next) +## warn_for_status(x) +## cx <- content(x) +## ans <- append(ans, lapply(cx[["_embedded"]][[1]], makeProperty)) +## .next <- cx[["_links"]][["next"]][[1]] +## } +## names(ans) <- sapply(ans, termLabel) +## Properties(x = ans) +## } + +## ##' @title Makes a Property instance based on the response from ## ##' /api/ontologies/{ontology}/terms/{iri} ## ##' @param x The content from the response -## ##' @return An object of class Term -## makeTerm <- function(x) -## .Term(iri = x$iri, -## label = x$label, -## description = x$description, -## annotation = x$annotation, -## synonym = x$synonym, -## ontology_name = x$ontology_name, -## ontology_prefix = x$ontology_prefix, -## ontology_iri = x$ontology_iri, -## is_obsolete = x$is_obsolete, -## is_defining_ontology = x$is_defining_ontology, -## has_children = x$has_children, -## is_root = x$is_root, -## short_form = x$short_form, -## obo_id = x$obo_id, -## links = x$`_links`) - - - -##' @title Constructs the query for a single term from a given -##' ontology -##' -##' @param oid `character(1)` containg the ontologyId or an `Ontology` -##' instance. -##' -##' @param termid `character(1)` with a term id. -##' -##' @return An object of class `Term` -.term <- function(oid, termid) { - ont <- Ontology(oid) - ## url <- paste0(ont@links$terms$href, "/") - url <- paste0(ontologyUrl(ont), "terms", "/") - ## uri <- URLencode(ontologyUri(ont), TRUE) - url <- paste0(url, uri, sub(":", "_", termid)) - x <- GET(url) - stop_for_status(x) - cx <- content(x) - makeTerm(cx) -} - - -##' @title Constructs the query for all properties from a given ontology -##' @param oid A character with an ontology or an ontology -##' @param pagesize How many results per page to return -##' @return An object of class Terms -.properties <- function(oid, pagesize = 200) { - ont <- Ontology(oid) - url <- paste(ontologyUrl(ont), "properties", sep = "/") - url <- paste0(url, "?&size=", pagesize) - makeProperties(url) -} - -makeProperties <- function(url) { - x <- GET(url) - stop_for_status(x) - cx <- content(x) - ans <- lapply(cx[["_embedded"]][[1]], makeProperty) - ## -- Iterating - .next <- cx[["_links"]][["next"]]$href - while (!is.null(.next)) { - x <- GET(.next) - warn_for_status(x) - cx <- content(x) - ans <- append(ans, lapply(cx[["_embedded"]][[1]], makeProperty)) - .next <- cx[["_links"]][["next"]][[1]] - } - names(ans) <- sapply(ans, termLabel) - Properties(x = ans) -} - -##' @title Makes a Property instance based on the response from -##' /api/ontologies/{ontology}/terms/{iri} -##' @param x The content from the response -##' @return An object of class Property -makeProperty <- function(x) - .Property(iri = x$iri, - label = x$label, - description = x$description, - annotation = x$annotation, - synonym = x$synonym, - ontology_name = x$ontology_name, - ontology_prefix = x$ontology_prefix, - ontology_iri = x$ontology_iri, - is_obsolete = x$is_obsolete, - is_defining_ontology = x$is_defining_ontology, - has_children = x$has_children, - is_root = x$is_root, - short_form = x$short_form, - obo_id = x$obo_id, - links = x$`_links`) - - -## see https://github.com/EBISPOT/OLS/issues/36 -getPropertyLinks <- function(trm) { - termlinks <- c("self", "parents", "ancestors", - "children", "descendants", - "part_of","derives_from") - graphlinks <- c("jstree", "graph") - nms <- names(trm@links) - p <- !nms %in% c(termlinks, graphlinks) - unlist(trm@links[p]) -} +## ##' @return An object of class Property +## makeProperty <- function(x) +## .Property(iri = x$iri, +## label = x$label, +## description = x$description, +## annotation = x$annotation, +## synonym = x$synonym, +## ontology_name = x$ontology_name, +## ontology_prefix = x$ontology_prefix, +## ontology_iri = x$ontology_iri, +## is_obsolete = x$is_obsolete, +## is_defining_ontology = x$is_defining_ontology, +## has_children = x$has_children, +## is_root = x$is_root, +## short_form = x$short_form, +## obo_id = x$obo_id, +## links = x$`_links`) diff --git a/R/zzz.R b/R/zzz.R index def846e..da1cee5 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,3 +1,5 @@ +##' @import utils packageVersion .onAttach <- function(libname, pkgname) { - packageStartupMessage(paste("\nThis is 'rols' version", packageVersion("rols"), "\n")) + packageStartupMessage(paste("\nThis is 'rols' version", + packageVersion("rols"), "\n")) } diff --git a/man/Ontology-class.Rd b/man/Ontology-class.Rd index 9395bad..59e45f2 100644 --- a/man/Ontology-class.Rd +++ b/man/Ontology-class.Rd @@ -59,6 +59,9 @@ \alias{olsUpdated,character-method} \alias{olsUpdated,Ontologies-method} +\alias{olsLinks} +\alias{olsLinks,Ontology-method} + \alias{show,Ontology-method} \alias{show,Ontologies-method} @@ -77,31 +80,32 @@ \description{ - Ontologies are stored as \code{Ontology} and \code{Ontologies} - instances, and contain various information as provided by the Ontology - Lookup Service. + The rols package provides an interface to PRIDE's Ontology Lookup + Servive (OLS) and can be used to query one or multiple ontologies, + stored as \code{Ontology} and \code{Ontologies} instances, and + containing various information as provided by OLS. } \details{ - + Ontologies are referred to by their namespace, which is lower case: the Gene Onology is "go", the Mass spectrometry ontology is "ms", etc. The ontologies also have prefixes, which are upper case: the Gene - Onology prefix "GO", the Mass spectrometry ontology prefix "MS". The - only exception to this rule is the Drosophila Phenotype Ontology, - whose namespace and prefix are "dpo" and "FBcv" respectively. This is - particularly confusing as the FlyBase Controlled Vocabulary has "fbcv" - and "FBcv" as namespace and prefix respectively. + Onology prefix "GO", the Mass spectrometry ontology prefix "MS". One + exception to this rule is the Drosophila Phenotype Ontology, whose + namespace and prefix are "dpo" and "FBcv" respectively (there might be + more). This is particularly confusing as the FlyBase Controlled + Vocabulary has "fbcv" and "FBcv" as namespace and prefix respectively. When using a character to initialise an ontology or query a term, - "fbcv" (this is case insensitive) will refer to the the FlyBase Controlled - Vocabulary. The the Drosophila Phenotype Ontology will have to be - referred as "dpo" (also case insensitive). + "fbcv" (this is case insensitive) will refer to the the FlyBase + Controlled Vocabulary. The the Drosophila Phenotype Ontology will have + to be referred as "dpo" (also case insensitive). } \section{Objects from the Class}{ - + Objects can be created in multiple ways. The \code{Ontologies} function will initialise all available ontolgies as an \code{Ontologies} object, while a call to \code{Ontology} with an @@ -122,34 +126,34 @@ \section{Slots}{ \describe{ - + \item{\code{loaded}:}{Object of class \code{NULL} or \code{character} containing the date the ontology was loaded on the backend side. Accessed with the \code{olsLoaded} method.} - + \item{\code{updated}:}{Object of class \code{NULL} or \code{character} containing the date the ontology was last updated on the backend side. Accessed with the \code{olsUpdated} method.} - + \item{\code{status}:}{Object of class \code{NULL} or \code{character} documenting the status of the ontology on the backend side. For example \code{"LOADED"}, \code{"FAILED"} or \code{"NOTLOADED"}. Accessed with the \code{olsStatus} method.} - + \item{\code{message}:}{Object of class \code{NULL} or \code{character} documentating the status of the ontology on the backend side. } - + \item{\code{version}:}{Object of class \code{NULL} or \code{character} documenting the version of the ontology. Note that there is also a \code{version} field in the \code{config} slot below. Use \code{olsVersion} to access the appropriate date. } - + \item{\code{numberOfTerms}:}{Object of class \code{"integer"} documenting the number of terms available in the ontology. } - + \item{\code{numberOfProperties}:}{Object of class \code{"integer"} documenting the number of properties available in the ontology. } @@ -158,7 +162,7 @@ \item{\code{config}:}{Object of class \code{"list"} containing further ontology configuration and metadata. } - + } } @@ -169,23 +173,23 @@ \item{Ontology}{\code{signature(object = "character")}: } - + \item{olsDesc}{\code{signature(object = "Ontology")}: returns the description of an ontology. Also works for \code{Ontologies} objects and \code{character} describing an ontology namespace or prefix (see Details). } - + \item{olsPrefix}{\code{signature(object = "Ontology")}: retruns the prefix of an ontology. Also works for \code{Ontologies} objects describing an ontology namespace or prefix (see Details). } - + \item{olsRoot}{\code{signature(object = "Ontology")}: returns the root of the ontology as a \code{\linkS4class{Terms}} instance. \code{object} could also be a \code{character} with an ontology namespace or prefix (see Details). If \code{object} is of class \code{Ontologies}, it returns a \code{list} of \code{\linkS4class{Terms}}. } - + \item{olsVersion}{\code{signature(object = "Ontology")}: returns the version of the ontology. Also works with an ontology namespace or prefix (see Details) as a \code{character} or an object of class @@ -206,16 +210,11 @@ containing the ontology namespace or prefix (see Details) or an object of class \code{Ontologies}.} - \item{olsStatus}{\code{signature(object = "Ontology")}: returns the - namespace of the ontology. Also works with a \code{character} - containing the ontology namespace or prefix (see Details) or an - object of class \code{Ontologies}.} - \item{olsTitle}{\code{signature(object = "Ontology")}: returns the title of an ontology. Also works with a \code{character} containing the ontology namespace or prefix (see Details) or an object of class \code{Ontologies}.} - + \item{show}{\code{signature(object = "Ontology")}: prints a short summary of \code{Ontology} and \code{Ontologies} objects. } @@ -223,13 +222,13 @@ number of ontolgies described by the \code{Ontologies} object. } \item{all.equal}{\code{signature(target = "Ontologies", current = - "Ontologies")}: ... } - + "Ontologies")}: ... } + } } \author{ - Laurent Gatto + Laurent Gatto } \examples{ @@ -241,8 +240,10 @@ head(as(ol, "data.frame")) length(ol) ## Individual ontologies -(go <- ol[["go"]]) (efo <- ol[["efo"]]) +(go <- ol[["go"]]) +(go2 <- Ontology("go")) +identical(go, go2) ## some basic information olsVersion(go) @@ -251,10 +252,7 @@ olsTitle(go) olsPrefix(go) olsNamespace(go) -olsRoot(go) - -## works with Ontology objects or their namespace -identical(olsRoot("go"), olsRoot(go)) +## with Ontology objects or their namespace identical(olsVersion("go"), olsVersion(go)) ## Directly initialise a single ontology diff --git a/man/Term-class.Rd b/man/Term-class.Rd index 4fe5f4f..7ade046 100644 --- a/man/Term-class.Rd +++ b/man/Term-class.Rd @@ -8,6 +8,8 @@ \alias{Terms} \alias{class:Terms} \alias{Terms-class} +\alias{Terms,Ontology-method} +\alias{Terms,character-method} \alias{termLabel} \alias{termLabel,Term-method} @@ -33,6 +35,8 @@ \alias{termPrefix,Term-method} \alias{termPrefix,Terms-method} +\alias{olsLinks,Term-method} + \alias{show,Term-method} \alias{show,Terms-method} @@ -82,13 +86,13 @@ The \code{Term} class describes an ontology term. A set of terms are instantiated as a \code{Terms} class. - + } \section{Objects from the Class}{ - - Objects can be created using the \code{term} and \code{terms} - functions. The latter is used with an object of class + + Objects can be created using the \code{Term} and \code{Terms} + constructers. The latter is used with an object of class \code{\linkS4class{Ontology}} or a \code{character} describing a valid ontology prefix to download and instantiate all terms of an ontology of interest. The former takes an \code{Ontology} object (or an @@ -102,7 +106,7 @@ \code{Terms} instances can be subset with \code{[} and \code{[[} and iterated over with \code{lapply}. - + } \section{Slots}{ @@ -130,13 +134,13 @@ \item{term}{\code{signature(object = "Ontology", id = "character")}: ... } - + \item{terms}{\code{signature(x = "Ontology", pagesize = "numeric")}: ... } - + \item{termDesc}{\code{signature(object = "Term")}: ... } - + \item{termLabel}{\code{signature(object = "Term")}: ... } - + \item{termPrefix}{\code{signature(object = "Term")}: ... } \item{termSynonym}{\code{signature(object = "Term")}: ... } @@ -148,7 +152,7 @@ \item{isRoot}{\code{signature(object = "Term")}: ... } \item{isObsolete}{\code{signature(object = "Term")}: ... } - + \item{termId}{\code{signature(object = "Term")}: ... } \item{children}{\code{signature(object = "Term")}: Returns a new @@ -158,11 +162,11 @@ \item{parents}{\code{signature(object = "Term")}: Returns a new \code{Terms} instance with the \code{object}'s parents. \code{NULL} if there are not parents.} - + \item{ancestors}{\code{signature(object = "Term")}: Returns a new \code{Terms} instance with the \code{object}'s ancestors. \code{NULL} if there are not ancestors. } - + \item{descendants}{\code{signature(object = "Term")}: Returns a new \code{Terms} instance with the \code{object}'s descendants. \code{NULL} if there are not descendants. } @@ -174,17 +178,17 @@ \item{derivesFrom}{\code{signature(object = "Term")}: Returns a new \code{Terms} instance with terms the \code{object}'s is derived from. \code{NULL} if none. } - + \item{show}{\code{signature(object = "Term")}: ... } \item{show}{\code{signature(object = "Terms")}: ... } \item{all.equal}{\code{signature(target = "Term", current = - "Term")}: ... } - + "Term")}: ... } + \item{all.equal}{\code{signature(target = "Terms", current = - "Terms")}: ... } - + "Terms")}: ... } + \item{length}{\code{signature(object = "Terms")}: returns the number of ontolgies described by the \code{Terms} object. } @@ -202,9 +206,9 @@ root node, the first synonym only, their iri and whether they are defining the ontology. Any missing value will be reported as \code{NA}. } - + } - + } \author{ diff --git a/man/dot-properties.Rd b/man/dot-properties.Rd deleted file mode 100644 index f91eecb..0000000 --- a/man/dot-properties.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{.properties} -\alias{.properties} -\title{Constructs the query for all properties from a given ontology} -\usage{ -.properties(oid, pagesize = 200) -} -\arguments{ -\item{oid}{A character with an ontology or an ontology} - -\item{pagesize}{How many results per page to return} -} -\value{ -An object of class Terms -} -\description{ -Constructs the query for all properties from a given ontology -} diff --git a/man/dot-term.Rd b/man/dot-term.Rd deleted file mode 100644 index 4b848fa..0000000 --- a/man/dot-term.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{.term} -\alias{.term} -\title{Constructs the query for a single term from a given - ontology} -\usage{ -.term(oid, termid) -} -\arguments{ -\item{oid}{A character with an ontology or an ontology} - -\item{termid}{A character with a term id} -} -\value{ -An object of class Term -} -\description{ -Constructs the query for a single term from a given - ontology -} diff --git a/man/dot-terms.Rd b/man/dot-terms.Rd deleted file mode 100644 index 4867f4e..0000000 --- a/man/dot-terms.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{.terms} -\alias{.terms} -\title{Constructs the query for all term from a given ontology} -\usage{ -.terms(oid, pagesize = 1000) -} -\arguments{ -\item{oid}{A character with an ontology or an ontology} - -\item{pagesize}{How many results per page to return} -} -\value{ -An object of class Terms -} -\description{ -Constructs the query for all term from a given ontology -} diff --git a/man/makeProperty.Rd b/man/makeProperty.Rd deleted file mode 100644 index 968a532..0000000 --- a/man/makeProperty.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{makeProperty} -\alias{makeProperty} -\title{Makes a Property instance based on the response from - /api/ontologies/{ontology}/terms/{iri}} -\usage{ -makeProperty(x) -} -\arguments{ -\item{x}{The content from the response} -} -\value{ -An object of class Property -} -\description{ -Makes a Property instance based on the response from - /api/ontologies/{ontology}/terms/{iri} -} diff --git a/man/makeTerm.Rd b/man/makeTerm.Rd deleted file mode 100644 index 7036b9f..0000000 --- a/man/makeTerm.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{makeTerm} -\alias{makeTerm} -\title{Makes a Term instance based on the response from - /api/ontologies/{ontology}/terms/{iri}} -\usage{ -makeTerm(x) -} -\arguments{ -\item{x}{The content from the response} -} -\value{ -An object of class Term -} -\description{ -Makes a Term instance based on the response from - /api/ontologies/{ontology}/terms/{iri} -} diff --git a/tests/testthat/test_Onologies.R b/tests/testthat/test_Onologies.R index a582a0f..7177638 100644 --- a/tests/testthat/test_Onologies.R +++ b/tests/testthat/test_Onologies.R @@ -2,8 +2,6 @@ ol <- Ontologies() go <- go1 <- Ontology("go") test_that("Ontology constructors", { - ol1 <- Ontologies(50) - expect_true(all.equal(ol, ol1)) ## expect_equal(length(ol), 143L) ## this will likely change expect_true(length(ol) > 120L) expect_true(is.integer(length(ol))) @@ -35,8 +33,7 @@ test_that("Ontology accessors", { ## --- Dates --- ## if the loaded date is not valid (NA), then that ontology should ## not have a status 'LOADED'. - expect_warning(loaded <- lubridate::ymd(olsLoaded(ol))) - ## expect_true(all(which(is.na(loaded)) %in% which(status != "LOADED"))) + expect_true(all(which(is.na(loaded)) %in% which(status != "LOADED"))) ## all update dates must be correct updated <- lubridate::ymd(olsUpdated(ol)) expect_false(any(is.na(updated))) @@ -48,37 +45,43 @@ test_that("Ontology accessors", { expect_identical(olsLoaded(go), olsLoaded("go")) expect_identical(olsUpdated(go), olsUpdated("GO")) expect_identical(olsUpdated(go), olsUpdated("go")) + ## --- Versions --- vrs <- olsVersion(ol) pre <- olsPrefix(ol) expect_identical(n, length(vrs)) expect_identical(n, length(pre)) - expect_identical(vrs[["go"]], olsVersion(go)) + ## expect_identical(vrs[["go"]], olsVersion(go)) expect_identical(olsVersion("GO"), olsVersion(go)) expect_identical(olsVersion("go"), olsVersion(go)) + ## --- Root --- - rts <- olsRoot(ol["go"]) - gort <- rts[[1]] - expect_identical(gort, olsRoot(go)) - expect_identical(gort, olsRoot("go")) - expect_identical(gort, olsRoot("GO")) + ## rts <- olsRoot(ol["go"]) + ## gort <- rts[[1]] + ## expect_identical(gort, olsRoot(go)) + ## expect_identical(gort, olsRoot("go")) + + ## expect_identical(gort, olsRoot("GO")) ### --- Terms --- - trms <- rols:::Terms(x = list('GO:0005575' = term("GO", 'GO:0005575'), - 'GO:0003674' = term("GO", 'GO:0003674'), - 'GO:0008150' = term("GO", 'GO:0008150'))) + trms <- Terms(x = list('GO:0005575' = Term("GO", 'GO:0005575'), + 'GO:0003674' = term("GO", 'GO:0003674'), + 'GO:0008150' = term("GO", 'GO:0008150'))) trms <- trms[order(termId(trms))] gort <- gort[order(termId(gort))] expect_identical(trms, gort) + ## --- Prefix --- expect_identical(pre[[i]], olsPrefix(go)) expect_identical(pre[[i]], olsPrefix("go")) expect_identical(pre[[i]], olsPrefix("GO")) expect_identical(pre[[i]], olsPrefix("Go")) + ## --- Description --- desc <- olsDesc(ol) expect_identical(desc[[i]], olsDesc(go)) expect_identical(desc[[i]], olsDesc("go")) expect_identical(desc[[i]], olsDesc("GO")) + ## --- Title --- ## ttl <- olsTitle(ol) ## expect_identical(ttl[[i]], olsTitle(go)) @@ -88,11 +91,13 @@ test_that("Ontology accessors", { ## next test fixed on 2020/05/01 - changed description ## expect_identical(olsDesc(go), "The Gene Ontology (GO) provides a framework and set of concepts for describing the functions of gene products from all organisms.") ## expect_identical(status[[i]], "LOADED") ## failed Sun Jan 1 20:36:00 GMT 2017 + ## --- Status --- expect_identical(status[[i]], olsStatus(go)) expect_identical(status[[i]], olsStatus("go")) expect_identical(status[[i]], olsStatus("GO")) - ## Namespace + + ## --- Namespace --- nsp0 <- olsNamespace(ol) nsp <- sapply(ol@x, olsNamespace) expect_identical(nsp0, nsp) From 96cc59f60c89ed1e7baf3ff1414155666239076e Mon Sep 17 00:00:00 2001 From: lgatto Date: Sun, 11 Feb 2024 00:33:03 +0100 Subject: [PATCH 04/11] refactoring to ols_requests() --- DESCRIPTION | 7 +++--- R/Ontologies.R | 12 ++-------- R/Properties.R | 56 +++++++++++++++++++++++++++++++++++++++++--- R/Terms.R | 63 ++++++++------------------------------------------ R/utils.R | 60 ++++++++--------------------------------------- 5 files changed, 79 insertions(+), 119 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 16dbc89..cd63cc0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,8 @@ License: GPL-2 Encoding: UTF-8 URL: http://lgatto.github.io/rols/ BugReports: https://github.com/lgatto/rols/issues -Collate: AllClasses.R AllGenerics.R utils.R cvparam.R - methods-OlsSearch.R methods-Ontologies.R methods-Terms.R - methods-Properties.R zzz.R +Collate: AllClasses.R AllGenerics.R utils.R + Ontologies.R Terms.R + cvparam.R OlsSearch.R + Properties.R zzz.R RoxygenNote: 6.1.0 diff --git a/R/Ontologies.R b/R/Ontologies.R index c67b2b0..e4628c6 100644 --- a/R/Ontologies.R +++ b/R/Ontologies.R @@ -447,16 +447,8 @@ setMethod("all.equal", c("Ontology", "Ontology"), ## Helper functions makeOntologies <- function() { url <- "https://www.ebi.ac.uk/ols4/api/ontologies/" - x <- lapply( - req_perform_iterative( - request(url), - next_req, - max_reqs = Inf, - progress = TRUE), - resp_embedded, - what = "ontologies") |> - unlist(recursive = FALSE) - .Ontologies(x = lapply(x, ontologyFromJson)) + .Ontologies(x = lapply(ols_requests(url, "ontologies"), + ontologyFromJson)) } makeOntology <- function(url) { diff --git a/R/Properties.R b/R/Properties.R index fab99cd..b8c733c 100644 --- a/R/Properties.R +++ b/R/Properties.R @@ -1,6 +1,6 @@ -.Property <- setClass("Property", - contains = "Term") -Properties <- setClass("Properties", contains = "Terms") +## .Property <- setClass("Property", +## contains = "Term") +## Properties <- setClass("Properties", contains = "Terms") ## ########################################## @@ -64,3 +64,53 @@ Properties <- setClass("Properties", contains = "Terms") ## ## Data manipulation ## setMethod("length", "Properties", function(x) length(x@x)) + +## ##' @title Constructs the query for all properties from a given ontology +## ##' @param oid A character with an ontology or an ontology +## ##' @param pagesize How many results per page to return +## ##' @return An object of class Terms +## .properties <- function(oid, pagesize = 200) { +## ont <- Ontology(oid) +## url <- paste(ontologyUrl(ont), "properties", sep = "/") +## url <- paste0(url, "?&size=", pagesize) +## makeProperties(url) +## } + +## makeProperties <- function(url) { +## x <- GET(url) +## stop_for_status(x) +## cx <- content(x) +## ans <- lapply(cx[["_embedded"]][[1]], makeProperty) +## ## -- Iterating +## .next <- cx[["_links"]][["next"]]$href +## while (!is.null(.next)) { +## x <- GET(.next) +## warn_for_status(x) +## cx <- content(x) +## ans <- append(ans, lapply(cx[["_embedded"]][[1]], makeProperty)) +## .next <- cx[["_links"]][["next"]][[1]] +## } +## names(ans) <- sapply(ans, termLabel) +## Properties(x = ans) +## } + +## ##' @title Makes a Property instance based on the response from +## ##' /api/ontologies/{ontology}/terms/{iri} +## ##' @param x The content from the response +## ##' @return An object of class Property +## makeProperty <- function(x) +## .Property(iri = x$iri, +## label = x$label, +## description = x$description, +## annotation = x$annotation, +## synonym = x$synonym, +## ontology_name = x$ontology_name, +## ontology_prefix = x$ontology_prefix, +## ontology_iri = x$ontology_iri, +## is_obsolete = x$is_obsolete, +## is_defining_ontology = x$is_defining_ontology, +## has_children = x$has_children, +## is_root = x$is_root, +## short_form = x$short_form, +## obo_id = x$obo_id, +## links = x$`_links`) diff --git a/R/Terms.R b/R/Terms.R index eb581b5..19eed99 100644 --- a/R/Terms.R +++ b/R/Terms.R @@ -178,37 +178,19 @@ children <- function(object) { if (!object@has_children) return(NULL) url <- termLinks(object)[["children"]] - x <- lapply( - req_perform_iterative( - request(url), - next_req, - max_reqs = Inf, - progress = TRUE), - resp_embedded, - what = "terms") |> - unlist(recursive = FALSE) - ans <- lapply(x, termFromJson) + ans <- lapply(ols_requests(url, "terms"), + termFromJson) names(ans) <- sapply(ans, termId) .Terms(x = ans) } - - parents <- function(object) { stopifnot(inherits(object, "Term")) if (object@is_root) return(NULL) url <- termLinks(object)[["parents"]] - x <- lapply( - req_perform_iterative( - request(url), - next_req, - max_reqs = Inf, - progress = TRUE), - resp_embedded, - what = "terms") |> - unlist(recursive = FALSE) - ans <- lapply(x, termFromJson) + ans <- lapply(ols_requests(url, "terms"), + termFromJson) names(ans) <- sapply(ans, termId) .Terms(x = ans) } @@ -218,16 +200,8 @@ ancestors <- function(object) { if (object@is_root) return(NULL) url <- termLinks(object)[["ancestors"]] - x <- lapply( - req_perform_iterative( - request(url), - next_req, - max_reqs = Inf, - progress = TRUE), - resp_embedded, - what = "terms") |> - unlist(recursive = FALSE) - ans <- lapply(x, termFromJson) + ans <- lapply(ols_requests(url, "terms"), + termFromJson) names(ans) <- sapply(ans, termId) .Terms(x = ans) } @@ -237,16 +211,8 @@ descendants <- function(object) { if (!object@has_children) return(NULL) url <- termLinks(object)[["descendants"]] - x <- lapply( - req_perform_iterative( - request(url), - next_req, - max_reqs = Inf, - progress = TRUE), - resp_embedded, - what = "terms") |> - unlist(recursive = FALSE) - ans <- lapply(x, termFromJson) + ans <- lapply(ols_requests(url, "terms"), + termFromJson) names(ans) <- sapply(ans, termId) .Terms(x = ans) } @@ -452,17 +418,8 @@ makeTerms <- function(oid, pagesize, obsolete) { url <- paste0(url, "obsoletes=", ifelse(obsolete, "true", "false")) url <- paste0(url, "&size=", as.integer(pagesize)) - - x <- lapply( - req_perform_iterative( - request(url), - next_req, - max_reqs = Inf, - progress = TRUE), - resp_embedded, - what = "terms") |> - unlist(recursive = FALSE) - ans <- lapply(x, termFromJson) + ans <- lapply(ols_requests(url, "terms"), + termFromJson) names(ans) <- sapply(ans, termId) .Terms(x = ans) } diff --git a/R/utils.R b/R/utils.R index 82d748d..0ac107e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -13,53 +13,13 @@ resp_embedded <- function(resp, what) { body[["_embedded"]][[what]] } - -## ##' @title Constructs the query for all properties from a given ontology -## ##' @param oid A character with an ontology or an ontology -## ##' @param pagesize How many results per page to return -## ##' @return An object of class Terms -## .properties <- function(oid, pagesize = 200) { -## ont <- Ontology(oid) -## url <- paste(ontologyUrl(ont), "properties", sep = "/") -## url <- paste0(url, "?&size=", pagesize) -## makeProperties(url) -## } - -## makeProperties <- function(url) { -## x <- GET(url) -## stop_for_status(x) -## cx <- content(x) -## ans <- lapply(cx[["_embedded"]][[1]], makeProperty) -## ## -- Iterating -## .next <- cx[["_links"]][["next"]]$href -## while (!is.null(.next)) { -## x <- GET(.next) -## warn_for_status(x) -## cx <- content(x) -## ans <- append(ans, lapply(cx[["_embedded"]][[1]], makeProperty)) -## .next <- cx[["_links"]][["next"]][[1]] -## } -## names(ans) <- sapply(ans, termLabel) -## Properties(x = ans) -## } - -## ##' @title Makes a Property instance based on the response from -## ##' /api/ontologies/{ontology}/terms/{iri} -## ##' @param x The content from the response -## ##' @return An object of class Property -## makeProperty <- function(x) -## .Property(iri = x$iri, -## label = x$label, -## description = x$description, -## annotation = x$annotation, -## synonym = x$synonym, -## ontology_name = x$ontology_name, -## ontology_prefix = x$ontology_prefix, -## ontology_iri = x$ontology_iri, -## is_obsolete = x$is_obsolete, -## is_defining_ontology = x$is_defining_ontology, -## has_children = x$has_children, -## is_root = x$is_root, -## short_form = x$short_form, -## obo_id = x$obo_id, -## links = x$`_links`) +ols_requests <- function(url, what) + lapply( + req_perform_iterative( + request(url), + next_req, + max_reqs = Inf, + progress = TRUE), + resp_embedded, + what = what) |> + unlist(recursive = FALSE) From f8d987348d94a36fb0f9114ddd8736acaf5d1ce1 Mon Sep 17 00:00:00 2001 From: lgatto Date: Sun, 11 Feb 2024 01:20:03 +0100 Subject: [PATCH 05/11] use roxygen --- DESCRIPTION | 2 +- NAMESPACE | 106 +++++++--------- R/OlsSearch.R | 1 + R/Ontologies.R | 161 +++++++++++++++--------- R/Terms.R | 138 +++++++++++++-------- R/cvparam.R | 28 +++-- R/zzz.R | 2 +- man/Ontologies.Rd | 279 ++++++++++++++++++++++++++++++++++++++++++ man/Ontology-class.Rd | 266 ---------------------------------------- man/Term-class.Rd | 273 ----------------------------------------- man/Terms.Rd | 245 +++++++++++++++++++++++++++++++++++++ 11 files changed, 771 insertions(+), 730 deletions(-) create mode 100644 man/Ontologies.Rd delete mode 100644 man/Ontology-class.Rd delete mode 100644 man/Term-class.Rd create mode 100644 man/Terms.Rd diff --git a/DESCRIPTION b/DESCRIPTION index cd63cc0..5c4cfbc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,4 +27,4 @@ Collate: AllClasses.R AllGenerics.R utils.R Ontologies.R Terms.R cvparam.R OlsSearch.R Properties.R zzz.R -RoxygenNote: 6.1.0 +RoxygenNote: 7.3.0 diff --git a/NAMESPACE b/NAMESPACE index 67ae5c2..ab54e2b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,64 +1,44 @@ -import(methods) -import(utils) -import(httr2) -import(httr) -import(jsonlite) -importFrom(Biobase, validMsg) -importFrom(BiocGenerics, Ontology) -importClassesFrom(Biobase, Versioned) - -exportClasses(CVParam, - Term, Terms, - Ontology, Ontologies, - OlsSearch) - ## Property, Properties) - -S3method(as.data.frame, OlsSearch) +# Generated by roxygen2: do not edit by hand -exportMethods(show, - "[", "[[", lapply, - coerce, - length, - unique, - ## Ontology/ies - Ontology, Ontologies, - Terms, - ## Term, - olsRoot, - olsPrefix, - olsDesc, - olsTitle, - olsStatus, - olsNamespace, - olsLinks, - ## Term/s - all.equal, - termLabel, - termPrefix, - termNamespace, - termOntology, - termDesc, - term, terms, - termId) - ## Property/ies - ## properties) - - -export(charIsCVParam, CVParam, - ## Ontology/ies - olsVersion, - olsLoaded, - olsUpdated, - ## Term/s - isObsolete, - isRoot, - termSynonym, - children, parents, - ancestors, descendants, - ## derivesFrom, partOf, - as.Term.data.frame, - as.Terms.data.frame, - ## Search/select - OlsSearch, - olsSearch, - olsRows, "olsRows<-", allRows) +S3method(as.character,CVParam) +S3method(as.data.frame,OlsSearch) +S3method(as.data.frame,Ontologies) +export(CVParam) +export(as.Term.data.frame) +export(as.Terms.data.frame) +exportMethods("[") +exportMethods("[[") +exportMethods(Ontologies) +exportMethods(Ontology) +exportMethods(Terms) +exportMethods(isObsolete) +exportMethods(isRoot) +exportMethods(lapply) +exportMethods(length) +exportMethods(olsConfig) +exportMethods(olsDesc) +exportMethods(olsLinks) +exportMethods(olsLoaded) +exportMethods(olsNamespace) +exportMethods(olsPrefix) +exportMethods(olsStatus) +exportMethods(olsTitle) +exportMethods(olsUpdated) +exportMethods(olsVersion) +exportMethods(ontologyUrl) +exportMethods(rep) +exportMethods(show) +exportMethods(termDesc) +exportMethods(termId) +exportMethods(termLabel) +exportMethods(termLinks) +exportMethods(termNamespace) +exportMethods(termOntology) +exportMethods(termPrefix) +exportMethods(termSynonym) +exportMethods(unique) +import(httr2) +import(methods) +importFrom(Biobase,validMsg) +importFrom(utils,packageVersion) +importMethodsFrom(BiocGenerics,Ontology) diff --git a/R/OlsSearch.R b/R/OlsSearch.R index fd25daa..3bf3de9 100644 --- a/R/OlsSearch.R +++ b/R/OlsSearch.R @@ -150,6 +150,7 @@ allRows <- function(x) { setAs(from = "OlsSearch", to = "data.frame", function(from) from@response) +##' @export as.data.frame.OlsSearch <- function(x, row.names = NULL, optional = FALSE, ...) { as(x, "data.frame") diff --git a/R/Ontologies.R b/R/Ontologies.R index e4628c6..b368e1f 100644 --- a/R/Ontologies.R +++ b/R/Ontologies.R @@ -112,7 +112,7 @@ ##' ##' @author Laurent Gatto ##' -##' @rdname ontologies +##' @name Ontologies ##' ##' @examples ##' @@ -164,11 +164,16 @@ NULL ########################################## ## Constructors -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("Ontologies", "missing", function(object) makeOntologies()) -##' @exportMethod +setGeneric("Ontology", function(object) standardGeneric("Ontology")) + +##' @importMethodsFrom BiocGenerics Ontology +##' @export +##' @rdname Ontologies setMethod("Ontology", "character", function(object) { ## make urls from ontologyId @@ -176,13 +181,15 @@ setMethod("Ontology", "character", makeOntology(url) }) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("Ontology", "Ontology", function(object) object) ########################################## ## show methods -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("show", "Ontology", function(object) { cat("Ontology: ", olsTitle(object), @@ -196,7 +203,8 @@ setMethod("show", "Ontology", object@numberOfIndividuals, "individuals\n") }) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("show", "Ontologies", function(object) { cat("Object of class 'Ontologies' with", @@ -215,109 +223,140 @@ setMethod("show", "Ontologies", ########################################## ## Accessors -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsVersion", "character", function(object) olsVersion(Ontology(object))) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsVersion", "Ontology", function(object) object@config$version) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsVersion", "Ontologies", function(object) sapply(object@x, olsVersion)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsLoaded", "character", function(object) olsLoaded(Ontology(object))) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsLoaded", "Ontology", function(object) substr(object@loaded, 1, 10)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsLoaded", "Ontologies", function(object) sapply(object@x, olsLoaded)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsLinks", "Ontology", function(object) { links <- unlist(object@links) names(links) <- sub("\\.href", "", names(links)) links }) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsConfig", "Ontology", function(object) object@config) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsUpdated", "character", function(object) olsUpdated(Ontology(object))) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsUpdated", "Ontology", function(object) substr(object@updated, 1, 10)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsUpdated", "Ontologies", function(object) sapply(object@x, olsUpdated)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsPrefix", "character", function(object) olsPrefix(Ontology(object))) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsPrefix", "Ontology", function(object) object@config$preferredPrefix) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsPrefix", "Ontologies", function(object) sapply(object@x, olsPrefix)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsDesc", "character", function(object) olsDesc(Ontology(object))) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsDesc", "Ontology", function(object) object@config$description) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsDesc", "Ontologies", function(object) sapply(object@x, olsDesc)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsTitle", "character", function(object) olsTitle(Ontology(object))) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsTitle", "Ontology", function(object) object@config$title) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsTitle", "Ontologies", function(object) sapply(object@x, olsTitle)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsStatus", "character", function(object) olsStatus(Ontology(object))) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsStatus", "Ontology", function(object) object@status) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsStatus", "Ontologies", function(object) sapply(object@x, olsStatus)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsNamespace", "character", function(object) olsNamespace(Ontology(object))) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsNamespace", "Ontology", function(object) object@config$namespace) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("olsNamespace", "Ontologies", function(object) sapply(object@x, olsNamespace)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("ontologyUrl", "character", function(object) paste0("https://www.ebi.ac.uk/ols4/api/ontologies/", object)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("ontologyUrl", "Ontology", function(object) olsLinks(object)[["self"]]) ########################################## ## Data manipulation -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("lapply", "Ontologies", function(X, FUN, ...) lapply(X@x, FUN, ...)) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("[", "Ontologies", function(x, i, j="missing", drop="missing") new("Ontologies", x = x@x[i])) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("[[", "Ontologies", function(x, i, j="missing", drop="missing") { if (is.numeric(i)) { @@ -335,7 +374,8 @@ setMethod("[[", "Ontologies", } stop("'i' must be a character or a numeric.") }) -##' @exportMethod +##' @export +##' @rdname Ontologies setMethod("length", "Ontologies", function(x) length(x@x)) ## This will not always be the correct URI (see for example @@ -371,11 +411,12 @@ setMethod("length", "Ontologies", function(x) length(x@x)) ## Coercion ##' @import methods -##' @exportMethod +##' @export setAs("Ontologies", "data.frame", function(from) as.data.frame.Ontologies(from)) ##' @exportS3Method +##' @rdname Ontologies as.data.frame.Ontologies <- function(x) { .as_vector <- function(x) { if (is.list(x)) @@ -390,9 +431,8 @@ as.data.frame.Ontologies <- function(x) { Title = ttl) } -##' @exportMethod -setAs("Ontologies", "list", - function(from) from@x) +##' @export +setAs("Ontologies", "list", function(from) from@x) ## ## Ontologies aren't names anymore (for now) ## setMethod("all.equal", c("Ontologies", "Ontologies"), @@ -423,24 +463,25 @@ setAs("Ontologies", "list", ## else msg ## }) -##' @exportMethod -setMethod("all.equal", c("Ontology", "Ontology"), - function(target, current) { - msg <- Biobase::validMsg(NULL, NULL) - sn <- slotNames("Ontology") - sn0 <- sn[sn != "config"] - for (i in sn0) { - eq <- all.equal(slot(current, i), slot(target, i)) - if (is.character(eq)) - msg <- validMsg(msg, paste0(i, ": ", eq)) - } - c1 <- slot(current, "config") - c2 <- slot(target, "config") - c1 <- c1[order(names(c1))] - c2 <- c2[order(names(c2))] - msg <- Biobase::validMsg(msg, all.equal(c1, c2)) - if (is.null(msg)) TRUE else msg - }) +##' @importFrom Biobase validMsg +## ##' @export +## setMethod("all.equal", c("Ontology", "Ontology"), +## function(target, current) { +## msg <- Biobase::validMsg(NULL, NULL) +## sn <- slotNames("Ontology") +## sn0 <- sn[sn != "config"] +## for (i in sn0) { +## eq <- all.equal(slot(current, i), slot(target, i)) +## if (is.character(eq)) +## msg <- validMsg(msg, paste0(i, ": ", eq)) +## } +## c1 <- slot(current, "config") +## c2 <- slot(target, "config") +## c1 <- c1[order(names(c1))] +## c2 <- c2[order(names(c2))] +## msg <- Biobase::validMsg(msg, all.equal(c1, c2)) +## if (is.null(msg)) TRUE else msg +## }) ########################################## diff --git a/R/Terms.R b/R/Terms.R index 19eed99..4c7092b 100644 --- a/R/Terms.R +++ b/R/Terms.R @@ -92,7 +92,7 @@ ##' synonym only, their iri and whether they are defining the ##' ontology. Any missing value will be reported as `NA`. ##' -##' @rdname terms +##' @name Terms ##' ##' @author Laurent Gatto ##' @@ -153,12 +153,15 @@ NULL ########################################## ## Constructors -##' exportMethod + +##' @export +##' @rdname Terms setMethod("Terms", "character", ## ontologyId function(x, pagesize = 1000, obsolete = NULL) makeTerms(x, pagesize, obsolete)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("Terms", "Ontology", function(x, pagesize = 1000, obsolete = NULL) makeTerms(x, pagesize, obsolete)) @@ -220,7 +223,8 @@ descendants <- function(object) { ########################################## ## show methods -##' exportMethod +##' @export +##' @rdname Terms setMethod("show", "Term", function(object) { ids <- .termId(object) @@ -232,7 +236,8 @@ setMethod("show", "Term", cat(strwrap(desc[[i]]), sep = "\n ") }) -##' exportMethod +##' @export +##' @rdname Terms setMethod("show", "Terms", function(object) { cat("Object of class 'Terms' with", length(object), "entries\n") @@ -253,103 +258,128 @@ setMethod("show", "Terms", ########################################## ## Accessors -##' exportMethod +##' @export +##' @rdname Terms setMethod("termSynonym", "Term", function(object) unlist(object@synonyms)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termSynonym", "Terms", function(object) lapply(object@x, termSynonym)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("isObsolete", "Term", function(object) object@is_obsolete) -##' exportMethod +##' @export +##' @rdname Terms setMethod("isObsolete", "Terms", function(object) sapply(object@x, isObsolete)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("isRoot", "Term", function(object) object@is_root) -##' exportMethod +##' @export +##' @rdname Terms setMethod("isRoot", "Terms", function(object) sapply(object@x, isRoot)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termLabel", "Term", function(object) object@label) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termLabel", "Terms", function(object) sapply(object@x, termLabel)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termId", "Term", function(object) .termId(object)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termId", "Terms", function(object) sapply(object@x, .termId)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termLinks", "Term", function(object) { links <- unlist(object@links) names(links) <- sub("\\.href", "", names(links)) links }) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termPrefix", "Term", function(object) object@ontology_prefix) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termPrefix", "Terms", function(object) sapply(object@x, termPrefix)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termDesc", "Term", function(object) unlist(object@description)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termDesc", "Terms", function(object) sapply(object@x, termDesc)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termOntology", "Term", function(object) unlist(object@ontology_name)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termOntology", "Terms", function(object) sapply(object@x, termOntology)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termNamespace", "Term", function(object) unlist(object@annotation$has_obo_namespace)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("termNamespace", "Terms", function(object) sapply(object@x, termNamespace)) ########################################## ## Data manipulation -##' exportMethod + +##' @export +##' @rdname Terms setMethod("length", "Terms", function(x) length(x@x)) -##' exportMethod +##' @export +##' @rdname Terms setMethod("unique", "Terms", function(x) x[!duplicated(names(x@x))]) -##' exportMethod +##' @export +##' @rdname Terms setMethod("[", "Terms", function(x, i, j="missing", drop="missing") Terms(x = x@x[i])) -##' exportMethod +##' @export +##' @rdname Terms setMethod("[[", "Terms", function(x, i, j="missing", drop="missing") x@x[[i]]) -##' exportMethod +##' @export +##' @rdname Terms setMethod("lapply", "Terms", function(X, FUN, ...) lapply(X@x, FUN, ...)) -##' exportMethod -setMethod("all.equal", c("Term", "Term"), - function(target, current) { - msg <- Biobase::validMsg(NULL, NULL) - snms <- slotNames("Term") - for (i in snms[-grep("links", snms)]) { - eq <- all.equal(slot(target, i), slot(current, i)) - if (is.character(eq)) { - eq <- paste0("Slot '", i, "': ", eq) - msg <- Biobase:::validMsg(msg, eq) - } - } - lt <- slot(target, "links") - lc <- slot(current, "links") - ot <- order(names(lt)) - oc <- order(names(lc)) - msg <- Biobase:::validMsg(msg, all.equal(lt[ot], lc[oc])) - if (is.null(msg)) return(TRUE) - else msg - }) +## ##' @export +## setMethod("all.equal", c("Term", "Term"), +## function(target, current) { +## msg <- Biobase::validMsg(NULL, NULL) +## snms <- slotNames("Term") +## for (i in snms[-grep("links", snms)]) { +## eq <- all.equal(slot(target, i), slot(current, i)) +## if (is.character(eq)) { +## eq <- paste0("Slot '", i, "': ", eq) +## msg <- Biobase:::validMsg(msg, eq) +## } +## } +## lt <- slot(target, "links") +## lc <- slot(current, "links") +## ot <- order(names(lt)) +## oc <- order(names(lc)) +## msg <- Biobase:::validMsg(msg, all.equal(lt[ot], lc[oc])) +## if (is.null(msg)) return(TRUE) +## else msg +## }) ## setMethod("all.equal", c("Terms", "Terms"), @@ -380,7 +410,7 @@ setMethod("all.equal", c("Term", "Term"), ## else msg ## }) -##' exportMethod +##' @export setAs("Term", "data.frame", function(from) data.frame( @@ -397,15 +427,17 @@ setAs("Term", "data.frame", stringsAsFactors = FALSE) ) -##' exportS3Method +##' @export +##' @rdname Terms as.Term.data.frame <- function(x) as(x, "data.frame") -##' exportMethod +##' @export setAs("Terms", "data.frame", function(from) do.call(rbind, lapply(from, as, "data.frame"))) -##' exportS3Method +##' @export +##' @rdname Terms as.Terms.data.frame <- function(x) as(x, "data.frame") diff --git a/R/cvparam.R b/R/cvparam.R index 6b3b1c3..f0c3908 100644 --- a/R/cvparam.R +++ b/R/cvparam.R @@ -1,5 +1,6 @@ ############################################################ ## A param is [CV label, accession, name|synonym, value] + .CVParam <- setClass("CVParam", slots = c( label = "character", @@ -7,10 +8,9 @@ name = "character", value = "character", user = "logical"), - contains = "Versioned", prototype = prototype( - user = FALSE, - new("Versioned", versions = c(CVParam="0.2.0"))), + user = FALSE + ), validity = function(object) { msg <- validMsg(NULL, NULL) if (object@user) { @@ -36,6 +36,7 @@ ## trim leading and trailing whitespace trim <- function (x) gsub("^\\s+|\\s+$", "", x) +##' @export CVParam <- function(label, name, accession, @@ -78,6 +79,8 @@ setAs("CVParam", "character", from@value, "]") ans }) + +##' @export as.character.CVParam <- function(x, ...) as(x, "character") setMethod("show","CVParam", @@ -86,6 +89,7 @@ setMethod("show","CVParam", invisible(NULL) }) +##' @export setMethod("rep", "CVParam", function(x, times) { l <- vector("list", length = times) @@ -125,8 +129,6 @@ setAs("character", "CVParam", ans }) -as.character.CVParam <- function(x, ...) as(x, "character") - .charIsCVParam <- function(x) { ## NO SEMANTICS IS CHECKED x <- x[1] @@ -163,14 +165,14 @@ charIsCVParam <- function(x) ## TESTING -notvalidCVchars<- c("[ , , , ]", "[, , , ]", - "[ , , ,]", "[,,,]", - "[AB, MS:123 , , ]", "[, MS:123 , , ]", - "[MS, AB:123, , ]", - "[, , foo, ]", "[, , , bar]", - "[foo, , , ]", "[, bar, , ]", - "[, foo, bar, ]", - "[MS, , , bar]", "[MS, , foo, ]") +notvalidCVchars <- c("[ , , , ]", "[, , , ]", + "[ , , ,]", "[,,,]", + "[AB, MS:123 , , ]", "[, MS:123 , , ]", + "[MS, AB:123, , ]", + "[, , foo, ]", "[, , , bar]", + "[foo, , , ]", "[, bar, , ]", + "[, foo, bar, ]", + "[MS, , , bar]", "[MS, , foo, ]") validCVchars <- c("[MS, MS:123 , , ]", "[, , foo, bar]", diff --git a/R/zzz.R b/R/zzz.R index da1cee5..8ee49ea 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,4 +1,4 @@ -##' @import utils packageVersion +##' @importFrom utils packageVersion .onAttach <- function(libname, pkgname) { packageStartupMessage(paste("\nThis is 'rols' version", packageVersion("rols"), "\n")) diff --git a/man/Ontologies.Rd b/man/Ontologies.Rd new file mode 100644 index 0000000..cbe6383 --- /dev/null +++ b/man/Ontologies.Rd @@ -0,0 +1,279 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Ontologies.R +\name{Ontologies} +\alias{Ontologies} +\alias{Ontology} +\alias{olsLinks} +\alias{olsLinks,Ontology} +\alias{olsConfig} +\alias{olsConfig,Ontology} +\alias{olsVersion,character} +\alias{olsVersion,Ontology} +\alias{olsVersion,Ontologies} +\alias{olsLoaded,character} +\alias{olsLoaded,Ontology} +\alias{olsLoaded,Ontologies} +\alias{olsUpdated,character} +\alias{olsUpdated,Ontology} +\alias{olsUpdated,Ontologies} +\alias{olsPrefix,character} +\alias{olsPrefix,Ontology} +\alias{olsPrefix,Ontologies} +\alias{olsDesc,character} +\alias{olsDesc,Ontology} +\alias{olsDesc,Ontologies} +\alias{olsTitle,character} +\alias{olsTitle,Ontology} +\alias{olsTitle,Ontologies} +\alias{olsStatus,character} +\alias{olsStatus,Ontology} +\alias{olsStatus,Ontologies} +\alias{olsNamespace,character} +\alias{olsNamespace,Ontology} +\alias{olsNamespace,Ontologies} +\alias{ontologyUrl} +\alias{ontologyUrl,character} +\alias{ontologyUrl,Ontology} +\alias{Ontologies,missing-method} +\alias{Ontology,character-method} +\alias{Ontology,Ontology-method} +\alias{show,Ontology-method} +\alias{show,Ontologies-method} +\alias{olsVersion,character-method} +\alias{olsVersion,Ontology-method} +\alias{olsVersion,Ontologies-method} +\alias{olsLoaded,character-method} +\alias{olsLoaded,Ontology-method} +\alias{olsLoaded,Ontologies-method} +\alias{olsLinks,Ontology-method} +\alias{olsConfig,Ontology-method} +\alias{olsUpdated,character-method} +\alias{olsUpdated,Ontology-method} +\alias{olsUpdated,Ontologies-method} +\alias{olsPrefix,character-method} +\alias{olsPrefix,Ontology-method} +\alias{olsPrefix,Ontologies-method} +\alias{olsDesc,character-method} +\alias{olsDesc,Ontology-method} +\alias{olsDesc,Ontologies-method} +\alias{olsTitle,character-method} +\alias{olsTitle,Ontology-method} +\alias{olsTitle,Ontologies-method} +\alias{olsStatus,character-method} +\alias{olsStatus,Ontology-method} +\alias{olsStatus,Ontologies-method} +\alias{olsNamespace,character-method} +\alias{olsNamespace,Ontology-method} +\alias{olsNamespace,Ontologies-method} +\alias{ontologyUrl,character-method} +\alias{ontologyUrl,Ontology-method} +\alias{lapply,Ontologies-method} +\alias{[,Ontologies-method} +\alias{[[,Ontologies-method} +\alias{length,Ontologies-method} +\alias{as.data.frame.Ontologies} +\title{Ontologies} +\usage{ +\S4method{Ontologies}{missing}(object) + +\S4method{Ontology}{character}(object) + +\S4method{Ontology}{Ontology}(object) + +\S4method{show}{Ontology}(object) + +\S4method{show}{Ontologies}(object) + +\S4method{olsVersion}{character}(object) + +\S4method{olsVersion}{Ontology}(object) + +\S4method{olsVersion}{Ontologies}(object) + +\S4method{olsLoaded}{character}(object) + +\S4method{olsLoaded}{Ontology}(object) + +\S4method{olsLoaded}{Ontologies}(object) + +\S4method{olsLinks}{Ontology}(object) + +\S4method{olsConfig}{Ontology}(object) + +\S4method{olsUpdated}{character}(object) + +\S4method{olsUpdated}{Ontology}(object) + +\S4method{olsUpdated}{Ontologies}(object) + +\S4method{olsPrefix}{character}(object) + +\S4method{olsPrefix}{Ontology}(object) + +\S4method{olsPrefix}{Ontologies}(object) + +\S4method{olsDesc}{character}(object) + +\S4method{olsDesc}{Ontology}(object) + +\S4method{olsDesc}{Ontologies}(object) + +\S4method{olsTitle}{character}(object) + +\S4method{olsTitle}{Ontology}(object) + +\S4method{olsTitle}{Ontologies}(object) + +\S4method{olsStatus}{character}(object) + +\S4method{olsStatus}{Ontology}(object) + +\S4method{olsStatus}{Ontologies}(object) + +\S4method{olsNamespace}{character}(object) + +\S4method{olsNamespace}{Ontology}(object) + +\S4method{olsNamespace}{Ontologies}(object) + +\S4method{ontologyUrl}{character}(object) + +\S4method{ontologyUrl}{Ontology}(object) + +\S4method{lapply}{Ontologies}(X, FUN, ...) + +\S4method{[}{Ontologies}(x, i, j = "missing", drop = "missing") + +\S4method{[[}{Ontologies}(x, i, j = "missing", drop = "missing") + +\S4method{length}{Ontologies}(x) + +\method{as.data.frame}{Ontologies}(x) +} +\description{ +The rols package provides an interface to PRIDE's Ontology Lookup +Servive (OLS) and can be used to query one or multiple ontologies, +stored as `Ontology` and `Ontologies` instances, and containing +various information as provided by OLS. +} +\details{ +Ontologies are referred to by their namespace, which is lower +case: the Gene Onology is "go", the Mass spectrometry ontology is +"ms", etc. The ontologies also have prefixes, which are upper +case: the Gene Onology prefix "GO", the Mass spectrometry ontology +prefix "MS". One exception to this rule is the Drosophila +Phenotype Ontology, whose namespace and prefix are "dpo" and +"FBcv" respectively (there might be more). This is particularly +confusing as the FlyBase Controlled Vocabulary has "fbcv" and +"FBcv" as namespace and prefix respectively. + +When using a character to initialise an ontology or query a term, +"fbcv" (this is case insensitive) will refer to the the FlyBase +Controlled Vocabulary. The the Drosophila Phenotype Ontology will +have to be referred as "dpo" (also case insensitive). +} +\section{Constructors}{ + + +Objects can be created in multiple ways. The [Ontologies()] +function will initialise all available ontolgies as an +`Ontologies` object, while a call to [Ontology()] with an ontology +namespace or prefix as argument will initialise the ontology of +interest as an `Ontology` instance. + +`Ontolgies` instances can be subset with `[` and `[[` (using their +namespace, see Details) and iterated over with +`lapply`. `Ontolgies` can be converted into a simple `data.frame` +containing the ontology prefixes, namespaces and titles using +`as(., "data.frame")`. `Ontologies` can also be coerced to lists +of `Ontology` ojects with `as(., "list")`. +} + +\section{Accessors}{ + + +- `olsDesc(object = "Ontology")` returns the description of an + ontology. Also works for `Ontologies` objects and a `character` + describing an ontology namespace or prefix (see Details). + +- `olsPrefix(object = "Ontology")` retruns the prefix of an + ontology. Also works for `Ontologies` objects and a `character` + describing an ontology namespace or prefix (see Details). + +- `olsVersion(object = "Ontology")` returns the version of the + ontology. Also works with an a `character` defining an ontology + namespace or prefix (see Details) or an object of class + `Ontologies`, in which case it returns a list of versions. + +- `olsLoaded(object = "Ontology")` returns the loading date of the + ontology. Also works with a `character` containing the ontology + namespace or prefix (see Details) or an object of class + `Ontologies`. + +- `olsUpdated(object = "Ontology")` returns the update date of the + ontology. Also works with a `character` containing the ontology + namespace or prefix (see Details) or an object of class + `Ontologies`. + +- `olsStatus(object = "Ontology")` returns the status of the + ontology. Also works with a `character` containing the ontology + namespace or prefix (see Details) or an object of class + `Ontologies`. + +- `olsTitle(object = "Ontology")` returns the title of an + ontology. Also works with a `character` containing the ontology + namespace or prefix (see Details) or an object of class + `Ontologies`. + +- `olsNamespace(object = "Ontology")` returns the namespace of an + ontology. Also works with a `character` containing the ontology + namespace or prefix (see Details) or an object of class + `Ontologies`. + +- `olsLinks(object = "Ontology")` returns a named `character` with + hyperlink to the ontology itself, and other associated concepts + such as its terms. + +- `olsConfig(object = "Ontology")` returns a list of additional + unstructured, partly redundant information about the ontology. + +- `ontologyUrl(object = "Ontology") return the hyperlink to the + ontology itself. It can also be used with a `character` defining + the namespace or prefix of an ontology, in which case it is + created from the base OLS API URL. +} + +\section{Ontology terms}{ + + +Once an ontology has been created an an `Ontology` instance, all +its terms can be requested using the `Terms()` constructor. See +[Terms()] for details. +} + +\examples{ + +############################# +## All ontologies +(onts <- Ontologies()) + +############################# +## Alzheimer's Disease Ontology (ADO) +## 1. From the ontologies object +(ado1 <- onts[['ado']]) +## 2. Create from its namespace +(ado2 <- Ontology('ado')) ## also works with ADO + +all.equal(ado1, ado2) + +olsVersion(ado1) +olsPrefix(ado1) +olsNamespace(ado1) +olsTitle(ado1) +olsDesc(ado1) +olsLinks(ado1) +str(olsConfig(ado1)) +} +\author{ +Laurent Gatto +} diff --git a/man/Ontology-class.Rd b/man/Ontology-class.Rd deleted file mode 100644 index 59e45f2..0000000 --- a/man/Ontology-class.Rd +++ /dev/null @@ -1,266 +0,0 @@ -\name{Ontology-class} -\Rdversion{1.1} -\docType{class} - -\alias{Ontology} -\alias{class:Ontology} -\alias{Ontology-class} -\alias{Ontologies} -\alias{class:Ontologies} -\alias{Ontologies-class} - -\alias{Ontologies,missing-method} -\alias{Ontologies,numeric-method} -\alias{Ontology,Ontology-method} -\alias{Ontology,character-method} - -\alias{olsDesc} -\alias{olsDesc,character-method} -\alias{olsDesc,Ontology-method} -\alias{olsDesc,Ontologies-method} - -\alias{olsPrefix} -\alias{olsPrefix,character-method} -\alias{olsPrefix,Ontology-method} -\alias{olsPrefix,Ontologies-method} - -\alias{olsStatus} -\alias{olsStatus,character-method} -\alias{olsStatus,Ontology-method} -\alias{olsStatus,Ontologies-method} - -\alias{olsNamespace} -\alias{olsNamespace,character-method} -\alias{olsNamespace,Ontology-method} -\alias{olsNamespace,Ontologies-method} - -\alias{olsRoot} -\alias{olsRoot,character-method} -\alias{olsRoot,Ontology-method} -\alias{olsRoot,Ontologies-method} - -\alias{olsTitle} -\alias{olsTitle,character-method} -\alias{olsTitle,Ontology-method} -\alias{olsTitle,Ontologies-method} - -\alias{olsVersion} -\alias{olsVersion,Ontology-method} -\alias{olsVersion,character-method} -\alias{olsVersion,Ontologies-method} - -\alias{olsLoaded} -\alias{olsLoaded,Ontology-method} -\alias{olsLoaded,character-method} -\alias{olsLoaded,Ontologies-method} - -\alias{olsUpdated} -\alias{olsUpdated,Ontology-method} -\alias{olsUpdated,character-method} -\alias{olsUpdated,Ontologies-method} - -\alias{olsLinks} -\alias{olsLinks,Ontology-method} - -\alias{show,Ontology-method} -\alias{show,Ontologies-method} - -\alias{length,Ontologies-method} -\alias{lapply,Ontologies-method} -\alias{[,Ontologies-method} -\alias{[[,Ontologies-method} - -\alias{coerce,Ontologies,data.frame-method} -\alias{coerce,Ontologies,list-method} - -\alias{all.equal,Ontologies,Ontologies-method} -\alias{all.equal,Ontology,Ontology-method} - -\title{Class \code{"Ontology"}} - -\description{ - - The rols package provides an interface to PRIDE's Ontology Lookup - Servive (OLS) and can be used to query one or multiple ontologies, - stored as \code{Ontology} and \code{Ontologies} instances, and - containing various information as provided by OLS. -} - -\details{ - - Ontologies are referred to by their namespace, which is lower case: - the Gene Onology is "go", the Mass spectrometry ontology is "ms", - etc. The ontologies also have prefixes, which are upper case: the Gene - Onology prefix "GO", the Mass spectrometry ontology prefix "MS". One - exception to this rule is the Drosophila Phenotype Ontology, whose - namespace and prefix are "dpo" and "FBcv" respectively (there might be - more). This is particularly confusing as the FlyBase Controlled - Vocabulary has "fbcv" and "FBcv" as namespace and prefix respectively. - - When using a character to initialise an ontology or query a term, - "fbcv" (this is case insensitive) will refer to the the FlyBase - Controlled Vocabulary. The the Drosophila Phenotype Ontology will have - to be referred as "dpo" (also case insensitive). - -} - -\section{Objects from the Class}{ - - Objects can be created in multiple ways. The \code{Ontologies} - function will initialise all available ontolgies as an - \code{Ontologies} object, while a call to \code{Ontology} with an - ontology namespace or prefix (but see Details section) as argument - will initialise the ontology of interest as an \code{Ontology} - instance. - - \code{Ontolgies} instances can be subset with \code{[} and \code{[[} - (using their namespace, see Details) and iterated over with - \code{lapply}. \code{Ontolgies} can be converted into a simple - \code{data.frame} containing the ontology prefixes, namespaces and - titles using \code{as(., "data.frame")}). An \code{Ontologies} can - also be coerced to lists of \code{Ontology} ojects with \code{as(., - "list")}. - -} - -\section{Slots}{ - - \describe{ - - \item{\code{loaded}:}{Object of class \code{NULL} or - \code{character} containing the date the ontology was loaded on - the backend side. Accessed with the \code{olsLoaded} method.} - - \item{\code{updated}:}{Object of class \code{NULL} or - \code{character} containing the date the ontology was last updated - on the backend side. Accessed with the \code{olsUpdated} - method.} - - \item{\code{status}:}{Object of class \code{NULL} or - \code{character} documenting the status of the ontology on the - backend side. For example \code{"LOADED"}, \code{"FAILED"} or - \code{"NOTLOADED"}. Accessed with the \code{olsStatus} method.} - - \item{\code{message}:}{Object of class \code{NULL} or - \code{character} documentating the status of the ontology on the - backend side. } - - \item{\code{version}:}{Object of class \code{NULL} or - \code{character} documenting the version of the ontology. Note - that there is also a \code{version} field in the \code{config} - slot below. Use \code{olsVersion} to access the appropriate - date. } - - \item{\code{numberOfTerms}:}{Object of class \code{"integer"} - documenting the number of terms available in the ontology. } - - \item{\code{numberOfProperties}:}{Object of class \code{"integer"} - documenting the number of properties available in the ontology. } - - \item{\code{numberOfIndividuals}:}{Object of class \code{"integer"} - documenting the number of individuals available in the ontology. } - - \item{\code{config}:}{Object of class \code{"list"} containing - further ontology configuration and metadata. } - - } -} - -\section{Methods and functions}{ - \describe{ - - \item{Ontologies}{\code{signature(object = "numeric")}: } - - \item{Ontology}{\code{signature(object = "character")}: } - - - \item{olsDesc}{\code{signature(object = "Ontology")}: returns the - description of an ontology. Also works for \code{Ontologies} - objects and \code{character} describing an ontology namespace or - prefix (see Details). } - - \item{olsPrefix}{\code{signature(object = "Ontology")}: retruns the - prefix of an ontology. Also works for \code{Ontologies} objects - describing an ontology namespace or prefix (see Details). } - - \item{olsRoot}{\code{signature(object = "Ontology")}: returns the - root of the ontology as a \code{\linkS4class{Terms}} - instance. \code{object} could also be a \code{character} with an - ontology namespace or prefix (see Details). If \code{object} is of - class \code{Ontologies}, it returns a \code{list} of - \code{\linkS4class{Terms}}. } - - \item{olsVersion}{\code{signature(object = "Ontology")}: returns the - version of the ontology. Also works with an ontology namespace or - prefix (see Details) as a \code{character} or an object of class - \code{Ontologies}, in which case it returns a list of versions. } - - \item{olsLoaded}{\code{signature(object = "Ontology")}: returns the - loading date of the ontology. Also works with a \code{character} - containing the ontology namespace or prefix (see Details) or an - object of class \code{Ontologies}. } - - \item{olsUpdated}{\code{signature(object = "Ontology")}: returns the - update date of the ontology. Also works with a \code{character} - containing the ontology namespace or prefix (see Details) or an - object of class \code{Ontologies}.} - - \item{olsStatus}{\code{signature(object = "Ontology")}: returns the - status of the ontology. Also works with a \code{character} - containing the ontology namespace or prefix (see Details) or an - object of class \code{Ontologies}.} - - \item{olsTitle}{\code{signature(object = "Ontology")}: returns the - title of an ontology. Also works with a \code{character} - containing the ontology namespace or prefix (see Details) or an - object of class \code{Ontologies}.} - - \item{show}{\code{signature(object = "Ontology")}: prints a short - summary of \code{Ontology} and \code{Ontologies} objects. } - - \item{length}{\code{signature(object = "Ontologies")}: returns the - number of ontolgies described by the \code{Ontologies} object. } - - \item{all.equal}{\code{signature(target = "Ontologies", current = - "Ontologies")}: ... } - - } -} - -\author{ - Laurent Gatto -} - -\examples{ -## Get all ontolgies -ol <- Ontologies() -ol - -head(as(ol, "data.frame")) -length(ol) - -## Individual ontologies -(efo <- ol[["efo"]]) -(go <- ol[["go"]]) -(go2 <- Ontology("go")) -identical(go, go2) - -## some basic information -olsVersion(go) -olsDesc(go) -olsTitle(go) -olsPrefix(go) -olsNamespace(go) - -## with Ontology objects or their namespace -identical(olsVersion("go"), olsVersion(go)) - -## Directly initialise a single ontology -go1 <- Ontology("go") ## using the namespace (preferred) -go2 <- Ontology("GO") ## using the prefix (see Details) -all.equal(go, go1) -all.equal(go, go2) -} - - -\keyword{classes} diff --git a/man/Term-class.Rd b/man/Term-class.Rd deleted file mode 100644 index 7ade046..0000000 --- a/man/Term-class.Rd +++ /dev/null @@ -1,273 +0,0 @@ -\name{Term-class} -\Rdversion{1.1} -\docType{class} -\alias{Term} -\alias{class:Term} -\alias{Term-class} - -\alias{Terms} -\alias{class:Terms} -\alias{Terms-class} -\alias{Terms,Ontology-method} -\alias{Terms,character-method} - -\alias{termLabel} -\alias{termLabel,Term-method} -\alias{termLabel,Terms-method} - -\alias{termNamespace} -\alias{termNamespace,Term-method} -\alias{termNamespace,Terms-method} - -\alias{termOntology} -\alias{termOntology,Term-method} -\alias{termOntology,Terms-method} - -\alias{termSynonym} -\alias{termSynonym,Term-method} -\alias{termSynonym,Terms-method} - -\alias{termDesc} -\alias{termDesc,Term-method} -\alias{termDesc,Terms-method} - -\alias{termPrefix} -\alias{termPrefix,Term-method} -\alias{termPrefix,Terms-method} - -\alias{olsLinks,Term-method} - -\alias{show,Term-method} -\alias{show,Terms-method} - -\alias{termId} -\alias{termId,Term-method} -\alias{termId,Terms-method} - -\alias{isObsolete} -\alias{isObsolete,Term-method} -\alias{isObsolete,Terms-method} - -\alias{isRoot} -\alias{isRoot,Term-method} -\alias{isRoot,Terms-method} - -\alias{coerce,Term,data.frame-method} -\alias{coerce,Terms,data.frame-method} -\alias{as.Term.data.frame} -\alias{as.Terms.data.frame} - -\alias{terms} -\alias{term} -\alias{term,Ontology,character-method} -\alias{term,character,character-method} -\alias{terms,Ontology-method} -\alias{terms,character-method} - -\alias{children} -\alias{parents} -\alias{ancestors} -\alias{descendants} -\alias{partOf} -\alias{derivesFrom} - -\alias{unique,Terms-method} -\alias{length,Terms-method} -\alias{lapply,Terms-method} -\alias{[,Terms-method} -\alias{[[,Terms-method} - -\alias{all.equal,Term,Term-method} -\alias{all.equal,Terms,Terms-method} - -\title{Class \code{"Term"}} - -\description{ - - The \code{Term} class describes an ontology term. A set of terms are - instantiated as a \code{Terms} class. - -} - -\section{Objects from the Class}{ - - Objects can be created using the \code{Term} and \code{Terms} - constructers. The latter is used with an object of class - \code{\linkS4class{Ontology}} or a \code{character} describing a valid - ontology prefix to download and instantiate all terms of an ontology - of interest. The former takes an \code{Ontology} object (or an - ontology prefix) and a term identifer to instantiate that specific - term. See also the 'Methods and functions' sections. - - For any given \code{Term} object, the \code{children}, \code{parents}, - \code{ancestors}, \code{descendants}, \code{partOf} and - \code{derivesFrom} terms can be generated and returned as \code{Terms} - objects. - - \code{Terms} instances can be subset with \code{[} and \code{[[} and - iterated over with \code{lapply}. - -} - -\section{Slots}{ - \describe{ - \item{\code{iri}:}{Object of class \code{"character"} ~~ } - \item{\code{label}:}{Object of class \code{"character"} ~~ } - \item{\code{description}:}{Object of class \code{"NullOrList"} ~~ } - \item{\code{annotation}:}{Object of class \code{"list"} ~~ } - \item{\code{synonym}:}{Object of class \code{"NullOrList"} ~~ } - \item{\code{ontology_name}:}{Object of class \code{"character"} ~~ } - \item{\code{ontology_prefix}:}{Object of class \code{"character"} ~~ } - \item{\code{ontology_iri}:}{Object of class \code{"character"} ~~ } - \item{\code{is_obsolete}:}{Object of class \code{"logical"} ~~ } - \item{\code{is_defining_ontology}:}{Object of class \code{"logical"} ~~ } - \item{\code{has_children}:}{Object of class \code{"logical"} ~~ } - \item{\code{is_root}:}{Object of class \code{"logical"} ~~ } - \item{\code{short_form}:}{Object of class \code{"character"} ~~ } - \item{\code{obo_id}:}{Object of class \code{"NullOrChar"} ~~ } - \item{\code{links}:}{Object of class \code{"list"} ~~ } - } -} - -\section{Methods and functions}{ - \describe{ - - \item{term}{\code{signature(object = "Ontology", id = "character")}: - ... } - - \item{terms}{\code{signature(x = "Ontology", pagesize = "numeric")}: ... } - - \item{termDesc}{\code{signature(object = "Term")}: ... } - - \item{termLabel}{\code{signature(object = "Term")}: ... } - - \item{termPrefix}{\code{signature(object = "Term")}: ... } - - \item{termSynonym}{\code{signature(object = "Term")}: ... } - - \item{termNamespace}{\code{signature(object = "Term")}: ... } - - \item{termOntology}{\code{signature(object = "Term")}: ... } - - \item{isRoot}{\code{signature(object = "Term")}: ... } - - \item{isObsolete}{\code{signature(object = "Term")}: ... } - - \item{termId}{\code{signature(object = "Term")}: ... } - - \item{children}{\code{signature(object = "Term")}: Returns a new - \code{Terms} instance with the \code{object}'s - children. \code{NULL} if there are not children. } - - \item{parents}{\code{signature(object = "Term")}: Returns a new - \code{Terms} instance with the \code{object}'s - parents. \code{NULL} if there are not parents.} - - \item{ancestors}{\code{signature(object = "Term")}: Returns a new - \code{Terms} instance with the \code{object}'s - ancestors. \code{NULL} if there are not ancestors. } - - \item{descendants}{\code{signature(object = "Term")}: Returns a new - \code{Terms} instance with the \code{object}'s - descendants. \code{NULL} if there are not descendants. } - - \item{partOf}{\code{signature(object = "Term")}: Returns a new - \code{Terms} instance with terms the \code{object}'s is a part - of. \code{NULL} if none. } - - \item{derivesFrom}{\code{signature(object = "Term")}: Returns a new - \code{Terms} instance with terms the \code{object}'s is derived - from. \code{NULL} if none. } - - \item{show}{\code{signature(object = "Term")}: ... } - - \item{show}{\code{signature(object = "Terms")}: ... } - - \item{all.equal}{\code{signature(target = "Term", current = - "Term")}: ... } - - \item{all.equal}{\code{signature(target = "Terms", current = - "Terms")}: ... } - - \item{length}{\code{signature(object = "Terms")}: returns the number - of ontolgies described by the \code{Terms} object. } - - \item{unique}{\code{signature(x = "Terms")}: returns a new - \code{Terms} object where all duplicated \code{Term} instances, - i.e. those with the same term id (even when stemming from - different ontologies), have been removed (only the first occurence - is retained). } - - \item{\code{as(x, "data.fram")}}{Coerces a single \code{Term} or - \code{Terms} into a \code{data.frame} of length 1 (for the former) - or length \code{length(x)} for the latter. The result will contain - the following columns: id, label, description of the term(s), - their ontology, whether they are obsolete, have children or are - root node, the first synonym only, their iri and whether they are - defining the ontology. Any missing value will be reported as - \code{NA}. } - - } - -} - -\author{ - Laurent Gatto -} - - -\examples{ - -## (all) terms -(gotrms <- terms("go", pagesize = 10000)) - -\dontrun{ - ## or, using on ontology object - go <- Ontology("go") - gotrms <- terms(go, pagesize = 10000) -} - -as(gotrms[1:10], "data.frame") ## data,frame with 10 rows - -## (one) term -(trm <- gotrms[[1]]) -termPrefix(trm) -gotrms[1:3] -gotrms[["GO:0005230"]] - -as(trm, "data.frame") ## data,frame with 1 row - -## using an Ontology object -go <- Ontology("GO") -term(go, "GO:0032801") -## using an ontology prefix -term("GO", "GO:0032801") - -isObsolete(gotrms[["GO:0005230"]]) -isObsolete(gotrms[["GO:0005232"]]) - -isRoot(gotrms[["GO:0005230"]]) -isRoot(gotrms[["GO:0005232"]]) - -i <- isRoot(gotrms) & !isObsolete(gotrms) -gotrms[i] -for (ii in which(i)) - show(gotrms[[ii]]) - -## or, directly querying the ontology -olsRoot(go) - -parents(trm) -ancestors(trm) -children(trm) -descendants(trm) - -partOf(gotrms[["GO:0044429"]]) -partOf(term("BTO", "BTO:0000142")) - -derivesFrom(term("BTO", "BTO:0002600")) -derivesFrom(term("BTO", "BTO:0001023")) - -} - -\keyword{classes} diff --git a/man/Terms.Rd b/man/Terms.Rd new file mode 100644 index 0000000..cb007c9 --- /dev/null +++ b/man/Terms.Rd @@ -0,0 +1,245 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Terms.R +\name{Terms} +\alias{Terms} +\alias{Term} +\alias{Terms,character} +\alias{Terms,Ontology} +\alias{termLinks} +\alias{termLinks,Term} +\alias{children} +\alias{parents} +\alias{ancestors} +\alias{descendants} +\alias{termSynonym} +\alias{termSynonym,Term} +\alias{termSynonym,Terms} +\alias{isObsolete} +\alias{isObsolete,Term} +\alias{isObsolete,Terms} +\alias{isRoot} +\alias{isRoot,Term} +\alias{isRoot,Terms} +\alias{termLabel} +\alias{termLabel,Term} +\alias{termLabel,Terms} +\alias{termId} +\alias{termId,Term} +\alias{termId,Terms} +\alias{termPrefix} +\alias{termPrefix,Term} +\alias{termPrefix,Terms} +\alias{termDesc} +\alias{termDesc,Term} +\alias{termDesc,Terms} +\alias{termOntology} +\alias{termOntology,Term} +\alias{termOntology,Terms} +\alias{termNamespace} +\alias{termNamespace,Term} +\alias{termNamespace,Terms} +\alias{Terms,character-method} +\alias{Terms,Ontology-method} +\alias{show,Term-method} +\alias{show,Terms-method} +\alias{termSynonym,Term-method} +\alias{termSynonym,Terms-method} +\alias{isObsolete,Term-method} +\alias{isObsolete,Terms-method} +\alias{isRoot,Term-method} +\alias{isRoot,Terms-method} +\alias{termLabel,Term-method} +\alias{termLabel,Terms-method} +\alias{termId,Term-method} +\alias{termId,Terms-method} +\alias{termLinks,Term-method} +\alias{termPrefix,Term-method} +\alias{termPrefix,Terms-method} +\alias{termDesc,Term-method} +\alias{termDesc,Terms-method} +\alias{termOntology,Term-method} +\alias{termOntology,Terms-method} +\alias{termNamespace,Term-method} +\alias{termNamespace,Terms-method} +\alias{length,Terms-method} +\alias{unique,Terms-method} +\alias{[,Terms-method} +\alias{[[,Terms-method} +\alias{lapply,Terms-method} +\alias{as.Term.data.frame} +\alias{as.Terms.data.frame} +\title{Ontology Terms} +\usage{ +\S4method{Terms}{character}(x, pagesize = 1000, obsolete = NULL) + +\S4method{Terms}{Ontology}(x, pagesize = 1000, obsolete = NULL) + +\S4method{show}{Term}(object) + +\S4method{show}{Terms}(object) + +\S4method{termSynonym}{Term}(object) + +\S4method{termSynonym}{Terms}(object) + +\S4method{isObsolete}{Term}(object) + +\S4method{isObsolete}{Terms}(object) + +\S4method{isRoot}{Term}(object) + +\S4method{isRoot}{Terms}(object) + +\S4method{termLabel}{Term}(object) + +\S4method{termLabel}{Terms}(object) + +\S4method{termId}{Term}(object) + +\S4method{termId}{Terms}(object) + +\S4method{termLinks}{Term}(object) + +\S4method{termPrefix}{Term}(object) + +\S4method{termPrefix}{Terms}(object) + +\S4method{termDesc}{Term}(object) + +\S4method{termDesc}{Terms}(object) + +\S4method{termOntology}{Term}(object) + +\S4method{termOntology}{Terms}(object) + +\S4method{termNamespace}{Term}(object) + +\S4method{termNamespace}{Terms}(object) + +\S4method{length}{Terms}(x) + +\S4method{unique}{Terms}(x) + +\S4method{[}{Terms}(x, i, j = "missing", drop = "missing") + +\S4method{[[}{Terms}(x, i, j = "missing", drop = "missing") + +\S4method{lapply}{Terms}(X, FUN, ...) + +as.Term.data.frame(x) + +as.Terms.data.frame(x) +} +\description{ +The `Term` class describes an ontology term. A set of terms are +instantiated as a `Terms` class. +} +\section{Contructors}{ + + +Objects can be created using the `Term()` and `Terms()` +constructers. The latter is used with an object of class +`Ontology` or a `character` describing a valid ontology prefix to +download and instantiate all terms of an ontology of interest. The +former takes an `Ontology` object (or an ontology prefix) and +a term identifer to instantiate that specific term. + +For any given `Term` object, the `children`, `parents`, +`ancestors` and `descendants` terms can be generated with the +`children()`, `parents()`, `ancestor()` and `descendants()` +function. `Terms` instances can be subset with `[` and `[[` and +iterated over with `lapply`. +} + +\section{Accessors}{ + + +- `isObsolete(object = "Term")` returns a `TRUE` if the term is + obsolete, `FALSE` otherwise. Also works on `Terms` instances. + +- `isRoot(object = "Term")` returns a `TRUE` if the term is a root + term, `FALSE` otherwise. Also works on `Terms` instances. + +- `termDesc(object = "Term")` returns a `character` with the + term's description. Also works on `Terms` instances. + +- `termId(object = "Term")` returns a `character` with the term's + identifier. Also works on `Terms` instances. + +- `termLabel(object = "Term")` returns a `character` with the + term's label. Also works on `Terms` instances. + +- `termNamespace(object = "Term")` returns a `character` with the + term's namespace. Also works on `Terms` instances. + +- `termOntology(object = "Term")` returns a `character` with the + term's ontology (where it was retrieved from). Also works on + `Terms` instances. + +- `termPrefix(object = "Term")` returns a `character` with the + term's (ontology) prefix (where it was retrieved from). Also + works on `Terms` instances. + +- `termSynonym(object = "Term")` returns a `character` with the + term's synpnym(s). Also works on `Terms` instances. + +- `termLinks(object = "Term")` returns a named `character` with + hyperlink to/from the term. +} + +\section{Related terms}{ + + +- `children(object = "Term")` returns a new `Terms` instance with + the `object`'s children or `NULL` if there are no children. + +- `parents(object = "Term")` returns a new `Terms` instance with + the `object`'s parents or `NULL` if there are no parents. + +- `ancestors(object = "Term")` returns a new `Terms` instance with + the `object`'s ancestors or `NULL` if there are no ancestors. + +- `descendants(object = "Term")` returns a new `Terms` instance + with the `object`'s descendants or `NULL` if there are no + descendants. +} + +\section{Coercion}{ + + +- `as(x, "data.fram")` coerces a `Term` or `Terms` instance into a + `data.frame` of length 1 (for the former) or length `length(x)` + for the latter. The result will contain the following columns: + id, label, description of the term(s), their ontology, whether + they are obsolete, have children or are root node, the first + synonym only, their iri and whether they are defining the + ontology. Any missing value will be reported as `NA`. +} + +\examples{ + +## Alzheimer's Disease Ontology (ADO) +(adoterms <- Terms('ado')) + +## Focus on squamous epithelium +(trm <- adoterms[["UBERON:0006914"]]) + +## Accessors +termLabel(trm) +head(termLabel(adoterms)) +termId(trm) +termDesc(trm) +termOntology(trm) +termNamespace(trm) +termSynonym(trm) ## none + +## Related terms +children(trm) +descendants(trm) ## includes child + +parents(trm) +ancestors(trm) ## includes parent +} +\author{ +Laurent Gatto +} From d35d20ebc0fff170e88ac2d4cf1b856622c463d9 Mon Sep 17 00:00:00 2001 From: lgatto Date: Sun, 11 Feb 2024 01:24:59 +0100 Subject: [PATCH 06/11] add missing exports --- NAMESPACE | 4 ++++ R/Terms.R | 8 ++++++++ man/Terms.Rd | 8 ++++++++ 3 files changed, 20 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index ab54e2b..a1f3a46 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,8 +4,12 @@ S3method(as.character,CVParam) S3method(as.data.frame,OlsSearch) S3method(as.data.frame,Ontologies) export(CVParam) +export(ancestors) export(as.Term.data.frame) export(as.Terms.data.frame) +export(children) +export(descendants) +export(parents) exportMethods("[") exportMethods("[[") exportMethods(Ontologies) diff --git a/R/Terms.R b/R/Terms.R index 4c7092b..8479b56 100644 --- a/R/Terms.R +++ b/R/Terms.R @@ -176,6 +176,8 @@ setMethod("Terms", "Ontology", ## function(object, id,...) .term(object, id, ...)) +##' @export +##' @rdname Terms children <- function(object) { stopifnot(inherits(object, "Term")) if (!object@has_children) @@ -187,6 +189,8 @@ children <- function(object) { .Terms(x = ans) } +##' @export +##' @rdname Terms parents <- function(object) { stopifnot(inherits(object, "Term")) if (object@is_root) @@ -198,6 +202,8 @@ parents <- function(object) { .Terms(x = ans) } +##' @export +##' @rdname Terms ancestors <- function(object) { stopifnot(inherits(object, "Term")) if (object@is_root) @@ -209,6 +215,8 @@ ancestors <- function(object) { .Terms(x = ans) } +##' @export +##' @rdname Terms descendants <- function(object) { stopifnot(inherits(object, "Term")) if (!object@has_children) diff --git a/man/Terms.Rd b/man/Terms.Rd index cb007c9..fc3a220 100644 --- a/man/Terms.Rd +++ b/man/Terms.Rd @@ -74,6 +74,14 @@ \S4method{Terms}{Ontology}(x, pagesize = 1000, obsolete = NULL) +children(object) + +parents(object) + +ancestors(object) + +descendants(object) + \S4method{show}{Term}(object) \S4method{show}{Terms}(object) From 95276251f5d181108af69826c9a3957fdd11c1aa Mon Sep 17 00:00:00 2001 From: lgatto Date: Sun, 11 Feb 2024 01:39:04 +0100 Subject: [PATCH 07/11] use roxygen for CVParam --- NAMESPACE | 2 + R/cvparam.R | 87 ++++++++++++++++++++++ man/CVParam-class.Rd | 168 ------------------------------------------- man/CVParam.Rd | 89 +++++++++++++++++++++++ 4 files changed, 178 insertions(+), 168 deletions(-) delete mode 100644 man/CVParam-class.Rd create mode 100644 man/CVParam.Rd diff --git a/NAMESPACE b/NAMESPACE index a1f3a46..ae55607 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,7 +7,9 @@ export(CVParam) export(ancestors) export(as.Term.data.frame) export(as.Terms.data.frame) +export(charIsCVParam) export(children) +export(cvCharToCVPar) export(descendants) export(parents) exportMethods("[") diff --git a/R/cvparam.R b/R/cvparam.R index f0c3908..8945fae 100644 --- a/R/cvparam.R +++ b/R/cvparam.R @@ -1,3 +1,68 @@ +##' @title Controlled Vocabulary +##' +##' @name CVParam +##' +##' @description +##' +##' `CVParam` objects instantiate controlled vocabulary entries. +##' +##' @section Methods: +##' +##' - `charIsCVParam(x)` checks if `x`, a character of the form +##' `"[ONTO, ACCESSION, NAME, VALUE]"`, is a valid (possibly +##' user-defined) `CVParam`. `"ONTO"` is the ontology label +##' (prefix), `"ACCESSION"` is the term accession number, `"NAME"` +##' is the term's name and `"VALUE"` is the value. Note that only +##' the syntax validity is verified, not the semantics. See example +##' below. +##' +##' - `coerce(from = "CVParam", to = "character")` coerces `CVParam` +##' `from` to a `character` of the following form: `[label, +##' accession, name, value]`. `as.character` is also defined. +##' +##' - `coerce(from = "character", to = "CVParam")` coerces `character` +##' `from` to a `CVParam`. `as.CVParam` is also defined. If a +##' `label` is absent, the `character` is converted to a User param, +##' else, the `label` and `accession` are used to query the Ontology +##' Lookup Service (see [OlsSearch()]). If a `name` is provided and +##' does not match the retrieved name, a warning is thrown. +##' +##' This function is vectorised; if the `from` character is of +##' length greater than 1, then a list of `CVParam` is returned. The +##' queries to the OLS are processed one-by-one, though. +##' +##' @author Laurent Gatto +##' +##' @examples +##' +##' ## a user param +##' CVParam(name = "A user param", value = "the value") +##' ## a CVParam from PSI's Mass Spectrometry ontology +##' term("MS", "MS:1000073") +##' CVParam(label = "MS", accession = "MS:1000073") +##' +##' ## From a CVParam object to a character +##' cv <- as(CVParam(label = "MS", accession = "MS:1000073"), "character") +##' cv +##' +##' ## From a character object to a CVParam +##' as(cv, "CVParam") +##' as("[MS, MS:1000073, , ]", "CVParam") ## no name +##' as("[MS, MS:1000073, ESI, ]", "CVParam") ## name does not match +##' as(c(cv, cv), "CVParam") ## more than 1 character +##' +##' x <- c("[MS, MS:1000073, , ]", ## valid CV param +##' "[, , Hello, world]", ## valid User param +##' "[this, one is, not, valid]", ## not valid +##' "[ , , , ]") ## not valid +##' +##' stopifnot(charIsCVParam(x) == c(TRUE, TRUE, FALSE, FALSE)) +##' +##' ## A list of expected valid and non-valid entries +##' rols:::validCVchars +##' rols:::notvalidCVchars +NULL + ############################################################ ## A param is [CV label, accession, name|synonym, value] @@ -36,7 +101,26 @@ ## trim leading and trailing whitespace trim <- function (x) gsub("^\\s+|\\s+$", "", x) +##' @param label `character(1)` with the ontology label. If missing, a +##' user-defined parameter is created. +##' +##' @param name `character(1)` with the name of the `CVParam` to be +##' constructed. This argument can be omitted if `accession` is +##' used and `label` is not missing. +##' +##' @param accession `character(1)` with the accession of the +##' `CVParam` to be constructed. This argument can be omitted if +##' `name` is used. Ignored for user-defined instances. +##' +##' @param value `character(1)` with the value of the `CVParam` o be +##' constructed. This argument is optional. +##' +##' @param exact `logical(1)` defining whether the query to retrieve +##' the `accession` (when `name` is used) should be an exact +##' match. +##' ##' @export +##' @rdname CVParam CVParam <- function(label, name, accession, @@ -83,6 +167,7 @@ setAs("CVParam", "character", ##' @export as.character.CVParam <- function(x, ...) as(x, "character") +##' @export setMethod("show","CVParam", function(object) { cat(as(object, "character"), "\n") @@ -98,6 +183,7 @@ setMethod("rep", "CVParam", return(l) }) +##' @export cvCharToCVPar <- function(from) { stopifnot(length(from) == 1) if (!charIsCVParam(from)) @@ -160,6 +246,7 @@ setAs("character", "CVParam", return(TRUE) } +##' @export charIsCVParam <- function(x) sapply(x, .charIsCVParam) diff --git a/man/CVParam-class.Rd b/man/CVParam-class.Rd deleted file mode 100644 index 7a7dfa2..0000000 --- a/man/CVParam-class.Rd +++ /dev/null @@ -1,168 +0,0 @@ -\name{CVParam-class} -\Rdversion{1.1} -\docType{class} -\alias{CVParam-class} -\alias{CVParam} -\alias{coerce,CVParam,character-method} -\alias{coerce,character,CVParam-method} -\alias{show,CVParam-method} -\alias{rep,CVParam-method} -\alias{as.character.CVParam} -\alias{as.CVParam.character} -\alias{charIsCVParam} - -\title{Class \code{"CVParam"}} - -\description{ - \code{CVParam} objects instantiate controlled vocabulary entries. -} - -\section{Objects from the Class}{ - Objects can be created with the \code{CVParam} constructor. -} - -\usage{ -CVParam(label, name, accession, value, exact = TRUE) -} - -\arguments{ - \item{label}{A \code{character} with the ontology label. If missing, - a user-defined parameter is created. } - - \item{name}{A \code{character} with the name of the \code{CVParam} to - be constructed. This argument can be omitted if \code{accession} is - used and \code{label} is not missing. } - - \item{accession}{A \code{character} with the accession of the - \code{CVParam} to be constructed. This argument can be omitted if - \code{name} is used. Ignored for user-defined instances. } - - \item{value}{A \code{character} with the value of the \code{CVParam} - to be constructed. This argument is optional. } - - \item{exact}{A \code{logical} defining whether the query to retrieve - the \code{accession} (when \code{name} is used) should be an - exact match. } - -} - -\section{Slots}{ - \describe{ - - \item{\code{label}:}{Object of class \code{"character"} that defines - the label of the instance, i.e the ontology - abbreviation/prefix. See \code{\link{Ontologies}} to generate a - list of available ontologies and \code{\link{olsPrefix}} for - existing labels.} - - \item{\code{accession}:}{Object of class \code{"character"} with the - parameter's valid \code{label} ontology accession number. See - below for validity constrains. } - - \item{\code{name}:}{ Object of class \code{"character"} with the - instance's valid name, i.e matching with the - \code{accession}. \code{name} and \code{accession} must follow - \code{term(accession, label) == name} for the instance to be - valid. } - - \item{\code{value}:}{Object of class \code{"character"} with the - \code{CVParams} value, if applicable, of empty string ("") - otherwise. } - - \item{\code{user}:}{Object of class \code{"logical"} defining if the - instance is a user-defined parameter (also called User params). } - - \item{\code{.__classVersion__}:}{Object of class - \code{"\linkS4class{Versions}"} describing the instance's class - definition version. For development use. } - - } -} - -\section{Extends}{ - Class \code{"\linkS4class{Versioned}"}, directly. -} - -\section{Methods}{ - \describe{ - - \item{charIsCVParam(x)}{Checks if \code{x}, a character of the form - \code{"[ONTO, ACCESSION, NAME, VALUE]"}, is a valid (possibly - user-defined) \code{CVParam}. \code{"ONTO"} is the ontology label - (prefi), \code{"ACCESSION"} is the term accession number, - \code{"NAME"} is the term's name and \code{"VALUE"} is the - value. Note that only syntax validity is verified, not semantics. - See example below. - - } - } -} - -\section{Methods}{ - \describe{ - \item{coerce}{\code{signature(from = "CVParam", to = "character")}: - Coerces \code{CVParam} \code{from} to a \code{character} of the - following form: \code{[label, accession, name, - value]}. \code{as.character} is also defined. - } - - \item{coerce}{\code{signature(from = "character", to = "CVParam")}: - Coerces \code{character} \code{from} to a - \code{CVParam}. \code{as.CVParam} is also defined. If a - \code{label} is absent, the \code{character} is converted to a - User param, else, the \code{label} and \code{accession} are used - to query the Ontology Lookup Service (see - \code{\link{OlsSearch}})). If a \code{name} is provided and does - not match the retrieved name, a warning is thrown. - - This function is vectorised; if the \code{from} character is of - length greater than 1, then a list of \code{CVParam} is - returned. The queries to the OLS are processed one-by-one, though. - - } - - \item{show}{\code{signature(object = "CVParam")}: Prints the - \code{CVParam} instance as text. - } - - \item{rep}{\code{signature(x = "CVParam", times = "numeric")}: - Replicates the \code{CVParam} \code{x} \code{times} times. - } - } -} - -\author{ - Laurent Gatto -} - -\examples{ -## a user param -CVParam(name = "A user param", value = "the value") -## a CVParam from PSI's Mass Spectrometry ontology -term("MS", "MS:1000073") -CVParam(label = "MS", accession = "MS:1000073") - -## From a CVParam object to a character -cv <- as(CVParam(label = "MS", accession = "MS:1000073"), "character") -cv - -## From a character object to a CVParam -as(cv, "CVParam") -as("[MS, MS:1000073, , ]", "CVParam") ## no name -as("[MS, MS:1000073, ESI, ]", "CVParam") ## name does not match -as(c(cv, cv), "CVParam") ## more than 1 character - -x <- c("[MS, MS:1000073, , ]", ## valid CV param - "[, , Hello, world]", ## valid User param - "[this, one is, not, valid]", ## not valid - "[ , , , ]") ## not valid - -stopifnot(charIsCVParam(x) == c(TRUE, TRUE, FALSE, FALSE)) - -## A list of expected valid and non-valid entries -rols:::validCVchars -rols:::notvalidCVchars -} - - -\keyword{classes} diff --git a/man/CVParam.Rd b/man/CVParam.Rd new file mode 100644 index 0000000..2055788 --- /dev/null +++ b/man/CVParam.Rd @@ -0,0 +1,89 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cvparam.R +\name{CVParam} +\alias{CVParam} +\title{Controlled Vocabulary} +\usage{ +CVParam(label, name, accession, value, exact = TRUE) +} +\arguments{ +\item{label}{`character(1)` with the ontology label. If missing, a +user-defined parameter is created.} + +\item{name}{`character(1)` with the name of the `CVParam` to be +constructed. This argument can be omitted if `accession` is +used and `label` is not missing.} + +\item{accession}{`character(1)` with the accession of the +`CVParam` to be constructed. This argument can be omitted if +`name` is used. Ignored for user-defined instances.} + +\item{value}{`character(1)` with the value of the `CVParam` o be +constructed. This argument is optional.} + +\item{exact}{`logical(1)` defining whether the query to retrieve +the `accession` (when `name` is used) should be an exact +match.} +} +\description{ +`CVParam` objects instantiate controlled vocabulary entries. +} +\section{Methods}{ + + +- `charIsCVParam(x)` checks if `x`, a character of the form + `"[ONTO, ACCESSION, NAME, VALUE]"`, is a valid (possibly + user-defined) `CVParam`. `"ONTO"` is the ontology label + (prefix), `"ACCESSION"` is the term accession number, `"NAME"` + is the term's name and `"VALUE"` is the value. Note that only + the syntax validity is verified, not the semantics. See example + below. + +- `coerce(from = "CVParam", to = "character")` coerces `CVParam` + `from` to a `character` of the following form: `[label, + accession, name, value]`. `as.character` is also defined. + +- `coerce(from = "character", to = "CVParam")` coerces `character` + `from` to a `CVParam`. `as.CVParam` is also defined. If a + `label` is absent, the `character` is converted to a User param, + else, the `label` and `accession` are used to query the Ontology + Lookup Service (see [OlsSearch()]). If a `name` is provided and + does not match the retrieved name, a warning is thrown. + + This function is vectorised; if the `from` character is of + length greater than 1, then a list of `CVParam` is returned. The + queries to the OLS are processed one-by-one, though. +} + +\examples{ + +## a user param +CVParam(name = "A user param", value = "the value") +## a CVParam from PSI's Mass Spectrometry ontology +term("MS", "MS:1000073") +CVParam(label = "MS", accession = "MS:1000073") + +## From a CVParam object to a character +cv <- as(CVParam(label = "MS", accession = "MS:1000073"), "character") +cv + +## From a character object to a CVParam +as(cv, "CVParam") +as("[MS, MS:1000073, , ]", "CVParam") ## no name +as("[MS, MS:1000073, ESI, ]", "CVParam") ## name does not match +as(c(cv, cv), "CVParam") ## more than 1 character + +x <- c("[MS, MS:1000073, , ]", ## valid CV param + "[, , Hello, world]", ## valid User param + "[this, one is, not, valid]", ## not valid + "[ , , , ]") ## not valid + +stopifnot(charIsCVParam(x) == c(TRUE, TRUE, FALSE, FALSE)) + +## A list of expected valid and non-valid entries +rols:::validCVchars +rols:::notvalidCVchars +} +\author{ +Laurent Gatto +} From c8a19693a79dd7feb469e29f76f4bdcd8277b8cd Mon Sep 17 00:00:00 2001 From: lgatto Date: Sun, 11 Feb 2024 12:11:52 +0100 Subject: [PATCH 08/11] temporary Term() fix --- R/AllGenerics.R | 7 +++-- R/Terms.R | 42 +++++++++++++++++++++--------- R/cvparam.R | 68 +++++++++++++++++++++++++------------------------ R/utils.R | 12 +++++++++ 4 files changed, 80 insertions(+), 49 deletions(-) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index a4e00bc..84c7af2 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -1,5 +1,6 @@ setGeneric("Ontologies", function(object) standardGeneric("Ontologies")) -setGeneric("Terms", function(x, ...) standardGeneric("Terms")) +setGeneric("Terms", function(object, ...) standardGeneric("Terms")) +setGeneric("Term", function(object, ...) standardGeneric("Term")) setGeneric("olsPrefix", function(object, ...) standardGeneric("olsPrefix")) setGeneric("olsDesc", function(object, ...) standardGeneric("olsDesc")) @@ -16,8 +17,6 @@ setGeneric("olsConfig", function(object, ...) standardGeneric("olsConfig")) setGeneric("termLinks", function(object, ...) standardGeneric("termLinks")) setGeneric("termLabel", function(object, ...) standardGeneric("termLabel")) setGeneric("termPrefix", function(object, ...) standardGeneric("termPrefix")) -setGeneric("terms", function(x, ...) standardGeneric("terms")) -setGeneric("term", function(object, id, ...) standardGeneric("term")) setGeneric("termId", function(object, ...) standardGeneric("termId")) setGeneric("isObsolete", function(object, ...) standardGeneric("isObsolete")) setGeneric("isRoot", function(object, ...) standardGeneric("isRoot")) @@ -26,7 +25,7 @@ setGeneric("termDesc", function(object, ...) standardGeneric("termDesc")) setGeneric("termNamespace", function(object, ...) standardGeneric("termNamespace")) setGeneric("termOntology", function(object, ...) standardGeneric("termOntology")) -setGeneric("properties", function(object, ...) standardGeneric("properties")) +## setGeneric("properties", function(object, ...) standardGeneric("properties")) ## private setGeneric("ontologyUrl", function(object, ...) standardGeneric("ontologyUrl")) diff --git a/R/Terms.R b/R/Terms.R index 8479b56..aad5dda 100644 --- a/R/Terms.R +++ b/R/Terms.R @@ -119,6 +119,9 @@ ##' ##' parents(trm) ##' ancestors(trm) ## includes parent +##' +##' ## A single term from an ontology +##' Term("ado", "ADO:0000090") NULL ############################################################ @@ -157,24 +160,39 @@ NULL ##' @export ##' @rdname Terms setMethod("Terms", "character", ## ontologyId - function(x, pagesize = 1000, obsolete = NULL) - makeTerms(x, pagesize, obsolete)) + function(object, pagesize = 1000, obsolete = NULL) + makeTerms(object, pagesize, obsolete)) ##' @export ##' @rdname Terms setMethod("Terms", "Ontology", - function(x, pagesize = 1000, obsolete = NULL) - makeTerms(x, pagesize, obsolete)) - + function(object, pagesize = 1000, obsolete = NULL) + makeTerms(object, pagesize, obsolete)) -## These methods query an Ontology (or its prefix) for all or one term -## setMethod("terms", "character", -## function(x, ...) .terms(x, ...)) -## setMethod("term", c("character", "character"), -## function(object, id, ...) .term(object, id, ...)) -## setMethod("term", c("Ontology", "character"), -## function(object, id,...) .term(object, id, ...)) +##' @export +##' @rdname Terms +setMethod("Term", "character", + function(object, id) Term(Ontology(object), id)) +##' @export +##' @rdname Terms +setMethod("Term", "Ontology", + function(object, id) { + ## Unfortunately, direct REST queries for a specific + ## term aren't working (see + ## https://github.com/EBISPOT/ols4/issues/621). For now, + ## as a very ugly workaround, I'm requesting all terms + ## to get a single one :-( + trms <- Terms(object) + i <- which(termId(trms) == id, useNames = FALSE) + if (length(i) == 0) { + warning("Id ", id, " not found. Returning empty Term.") + return(.Term()) + } else if (length(i) > 1) { + stop(id, " is not unique. Please open an issue.") + } + trms[[i]] + }) ##' @export ##' @rdname Terms diff --git a/R/cvparam.R b/R/cvparam.R index 8945fae..a9814cc 100644 --- a/R/cvparam.R +++ b/R/cvparam.R @@ -35,21 +35,24 @@ ##' ##' @examples ##' -##' ## a user param +##' ## User param ##' CVParam(name = "A user param", value = "the value") -##' ## a CVParam from PSI's Mass Spectrometry ontology -##' term("MS", "MS:1000073") -##' CVParam(label = "MS", accession = "MS:1000073") +##' ## CVParam ESI from PSI's Mass Spectrometry ontology +##' Term("MS", "MS:1000073") +##' esi <- CVParam(label = "MS", accession = "MS:1000073") +##' class(esi) ##' ##' ## From a CVParam object to a character -##' cv <- as(CVParam(label = "MS", accession = "MS:1000073"), "character") -##' cv +##' cv <- as(esi, "character") +##' cv ## note the quotes ##' +##' \dontrun{ ##' ## From a character object to a CVParam ##' as(cv, "CVParam") ##' as("[MS, MS:1000073, , ]", "CVParam") ## no name ##' as("[MS, MS:1000073, ESI, ]", "CVParam") ## name does not match ##' as(c(cv, cv), "CVParam") ## more than 1 character +##' } ##' ##' x <- c("[MS, MS:1000073, , ]", ## valid CV param ##' "[, , Hello, world]", ## valid User param @@ -65,7 +68,6 @@ NULL ############################################################ ## A param is [CV label, accession, name|synonym, value] - .CVParam <- setClass("CVParam", slots = c( label = "character", @@ -73,30 +75,30 @@ NULL name = "character", value = "character", user = "logical"), - prototype = prototype( - user = FALSE - ), - validity = function(object) { - msg <- validMsg(NULL, NULL) - if (object@user) { - if (!all(c(object@label, object@accession) == "")) - msg <- "Label and accession must be empty in UserParams." - } else { - x <- c(object@label, object@accession, - object@name, object@value) == "" - if (!all(x)) { - ._term <- term(object@label, object@accession) - ._label <- termLabel(._term) - ._synonyms <- termSynonym(._term) - if (!(object@name %in% c(._label, ._synonyms))) - msg <- paste0("CVParam accession and name/synomyms do not match. Got [", - paste(c(._label, ._synonyms), collapse = ", "), - "], expected '", object@name, "'.") - } - } - if (is.null(msg)) TRUE else msg - }) + prototype = prototype(user = FALSE)) +## When fixed, set automatic validity back +validCVParam <- function(object) { + msg <- validMsg(NULL, NULL) + if (object@user) { + if (!all(c(object@label, object@accession) == "")) + msg <- "Label and accession must be empty in UserParams." + } else { + x <- c(object@label, object@accession, + object@name, object@value) == "" + if (!all(x)) { + ## FIXME - why call Term here? Is this needed? + ._term <- Term(object@label, object@accession) + ._label <- termLabel(._term) + ._synonyms <- termSynonym(._term) + if (!(object@name %in% c(._label, ._synonyms))) + msg <- paste0("CVParam accession and name/synomyms do not match. Got [", + paste(c(._label, ._synonyms), collapse = ", "), + "], expected '", object@name, "'.") + } + } + if (is.null(msg)) TRUE else msg +} ## trim leading and trailing whitespace trim <- function (x) gsub("^\\s+|\\s+$", "", x) @@ -134,7 +136,7 @@ CVParam <- function(label, if (missing(name) & missing(accession)) { stop("You need to provide at least one of 'name' or 'accession'") } else if (missing(name)) { - name <- termLabel(term(label, accession)) + name <- termLabel(Term(label, accession)) } else { ## missing(accession) resp <- OlsSearch(q = name, ontology = label, exact = exact) if (resp@numFound != 1) @@ -145,11 +147,11 @@ CVParam <- function(label, accession <- resp@response$obo_id } - ans <- new("CVParam", label = label, name = name, accession = accession) + ans <- new("CVParam", label = label, name = name, + accession = accession) } if (!missing(value)) ans@value <- value - if (validObject(ans)) return(ans) } diff --git a/R/utils.R b/R/utils.R index 0ac107e..81aaa11 100644 --- a/R/utils.R +++ b/R/utils.R @@ -13,6 +13,18 @@ resp_embedded <- function(resp, what) { body[["_embedded"]][[what]] } +##' @param url `character(1)` with the request URL. +##' +##' @param what `character(1)` defining the embedded slot name, +##' typically `"ontologies"` for `Ontologies()` or `"terms"` for +##' `Terms()`. Passed to `resp_embedded()`. +##' +##' @return A `list()` responsons in json format that can be converted +##' into ontology or term objects with the `ontologyFromJson()` +##' and `termFromJson()` functions. See `makeOntologies()` and +##' `makeTerms()`, `parents()`, ... for examples. +##' +##' @noRd ols_requests <- function(url, what) lapply( req_perform_iterative( From fd7955d6cbb9dfcca9e09f2030e37894bd1d6e85 Mon Sep 17 00:00:00 2001 From: lgatto Date: Sun, 11 Feb 2024 22:21:47 +0100 Subject: [PATCH 09/11] check and vignette OK (without properties) --- DESCRIPTION | 2 +- NAMESPACE | 10 ++ R/OlsSearch.R | 259 +++++++++++++++++++++++++------ R/Ontologies.R | 45 ++++-- R/Terms.R | 75 +++++---- R/cvparam.R | 19 ++- R/utils.R | 13 +- man/CVParam.Rd | 28 +++- man/OlsSearch-class.Rd | 135 ---------------- man/OlsSearch.Rd | 168 ++++++++++++++++++++ man/Ontologies.Rd | 35 ++++- man/Properties-class.Rd | 83 ---------- man/Terms.Rd | 41 ++++- tests/testthat/test_CVParam.R | 9 -- tests/testthat/test_OlsSearch.R | 37 +---- tests/testthat/test_Onologies.R | 66 ++------ tests/testthat/test_Properties.R | 112 ++++++------- tests/testthat/test_Terms.R | 186 ++++------------------ tests/testthat/test_queries.R | 121 --------------- tests/testthat/test_utils.R | 22 --- vignettes/rols.Rmd | 49 +++--- 21 files changed, 705 insertions(+), 810 deletions(-) delete mode 100644 man/OlsSearch-class.Rd create mode 100644 man/OlsSearch.Rd delete mode 100644 man/Properties-class.Rd delete mode 100644 tests/testthat/test_queries.R delete mode 100644 tests/testthat/test_utils.R diff --git a/DESCRIPTION b/DESCRIPTION index 5c4cfbc..efea294 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,7 +13,7 @@ Description: The rols package is an interface to the Ontology Lookup Service (OLS) to access and query hundred of ontolgies directly from R. Depends: methods -Imports: httr2, httr, jsonlite, +Imports: httr2, jsonlite, utils, Biobase, BiocGenerics (>= 0.23.1) Suggests: GO.db, knitr (>= 1.1.0), BiocStyle (>= 2.5.19), testthat, lubridate, DT, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index ae55607..ec5a82e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,7 +3,10 @@ S3method(as.character,CVParam) S3method(as.data.frame,OlsSearch) S3method(as.data.frame,Ontologies) +export("olsRows<-") export(CVParam) +export(OlsSearch) +export(allRows) export(ancestors) export(as.Term.data.frame) export(as.Terms.data.frame) @@ -11,11 +14,14 @@ export(charIsCVParam) export(children) export(cvCharToCVPar) export(descendants) +export(olsRows) +export(olsSearch) export(parents) exportMethods("[") exportMethods("[[") exportMethods(Ontologies) exportMethods(Ontology) +exportMethods(Term) exportMethods(Terms) exportMethods(isObsolete) exportMethods(isRoot) @@ -46,5 +52,9 @@ exportMethods(unique) import(httr2) import(methods) importFrom(Biobase,validMsg) +importFrom(jsonlite,fromJSON) +importFrom(utils,URLencode) +importFrom(utils,head) importFrom(utils,packageVersion) +importFrom(utils,tail) importMethodsFrom(BiocGenerics,Ontology) diff --git a/R/OlsSearch.R b/R/OlsSearch.R index 3bf3de9..fc99253 100644 --- a/R/OlsSearch.R +++ b/R/OlsSearch.R @@ -1,3 +1,80 @@ +##' @title Querying OLS +##' +##' @aliases OlsSearch olsSearch +##' @aliases olsRows 'olsRows<-' allRows as.data.frame.OlsSearch +##' +##' @description +##' +##' Searching the Ontology Lookup Service is done first by creating an +##' object `OlsSearch` using the `OlsSearch()` constructor. Query +##' responses are then retrieved with the `olsSearch()` function. +##' +##' @author Laurent Gatto +##' +##' @name OlsSearch +##' +##' @examples +##' +##' ## Many results across all ontologies +##' OlsSearch(q = "trans-golgi") +##' +##' ## Exact matches +##' OlsSearch(q = "trans-golgi", exact = TRUE) +##' +##' ## Exact match in the gene ontology (go or GO) only +##' OlsSearch(q = "trans-golgi", exact = TRUE, ontology = "go") +##' OlsSearch(q = "trans-golgi", exact = TRUE, ontology = "GO") +##' +##' ## Exact match in the GO and Uberon +##' OlsSearch(q = "trans-golgi", exact = TRUE, +##' ontology = c("GO", "Uberon")) +##' +##' ## Testing different ESI queries +##' OlsSearch(q = "electrospray", ontology = "MS") +##' OlsSearch(q = "ionization", ontology = "MS") +##' OlsSearch(q = "electrospray ionization", ontology = "MS") +##' OlsSearch(q = "electrospray ionization", ontology = "MS", exact=TRUE) +##' +##' ## Request 5 results instead of 20 (default) +##' OlsSearch(q = "plasma,membrane", ontology = "go", rows = 5) +##' ## Same as above +##' OlsSearch(q = "plasma membrane", ontology = "go", rows = 5) +##' +##' ## or, once the object was created +##' (res <- OlsSearch(q = "plasma,membrane", ontology = "go")) +##' olsRows(res) <- 5 +##' res +##' +##' ## all results +##' res <- allRows(res) +##' res +##' +##' res <- OlsSearch(q = "trans-golgi", ontology = "go", rows = 5) +##' res +##' res <- olsSearch(res) +##' res +##' as(res, "data.frame") +##' trms <- as(res, "Terms") +##' trms +##' termPrefix(trms) +##' termId(trms) +##' +##' ## Setting rows and start parameters +##' tg1 <- OlsSearch(q = "trans-golgi", rows = 5, start = 0) |> +##' olsSearch() |> +##' as("data.frame") +##' tg2 <- OlsSearch(q = "trans-golgi", rows = 5, start = 5) |> +##' olsSearch() |> +##' as("data.frame") +##' tg3 <- OlsSearch(q = "trans-golgi", rows = 10, start = 0) |> +##' olsSearch() |> +##' as("data.frame") +##' +##' ## The two consecutive small results are identical +##' ## to the larger on. +##' identical(rbind(tg1, tg2), tg3) +############################################ +## OlsSearch class .OlsSearch <- setClass("OlsSearch", slots = c(q = "character", ontology = "character", @@ -8,7 +85,7 @@ exact = "logical", groupField = "logical", obsoletes = "logical", - local = "character", + local = "logical", childrenOf = "character", rows = "integer", start = "integer", @@ -16,19 +93,63 @@ numFound = "integer", response = "data.frame")) - -emptyQueryDataFrame <- - structure(list(id = character(0), iri = character(0), - short_form = character(0), obo_id = character(0), - label = character(0), description = list(), - ontology_name = character(0), - ontology_prefix = character(0), type = character(0), - is_defining_ontology = logical(0)), - row.names = integer(0), - class = "data.frame") - ########################################## ## Constructor + +##' @export +##' +##' @rdname OlsSearch +##' +##' @param q `characher(1)` containing the search query. +##' +##' @param ontology `character()` defining the ontology to be +##' queried. Default is the empty character, to search all +##' ontologies. +##' +##' @param type `character()` restricting the search to an entity +##' type, one of `"class"`, `"property"`, `"individual"` or +##' `"ontology"`. +##' +##' @param slim `character()` restricts the search to an particular +##' set of slims by name. +##' +##' @param fieldList `character()` specifcies the fields to return. +##' The defaults are iri, label, short_form, obo_id, +##' ontology_name, ontology_prefix, description and type. Default +##' is `""` for all fields. +##' +##' @param queryFields `character()` specifcies the fields to query, +##' the defaults are label, synonym, description, short_form, +##' obo_id, annotations, logical_description, iri. Default is `""` +##' for all fields. +##' +##' @param exact `logical(1)` defining if exact matches should be +##' returned. Default is `FALSE`. +##' +##' @param groupField `logical(1)`, set to `TRUE`rue to group results +##' by unique id (IRI). +##' +##' @param obsoletes `logical(1)` defining whether obsolete terms +##' should be queried. Default is `FALSE`. +##' +##' @param local `character(1)`, default is `FALSE`. Set to `TRUE` to +##' only return terms that are in a defining ontology e.g. only +##' return matches to gene ontology terms in the gene ontology, +##' and exclude ontologies where those terms are also referenced +##' +##' @param childrenOf `character()` to restrict a search to children +##' of a given term. Supply a list of IRI for the terms that you +##' want to search under. +##' +##' @param rows `integer(1)` defining the number of query +##' returns. Default is 20L. Maximum number of values returned by +##' the server is 1000. To retrieve the next results, set `start` +##' 1000. See examle below. +##' +##' @param start `integer(1)` defining the results page. +##' number. Default is 0L. +##' +##' @importFrom utils URLencode OlsSearch <- function(q, ontology = "", type = "", @@ -38,15 +159,19 @@ OlsSearch <- function(q, exact = FALSE, groupField = FALSE, obsoletes = FALSE, - local = "", + local = TRUE, childrenOf = "", - rows, + rows = 20L, start = 0L) { if (missing(q)) stop("You must supply a query.") + if (rows > 1000) { + warning("Setting row to max value 1000.") + rows <- 1000 + } .args <- as.list(match.call())[-1] if (missing(rows)) - .args[["rows"]] <- rows <- 20L + .args[["rows"]] <- rows ## Create search URL and instantiate OlsSearch object params <- c() for (i in seq_along(.args)) { @@ -61,17 +186,14 @@ OlsSearch <- function(q, arg <- paste(arg, collapse = ",") params <- append(params, paste(nm, arg, sep = "=")) } - url <- paste0("http://www.ebi.ac.uk/ols/beta/api/search?", + ## searchUrl <- "http://www.ebi.ac.uk/ols/beta/api/search?" + searchUrl <- "http://www.ebi.ac.uk/ols4/api/search?" + url <- paste0(searchUrl, paste(params, collapse = "&")) - ## Make actual query, with rows = 1 to get the total number of - ## results found - url0 <- sub("rows=[0-9]+", "rows=1", url) - x <- httr::GET(url) - httr::stop_for_status(x) - cx <- httr::content(x, as = "raw") - txt <- rawToChar(cx) - ans <- jsonlite::fromJSON(txt) - numFound <- ans[["response"]][["numFound"]] + x <- request(url) |> + req_perform() |> + resp_body_json() + numFound <- x[["response"]][["numFound"]] response <- data.frame() .OlsSearch(q = q, ontology = ontology, slim = slim, fieldList = fieldList, queryFields = queryFields, @@ -83,14 +205,24 @@ OlsSearch <- function(q, response = response) } +##' @export +##' +##' @importFrom jsonlite fromJSON +##' +##' @rdname OlsSearch +##' +##' @param object `OlsSeach` result object. +##' +##' @param all `logical(1)` Should all rows be retrieved. Default is +##' `FALSE`. Can also be set in the queary object directly with +##' `allRows()`. olsSearch <- function(object, all = FALSE) { if (all) - x <- allRows(x) - x <- httr::GET(object@url) - httr::stop_for_status(x) - cx <- httr::content(x, as = "raw") - txt <- rawToChar(cx) - ans <- jsonlite::fromJSON(txt) + object <- allRows(object) + ans <- request(object@url) |> + req_perform() |> + resp_body_string() |> + jsonlite::fromJSON() if (!length(ans[['response']][['docs']])) { object@response <- emptyQueryDataFrame } else { @@ -102,7 +234,8 @@ olsSearch <- function(object, all = FALSE) { ########################################## ## show method - +##' @export +##' @rdname OlsSearch setMethod("show", "OlsSearch", function(object) { cat("Object of class 'OlsSearch':\n") @@ -123,24 +256,39 @@ setMethod("show", "OlsSearch", ########################################## ## Accessors and setter -olsRows <- function(x) { - stopifnot(inherits(x, "OlsSearch")) - x@rows +##' @export +##' +##' @rdname OlsSearch +olsRows <- function(object) { + stopifnot(inherits(object, "OlsSearch")) + object@rows } -"olsRows<-" <- function(x, value) { - stopifnot(inherits(x, "OlsSearch")) +##' @export +##' +##' @param value replacement value +##' +##' @rdname OlsSearch +"olsRows<-" <- function(object, value) { + stopifnot(inherits(object, "OlsSearch")) stopifnot(is.numeric(value)) - x@url <- sub("rows=[0-9]+", paste0("rows=", as.integer(value)), x@url) - x@rows <- as.integer(value) - x + object@url <- sub("rows=[0-9]+", + paste0("rows=", as.integer(value)), + object@url) + object@rows <- as.integer(value) + object } -allRows <- function(x) { - stopifnot(inherits(x, "OlsSearch")) - x@rows <- x@numFound - x@url <- sub("rows=[0-9]+", paste0("rows=", x@numFound), x@url) - x +##' @export +##' +##' @rdname OlsSearch +allRows <- function(object) { + stopifnot(inherits(object, "OlsSearch")) + object@rows <- object@numFound + object@url <- sub("rows=[0-9]+", + paste0("rows=", object@numFound), + object@url) + object } @@ -156,7 +304,8 @@ as.data.frame.OlsSearch <- as(x, "data.frame") } -## Terms constructor + +##' @export setAs(from = "OlsSearch", to = "Terms", function(from) { resp <- from@response @@ -167,7 +316,7 @@ setAs(from = "OlsSearch", to = "Terms", } x <- apply(resp, 1, function(x) - tryCatch(term(x[["ontology_prefix"]], + tryCatch(Term(x[["ontology_prefix"]], x[["obo_id"]]), error = function(e) NULL)) if (is.null(x)) { @@ -181,5 +330,19 @@ setAs(from = "OlsSearch", to = "Terms", x <- x[!nullterm] } names(x) <- resp[["obo_id"]][!nullterm] - Terms(x = x) + .Terms(x = x) }) + + +######################################### +## helper functions + +emptyQueryDataFrame <- + structure(list(id = character(0), iri = character(0), + short_form = character(0), obo_id = character(0), + label = character(0), description = list(), + ontology_name = character(0), + ontology_prefix = character(0), type = character(0), + is_defining_ontology = logical(0)), + row.names = integer(0), + class = "data.frame") diff --git a/R/Ontologies.R b/R/Ontologies.R index b368e1f..8dae701 100644 --- a/R/Ontologies.R +++ b/R/Ontologies.R @@ -3,15 +3,16 @@ ##' @aliases Ontologies Ontology ##' @aliases olsLinks olsLinks,Ontology ##' @aliases olsConfig olsConfig,Ontology -##' @aliases olsVersion,character olsVersion,Ontology olsVersion,Ontologies -##' @aliases olsLoaded,character olsLoaded,Ontology olsLoaded,Ontologies -##' @aliases olsUpdated,character olsUpdated,Ontology olsUpdated,Ontologies -##' @aliases olsPrefix,character olsPrefix,Ontology olsPrefix,Ontologies -##' @aliases olsDesc,character olsDesc,Ontology olsDesc,Ontologies -##' @aliases olsTitle,character olsTitle,Ontology olsTitle,Ontologies -##' @aliases olsStatus,character olsStatus,Ontology olsStatus,Ontologies -##' @aliases olsNamespace,character olsNamespace,Ontology olsNamespace,Ontologies +##' @aliases olsVersion olsVersion,character olsVersion,Ontology olsVersion,Ontologies +##' @aliases olsLoaded olsLoaded,character olsLoaded,Ontology olsLoaded,Ontologies +##' @aliases olsUpdated olsUpdated,character olsUpdated,Ontology olsUpdated,Ontologies +##' @aliases olsStatus olsStatus,character olsStatus,Ontology olsStatus,Ontologies +##' @aliases olsPrefix olsPrefix,character olsPrefix,Ontology olsPrefix,Ontologies +##' @aliases olsDesc olsDesc,character olsDesc,Ontology olsDesc,Ontologies +##' @aliases olsTitle olsTitle,character olsTitle,Ontology olsTitle,Ontologies +##' @aliases olsNamespace olsNamespace,character olsNamespace,Ontology olsNamespace,Ontologies ##' @aliases ontologyUrl ontologyUrl,character ontologyUrl,Ontology +##' @aliases as.data.frame.Ontologies ##' ##' @description ##' @@ -165,6 +166,10 @@ NULL ## Constructors ##' @export +##' +##' @param object an instance of class `Ontologies` or `Ontology`. For +##' some functions, a ontology identifier is applicable. +##' ##' @rdname Ontologies setMethod("Ontologies", "missing", function(object) makeOntologies()) @@ -204,6 +209,7 @@ setMethod("show", "Ontology", }) ##' @export +##' @importFrom utils head tail ##' @rdname Ontologies setMethod("show", "Ontologies", function(object) { @@ -347,10 +353,27 @@ setMethod("ontologyUrl", "Ontology", ########################################## ## Data manipulation ##' @export +##' +##' @param X `Ontologies` object. +##' +##' @param FUN a `function` to be applied to each `Ontology` element +##' of `X`. +##' +##' @param ... additional arguments passed to `FUN`. +##' ##' @rdname Ontologies setMethod("lapply", "Ontologies", function(X, FUN, ...) lapply(X@x, FUN, ...)) ##' @export +##' +##' @param x an `Ontologies` object. +##' +##' @param i index of elecements to subset. +##' +##' @param j ignored. +##' +##' @param drop ignored. +##' ##' @rdname Ontologies setMethod("[", "Ontologies", function(x, i, j="missing", drop="missing") @@ -415,9 +438,9 @@ setMethod("length", "Ontologies", function(x) length(x@x)) setAs("Ontologies", "data.frame", function(from) as.data.frame.Ontologies(from)) -##' @exportS3Method -##' @rdname Ontologies -as.data.frame.Ontologies <- function(x) { +##' @export +as.data.frame.Ontologies <- function(x, row.names = NULL, + optional = FALSE, ...) { .as_vector <- function(x) { if (is.list(x)) x <- sapply(x, paste, collapse = "; ") diff --git a/R/Terms.R b/R/Terms.R index aad5dda..169b898 100644 --- a/R/Terms.R +++ b/R/Terms.R @@ -159,6 +159,16 @@ NULL ##' @export ##' @rdname Terms +##' +##' @param object generally an instance of class `Terms` or `Term`. In +##' some cases, an ontology identifier is applicable. +##' +##' @param pagesize `numeric(1)`, converted to an integer, defining +##' the response page size. Default is 1000. +##' +##' @param obsolete `NULL` or `logical(1)` defining whether obsolete +##' terms (`TRUE`), current terms (`FALSE`) or all (`NULL`, +##' default) should be returned. setMethod("Terms", "character", ## ontologyId function(object, pagesize = 1000, obsolete = NULL) makeTerms(object, pagesize, obsolete)) @@ -171,28 +181,27 @@ setMethod("Terms", "Ontology", ##' @export ##' @rdname Terms +##' +##' @param id `character(1)` with the term's identifier. setMethod("Term", "character", - function(object, id) Term(Ontology(object), id)) + function(object, id) { + ## See https://github.com/EBISPOT/ols4/issues/621 + url <- paste0( + "https://www.ebi.ac.uk/ols4/api/ontologies/", + object, + "/terms/http%253A%252F%252Fpurl.obolibrary.org%252Fobo%252F") + url <- paste0(url, sub(":", "_", id)) + request(url) |> + req_perform() |> + resp_body_json() |> + termFromJson() + }) ##' @export ##' @rdname Terms setMethod("Term", "Ontology", - function(object, id) { - ## Unfortunately, direct REST queries for a specific - ## term aren't working (see - ## https://github.com/EBISPOT/ols4/issues/621). For now, - ## as a very ugly workaround, I'm requesting all terms - ## to get a single one :-( - trms <- Terms(object) - i <- which(termId(trms) == id, useNames = FALSE) - if (length(i) == 0) { - warning("Id ", id, " not found. Returning empty Term.") - return(.Term()) - } else if (length(i) > 1) { - stop(id, " is not unique. Please open an issue.") - } - trms[[i]] - }) + function(object, id) + Term(olsNamespace(object), id)) ##' @export ##' @rdname Terms @@ -258,7 +267,7 @@ setMethod("show", "Term", cat(" Label: ", termLabel(object),"\n ", sep = "") desc <- termDesc(object) if (is.null(desc)) cat("No description\n") - else for (i in 1:seq_along(desc)) + else for (i in seq_along(desc)) cat(strwrap(desc[[i]]), sep = "\n ") }) @@ -376,13 +385,30 @@ setMethod("length", "Terms", function(x) length(x@x)) setMethod("unique", "Terms", function(x) x[!duplicated(names(x@x))]) ##' @export ##' @rdname Terms +##' +##' @param x a `Terms` object. +##' +##' @param i index of elecements to subset. +##' +##' @param j ignored. +##' +##' @param drop ignored. setMethod("[", "Terms", - function(x, i, j="missing", drop="missing") Terms(x = x@x[i])) + function(x, i, j="missing", drop="missing") + .Terms(x = x@x[i])) ##' @export ##' @rdname Terms setMethod("[[", "Terms", function(x, i, j="missing", drop="missing") x@x[[i]]) ##' @export +##' +##' @param X `Terms` object. +##' +##' @param FUN a `function` to be applied to each `Term` element of +##' `X`. +##' +##' @param ... additional arguments passed to `FUN`. +##' ##' @rdname Terms setMethod("lapply", "Terms", function(X, FUN, ...) lapply(X@x, FUN, ...)) @@ -514,14 +540,3 @@ fix_null <- function(x) { } .termId <- function(x) x@obo_id - -.term <- function(oid, termid) { - ont <- Ontology(oid) - url <- olsLinks(ont)[["terms"]] - uri <- URLencode(ontologyUri(ont), TRUE) - url <- paste0(url, uri, sub(":", "_", termid)) - x <- GET(url) - stop_for_status(x) - cx <- content(x) - makeTerm(cx) -} diff --git a/R/cvparam.R b/R/cvparam.R index a9814cc..73356ce 100644 --- a/R/cvparam.R +++ b/R/cvparam.R @@ -2,6 +2,9 @@ ##' ##' @name CVParam ##' +##' @aliases CVParam +##' @aliases charIsCVParam cvCharToCVPar as.character.CVParam +##' ##' @description ##' ##' `CVParam` objects instantiate controlled vocabulary entries. @@ -39,20 +42,18 @@ ##' CVParam(name = "A user param", value = "the value") ##' ## CVParam ESI from PSI's Mass Spectrometry ontology ##' Term("MS", "MS:1000073") -##' esi <- CVParam(label = "MS", accession = "MS:1000073") +##' (esi <- CVParam(label = "MS", accession = "MS:1000073")) ##' class(esi) ##' ##' ## From a CVParam object to a character ##' cv <- as(esi, "character") ##' cv ## note the quotes ##' -##' \dontrun{ ##' ## From a character object to a CVParam ##' as(cv, "CVParam") ##' as("[MS, MS:1000073, , ]", "CVParam") ## no name ##' as("[MS, MS:1000073, ESI, ]", "CVParam") ## name does not match ##' as(c(cv, cv), "CVParam") ## more than 1 character -##' } ##' ##' x <- c("[MS, MS:1000073, , ]", ## valid CV param ##' "[, , Hello, world]", ## valid User param @@ -170,6 +171,9 @@ setAs("CVParam", "character", as.character.CVParam <- function(x, ...) as(x, "character") ##' @export +##' +##' @param object `CVParam` object. +##' @rdname CVParam setMethod("show","CVParam", function(object) { cat(as(object, "character"), "\n") @@ -177,6 +181,11 @@ setMethod("show","CVParam", }) ##' @export +##' @rdname CVParam +##' +##' @param x `CVParam` to be repeated. +##' +##' @param times `numeric(1)` defining the number of repetitions. setMethod("rep", "CVParam", function(x, times) { l <- vector("list", length = times) @@ -249,8 +258,8 @@ setAs("character", "CVParam", } ##' @export -charIsCVParam <- function(x) - sapply(x, .charIsCVParam) +charIsCVParam <- function(object) + sapply(object, .charIsCVParam) ## TESTING diff --git a/R/utils.R b/R/utils.R index 81aaa11..cfc5af6 100644 --- a/R/utils.R +++ b/R/utils.R @@ -8,9 +8,10 @@ next_req <- function(resp, req) { request(.next) } -resp_embedded <- function(resp, what) { +resp_embedded <- function(resp, what, + embedded = "_embedded") { body <- resp_body_json(resp) - body[["_embedded"]][[what]] + body[[embedded]][[what]] } ##' @param url `character(1)` with the request URL. @@ -19,13 +20,19 @@ resp_embedded <- function(resp, what) { ##' typically `"ontologies"` for `Ontologies()` or `"terms"` for ##' `Terms()`. Passed to `resp_embedded()`. ##' +##' @param embedded `character(1)` defining where to find the embedded +##' slot name `what`. Default is `"_embedded"`, which work for +##' ontologies and terms, but should be set to `"response"` for an +##' OLS query. +##' ##' @return A `list()` responsons in json format that can be converted ##' into ontology or term objects with the `ontologyFromJson()` ##' and `termFromJson()` functions. See `makeOntologies()` and ##' `makeTerms()`, `parents()`, ... for examples. ##' ##' @noRd -ols_requests <- function(url, what) +ols_requests <- function(url, what, + embedded = "_embedded") lapply( req_perform_iterative( request(url), diff --git a/man/CVParam.Rd b/man/CVParam.Rd index 2055788..55686aa 100644 --- a/man/CVParam.Rd +++ b/man/CVParam.Rd @@ -2,9 +2,18 @@ % Please edit documentation in R/cvparam.R \name{CVParam} \alias{CVParam} +\alias{charIsCVParam} +\alias{cvCharToCVPar} +\alias{as.character.CVParam} +\alias{show,CVParam-method} +\alias{rep,CVParam-method} \title{Controlled Vocabulary} \usage{ CVParam(label, name, accession, value, exact = TRUE) + +\S4method{show}{CVParam}(object) + +\S4method{rep}{CVParam}(x, times) } \arguments{ \item{label}{`character(1)` with the ontology label. If missing, a @@ -24,6 +33,12 @@ constructed. This argument is optional.} \item{exact}{`logical(1)` defining whether the query to retrieve the `accession` (when `name` is used) should be an exact match.} + +\item{object}{`CVParam` object.} + +\item{x}{`CVParam` to be repeated.} + +\item{times}{`numeric(1)` defining the number of repetitions.} } \description{ `CVParam` objects instantiate controlled vocabulary entries. @@ -57,15 +72,16 @@ match.} \examples{ -## a user param +## User param CVParam(name = "A user param", value = "the value") -## a CVParam from PSI's Mass Spectrometry ontology -term("MS", "MS:1000073") -CVParam(label = "MS", accession = "MS:1000073") +## CVParam ESI from PSI's Mass Spectrometry ontology +Term("MS", "MS:1000073") +(esi <- CVParam(label = "MS", accession = "MS:1000073")) +class(esi) ## From a CVParam object to a character -cv <- as(CVParam(label = "MS", accession = "MS:1000073"), "character") -cv +cv <- as(esi, "character") +cv ## note the quotes ## From a character object to a CVParam as(cv, "CVParam") diff --git a/man/OlsSearch-class.Rd b/man/OlsSearch-class.Rd deleted file mode 100644 index 0e3a0c0..0000000 --- a/man/OlsSearch-class.Rd +++ /dev/null @@ -1,135 +0,0 @@ -\name{OlsSearch-class} -\Rdversion{1.1} -\docType{class} - -\alias{OlsSearch} -\alias{class:OlsSearch} -\alias{OlsSearch-class} - -\alias{olsSearch} - -\alias{olsRows} -\alias{olsRows<-} -\alias{allRows} - -\alias{coerce,OlsSearch,data.frame-method} -\alias{coerce,OlsSearch,Terms-method} - -\alias{show,OlsSearch-method} - -\title{Class \code{"OlsSearch"}} - - -\description{ - - Searching the OLS is done using the \code{OlsSearch} data - structure. - -} - -\section{Objects from the Class}{ - - Objects can be created with the constructor function - \code{OlsSearch}. - -} -\section{Slots}{ - \describe{ - - \item{\code{q}:}{Object of class \code{"character"} ~~ } - - \item{\code{ontology}:}{Object of class \code{"character"} ~~ } - - \item{\code{type}:}{Object of class \code{"character"} ~~ } - - \item{\code{slim}:}{Object of class \code{"character"} ~~ } - - \item{\code{fieldList}:}{Object of class \code{"character"} ~~ } - - \item{\code{queryFields}:}{Object of class \code{"character"} ~~ } - - \item{\code{exact}:}{Object of class \code{"logical"} ~~ } - - \item{\code{groupField}:}{Object of class \code{"logical"} ~~ } - - \item{\code{obsoletes}:}{Object of class \code{"logical"} ~~ } - - \item{\code{local}:}{Object of class \code{"character"} ~~ } - - \item{\code{childrenOf}:}{Object of class \code{"character"} ~~ } - - \item{\code{rows}:}{Object of class \code{"integer"} ~~ } - - \item{\code{start}:}{Object of class \code{"integer"} ~~ } - - \item{\code{url}:}{Object of class \code{"character"} ~~ } - - \item{\code{numFound}:}{Object of class \code{"integer"} ~~ } - - \item{\code{response}:}{Object of class \code{"data.frame"} ~~ } - - } -} - -\section{Methods and functions}{ - \describe{ - - \item{coerce}{\code{signature(from = "OlsSearch", to = - "data.frame")}: ... } - - \item{coerce}{\code{signature(from = "OlsSearch", to = "Terms")}: - ... } - - \item{show}{\code{signature(object = "OlsSearch")}: ... } - - - \item{olsRows}{\code{signature(object = "OlsSearch")}: ... The value - can be updated with the \code{olsRows} replacement method. To - request all responses, use \code{allRows}. } - - - } -} - - -\author{ -Laurent Gatto -} - - -\examples{ - -OlsSearch(q = "trans-golgi") -OlsSearch(q = "cell") -OlsSearch(q = "cell", exact = TRUE) -OlsSearch(q = "cell", exact = TRUE, ontology = "go") -OlsSearch(q = "cell", exact = TRUE, ontology = "GO") - -OlsSearch(q = "electrospray", ontology = "MS") -OlsSearch(q = "ionization", ontology = "MS") -OlsSearch(q = "electrospray ionization", ontology = "MS") -OlsSearch(q = "electrospray ionization", ontology = "MS", exact=TRUE) - -## Request 5 results instead of 20 (default) -OlsSearch(q = "plasma,membrane", ontology = "go", rows = 5) - -## or, once the object was created -(res <- OlsSearch(q = "plasma,membrane", ontology = "go")) -olsRows(res) <- 5 -res -## all results -res <- allRows(res) -res - -res <- OlsSearch(q = "trans-golgi", ontology = "go", rows = 5) -res -res <- olsSearch(res) -res -as(res, "data.frame") -res <- as(res, "Terms") -res -termPrefix(res) -termId(res) -} - -\keyword{classes} diff --git a/man/OlsSearch.Rd b/man/OlsSearch.Rd new file mode 100644 index 0000000..f2cfeaa --- /dev/null +++ b/man/OlsSearch.Rd @@ -0,0 +1,168 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/OlsSearch.R +\docType{class} +\name{OlsSearch} +\alias{OlsSearch} +\alias{.OlsSearch} +\alias{olsSearch} +\alias{olsRows} +\alias{'olsRows<-'} +\alias{allRows} +\alias{as.data.frame.OlsSearch} +\alias{show,OlsSearch-method} +\alias{olsRows<-} +\title{Querying OLS} +\usage{ +OlsSearch( + q, + ontology = "", + type = "", + slim = "", + fieldList = "", + queryFields = "", + exact = FALSE, + groupField = FALSE, + obsoletes = FALSE, + local = TRUE, + childrenOf = "", + rows = 20L, + start = 0L +) + +olsSearch(object, all = FALSE) + +\S4method{show}{OlsSearch}(object) + +olsRows(object) + +olsRows(object) <- value + +allRows(object) +} +\arguments{ +\item{q}{`characher(1)` containing the search query.} + +\item{ontology}{`character()` defining the ontology to be +queried. Default is the empty character, to search all +ontologies.} + +\item{type}{`character()` restricting the search to an entity +type, one of `"class"`, `"property"`, `"individual"` or +`"ontology"`.} + +\item{slim}{`character()` restricts the search to an particular +set of slims by name.} + +\item{fieldList}{`character()` specifcies the fields to return. +The defaults are iri, label, short_form, obo_id, +ontology_name, ontology_prefix, description and type. Default +is `""` for all fields.} + +\item{queryFields}{`character()` specifcies the fields to query, +the defaults are label, synonym, description, short_form, +obo_id, annotations, logical_description, iri. Default is `""` +for all fields.} + +\item{exact}{`logical(1)` defining if exact matches should be +returned. Default is `FALSE`.} + +\item{groupField}{`logical(1)`, set to `TRUE`rue to group results +by unique id (IRI).} + +\item{obsoletes}{`logical(1)` defining whether obsolete terms +should be queried. Default is `FALSE`.} + +\item{local}{`character(1)`, default is `FALSE`. Set to `TRUE` to +only return terms that are in a defining ontology e.g. only +return matches to gene ontology terms in the gene ontology, +and exclude ontologies where those terms are also referenced} + +\item{childrenOf}{`character()` to restrict a search to children +of a given term. Supply a list of IRI for the terms that you +want to search under.} + +\item{rows}{`integer(1)` defining the number of query +returns. Default is 20L. Maximum number of values returned by +the server is 1000. To retrieve the next results, set `start` +1000. See examle below.} + +\item{start}{`integer(1)` defining the results page. +number. Default is 0L.} + +\item{object}{`OlsSeach` result object.} + +\item{all}{`logical(1)` Should all rows be retrieved. Default is +`FALSE`. Can also be set in the queary object directly with +`allRows()`.} + +\item{value}{replacement value} +} +\description{ +Searching the Ontology Lookup Service is done first by creating an +object `OlsSearch` using the `OlsSearch()` constructor. Query +responses are then retrieved with the `olsSearch()` function. +} +\examples{ + +## Many results across all ontologies +OlsSearch(q = "trans-golgi") + +## Exact matches +OlsSearch(q = "trans-golgi", exact = TRUE) + +## Exact match in the gene ontology (go or GO) only +OlsSearch(q = "trans-golgi", exact = TRUE, ontology = "go") +OlsSearch(q = "trans-golgi", exact = TRUE, ontology = "GO") + +## Exact match in the GO and Uberon +OlsSearch(q = "trans-golgi", exact = TRUE, + ontology = c("GO", "Uberon")) + +## Testing different ESI queries +OlsSearch(q = "electrospray", ontology = "MS") +OlsSearch(q = "ionization", ontology = "MS") +OlsSearch(q = "electrospray ionization", ontology = "MS") +OlsSearch(q = "electrospray ionization", ontology = "MS", exact=TRUE) + +## Request 5 results instead of 20 (default) +OlsSearch(q = "plasma,membrane", ontology = "go", rows = 5) +## Same as above +OlsSearch(q = "plasma membrane", ontology = "go", rows = 5) + +## or, once the object was created +(res <- OlsSearch(q = "plasma,membrane", ontology = "go")) +olsRows(res) <- 5 +res + +## all results +res <- allRows(res) +res + +res <- OlsSearch(q = "trans-golgi", ontology = "go", rows = 5) +res +res <- olsSearch(res) +res +as(res, "data.frame") +trms <- as(res, "Terms") +trms +termPrefix(trms) +termId(trms) + +## Setting rows and start parameters +tg1 <- OlsSearch(q = "trans-golgi", rows = 5, start = 0) |> + olsSearch() |> + as("data.frame") +tg2 <- OlsSearch(q = "trans-golgi", rows = 5, start = 5) |> + olsSearch() |> + as("data.frame") +tg3 <- OlsSearch(q = "trans-golgi", rows = 10, start = 0) |> + olsSearch() |> + as("data.frame") + +## The two consecutive small results are identical +## to the larger on. +identical(rbind(tg1, tg2), tg3) +} +\author{ +Laurent Gatto +} diff --git a/man/Ontologies.Rd b/man/Ontologies.Rd index cbe6383..e328a91 100644 --- a/man/Ontologies.Rd +++ b/man/Ontologies.Rd @@ -7,33 +7,42 @@ \alias{olsLinks,Ontology} \alias{olsConfig} \alias{olsConfig,Ontology} +\alias{olsVersion} \alias{olsVersion,character} \alias{olsVersion,Ontology} \alias{olsVersion,Ontologies} +\alias{olsLoaded} \alias{olsLoaded,character} \alias{olsLoaded,Ontology} \alias{olsLoaded,Ontologies} +\alias{olsUpdated} \alias{olsUpdated,character} \alias{olsUpdated,Ontology} \alias{olsUpdated,Ontologies} +\alias{olsStatus} +\alias{olsStatus,character} +\alias{olsStatus,Ontology} +\alias{olsStatus,Ontologies} +\alias{olsPrefix} \alias{olsPrefix,character} \alias{olsPrefix,Ontology} \alias{olsPrefix,Ontologies} +\alias{olsDesc} \alias{olsDesc,character} \alias{olsDesc,Ontology} \alias{olsDesc,Ontologies} +\alias{olsTitle} \alias{olsTitle,character} \alias{olsTitle,Ontology} \alias{olsTitle,Ontologies} -\alias{olsStatus,character} -\alias{olsStatus,Ontology} -\alias{olsStatus,Ontologies} +\alias{olsNamespace} \alias{olsNamespace,character} \alias{olsNamespace,Ontology} \alias{olsNamespace,Ontologies} \alias{ontologyUrl} \alias{ontologyUrl,character} \alias{ontologyUrl,Ontology} +\alias{as.data.frame.Ontologies} \alias{Ontologies,missing-method} \alias{Ontology,character-method} \alias{Ontology,Ontology-method} @@ -71,7 +80,6 @@ \alias{[,Ontologies-method} \alias{[[,Ontologies-method} \alias{length,Ontologies-method} -\alias{as.data.frame.Ontologies} \title{Ontologies} \usage{ \S4method{Ontologies}{missing}(object) @@ -147,8 +155,25 @@ \S4method{[[}{Ontologies}(x, i, j = "missing", drop = "missing") \S4method{length}{Ontologies}(x) +} +\arguments{ +\item{object}{an instance of class `Ontologies` or `Ontology`. For +some functions, a ontology identifier is applicable.} + +\item{X}{`Ontologies` object.} + +\item{FUN}{a `function` to be applied to each `Ontology` element +of `X`.} + +\item{...}{additional arguments passed to `FUN`.} + +\item{x}{an `Ontologies` object.} + +\item{i}{index of elecements to subset.} + +\item{j}{ignored.} -\method{as.data.frame}{Ontologies}(x) +\item{drop}{ignored.} } \description{ The rols package provides an interface to PRIDE's Ontology Lookup diff --git a/man/Properties-class.Rd b/man/Properties-class.Rd deleted file mode 100644 index eae9e87..0000000 --- a/man/Properties-class.Rd +++ /dev/null @@ -1,83 +0,0 @@ -\name{Properties-class} -\Rdversion{1.1} -\docType{class} - -\alias{Properties} -\alias{class:Properties} -\alias{Properties-class} -\alias{Property} -\alias{class:Property} -\alias{Property-class} - -\alias{show,Properties-method} -\alias{show,Property-method} - -\alias{properties} -\alias{properties,character-method} -\alias{properties,Ontology-method} -\alias{properties,Term-method} -\alias{properties,Terms-method} - -\alias{length,Properties-method} - -\title{Class \code{"Properties"}} - -\description{ - - Propteries (relationships) between terms can be queries for complete - \code{\linkS4class{Ontology}} objects and - \code{\linkS4class{Term}}/\code{\linkS4class{Terms}} instances, and - the results are stored as objects of class \code{Property} or - \code{Properties}. - -} - -\section{Objects from the Class}{ - Objects can be created by calls to \code{properties}, as described - below. } - -\section{Slots}{ - See the \code{\linkS4class{Term}} and \code{\linkS4class{Terms}} classes. -} - -\section{Extends}{ - Class \code{"\linkS4class{Terms}"}, directly. -} - -\section{Methods and functions}{ - \describe{ - - \item{properties}{\code{signature(object = "Ontology", pagesize = - 200)}: ... Also works with a \code{character} with the ontology - namespace. See \code{\link{Ontology}} for details. } - - \item{properties}{\code{signature(object = "Term")}: retrieves the - properties of term \code{object} and returns a \code{Properties} - object. Returns \code{NULL} when no properties are available. } - - \item{proterties}{\code{signature(object = "Terms", ...)}: retrieves - the properties of each term of \code{object} and returns a list of - \code{Properties} (or \code{NULL}) items. } - - \item{show}{\code{signature(object = "Properties")}: shows a textual - summary of the object. } - - \item{length}{\code{signature(object = "Properties")}: returns the - number of properties in \code{object}. } } } - - -\author{ - Laurent Gatto -} - -\examples{ -trm <- term("uberon", "UBERON:0002107") -trm -properties(trm) - -trm2 <- term("GO", "GO:0005326") -trm2 -properties(trm2) -} - -\keyword{classes} diff --git a/man/Terms.Rd b/man/Terms.Rd index fc3a220..d9c92e6 100644 --- a/man/Terms.Rd +++ b/man/Terms.Rd @@ -40,6 +40,8 @@ \alias{termNamespace,Terms} \alias{Terms,character-method} \alias{Terms,Ontology-method} +\alias{Term,character-method} +\alias{Term,Ontology-method} \alias{show,Term-method} \alias{show,Terms-method} \alias{termSynonym,Term-method} @@ -70,9 +72,13 @@ \alias{as.Terms.data.frame} \title{Ontology Terms} \usage{ -\S4method{Terms}{character}(x, pagesize = 1000, obsolete = NULL) +\S4method{Terms}{character}(object, pagesize = 1000, obsolete = NULL) -\S4method{Terms}{Ontology}(x, pagesize = 1000, obsolete = NULL) +\S4method{Terms}{Ontology}(object, pagesize = 1000, obsolete = NULL) + +\S4method{Term}{character}(object, id) + +\S4method{Term}{Ontology}(object, id) children(object) @@ -138,6 +144,34 @@ as.Term.data.frame(x) as.Terms.data.frame(x) } +\arguments{ +\item{object}{generally an instance of class `Terms` or `Term`. In +some cases, an ontology identifier is applicable.} + +\item{pagesize}{`numeric(1)`, converted to an integer, defining +the response page size. Default is 1000.} + +\item{obsolete}{`NULL` or `logical(1)` defining whether obsolete +terms (`TRUE`), current terms (`FALSE`) or all (`NULL`, +default) should be returned.} + +\item{id}{`character(1)` with the term's identifier.} + +\item{x}{a `Terms` object.} + +\item{i}{index of elecements to subset.} + +\item{j}{ignored.} + +\item{drop}{ignored.} + +\item{X}{`Terms` object.} + +\item{FUN}{a `function` to be applied to each `Term` element of +`X`.} + +\item{...}{additional arguments passed to `FUN`.} +} \description{ The `Term` class describes an ontology term. A set of terms are instantiated as a `Terms` class. @@ -247,6 +281,9 @@ descendants(trm) ## includes child parents(trm) ancestors(trm) ## includes parent + +## A single term from an ontology +Term("ado", "ADO:0000090") } \author{ Laurent Gatto diff --git a/tests/testthat/test_CVParam.R b/tests/testthat/test_CVParam.R index fdae4b0..bf55326 100644 --- a/tests/testthat/test_CVParam.R +++ b/tests/testthat/test_CVParam.R @@ -25,15 +25,6 @@ test_that("CVParam creation and coercion", { expect_identical(cv2, cv2) }) - -test_that("CVParam creation and coercion 2", { - cv <- CVParam(label = "MS", - accession = "MS:1000073") - cv2 <- CVParam(label = "MS", - name = cv@name) - expect_identical(cv, cv2) - }) - test_that("testing chars are CV params", { falses <- rols:::notvalidCVchars expect_false(any(charIsCVParam(falses))) diff --git a/tests/testthat/test_OlsSearch.R b/tests/testthat/test_OlsSearch.R index 85679c1..ba8485a 100644 --- a/tests/testthat/test_OlsSearch.R +++ b/tests/testthat/test_OlsSearch.R @@ -1,42 +1,9 @@ -## test_that("OlsSearch tgn", { -## tgn <- OlsSearch(q = "tgn",ontology = "GO") -## tgn <- olsSearch(tgn) - -## tgnres <- structure(c("trans-Golgi network", -## "clathrin coat of trans-Golgi network vesicle", -## "Golgi to endosome transport", -## "trans-Golgi network transport vesicle", -## "trans-Golgi network transport vesicle membrane"), -## .Names = c("GO:0005802", "GO:0030130", -## "GO:0006895", "GO:0030140", "GO:0012510")) - -## expect_identical(sort(termLabel(as(tgn, "Terms"))), -## sort(tgnres)) -## }) - - -## test_that("OlsSearch ESI", { - -## esi2 <- OlsSearch(q = "ESI", ontology = "MS", rows = 28) -## esi1 <- OlsSearch(q = "ESI", ontology = "MS", exact = TRUE) - -## esi1 <- olsSearch(esi1) -## esi2 <- olsSearch(esi2) - -## expect_identical(esi1@numFound, 1L) -## expect_identical(esi2@numFound, 34L) -## expect_true(termId(as(esi1, "Terms")) %in% termId(as(esi2, "Terms"))) -## }) - - test_that("OlsSearch tgn", { tgnpw <- OlsSearch("tgn","PW") tgnpw <- olsSearch(allRows(tgnpw)) expect_equal(tgnpw@numFound, 4L) - tgn <- OlsSearch("tgn") tgn <- olsSearch(allRows(tgn)) - expect_true(all(tgnpw@response[, "obo_id"] %in% tgn@response[, "obo_id"])) }) @@ -59,7 +26,9 @@ test_that("OlsSearch rows", { res <- allRows(res) expect_equal(olsRows(res), res@numFound) - expect_equal(nrow(olsSearch(res)@response), res@numFound) + + res <- olsSearch(res) ## max is 1000 + expect_equal(nrow(res@response), 1000) }) test_that("OlsSearch coercion", { diff --git a/tests/testthat/test_Onologies.R b/tests/testthat/test_Onologies.R index 7177638..88846f3 100644 --- a/tests/testthat/test_Onologies.R +++ b/tests/testthat/test_Onologies.R @@ -30,6 +30,7 @@ test_that("Ontology accessors", { library("lubridate") n <- length(ol) status <- olsStatus(ol) + loaded <- olsLoaded(ol) ## --- Dates --- ## if the loaded date is not valid (NA), then that ontology should ## not have a status 'LOADED'. @@ -39,13 +40,10 @@ test_that("Ontology accessors", { expect_false(any(is.na(updated))) expect_identical(n, length(loaded)) expect_identical(n, length(updated)) - i <- which(names(status) == "go") - ## expect_identical(ymd(olsLoaded(go)), loaded[i]) expect_identical(olsLoaded(go), olsLoaded("GO")) expect_identical(olsLoaded(go), olsLoaded("go")) expect_identical(olsUpdated(go), olsUpdated("GO")) expect_identical(olsUpdated(go), olsUpdated("go")) - ## --- Versions --- vrs <- olsVersion(ol) pre <- olsPrefix(ol) @@ -54,60 +52,32 @@ test_that("Ontology accessors", { ## expect_identical(vrs[["go"]], olsVersion(go)) expect_identical(olsVersion("GO"), olsVersion(go)) expect_identical(olsVersion("go"), olsVersion(go)) - - ## --- Root --- - ## rts <- olsRoot(ol["go"]) - ## gort <- rts[[1]] - ## expect_identical(gort, olsRoot(go)) - ## expect_identical(gort, olsRoot("go")) - - ## expect_identical(gort, olsRoot("GO")) - ### --- Terms --- - trms <- Terms(x = list('GO:0005575' = Term("GO", 'GO:0005575'), - 'GO:0003674' = term("GO", 'GO:0003674'), - 'GO:0008150' = term("GO", 'GO:0008150'))) - trms <- trms[order(termId(trms))] - gort <- gort[order(termId(gort))] - expect_identical(trms, gort) - ## --- Prefix --- + i <- which(olsPrefix(ol) == "GO") expect_identical(pre[[i]], olsPrefix(go)) expect_identical(pre[[i]], olsPrefix("go")) expect_identical(pre[[i]], olsPrefix("GO")) expect_identical(pre[[i]], olsPrefix("Go")) - ## --- Description --- - desc <- olsDesc(ol) - expect_identical(desc[[i]], olsDesc(go)) - expect_identical(desc[[i]], olsDesc("go")) - expect_identical(desc[[i]], olsDesc("GO")) - - ## --- Title --- - ## ttl <- olsTitle(ol) - ## expect_identical(ttl[[i]], olsTitle(go)) - ## expect_identical(ttl[[i]], olsTitle("go")) - ## expect_identical(ttl[[i]], olsTitle("GO")) - ## expect_identical(olsTitle(go), "Gene Ontology") - ## next test fixed on 2020/05/01 - changed description - ## expect_identical(olsDesc(go), "The Gene Ontology (GO) provides a framework and set of concepts for describing the functions of gene products from all organisms.") - ## expect_identical(status[[i]], "LOADED") ## failed Sun Jan 1 20:36:00 GMT 2017 - + desc <- olsDesc(ol[[i]]) + expect_identical(desc, olsDesc(go)) + expect_identical(desc, olsDesc("go")) + expect_identical(desc, olsDesc("GO")) ## --- Status --- expect_identical(status[[i]], olsStatus(go)) expect_identical(status[[i]], olsStatus("go")) expect_identical(status[[i]], olsStatus("GO")) - ## --- Namespace --- nsp0 <- olsNamespace(ol) nsp <- sapply(ol@x, olsNamespace) expect_identical(nsp0, nsp) - expect_identical(nsp[["go"]], olsNamespace("GO")) - expect_identical(nsp[["go"]], olsNamespace("go")) - expect_identical(nsp[["go"]], olsNamespace(go)) + expect_identical(nsp[[i]], olsNamespace("GO")) + expect_identical(nsp[[i]], olsNamespace("go")) + expect_identical(nsp[[i]], olsNamespace(go)) }) test_that("apply over Ontologies", { - expect_identical(unlist(lapply(ol, olsPrefix)), + expect_identical(lapply(ol, olsPrefix), olsPrefix(ol)) }) @@ -118,19 +88,3 @@ test_that("coercion", { olst <- as(ol, "list") expect_identical(olst, ol@x) }) - -test_that("all.equal ontolgies", { - ol0 <- ol <- Ontologies() - expect_identical(length(ol), length(ol[-1]) + 1L) - expect_identical(all.equal(ol, ol[-1]), - "The 2 Ontologies are of different lengths") - names(ol@x)[1] <- "foo" - expect_identical(length(ol), length(ol0)) - expect_identical(all.equal(ol, ol0), - "Ontology names don't match") - expect_identical(names(ol@x)[-1], names(ol0@x)[-1]) - ol <- ol0 - ol@x[[1]]@loaded <- "123" - nm <- olsNamespace(ol[[1]]) - expect_equivalent(ol, ol0) -}) diff --git a/tests/testthat/test_Properties.R b/tests/testthat/test_Properties.R index 43472fa..0f2b4b6 100644 --- a/tests/testthat/test_Properties.R +++ b/tests/testthat/test_Properties.R @@ -1,56 +1,56 @@ -test_that("Property constructors", { - soprops <- properties("so") - ont <- Ontology("so") - soprops2 <- properties(ont) - ## note that this is true only of the order of the two requests is - ## the same. This seems to be the case here, pronably because - ## there are relatively rew results. Might need to implement an - ## all.equal method though. - expect_identical(soprops, soprops2) - - trm <- term("uberon", "UBERON_0002107") - p <- properties(trm) - expect_is(p, "Properties") - ## expect_identical(length(p), 11L) - - expect_identical(termId(p), sapply(p@x, "slot", "obo_id")) - - trm2 <- term("uberon", "UBERON_0002108") - trm3 <- term("uberon", "UBERON_0000002") - - trmlst <- c(trm, trm2, trm3) - names(trmlst) <- sapply(trmlst, termId) - trms <- rols:::Terms(x = trmlst) - - pl <- properties(trms) - expect_is(pl, "list") - expect_identical(length(pl), 3L) - - so <- terms(ont) - k <- c("SO:0000579", "SO:0000833", "SO:0000578", "SO:0000011", - "SO:0000577", "SO:0000628", "SO:0001431", "SO:0000704", - "SO:0000976", "SO:0000576") - - pl <- properties(so[k]) - - ## expect_message(x <- properties(so[k[1]]), "No properties for term SO:0000579") - ## expect_null(x[[1]]) - ## x <- properties(so[k]) - ## expect_identical(sum(sapply(x, is.null)), 7L) -}) - - -test_that("Property/ies show", { - expect_null(show(properties("so"))) - trm <- term("uberon", "UBERON_0002107") - p <- properties(trm) - expect_null(show(p)) - expect_null(show(p[[1]])) -}) - -test_that("iterating over next property", { - go <- Ontology("go") - p1 <- properties(go) - p2 <- properties(go, pagesize = 10) - expect_identical(p1, p2) -}) +## test_that("Property constructors", { +## soprops <- properties("so") +## ont <- Ontology("so") +## soprops2 <- properties(ont) +## ## note that this is true only of the order of the two requests is +## ## the same. This seems to be the case here, pronably because +## ## there are relatively rew results. Might need to implement an +## ## all.equal method though. +## expect_identical(soprops, soprops2) + +## trm <- term("uberon", "UBERON_0002107") +## p <- properties(trm) +## expect_is(p, "Properties") +## ## expect_identical(length(p), 11L) + +## expect_identical(termId(p), sapply(p@x, "slot", "obo_id")) + +## trm2 <- term("uberon", "UBERON_0002108") +## trm3 <- term("uberon", "UBERON_0000002") + +## trmlst <- c(trm, trm2, trm3) +## names(trmlst) <- sapply(trmlst, termId) +## trms <- rols:::Terms(x = trmlst) + +## pl <- properties(trms) +## expect_is(pl, "list") +## expect_identical(length(pl), 3L) + +## so <- terms(ont) +## k <- c("SO:0000579", "SO:0000833", "SO:0000578", "SO:0000011", +## "SO:0000577", "SO:0000628", "SO:0001431", "SO:0000704", +## "SO:0000976", "SO:0000576") + +## pl <- properties(so[k]) + +## ## expect_message(x <- properties(so[k[1]]), "No properties for term SO:0000579") +## ## expect_null(x[[1]]) +## ## x <- properties(so[k]) +## ## expect_identical(sum(sapply(x, is.null)), 7L) +## }) + + +## test_that("Property/ies show", { +## expect_null(show(properties("so"))) +## trm <- term("uberon", "UBERON_0002107") +## p <- properties(trm) +## expect_null(show(p)) +## expect_null(show(p[[1]])) +## }) + +## test_that("iterating over next property", { +## go <- Ontology("go") +## p1 <- properties(go) +## p2 <- properties(go, pagesize = 10) +## expect_identical(p1, p2) +## }) diff --git a/tests/testthat/test_Terms.R b/tests/testthat/test_Terms.R index 82046fd..d4beae7 100644 --- a/tests/testthat/test_Terms.R +++ b/tests/testthat/test_Terms.R @@ -1,19 +1,19 @@ go <- Ontology("GO") -trm <- term(go, "GO:0032801") -trms <- terms("SO", pagesize = 1000) +trm <- Term(go, "GO:0032801") +trms <- Terms("SO", pagesize = 1000) test_that("constructors", { - so <- Ontology("SO") - trms <- terms("SO") - trms2 <- terms(so) - expect_true(rols:::all.equal(trms, trms2)) - expect_identical(length(trms[1:10]), 10L) + ## so <- Ontology("SO") + ## trms <- Terms("SO") + ## trms2 <- Terms(so) + ## expect_true(rols:::all.equal(trms, trms2)) + ## expect_identical(length(trms[1:10]), 10L) go <- Ontology("GO") - trm <- term(go, "GO:0032801") - trm1 <- term(go, "GO:0032801") - trm2 <- term("go", "GO:0032801") - trm3 <- term("GO", "GO:0032801") + trm <- Term(go, "GO:0032801") + trm1 <- Term(go, "GO:0032801") + trm2 <- Term("go", "GO:0032801") + trm3 <- Term("GO", "GO:0032801") expect_identical(trm1, trm2) expect_identical(trm1, trm3) @@ -22,86 +22,37 @@ test_that("constructors", { expect_identical(termId(trm), "GO:0032801") trm1 <- trms[["SO:1000005"]] - trm2 <- term("SO", "SO:1000005") + trm2 <- Term("SO", "SO:1000005") expect_identical(trm1, trm2) expect_identical(termPrefix(trm1), "SO") expect_true(all(termPrefix(trms) == "SO")) expect_identical(termPrefix(trm), "GO") - expect_identical(termLabel(trm), "receptor catabolic process") - ## removed 2021-03-30 when termSynonym(trm) became NULL - ## expect_identical(termSynonym(trm), - ## c("receptor breakdown", - ## "receptor degradation", - ## "receptor catabolism")) - expect_identical(termSynonym(trms[[123]]), - "biomaterial region") - - ## removed 2021-03-30 when termDesc(trm) became NULL - ## expect_identical(termDesc(trm), - ## "The chemical reactions and pathways resulting in the breakdown of a receptor molecule, a macromolecule that undergoes combination with a hormone, neurotransmitter, drug or intracellular messenger to initiate a change in cell function.") - expect_identical(termDesc(trms[[123]]), - "A region which is intended for use in an experiment.") - - ## The labels have changed on 2018-10-06 - xt <- c('GO:0038018', 'GO:1990172', 'GO:0032802', 'GO:0097019') - chld <- children(trm) - - - expect_identical(sort(names(termLabel(chld))), - sort(sort(xt))) - - expect_identical(sort(termLabel(parents(trm))), - sort(c('GO:0043112' = "receptor metabolic process", - 'GO:0044248' = "cellular catabolic process", - 'GO:0009057' = "macromolecule catabolic process"))) - - ## was 20 before 2017-06-20 - ## was 13 before 2017-10-17 - ## set to 13 after fixing a bug (see #26) 2018-06-01 - expect_identical(length(ancestors(trm)), 13L) - nms <- names(descendants(trm)@x) expect_identical(children(trm)@x[nms], descendants(trm)@x[nms]) - }) test_that("show methods", { expect_null(show(trms)) - expect_null(show(trms[1])) - expect_null(show(trms[1:2])) - expect_null(show(trms[1:3])) - expect_null(show(trms[1:4])) - expect_null(show(trms[1:5])) + ## expect_null(show(trms[1])) + ## expect_null(show(trms[1:2])) + ## expect_null(show(trms[1:3])) + ## expect_null(show(trms[1:4])) + ## expect_null(show(trms[1:5])) expect_null(show(trm)) }) test_that("accessors", { - expect_identical(length(termSynonym(trms[1:2])), 2L) + ## expect_identical(length(termSynonym(trms[1:2])), 2L) expect_false(isObsolete(trm)) - expect_true(isObsolete(term("GO", "GO:0005563"))) - expect_false(isObsolete(term("GO", "GO:0030533"))) - k <- 342 ## changed on <2019-08-12 Mon>; <2020-02-17 Wed>; - ## <2020-08-26 Wed>; <2021-02-01 Mon>; <2021-06-15 Tue> - expect_equal(sum(isObsolete(trms)), k) - expect_equal(sum(!isObsolete(trms)), length(trms) - k) + expect_true(isObsolete(Term("GO", "GO:0005563"))) + expect_false(isObsolete(Term("GO", "GO:0030533"))) expect_true(isRoot(trms[["SO:0000400"]])) - expect_true(isRoot(trms[["SO:0000110"]])) - expect_true(isRoot(trms[["SO:0001260"]])) - expect_true(all(termId(olsRoot("SO")) %in% names(which(isRoot(trms))))) - - olsroot <- olsRoot("GO") - goroots <- sort(structure(c("biological_process", - "cellular_component", - "molecular_function"), - .Names = c("GO:0008150", - "GO:0005575", "GO:0003674"))) - expect_identical(sort(termLabel(olsroot)), goroots) expect_identical(length(termDesc(trms)), length(trms)) expect_identical(length(termLabel(trms)), length(trms)) @@ -113,110 +64,27 @@ test_that("accessors", { expect_identical(termOntology(trm), "go") }) -test_that("unique terms", { - x <- list(term("go", "GO:0005802"), - term("cco", "GO:0005802")) - names(x) <- rep("GO:0005802", 2) - trms <- rols:::Terms(x = x) - expect_identical(length(trms), 2L) - expect_identical(length(unique(trms)), 1L) - expect_identical(unique(trms)[[1]], trms[[1]]) -}) - test_that("apply over Terms", { - expect_identical(lapply(trms, termId), + expect_identical(unlist(lapply(trms, termId)), termId(trms)) }) -test_that("Term/Terms equality", { - expect_true(all.equal(trms, trms)) - expect_true(all.equal(trms[1:10], trms[10:1])) - expect_match(all.equal(trms[1:10], trms[1:2]), - "2 Terms are of different lengths") - expect_match(all.equal(trms[1:10], trms[11:2]), - "Term ids don't match") - i <- sample(length(trms), 10) - for (ii in i) { - cat("Testing term", termId(trms)[[ii]], "\n") - all.equal(trms[[ii]], term("SO", termId(trms)[[ii]])) - } - expect_false(isTRUE(all.equal(trms[[1]], trms[[2]]))) - - xx1 <- xx2 <- trms[1:2] - xx1@x[[1]] <- xx1@x[[2]] - expect_false(isTRUE(all.equal(xx1, xx2))) - ## 2020-07-01: Changed matching pattern from "Term id 'SO:0000995'" - expect_match(all.equal(xx1, xx2), "Term id 'SO:0000579'") -}) test_that("terms(pagesize)", { - trms1 <- terms("SO", pagesize = 20) - trms2 <- terms("SO", pagesize = 200) - trms3 <- terms("SO", pagesize = 1000) - trms4 <- terms("SO", pagesize = 10000) ## 2302 entries - trms5 <- terms("SO", pagesize = 2302) ## 2302 entries + trms1 <- Terms("SO", pagesize = 20, obsolete = TRUE) + trms2 <- Terms("SO", pagesize = length(trms1), obsolete = TRUE) + trms3 <- Terms("SO", pagesize = 1000, obsolete = TRUE) ## > length(trms1) expect_true(all.equal(trms1, trms2)) expect_true(all.equal(trms1, trms3)) - expect_true(all.equal(trms3, trms4)) - expect_true(all.equal(trms3, trms5)) }) test_that("No links", { - trm <- term("GO", "GO:0030232") + trm <- Term("GO", "GO:0030232") ## does not have any children - expect_message(x <- children(trm), "No children terms.") - expect_null(x) + expect_null(children(trm)) ## does not have any descendants - expect_message(x <- descendants(trm), "No descendant terms.") - expect_null(x) + expect_null(descendants(trm)) ## does have parents and ancestors, though expect_is(parents(trm), "Terms") expect_is(ancestors(trm), "Terms") - ## not anymore - trm@links$parents <- NULL - trm@links$ancestors <- NULL - expect_message(x <- parents(trm), "No parent terms.") - expect_null(x) - expect_message(x <- ancestors(trm), "No ancestor terms.") - expect_null(x) -}) - -test_that("partOf and derivesFrom", { - pof <- partOf(term("BTO", "BTO:0000142")) - expect_identical(length(pof), 2L) - expect_identical(lapply(pof, termLabel), - list(`BTO:0000227` = "central nervous system", - `BTO:0000282` = "head")) - - defrom <- derivesFrom(term("BTO", "BTO:0002600")) - expect_identical(length(defrom), 1L) - expect_identical(termId(defrom[[1]]), "BTO:0000099") - - defrom <- derivesFrom(term("BTO", "BTO:0001023")) - expect_identical(length(defrom), 1L) - expect_identical(termId(defrom[[1]]), "BTO:0000975") - - expect_null(derivesFrom(term("GO", "GO:0008308"))) - expect_message(derivesFrom(term("GO", "GO:0008308")), - "No 'derives from' terms") - - expect_null(partOf(term("BTO", "BTO:0002600"))) - expect_message(partOf(term("BTO", "BTO:0002600")), - "No 'part of' terms") -}) - - -test_that("coerce term(s) as df", { - x <- as(trm, "data.frame") - expect_identical(dim(x), c(1L, 10L)) - x <- as(trms, "data.frame") - expect_identical(ncol(x), 10L) - ## for (i in 1:length(trms)) { - ## x1 <- x[i, ] - ## x2 <- as(trms[[i]], "data.frame") - ## x1[is.na(x1)] <- NA_character_ - ## x2[is.na(x2)] <- NA_character_ - ## rownames(x2) <- rownames(x1) - ## expect_identical(x1, x2) - ## } }) diff --git a/tests/testthat/test_queries.R b/tests/testthat/test_queries.R deleted file mode 100644 index f79861d..0000000 --- a/tests/testthat/test_queries.R +++ /dev/null @@ -1,121 +0,0 @@ -## context("queries and iface.R code") - -## children/getTermChildren - not implemented -## getChildrenFromRoot - not implemented -## getTermsByExactName - not implemented -## getTermsByAnnotationData - not implemented - -## test_that("olsVersion/getVersion", { -## v <- olsVersion() -## expect_is(v, "character") -## expect_identical(length(v), 5L) -## }) - -## test_that("term/getTermById", { -## expect_identical(term("GO:0005794", "GO"), -## "Golgi apparatus") -## expect_null(term("GO:0000000", "GO")) -## expect_warning(term("GO:0000000", "GO")) -## expect_identical(term("210797", "NEWT"), -## "Golfingia vulgaris (Marine worm)") -## }) - -## test_that("termMetadata/getTermMetadata", { -## mtd <- termMetadata("GO:0005802", "GO") -## expect_null(rols:::print.termMetadata(mtd)) -## expect_identical(mtd["exact_synonym_2"], c(exact_synonym_2 = "TGN")) -## expect_identical(length(mtd), 9L) -## }) - -## test_that("termXrefs/getTermXrefs", { -## ans <- termXrefs("TGN transport vesicle", "GO") -## ans2 <- termXrefs("TGN", "GO") -## expect_equal(grep("GOC", ans), 1L) -## expect_equal(grep("GOC", ans2), 3L) -## }) - -## test_that("onologyNames/getOntologyNames", { -## onms <- ontologyNames() -## expect_is(onms, "character") -## expect_true(length(onms) >= 93) -## }) - -## test_that("ontologyLoadDate/getOntologyLoadDate", { -## onms <- ontologyNames() -## xx <- sapply(onms, ontologyLoadDate) -## expect_is(xx, "character") -## expect_identical(length(onms), length(xx)) -## }) - -## test_that("allIds/getAllTermsFromOntology", { -## allms <- allIds("MS", simplify=FALSE) -## expect_is(allms, "Map") -## expect_true(length(allms) >= 5266) -## allms2 <- allIds("MS", simplify=TRUE) -## expect_is(allms2, "character") -## expect_identical(length(allms), length(allms2)) -## }) - -## test_that("rootId/getRootTerms",{ -## goroot <- rootId("GO") -## goans <- -## structure(c("biological_process", -## "cellular_component", -## "molecular_function"), -## .Names = c("GO:0008150", -## "GO:0005575", "GO:0003674")) -## expect_identical(goroot, goans) -## }) - -## test_that("olsQuery/getTermsByName", { -## tgn <- olsQuery("tgn","GO") -## tgnres <- structure(c("TGN", "clathrin coat of TGN vesicle", -## "TGN to endosome transport", -## "TGN transport vesicle", -## "TGN transport vesicle membrane"), -## .Names = c("GO:0005802", "GO:0030130", -## "GO:0006895", "GO:0030140", "GO:0012510")) -## expect_identical(tgn, tgnres) - -## esi2 <- olsQuery("ESI", "MS") -## esi1 <- olsQuery("ESI", "MS", exact = TRUE) -## expect_identical(length(esi1), 1L) -## expect_identical(length(esi2), 2L) -## expect_true(esi1 %in% esi2) - -## expect_warning(olsQuery("tgn", exact=TRUE)) -## expect_message(x <- olsQuery("foobar", "GO", exact=TRUE), -## "Empty query results after 3 attempts.") -## expect_equal(length(x), 0L) -## }) - -## test_that("olsQuery/getPrefixedTermsByName", { -## tgngo <- olsQuery("tgn","GO") -## tgn <- olsQuery("tgn") -## expect_true(all(paste("GO", tgngo, sep = ":") %in% tgn)) -## }) - -## test_that("parents/getTermParents", { -## x <- parents("GO:0005802", "GO") -## ans <- structure(c("Golgi apparatus part", "Golgi apparatus", -## "Golgi subcompartment", "organelle subcompartment"), -## .Names = c("GO:0044431", "GO:0005794", -## "GO:0098791", "GO:0031984")) -## expect_equal(x, ans) -## }) - - -## test_that("childrenRelations/getTermRelations", { -## x <- childrenRelations("GO:0005802", "GO") -## ans <- structure("part_of", .Names = "GO:0032588") -## expect_equal(x, ans) -## x <- childrenRelations("GO:0005802", "MS") -## ans <- structure(list(), .Names = character(0)) -## expect_equal(x, ans) -## }) - - -## test_that("isIdObsolete/isObsolete", { -## expect_true(isIdObsolete("GO:0005563", "GO")) -## expect_true(!isIdObsolete("GO:0030533", "GO")) -## }) diff --git a/tests/testthat/test_utils.R b/tests/testthat/test_utils.R deleted file mode 100644 index 387bc74..0000000 --- a/tests/testthat/test_utils.R +++ /dev/null @@ -1,22 +0,0 @@ -test_that("ontologyUri", { - go <- Ontology("go") - expect_identical(rols:::ontologyUri(go, encode = FALSE), - rols:::ontologyUri(encode = FALSE)) - expect_identical(rols:::ontologyUri(go, encode = TRUE), - rols:::ontologyUri(encode = TRUE)) - ## not in this case - https://github.com/EBISPOT/OLS/issues/35 - ordo <- Ontology("ordo") - expect_false(rols:::ontologyUri(ordo, encode = FALSE) == rols:::ontologyUri(encode = FALSE)) - expect_equal(rols:::ontologyUri(ordo, encode = FALSE), - "http://www.orpha.net/ORDO/") -}) - - - -test_that("ontologyUri with multiple URIs", { - go0 <- go <- Ontology("go") - go@config$baseUris[[2]] <- "foo" - expect_warning(rols:::ontologyUri(go, encode = FALSE)) - expect_equal(suppressWarnings(rols:::ontologyUri(go, encode = FALSE)), - rols:::ontologyUri(go0, encode = FALSE)) -}) diff --git a/vignettes/rols.Rmd b/vignettes/rols.Rmd index a0244e6..42473a8 100644 --- a/vignettes/rols.Rmd +++ b/vignettes/rols.Rmd @@ -74,7 +74,7 @@ query. ```{r ontTable, echo = FALSE} -datatable(as(ol, "data.frame")) +DT::datatable(as(ol, "data.frame")) ``` # A Brief rols overview @@ -101,14 +101,14 @@ ol ```{r} head(olsNamespace(ol)) -ol[["go"]] +ol[["bspo"]] ``` It is also possible to initialise a single ontology ```{r} -go <- Ontology("go") -go +bspo <- Ontology("bspo") +bspo ``` ## Terms @@ -120,16 +120,16 @@ to obtain all terms of an ontology of interest, and the resulting lists. ```{r} -gotrms <- terms(go) ## or terms("go") -gotrms -gotrms[1:10] -gotrms[["GO:0090575"]] +bspotrms <- Terms(bspo) ## or Terms("bspo") +bspotrms +bspotrms[1:10] +bspotrms[["BSPO:0000092"]] ``` It is also possible to initialise a single term ```{r} -trm <- term(go, "GO:0090575") +trm <- Term(bspo, "BSPO:0000092") termId(trm) termLabel(trm) ``` @@ -143,9 +143,6 @@ parents(trm) children(trm) ``` -Similarly, the `partOf` and `derivesFrom` functions return, for an -input term, the terms it is a part of and derived from. - Finally, a single term or terms object can be coerced to a `data.frame` using `as(x, "data.frame")`. @@ -156,12 +153,12 @@ ontologies can be queries with the `properties` method, as briefly illustrated below. ```{r propex} -trm <- term("uberon", "UBERON:0002107") +trm <- Term("uberon", "UBERON:0002107") trm -p <- properties(trm) -p -p[[1]] -termLabel(p[[1]]) +## p <- properties(trm) +## p +## p[[1]] +## termLabel(p[[1]]) ``` # Use case @@ -201,12 +198,7 @@ One case set the `rows` argument to set the number of desired results. OlsSearch(q = "trans-golgi network", ontology = "GO", rows = 200) ``` -Alternatively, one can call the `allRows` function to request all results. - -```{r tgnquery3} -(tgnq <- OlsSearch(q = "trans-golgi network", ontology = "GO")) -(tgnq <- allRows(tgnq)) -``` +See `?OlsSearch` for details about retrieving many results. ```{r tgnsear4, echo=FALSE} qry <- OlsSearch(q = "trans-golgi network", exact = TRUE) @@ -266,8 +258,9 @@ off-line approaches. In the case of `r Biocpkg("rols")`, although the load date of a specific ontology can be queried with `olsVersion`, it is not possible to query a specific version of an ontology. +# Changes -# Changes in version 2.0 +## Version 2.0 `r Biocpkg("rols")` 2.0 has substantially changed. While the table below shows some correspondence between the old and new interface, @@ -292,6 +285,14 @@ maintained by opening an [issue](https://github.com/lgatto/rols/issues) on the package development site. +# Version 2.99 + +- `rols` version >= 2.99 has been refactored to use the OLS4 REST API. +- REST queries now use [httr2](https://httr2.r-lib.org/) instead of + superseded `httr`. +- The term(s) constructors are capitalised as `Term()` and `Terms()`. +- Some class definitions have been updated to accomodate changes in + the data received by OLS. Some function have been dropped. # CVParams From 8b55f7bf6413bfe4056b956638b6eb2143629f80 Mon Sep 17 00:00:00 2001 From: lgatto Date: Mon, 12 Feb 2024 00:01:08 +0100 Subject: [PATCH 10/11] add Properties --- NAMESPACE | 1 + R/AllClasses.R | 2 +- R/AllGenerics.R | 2 +- R/Properties.R | 239 +++++++++++++++++-------------- R/Terms.R | 2 +- man/Properties.Rd | 21 +++ tests/testthat/test_Properties.R | 90 +++++------- vignettes/rols.Rmd | 8 +- 8 files changed, 197 insertions(+), 168 deletions(-) create mode 100644 man/Properties.Rd diff --git a/NAMESPACE b/NAMESPACE index ec5a82e..d89b3e4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ exportMethods("[") exportMethods("[[") exportMethods(Ontologies) exportMethods(Ontology) +exportMethods(Properties) exportMethods(Term) exportMethods(Terms) exportMethods(isObsolete) diff --git a/R/AllClasses.R b/R/AllClasses.R index 117ad96..24056e6 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -1,3 +1,3 @@ setClassUnion("NullOrChar", c("NULL", "character")) setClassUnion("NullOrList", c("NULL", "list")) -## setClassUnion("NullOrLogical", c("NULL", "logical")) +setClassUnion("NullOrLogical", c("NULL", "logical")) diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 84c7af2..7c4ba1c 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -25,7 +25,7 @@ setGeneric("termDesc", function(object, ...) standardGeneric("termDesc")) setGeneric("termNamespace", function(object, ...) standardGeneric("termNamespace")) setGeneric("termOntology", function(object, ...) standardGeneric("termOntology")) -## setGeneric("properties", function(object, ...) standardGeneric("properties")) +setGeneric("Properties", function(object, ...) standardGeneric("Properties")) ## private setGeneric("ontologyUrl", function(object, ...) standardGeneric("ontologyUrl")) diff --git a/R/Properties.R b/R/Properties.R index b8c733c..8689679 100644 --- a/R/Properties.R +++ b/R/Properties.R @@ -1,116 +1,145 @@ -## .Property <- setClass("Property", -## contains = "Term") -## Properties <- setClass("Properties", contains = "Terms") +##' @title Term Properties +##' +##' @name Properties +##' +##' @description +##' +##' Properties (relationships) between terms can be queries for +##' complete [Ontology()] objects and [Term()]/[Terms()] instances, +##' and the results are stored as objects of class `Property` or +##' `Properties`. +##' +##' @examples +##' +##' ## Term properties +##' trm <- Term("uberon", "UBERON:0002107") +##' trm +##' Properties(trm) +##' +##' ## Ontology properties +##' Properties('ado') +NULL +########################################## +## Classes +.Property <- setClass("Property", + contains = "Term") +.Properties <- setClass("Properties", contains = "Terms") -## ########################################## -## ## Constructors -## setMethod("properties", "character", -## function(object, ...) .properties(object, ...)) -## setMethod("properties", "Ontology", -## function(object, ...) .properties(olsNamespace(object), ...)) -## setMethod("properties", "Term", -## function(object, ...) { -## urls <- getPropertyLinks(object) -## if (length(urls) == 0) { -## message("No properties for term ", termId(object)) -## return(NULL) -## } -## ans <- lapply(urls, makeProperties) -## ans <- unlist(lapply(ans, "slot", "x")) -## names(ans) <- sub("\\.href\\.", "/", names(ans)) -## Properties(x = ans) -## }) +########################################## +## Constructors +##' @export +setMethod("Properties", "Ontology", + function(object, ...) + Properties(olsNamespace(object))) -## setMethod("properties", "Terms", -## function(object, ...) { -## lapply(object@x, properties, ...) -## }) +##' @export +setMethod("Properties", "character", + function(object, ...) { + url <- + paste0("http://www.ebi.ac.uk/ols4/api/ontologies/", + object, "/properties") + x <- lapply(ols_requests(url, what = "properties"), + propertyFromJson) + .Properties(x = x) + }) -## ########################################## -## ## show methods +##' @export +setMethod("Properties", "Term", + function(object, ...) { + urls <- getPropertyLinks(object) + if (length(urls) == 0) { + message("No properties for term ", termId(object)) + return(NULL) + } + .properiesFromJson <- function(url) + lapply(ols_requests(url, what = "terms"), + propertyFromJson) + ans <- unlist(lapply(urls, .properiesFromJson)) + .Properties(x = ans) + }) +##' @export +setMethod("Properties", "Terms", + function(object, ...) { + ans <- lapply(object@x, Properties, ...) + ans <- unlist(lapply(ans, "slot", "x"), + use.names = FALSE) + .Properties(x = ans) + }) -## setMethod("show", "Property", -## function(object) { -## ids <- termId(object) -## cat("A Property from the", termPrefix(object), "ontology:", ids, "\n") -## cat(" Label: ", termLabel(object),"\n", sep = "") -## }) +########################################## +## show methods +##' @export +setMethod("show", "Property", + function(object) { + ids <- termId(object) + cat("A Property from the", termPrefix(object), + "ontology:", ids, "\n") + cat(" Label: ", termLabel(object),"\n", sep = "") + }) +##' @export +setMethod("show", "Properties", + function(object) { + cat("Object of class 'Properties' with", length(object), + ifelse(length(object) > 1, + "entries\n", + "entry\n")) + onts <- unique(termPrefix(object)) + if (length(onts) == 1) + cat(" From the", onts, "ontology\n") + else if (length(onts) < 6) + cat(" From the", paste(onts, collapse = ", "), "ontologies\n") + else cat(" From ", length(onts), "ontologies\n") + n <- length(object) + if (n > 4) + cat(" ", paste(head(termLabel(object), n=2), collapse = ", "), + "...", + paste(tail(termLabel(object), n=2), collapse = ", "), "\n") + else + cat(paste(termLabel(object)[1:n], collapse = ", "), "\n") + }) -## setMethod("show", "Properties", -## function(object) { -## cat("Object of class 'Properties' with", length(object), -## ifelse(length(object) > 1, -## "entries\n", -## "entry\n")) -## onts <- unique(termPrefix(object)) -## if (length(onts) == 1) -## cat(" From the", onts, "ontology\n") -## else if (length(onts) < 6) -## cat(" From the", paste(onts, collapse = ", "), "ontologies\n") -## else cat(" From ", length(onts), "ontologies\n") -## n <- length(object) -## if (n > 4) -## cat(" ", paste(head(termLabel(object), n=2), collapse = ", "), -## "...", -## paste(tail(termLabel(object), n=2), collapse = ", "), "\n") -## else -## cat(paste(termLabel(object)[1:n], collapse = ", "), "\n") -## }) +########################################## +## Data manipulation +##' @export +setMethod("length", "Properties", function(x) length(x@x)) -## ########################################## -## ## Data manipulation +######################################### +## Helper functions +propertyFromJson <- function(x) + .Property(iri = x[["iri"]], + lang = x[["lang"]], + description = x[["description"]], + synonyms = x[["synonyms"]], + annotation = x[["annotation"]], + label = x[["label"]], + ontology_name = x[["ontology_name"]], + ontology_prefix = x[["ontology_prefix"]], + ontology_iri = x[["ontology_iri"]], + is_obsolete = x[["is_obsolete"]], + term_replaced_by = x[["term_replaced_by"]], + is_defining_ontology = x[["is_defining_ontology"]], + has_children = x[["has_children"]], + is_root = x[["is_root"]], + short_form = x[["short_form"]], + obo_id = x[["obo_id"]], + in_subset = x[["in_subset"]], + obo_definition_citation = x[["obo_definition_citation"]], + obo_xref = x[["obo_xref"]], + obo_synonym = x[["obo_synonym"]], + is_preferred_root = x[["is_preferred_root"]], + links = x[["_links"]]) -## setMethod("length", "Properties", function(x) length(x@x)) -## ##' @title Constructs the query for all properties from a given ontology -## ##' @param oid A character with an ontology or an ontology -## ##' @param pagesize How many results per page to return -## ##' @return An object of class Terms -## .properties <- function(oid, pagesize = 200) { -## ont <- Ontology(oid) -## url <- paste(ontologyUrl(ont), "properties", sep = "/") -## url <- paste0(url, "?&size=", pagesize) -## makeProperties(url) -## } - -## makeProperties <- function(url) { -## x <- GET(url) -## stop_for_status(x) -## cx <- content(x) -## ans <- lapply(cx[["_embedded"]][[1]], makeProperty) -## ## -- Iterating -## .next <- cx[["_links"]][["next"]]$href -## while (!is.null(.next)) { -## x <- GET(.next) -## warn_for_status(x) -## cx <- content(x) -## ans <- append(ans, lapply(cx[["_embedded"]][[1]], makeProperty)) -## .next <- cx[["_links"]][["next"]][[1]] -## } -## names(ans) <- sapply(ans, termLabel) -## Properties(x = ans) -## } - -## ##' @title Makes a Property instance based on the response from -## ##' /api/ontologies/{ontology}/terms/{iri} -## ##' @param x The content from the response -## ##' @return An object of class Property -## makeProperty <- function(x) -## .Property(iri = x$iri, -## label = x$label, -## description = x$description, -## annotation = x$annotation, -## synonym = x$synonym, -## ontology_name = x$ontology_name, -## ontology_prefix = x$ontology_prefix, -## ontology_iri = x$ontology_iri, -## is_obsolete = x$is_obsolete, -## is_defining_ontology = x$is_defining_ontology, -## has_children = x$has_children, -## is_root = x$is_root, -## short_form = x$short_form, -## obo_id = x$obo_id, -## links = x$`_links`) +## see https://github.com/EBISPOT/OLS/issues/36 +getPropertyLinks <- function(trm) { + termlinks <- c("self", "parents", "ancestors", + "children", "descendants", + "part_of","derives_from") + graphlinks <- c("jstree", "graph") + nms <- names(termLinks(trm)) + p <- !nms %in% c(termlinks, graphlinks) + termLinks(trm)[p] +} diff --git a/R/Terms.R b/R/Terms.R index 169b898..4080614 100644 --- a/R/Terms.R +++ b/R/Terms.R @@ -147,7 +147,7 @@ NULL obo_definition_citation = "NullOrList", obo_xref = "NullOrList", obo_synonym = "NullOrList", - is_preferred_root = "logical", + is_preferred_root = "NullOrLogical", links = "list")) ############################################################ diff --git a/man/Properties.Rd b/man/Properties.Rd new file mode 100644 index 0000000..d7d2c4d --- /dev/null +++ b/man/Properties.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Properties.R +\name{Properties} +\alias{Properties} +\title{Term Properties} +\description{ +Properties (relationships) between terms can be queries for +complete [Ontology()] objects and [Term()]/[Terms()] instances, +and the results are stored as objects of class `Property` or +`Properties`. +} +\examples{ + +## Term properties +trm <- Term("uberon", "UBERON:0002107") +trm +Properties(trm) + +## Ontology properties +Properties('ado') +} diff --git a/tests/testthat/test_Properties.R b/tests/testthat/test_Properties.R index 0f2b4b6..06d8322 100644 --- a/tests/testthat/test_Properties.R +++ b/tests/testthat/test_Properties.R @@ -1,56 +1,34 @@ -## test_that("Property constructors", { -## soprops <- properties("so") -## ont <- Ontology("so") -## soprops2 <- properties(ont) -## ## note that this is true only of the order of the two requests is -## ## the same. This seems to be the case here, pronably because -## ## there are relatively rew results. Might need to implement an -## ## all.equal method though. -## expect_identical(soprops, soprops2) - -## trm <- term("uberon", "UBERON_0002107") -## p <- properties(trm) -## expect_is(p, "Properties") -## ## expect_identical(length(p), 11L) - -## expect_identical(termId(p), sapply(p@x, "slot", "obo_id")) - -## trm2 <- term("uberon", "UBERON_0002108") -## trm3 <- term("uberon", "UBERON_0000002") - -## trmlst <- c(trm, trm2, trm3) -## names(trmlst) <- sapply(trmlst, termId) -## trms <- rols:::Terms(x = trmlst) - -## pl <- properties(trms) -## expect_is(pl, "list") -## expect_identical(length(pl), 3L) - -## so <- terms(ont) -## k <- c("SO:0000579", "SO:0000833", "SO:0000578", "SO:0000011", -## "SO:0000577", "SO:0000628", "SO:0001431", "SO:0000704", -## "SO:0000976", "SO:0000576") - -## pl <- properties(so[k]) - -## ## expect_message(x <- properties(so[k[1]]), "No properties for term SO:0000579") -## ## expect_null(x[[1]]) -## ## x <- properties(so[k]) -## ## expect_identical(sum(sapply(x, is.null)), 7L) -## }) - - -## test_that("Property/ies show", { -## expect_null(show(properties("so"))) -## trm <- term("uberon", "UBERON_0002107") -## p <- properties(trm) -## expect_null(show(p)) -## expect_null(show(p[[1]])) -## }) - -## test_that("iterating over next property", { -## go <- Ontology("go") -## p1 <- properties(go) -## p2 <- properties(go, pagesize = 10) -## expect_identical(p1, p2) -## }) +test_that("Property constructors", { + soprops <- Properties("so") + ont <- Ontology("so") + soprops2 <- Properties(ont) + ## note that this is true only of the order of the two requests is + ## the same. This seems to be the case here, probably because + ## there are relatively rew results. Might need to implement an + ## all.equal method though. + expect_identical(soprops, soprops2) + + trm <- Term("uberon", "UBERON_0002107") + p <- Properties(trm) + expect_is(p, "Properties") + + expect_identical(termId(p), sapply(p@x, "slot", "obo_id")) + + trm2 <- Term("uberon", "UBERON_0002108") + trm3 <- Term("uberon", "UBERON_0000002") + + trmlst <- c(trm, trm2, trm3) + names(trmlst) <- sapply(trmlst, termId) + trms <- rols:::.Terms(x = trmlst) + + pl <- Properties(trms) +}) + + +test_that("Property/ies show", { + expect_null(show(Properties("so"))) + trm <- Term("uberon", "UBERON_0002107") + p <- Properties(trm) + expect_null(show(p)) + expect_null(show(p[[1]])) +}) diff --git a/vignettes/rols.Rmd b/vignettes/rols.Rmd index 42473a8..9ab8178 100644 --- a/vignettes/rols.Rmd +++ b/vignettes/rols.Rmd @@ -155,10 +155,10 @@ illustrated below. ```{r propex} trm <- Term("uberon", "UBERON:0002107") trm -## p <- properties(trm) -## p -## p[[1]] -## termLabel(p[[1]]) +p <- Properties(trm) +p +p[[1]] +termLabel(p[[1]]) ``` # Use case From 7bcf65df9a97719f119c53b92725addee4c0a508 Mon Sep 17 00:00:00 2001 From: lgatto Date: Mon, 12 Feb 2024 00:14:26 +0100 Subject: [PATCH 11/11] fix Properties man page warnings --- R/Properties.R | 30 +++++++++++++++++++++++++----- man/Properties.Rd | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+), 5 deletions(-) diff --git a/R/Properties.R b/R/Properties.R index 8689679..469284c 100644 --- a/R/Properties.R +++ b/R/Properties.R @@ -1,5 +1,11 @@ ##' @title Term Properties ##' +##' @aliases Property +##' @aliases Properties Properties,character Properties,Ontology +##' @aliases Properties,Term Properties,Terms +##' @aliases Properties,length +##' +##' ##' @name Properties ##' ##' @description @@ -30,13 +36,17 @@ NULL ########################################## ## Constructors ##' @export +##' @rdname Properties +##' +##' @param object First input object. setMethod("Properties", "Ontology", - function(object, ...) + function(object) Properties(olsNamespace(object))) ##' @export +##' @rdname Properties setMethod("Properties", "character", - function(object, ...) { + function(object) { url <- paste0("http://www.ebi.ac.uk/ols4/api/ontologies/", object, "/properties") @@ -46,8 +56,9 @@ setMethod("Properties", "character", }) ##' @export +##' @rdname Properties setMethod("Properties", "Term", - function(object, ...) { + function(object) { urls <- getPropertyLinks(object) if (length(urls) == 0) { message("No properties for term ", termId(object)) @@ -60,9 +71,10 @@ setMethod("Properties", "Term", .Properties(x = ans) }) ##' @export +##' @rdname Properties setMethod("Properties", "Terms", - function(object, ...) { - ans <- lapply(object@x, Properties, ...) + function(object) { + ans <- lapply(object@x, Properties) ans <- unlist(lapply(ans, "slot", "x"), use.names = FALSE) .Properties(x = ans) @@ -71,6 +83,7 @@ setMethod("Properties", "Terms", ########################################## ## show methods ##' @export +##' @rdname Properties setMethod("show", "Property", function(object) { ids <- termId(object) @@ -80,6 +93,7 @@ setMethod("show", "Property", }) ##' @export +##' @rdname Properties setMethod("show", "Properties", function(object) { cat("Object of class 'Properties' with", length(object), @@ -104,6 +118,9 @@ setMethod("show", "Properties", ########################################## ## Data manipulation ##' @export +##' @rdname Properties +##' +##' @param x A `Properties` object. setMethod("length", "Properties", function(x) length(x@x)) ######################################### @@ -143,3 +160,6 @@ getPropertyLinks <- function(trm) { p <- !nms %in% c(termlinks, graphlinks) termLinks(trm)[p] } + +## Try also from URL +## curl 'http://www.ebi.ac.uk/ols/beta/api/ontologies/go/properties/http%253A%252F%252Fpurl.obolibrary.org%252Fobo%252FBFO_0000051' -i -H 'Accept: application/json' diff --git a/man/Properties.Rd b/man/Properties.Rd index d7d2c4d..5f437ea 100644 --- a/man/Properties.Rd +++ b/man/Properties.Rd @@ -2,7 +2,40 @@ % Please edit documentation in R/Properties.R \name{Properties} \alias{Properties} +\alias{Property} +\alias{Properties,character} +\alias{Properties,Ontology} +\alias{Properties,Term} +\alias{Properties,Terms} +\alias{Properties,length} +\alias{Properties,Ontology-method} +\alias{Properties,character-method} +\alias{Properties,Term-method} +\alias{Properties,Terms-method} +\alias{show,Property-method} +\alias{show,Properties-method} +\alias{length,Properties-method} \title{Term Properties} +\usage{ +\S4method{Properties}{Ontology}(object) + +\S4method{Properties}{character}(object) + +\S4method{Properties}{Term}(object) + +\S4method{Properties}{Terms}(object) + +\S4method{show}{Property}(object) + +\S4method{show}{Properties}(object) + +\S4method{length}{Properties}(x) +} +\arguments{ +\item{object}{First input object.} + +\item{x}{A `Properties` object.} +} \description{ Properties (relationships) between terms can be queries for complete [Ontology()] objects and [Term()]/[Terms()] instances,