From d0c33b5bab3f251224e4bdb39aa1ae5de78020a7 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 28 Jul 2023 11:29:23 -0400 Subject: [PATCH 01/35] Initial commit --- R/class_all_generics.R | 0 R/hap_id_matrix.R | 23 ++++++++++++----------- 2 files changed, 12 insertions(+), 11 deletions(-) create mode 100644 R/class_all_generics.R diff --git a/R/class_all_generics.R b/R/class_all_generics.R new file mode 100644 index 0000000..e69de29 diff --git a/R/hap_id_matrix.R b/R/hap_id_matrix.R index caff00b..8331e8e 100644 --- a/R/hap_id_matrix.R +++ b/R/hap_id_matrix.R @@ -1,14 +1,15 @@ -#' @title Generate a haplotype ID matrix -#' -#' @description Generates a haplotype ID matrix from a PHG object. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param phgObject A PHG object. -#' -#' @importFrom rJava is.jnull -#' @importFrom rJava J +## ---- +# @title Generate a haplotype ID matrix +# +# @description Generates a haplotype ID matrix from a PHG object. +# +# @author Brandon Monier +# @author Peter Bradbury +# +# @param phgObject A PHG object. +# +# @importFrom rJava is.jnull +# @importFrom rJava J hapIDMatrix <- function(phgObject) { ## Pull hap ID matrix from phg object From e3112e294fb1a4c4b45354305af804e5622572b1 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 4 Aug 2023 17:23:09 -0400 Subject: [PATCH 02/35] Update console output --- R/brapi_methods.R | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/R/brapi_methods.R b/R/brapi_methods.R index 1298635..ad967c2 100644 --- a/R/brapi_methods.R +++ b/R/brapi_methods.R @@ -40,20 +40,21 @@ setMethod( statusMsg <- "" } - cat("A BrAPI connection object\n") - cat(" Server...........:", host(object), "\n") - cat(" Port.............:", port(object), "\n") - cat(" Server status....:", status, statusMsg, "\n") - cat(" BrAPI version....:", version(object), "\n") + # cat("A BrAPI connection object\n") + # cat(" Server...........:", host(object), "\n") + # cat(" Port.............:", port(object), "\n") + # cat(" Server status....:", status, statusMsg, "\n") + # cat(" BrAPI version....:", version(object), "\n") + + msg <- c( + paste0("A ", cli::style_bold("BrAPI"), " connection object"), + paste0(" ", cli::col_green(cli::symbol$pointer), " Server...........: ", host(object)), + paste0(" ", cli::col_green(cli::symbol$pointer), " Port.............: ", port(object)), + paste0(" ", cli::col_green(cli::symbol$pointer), " Server status....: ", statusMsg), + paste0(" ", cli::col_green(cli::symbol$pointer), " BrAPI version....: ", version(object)) + ) - # cli::cli_div(theme = list(ul = list(`margin-left` = 2, before = ""))) - # cli::cli_text("A {.strong BrAPI} connection object") - # cli::cli_ul(id = "foo") - # cli::cli_li("{.field Server}...........: {.url {host(object)}}") - # cli::cli_li("{.field Port}.............: { {port(object)} }") - # cli::cli_li("{.field Server status}....: { statusMsg }") - # cli::cli_li("{.field BrAPI version}....: { {version(object)} }") - # cli::cli_end(id = "foo") + cat(msg, sep = "\n") } ) From 199ae7d7bf81c816b8b55cf19e34396195143e4b Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 4 Aug 2023 17:25:35 -0400 Subject: [PATCH 03/35] Add variable --- R/brapi_methods.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/brapi_methods.R b/R/brapi_methods.R index ad967c2..ac0b27e 100644 --- a/R/brapi_methods.R +++ b/R/brapi_methods.R @@ -46,12 +46,13 @@ setMethod( # cat(" Server status....:", status, statusMsg, "\n") # cat(" BrAPI version....:", version(object), "\n") + pointerSymbol <- cli::col_green(cli::symbol$pointer) msg <- c( paste0("A ", cli::style_bold("BrAPI"), " connection object"), - paste0(" ", cli::col_green(cli::symbol$pointer), " Server...........: ", host(object)), - paste0(" ", cli::col_green(cli::symbol$pointer), " Port.............: ", port(object)), - paste0(" ", cli::col_green(cli::symbol$pointer), " Server status....: ", statusMsg), - paste0(" ", cli::col_green(cli::symbol$pointer), " BrAPI version....: ", version(object)) + paste0(" ", pointerSymbol, " Server...........: ", host(object)), + paste0(" ", pointerSymbol, " Port.............: ", port(object)), + paste0(" ", pointerSymbol, " Server status....: ", statusMsg), + paste0(" ", pointerSymbol, " BrAPI version....: ", version(object)) ) cat(msg, sep = "\n") From d68793896de0d6e16f85fec137ac4aad91d37d7d Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 11 Aug 2023 16:15:06 -0400 Subject: [PATCH 04/35] Reorganize classes and generics --- DESCRIPTION | 2 +- NAMESPACE | 23 +- R/brapi_getters_setters.R | 37 -- R/brapi_methods.R | 585 ------------------ R/class_all_generics.R | 146 +++++ R/class_phg_con_local.R | 129 ++++ R/{brapi_classes.R => class_phg_con_server.R} | 113 ++-- R/{classes.R => class_phg_dataset.R} | 0 R/class_phg_method.R | 295 +++++++++ R/{brapi_defunct.R => deprecated_brapi.R} | 0 R/show_phg_methods.R | 117 ++-- R/{brapi_utilities.R => utilities_brapi.R} | 0 R/{utilities.R => utilities_general.R} | 63 +- inst/extdata/configSQLite.txt | 2 +- man/BrapiCon-class.Rd | 2 +- man/BrapiCon-validity.Rd | 2 +- man/BrapiCon.Rd | 2 +- man/BrapiConPHG-class.Rd | 2 +- man/PHGDataSet-class.Rd | 2 +- man/PHGLocalCon-class.Rd | 32 + man/PHGLocalCon-validity.Rd | 11 + man/PHGLocalCon.Rd | 15 + man/PHGMethod.Rd | 2 +- man/availablePHGMethods.Rd | 18 - man/brapiURL.Rd | 15 +- man/brapiVersion.Rd | 16 + man/configCatcher.Rd | 6 +- man/createConfigFile.Rd | 33 - man/filterRefRanges.Rd | 31 - man/filterSamples.Rd | 18 - man/getVTList.Rd | 2 +- man/hapIDMatrix.Rd | 19 - man/host.Rd | 19 + man/json2tibble.Rd | 2 +- man/parseJSON.Rd | 2 +- man/port.Rd | 16 + man/readHaplotypeIds.Rd | 23 + man/readPHGDataSet.Rd | 21 + man/readPHGDatasetFromBrapi.Rd | 17 - man/readRefRanges.Rd | 13 +- man/readSamples.Rd | 14 +- man/readTable.Rd | 27 - man/referenceSets.Rd | 18 - man/references.Rd | 18 - man/serverInfo.Rd | 13 +- man/show.Rd | 12 +- man/showPHGMethods.Rd | 21 +- 47 files changed, 942 insertions(+), 1034 deletions(-) delete mode 100644 R/brapi_getters_setters.R delete mode 100644 R/brapi_methods.R create mode 100644 R/class_phg_con_local.R rename R/{brapi_classes.R => class_phg_con_server.R} (62%) rename R/{classes.R => class_phg_dataset.R} (100%) create mode 100644 R/class_phg_method.R rename R/{brapi_defunct.R => deprecated_brapi.R} (100%) rename R/{brapi_utilities.R => utilities_brapi.R} (100%) rename R/{utilities.R => utilities_general.R} (56%) create mode 100644 man/PHGLocalCon-class.Rd create mode 100644 man/PHGLocalCon-validity.Rd create mode 100644 man/PHGLocalCon.Rd delete mode 100644 man/availablePHGMethods.Rd create mode 100644 man/brapiVersion.Rd delete mode 100644 man/createConfigFile.Rd delete mode 100644 man/filterRefRanges.Rd delete mode 100644 man/filterSamples.Rd delete mode 100644 man/hapIDMatrix.Rd create mode 100644 man/host.Rd create mode 100644 man/port.Rd create mode 100644 man/readHaplotypeIds.Rd create mode 100644 man/readPHGDataSet.Rd delete mode 100644 man/readPHGDatasetFromBrapi.Rd delete mode 100644 man/readTable.Rd delete mode 100644 man/referenceSets.Rd delete mode 100644 man/references.Rd diff --git a/DESCRIPTION b/DESCRIPTION index fba28f0..be9d594 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: rPHG -Version: 0.1.18 +Version: 0.1.19 Date: 2019-06-03 Title: R front-end for the practical haplotype graph Authors@R: c( diff --git a/NAMESPACE b/NAMESPACE index b807844..5ce343b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,25 +1,26 @@ # Generated by roxygen2: do not edit by hand export(BrapiCon) +export(PHGLocalCon) export(PHGMethod) -export(availablePHGMethods) export(brapiURL) +export(brapiVersion) export(getVTList) export(graphBuilder) +export(host) export(numHaploPerRange) export(pathsForMethod) export(plotGraph) export(plotMutualInfo) export(plotNumHaplo) +export(port) +export(readHaplotypeIds) export(readMappingTableInfo) export(readMappingsForLineName) -export(readPHGDatasetFromBrapi) +export(readPHGDataSet) export(readRefRanges) export(readSamples) -export(readTable) export(refRangeTable) -export(referenceSets) -export(references) export(searchRecombination) export(searchSimilarGametes) export(serverInfo) @@ -29,17 +30,16 @@ export(taxaByNode) exportClasses(BrapiCon) exportClasses(BrapiConPHG) exportClasses(PHGDataSet) -exportMethods(availablePHGMethods) +exportClasses(PHGLocalCon) exportMethods(brapiURL) -exportMethods(readPHGDatasetFromBrapi) +exportMethods(host) +exportMethods(readHaplotypeIds) +exportMethods(readPHGDataSet) exportMethods(readRefRanges) exportMethods(readSamples) -exportMethods(readTable) -exportMethods(referenceSets) -exportMethods(references) exportMethods(serverInfo) +exportMethods(showPHGMethods) import(ggplot2) -importFrom(GenomeInfoDb,dropSeqlevels) importFrom(GenomicRanges,GRanges) importFrom(IRanges,IRanges) importFrom(IRanges,subsetByOverlaps) @@ -66,7 +66,6 @@ importFrom(methods,new) importFrom(methods,setClass) importFrom(parallel,mclapply) importFrom(rJava,.jcall) -importFrom(rJava,.jcast) importFrom(rJava,.jevalArray) importFrom(rJava,.jnew) importFrom(rJava,.jnull) diff --git a/R/brapi_getters_setters.R b/R/brapi_getters_setters.R deleted file mode 100644 index b88cec3..0000000 --- a/R/brapi_getters_setters.R +++ /dev/null @@ -1,37 +0,0 @@ -# === BrAPI getters and setters (maybe) ============================= - -## BrAPI URL ---- -#' @title The URL of a \code{BrapiCon} object -#' -#' @description get or set the Uniform Resource Locator (URL) of a -#' \code{BrapiCon} object. -#' -#' @param x a \linkS4class{BrapiCon} object. -#' -#' @rdname brapiURL -#' -#' @export -setGeneric("brapiURL", function(x) standardGeneric("brapiURL")) - -#' @rdname brapiURL -#' @export -setMethod("brapiURL", signature = c(x = "BrapiCon"), function(x) return(x@url)) - - - -setGeneric("host", function(x) standardGeneric("host")) -setMethod("host", signature("BrapiCon"), function(x) x@host) - -setGeneric("port", function(x) standardGeneric("port")) -setMethod("port", signature = "BrapiCon", function(x) x@port) - -setGeneric("protocol", function(x) standardGeneric("protocol")) -setMethod("protocol", signature = "BrapiCon", function(x) x@protocol) - -setGeneric("version", function(x) standardGeneric("version")) -setMethod("version", signature = "BrapiCon", function(x) x@version) - -setGeneric("token", function(x) standardGeneric("token")) -setMethod("token", signature = "BrapiCon", function(x) x@token) - - diff --git a/R/brapi_methods.R b/R/brapi_methods.R deleted file mode 100644 index ac0b27e..0000000 --- a/R/brapi_methods.R +++ /dev/null @@ -1,585 +0,0 @@ -##################################################################### -## -## Overview: -## This file houses methods and generics related to `BrapiCon` and -## `BrapiConPHG` classes -## -##################################################################### - -# === BrapiCon general methods ====================================== - -## ---- -#' @title Show method for BrapiCon objects -#' -#' @description Prints out the information from the BrAPI connection object -#' including server status codes. See this -#' \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} -#' for further details about what these codes mean. -#' -#' @param object a \code{\linkS4class{BrapiCon}} object. -#' -#' @docType methods -#' @name show -#' @rdname show -#' @aliases show show,BrapiCon-method -setMethod( - f = "show", - signature = "BrapiCon", - definition = function(object) { - - status <- tryCatch( - expr = { - httr::GET(paste0(brapiURL(object), "/serverinfo"))$status - }, - error = function(cond) "ERROR" - ) - - if (is.numeric(status) && status >= 200 && status <= 299) { - statusMsg <- "(OK)" - } else { - statusMsg <- "" - } - - # cat("A BrAPI connection object\n") - # cat(" Server...........:", host(object), "\n") - # cat(" Port.............:", port(object), "\n") - # cat(" Server status....:", status, statusMsg, "\n") - # cat(" BrAPI version....:", version(object), "\n") - - pointerSymbol <- cli::col_green(cli::symbol$pointer) - msg <- c( - paste0("A ", cli::style_bold("BrAPI"), " connection object"), - paste0(" ", pointerSymbol, " Server...........: ", host(object)), - paste0(" ", pointerSymbol, " Port.............: ", port(object)), - paste0(" ", pointerSymbol, " Server status....: ", statusMsg), - paste0(" ", pointerSymbol, " BrAPI version....: ", version(object)) - ) - - cat(msg, sep = "\n") - } -) - - -## ---- -#' @title Retrieve server info data from BrAPI connection -#' -#' @description Retrieves data from the \code{serverinfo} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname serverInfo -#' -#' @export -setGeneric("serverInfo", function(object) standardGeneric("serverInfo")) - -#' @rdname serverInfo -#' @export -setMethod( - f = "serverInfo", - signature = "BrapiCon", - definition = function(object) { - json2tibble(object, "serverinfo", "calls") - } -) - - -## ---- -#' @title Retrieve reference data from BrAPI connection -#' -#' @description Retrieves data from the \code{references} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname references -#' -#' @export -setGeneric("references", function(object) standardGeneric("references")) - -#' @rdname references -#' @export -setMethod( - f = "references", - signature = "BrapiCon", - definition = function(object) { - json2tibble(object, "references") - } -) - - -## ---- -#' @title Retrieve reference set data from BrAPI connection -#' -#' @description Retrieves data from the \code{referenceSets} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname referenceSets -#' -#' @export -setGeneric("referenceSets", function(object) standardGeneric("referenceSets")) - -#' @rdname referenceSets -#' @export -setMethod( - f = "referenceSets", - signature = "BrapiCon", - definition = function(object) { - json2tibble(object, "referencesets") - } -) - - -## ---- -#' @title Retrieve available PHG method data from BrAPI connection -#' -#' @description Retrieves data from the \code{variantTables} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname availablePHGMethods -#' -#' @export -setGeneric("availablePHGMethods", function(object) standardGeneric("availablePHGMethods")) - -#' @rdname availablePHGMethods -#' @export -setMethod( - f = "availablePHGMethods", - signature = "BrapiCon", - definition = function(object) { - ## Temp fix to return proper methods - fullTable <- json2tibble(object, "variantTables") - filtTable <- fullTable[fullTable$numSamples > 100, ] # arbitrary n - return(filtTable) - } -) - - - - - -# === BrapiConPHG general methods =================================== - -## ---- -#' @title Show method for BrapiConPHG objects -#' -#' @description Prints out the information from the BrAPI connection object -#' including server status codes. See this -#' \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} -#' for further details about what these codes mean. -#' -#' @param object a \code{\linkS4class{BrapiConPHG}} object. -#' -#' @docType methods -#' @name show -#' @rdname show -#' @aliases show show,BrapiConPHG-method -setMethod( - f = "show", - signature = "BrapiConPHG", - definition = function(object) { - # cli::cli_div(theme = list(ul = list(`margin-left` = 2, before = ""))) - - # activeSlotMsg <- cli::symbol$square_small_filled - # inactiveSlotMsg <- cli::symbol$square_small - activeSlotMsg <- "[x]" - inactiveSlotMsg <- "[ ]" - - rrCheck <- ifelse( - test = is.na(object@refRangeFilter), - yes = inactiveSlotMsg, - no = activeSlotMsg - ) - sampleCheck <- ifelse( - test = is.na(object@sampleFilter), - yes = inactiveSlotMsg, - no = activeSlotMsg - ) - - cat(" PHG pointer object>\n") - cat(" method: ", object@methodID, "\n") - cat(" variant filter: ", rrCheck, "\n") - cat(" sample filter: ", sampleCheck, "\n") - } -) - - -## ---- -#' @title Filter reference ranges from given PHG method -#' -#' @description Filters reference ranges for a given PHG method by -#' manipulation of BrAPI samples URL call. For a given query, reference -#' ranges will be returned if they overlap with a user-defined range. -#' Uses 1-based coordinate information. -#' -#' @param x A \code{BrapiConPHG} object. -#' @param gr A \code{GRanges} object. Houses genomic range information for -#' filter. -#' @param chromosome A vector of chromosome ids of type \code{character}. Can -#' be of length one to size \code{n}. If used, this will return all reference -#' ranges within a given chromosome. -#' @param start A vector of start positions of type \code{numeric}. If used, -#' an equal number of \code{end} elements will be needed to avoid error. -#' @param end A vector of end positions of type \code{numeric}. These will -#' link up with the \code{start} positions. Must be equal to the \code{start} -#' parameter. -#' -#' @importFrom GenomeInfoDb dropSeqlevels -#' -# #' @export -filterRefRanges <- function( - x, - gr = NULL, - chromosome = NULL, - start = NULL, - end = NULL -) { - if (class(x) != "BrapiConPHG") { - stop("A `BrapiConPHG` object is needed for the LHS argument", call. = FALSE) - } - - if (!is.null(gr)) { - if (inherits(gr, "GRanges")) { - if (is.null(chromosome)) { - grDF <- as.data.frame(gr) - seqString <- paste0( - grDF$seqnames, ":", - grDF$start, "-", grDF$end, - collapse = "," - ) - rrString <- paste0("ranges=", seqString) - } else { - grSub <- GenomeInfoDb::dropSeqlevels(gr, chromosome, pruning.mode = "coarse") - grDF <- as.data.frame(grSub) - seqStringGR <- paste0( - grDF$seqnames, ":", - grDF$start, "-", grDF$end, - collapse = "," - ) - seqStringChr <- paste0(chromosome, collapse = ",") - rrString <- paste0("ranges=", seqStringChr, ",", seqStringGR) - } - - } else { - stop("Not a valid GRanges object", call. = FALSE) - } - } else { - if (!is.null(chromosome) && is.null(start) && is.null(end)) { - rrString <- paste0("ranges=", paste0(chromosome, collapse = ",")) - } else if (!is.null(chromosome) && !is.null(start) && !is.null(end)) { - if (length(unique(sapply(list(chromosome, start, end), length))) == 1) { - seqString <- paste0( - chromosome, ":", - start, "-", end, - collapse = "," - ) - rrString <- paste0("ranges=", seqString) - } else { - stop("Range vectors do not have the same length", call. = FALSE) - } - } else { - stop("Incorrect filtration parameters", call. = FALSE) - } - } - - # Add filter on `refRangeFilter` slot - x@refRangeFilter <- rrString - - return(x) -} - - -## ---- -#' @title Filter samples from given PHG method -#' -#' @description Filters samples for a given PHG method by manipulation of BrAPI -#' samples URL call. Returns exact matches only. If query is not exact match, -#' no data will be returned for that given sample. -#' -#' @param x A \code{BrapiConPHG} object. -#' @param samples A vector of taxa ID of type \code{character}. -#' -# #' @export -filterSamples <- function(x, samples) { - if (class(x) != "BrapiConPHG") { - stop("A `BrapiConPHG` object is needed for the LHS argument", call. = FALSE) - } - - if (is.vector(samples) && is.atomic(samples)) { - sampleString <- paste0("sampleNames=", paste0(samples, collapse = ",")) - } else { - stop("`samples` argument must be an atomic vector", call. = FALSE) - } - - x@sampleFilter <- sampleString - - return(x) -} - - -## ---- -#' @title Retrieve available ref range data from a given PHG method -#' -#' @description Retrieves reference range information from a given PHG method. -#' Data returned is (1) chromosome, (2) start, and (3) stop coordinates. -#' -#' @param object A \code{BrapiConPHG} object. -#' -#' @rdname readRefRanges -#' -#' @export -setGeneric("readRefRanges", function(object) standardGeneric("readRefRanges")) - -#' @rdname readRefRanges -#' -#' @importFrom GenomicRanges GRanges -#' @importFrom IRanges IRanges -#' @importFrom rJava .jevalArray -#' @importFrom rJava .jnew -#' -#' @export -setMethod( - f = "readRefRanges", - signature = "BrapiConPHG", - definition = function(object) { - urls <- getVTList(object) - - # rJC <- rJava::.jnew("net/maizegenetics/pangenome/api/RMethodsKotlin") - # rrArray <- rJC$getRefRangesFromBrapi( - # urls$rangeURL, - # as.integer(1000) - # ) - # rrArray <- rJava::.jevalArray(rrArray, simplify = TRUE) - - pageSize <- ifelse( - grepl("variants$", urls$rangeURL), - "?pageSize=", - "&pageSize=" - ) - - if (object@methodID == "DEMO") { - rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "1000")) - } else { - rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "150000")) - } - rrDF <- rrDF$result$data - - gr <- GenomicRanges::GRanges( - seqnames = rrDF$referenceName, - ranges = IRanges::IRanges( - start = rrDF$start, - end = rrDF$end - ), - variantDbId = rrDF$variantDbId - ) - - return(gr) - - } -) - - -## ---- -#' @title Retrieve available sample data from a given PHG method -#' -#' @description Retrieves sample information from a given PHG method. -#' Data returned is (1) sample name, (2) sample DB ID, (3) description, -#' and (4) additional information. -#' -#' @param object A \code{BrapiConPHG} object. -#' -#' @rdname readSamples -#' -#' @export -setGeneric("readSamples", function(object) standardGeneric("readSamples")) - -#' @rdname readSamples -#' -#' @importFrom tibble as_tibble -#' -#' @export -setMethod( - f = "readSamples", - signature = "BrapiConPHG", - definition = function(object) { - urls <- getVTList(object) - - sampleDF <- parseJSON(urls$sampleURL) - sampleDF <- sampleDF$result$data - - if (object@methodID == "DEMO") { - return(utils::head(tibble::as_tibble(sampleDF), n = 25)) - } else{ - return(tibble::as_tibble(sampleDF)) - } - } -) - - -## ---- -#' @title Retrieve available table data from a given PHG method -#' -#' @description Retrieves table information from a given PHG method. -#' Data returned is a \code{matrix} object. -#' -#' @param object A \code{BrapiConPHG} object. -#' @param ... Additional arguments to be passed. -#' -#' @rdname readTable -#' -#' @export -setGeneric("readTable", function(object, ...) { - standardGeneric("readTable") -}) - -#' @rdname readTable -#' -#' @param numCores Number of processing cores for faster processing times. -#' @param transpose Do you want to transpose table? -#' -#' @importFrom cli cli_progress_bar -#' @importFrom cli cli_progress_done -#' @importFrom cli cli_progress_step -#' @importFrom cli cli_progress_update -#' @importFrom httr content -#' @importFrom httr GET -#' @importFrom jsonlite fromJSON -#' @importFrom parallel mclapply -#' -#' @export -setMethod( - f = "readTable", - signature = "BrapiConPHG", - definition = function(object, numCores = NULL, transpose = TRUE) { - # Logic checks - if (is.null(numCores)) { - numCores <- 1 - } - if (!is.numeric(numCores)) { - stop("numCores parameter must be numeric or NULL") - } - - # Get URLs - urls <- getVTList(object) - - # Calculate total pages - - if (object@methodID == "DEMO") { - totalVariants <- 1000 - totalPages <- ceiling(totalVariants / 250) - } else { - methods <- availablePHGMethods(object) - totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants - totalPages <- ceiling(totalVariants / 10000) - } - - # Download each page (iterative) - # TODO - can we async this? (e.g. futures) - allResp <- vector("list", totalPages) - # cli::cli_progress_step("Establishing connection") - message("Establishing connection") - # cli::cli_progress_bar(" - Downloading: ", total = totalPages) - message("Downloading:") - pb <- utils::txtProgressBar( - style = 3, - char = "=", - min = 1, - max = totalPages - ) - for (i in seq_len(totalPages)) { - currentUrl <- sprintf(urls$tableURL, i - 1, 0) - allResp[[i]] <- httr::GET(currentUrl) - utils::setTxtProgressBar(pb, i) - # cli::cli_progress_update() - } - close(pb) - # cli::cli_progress_done() - - # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) - brapiHapIdStringToInt <- function(x) { - id <- strsplit(x, "/")[[1]][1] - ifelse(id == ".", return(NA), return(as.integer(id))) - } - - # F2 - process matrix slices (convert from JSON to int matrix) - processMatrix <- function(x) { - xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") - xNew <- jsonlite::fromJSON(xNew) - xMat <- xNew$result$dataMatrices$dataMatrix[[1]] - colnames(xMat) <- xNew$result$callSetDbIds - rownames(xMat) <- xNew$result$variants - xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) - return(xMat) - } - - # Clean up data (parallel) - # cli::cli_progress_step("Cleaning data") - message("Cleaning data") - finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) - - # Bind all data into one matrix and return - # cli::cli_progress_step("Combining responses") - message("Combining responses") - if (transpose) { - unionMatrix <- t(do.call(rbind, finalMatrices)) - } else { - unionMatrix <- do.call(rbind, finalMatrices) - } - - return(unionMatrix) - } -) - - -## ---- -#' @title Read PHGDataset object from BrAPI PHG method -#' -#' @description Creates a \code{PHGDataset} object by reading sample, -#' reference range, and feature data information. -#' -#' @param object A \code{BrapiConPHG} object. -#' @param ... Additional arguments to be passed. -#' -#' @rdname readPHGDatasetFromBrapi -#' -#' @export -setGeneric("readPHGDatasetFromBrapi", function(object, ...) { - standardGeneric("readPHGDatasetFromBrapi") -}) - -#' @rdname readTable -#' -#' @export -setMethod( - f = "readPHGDatasetFromBrapi", - signature = "BrapiConPHG", - definition = function(object, ...) { - - urls <- getVTList(object) - - hapArray <- readTable(object, transpose = FALSE) - - # cli::cli_progress_step("Getting ref range data") - message("Getting ref range data") - rr <- readRefRanges(object) - # cli::cli_progress_step("Getting sample data") - message("Getting sample data") - samples <- readSamples(object) - - colnames(hapArray) <- samples$sampleName - - phgSE <- SummarizedExperiment::SummarizedExperiment( - assays = list(hapID = hapArray), - rowRanges = rr, - colData = samples - ) - - return(methods::new(Class = "PHGDataSet", phgSE)) - } -) - - diff --git a/R/class_all_generics.R b/R/class_all_generics.R index e69de29..271dbdd 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -0,0 +1,146 @@ +## ---- +#' @title Return URL path +#' +#' @description +#' Returns the Uniform Resource Locator (URL) of a \code{BrapiCon} object. +#' +#' @param object a \code{\linkS4class{BrapiCon}} object. +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname brapiURL +#' @export +setGeneric("brapiURL", function(object, ...) standardGeneric("brapiURL")) + + +## ---- +#' @title Return host data +#' +#' @description +#' Returns the host information for a given object +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname host +#' @export +setGeneric("host", function(object, ...) standardGeneric("host")) + + +## ---- +#' @title Return port value +#' +#' @description +#' Returns the port information for a given object +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname port +#' @export +setGeneric("port", function(object, ...) standardGeneric("port")) + + +## ---- +#' @title Return BrAPI version ID +#' +#' @description +#' Returns the version ID for a BrAPI-compliant PHG server +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname brapiVersion +#' @export +setGeneric("brapiVersion", function(object, ...) standardGeneric("brapiVersion")) + + +## ---- +#' @title Return available PHG methods +#' +#' @description +#' Returns a collection of available PHG methods and metadata +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname showPHGMethods +#' @export +setGeneric("showPHGMethods", function(object, ...) standardGeneric("showPHGMethods")) + + +## ---- +#' @title Return server information +#' +#' @description +#' Get avaiable BrAPI calls from BrAPI compliant PHG server +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname serverInfo +#' @export +setGeneric("serverInfo", function(object, ...) standardGeneric("serverInfo")) + + +## ---- +#' @title Return reference ranges +#' +#' @description +#' Get reference range data for a given PHG method +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readRefRanges +#' @export +setGeneric("readRefRanges", function(object, ...) standardGeneric("readRefRanges")) + + +## ---- +#' @title Return samples IDs +#' +#' @description +#' Gets sample ID data for a given PHG method +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readSamples +#' @export +setGeneric("readSamples", function(object, ...) standardGeneric("readSamples")) + + +## ---- +#' @title Return haplotype IDs +#' +#' @description +#' Gets haplotype ID for given samples and reference ranges for PHG method +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readHaplotypeIds +#' @export +setGeneric("readHaplotypeIds", function(object, ...) standardGeneric("readHaplotypeIds")) + + +## ---- +#' @title Return a PHGDataSet +#' +#' @description +#' Creates a \code{\linkS4class{PHGDataSet}} for a given PHG method. This will +#' return all 3 primary sources of data (samples, reference ranges, and +#' haplotype IDs). +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readPHGDataSet +#' @export +setGeneric("readPHGDataSet", function(object, ...) standardGeneric("readPHGDataSet")) + + + + + + diff --git a/R/class_phg_con_local.R b/R/class_phg_con_local.R new file mode 100644 index 0000000..7f2ab6c --- /dev/null +++ b/R/class_phg_con_local.R @@ -0,0 +1,129 @@ +## ---- +#' @title A PHGLocalCon Class +#' +#' @description +#' Class \code{PHGLocalCon} defines a \code{rPHG} class for storing +#' local config file data. +#' +#' @slot host Location path of local SQLite or Postgres database +#' @slot dbName Name of database +#' @slot dbType Type of database +#' @slot configFilePath Path to configuration file +#' +#' @name PHGLocalCon-class +#' @rdname PHGLocalCon-class +#' @exportClass PHGLocalCon +setClass( + Class = "PHGLocalCon", + representation = representation( + host = "character", + dbName = "character", + dbType = "character", + configFilePath = "character" + ), + prototype = prototype( + host = NA_character_, + dbName = NA_character_, + dbType = NA_character_, + configFilePath = NA_character_ + ) +) + + +## ---- +#' @title PHGLocalCon validation +#' +#' @name PHGLocalCon-validity +#' +#' @description +#' Checks for correct data entry into \code{PHGLocalCon} class +#' +#' @param object A \code{\linkS4class{PHGLocalCon}} object +setValidity("PHGLocalCon", function(object) { + errors <- character() + + if (!file.exists(object@configFilePath)) { + msg <- "Path to config file does not exist" + errors <- c(errors, msg) + } + + if (length(errors) == 0) { + return(TRUE) + } else { + return(errors) + } +}) + + +## ---- +#' @title Show methods for PHGLocalCon objects +#' +#' @description +#' Prints out information regarding properties from the \code{PHGLocalCon} +#' class to the console +#' +#' @param object A \code{\linkS4class{PHGLocalCon}} object +#' +#' @docType methods +#' @rdname PHGLocalCon-class +#' @aliases show,PHGLocalCon-method +setMethod( + f = "show", + signature = "PHGLocalCon", + definition = function(object) { + pointerSymbol <- cli::col_green(cli::symbol$pointer) + msg <- c( + paste0("A ", cli::style_bold("PHGLocalCon"), " connection object"), + paste0(" ", pointerSymbol, " Host......: ", object@host), + paste0(" ", pointerSymbol, " DB Name...: ", object@dbName), + paste0(" ", pointerSymbol, " DB Type...: ", object@dbType) + ) + + cat(msg, sep = "\n") + } +) + + +## ---- +#' @title Helper functio to construct a \code{PHGLocalCon} object +#' +#' @description +#' Creates a \code{\linkS4class{PHGLocalCon}} object to be used to read PHG +#' DB data for a given set of PHG-related methods. +#' +#' @param file A path to a PHG configuration file +#' +#' @export +PHGLocalCon <- function(file) { + configCatcher(file) + + configProperties <- parseConfigFile(file) + + methods::new( + Class = "PHGLocalCon", + host = configProperties$host, + dbName = configProperties$DB |> basename(), + dbType = configProperties$DBtype, + configFilePath = normalizePath(file) + ) +} + + + + + + + + + + + + + + + + + + + + diff --git a/R/brapi_classes.R b/R/class_phg_con_server.R similarity index 62% rename from R/brapi_classes.R rename to R/class_phg_con_server.R index 5bd812d..8746c47 100644 --- a/R/brapi_classes.R +++ b/R/class_phg_con_server.R @@ -1,16 +1,4 @@ -##################################################################### -## -## Overview: -## This file houses BrAPI-related functions for: -## * Class representation -## * Validity checking classes -## * Class instantiation (e.g. helper functions) -## -##################################################################### - - -# === BrapiCon Class ================================================ - +## ---- #' @title An S4 BrapiCon Class #' #' @description Class \code{BrapiCon} defines a \code{rPHG} @@ -49,6 +37,7 @@ setClass( ) +## ---- #' @title BrAPI connection validation #' #' @name BrapiCon-validity @@ -89,6 +78,7 @@ setValidity("BrapiCon", function(object) { }) +## ---- #' @title BrapiCon object and constructors #' #' @description \code{BrapiCon} is the primary container for housing BrAPI @@ -105,10 +95,12 @@ setValidity("BrapiCon", function(object) { #' @return A \code{BrapiCon} object. #' #' @export -BrapiCon <- function(host, - port = NULL, - protocol = c("http", "https"), - version = c("v2", "v1")) { +BrapiCon <- function( + host, + port = NULL, + protocol = c("http", "https"), + version = c("v2", "v1") +) { if (missing(host)) stop("A URL host is needed to make this class.") @@ -133,59 +125,54 @@ BrapiCon <- function(host, } +## ---- +#' @rdname brapiURL +#' @export +setMethod( + f = "brapiURL", + signature = signature(object = "BrapiCon"), + definition = function(object) { + return(object@url) + } +) - -# === BrapiConPHG Class ============================================= +## ---- +#' @rdname host +#' @export +setMethod( + f = "host", + signature = signature(object = "BrapiCon"), + definition = function(object) { + return(object@host) + } +) -#' @title An S4 BrapiConPHG Class -#' -#' @description Class \code{BrapiConPHG} defines a \code{rPHG} -#' Class for storing BrAPI connection data plust PHG coordinate info. -#' -#' @slot methodID A PHG method identifier. -#' @slot refRangeFilter Reference range selection URL parameters. -#' @slot sampleFilter Sample / taxa selection URL parameters. -#' -#' @name BrapiConPHG-class -#' @rdname BrapiConPHG-class -#' @exportClass BrapiConPHG -setClass( - Class = "BrapiConPHG", - contains = "BrapiCon", - slots = c( - methodID = "character", - refRangeFilter = "character", - sampleFilter = "character" - ), - prototype = list( - methodID = NA_character_, - refRangeFilter = NA_character_, - sampleFilter = NA_character_ - ) +## ---- +#' @rdname serverInfo +#' @export +setMethod( + f = "serverInfo", + signature = signature(object = "BrapiCon"), + definition = function(object) { + json2tibble(object, "serverinfo", "calls") + } ) -#' @title Helper function to construct BrapiConPHG object -#' -#' @description Creates a \code{BrapiConPHG} object to be used to read and -#' filter data from a given BrAPI endpoint given a verified PHG method. -#' -#' @param brapiObj A \code{BrapiCon} object. -#' @param x A PHG method identifier. -#' +## ---- +#' @rdname showPHGMethods #' @export -PHGMethod <- function(brapiObj, x) { - - # For demo purposes only! - # if (x == "DEMO") x <- "NAM_GBS_Alignments_PATHS" - - methods::new( - "BrapiConPHG", - brapiObj, - methodID = x - ) -} +setMethod( + f = "showPHGMethods", + signature = signature(object = "BrapiCon"), + definition = function(object) { + ## Temp fix to return proper methods + fullTable <- json2tibble(object, "variantTables") + filtTable <- fullTable[fullTable$numSamples > 100, ] # arbitrary n + return(filtTable) + } +) diff --git a/R/classes.R b/R/class_phg_dataset.R similarity index 100% rename from R/classes.R rename to R/class_phg_dataset.R diff --git a/R/class_phg_method.R b/R/class_phg_method.R new file mode 100644 index 0000000..57615cc --- /dev/null +++ b/R/class_phg_method.R @@ -0,0 +1,295 @@ +## ---- +#' @title An S4 BrapiConPHG Class +#' +#' @description Class \code{BrapiConPHG} defines a \code{rPHG} +#' Class for storing BrAPI connection data plust PHG coordinate info. +#' +#' @slot methodID A PHG method identifier. +#' @slot refRangeFilter Reference range selection URL parameters. +#' @slot sampleFilter Sample / taxa selection URL parameters. +#' +#' @name BrapiConPHG-class +#' @rdname BrapiConPHG-class +#' @exportClass BrapiConPHG +setClass( + Class = "BrapiConPHG", + contains = "BrapiCon", + slots = c( + methodID = "character", + refRangeFilter = "character", + sampleFilter = "character" + ), + prototype = list( + methodID = NA_character_, + refRangeFilter = NA_character_, + sampleFilter = NA_character_ + ) +) + + +## ---- +#' @title Helper function to construct BrapiConPHG object +#' +#' @description Creates a \code{BrapiConPHG} object to be used to read and +#' filter data from a given BrAPI endpoint given a verified PHG method. +#' +#' @param brapiObj A \code{BrapiCon} object. +#' @param x A PHG method identifier. +#' +#' @export +PHGMethod <- function(brapiObj, x) { + + # For demo purposes only! + # if (x == "DEMO") x <- "NAM_GBS_Alignments_PATHS" + + methods::new( + "BrapiConPHG", + brapiObj, + methodID = x + ) +} + + +## ---- +#' @title Show method for BrapiConPHG objects +#' +#' @description Prints out the information from the BrAPI connection object +#' including server status codes. See this +#' \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} +#' for further details about what these codes mean. +#' +#' @param object a \code{\linkS4class{BrapiConPHG}} object. +#' +#' @docType methods +#' @name show +#' @rdname show +#' @aliases show,BrapiConPHG-method +setMethod( + f = "show", + signature = "BrapiConPHG", + definition = function(object) { + # cli::cli_div(theme = list(ul = list(`margin-left` = 2, before = ""))) + + # activeSlotMsg <- cli::symbol$square_small_filled + # inactiveSlotMsg <- cli::symbol$square_small + activeSlotMsg <- "[x]" + inactiveSlotMsg <- "[ ]" + + rrCheck <- ifelse( + test = is.na(object@refRangeFilter), + yes = inactiveSlotMsg, + no = activeSlotMsg + ) + sampleCheck <- ifelse( + test = is.na(object@sampleFilter), + yes = inactiveSlotMsg, + no = activeSlotMsg + ) + + cat(" PHG pointer object>\n") + cat(" method: ", object@methodID, "\n") + cat(" variant filter: ", rrCheck, "\n") + cat(" sample filter: ", sampleCheck, "\n") + } +) + + +## ---- +#' @rdname readRefRanges +#' +#' @importFrom GenomicRanges GRanges +#' @importFrom IRanges IRanges +#' @importFrom rJava .jevalArray +#' @importFrom rJava .jnew +#' +#' @export +setMethod( + f = "readRefRanges", + signature = "BrapiConPHG", + definition = function(object) { + urls <- getVTList(object) + + pageSize <- ifelse( + grepl("variants$", urls$rangeURL), + "?pageSize=", + "&pageSize=" + ) + + if (object@methodID == "DEMO") { + rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "1000")) + } else { + rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "150000")) + } + rrDF <- rrDF$result$data + + gr <- GenomicRanges::GRanges( + seqnames = rrDF$referenceName, + ranges = IRanges::IRanges( + start = rrDF$start, + end = rrDF$end + ), + variantDbId = rrDF$variantDbId + ) + + return(gr) + + } +) + + +## ---- +#' @rdname readSamples +#' +#' @importFrom tibble as_tibble +#' +#' @export +setMethod( + f = "readSamples", + signature = "BrapiConPHG", + definition = function(object) { + urls <- getVTList(object) + + sampleDF <- parseJSON(urls$sampleURL) + sampleDF <- sampleDF$result$data + + if (object@methodID == "DEMO") { + return(utils::head(tibble::as_tibble(sampleDF), n = 25)) + } else{ + return(tibble::as_tibble(sampleDF)) + } + } +) + + +## ---- +#' @rdname readHaplotypeIds +#' +#' @param numCores Number of processing cores for faster processing times. +#' @param transpose Do you want to transpose table? +#' +#' @importFrom cli cli_progress_bar +#' @importFrom cli cli_progress_done +#' @importFrom cli cli_progress_step +#' @importFrom cli cli_progress_update +#' @importFrom httr content +#' @importFrom httr GET +#' @importFrom jsonlite fromJSON +#' @importFrom parallel mclapply +#' +#' @export +setMethod( + f = "readHaplotypeIds", + signature = "BrapiConPHG", + definition = function(object, numCores = NULL, transpose = TRUE) { + # Logic checks + if (is.null(numCores)) { + numCores <- 1 + } + if (!is.numeric(numCores)) { + stop("numCores parameter must be numeric or NULL") + } + + # Get URLs + urls <- getVTList(object) + + # Calculate total pages + + if (object@methodID == "DEMO") { + totalVariants <- 1000 + totalPages <- ceiling(totalVariants / 250) + } else { + methods <- availablePHGMethods(object) + totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants + totalPages <- ceiling(totalVariants / 10000) + } + + # Download each page (iterative) + # TODO - can we async this? (e.g. futures) + allResp <- vector("list", totalPages) + # cli::cli_progress_step("Establishing connection") + message("Establishing connection") + # cli::cli_progress_bar(" - Downloading: ", total = totalPages) + message("Downloading:") + pb <- utils::txtProgressBar( + style = 3, + char = "=", + min = 1, + max = totalPages + ) + for (i in seq_len(totalPages)) { + currentUrl <- sprintf(urls$tableURL, i - 1, 0) + allResp[[i]] <- httr::GET(currentUrl) + utils::setTxtProgressBar(pb, i) + # cli::cli_progress_update() + } + close(pb) + # cli::cli_progress_done() + + # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) + brapiHapIdStringToInt <- function(x) { + id <- strsplit(x, "/")[[1]][1] + ifelse(id == ".", return(NA), return(as.integer(id))) + } + + # F2 - process matrix slices (convert from JSON to int matrix) + processMatrix <- function(x) { + xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") + xNew <- jsonlite::fromJSON(xNew) + xMat <- xNew$result$dataMatrices$dataMatrix[[1]] + colnames(xMat) <- xNew$result$callSetDbIds + rownames(xMat) <- xNew$result$variants + xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) + return(xMat) + } + + # Clean up data (parallel) + # cli::cli_progress_step("Cleaning data") + message("Cleaning data") + finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) + + # Bind all data into one matrix and return + # cli::cli_progress_step("Combining responses") + message("Combining responses") + if (transpose) { + unionMatrix <- t(do.call(rbind, finalMatrices)) + } else { + unionMatrix <- do.call(rbind, finalMatrices) + } + + return(unionMatrix) + } +) + + +## ---- +#' @rdname readPHGDataSet +#' +#' @export +setMethod( + f = "readPHGDataSet", + signature = "BrapiConPHG", + definition = function(object, ...) { + + urls <- getVTList(object) + + hapArray <- readTable(object, transpose = FALSE) + + # cli::cli_progress_step("Getting ref range data") + message("Getting ref range data") + rr <- readRefRanges(object) + # cli::cli_progress_step("Getting sample data") + message("Getting sample data") + samples <- readSamples(object) + + colnames(hapArray) <- samples$sampleName + + phgSE <- SummarizedExperiment::SummarizedExperiment( + assays = list(hapID = hapArray), + rowRanges = rr, + colData = samples + ) + + return(methods::new(Class = "PHGDataSet", phgSE)) + } +) + diff --git a/R/brapi_defunct.R b/R/deprecated_brapi.R similarity index 100% rename from R/brapi_defunct.R rename to R/deprecated_brapi.R diff --git a/R/show_phg_methods.R b/R/show_phg_methods.R index ccc6102..79aad91 100644 --- a/R/show_phg_methods.R +++ b/R/show_phg_methods.R @@ -1,58 +1,59 @@ -#' @title Get DB PHG methods for graph building -#' -#' @description Gets all available PHG methods from the graph database -#' using a path parameter to the database configuration file. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' -#' @importFrom rJava .jcast -#' @importFrom rJava .jnull -#' @importFrom rJava J -#' @importFrom rJava new -#' @importFrom tibble tibble -#' -#' @export -showPHGMethods <- function(configFile) { - - configCatcher(configFile) - - ## Get table report plugin and pull data from DB - plugin <- rJava::new( - rJava::J("net/maizegenetics/pangenome/api/MethodTableReportPlugin") - ) - plugin <- plugin$configFile(configFile) - ds <- plugin$performFunction( - rJava::.jnull("net/maizegenetics/plugindef/DataSet") - ) - datum <- ds$getData(0L) - tabRep <- rJava::.jcast( - datum$getData(), - new.class = "net/maizegenetics/util/TableReport" - ) - resultVectors <- rJava::J( - "net/maizegenetics/plugindef/GenerateRCode", - "tableReportToVectors", - tabRep - ) - - ## Get data vectors - data <- resultVectors$dataVector - - ## Convert to native R data frame - dfMethods <- tibble::tibble( - data$get(0L), - data$get(1L), - data$get(2L), - data$get(3L), - data$get(4L) - ) - - ## Convert names - names(dfMethods) <- resultVectors$columnNames - - ## Return object - return(dfMethods) -} +## #' @title Get DB PHG methods for graph building +## #' +## #' @description Gets all available PHG methods from the graph database +## #' using a path parameter to the database configuration file. +## #' +## #' @author Brandon Monier +## #' @author Peter Bradbury +## #' +## #' @param configFile Path to a configuration file for your graph database. +## #' +## #' @importFrom rJava .jcast +## #' @importFrom rJava .jnull +## #' @importFrom rJava J +## #' @importFrom rJava new +## #' @importFrom tibble tibble +## #' +## #' @export +## showPHGMethods <- function(configFile) { +## +## configCatcher(configFile) +## +## ## Get table report plugin and pull data from DB +## plugin <- rJava::new( +## rJava::J("net/maizegenetics/pangenome/api/MethodTableReportPlugin") +## ) +## plugin <- plugin$configFile(configFile) +## ds <- plugin$performFunction( +## rJava::.jnull("net/maizegenetics/plugindef/DataSet") +## ) +## datum <- ds$getData(0L) +## tabRep <- rJava::.jcast( +## datum$getData(), +## new.class = "net/maizegenetics/util/TableReport" +## ) +## resultVectors <- rJava::J( +## "net/maizegenetics/plugindef/GenerateRCode", +## "tableReportToVectors", +## tabRep +## ) +## +## ## Get data vectors +## data <- resultVectors$dataVector +## +## ## Convert to native R data frame +## dfMethods <- tibble::tibble( +## data$get(0L), +## data$get(1L), +## data$get(2L), +## data$get(3L), +## data$get(4L) +## ) +## +## ## Convert names +## names(dfMethods) <- resultVectors$columnNames +## +## ## Return object +## return(dfMethods) +## } +## \ No newline at end of file diff --git a/R/brapi_utilities.R b/R/utilities_brapi.R similarity index 100% rename from R/brapi_utilities.R rename to R/utilities_brapi.R diff --git a/R/utilities.R b/R/utilities_general.R similarity index 56% rename from R/utilities.R rename to R/utilities_general.R index 38d2f8b..4cf2064 100644 --- a/R/utilities.R +++ b/R/utilities_general.R @@ -1,18 +1,18 @@ # === Miscellaneous utilities for rPHG methods ====================== ## ---- -#' @title Create mock config file -#' -#' @description Creates a temporary PHG configuration file to access the -#' provided example database. Mainly for debugging and educational -#' purposes. -#' -#' @param file User defined output file -#' @param host Host service for database -#' @param user User ID for database access -#' @param password Password for database access -#' @param dbType Database architecture used -#' @param dbPath P +# @title Create mock config file +# +# @description Creates a temporary PHG configuration file to access the +# provided example database. Mainly for debugging and educational +# purposes. +# +# @param file User defined output file +# @param host Host service for database +# @param user User ID for database access +# @param password Password for database access +# @param dbType Database architecture used +# @param dbPath Path to DB createConfigFile <- function( file, host = "localhost", @@ -42,11 +42,11 @@ createConfigFile <- function( ## ---- -#' @title Logic support for config files -#' -#' @description Provides logic checking for config files used in PHG creation. -#' -#' @param configFile Path to a configuration file for your graph database. +# @title Logic support for config files +# +# @description Provides logic checking for config files used in PHG creation. +# +# @param configFile Path to a configuration file for your graph database. configCatcher <- function(configFile) { if (!file.exists(configFile)) { @@ -78,3 +78,32 @@ configCatcher <- function(configFile) { } +## ---- +# Parse components of config file into a list object +# +# @param file Path to a configuration file for database +parseConfigFile <- function(file) { + FIELDS <- c("host", "DB", "DBtype") + conLines <- readLines(file) + + properties <- vapply(FIELDS, \(x) getProperty(conLines, x), character(1)) + + return(setNames(as.list(properties), FIELDS)) +} + + +## ---- +# Get property from config file field +# +# @param configLines A character vector of config lines +# @param x A field value +getProperty <- function(configLines, x) { + regexField <- paste0("^", x, "=") + + property <- configLines[grepl(regexField, configLines)] |> + gsub("^.*=", "", x = _) + + return(property) +} + + diff --git a/inst/extdata/configSQLite.txt b/inst/extdata/configSQLite.txt index b9cdf79..33c2e74 100644 --- a/inst/extdata/configSQLite.txt +++ b/inst/extdata/configSQLite.txt @@ -1,7 +1,7 @@ host=localHost user=sqlite password=sqlite -DB=/home/bm646/Projects/rphg/inst/extdata/phgSmallSeq.db +DB=inst/extdata/phg_smallseq_test.db DBtype=sqlite minTaxa=1 minSites=5 diff --git a/man/BrapiCon-class.Rd b/man/BrapiCon-class.Rd index 28075a3..7cbc30d 100644 --- a/man/BrapiCon-class.Rd +++ b/man/BrapiCon-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_con_server.R \docType{class} \name{BrapiCon-class} \alias{BrapiCon-class} diff --git a/man/BrapiCon-validity.Rd b/man/BrapiCon-validity.Rd index b993c1f..69d85d4 100644 --- a/man/BrapiCon-validity.Rd +++ b/man/BrapiCon-validity.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_con_server.R \name{BrapiCon-validity} \alias{BrapiCon-validity} \title{BrAPI connection validation} diff --git a/man/BrapiCon.Rd b/man/BrapiCon.Rd index 07ac943..ccb199a 100644 --- a/man/BrapiCon.Rd +++ b/man/BrapiCon.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_con_server.R \name{BrapiCon} \alias{BrapiCon} \title{BrapiCon object and constructors} diff --git a/man/BrapiConPHG-class.Rd b/man/BrapiConPHG-class.Rd index dbfd7ff..d92b979 100644 --- a/man/BrapiConPHG-class.Rd +++ b/man/BrapiConPHG-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_method.R \docType{class} \name{BrapiConPHG-class} \alias{BrapiConPHG-class} diff --git a/man/PHGDataSet-class.Rd b/man/PHGDataSet-class.Rd index ef54fa4..801d37d 100644 --- a/man/PHGDataSet-class.Rd +++ b/man/PHGDataSet-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/classes.R +% Please edit documentation in R/class_phg_dataset.R \docType{class} \name{PHGDataSet-class} \alias{PHGDataSet-class} diff --git a/man/PHGLocalCon-class.Rd b/man/PHGLocalCon-class.Rd new file mode 100644 index 0000000..11f4387 --- /dev/null +++ b/man/PHGLocalCon-class.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con_local.R +\docType{class} +\name{PHGLocalCon-class} +\alias{PHGLocalCon-class} +\alias{show,PHGLocalCon-method} +\title{A PHGLocalCon Class} +\usage{ +\S4method{show}{PHGLocalCon}(object) +} +\arguments{ +\item{object}{A \code{\linkS4class{PHGLocalCon}} object} +} +\description{ +Class \code{PHGLocalCon} defines a \code{rPHG} class for storing +local config file data. + +Prints out information regarding properties from the \code{PHGLocalCon} +class to the console +} +\section{Slots}{ + +\describe{ +\item{\code{host}}{Location path of local SQLite or Postgres database} + +\item{\code{dbName}}{Name of database} + +\item{\code{dbType}}{Type of database} + +\item{\code{configFilePath}}{Path to configuration file} +}} + diff --git a/man/PHGLocalCon-validity.Rd b/man/PHGLocalCon-validity.Rd new file mode 100644 index 0000000..839485d --- /dev/null +++ b/man/PHGLocalCon-validity.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con_local.R +\name{PHGLocalCon-validity} +\alias{PHGLocalCon-validity} +\title{PHGLocalCon validation} +\arguments{ +\item{object}{A \code{\linkS4class{PHGLocalCon}} object} +} +\description{ +Checks for correct data entry into \code{PHGLocalCon} class +} diff --git a/man/PHGLocalCon.Rd b/man/PHGLocalCon.Rd new file mode 100644 index 0000000..e5b015d --- /dev/null +++ b/man/PHGLocalCon.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con_local.R +\name{PHGLocalCon} +\alias{PHGLocalCon} +\title{Helper functio to construct a \code{PHGLocalCon} object} +\usage{ +PHGLocalCon(file) +} +\arguments{ +\item{file}{A path to a PHG configuration file} +} +\description{ +Creates a \code{\linkS4class{PHGLocalCon}} object to be used to read PHG +DB data for a given set of PHG-related methods. +} diff --git a/man/PHGMethod.Rd b/man/PHGMethod.Rd index fcad91e..093c083 100644 --- a/man/PHGMethod.Rd +++ b/man/PHGMethod.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_method.R \name{PHGMethod} \alias{PHGMethod} \title{Helper function to construct BrapiConPHG object} diff --git a/man/availablePHGMethods.Rd b/man/availablePHGMethods.Rd deleted file mode 100644 index e776eb6..0000000 --- a/man/availablePHGMethods.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{availablePHGMethods} -\alias{availablePHGMethods} -\alias{availablePHGMethods,BrapiCon-method} -\title{Retrieve available PHG method data from BrAPI connection} -\usage{ -availablePHGMethods(object) - -\S4method{availablePHGMethods}{BrapiCon}(object) -} -\arguments{ -\item{object}{A \code{BrapiCon} object.} -} -\description{ -Retrieves data from the \code{variantTables} endpoint of a BrAPI - server. -} diff --git a/man/brapiURL.Rd b/man/brapiURL.Rd index 9b8197c..137c66b 100644 --- a/man/brapiURL.Rd +++ b/man/brapiURL.Rd @@ -1,18 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_getters_setters.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{brapiURL} \alias{brapiURL} \alias{brapiURL,BrapiCon-method} -\title{The URL of a \code{BrapiCon} object} +\title{Return URL path} \usage{ -brapiURL(x) +brapiURL(object, ...) -\S4method{brapiURL}{BrapiCon}(x) +\S4method{brapiURL}{BrapiCon}(object) } \arguments{ -\item{x}{a \linkS4class{BrapiCon} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object.} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -get or set the Uniform Resource Locator (URL) of a - \code{BrapiCon} object. +Returns the Uniform Resource Locator (URL) of a \code{BrapiCon} object. } diff --git a/man/brapiVersion.Rd b/man/brapiVersion.Rd new file mode 100644 index 0000000..7902db9 --- /dev/null +++ b/man/brapiVersion.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R +\name{brapiVersion} +\alias{brapiVersion} +\title{Return BrAPI version ID} +\usage{ +brapiVersion(object, ...) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the version ID for a BrAPI-compliant PHG server +} diff --git a/man/configCatcher.Rd b/man/configCatcher.Rd index 2bf00ad..7c01149 100644 --- a/man/configCatcher.Rd +++ b/man/configCatcher.Rd @@ -1,19 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/logic_support.R, R/utilities.R +% Please edit documentation in R/logic_support.R \name{configCatcher} \alias{configCatcher} \title{Logic support for config files} \usage{ -configCatcher(configFile) - configCatcher(configFile) } \arguments{ \item{configFile}{Path to a configuration file for your graph database.} } \description{ -Provides logic checking for config files used in PHG creation. - Provides logic checking for config files used in PHG creation. } \author{ diff --git a/man/createConfigFile.Rd b/man/createConfigFile.Rd deleted file mode 100644 index e62dda2..0000000 --- a/man/createConfigFile.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities.R -\name{createConfigFile} -\alias{createConfigFile} -\title{Create mock config file} -\usage{ -createConfigFile( - file, - host = "localhost", - user = "user", - password = "sqlite", - dbType = "sqlite", - dbPath = NULL -) -} -\arguments{ -\item{file}{User defined output file} - -\item{host}{Host service for database} - -\item{user}{User ID for database access} - -\item{password}{Password for database access} - -\item{dbType}{Database architecture used} - -\item{dbPath}{P} -} -\description{ -Creates a temporary PHG configuration file to access the - provided example database. Mainly for debugging and educational - purposes. -} diff --git a/man/filterRefRanges.Rd b/man/filterRefRanges.Rd deleted file mode 100644 index 0ef9fa3..0000000 --- a/man/filterRefRanges.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{filterRefRanges} -\alias{filterRefRanges} -\title{Filter reference ranges from given PHG method} -\usage{ -filterRefRanges(x, gr = NULL, chromosome = NULL, start = NULL, end = NULL) -} -\arguments{ -\item{x}{A \code{BrapiConPHG} object.} - -\item{gr}{A \code{GRanges} object. Houses genomic range information for -filter.} - -\item{chromosome}{A vector of chromosome ids of type \code{character}. Can -be of length one to size \code{n}. If used, this will return all reference -ranges within a given chromosome.} - -\item{start}{A vector of start positions of type \code{numeric}. If used, -an equal number of \code{end} elements will be needed to avoid error.} - -\item{end}{A vector of end positions of type \code{numeric}. These will -link up with the \code{start} positions. Must be equal to the \code{start} -parameter.} -} -\description{ -Filters reference ranges for a given PHG method by - manipulation of BrAPI samples URL call. For a given query, reference - ranges will be returned if they overlap with a user-defined range. - Uses 1-based coordinate information. -} diff --git a/man/filterSamples.Rd b/man/filterSamples.Rd deleted file mode 100644 index 20c862f..0000000 --- a/man/filterSamples.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{filterSamples} -\alias{filterSamples} -\title{Filter samples from given PHG method} -\usage{ -filterSamples(x, samples) -} -\arguments{ -\item{x}{A \code{BrapiConPHG} object.} - -\item{samples}{A vector of taxa ID of type \code{character}.} -} -\description{ -Filters samples for a given PHG method by manipulation of BrAPI - samples URL call. Returns exact matches only. If query is not exact match, - no data will be returned for that given sample. -} diff --git a/man/getVTList.Rd b/man/getVTList.Rd index df9ceae..94dde7a 100644 --- a/man/getVTList.Rd +++ b/man/getVTList.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_utilities.R +% Please edit documentation in R/utilities_brapi.R \name{getVTList} \alias{getVTList} \title{Retrieve variant table BrAPI URLs} diff --git a/man/hapIDMatrix.Rd b/man/hapIDMatrix.Rd deleted file mode 100644 index 5f24304..0000000 --- a/man/hapIDMatrix.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hap_id_matrix.R -\name{hapIDMatrix} -\alias{hapIDMatrix} -\title{Generate a haplotype ID matrix} -\usage{ -hapIDMatrix(phgObject) -} -\arguments{ -\item{phgObject}{A PHG object.} -} -\description{ -Generates a haplotype ID matrix from a PHG object. -} -\author{ -Brandon Monier - -Peter Bradbury -} diff --git a/man/host.Rd b/man/host.Rd new file mode 100644 index 0000000..e2a1e14 --- /dev/null +++ b/man/host.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R +\name{host} +\alias{host} +\alias{host,BrapiCon-method} +\title{Return host data} +\usage{ +host(object, ...) + +\S4method{host}{BrapiCon}(object) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the host information for a given object +} diff --git a/man/json2tibble.Rd b/man/json2tibble.Rd index bb2aa4b..f2bdfba 100644 --- a/man/json2tibble.Rd +++ b/man/json2tibble.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_utilities.R +% Please edit documentation in R/utilities_brapi.R \name{json2tibble} \alias{json2tibble} \title{JSON to tibble converter} diff --git a/man/parseJSON.Rd b/man/parseJSON.Rd index eec53a0..1b5357d 100644 --- a/man/parseJSON.Rd +++ b/man/parseJSON.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_utilities.R +% Please edit documentation in R/utilities_brapi.R \name{parseJSON} \alias{parseJSON} \title{URL checker} diff --git a/man/port.Rd b/man/port.Rd new file mode 100644 index 0000000..54879e7 --- /dev/null +++ b/man/port.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R +\name{port} +\alias{port} +\title{Return port value} +\usage{ +port(object, ...) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the port information for a given object +} diff --git a/man/readHaplotypeIds.Rd b/man/readHaplotypeIds.Rd new file mode 100644 index 0000000..05f9f76 --- /dev/null +++ b/man/readHaplotypeIds.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +\name{readHaplotypeIds} +\alias{readHaplotypeIds} +\alias{readHaplotypeIds,BrapiConPHG-method} +\title{Return haplotype IDs} +\usage{ +readHaplotypeIds(object, ...) + +\S4method{readHaplotypeIds}{BrapiConPHG}(object, numCores = NULL, transpose = TRUE) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} + +\item{numCores}{Number of processing cores for faster processing times.} + +\item{transpose}{Do you want to transpose table?} +} +\description{ +Gets haplotype ID for given samples and reference ranges for PHG method +} diff --git a/man/readPHGDataSet.Rd b/man/readPHGDataSet.Rd new file mode 100644 index 0000000..f69458d --- /dev/null +++ b/man/readPHGDataSet.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +\name{readPHGDataSet} +\alias{readPHGDataSet} +\alias{readPHGDataSet,BrapiConPHG-method} +\title{Return a PHGDataSet} +\usage{ +readPHGDataSet(object, ...) + +\S4method{readPHGDataSet}{BrapiConPHG}(object, ...) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Creates a \code{\linkS4class{PHGDataSet}} for a given PHG method. This will +return all 3 primary sources of data (samples, reference ranges, and +haplotype IDs). +} diff --git a/man/readPHGDatasetFromBrapi.Rd b/man/readPHGDatasetFromBrapi.Rd deleted file mode 100644 index c8423a5..0000000 --- a/man/readPHGDatasetFromBrapi.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{readPHGDatasetFromBrapi} -\alias{readPHGDatasetFromBrapi} -\title{Read PHGDataset object from BrAPI PHG method} -\usage{ -readPHGDatasetFromBrapi(object, ...) -} -\arguments{ -\item{object}{A \code{BrapiConPHG} object.} - -\item{...}{Additional arguments to be passed.} -} -\description{ -Creates a \code{PHGDataset} object by reading sample, - reference range, and feature data information. -} diff --git a/man/readRefRanges.Rd b/man/readRefRanges.Rd index 7544428..d572bd3 100644 --- a/man/readRefRanges.Rd +++ b/man/readRefRanges.Rd @@ -1,18 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R \name{readRefRanges} \alias{readRefRanges} \alias{readRefRanges,BrapiConPHG-method} -\title{Retrieve available ref range data from a given PHG method} +\title{Return reference ranges} \usage{ -readRefRanges(object) +readRefRanges(object, ...) \S4method{readRefRanges}{BrapiConPHG}(object) } \arguments{ -\item{object}{A \code{BrapiConPHG} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Retrieves reference range information from a given PHG method. - Data returned is (1) chromosome, (2) start, and (3) stop coordinates. +Get reference range data for a given PHG method } diff --git a/man/readSamples.Rd b/man/readSamples.Rd index 5d35031..5c045db 100644 --- a/man/readSamples.Rd +++ b/man/readSamples.Rd @@ -1,19 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R \name{readSamples} \alias{readSamples} \alias{readSamples,BrapiConPHG-method} -\title{Retrieve available sample data from a given PHG method} +\title{Return samples IDs} \usage{ -readSamples(object) +readSamples(object, ...) \S4method{readSamples}{BrapiConPHG}(object) } \arguments{ -\item{object}{A \code{BrapiConPHG} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Retrieves sample information from a given PHG method. - Data returned is (1) sample name, (2) sample DB ID, (3) description, - and (4) additional information. +Gets sample ID data for a given PHG method } diff --git a/man/readTable.Rd b/man/readTable.Rd deleted file mode 100644 index 2e6980d..0000000 --- a/man/readTable.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{readTable} -\alias{readTable} -\alias{readTable,BrapiConPHG-method} -\alias{readPHGDatasetFromBrapi,BrapiConPHG-method} -\title{Retrieve available table data from a given PHG method} -\usage{ -readTable(object, ...) - -\S4method{readTable}{BrapiConPHG}(object, numCores = NULL, transpose = TRUE) - -\S4method{readPHGDatasetFromBrapi}{BrapiConPHG}(object, ...) -} -\arguments{ -\item{object}{A \code{BrapiConPHG} object.} - -\item{...}{Additional arguments to be passed.} - -\item{numCores}{Number of processing cores for faster processing times.} - -\item{transpose}{Do you want to transpose table?} -} -\description{ -Retrieves table information from a given PHG method. - Data returned is a \code{matrix} object. -} diff --git a/man/referenceSets.Rd b/man/referenceSets.Rd deleted file mode 100644 index c165324..0000000 --- a/man/referenceSets.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{referenceSets} -\alias{referenceSets} -\alias{referenceSets,BrapiCon-method} -\title{Retrieve reference set data from BrAPI connection} -\usage{ -referenceSets(object) - -\S4method{referenceSets}{BrapiCon}(object) -} -\arguments{ -\item{object}{A \code{BrapiCon} object.} -} -\description{ -Retrieves data from the \code{referenceSets} endpoint of a BrAPI - server. -} diff --git a/man/references.Rd b/man/references.Rd deleted file mode 100644 index b6819a5..0000000 --- a/man/references.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{references} -\alias{references} -\alias{references,BrapiCon-method} -\title{Retrieve reference data from BrAPI connection} -\usage{ -references(object) - -\S4method{references}{BrapiCon}(object) -} -\arguments{ -\item{object}{A \code{BrapiCon} object.} -} -\description{ -Retrieves data from the \code{references} endpoint of a BrAPI - server. -} diff --git a/man/serverInfo.Rd b/man/serverInfo.Rd index 54b5e17..b1f7055 100644 --- a/man/serverInfo.Rd +++ b/man/serverInfo.Rd @@ -1,18 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{serverInfo} \alias{serverInfo} \alias{serverInfo,BrapiCon-method} -\title{Retrieve server info data from BrAPI connection} +\title{Return server information} \usage{ -serverInfo(object) +serverInfo(object, ...) \S4method{serverInfo}{BrapiCon}(object) } \arguments{ -\item{object}{A \code{BrapiCon} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Retrieves data from the \code{serverinfo} endpoint of a BrAPI - server. +Get avaiable BrAPI calls from BrAPI compliant PHG server } diff --git a/man/show.Rd b/man/show.Rd index 6e95b1e..bfbc86e 100644 --- a/man/show.Rd +++ b/man/show.Rd @@ -1,25 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_phg_method.R \docType{methods} \name{show} \alias{show} -\alias{show,BrapiCon-method} \alias{show,BrapiConPHG-method} -\title{Show method for BrapiCon objects} +\title{Show method for BrapiConPHG objects} \usage{ -\S4method{show}{BrapiCon}(object) - \S4method{show}{BrapiConPHG}(object) } \arguments{ \item{object}{a \code{\linkS4class{BrapiConPHG}} object.} } \description{ -Prints out the information from the BrAPI connection object - including server status codes. See this - \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} - for further details about what these codes mean. - Prints out the information from the BrAPI connection object including server status codes. See this \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} diff --git a/man/showPHGMethods.Rd b/man/showPHGMethods.Rd index 542d7f9..261bfa0 100644 --- a/man/showPHGMethods.Rd +++ b/man/showPHGMethods.Rd @@ -1,20 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/show_phg_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{showPHGMethods} \alias{showPHGMethods} -\title{Get DB PHG methods for graph building} +\alias{showPHGMethods,BrapiCon-method} +\title{Return available PHG methods} \usage{ -showPHGMethods(configFile) +showPHGMethods(object, ...) + +\S4method{showPHGMethods}{BrapiCon}(object) } \arguments{ -\item{configFile}{Path to a configuration file for your graph database.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Gets all available PHG methods from the graph database - using a path parameter to the database configuration file. -} -\author{ -Brandon Monier - -Peter Bradbury +Returns a collection of available PHG methods and metadata } From 1b955e3feaa2bc2cdd2687d171bde84b8d71fdb9 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 28 Jul 2023 11:29:23 -0400 Subject: [PATCH 05/35] Initial commit --- R/class_all_generics.R | 0 R/hap_id_matrix.R | 23 ++++++++++++----------- 2 files changed, 12 insertions(+), 11 deletions(-) create mode 100644 R/class_all_generics.R diff --git a/R/class_all_generics.R b/R/class_all_generics.R new file mode 100644 index 0000000..e69de29 diff --git a/R/hap_id_matrix.R b/R/hap_id_matrix.R index caff00b..8331e8e 100644 --- a/R/hap_id_matrix.R +++ b/R/hap_id_matrix.R @@ -1,14 +1,15 @@ -#' @title Generate a haplotype ID matrix -#' -#' @description Generates a haplotype ID matrix from a PHG object. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param phgObject A PHG object. -#' -#' @importFrom rJava is.jnull -#' @importFrom rJava J +## ---- +# @title Generate a haplotype ID matrix +# +# @description Generates a haplotype ID matrix from a PHG object. +# +# @author Brandon Monier +# @author Peter Bradbury +# +# @param phgObject A PHG object. +# +# @importFrom rJava is.jnull +# @importFrom rJava J hapIDMatrix <- function(phgObject) { ## Pull hap ID matrix from phg object From 877ad2b2de543edd4ed608fa4e9dca6fdbb255c6 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 4 Aug 2023 17:23:09 -0400 Subject: [PATCH 06/35] Update console output --- R/brapi_methods.R | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/R/brapi_methods.R b/R/brapi_methods.R index 1298635..ad967c2 100644 --- a/R/brapi_methods.R +++ b/R/brapi_methods.R @@ -40,20 +40,21 @@ setMethod( statusMsg <- "" } - cat("A BrAPI connection object\n") - cat(" Server...........:", host(object), "\n") - cat(" Port.............:", port(object), "\n") - cat(" Server status....:", status, statusMsg, "\n") - cat(" BrAPI version....:", version(object), "\n") + # cat("A BrAPI connection object\n") + # cat(" Server...........:", host(object), "\n") + # cat(" Port.............:", port(object), "\n") + # cat(" Server status....:", status, statusMsg, "\n") + # cat(" BrAPI version....:", version(object), "\n") + + msg <- c( + paste0("A ", cli::style_bold("BrAPI"), " connection object"), + paste0(" ", cli::col_green(cli::symbol$pointer), " Server...........: ", host(object)), + paste0(" ", cli::col_green(cli::symbol$pointer), " Port.............: ", port(object)), + paste0(" ", cli::col_green(cli::symbol$pointer), " Server status....: ", statusMsg), + paste0(" ", cli::col_green(cli::symbol$pointer), " BrAPI version....: ", version(object)) + ) - # cli::cli_div(theme = list(ul = list(`margin-left` = 2, before = ""))) - # cli::cli_text("A {.strong BrAPI} connection object") - # cli::cli_ul(id = "foo") - # cli::cli_li("{.field Server}...........: {.url {host(object)}}") - # cli::cli_li("{.field Port}.............: { {port(object)} }") - # cli::cli_li("{.field Server status}....: { statusMsg }") - # cli::cli_li("{.field BrAPI version}....: { {version(object)} }") - # cli::cli_end(id = "foo") + cat(msg, sep = "\n") } ) From 9343b61b77145973df25106a17e4e98158dd62d4 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 4 Aug 2023 17:25:35 -0400 Subject: [PATCH 07/35] Add variable --- R/brapi_methods.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/brapi_methods.R b/R/brapi_methods.R index ad967c2..ac0b27e 100644 --- a/R/brapi_methods.R +++ b/R/brapi_methods.R @@ -46,12 +46,13 @@ setMethod( # cat(" Server status....:", status, statusMsg, "\n") # cat(" BrAPI version....:", version(object), "\n") + pointerSymbol <- cli::col_green(cli::symbol$pointer) msg <- c( paste0("A ", cli::style_bold("BrAPI"), " connection object"), - paste0(" ", cli::col_green(cli::symbol$pointer), " Server...........: ", host(object)), - paste0(" ", cli::col_green(cli::symbol$pointer), " Port.............: ", port(object)), - paste0(" ", cli::col_green(cli::symbol$pointer), " Server status....: ", statusMsg), - paste0(" ", cli::col_green(cli::symbol$pointer), " BrAPI version....: ", version(object)) + paste0(" ", pointerSymbol, " Server...........: ", host(object)), + paste0(" ", pointerSymbol, " Port.............: ", port(object)), + paste0(" ", pointerSymbol, " Server status....: ", statusMsg), + paste0(" ", pointerSymbol, " BrAPI version....: ", version(object)) ) cat(msg, sep = "\n") From 82320ae4561e1c2cfcd561cf21e10128f841e481 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 11 Aug 2023 16:15:06 -0400 Subject: [PATCH 08/35] Reorganize classes and generics --- DESCRIPTION | 2 +- NAMESPACE | 23 +- R/brapi_getters_setters.R | 37 -- R/brapi_methods.R | 585 ------------------ R/class_all_generics.R | 146 +++++ R/class_phg_con_local.R | 129 ++++ R/{brapi_classes.R => class_phg_con_server.R} | 113 ++-- R/{classes.R => class_phg_dataset.R} | 0 R/class_phg_method.R | 295 +++++++++ R/{brapi_defunct.R => deprecated_brapi.R} | 0 R/show_phg_methods.R | 117 ++-- R/{brapi_utilities.R => utilities_brapi.R} | 0 R/{utilities.R => utilities_general.R} | 63 +- inst/extdata/configSQLite.txt | 2 +- man/BrapiCon-class.Rd | 2 +- man/BrapiCon-validity.Rd | 2 +- man/BrapiCon.Rd | 2 +- man/BrapiConPHG-class.Rd | 2 +- man/PHGDataSet-class.Rd | 2 +- man/PHGLocalCon-class.Rd | 32 + man/PHGLocalCon-validity.Rd | 11 + man/PHGLocalCon.Rd | 15 + man/PHGMethod.Rd | 2 +- man/availablePHGMethods.Rd | 18 - man/brapiURL.Rd | 15 +- man/brapiVersion.Rd | 16 + man/configCatcher.Rd | 6 +- man/createConfigFile.Rd | 33 - man/filterRefRanges.Rd | 31 - man/filterSamples.Rd | 18 - man/getVTList.Rd | 2 +- man/hapIDMatrix.Rd | 19 - man/host.Rd | 19 + man/json2tibble.Rd | 2 +- man/parseJSON.Rd | 2 +- man/port.Rd | 16 + man/readHaplotypeIds.Rd | 23 + man/readPHGDataSet.Rd | 21 + man/readPHGDatasetFromBrapi.Rd | 17 - man/readRefRanges.Rd | 13 +- man/readSamples.Rd | 14 +- man/readTable.Rd | 27 - man/referenceSets.Rd | 18 - man/references.Rd | 18 - man/serverInfo.Rd | 13 +- man/show.Rd | 12 +- man/showPHGMethods.Rd | 21 +- 47 files changed, 942 insertions(+), 1034 deletions(-) delete mode 100644 R/brapi_getters_setters.R delete mode 100644 R/brapi_methods.R create mode 100644 R/class_phg_con_local.R rename R/{brapi_classes.R => class_phg_con_server.R} (62%) rename R/{classes.R => class_phg_dataset.R} (100%) create mode 100644 R/class_phg_method.R rename R/{brapi_defunct.R => deprecated_brapi.R} (100%) rename R/{brapi_utilities.R => utilities_brapi.R} (100%) rename R/{utilities.R => utilities_general.R} (56%) create mode 100644 man/PHGLocalCon-class.Rd create mode 100644 man/PHGLocalCon-validity.Rd create mode 100644 man/PHGLocalCon.Rd delete mode 100644 man/availablePHGMethods.Rd create mode 100644 man/brapiVersion.Rd delete mode 100644 man/createConfigFile.Rd delete mode 100644 man/filterRefRanges.Rd delete mode 100644 man/filterSamples.Rd delete mode 100644 man/hapIDMatrix.Rd create mode 100644 man/host.Rd create mode 100644 man/port.Rd create mode 100644 man/readHaplotypeIds.Rd create mode 100644 man/readPHGDataSet.Rd delete mode 100644 man/readPHGDatasetFromBrapi.Rd delete mode 100644 man/readTable.Rd delete mode 100644 man/referenceSets.Rd delete mode 100644 man/references.Rd diff --git a/DESCRIPTION b/DESCRIPTION index fba28f0..be9d594 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: rPHG -Version: 0.1.18 +Version: 0.1.19 Date: 2019-06-03 Title: R front-end for the practical haplotype graph Authors@R: c( diff --git a/NAMESPACE b/NAMESPACE index b807844..5ce343b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,25 +1,26 @@ # Generated by roxygen2: do not edit by hand export(BrapiCon) +export(PHGLocalCon) export(PHGMethod) -export(availablePHGMethods) export(brapiURL) +export(brapiVersion) export(getVTList) export(graphBuilder) +export(host) export(numHaploPerRange) export(pathsForMethod) export(plotGraph) export(plotMutualInfo) export(plotNumHaplo) +export(port) +export(readHaplotypeIds) export(readMappingTableInfo) export(readMappingsForLineName) -export(readPHGDatasetFromBrapi) +export(readPHGDataSet) export(readRefRanges) export(readSamples) -export(readTable) export(refRangeTable) -export(referenceSets) -export(references) export(searchRecombination) export(searchSimilarGametes) export(serverInfo) @@ -29,17 +30,16 @@ export(taxaByNode) exportClasses(BrapiCon) exportClasses(BrapiConPHG) exportClasses(PHGDataSet) -exportMethods(availablePHGMethods) +exportClasses(PHGLocalCon) exportMethods(brapiURL) -exportMethods(readPHGDatasetFromBrapi) +exportMethods(host) +exportMethods(readHaplotypeIds) +exportMethods(readPHGDataSet) exportMethods(readRefRanges) exportMethods(readSamples) -exportMethods(readTable) -exportMethods(referenceSets) -exportMethods(references) exportMethods(serverInfo) +exportMethods(showPHGMethods) import(ggplot2) -importFrom(GenomeInfoDb,dropSeqlevels) importFrom(GenomicRanges,GRanges) importFrom(IRanges,IRanges) importFrom(IRanges,subsetByOverlaps) @@ -66,7 +66,6 @@ importFrom(methods,new) importFrom(methods,setClass) importFrom(parallel,mclapply) importFrom(rJava,.jcall) -importFrom(rJava,.jcast) importFrom(rJava,.jevalArray) importFrom(rJava,.jnew) importFrom(rJava,.jnull) diff --git a/R/brapi_getters_setters.R b/R/brapi_getters_setters.R deleted file mode 100644 index b88cec3..0000000 --- a/R/brapi_getters_setters.R +++ /dev/null @@ -1,37 +0,0 @@ -# === BrAPI getters and setters (maybe) ============================= - -## BrAPI URL ---- -#' @title The URL of a \code{BrapiCon} object -#' -#' @description get or set the Uniform Resource Locator (URL) of a -#' \code{BrapiCon} object. -#' -#' @param x a \linkS4class{BrapiCon} object. -#' -#' @rdname brapiURL -#' -#' @export -setGeneric("brapiURL", function(x) standardGeneric("brapiURL")) - -#' @rdname brapiURL -#' @export -setMethod("brapiURL", signature = c(x = "BrapiCon"), function(x) return(x@url)) - - - -setGeneric("host", function(x) standardGeneric("host")) -setMethod("host", signature("BrapiCon"), function(x) x@host) - -setGeneric("port", function(x) standardGeneric("port")) -setMethod("port", signature = "BrapiCon", function(x) x@port) - -setGeneric("protocol", function(x) standardGeneric("protocol")) -setMethod("protocol", signature = "BrapiCon", function(x) x@protocol) - -setGeneric("version", function(x) standardGeneric("version")) -setMethod("version", signature = "BrapiCon", function(x) x@version) - -setGeneric("token", function(x) standardGeneric("token")) -setMethod("token", signature = "BrapiCon", function(x) x@token) - - diff --git a/R/brapi_methods.R b/R/brapi_methods.R deleted file mode 100644 index ac0b27e..0000000 --- a/R/brapi_methods.R +++ /dev/null @@ -1,585 +0,0 @@ -##################################################################### -## -## Overview: -## This file houses methods and generics related to `BrapiCon` and -## `BrapiConPHG` classes -## -##################################################################### - -# === BrapiCon general methods ====================================== - -## ---- -#' @title Show method for BrapiCon objects -#' -#' @description Prints out the information from the BrAPI connection object -#' including server status codes. See this -#' \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} -#' for further details about what these codes mean. -#' -#' @param object a \code{\linkS4class{BrapiCon}} object. -#' -#' @docType methods -#' @name show -#' @rdname show -#' @aliases show show,BrapiCon-method -setMethod( - f = "show", - signature = "BrapiCon", - definition = function(object) { - - status <- tryCatch( - expr = { - httr::GET(paste0(brapiURL(object), "/serverinfo"))$status - }, - error = function(cond) "ERROR" - ) - - if (is.numeric(status) && status >= 200 && status <= 299) { - statusMsg <- "(OK)" - } else { - statusMsg <- "" - } - - # cat("A BrAPI connection object\n") - # cat(" Server...........:", host(object), "\n") - # cat(" Port.............:", port(object), "\n") - # cat(" Server status....:", status, statusMsg, "\n") - # cat(" BrAPI version....:", version(object), "\n") - - pointerSymbol <- cli::col_green(cli::symbol$pointer) - msg <- c( - paste0("A ", cli::style_bold("BrAPI"), " connection object"), - paste0(" ", pointerSymbol, " Server...........: ", host(object)), - paste0(" ", pointerSymbol, " Port.............: ", port(object)), - paste0(" ", pointerSymbol, " Server status....: ", statusMsg), - paste0(" ", pointerSymbol, " BrAPI version....: ", version(object)) - ) - - cat(msg, sep = "\n") - } -) - - -## ---- -#' @title Retrieve server info data from BrAPI connection -#' -#' @description Retrieves data from the \code{serverinfo} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname serverInfo -#' -#' @export -setGeneric("serverInfo", function(object) standardGeneric("serverInfo")) - -#' @rdname serverInfo -#' @export -setMethod( - f = "serverInfo", - signature = "BrapiCon", - definition = function(object) { - json2tibble(object, "serverinfo", "calls") - } -) - - -## ---- -#' @title Retrieve reference data from BrAPI connection -#' -#' @description Retrieves data from the \code{references} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname references -#' -#' @export -setGeneric("references", function(object) standardGeneric("references")) - -#' @rdname references -#' @export -setMethod( - f = "references", - signature = "BrapiCon", - definition = function(object) { - json2tibble(object, "references") - } -) - - -## ---- -#' @title Retrieve reference set data from BrAPI connection -#' -#' @description Retrieves data from the \code{referenceSets} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname referenceSets -#' -#' @export -setGeneric("referenceSets", function(object) standardGeneric("referenceSets")) - -#' @rdname referenceSets -#' @export -setMethod( - f = "referenceSets", - signature = "BrapiCon", - definition = function(object) { - json2tibble(object, "referencesets") - } -) - - -## ---- -#' @title Retrieve available PHG method data from BrAPI connection -#' -#' @description Retrieves data from the \code{variantTables} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname availablePHGMethods -#' -#' @export -setGeneric("availablePHGMethods", function(object) standardGeneric("availablePHGMethods")) - -#' @rdname availablePHGMethods -#' @export -setMethod( - f = "availablePHGMethods", - signature = "BrapiCon", - definition = function(object) { - ## Temp fix to return proper methods - fullTable <- json2tibble(object, "variantTables") - filtTable <- fullTable[fullTable$numSamples > 100, ] # arbitrary n - return(filtTable) - } -) - - - - - -# === BrapiConPHG general methods =================================== - -## ---- -#' @title Show method for BrapiConPHG objects -#' -#' @description Prints out the information from the BrAPI connection object -#' including server status codes. See this -#' \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} -#' for further details about what these codes mean. -#' -#' @param object a \code{\linkS4class{BrapiConPHG}} object. -#' -#' @docType methods -#' @name show -#' @rdname show -#' @aliases show show,BrapiConPHG-method -setMethod( - f = "show", - signature = "BrapiConPHG", - definition = function(object) { - # cli::cli_div(theme = list(ul = list(`margin-left` = 2, before = ""))) - - # activeSlotMsg <- cli::symbol$square_small_filled - # inactiveSlotMsg <- cli::symbol$square_small - activeSlotMsg <- "[x]" - inactiveSlotMsg <- "[ ]" - - rrCheck <- ifelse( - test = is.na(object@refRangeFilter), - yes = inactiveSlotMsg, - no = activeSlotMsg - ) - sampleCheck <- ifelse( - test = is.na(object@sampleFilter), - yes = inactiveSlotMsg, - no = activeSlotMsg - ) - - cat(" PHG pointer object>\n") - cat(" method: ", object@methodID, "\n") - cat(" variant filter: ", rrCheck, "\n") - cat(" sample filter: ", sampleCheck, "\n") - } -) - - -## ---- -#' @title Filter reference ranges from given PHG method -#' -#' @description Filters reference ranges for a given PHG method by -#' manipulation of BrAPI samples URL call. For a given query, reference -#' ranges will be returned if they overlap with a user-defined range. -#' Uses 1-based coordinate information. -#' -#' @param x A \code{BrapiConPHG} object. -#' @param gr A \code{GRanges} object. Houses genomic range information for -#' filter. -#' @param chromosome A vector of chromosome ids of type \code{character}. Can -#' be of length one to size \code{n}. If used, this will return all reference -#' ranges within a given chromosome. -#' @param start A vector of start positions of type \code{numeric}. If used, -#' an equal number of \code{end} elements will be needed to avoid error. -#' @param end A vector of end positions of type \code{numeric}. These will -#' link up with the \code{start} positions. Must be equal to the \code{start} -#' parameter. -#' -#' @importFrom GenomeInfoDb dropSeqlevels -#' -# #' @export -filterRefRanges <- function( - x, - gr = NULL, - chromosome = NULL, - start = NULL, - end = NULL -) { - if (class(x) != "BrapiConPHG") { - stop("A `BrapiConPHG` object is needed for the LHS argument", call. = FALSE) - } - - if (!is.null(gr)) { - if (inherits(gr, "GRanges")) { - if (is.null(chromosome)) { - grDF <- as.data.frame(gr) - seqString <- paste0( - grDF$seqnames, ":", - grDF$start, "-", grDF$end, - collapse = "," - ) - rrString <- paste0("ranges=", seqString) - } else { - grSub <- GenomeInfoDb::dropSeqlevels(gr, chromosome, pruning.mode = "coarse") - grDF <- as.data.frame(grSub) - seqStringGR <- paste0( - grDF$seqnames, ":", - grDF$start, "-", grDF$end, - collapse = "," - ) - seqStringChr <- paste0(chromosome, collapse = ",") - rrString <- paste0("ranges=", seqStringChr, ",", seqStringGR) - } - - } else { - stop("Not a valid GRanges object", call. = FALSE) - } - } else { - if (!is.null(chromosome) && is.null(start) && is.null(end)) { - rrString <- paste0("ranges=", paste0(chromosome, collapse = ",")) - } else if (!is.null(chromosome) && !is.null(start) && !is.null(end)) { - if (length(unique(sapply(list(chromosome, start, end), length))) == 1) { - seqString <- paste0( - chromosome, ":", - start, "-", end, - collapse = "," - ) - rrString <- paste0("ranges=", seqString) - } else { - stop("Range vectors do not have the same length", call. = FALSE) - } - } else { - stop("Incorrect filtration parameters", call. = FALSE) - } - } - - # Add filter on `refRangeFilter` slot - x@refRangeFilter <- rrString - - return(x) -} - - -## ---- -#' @title Filter samples from given PHG method -#' -#' @description Filters samples for a given PHG method by manipulation of BrAPI -#' samples URL call. Returns exact matches only. If query is not exact match, -#' no data will be returned for that given sample. -#' -#' @param x A \code{BrapiConPHG} object. -#' @param samples A vector of taxa ID of type \code{character}. -#' -# #' @export -filterSamples <- function(x, samples) { - if (class(x) != "BrapiConPHG") { - stop("A `BrapiConPHG` object is needed for the LHS argument", call. = FALSE) - } - - if (is.vector(samples) && is.atomic(samples)) { - sampleString <- paste0("sampleNames=", paste0(samples, collapse = ",")) - } else { - stop("`samples` argument must be an atomic vector", call. = FALSE) - } - - x@sampleFilter <- sampleString - - return(x) -} - - -## ---- -#' @title Retrieve available ref range data from a given PHG method -#' -#' @description Retrieves reference range information from a given PHG method. -#' Data returned is (1) chromosome, (2) start, and (3) stop coordinates. -#' -#' @param object A \code{BrapiConPHG} object. -#' -#' @rdname readRefRanges -#' -#' @export -setGeneric("readRefRanges", function(object) standardGeneric("readRefRanges")) - -#' @rdname readRefRanges -#' -#' @importFrom GenomicRanges GRanges -#' @importFrom IRanges IRanges -#' @importFrom rJava .jevalArray -#' @importFrom rJava .jnew -#' -#' @export -setMethod( - f = "readRefRanges", - signature = "BrapiConPHG", - definition = function(object) { - urls <- getVTList(object) - - # rJC <- rJava::.jnew("net/maizegenetics/pangenome/api/RMethodsKotlin") - # rrArray <- rJC$getRefRangesFromBrapi( - # urls$rangeURL, - # as.integer(1000) - # ) - # rrArray <- rJava::.jevalArray(rrArray, simplify = TRUE) - - pageSize <- ifelse( - grepl("variants$", urls$rangeURL), - "?pageSize=", - "&pageSize=" - ) - - if (object@methodID == "DEMO") { - rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "1000")) - } else { - rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "150000")) - } - rrDF <- rrDF$result$data - - gr <- GenomicRanges::GRanges( - seqnames = rrDF$referenceName, - ranges = IRanges::IRanges( - start = rrDF$start, - end = rrDF$end - ), - variantDbId = rrDF$variantDbId - ) - - return(gr) - - } -) - - -## ---- -#' @title Retrieve available sample data from a given PHG method -#' -#' @description Retrieves sample information from a given PHG method. -#' Data returned is (1) sample name, (2) sample DB ID, (3) description, -#' and (4) additional information. -#' -#' @param object A \code{BrapiConPHG} object. -#' -#' @rdname readSamples -#' -#' @export -setGeneric("readSamples", function(object) standardGeneric("readSamples")) - -#' @rdname readSamples -#' -#' @importFrom tibble as_tibble -#' -#' @export -setMethod( - f = "readSamples", - signature = "BrapiConPHG", - definition = function(object) { - urls <- getVTList(object) - - sampleDF <- parseJSON(urls$sampleURL) - sampleDF <- sampleDF$result$data - - if (object@methodID == "DEMO") { - return(utils::head(tibble::as_tibble(sampleDF), n = 25)) - } else{ - return(tibble::as_tibble(sampleDF)) - } - } -) - - -## ---- -#' @title Retrieve available table data from a given PHG method -#' -#' @description Retrieves table information from a given PHG method. -#' Data returned is a \code{matrix} object. -#' -#' @param object A \code{BrapiConPHG} object. -#' @param ... Additional arguments to be passed. -#' -#' @rdname readTable -#' -#' @export -setGeneric("readTable", function(object, ...) { - standardGeneric("readTable") -}) - -#' @rdname readTable -#' -#' @param numCores Number of processing cores for faster processing times. -#' @param transpose Do you want to transpose table? -#' -#' @importFrom cli cli_progress_bar -#' @importFrom cli cli_progress_done -#' @importFrom cli cli_progress_step -#' @importFrom cli cli_progress_update -#' @importFrom httr content -#' @importFrom httr GET -#' @importFrom jsonlite fromJSON -#' @importFrom parallel mclapply -#' -#' @export -setMethod( - f = "readTable", - signature = "BrapiConPHG", - definition = function(object, numCores = NULL, transpose = TRUE) { - # Logic checks - if (is.null(numCores)) { - numCores <- 1 - } - if (!is.numeric(numCores)) { - stop("numCores parameter must be numeric or NULL") - } - - # Get URLs - urls <- getVTList(object) - - # Calculate total pages - - if (object@methodID == "DEMO") { - totalVariants <- 1000 - totalPages <- ceiling(totalVariants / 250) - } else { - methods <- availablePHGMethods(object) - totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants - totalPages <- ceiling(totalVariants / 10000) - } - - # Download each page (iterative) - # TODO - can we async this? (e.g. futures) - allResp <- vector("list", totalPages) - # cli::cli_progress_step("Establishing connection") - message("Establishing connection") - # cli::cli_progress_bar(" - Downloading: ", total = totalPages) - message("Downloading:") - pb <- utils::txtProgressBar( - style = 3, - char = "=", - min = 1, - max = totalPages - ) - for (i in seq_len(totalPages)) { - currentUrl <- sprintf(urls$tableURL, i - 1, 0) - allResp[[i]] <- httr::GET(currentUrl) - utils::setTxtProgressBar(pb, i) - # cli::cli_progress_update() - } - close(pb) - # cli::cli_progress_done() - - # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) - brapiHapIdStringToInt <- function(x) { - id <- strsplit(x, "/")[[1]][1] - ifelse(id == ".", return(NA), return(as.integer(id))) - } - - # F2 - process matrix slices (convert from JSON to int matrix) - processMatrix <- function(x) { - xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") - xNew <- jsonlite::fromJSON(xNew) - xMat <- xNew$result$dataMatrices$dataMatrix[[1]] - colnames(xMat) <- xNew$result$callSetDbIds - rownames(xMat) <- xNew$result$variants - xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) - return(xMat) - } - - # Clean up data (parallel) - # cli::cli_progress_step("Cleaning data") - message("Cleaning data") - finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) - - # Bind all data into one matrix and return - # cli::cli_progress_step("Combining responses") - message("Combining responses") - if (transpose) { - unionMatrix <- t(do.call(rbind, finalMatrices)) - } else { - unionMatrix <- do.call(rbind, finalMatrices) - } - - return(unionMatrix) - } -) - - -## ---- -#' @title Read PHGDataset object from BrAPI PHG method -#' -#' @description Creates a \code{PHGDataset} object by reading sample, -#' reference range, and feature data information. -#' -#' @param object A \code{BrapiConPHG} object. -#' @param ... Additional arguments to be passed. -#' -#' @rdname readPHGDatasetFromBrapi -#' -#' @export -setGeneric("readPHGDatasetFromBrapi", function(object, ...) { - standardGeneric("readPHGDatasetFromBrapi") -}) - -#' @rdname readTable -#' -#' @export -setMethod( - f = "readPHGDatasetFromBrapi", - signature = "BrapiConPHG", - definition = function(object, ...) { - - urls <- getVTList(object) - - hapArray <- readTable(object, transpose = FALSE) - - # cli::cli_progress_step("Getting ref range data") - message("Getting ref range data") - rr <- readRefRanges(object) - # cli::cli_progress_step("Getting sample data") - message("Getting sample data") - samples <- readSamples(object) - - colnames(hapArray) <- samples$sampleName - - phgSE <- SummarizedExperiment::SummarizedExperiment( - assays = list(hapID = hapArray), - rowRanges = rr, - colData = samples - ) - - return(methods::new(Class = "PHGDataSet", phgSE)) - } -) - - diff --git a/R/class_all_generics.R b/R/class_all_generics.R index e69de29..271dbdd 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -0,0 +1,146 @@ +## ---- +#' @title Return URL path +#' +#' @description +#' Returns the Uniform Resource Locator (URL) of a \code{BrapiCon} object. +#' +#' @param object a \code{\linkS4class{BrapiCon}} object. +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname brapiURL +#' @export +setGeneric("brapiURL", function(object, ...) standardGeneric("brapiURL")) + + +## ---- +#' @title Return host data +#' +#' @description +#' Returns the host information for a given object +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname host +#' @export +setGeneric("host", function(object, ...) standardGeneric("host")) + + +## ---- +#' @title Return port value +#' +#' @description +#' Returns the port information for a given object +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname port +#' @export +setGeneric("port", function(object, ...) standardGeneric("port")) + + +## ---- +#' @title Return BrAPI version ID +#' +#' @description +#' Returns the version ID for a BrAPI-compliant PHG server +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname brapiVersion +#' @export +setGeneric("brapiVersion", function(object, ...) standardGeneric("brapiVersion")) + + +## ---- +#' @title Return available PHG methods +#' +#' @description +#' Returns a collection of available PHG methods and metadata +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname showPHGMethods +#' @export +setGeneric("showPHGMethods", function(object, ...) standardGeneric("showPHGMethods")) + + +## ---- +#' @title Return server information +#' +#' @description +#' Get avaiable BrAPI calls from BrAPI compliant PHG server +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname serverInfo +#' @export +setGeneric("serverInfo", function(object, ...) standardGeneric("serverInfo")) + + +## ---- +#' @title Return reference ranges +#' +#' @description +#' Get reference range data for a given PHG method +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readRefRanges +#' @export +setGeneric("readRefRanges", function(object, ...) standardGeneric("readRefRanges")) + + +## ---- +#' @title Return samples IDs +#' +#' @description +#' Gets sample ID data for a given PHG method +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readSamples +#' @export +setGeneric("readSamples", function(object, ...) standardGeneric("readSamples")) + + +## ---- +#' @title Return haplotype IDs +#' +#' @description +#' Gets haplotype ID for given samples and reference ranges for PHG method +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readHaplotypeIds +#' @export +setGeneric("readHaplotypeIds", function(object, ...) standardGeneric("readHaplotypeIds")) + + +## ---- +#' @title Return a PHGDataSet +#' +#' @description +#' Creates a \code{\linkS4class{PHGDataSet}} for a given PHG method. This will +#' return all 3 primary sources of data (samples, reference ranges, and +#' haplotype IDs). +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readPHGDataSet +#' @export +setGeneric("readPHGDataSet", function(object, ...) standardGeneric("readPHGDataSet")) + + + + + + diff --git a/R/class_phg_con_local.R b/R/class_phg_con_local.R new file mode 100644 index 0000000..7f2ab6c --- /dev/null +++ b/R/class_phg_con_local.R @@ -0,0 +1,129 @@ +## ---- +#' @title A PHGLocalCon Class +#' +#' @description +#' Class \code{PHGLocalCon} defines a \code{rPHG} class for storing +#' local config file data. +#' +#' @slot host Location path of local SQLite or Postgres database +#' @slot dbName Name of database +#' @slot dbType Type of database +#' @slot configFilePath Path to configuration file +#' +#' @name PHGLocalCon-class +#' @rdname PHGLocalCon-class +#' @exportClass PHGLocalCon +setClass( + Class = "PHGLocalCon", + representation = representation( + host = "character", + dbName = "character", + dbType = "character", + configFilePath = "character" + ), + prototype = prototype( + host = NA_character_, + dbName = NA_character_, + dbType = NA_character_, + configFilePath = NA_character_ + ) +) + + +## ---- +#' @title PHGLocalCon validation +#' +#' @name PHGLocalCon-validity +#' +#' @description +#' Checks for correct data entry into \code{PHGLocalCon} class +#' +#' @param object A \code{\linkS4class{PHGLocalCon}} object +setValidity("PHGLocalCon", function(object) { + errors <- character() + + if (!file.exists(object@configFilePath)) { + msg <- "Path to config file does not exist" + errors <- c(errors, msg) + } + + if (length(errors) == 0) { + return(TRUE) + } else { + return(errors) + } +}) + + +## ---- +#' @title Show methods for PHGLocalCon objects +#' +#' @description +#' Prints out information regarding properties from the \code{PHGLocalCon} +#' class to the console +#' +#' @param object A \code{\linkS4class{PHGLocalCon}} object +#' +#' @docType methods +#' @rdname PHGLocalCon-class +#' @aliases show,PHGLocalCon-method +setMethod( + f = "show", + signature = "PHGLocalCon", + definition = function(object) { + pointerSymbol <- cli::col_green(cli::symbol$pointer) + msg <- c( + paste0("A ", cli::style_bold("PHGLocalCon"), " connection object"), + paste0(" ", pointerSymbol, " Host......: ", object@host), + paste0(" ", pointerSymbol, " DB Name...: ", object@dbName), + paste0(" ", pointerSymbol, " DB Type...: ", object@dbType) + ) + + cat(msg, sep = "\n") + } +) + + +## ---- +#' @title Helper functio to construct a \code{PHGLocalCon} object +#' +#' @description +#' Creates a \code{\linkS4class{PHGLocalCon}} object to be used to read PHG +#' DB data for a given set of PHG-related methods. +#' +#' @param file A path to a PHG configuration file +#' +#' @export +PHGLocalCon <- function(file) { + configCatcher(file) + + configProperties <- parseConfigFile(file) + + methods::new( + Class = "PHGLocalCon", + host = configProperties$host, + dbName = configProperties$DB |> basename(), + dbType = configProperties$DBtype, + configFilePath = normalizePath(file) + ) +} + + + + + + + + + + + + + + + + + + + + diff --git a/R/brapi_classes.R b/R/class_phg_con_server.R similarity index 62% rename from R/brapi_classes.R rename to R/class_phg_con_server.R index 5bd812d..8746c47 100644 --- a/R/brapi_classes.R +++ b/R/class_phg_con_server.R @@ -1,16 +1,4 @@ -##################################################################### -## -## Overview: -## This file houses BrAPI-related functions for: -## * Class representation -## * Validity checking classes -## * Class instantiation (e.g. helper functions) -## -##################################################################### - - -# === BrapiCon Class ================================================ - +## ---- #' @title An S4 BrapiCon Class #' #' @description Class \code{BrapiCon} defines a \code{rPHG} @@ -49,6 +37,7 @@ setClass( ) +## ---- #' @title BrAPI connection validation #' #' @name BrapiCon-validity @@ -89,6 +78,7 @@ setValidity("BrapiCon", function(object) { }) +## ---- #' @title BrapiCon object and constructors #' #' @description \code{BrapiCon} is the primary container for housing BrAPI @@ -105,10 +95,12 @@ setValidity("BrapiCon", function(object) { #' @return A \code{BrapiCon} object. #' #' @export -BrapiCon <- function(host, - port = NULL, - protocol = c("http", "https"), - version = c("v2", "v1")) { +BrapiCon <- function( + host, + port = NULL, + protocol = c("http", "https"), + version = c("v2", "v1") +) { if (missing(host)) stop("A URL host is needed to make this class.") @@ -133,59 +125,54 @@ BrapiCon <- function(host, } +## ---- +#' @rdname brapiURL +#' @export +setMethod( + f = "brapiURL", + signature = signature(object = "BrapiCon"), + definition = function(object) { + return(object@url) + } +) - -# === BrapiConPHG Class ============================================= +## ---- +#' @rdname host +#' @export +setMethod( + f = "host", + signature = signature(object = "BrapiCon"), + definition = function(object) { + return(object@host) + } +) -#' @title An S4 BrapiConPHG Class -#' -#' @description Class \code{BrapiConPHG} defines a \code{rPHG} -#' Class for storing BrAPI connection data plust PHG coordinate info. -#' -#' @slot methodID A PHG method identifier. -#' @slot refRangeFilter Reference range selection URL parameters. -#' @slot sampleFilter Sample / taxa selection URL parameters. -#' -#' @name BrapiConPHG-class -#' @rdname BrapiConPHG-class -#' @exportClass BrapiConPHG -setClass( - Class = "BrapiConPHG", - contains = "BrapiCon", - slots = c( - methodID = "character", - refRangeFilter = "character", - sampleFilter = "character" - ), - prototype = list( - methodID = NA_character_, - refRangeFilter = NA_character_, - sampleFilter = NA_character_ - ) +## ---- +#' @rdname serverInfo +#' @export +setMethod( + f = "serverInfo", + signature = signature(object = "BrapiCon"), + definition = function(object) { + json2tibble(object, "serverinfo", "calls") + } ) -#' @title Helper function to construct BrapiConPHG object -#' -#' @description Creates a \code{BrapiConPHG} object to be used to read and -#' filter data from a given BrAPI endpoint given a verified PHG method. -#' -#' @param brapiObj A \code{BrapiCon} object. -#' @param x A PHG method identifier. -#' +## ---- +#' @rdname showPHGMethods #' @export -PHGMethod <- function(brapiObj, x) { - - # For demo purposes only! - # if (x == "DEMO") x <- "NAM_GBS_Alignments_PATHS" - - methods::new( - "BrapiConPHG", - brapiObj, - methodID = x - ) -} +setMethod( + f = "showPHGMethods", + signature = signature(object = "BrapiCon"), + definition = function(object) { + ## Temp fix to return proper methods + fullTable <- json2tibble(object, "variantTables") + filtTable <- fullTable[fullTable$numSamples > 100, ] # arbitrary n + return(filtTable) + } +) diff --git a/R/classes.R b/R/class_phg_dataset.R similarity index 100% rename from R/classes.R rename to R/class_phg_dataset.R diff --git a/R/class_phg_method.R b/R/class_phg_method.R new file mode 100644 index 0000000..57615cc --- /dev/null +++ b/R/class_phg_method.R @@ -0,0 +1,295 @@ +## ---- +#' @title An S4 BrapiConPHG Class +#' +#' @description Class \code{BrapiConPHG} defines a \code{rPHG} +#' Class for storing BrAPI connection data plust PHG coordinate info. +#' +#' @slot methodID A PHG method identifier. +#' @slot refRangeFilter Reference range selection URL parameters. +#' @slot sampleFilter Sample / taxa selection URL parameters. +#' +#' @name BrapiConPHG-class +#' @rdname BrapiConPHG-class +#' @exportClass BrapiConPHG +setClass( + Class = "BrapiConPHG", + contains = "BrapiCon", + slots = c( + methodID = "character", + refRangeFilter = "character", + sampleFilter = "character" + ), + prototype = list( + methodID = NA_character_, + refRangeFilter = NA_character_, + sampleFilter = NA_character_ + ) +) + + +## ---- +#' @title Helper function to construct BrapiConPHG object +#' +#' @description Creates a \code{BrapiConPHG} object to be used to read and +#' filter data from a given BrAPI endpoint given a verified PHG method. +#' +#' @param brapiObj A \code{BrapiCon} object. +#' @param x A PHG method identifier. +#' +#' @export +PHGMethod <- function(brapiObj, x) { + + # For demo purposes only! + # if (x == "DEMO") x <- "NAM_GBS_Alignments_PATHS" + + methods::new( + "BrapiConPHG", + brapiObj, + methodID = x + ) +} + + +## ---- +#' @title Show method for BrapiConPHG objects +#' +#' @description Prints out the information from the BrAPI connection object +#' including server status codes. See this +#' \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} +#' for further details about what these codes mean. +#' +#' @param object a \code{\linkS4class{BrapiConPHG}} object. +#' +#' @docType methods +#' @name show +#' @rdname show +#' @aliases show,BrapiConPHG-method +setMethod( + f = "show", + signature = "BrapiConPHG", + definition = function(object) { + # cli::cli_div(theme = list(ul = list(`margin-left` = 2, before = ""))) + + # activeSlotMsg <- cli::symbol$square_small_filled + # inactiveSlotMsg <- cli::symbol$square_small + activeSlotMsg <- "[x]" + inactiveSlotMsg <- "[ ]" + + rrCheck <- ifelse( + test = is.na(object@refRangeFilter), + yes = inactiveSlotMsg, + no = activeSlotMsg + ) + sampleCheck <- ifelse( + test = is.na(object@sampleFilter), + yes = inactiveSlotMsg, + no = activeSlotMsg + ) + + cat(" PHG pointer object>\n") + cat(" method: ", object@methodID, "\n") + cat(" variant filter: ", rrCheck, "\n") + cat(" sample filter: ", sampleCheck, "\n") + } +) + + +## ---- +#' @rdname readRefRanges +#' +#' @importFrom GenomicRanges GRanges +#' @importFrom IRanges IRanges +#' @importFrom rJava .jevalArray +#' @importFrom rJava .jnew +#' +#' @export +setMethod( + f = "readRefRanges", + signature = "BrapiConPHG", + definition = function(object) { + urls <- getVTList(object) + + pageSize <- ifelse( + grepl("variants$", urls$rangeURL), + "?pageSize=", + "&pageSize=" + ) + + if (object@methodID == "DEMO") { + rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "1000")) + } else { + rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "150000")) + } + rrDF <- rrDF$result$data + + gr <- GenomicRanges::GRanges( + seqnames = rrDF$referenceName, + ranges = IRanges::IRanges( + start = rrDF$start, + end = rrDF$end + ), + variantDbId = rrDF$variantDbId + ) + + return(gr) + + } +) + + +## ---- +#' @rdname readSamples +#' +#' @importFrom tibble as_tibble +#' +#' @export +setMethod( + f = "readSamples", + signature = "BrapiConPHG", + definition = function(object) { + urls <- getVTList(object) + + sampleDF <- parseJSON(urls$sampleURL) + sampleDF <- sampleDF$result$data + + if (object@methodID == "DEMO") { + return(utils::head(tibble::as_tibble(sampleDF), n = 25)) + } else{ + return(tibble::as_tibble(sampleDF)) + } + } +) + + +## ---- +#' @rdname readHaplotypeIds +#' +#' @param numCores Number of processing cores for faster processing times. +#' @param transpose Do you want to transpose table? +#' +#' @importFrom cli cli_progress_bar +#' @importFrom cli cli_progress_done +#' @importFrom cli cli_progress_step +#' @importFrom cli cli_progress_update +#' @importFrom httr content +#' @importFrom httr GET +#' @importFrom jsonlite fromJSON +#' @importFrom parallel mclapply +#' +#' @export +setMethod( + f = "readHaplotypeIds", + signature = "BrapiConPHG", + definition = function(object, numCores = NULL, transpose = TRUE) { + # Logic checks + if (is.null(numCores)) { + numCores <- 1 + } + if (!is.numeric(numCores)) { + stop("numCores parameter must be numeric or NULL") + } + + # Get URLs + urls <- getVTList(object) + + # Calculate total pages + + if (object@methodID == "DEMO") { + totalVariants <- 1000 + totalPages <- ceiling(totalVariants / 250) + } else { + methods <- availablePHGMethods(object) + totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants + totalPages <- ceiling(totalVariants / 10000) + } + + # Download each page (iterative) + # TODO - can we async this? (e.g. futures) + allResp <- vector("list", totalPages) + # cli::cli_progress_step("Establishing connection") + message("Establishing connection") + # cli::cli_progress_bar(" - Downloading: ", total = totalPages) + message("Downloading:") + pb <- utils::txtProgressBar( + style = 3, + char = "=", + min = 1, + max = totalPages + ) + for (i in seq_len(totalPages)) { + currentUrl <- sprintf(urls$tableURL, i - 1, 0) + allResp[[i]] <- httr::GET(currentUrl) + utils::setTxtProgressBar(pb, i) + # cli::cli_progress_update() + } + close(pb) + # cli::cli_progress_done() + + # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) + brapiHapIdStringToInt <- function(x) { + id <- strsplit(x, "/")[[1]][1] + ifelse(id == ".", return(NA), return(as.integer(id))) + } + + # F2 - process matrix slices (convert from JSON to int matrix) + processMatrix <- function(x) { + xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") + xNew <- jsonlite::fromJSON(xNew) + xMat <- xNew$result$dataMatrices$dataMatrix[[1]] + colnames(xMat) <- xNew$result$callSetDbIds + rownames(xMat) <- xNew$result$variants + xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) + return(xMat) + } + + # Clean up data (parallel) + # cli::cli_progress_step("Cleaning data") + message("Cleaning data") + finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) + + # Bind all data into one matrix and return + # cli::cli_progress_step("Combining responses") + message("Combining responses") + if (transpose) { + unionMatrix <- t(do.call(rbind, finalMatrices)) + } else { + unionMatrix <- do.call(rbind, finalMatrices) + } + + return(unionMatrix) + } +) + + +## ---- +#' @rdname readPHGDataSet +#' +#' @export +setMethod( + f = "readPHGDataSet", + signature = "BrapiConPHG", + definition = function(object, ...) { + + urls <- getVTList(object) + + hapArray <- readTable(object, transpose = FALSE) + + # cli::cli_progress_step("Getting ref range data") + message("Getting ref range data") + rr <- readRefRanges(object) + # cli::cli_progress_step("Getting sample data") + message("Getting sample data") + samples <- readSamples(object) + + colnames(hapArray) <- samples$sampleName + + phgSE <- SummarizedExperiment::SummarizedExperiment( + assays = list(hapID = hapArray), + rowRanges = rr, + colData = samples + ) + + return(methods::new(Class = "PHGDataSet", phgSE)) + } +) + diff --git a/R/brapi_defunct.R b/R/deprecated_brapi.R similarity index 100% rename from R/brapi_defunct.R rename to R/deprecated_brapi.R diff --git a/R/show_phg_methods.R b/R/show_phg_methods.R index ccc6102..79aad91 100644 --- a/R/show_phg_methods.R +++ b/R/show_phg_methods.R @@ -1,58 +1,59 @@ -#' @title Get DB PHG methods for graph building -#' -#' @description Gets all available PHG methods from the graph database -#' using a path parameter to the database configuration file. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' -#' @importFrom rJava .jcast -#' @importFrom rJava .jnull -#' @importFrom rJava J -#' @importFrom rJava new -#' @importFrom tibble tibble -#' -#' @export -showPHGMethods <- function(configFile) { - - configCatcher(configFile) - - ## Get table report plugin and pull data from DB - plugin <- rJava::new( - rJava::J("net/maizegenetics/pangenome/api/MethodTableReportPlugin") - ) - plugin <- plugin$configFile(configFile) - ds <- plugin$performFunction( - rJava::.jnull("net/maizegenetics/plugindef/DataSet") - ) - datum <- ds$getData(0L) - tabRep <- rJava::.jcast( - datum$getData(), - new.class = "net/maizegenetics/util/TableReport" - ) - resultVectors <- rJava::J( - "net/maizegenetics/plugindef/GenerateRCode", - "tableReportToVectors", - tabRep - ) - - ## Get data vectors - data <- resultVectors$dataVector - - ## Convert to native R data frame - dfMethods <- tibble::tibble( - data$get(0L), - data$get(1L), - data$get(2L), - data$get(3L), - data$get(4L) - ) - - ## Convert names - names(dfMethods) <- resultVectors$columnNames - - ## Return object - return(dfMethods) -} +## #' @title Get DB PHG methods for graph building +## #' +## #' @description Gets all available PHG methods from the graph database +## #' using a path parameter to the database configuration file. +## #' +## #' @author Brandon Monier +## #' @author Peter Bradbury +## #' +## #' @param configFile Path to a configuration file for your graph database. +## #' +## #' @importFrom rJava .jcast +## #' @importFrom rJava .jnull +## #' @importFrom rJava J +## #' @importFrom rJava new +## #' @importFrom tibble tibble +## #' +## #' @export +## showPHGMethods <- function(configFile) { +## +## configCatcher(configFile) +## +## ## Get table report plugin and pull data from DB +## plugin <- rJava::new( +## rJava::J("net/maizegenetics/pangenome/api/MethodTableReportPlugin") +## ) +## plugin <- plugin$configFile(configFile) +## ds <- plugin$performFunction( +## rJava::.jnull("net/maizegenetics/plugindef/DataSet") +## ) +## datum <- ds$getData(0L) +## tabRep <- rJava::.jcast( +## datum$getData(), +## new.class = "net/maizegenetics/util/TableReport" +## ) +## resultVectors <- rJava::J( +## "net/maizegenetics/plugindef/GenerateRCode", +## "tableReportToVectors", +## tabRep +## ) +## +## ## Get data vectors +## data <- resultVectors$dataVector +## +## ## Convert to native R data frame +## dfMethods <- tibble::tibble( +## data$get(0L), +## data$get(1L), +## data$get(2L), +## data$get(3L), +## data$get(4L) +## ) +## +## ## Convert names +## names(dfMethods) <- resultVectors$columnNames +## +## ## Return object +## return(dfMethods) +## } +## \ No newline at end of file diff --git a/R/brapi_utilities.R b/R/utilities_brapi.R similarity index 100% rename from R/brapi_utilities.R rename to R/utilities_brapi.R diff --git a/R/utilities.R b/R/utilities_general.R similarity index 56% rename from R/utilities.R rename to R/utilities_general.R index 38d2f8b..4cf2064 100644 --- a/R/utilities.R +++ b/R/utilities_general.R @@ -1,18 +1,18 @@ # === Miscellaneous utilities for rPHG methods ====================== ## ---- -#' @title Create mock config file -#' -#' @description Creates a temporary PHG configuration file to access the -#' provided example database. Mainly for debugging and educational -#' purposes. -#' -#' @param file User defined output file -#' @param host Host service for database -#' @param user User ID for database access -#' @param password Password for database access -#' @param dbType Database architecture used -#' @param dbPath P +# @title Create mock config file +# +# @description Creates a temporary PHG configuration file to access the +# provided example database. Mainly for debugging and educational +# purposes. +# +# @param file User defined output file +# @param host Host service for database +# @param user User ID for database access +# @param password Password for database access +# @param dbType Database architecture used +# @param dbPath Path to DB createConfigFile <- function( file, host = "localhost", @@ -42,11 +42,11 @@ createConfigFile <- function( ## ---- -#' @title Logic support for config files -#' -#' @description Provides logic checking for config files used in PHG creation. -#' -#' @param configFile Path to a configuration file for your graph database. +# @title Logic support for config files +# +# @description Provides logic checking for config files used in PHG creation. +# +# @param configFile Path to a configuration file for your graph database. configCatcher <- function(configFile) { if (!file.exists(configFile)) { @@ -78,3 +78,32 @@ configCatcher <- function(configFile) { } +## ---- +# Parse components of config file into a list object +# +# @param file Path to a configuration file for database +parseConfigFile <- function(file) { + FIELDS <- c("host", "DB", "DBtype") + conLines <- readLines(file) + + properties <- vapply(FIELDS, \(x) getProperty(conLines, x), character(1)) + + return(setNames(as.list(properties), FIELDS)) +} + + +## ---- +# Get property from config file field +# +# @param configLines A character vector of config lines +# @param x A field value +getProperty <- function(configLines, x) { + regexField <- paste0("^", x, "=") + + property <- configLines[grepl(regexField, configLines)] |> + gsub("^.*=", "", x = _) + + return(property) +} + + diff --git a/inst/extdata/configSQLite.txt b/inst/extdata/configSQLite.txt index b9cdf79..33c2e74 100644 --- a/inst/extdata/configSQLite.txt +++ b/inst/extdata/configSQLite.txt @@ -1,7 +1,7 @@ host=localHost user=sqlite password=sqlite -DB=/home/bm646/Projects/rphg/inst/extdata/phgSmallSeq.db +DB=inst/extdata/phg_smallseq_test.db DBtype=sqlite minTaxa=1 minSites=5 diff --git a/man/BrapiCon-class.Rd b/man/BrapiCon-class.Rd index 28075a3..7cbc30d 100644 --- a/man/BrapiCon-class.Rd +++ b/man/BrapiCon-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_con_server.R \docType{class} \name{BrapiCon-class} \alias{BrapiCon-class} diff --git a/man/BrapiCon-validity.Rd b/man/BrapiCon-validity.Rd index b993c1f..69d85d4 100644 --- a/man/BrapiCon-validity.Rd +++ b/man/BrapiCon-validity.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_con_server.R \name{BrapiCon-validity} \alias{BrapiCon-validity} \title{BrAPI connection validation} diff --git a/man/BrapiCon.Rd b/man/BrapiCon.Rd index 07ac943..ccb199a 100644 --- a/man/BrapiCon.Rd +++ b/man/BrapiCon.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_con_server.R \name{BrapiCon} \alias{BrapiCon} \title{BrapiCon object and constructors} diff --git a/man/BrapiConPHG-class.Rd b/man/BrapiConPHG-class.Rd index dbfd7ff..d92b979 100644 --- a/man/BrapiConPHG-class.Rd +++ b/man/BrapiConPHG-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_method.R \docType{class} \name{BrapiConPHG-class} \alias{BrapiConPHG-class} diff --git a/man/PHGDataSet-class.Rd b/man/PHGDataSet-class.Rd index ef54fa4..801d37d 100644 --- a/man/PHGDataSet-class.Rd +++ b/man/PHGDataSet-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/classes.R +% Please edit documentation in R/class_phg_dataset.R \docType{class} \name{PHGDataSet-class} \alias{PHGDataSet-class} diff --git a/man/PHGLocalCon-class.Rd b/man/PHGLocalCon-class.Rd new file mode 100644 index 0000000..11f4387 --- /dev/null +++ b/man/PHGLocalCon-class.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con_local.R +\docType{class} +\name{PHGLocalCon-class} +\alias{PHGLocalCon-class} +\alias{show,PHGLocalCon-method} +\title{A PHGLocalCon Class} +\usage{ +\S4method{show}{PHGLocalCon}(object) +} +\arguments{ +\item{object}{A \code{\linkS4class{PHGLocalCon}} object} +} +\description{ +Class \code{PHGLocalCon} defines a \code{rPHG} class for storing +local config file data. + +Prints out information regarding properties from the \code{PHGLocalCon} +class to the console +} +\section{Slots}{ + +\describe{ +\item{\code{host}}{Location path of local SQLite or Postgres database} + +\item{\code{dbName}}{Name of database} + +\item{\code{dbType}}{Type of database} + +\item{\code{configFilePath}}{Path to configuration file} +}} + diff --git a/man/PHGLocalCon-validity.Rd b/man/PHGLocalCon-validity.Rd new file mode 100644 index 0000000..839485d --- /dev/null +++ b/man/PHGLocalCon-validity.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con_local.R +\name{PHGLocalCon-validity} +\alias{PHGLocalCon-validity} +\title{PHGLocalCon validation} +\arguments{ +\item{object}{A \code{\linkS4class{PHGLocalCon}} object} +} +\description{ +Checks for correct data entry into \code{PHGLocalCon} class +} diff --git a/man/PHGLocalCon.Rd b/man/PHGLocalCon.Rd new file mode 100644 index 0000000..e5b015d --- /dev/null +++ b/man/PHGLocalCon.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con_local.R +\name{PHGLocalCon} +\alias{PHGLocalCon} +\title{Helper functio to construct a \code{PHGLocalCon} object} +\usage{ +PHGLocalCon(file) +} +\arguments{ +\item{file}{A path to a PHG configuration file} +} +\description{ +Creates a \code{\linkS4class{PHGLocalCon}} object to be used to read PHG +DB data for a given set of PHG-related methods. +} diff --git a/man/PHGMethod.Rd b/man/PHGMethod.Rd index fcad91e..093c083 100644 --- a/man/PHGMethod.Rd +++ b/man/PHGMethod.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_method.R \name{PHGMethod} \alias{PHGMethod} \title{Helper function to construct BrapiConPHG object} diff --git a/man/availablePHGMethods.Rd b/man/availablePHGMethods.Rd deleted file mode 100644 index e776eb6..0000000 --- a/man/availablePHGMethods.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{availablePHGMethods} -\alias{availablePHGMethods} -\alias{availablePHGMethods,BrapiCon-method} -\title{Retrieve available PHG method data from BrAPI connection} -\usage{ -availablePHGMethods(object) - -\S4method{availablePHGMethods}{BrapiCon}(object) -} -\arguments{ -\item{object}{A \code{BrapiCon} object.} -} -\description{ -Retrieves data from the \code{variantTables} endpoint of a BrAPI - server. -} diff --git a/man/brapiURL.Rd b/man/brapiURL.Rd index 9b8197c..137c66b 100644 --- a/man/brapiURL.Rd +++ b/man/brapiURL.Rd @@ -1,18 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_getters_setters.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{brapiURL} \alias{brapiURL} \alias{brapiURL,BrapiCon-method} -\title{The URL of a \code{BrapiCon} object} +\title{Return URL path} \usage{ -brapiURL(x) +brapiURL(object, ...) -\S4method{brapiURL}{BrapiCon}(x) +\S4method{brapiURL}{BrapiCon}(object) } \arguments{ -\item{x}{a \linkS4class{BrapiCon} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object.} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -get or set the Uniform Resource Locator (URL) of a - \code{BrapiCon} object. +Returns the Uniform Resource Locator (URL) of a \code{BrapiCon} object. } diff --git a/man/brapiVersion.Rd b/man/brapiVersion.Rd new file mode 100644 index 0000000..7902db9 --- /dev/null +++ b/man/brapiVersion.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R +\name{brapiVersion} +\alias{brapiVersion} +\title{Return BrAPI version ID} +\usage{ +brapiVersion(object, ...) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the version ID for a BrAPI-compliant PHG server +} diff --git a/man/configCatcher.Rd b/man/configCatcher.Rd index 2bf00ad..7c01149 100644 --- a/man/configCatcher.Rd +++ b/man/configCatcher.Rd @@ -1,19 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/logic_support.R, R/utilities.R +% Please edit documentation in R/logic_support.R \name{configCatcher} \alias{configCatcher} \title{Logic support for config files} \usage{ -configCatcher(configFile) - configCatcher(configFile) } \arguments{ \item{configFile}{Path to a configuration file for your graph database.} } \description{ -Provides logic checking for config files used in PHG creation. - Provides logic checking for config files used in PHG creation. } \author{ diff --git a/man/createConfigFile.Rd b/man/createConfigFile.Rd deleted file mode 100644 index e62dda2..0000000 --- a/man/createConfigFile.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities.R -\name{createConfigFile} -\alias{createConfigFile} -\title{Create mock config file} -\usage{ -createConfigFile( - file, - host = "localhost", - user = "user", - password = "sqlite", - dbType = "sqlite", - dbPath = NULL -) -} -\arguments{ -\item{file}{User defined output file} - -\item{host}{Host service for database} - -\item{user}{User ID for database access} - -\item{password}{Password for database access} - -\item{dbType}{Database architecture used} - -\item{dbPath}{P} -} -\description{ -Creates a temporary PHG configuration file to access the - provided example database. Mainly for debugging and educational - purposes. -} diff --git a/man/filterRefRanges.Rd b/man/filterRefRanges.Rd deleted file mode 100644 index 0ef9fa3..0000000 --- a/man/filterRefRanges.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{filterRefRanges} -\alias{filterRefRanges} -\title{Filter reference ranges from given PHG method} -\usage{ -filterRefRanges(x, gr = NULL, chromosome = NULL, start = NULL, end = NULL) -} -\arguments{ -\item{x}{A \code{BrapiConPHG} object.} - -\item{gr}{A \code{GRanges} object. Houses genomic range information for -filter.} - -\item{chromosome}{A vector of chromosome ids of type \code{character}. Can -be of length one to size \code{n}. If used, this will return all reference -ranges within a given chromosome.} - -\item{start}{A vector of start positions of type \code{numeric}. If used, -an equal number of \code{end} elements will be needed to avoid error.} - -\item{end}{A vector of end positions of type \code{numeric}. These will -link up with the \code{start} positions. Must be equal to the \code{start} -parameter.} -} -\description{ -Filters reference ranges for a given PHG method by - manipulation of BrAPI samples URL call. For a given query, reference - ranges will be returned if they overlap with a user-defined range. - Uses 1-based coordinate information. -} diff --git a/man/filterSamples.Rd b/man/filterSamples.Rd deleted file mode 100644 index 20c862f..0000000 --- a/man/filterSamples.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{filterSamples} -\alias{filterSamples} -\title{Filter samples from given PHG method} -\usage{ -filterSamples(x, samples) -} -\arguments{ -\item{x}{A \code{BrapiConPHG} object.} - -\item{samples}{A vector of taxa ID of type \code{character}.} -} -\description{ -Filters samples for a given PHG method by manipulation of BrAPI - samples URL call. Returns exact matches only. If query is not exact match, - no data will be returned for that given sample. -} diff --git a/man/getVTList.Rd b/man/getVTList.Rd index df9ceae..94dde7a 100644 --- a/man/getVTList.Rd +++ b/man/getVTList.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_utilities.R +% Please edit documentation in R/utilities_brapi.R \name{getVTList} \alias{getVTList} \title{Retrieve variant table BrAPI URLs} diff --git a/man/hapIDMatrix.Rd b/man/hapIDMatrix.Rd deleted file mode 100644 index 5f24304..0000000 --- a/man/hapIDMatrix.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hap_id_matrix.R -\name{hapIDMatrix} -\alias{hapIDMatrix} -\title{Generate a haplotype ID matrix} -\usage{ -hapIDMatrix(phgObject) -} -\arguments{ -\item{phgObject}{A PHG object.} -} -\description{ -Generates a haplotype ID matrix from a PHG object. -} -\author{ -Brandon Monier - -Peter Bradbury -} diff --git a/man/host.Rd b/man/host.Rd new file mode 100644 index 0000000..e2a1e14 --- /dev/null +++ b/man/host.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R +\name{host} +\alias{host} +\alias{host,BrapiCon-method} +\title{Return host data} +\usage{ +host(object, ...) + +\S4method{host}{BrapiCon}(object) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the host information for a given object +} diff --git a/man/json2tibble.Rd b/man/json2tibble.Rd index bb2aa4b..f2bdfba 100644 --- a/man/json2tibble.Rd +++ b/man/json2tibble.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_utilities.R +% Please edit documentation in R/utilities_brapi.R \name{json2tibble} \alias{json2tibble} \title{JSON to tibble converter} diff --git a/man/parseJSON.Rd b/man/parseJSON.Rd index eec53a0..1b5357d 100644 --- a/man/parseJSON.Rd +++ b/man/parseJSON.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_utilities.R +% Please edit documentation in R/utilities_brapi.R \name{parseJSON} \alias{parseJSON} \title{URL checker} diff --git a/man/port.Rd b/man/port.Rd new file mode 100644 index 0000000..54879e7 --- /dev/null +++ b/man/port.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R +\name{port} +\alias{port} +\title{Return port value} +\usage{ +port(object, ...) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the port information for a given object +} diff --git a/man/readHaplotypeIds.Rd b/man/readHaplotypeIds.Rd new file mode 100644 index 0000000..05f9f76 --- /dev/null +++ b/man/readHaplotypeIds.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +\name{readHaplotypeIds} +\alias{readHaplotypeIds} +\alias{readHaplotypeIds,BrapiConPHG-method} +\title{Return haplotype IDs} +\usage{ +readHaplotypeIds(object, ...) + +\S4method{readHaplotypeIds}{BrapiConPHG}(object, numCores = NULL, transpose = TRUE) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} + +\item{numCores}{Number of processing cores for faster processing times.} + +\item{transpose}{Do you want to transpose table?} +} +\description{ +Gets haplotype ID for given samples and reference ranges for PHG method +} diff --git a/man/readPHGDataSet.Rd b/man/readPHGDataSet.Rd new file mode 100644 index 0000000..f69458d --- /dev/null +++ b/man/readPHGDataSet.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +\name{readPHGDataSet} +\alias{readPHGDataSet} +\alias{readPHGDataSet,BrapiConPHG-method} +\title{Return a PHGDataSet} +\usage{ +readPHGDataSet(object, ...) + +\S4method{readPHGDataSet}{BrapiConPHG}(object, ...) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Creates a \code{\linkS4class{PHGDataSet}} for a given PHG method. This will +return all 3 primary sources of data (samples, reference ranges, and +haplotype IDs). +} diff --git a/man/readPHGDatasetFromBrapi.Rd b/man/readPHGDatasetFromBrapi.Rd deleted file mode 100644 index c8423a5..0000000 --- a/man/readPHGDatasetFromBrapi.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{readPHGDatasetFromBrapi} -\alias{readPHGDatasetFromBrapi} -\title{Read PHGDataset object from BrAPI PHG method} -\usage{ -readPHGDatasetFromBrapi(object, ...) -} -\arguments{ -\item{object}{A \code{BrapiConPHG} object.} - -\item{...}{Additional arguments to be passed.} -} -\description{ -Creates a \code{PHGDataset} object by reading sample, - reference range, and feature data information. -} diff --git a/man/readRefRanges.Rd b/man/readRefRanges.Rd index 7544428..d572bd3 100644 --- a/man/readRefRanges.Rd +++ b/man/readRefRanges.Rd @@ -1,18 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R \name{readRefRanges} \alias{readRefRanges} \alias{readRefRanges,BrapiConPHG-method} -\title{Retrieve available ref range data from a given PHG method} +\title{Return reference ranges} \usage{ -readRefRanges(object) +readRefRanges(object, ...) \S4method{readRefRanges}{BrapiConPHG}(object) } \arguments{ -\item{object}{A \code{BrapiConPHG} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Retrieves reference range information from a given PHG method. - Data returned is (1) chromosome, (2) start, and (3) stop coordinates. +Get reference range data for a given PHG method } diff --git a/man/readSamples.Rd b/man/readSamples.Rd index 5d35031..5c045db 100644 --- a/man/readSamples.Rd +++ b/man/readSamples.Rd @@ -1,19 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R \name{readSamples} \alias{readSamples} \alias{readSamples,BrapiConPHG-method} -\title{Retrieve available sample data from a given PHG method} +\title{Return samples IDs} \usage{ -readSamples(object) +readSamples(object, ...) \S4method{readSamples}{BrapiConPHG}(object) } \arguments{ -\item{object}{A \code{BrapiConPHG} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Retrieves sample information from a given PHG method. - Data returned is (1) sample name, (2) sample DB ID, (3) description, - and (4) additional information. +Gets sample ID data for a given PHG method } diff --git a/man/readTable.Rd b/man/readTable.Rd deleted file mode 100644 index 2e6980d..0000000 --- a/man/readTable.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{readTable} -\alias{readTable} -\alias{readTable,BrapiConPHG-method} -\alias{readPHGDatasetFromBrapi,BrapiConPHG-method} -\title{Retrieve available table data from a given PHG method} -\usage{ -readTable(object, ...) - -\S4method{readTable}{BrapiConPHG}(object, numCores = NULL, transpose = TRUE) - -\S4method{readPHGDatasetFromBrapi}{BrapiConPHG}(object, ...) -} -\arguments{ -\item{object}{A \code{BrapiConPHG} object.} - -\item{...}{Additional arguments to be passed.} - -\item{numCores}{Number of processing cores for faster processing times.} - -\item{transpose}{Do you want to transpose table?} -} -\description{ -Retrieves table information from a given PHG method. - Data returned is a \code{matrix} object. -} diff --git a/man/referenceSets.Rd b/man/referenceSets.Rd deleted file mode 100644 index c165324..0000000 --- a/man/referenceSets.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{referenceSets} -\alias{referenceSets} -\alias{referenceSets,BrapiCon-method} -\title{Retrieve reference set data from BrAPI connection} -\usage{ -referenceSets(object) - -\S4method{referenceSets}{BrapiCon}(object) -} -\arguments{ -\item{object}{A \code{BrapiCon} object.} -} -\description{ -Retrieves data from the \code{referenceSets} endpoint of a BrAPI - server. -} diff --git a/man/references.Rd b/man/references.Rd deleted file mode 100644 index b6819a5..0000000 --- a/man/references.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{references} -\alias{references} -\alias{references,BrapiCon-method} -\title{Retrieve reference data from BrAPI connection} -\usage{ -references(object) - -\S4method{references}{BrapiCon}(object) -} -\arguments{ -\item{object}{A \code{BrapiCon} object.} -} -\description{ -Retrieves data from the \code{references} endpoint of a BrAPI - server. -} diff --git a/man/serverInfo.Rd b/man/serverInfo.Rd index 54b5e17..b1f7055 100644 --- a/man/serverInfo.Rd +++ b/man/serverInfo.Rd @@ -1,18 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{serverInfo} \alias{serverInfo} \alias{serverInfo,BrapiCon-method} -\title{Retrieve server info data from BrAPI connection} +\title{Return server information} \usage{ -serverInfo(object) +serverInfo(object, ...) \S4method{serverInfo}{BrapiCon}(object) } \arguments{ -\item{object}{A \code{BrapiCon} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Retrieves data from the \code{serverinfo} endpoint of a BrAPI - server. +Get avaiable BrAPI calls from BrAPI compliant PHG server } diff --git a/man/show.Rd b/man/show.Rd index 6e95b1e..bfbc86e 100644 --- a/man/show.Rd +++ b/man/show.Rd @@ -1,25 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_phg_method.R \docType{methods} \name{show} \alias{show} -\alias{show,BrapiCon-method} \alias{show,BrapiConPHG-method} -\title{Show method for BrapiCon objects} +\title{Show method for BrapiConPHG objects} \usage{ -\S4method{show}{BrapiCon}(object) - \S4method{show}{BrapiConPHG}(object) } \arguments{ \item{object}{a \code{\linkS4class{BrapiConPHG}} object.} } \description{ -Prints out the information from the BrAPI connection object - including server status codes. See this - \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} - for further details about what these codes mean. - Prints out the information from the BrAPI connection object including server status codes. See this \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} diff --git a/man/showPHGMethods.Rd b/man/showPHGMethods.Rd index 542d7f9..261bfa0 100644 --- a/man/showPHGMethods.Rd +++ b/man/showPHGMethods.Rd @@ -1,20 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/show_phg_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{showPHGMethods} \alias{showPHGMethods} -\title{Get DB PHG methods for graph building} +\alias{showPHGMethods,BrapiCon-method} +\title{Return available PHG methods} \usage{ -showPHGMethods(configFile) +showPHGMethods(object, ...) + +\S4method{showPHGMethods}{BrapiCon}(object) } \arguments{ -\item{configFile}{Path to a configuration file for your graph database.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Gets all available PHG methods from the graph database - using a path parameter to the database configuration file. -} -\author{ -Brandon Monier - -Peter Bradbury +Returns a collection of available PHG methods and metadata } From 0772db6e21caab29f885ff76fb15278878c1dab8 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 28 Jul 2023 11:29:23 -0400 Subject: [PATCH 09/35] Initial commit --- R/class_all_generics.R | 0 R/hap_id_matrix.R | 23 ++++++++++++----------- 2 files changed, 12 insertions(+), 11 deletions(-) create mode 100644 R/class_all_generics.R diff --git a/R/class_all_generics.R b/R/class_all_generics.R new file mode 100644 index 0000000..e69de29 diff --git a/R/hap_id_matrix.R b/R/hap_id_matrix.R index caff00b..8331e8e 100644 --- a/R/hap_id_matrix.R +++ b/R/hap_id_matrix.R @@ -1,14 +1,15 @@ -#' @title Generate a haplotype ID matrix -#' -#' @description Generates a haplotype ID matrix from a PHG object. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param phgObject A PHG object. -#' -#' @importFrom rJava is.jnull -#' @importFrom rJava J +## ---- +# @title Generate a haplotype ID matrix +# +# @description Generates a haplotype ID matrix from a PHG object. +# +# @author Brandon Monier +# @author Peter Bradbury +# +# @param phgObject A PHG object. +# +# @importFrom rJava is.jnull +# @importFrom rJava J hapIDMatrix <- function(phgObject) { ## Pull hap ID matrix from phg object From 9d09462ed8561e2cb3263fcb0f359f2f794650f0 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 4 Aug 2023 17:23:09 -0400 Subject: [PATCH 10/35] Update console output --- R/brapi_methods.R | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/R/brapi_methods.R b/R/brapi_methods.R index 1298635..ad967c2 100644 --- a/R/brapi_methods.R +++ b/R/brapi_methods.R @@ -40,20 +40,21 @@ setMethod( statusMsg <- "" } - cat("A BrAPI connection object\n") - cat(" Server...........:", host(object), "\n") - cat(" Port.............:", port(object), "\n") - cat(" Server status....:", status, statusMsg, "\n") - cat(" BrAPI version....:", version(object), "\n") + # cat("A BrAPI connection object\n") + # cat(" Server...........:", host(object), "\n") + # cat(" Port.............:", port(object), "\n") + # cat(" Server status....:", status, statusMsg, "\n") + # cat(" BrAPI version....:", version(object), "\n") + + msg <- c( + paste0("A ", cli::style_bold("BrAPI"), " connection object"), + paste0(" ", cli::col_green(cli::symbol$pointer), " Server...........: ", host(object)), + paste0(" ", cli::col_green(cli::symbol$pointer), " Port.............: ", port(object)), + paste0(" ", cli::col_green(cli::symbol$pointer), " Server status....: ", statusMsg), + paste0(" ", cli::col_green(cli::symbol$pointer), " BrAPI version....: ", version(object)) + ) - # cli::cli_div(theme = list(ul = list(`margin-left` = 2, before = ""))) - # cli::cli_text("A {.strong BrAPI} connection object") - # cli::cli_ul(id = "foo") - # cli::cli_li("{.field Server}...........: {.url {host(object)}}") - # cli::cli_li("{.field Port}.............: { {port(object)} }") - # cli::cli_li("{.field Server status}....: { statusMsg }") - # cli::cli_li("{.field BrAPI version}....: { {version(object)} }") - # cli::cli_end(id = "foo") + cat(msg, sep = "\n") } ) From 07e4b6506729d9b8292ea1f666fa4ec257e93518 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 4 Aug 2023 17:25:35 -0400 Subject: [PATCH 11/35] Add variable --- R/brapi_methods.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/brapi_methods.R b/R/brapi_methods.R index ad967c2..ac0b27e 100644 --- a/R/brapi_methods.R +++ b/R/brapi_methods.R @@ -46,12 +46,13 @@ setMethod( # cat(" Server status....:", status, statusMsg, "\n") # cat(" BrAPI version....:", version(object), "\n") + pointerSymbol <- cli::col_green(cli::symbol$pointer) msg <- c( paste0("A ", cli::style_bold("BrAPI"), " connection object"), - paste0(" ", cli::col_green(cli::symbol$pointer), " Server...........: ", host(object)), - paste0(" ", cli::col_green(cli::symbol$pointer), " Port.............: ", port(object)), - paste0(" ", cli::col_green(cli::symbol$pointer), " Server status....: ", statusMsg), - paste0(" ", cli::col_green(cli::symbol$pointer), " BrAPI version....: ", version(object)) + paste0(" ", pointerSymbol, " Server...........: ", host(object)), + paste0(" ", pointerSymbol, " Port.............: ", port(object)), + paste0(" ", pointerSymbol, " Server status....: ", statusMsg), + paste0(" ", pointerSymbol, " BrAPI version....: ", version(object)) ) cat(msg, sep = "\n") From 4471d401d82826c222931980744d62c5ee63ccbf Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 11 Aug 2023 16:15:06 -0400 Subject: [PATCH 12/35] Reorganize classes and generics --- DESCRIPTION | 2 +- NAMESPACE | 23 +- R/brapi_getters_setters.R | 37 -- R/brapi_methods.R | 585 ------------------ R/class_all_generics.R | 146 +++++ R/class_phg_con_local.R | 129 ++++ R/{brapi_classes.R => class_phg_con_server.R} | 113 ++-- R/{classes.R => class_phg_dataset.R} | 0 R/class_phg_method.R | 295 +++++++++ R/{brapi_defunct.R => deprecated_brapi.R} | 0 R/show_phg_methods.R | 117 ++-- R/{brapi_utilities.R => utilities_brapi.R} | 0 R/{utilities.R => utilities_general.R} | 63 +- inst/extdata/configSQLite.txt | 2 +- man/BrapiCon-class.Rd | 2 +- man/BrapiCon-validity.Rd | 2 +- man/BrapiCon.Rd | 2 +- man/BrapiConPHG-class.Rd | 2 +- man/PHGDataSet-class.Rd | 2 +- man/PHGLocalCon-class.Rd | 32 + man/PHGLocalCon-validity.Rd | 11 + man/PHGLocalCon.Rd | 15 + man/PHGMethod.Rd | 2 +- man/availablePHGMethods.Rd | 18 - man/brapiURL.Rd | 15 +- man/brapiVersion.Rd | 16 + man/configCatcher.Rd | 6 +- man/createConfigFile.Rd | 33 - man/filterRefRanges.Rd | 31 - man/filterSamples.Rd | 18 - man/getVTList.Rd | 2 +- man/hapIDMatrix.Rd | 19 - man/host.Rd | 19 + man/json2tibble.Rd | 2 +- man/parseJSON.Rd | 2 +- man/port.Rd | 16 + man/readHaplotypeIds.Rd | 23 + man/readPHGDataSet.Rd | 21 + man/readPHGDatasetFromBrapi.Rd | 17 - man/readRefRanges.Rd | 13 +- man/readSamples.Rd | 14 +- man/readTable.Rd | 27 - man/referenceSets.Rd | 18 - man/references.Rd | 18 - man/serverInfo.Rd | 13 +- man/show.Rd | 12 +- man/showPHGMethods.Rd | 21 +- 47 files changed, 942 insertions(+), 1034 deletions(-) delete mode 100644 R/brapi_getters_setters.R delete mode 100644 R/brapi_methods.R create mode 100644 R/class_phg_con_local.R rename R/{brapi_classes.R => class_phg_con_server.R} (62%) rename R/{classes.R => class_phg_dataset.R} (100%) create mode 100644 R/class_phg_method.R rename R/{brapi_defunct.R => deprecated_brapi.R} (100%) rename R/{brapi_utilities.R => utilities_brapi.R} (100%) rename R/{utilities.R => utilities_general.R} (56%) create mode 100644 man/PHGLocalCon-class.Rd create mode 100644 man/PHGLocalCon-validity.Rd create mode 100644 man/PHGLocalCon.Rd delete mode 100644 man/availablePHGMethods.Rd create mode 100644 man/brapiVersion.Rd delete mode 100644 man/createConfigFile.Rd delete mode 100644 man/filterRefRanges.Rd delete mode 100644 man/filterSamples.Rd delete mode 100644 man/hapIDMatrix.Rd create mode 100644 man/host.Rd create mode 100644 man/port.Rd create mode 100644 man/readHaplotypeIds.Rd create mode 100644 man/readPHGDataSet.Rd delete mode 100644 man/readPHGDatasetFromBrapi.Rd delete mode 100644 man/readTable.Rd delete mode 100644 man/referenceSets.Rd delete mode 100644 man/references.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 52b8a6f..0042cc2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: rPHG -Version: 0.1.18 +Version: 0.1.19 Date: 2019-06-03 Title: R front-end for the practical haplotype graph Authors@R: c( diff --git a/NAMESPACE b/NAMESPACE index b807844..5ce343b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,25 +1,26 @@ # Generated by roxygen2: do not edit by hand export(BrapiCon) +export(PHGLocalCon) export(PHGMethod) -export(availablePHGMethods) export(brapiURL) +export(brapiVersion) export(getVTList) export(graphBuilder) +export(host) export(numHaploPerRange) export(pathsForMethod) export(plotGraph) export(plotMutualInfo) export(plotNumHaplo) +export(port) +export(readHaplotypeIds) export(readMappingTableInfo) export(readMappingsForLineName) -export(readPHGDatasetFromBrapi) +export(readPHGDataSet) export(readRefRanges) export(readSamples) -export(readTable) export(refRangeTable) -export(referenceSets) -export(references) export(searchRecombination) export(searchSimilarGametes) export(serverInfo) @@ -29,17 +30,16 @@ export(taxaByNode) exportClasses(BrapiCon) exportClasses(BrapiConPHG) exportClasses(PHGDataSet) -exportMethods(availablePHGMethods) +exportClasses(PHGLocalCon) exportMethods(brapiURL) -exportMethods(readPHGDatasetFromBrapi) +exportMethods(host) +exportMethods(readHaplotypeIds) +exportMethods(readPHGDataSet) exportMethods(readRefRanges) exportMethods(readSamples) -exportMethods(readTable) -exportMethods(referenceSets) -exportMethods(references) exportMethods(serverInfo) +exportMethods(showPHGMethods) import(ggplot2) -importFrom(GenomeInfoDb,dropSeqlevels) importFrom(GenomicRanges,GRanges) importFrom(IRanges,IRanges) importFrom(IRanges,subsetByOverlaps) @@ -66,7 +66,6 @@ importFrom(methods,new) importFrom(methods,setClass) importFrom(parallel,mclapply) importFrom(rJava,.jcall) -importFrom(rJava,.jcast) importFrom(rJava,.jevalArray) importFrom(rJava,.jnew) importFrom(rJava,.jnull) diff --git a/R/brapi_getters_setters.R b/R/brapi_getters_setters.R deleted file mode 100644 index b88cec3..0000000 --- a/R/brapi_getters_setters.R +++ /dev/null @@ -1,37 +0,0 @@ -# === BrAPI getters and setters (maybe) ============================= - -## BrAPI URL ---- -#' @title The URL of a \code{BrapiCon} object -#' -#' @description get or set the Uniform Resource Locator (URL) of a -#' \code{BrapiCon} object. -#' -#' @param x a \linkS4class{BrapiCon} object. -#' -#' @rdname brapiURL -#' -#' @export -setGeneric("brapiURL", function(x) standardGeneric("brapiURL")) - -#' @rdname brapiURL -#' @export -setMethod("brapiURL", signature = c(x = "BrapiCon"), function(x) return(x@url)) - - - -setGeneric("host", function(x) standardGeneric("host")) -setMethod("host", signature("BrapiCon"), function(x) x@host) - -setGeneric("port", function(x) standardGeneric("port")) -setMethod("port", signature = "BrapiCon", function(x) x@port) - -setGeneric("protocol", function(x) standardGeneric("protocol")) -setMethod("protocol", signature = "BrapiCon", function(x) x@protocol) - -setGeneric("version", function(x) standardGeneric("version")) -setMethod("version", signature = "BrapiCon", function(x) x@version) - -setGeneric("token", function(x) standardGeneric("token")) -setMethod("token", signature = "BrapiCon", function(x) x@token) - - diff --git a/R/brapi_methods.R b/R/brapi_methods.R deleted file mode 100644 index ac0b27e..0000000 --- a/R/brapi_methods.R +++ /dev/null @@ -1,585 +0,0 @@ -##################################################################### -## -## Overview: -## This file houses methods and generics related to `BrapiCon` and -## `BrapiConPHG` classes -## -##################################################################### - -# === BrapiCon general methods ====================================== - -## ---- -#' @title Show method for BrapiCon objects -#' -#' @description Prints out the information from the BrAPI connection object -#' including server status codes. See this -#' \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} -#' for further details about what these codes mean. -#' -#' @param object a \code{\linkS4class{BrapiCon}} object. -#' -#' @docType methods -#' @name show -#' @rdname show -#' @aliases show show,BrapiCon-method -setMethod( - f = "show", - signature = "BrapiCon", - definition = function(object) { - - status <- tryCatch( - expr = { - httr::GET(paste0(brapiURL(object), "/serverinfo"))$status - }, - error = function(cond) "ERROR" - ) - - if (is.numeric(status) && status >= 200 && status <= 299) { - statusMsg <- "(OK)" - } else { - statusMsg <- "" - } - - # cat("A BrAPI connection object\n") - # cat(" Server...........:", host(object), "\n") - # cat(" Port.............:", port(object), "\n") - # cat(" Server status....:", status, statusMsg, "\n") - # cat(" BrAPI version....:", version(object), "\n") - - pointerSymbol <- cli::col_green(cli::symbol$pointer) - msg <- c( - paste0("A ", cli::style_bold("BrAPI"), " connection object"), - paste0(" ", pointerSymbol, " Server...........: ", host(object)), - paste0(" ", pointerSymbol, " Port.............: ", port(object)), - paste0(" ", pointerSymbol, " Server status....: ", statusMsg), - paste0(" ", pointerSymbol, " BrAPI version....: ", version(object)) - ) - - cat(msg, sep = "\n") - } -) - - -## ---- -#' @title Retrieve server info data from BrAPI connection -#' -#' @description Retrieves data from the \code{serverinfo} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname serverInfo -#' -#' @export -setGeneric("serverInfo", function(object) standardGeneric("serverInfo")) - -#' @rdname serverInfo -#' @export -setMethod( - f = "serverInfo", - signature = "BrapiCon", - definition = function(object) { - json2tibble(object, "serverinfo", "calls") - } -) - - -## ---- -#' @title Retrieve reference data from BrAPI connection -#' -#' @description Retrieves data from the \code{references} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname references -#' -#' @export -setGeneric("references", function(object) standardGeneric("references")) - -#' @rdname references -#' @export -setMethod( - f = "references", - signature = "BrapiCon", - definition = function(object) { - json2tibble(object, "references") - } -) - - -## ---- -#' @title Retrieve reference set data from BrAPI connection -#' -#' @description Retrieves data from the \code{referenceSets} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname referenceSets -#' -#' @export -setGeneric("referenceSets", function(object) standardGeneric("referenceSets")) - -#' @rdname referenceSets -#' @export -setMethod( - f = "referenceSets", - signature = "BrapiCon", - definition = function(object) { - json2tibble(object, "referencesets") - } -) - - -## ---- -#' @title Retrieve available PHG method data from BrAPI connection -#' -#' @description Retrieves data from the \code{variantTables} endpoint of a BrAPI -#' server. -#' -#' @param object A \code{BrapiCon} object. -#' -#' @rdname availablePHGMethods -#' -#' @export -setGeneric("availablePHGMethods", function(object) standardGeneric("availablePHGMethods")) - -#' @rdname availablePHGMethods -#' @export -setMethod( - f = "availablePHGMethods", - signature = "BrapiCon", - definition = function(object) { - ## Temp fix to return proper methods - fullTable <- json2tibble(object, "variantTables") - filtTable <- fullTable[fullTable$numSamples > 100, ] # arbitrary n - return(filtTable) - } -) - - - - - -# === BrapiConPHG general methods =================================== - -## ---- -#' @title Show method for BrapiConPHG objects -#' -#' @description Prints out the information from the BrAPI connection object -#' including server status codes. See this -#' \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} -#' for further details about what these codes mean. -#' -#' @param object a \code{\linkS4class{BrapiConPHG}} object. -#' -#' @docType methods -#' @name show -#' @rdname show -#' @aliases show show,BrapiConPHG-method -setMethod( - f = "show", - signature = "BrapiConPHG", - definition = function(object) { - # cli::cli_div(theme = list(ul = list(`margin-left` = 2, before = ""))) - - # activeSlotMsg <- cli::symbol$square_small_filled - # inactiveSlotMsg <- cli::symbol$square_small - activeSlotMsg <- "[x]" - inactiveSlotMsg <- "[ ]" - - rrCheck <- ifelse( - test = is.na(object@refRangeFilter), - yes = inactiveSlotMsg, - no = activeSlotMsg - ) - sampleCheck <- ifelse( - test = is.na(object@sampleFilter), - yes = inactiveSlotMsg, - no = activeSlotMsg - ) - - cat(" PHG pointer object>\n") - cat(" method: ", object@methodID, "\n") - cat(" variant filter: ", rrCheck, "\n") - cat(" sample filter: ", sampleCheck, "\n") - } -) - - -## ---- -#' @title Filter reference ranges from given PHG method -#' -#' @description Filters reference ranges for a given PHG method by -#' manipulation of BrAPI samples URL call. For a given query, reference -#' ranges will be returned if they overlap with a user-defined range. -#' Uses 1-based coordinate information. -#' -#' @param x A \code{BrapiConPHG} object. -#' @param gr A \code{GRanges} object. Houses genomic range information for -#' filter. -#' @param chromosome A vector of chromosome ids of type \code{character}. Can -#' be of length one to size \code{n}. If used, this will return all reference -#' ranges within a given chromosome. -#' @param start A vector of start positions of type \code{numeric}. If used, -#' an equal number of \code{end} elements will be needed to avoid error. -#' @param end A vector of end positions of type \code{numeric}. These will -#' link up with the \code{start} positions. Must be equal to the \code{start} -#' parameter. -#' -#' @importFrom GenomeInfoDb dropSeqlevels -#' -# #' @export -filterRefRanges <- function( - x, - gr = NULL, - chromosome = NULL, - start = NULL, - end = NULL -) { - if (class(x) != "BrapiConPHG") { - stop("A `BrapiConPHG` object is needed for the LHS argument", call. = FALSE) - } - - if (!is.null(gr)) { - if (inherits(gr, "GRanges")) { - if (is.null(chromosome)) { - grDF <- as.data.frame(gr) - seqString <- paste0( - grDF$seqnames, ":", - grDF$start, "-", grDF$end, - collapse = "," - ) - rrString <- paste0("ranges=", seqString) - } else { - grSub <- GenomeInfoDb::dropSeqlevels(gr, chromosome, pruning.mode = "coarse") - grDF <- as.data.frame(grSub) - seqStringGR <- paste0( - grDF$seqnames, ":", - grDF$start, "-", grDF$end, - collapse = "," - ) - seqStringChr <- paste0(chromosome, collapse = ",") - rrString <- paste0("ranges=", seqStringChr, ",", seqStringGR) - } - - } else { - stop("Not a valid GRanges object", call. = FALSE) - } - } else { - if (!is.null(chromosome) && is.null(start) && is.null(end)) { - rrString <- paste0("ranges=", paste0(chromosome, collapse = ",")) - } else if (!is.null(chromosome) && !is.null(start) && !is.null(end)) { - if (length(unique(sapply(list(chromosome, start, end), length))) == 1) { - seqString <- paste0( - chromosome, ":", - start, "-", end, - collapse = "," - ) - rrString <- paste0("ranges=", seqString) - } else { - stop("Range vectors do not have the same length", call. = FALSE) - } - } else { - stop("Incorrect filtration parameters", call. = FALSE) - } - } - - # Add filter on `refRangeFilter` slot - x@refRangeFilter <- rrString - - return(x) -} - - -## ---- -#' @title Filter samples from given PHG method -#' -#' @description Filters samples for a given PHG method by manipulation of BrAPI -#' samples URL call. Returns exact matches only. If query is not exact match, -#' no data will be returned for that given sample. -#' -#' @param x A \code{BrapiConPHG} object. -#' @param samples A vector of taxa ID of type \code{character}. -#' -# #' @export -filterSamples <- function(x, samples) { - if (class(x) != "BrapiConPHG") { - stop("A `BrapiConPHG` object is needed for the LHS argument", call. = FALSE) - } - - if (is.vector(samples) && is.atomic(samples)) { - sampleString <- paste0("sampleNames=", paste0(samples, collapse = ",")) - } else { - stop("`samples` argument must be an atomic vector", call. = FALSE) - } - - x@sampleFilter <- sampleString - - return(x) -} - - -## ---- -#' @title Retrieve available ref range data from a given PHG method -#' -#' @description Retrieves reference range information from a given PHG method. -#' Data returned is (1) chromosome, (2) start, and (3) stop coordinates. -#' -#' @param object A \code{BrapiConPHG} object. -#' -#' @rdname readRefRanges -#' -#' @export -setGeneric("readRefRanges", function(object) standardGeneric("readRefRanges")) - -#' @rdname readRefRanges -#' -#' @importFrom GenomicRanges GRanges -#' @importFrom IRanges IRanges -#' @importFrom rJava .jevalArray -#' @importFrom rJava .jnew -#' -#' @export -setMethod( - f = "readRefRanges", - signature = "BrapiConPHG", - definition = function(object) { - urls <- getVTList(object) - - # rJC <- rJava::.jnew("net/maizegenetics/pangenome/api/RMethodsKotlin") - # rrArray <- rJC$getRefRangesFromBrapi( - # urls$rangeURL, - # as.integer(1000) - # ) - # rrArray <- rJava::.jevalArray(rrArray, simplify = TRUE) - - pageSize <- ifelse( - grepl("variants$", urls$rangeURL), - "?pageSize=", - "&pageSize=" - ) - - if (object@methodID == "DEMO") { - rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "1000")) - } else { - rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "150000")) - } - rrDF <- rrDF$result$data - - gr <- GenomicRanges::GRanges( - seqnames = rrDF$referenceName, - ranges = IRanges::IRanges( - start = rrDF$start, - end = rrDF$end - ), - variantDbId = rrDF$variantDbId - ) - - return(gr) - - } -) - - -## ---- -#' @title Retrieve available sample data from a given PHG method -#' -#' @description Retrieves sample information from a given PHG method. -#' Data returned is (1) sample name, (2) sample DB ID, (3) description, -#' and (4) additional information. -#' -#' @param object A \code{BrapiConPHG} object. -#' -#' @rdname readSamples -#' -#' @export -setGeneric("readSamples", function(object) standardGeneric("readSamples")) - -#' @rdname readSamples -#' -#' @importFrom tibble as_tibble -#' -#' @export -setMethod( - f = "readSamples", - signature = "BrapiConPHG", - definition = function(object) { - urls <- getVTList(object) - - sampleDF <- parseJSON(urls$sampleURL) - sampleDF <- sampleDF$result$data - - if (object@methodID == "DEMO") { - return(utils::head(tibble::as_tibble(sampleDF), n = 25)) - } else{ - return(tibble::as_tibble(sampleDF)) - } - } -) - - -## ---- -#' @title Retrieve available table data from a given PHG method -#' -#' @description Retrieves table information from a given PHG method. -#' Data returned is a \code{matrix} object. -#' -#' @param object A \code{BrapiConPHG} object. -#' @param ... Additional arguments to be passed. -#' -#' @rdname readTable -#' -#' @export -setGeneric("readTable", function(object, ...) { - standardGeneric("readTable") -}) - -#' @rdname readTable -#' -#' @param numCores Number of processing cores for faster processing times. -#' @param transpose Do you want to transpose table? -#' -#' @importFrom cli cli_progress_bar -#' @importFrom cli cli_progress_done -#' @importFrom cli cli_progress_step -#' @importFrom cli cli_progress_update -#' @importFrom httr content -#' @importFrom httr GET -#' @importFrom jsonlite fromJSON -#' @importFrom parallel mclapply -#' -#' @export -setMethod( - f = "readTable", - signature = "BrapiConPHG", - definition = function(object, numCores = NULL, transpose = TRUE) { - # Logic checks - if (is.null(numCores)) { - numCores <- 1 - } - if (!is.numeric(numCores)) { - stop("numCores parameter must be numeric or NULL") - } - - # Get URLs - urls <- getVTList(object) - - # Calculate total pages - - if (object@methodID == "DEMO") { - totalVariants <- 1000 - totalPages <- ceiling(totalVariants / 250) - } else { - methods <- availablePHGMethods(object) - totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants - totalPages <- ceiling(totalVariants / 10000) - } - - # Download each page (iterative) - # TODO - can we async this? (e.g. futures) - allResp <- vector("list", totalPages) - # cli::cli_progress_step("Establishing connection") - message("Establishing connection") - # cli::cli_progress_bar(" - Downloading: ", total = totalPages) - message("Downloading:") - pb <- utils::txtProgressBar( - style = 3, - char = "=", - min = 1, - max = totalPages - ) - for (i in seq_len(totalPages)) { - currentUrl <- sprintf(urls$tableURL, i - 1, 0) - allResp[[i]] <- httr::GET(currentUrl) - utils::setTxtProgressBar(pb, i) - # cli::cli_progress_update() - } - close(pb) - # cli::cli_progress_done() - - # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) - brapiHapIdStringToInt <- function(x) { - id <- strsplit(x, "/")[[1]][1] - ifelse(id == ".", return(NA), return(as.integer(id))) - } - - # F2 - process matrix slices (convert from JSON to int matrix) - processMatrix <- function(x) { - xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") - xNew <- jsonlite::fromJSON(xNew) - xMat <- xNew$result$dataMatrices$dataMatrix[[1]] - colnames(xMat) <- xNew$result$callSetDbIds - rownames(xMat) <- xNew$result$variants - xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) - return(xMat) - } - - # Clean up data (parallel) - # cli::cli_progress_step("Cleaning data") - message("Cleaning data") - finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) - - # Bind all data into one matrix and return - # cli::cli_progress_step("Combining responses") - message("Combining responses") - if (transpose) { - unionMatrix <- t(do.call(rbind, finalMatrices)) - } else { - unionMatrix <- do.call(rbind, finalMatrices) - } - - return(unionMatrix) - } -) - - -## ---- -#' @title Read PHGDataset object from BrAPI PHG method -#' -#' @description Creates a \code{PHGDataset} object by reading sample, -#' reference range, and feature data information. -#' -#' @param object A \code{BrapiConPHG} object. -#' @param ... Additional arguments to be passed. -#' -#' @rdname readPHGDatasetFromBrapi -#' -#' @export -setGeneric("readPHGDatasetFromBrapi", function(object, ...) { - standardGeneric("readPHGDatasetFromBrapi") -}) - -#' @rdname readTable -#' -#' @export -setMethod( - f = "readPHGDatasetFromBrapi", - signature = "BrapiConPHG", - definition = function(object, ...) { - - urls <- getVTList(object) - - hapArray <- readTable(object, transpose = FALSE) - - # cli::cli_progress_step("Getting ref range data") - message("Getting ref range data") - rr <- readRefRanges(object) - # cli::cli_progress_step("Getting sample data") - message("Getting sample data") - samples <- readSamples(object) - - colnames(hapArray) <- samples$sampleName - - phgSE <- SummarizedExperiment::SummarizedExperiment( - assays = list(hapID = hapArray), - rowRanges = rr, - colData = samples - ) - - return(methods::new(Class = "PHGDataSet", phgSE)) - } -) - - diff --git a/R/class_all_generics.R b/R/class_all_generics.R index e69de29..271dbdd 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -0,0 +1,146 @@ +## ---- +#' @title Return URL path +#' +#' @description +#' Returns the Uniform Resource Locator (URL) of a \code{BrapiCon} object. +#' +#' @param object a \code{\linkS4class{BrapiCon}} object. +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname brapiURL +#' @export +setGeneric("brapiURL", function(object, ...) standardGeneric("brapiURL")) + + +## ---- +#' @title Return host data +#' +#' @description +#' Returns the host information for a given object +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname host +#' @export +setGeneric("host", function(object, ...) standardGeneric("host")) + + +## ---- +#' @title Return port value +#' +#' @description +#' Returns the port information for a given object +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname port +#' @export +setGeneric("port", function(object, ...) standardGeneric("port")) + + +## ---- +#' @title Return BrAPI version ID +#' +#' @description +#' Returns the version ID for a BrAPI-compliant PHG server +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname brapiVersion +#' @export +setGeneric("brapiVersion", function(object, ...) standardGeneric("brapiVersion")) + + +## ---- +#' @title Return available PHG methods +#' +#' @description +#' Returns a collection of available PHG methods and metadata +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname showPHGMethods +#' @export +setGeneric("showPHGMethods", function(object, ...) standardGeneric("showPHGMethods")) + + +## ---- +#' @title Return server information +#' +#' @description +#' Get avaiable BrAPI calls from BrAPI compliant PHG server +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname serverInfo +#' @export +setGeneric("serverInfo", function(object, ...) standardGeneric("serverInfo")) + + +## ---- +#' @title Return reference ranges +#' +#' @description +#' Get reference range data for a given PHG method +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readRefRanges +#' @export +setGeneric("readRefRanges", function(object, ...) standardGeneric("readRefRanges")) + + +## ---- +#' @title Return samples IDs +#' +#' @description +#' Gets sample ID data for a given PHG method +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readSamples +#' @export +setGeneric("readSamples", function(object, ...) standardGeneric("readSamples")) + + +## ---- +#' @title Return haplotype IDs +#' +#' @description +#' Gets haplotype ID for given samples and reference ranges for PHG method +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readHaplotypeIds +#' @export +setGeneric("readHaplotypeIds", function(object, ...) standardGeneric("readHaplotypeIds")) + + +## ---- +#' @title Return a PHGDataSet +#' +#' @description +#' Creates a \code{\linkS4class{PHGDataSet}} for a given PHG method. This will +#' return all 3 primary sources of data (samples, reference ranges, and +#' haplotype IDs). +#' +#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname readPHGDataSet +#' @export +setGeneric("readPHGDataSet", function(object, ...) standardGeneric("readPHGDataSet")) + + + + + + diff --git a/R/class_phg_con_local.R b/R/class_phg_con_local.R new file mode 100644 index 0000000..7f2ab6c --- /dev/null +++ b/R/class_phg_con_local.R @@ -0,0 +1,129 @@ +## ---- +#' @title A PHGLocalCon Class +#' +#' @description +#' Class \code{PHGLocalCon} defines a \code{rPHG} class for storing +#' local config file data. +#' +#' @slot host Location path of local SQLite or Postgres database +#' @slot dbName Name of database +#' @slot dbType Type of database +#' @slot configFilePath Path to configuration file +#' +#' @name PHGLocalCon-class +#' @rdname PHGLocalCon-class +#' @exportClass PHGLocalCon +setClass( + Class = "PHGLocalCon", + representation = representation( + host = "character", + dbName = "character", + dbType = "character", + configFilePath = "character" + ), + prototype = prototype( + host = NA_character_, + dbName = NA_character_, + dbType = NA_character_, + configFilePath = NA_character_ + ) +) + + +## ---- +#' @title PHGLocalCon validation +#' +#' @name PHGLocalCon-validity +#' +#' @description +#' Checks for correct data entry into \code{PHGLocalCon} class +#' +#' @param object A \code{\linkS4class{PHGLocalCon}} object +setValidity("PHGLocalCon", function(object) { + errors <- character() + + if (!file.exists(object@configFilePath)) { + msg <- "Path to config file does not exist" + errors <- c(errors, msg) + } + + if (length(errors) == 0) { + return(TRUE) + } else { + return(errors) + } +}) + + +## ---- +#' @title Show methods for PHGLocalCon objects +#' +#' @description +#' Prints out information regarding properties from the \code{PHGLocalCon} +#' class to the console +#' +#' @param object A \code{\linkS4class{PHGLocalCon}} object +#' +#' @docType methods +#' @rdname PHGLocalCon-class +#' @aliases show,PHGLocalCon-method +setMethod( + f = "show", + signature = "PHGLocalCon", + definition = function(object) { + pointerSymbol <- cli::col_green(cli::symbol$pointer) + msg <- c( + paste0("A ", cli::style_bold("PHGLocalCon"), " connection object"), + paste0(" ", pointerSymbol, " Host......: ", object@host), + paste0(" ", pointerSymbol, " DB Name...: ", object@dbName), + paste0(" ", pointerSymbol, " DB Type...: ", object@dbType) + ) + + cat(msg, sep = "\n") + } +) + + +## ---- +#' @title Helper functio to construct a \code{PHGLocalCon} object +#' +#' @description +#' Creates a \code{\linkS4class{PHGLocalCon}} object to be used to read PHG +#' DB data for a given set of PHG-related methods. +#' +#' @param file A path to a PHG configuration file +#' +#' @export +PHGLocalCon <- function(file) { + configCatcher(file) + + configProperties <- parseConfigFile(file) + + methods::new( + Class = "PHGLocalCon", + host = configProperties$host, + dbName = configProperties$DB |> basename(), + dbType = configProperties$DBtype, + configFilePath = normalizePath(file) + ) +} + + + + + + + + + + + + + + + + + + + + diff --git a/R/brapi_classes.R b/R/class_phg_con_server.R similarity index 62% rename from R/brapi_classes.R rename to R/class_phg_con_server.R index 5bd812d..8746c47 100644 --- a/R/brapi_classes.R +++ b/R/class_phg_con_server.R @@ -1,16 +1,4 @@ -##################################################################### -## -## Overview: -## This file houses BrAPI-related functions for: -## * Class representation -## * Validity checking classes -## * Class instantiation (e.g. helper functions) -## -##################################################################### - - -# === BrapiCon Class ================================================ - +## ---- #' @title An S4 BrapiCon Class #' #' @description Class \code{BrapiCon} defines a \code{rPHG} @@ -49,6 +37,7 @@ setClass( ) +## ---- #' @title BrAPI connection validation #' #' @name BrapiCon-validity @@ -89,6 +78,7 @@ setValidity("BrapiCon", function(object) { }) +## ---- #' @title BrapiCon object and constructors #' #' @description \code{BrapiCon} is the primary container for housing BrAPI @@ -105,10 +95,12 @@ setValidity("BrapiCon", function(object) { #' @return A \code{BrapiCon} object. #' #' @export -BrapiCon <- function(host, - port = NULL, - protocol = c("http", "https"), - version = c("v2", "v1")) { +BrapiCon <- function( + host, + port = NULL, + protocol = c("http", "https"), + version = c("v2", "v1") +) { if (missing(host)) stop("A URL host is needed to make this class.") @@ -133,59 +125,54 @@ BrapiCon <- function(host, } +## ---- +#' @rdname brapiURL +#' @export +setMethod( + f = "brapiURL", + signature = signature(object = "BrapiCon"), + definition = function(object) { + return(object@url) + } +) - -# === BrapiConPHG Class ============================================= +## ---- +#' @rdname host +#' @export +setMethod( + f = "host", + signature = signature(object = "BrapiCon"), + definition = function(object) { + return(object@host) + } +) -#' @title An S4 BrapiConPHG Class -#' -#' @description Class \code{BrapiConPHG} defines a \code{rPHG} -#' Class for storing BrAPI connection data plust PHG coordinate info. -#' -#' @slot methodID A PHG method identifier. -#' @slot refRangeFilter Reference range selection URL parameters. -#' @slot sampleFilter Sample / taxa selection URL parameters. -#' -#' @name BrapiConPHG-class -#' @rdname BrapiConPHG-class -#' @exportClass BrapiConPHG -setClass( - Class = "BrapiConPHG", - contains = "BrapiCon", - slots = c( - methodID = "character", - refRangeFilter = "character", - sampleFilter = "character" - ), - prototype = list( - methodID = NA_character_, - refRangeFilter = NA_character_, - sampleFilter = NA_character_ - ) +## ---- +#' @rdname serverInfo +#' @export +setMethod( + f = "serverInfo", + signature = signature(object = "BrapiCon"), + definition = function(object) { + json2tibble(object, "serverinfo", "calls") + } ) -#' @title Helper function to construct BrapiConPHG object -#' -#' @description Creates a \code{BrapiConPHG} object to be used to read and -#' filter data from a given BrAPI endpoint given a verified PHG method. -#' -#' @param brapiObj A \code{BrapiCon} object. -#' @param x A PHG method identifier. -#' +## ---- +#' @rdname showPHGMethods #' @export -PHGMethod <- function(brapiObj, x) { - - # For demo purposes only! - # if (x == "DEMO") x <- "NAM_GBS_Alignments_PATHS" - - methods::new( - "BrapiConPHG", - brapiObj, - methodID = x - ) -} +setMethod( + f = "showPHGMethods", + signature = signature(object = "BrapiCon"), + definition = function(object) { + ## Temp fix to return proper methods + fullTable <- json2tibble(object, "variantTables") + filtTable <- fullTable[fullTable$numSamples > 100, ] # arbitrary n + return(filtTable) + } +) diff --git a/R/classes.R b/R/class_phg_dataset.R similarity index 100% rename from R/classes.R rename to R/class_phg_dataset.R diff --git a/R/class_phg_method.R b/R/class_phg_method.R new file mode 100644 index 0000000..57615cc --- /dev/null +++ b/R/class_phg_method.R @@ -0,0 +1,295 @@ +## ---- +#' @title An S4 BrapiConPHG Class +#' +#' @description Class \code{BrapiConPHG} defines a \code{rPHG} +#' Class for storing BrAPI connection data plust PHG coordinate info. +#' +#' @slot methodID A PHG method identifier. +#' @slot refRangeFilter Reference range selection URL parameters. +#' @slot sampleFilter Sample / taxa selection URL parameters. +#' +#' @name BrapiConPHG-class +#' @rdname BrapiConPHG-class +#' @exportClass BrapiConPHG +setClass( + Class = "BrapiConPHG", + contains = "BrapiCon", + slots = c( + methodID = "character", + refRangeFilter = "character", + sampleFilter = "character" + ), + prototype = list( + methodID = NA_character_, + refRangeFilter = NA_character_, + sampleFilter = NA_character_ + ) +) + + +## ---- +#' @title Helper function to construct BrapiConPHG object +#' +#' @description Creates a \code{BrapiConPHG} object to be used to read and +#' filter data from a given BrAPI endpoint given a verified PHG method. +#' +#' @param brapiObj A \code{BrapiCon} object. +#' @param x A PHG method identifier. +#' +#' @export +PHGMethod <- function(brapiObj, x) { + + # For demo purposes only! + # if (x == "DEMO") x <- "NAM_GBS_Alignments_PATHS" + + methods::new( + "BrapiConPHG", + brapiObj, + methodID = x + ) +} + + +## ---- +#' @title Show method for BrapiConPHG objects +#' +#' @description Prints out the information from the BrAPI connection object +#' including server status codes. See this +#' \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} +#' for further details about what these codes mean. +#' +#' @param object a \code{\linkS4class{BrapiConPHG}} object. +#' +#' @docType methods +#' @name show +#' @rdname show +#' @aliases show,BrapiConPHG-method +setMethod( + f = "show", + signature = "BrapiConPHG", + definition = function(object) { + # cli::cli_div(theme = list(ul = list(`margin-left` = 2, before = ""))) + + # activeSlotMsg <- cli::symbol$square_small_filled + # inactiveSlotMsg <- cli::symbol$square_small + activeSlotMsg <- "[x]" + inactiveSlotMsg <- "[ ]" + + rrCheck <- ifelse( + test = is.na(object@refRangeFilter), + yes = inactiveSlotMsg, + no = activeSlotMsg + ) + sampleCheck <- ifelse( + test = is.na(object@sampleFilter), + yes = inactiveSlotMsg, + no = activeSlotMsg + ) + + cat(" PHG pointer object>\n") + cat(" method: ", object@methodID, "\n") + cat(" variant filter: ", rrCheck, "\n") + cat(" sample filter: ", sampleCheck, "\n") + } +) + + +## ---- +#' @rdname readRefRanges +#' +#' @importFrom GenomicRanges GRanges +#' @importFrom IRanges IRanges +#' @importFrom rJava .jevalArray +#' @importFrom rJava .jnew +#' +#' @export +setMethod( + f = "readRefRanges", + signature = "BrapiConPHG", + definition = function(object) { + urls <- getVTList(object) + + pageSize <- ifelse( + grepl("variants$", urls$rangeURL), + "?pageSize=", + "&pageSize=" + ) + + if (object@methodID == "DEMO") { + rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "1000")) + } else { + rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "150000")) + } + rrDF <- rrDF$result$data + + gr <- GenomicRanges::GRanges( + seqnames = rrDF$referenceName, + ranges = IRanges::IRanges( + start = rrDF$start, + end = rrDF$end + ), + variantDbId = rrDF$variantDbId + ) + + return(gr) + + } +) + + +## ---- +#' @rdname readSamples +#' +#' @importFrom tibble as_tibble +#' +#' @export +setMethod( + f = "readSamples", + signature = "BrapiConPHG", + definition = function(object) { + urls <- getVTList(object) + + sampleDF <- parseJSON(urls$sampleURL) + sampleDF <- sampleDF$result$data + + if (object@methodID == "DEMO") { + return(utils::head(tibble::as_tibble(sampleDF), n = 25)) + } else{ + return(tibble::as_tibble(sampleDF)) + } + } +) + + +## ---- +#' @rdname readHaplotypeIds +#' +#' @param numCores Number of processing cores for faster processing times. +#' @param transpose Do you want to transpose table? +#' +#' @importFrom cli cli_progress_bar +#' @importFrom cli cli_progress_done +#' @importFrom cli cli_progress_step +#' @importFrom cli cli_progress_update +#' @importFrom httr content +#' @importFrom httr GET +#' @importFrom jsonlite fromJSON +#' @importFrom parallel mclapply +#' +#' @export +setMethod( + f = "readHaplotypeIds", + signature = "BrapiConPHG", + definition = function(object, numCores = NULL, transpose = TRUE) { + # Logic checks + if (is.null(numCores)) { + numCores <- 1 + } + if (!is.numeric(numCores)) { + stop("numCores parameter must be numeric or NULL") + } + + # Get URLs + urls <- getVTList(object) + + # Calculate total pages + + if (object@methodID == "DEMO") { + totalVariants <- 1000 + totalPages <- ceiling(totalVariants / 250) + } else { + methods <- availablePHGMethods(object) + totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants + totalPages <- ceiling(totalVariants / 10000) + } + + # Download each page (iterative) + # TODO - can we async this? (e.g. futures) + allResp <- vector("list", totalPages) + # cli::cli_progress_step("Establishing connection") + message("Establishing connection") + # cli::cli_progress_bar(" - Downloading: ", total = totalPages) + message("Downloading:") + pb <- utils::txtProgressBar( + style = 3, + char = "=", + min = 1, + max = totalPages + ) + for (i in seq_len(totalPages)) { + currentUrl <- sprintf(urls$tableURL, i - 1, 0) + allResp[[i]] <- httr::GET(currentUrl) + utils::setTxtProgressBar(pb, i) + # cli::cli_progress_update() + } + close(pb) + # cli::cli_progress_done() + + # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) + brapiHapIdStringToInt <- function(x) { + id <- strsplit(x, "/")[[1]][1] + ifelse(id == ".", return(NA), return(as.integer(id))) + } + + # F2 - process matrix slices (convert from JSON to int matrix) + processMatrix <- function(x) { + xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") + xNew <- jsonlite::fromJSON(xNew) + xMat <- xNew$result$dataMatrices$dataMatrix[[1]] + colnames(xMat) <- xNew$result$callSetDbIds + rownames(xMat) <- xNew$result$variants + xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) + return(xMat) + } + + # Clean up data (parallel) + # cli::cli_progress_step("Cleaning data") + message("Cleaning data") + finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) + + # Bind all data into one matrix and return + # cli::cli_progress_step("Combining responses") + message("Combining responses") + if (transpose) { + unionMatrix <- t(do.call(rbind, finalMatrices)) + } else { + unionMatrix <- do.call(rbind, finalMatrices) + } + + return(unionMatrix) + } +) + + +## ---- +#' @rdname readPHGDataSet +#' +#' @export +setMethod( + f = "readPHGDataSet", + signature = "BrapiConPHG", + definition = function(object, ...) { + + urls <- getVTList(object) + + hapArray <- readTable(object, transpose = FALSE) + + # cli::cli_progress_step("Getting ref range data") + message("Getting ref range data") + rr <- readRefRanges(object) + # cli::cli_progress_step("Getting sample data") + message("Getting sample data") + samples <- readSamples(object) + + colnames(hapArray) <- samples$sampleName + + phgSE <- SummarizedExperiment::SummarizedExperiment( + assays = list(hapID = hapArray), + rowRanges = rr, + colData = samples + ) + + return(methods::new(Class = "PHGDataSet", phgSE)) + } +) + diff --git a/R/brapi_defunct.R b/R/deprecated_brapi.R similarity index 100% rename from R/brapi_defunct.R rename to R/deprecated_brapi.R diff --git a/R/show_phg_methods.R b/R/show_phg_methods.R index ccc6102..79aad91 100644 --- a/R/show_phg_methods.R +++ b/R/show_phg_methods.R @@ -1,58 +1,59 @@ -#' @title Get DB PHG methods for graph building -#' -#' @description Gets all available PHG methods from the graph database -#' using a path parameter to the database configuration file. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' -#' @importFrom rJava .jcast -#' @importFrom rJava .jnull -#' @importFrom rJava J -#' @importFrom rJava new -#' @importFrom tibble tibble -#' -#' @export -showPHGMethods <- function(configFile) { - - configCatcher(configFile) - - ## Get table report plugin and pull data from DB - plugin <- rJava::new( - rJava::J("net/maizegenetics/pangenome/api/MethodTableReportPlugin") - ) - plugin <- plugin$configFile(configFile) - ds <- plugin$performFunction( - rJava::.jnull("net/maizegenetics/plugindef/DataSet") - ) - datum <- ds$getData(0L) - tabRep <- rJava::.jcast( - datum$getData(), - new.class = "net/maizegenetics/util/TableReport" - ) - resultVectors <- rJava::J( - "net/maizegenetics/plugindef/GenerateRCode", - "tableReportToVectors", - tabRep - ) - - ## Get data vectors - data <- resultVectors$dataVector - - ## Convert to native R data frame - dfMethods <- tibble::tibble( - data$get(0L), - data$get(1L), - data$get(2L), - data$get(3L), - data$get(4L) - ) - - ## Convert names - names(dfMethods) <- resultVectors$columnNames - - ## Return object - return(dfMethods) -} +## #' @title Get DB PHG methods for graph building +## #' +## #' @description Gets all available PHG methods from the graph database +## #' using a path parameter to the database configuration file. +## #' +## #' @author Brandon Monier +## #' @author Peter Bradbury +## #' +## #' @param configFile Path to a configuration file for your graph database. +## #' +## #' @importFrom rJava .jcast +## #' @importFrom rJava .jnull +## #' @importFrom rJava J +## #' @importFrom rJava new +## #' @importFrom tibble tibble +## #' +## #' @export +## showPHGMethods <- function(configFile) { +## +## configCatcher(configFile) +## +## ## Get table report plugin and pull data from DB +## plugin <- rJava::new( +## rJava::J("net/maizegenetics/pangenome/api/MethodTableReportPlugin") +## ) +## plugin <- plugin$configFile(configFile) +## ds <- plugin$performFunction( +## rJava::.jnull("net/maizegenetics/plugindef/DataSet") +## ) +## datum <- ds$getData(0L) +## tabRep <- rJava::.jcast( +## datum$getData(), +## new.class = "net/maizegenetics/util/TableReport" +## ) +## resultVectors <- rJava::J( +## "net/maizegenetics/plugindef/GenerateRCode", +## "tableReportToVectors", +## tabRep +## ) +## +## ## Get data vectors +## data <- resultVectors$dataVector +## +## ## Convert to native R data frame +## dfMethods <- tibble::tibble( +## data$get(0L), +## data$get(1L), +## data$get(2L), +## data$get(3L), +## data$get(4L) +## ) +## +## ## Convert names +## names(dfMethods) <- resultVectors$columnNames +## +## ## Return object +## return(dfMethods) +## } +## \ No newline at end of file diff --git a/R/brapi_utilities.R b/R/utilities_brapi.R similarity index 100% rename from R/brapi_utilities.R rename to R/utilities_brapi.R diff --git a/R/utilities.R b/R/utilities_general.R similarity index 56% rename from R/utilities.R rename to R/utilities_general.R index 38d2f8b..4cf2064 100644 --- a/R/utilities.R +++ b/R/utilities_general.R @@ -1,18 +1,18 @@ # === Miscellaneous utilities for rPHG methods ====================== ## ---- -#' @title Create mock config file -#' -#' @description Creates a temporary PHG configuration file to access the -#' provided example database. Mainly for debugging and educational -#' purposes. -#' -#' @param file User defined output file -#' @param host Host service for database -#' @param user User ID for database access -#' @param password Password for database access -#' @param dbType Database architecture used -#' @param dbPath P +# @title Create mock config file +# +# @description Creates a temporary PHG configuration file to access the +# provided example database. Mainly for debugging and educational +# purposes. +# +# @param file User defined output file +# @param host Host service for database +# @param user User ID for database access +# @param password Password for database access +# @param dbType Database architecture used +# @param dbPath Path to DB createConfigFile <- function( file, host = "localhost", @@ -42,11 +42,11 @@ createConfigFile <- function( ## ---- -#' @title Logic support for config files -#' -#' @description Provides logic checking for config files used in PHG creation. -#' -#' @param configFile Path to a configuration file for your graph database. +# @title Logic support for config files +# +# @description Provides logic checking for config files used in PHG creation. +# +# @param configFile Path to a configuration file for your graph database. configCatcher <- function(configFile) { if (!file.exists(configFile)) { @@ -78,3 +78,32 @@ configCatcher <- function(configFile) { } +## ---- +# Parse components of config file into a list object +# +# @param file Path to a configuration file for database +parseConfigFile <- function(file) { + FIELDS <- c("host", "DB", "DBtype") + conLines <- readLines(file) + + properties <- vapply(FIELDS, \(x) getProperty(conLines, x), character(1)) + + return(setNames(as.list(properties), FIELDS)) +} + + +## ---- +# Get property from config file field +# +# @param configLines A character vector of config lines +# @param x A field value +getProperty <- function(configLines, x) { + regexField <- paste0("^", x, "=") + + property <- configLines[grepl(regexField, configLines)] |> + gsub("^.*=", "", x = _) + + return(property) +} + + diff --git a/inst/extdata/configSQLite.txt b/inst/extdata/configSQLite.txt index b9cdf79..33c2e74 100644 --- a/inst/extdata/configSQLite.txt +++ b/inst/extdata/configSQLite.txt @@ -1,7 +1,7 @@ host=localHost user=sqlite password=sqlite -DB=/home/bm646/Projects/rphg/inst/extdata/phgSmallSeq.db +DB=inst/extdata/phg_smallseq_test.db DBtype=sqlite minTaxa=1 minSites=5 diff --git a/man/BrapiCon-class.Rd b/man/BrapiCon-class.Rd index 28075a3..7cbc30d 100644 --- a/man/BrapiCon-class.Rd +++ b/man/BrapiCon-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_con_server.R \docType{class} \name{BrapiCon-class} \alias{BrapiCon-class} diff --git a/man/BrapiCon-validity.Rd b/man/BrapiCon-validity.Rd index b993c1f..69d85d4 100644 --- a/man/BrapiCon-validity.Rd +++ b/man/BrapiCon-validity.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_con_server.R \name{BrapiCon-validity} \alias{BrapiCon-validity} \title{BrAPI connection validation} diff --git a/man/BrapiCon.Rd b/man/BrapiCon.Rd index 07ac943..ccb199a 100644 --- a/man/BrapiCon.Rd +++ b/man/BrapiCon.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_con_server.R \name{BrapiCon} \alias{BrapiCon} \title{BrapiCon object and constructors} diff --git a/man/BrapiConPHG-class.Rd b/man/BrapiConPHG-class.Rd index dbfd7ff..d92b979 100644 --- a/man/BrapiConPHG-class.Rd +++ b/man/BrapiConPHG-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_method.R \docType{class} \name{BrapiConPHG-class} \alias{BrapiConPHG-class} diff --git a/man/PHGDataSet-class.Rd b/man/PHGDataSet-class.Rd index ef54fa4..801d37d 100644 --- a/man/PHGDataSet-class.Rd +++ b/man/PHGDataSet-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/classes.R +% Please edit documentation in R/class_phg_dataset.R \docType{class} \name{PHGDataSet-class} \alias{PHGDataSet-class} diff --git a/man/PHGLocalCon-class.Rd b/man/PHGLocalCon-class.Rd new file mode 100644 index 0000000..11f4387 --- /dev/null +++ b/man/PHGLocalCon-class.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con_local.R +\docType{class} +\name{PHGLocalCon-class} +\alias{PHGLocalCon-class} +\alias{show,PHGLocalCon-method} +\title{A PHGLocalCon Class} +\usage{ +\S4method{show}{PHGLocalCon}(object) +} +\arguments{ +\item{object}{A \code{\linkS4class{PHGLocalCon}} object} +} +\description{ +Class \code{PHGLocalCon} defines a \code{rPHG} class for storing +local config file data. + +Prints out information regarding properties from the \code{PHGLocalCon} +class to the console +} +\section{Slots}{ + +\describe{ +\item{\code{host}}{Location path of local SQLite or Postgres database} + +\item{\code{dbName}}{Name of database} + +\item{\code{dbType}}{Type of database} + +\item{\code{configFilePath}}{Path to configuration file} +}} + diff --git a/man/PHGLocalCon-validity.Rd b/man/PHGLocalCon-validity.Rd new file mode 100644 index 0000000..839485d --- /dev/null +++ b/man/PHGLocalCon-validity.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con_local.R +\name{PHGLocalCon-validity} +\alias{PHGLocalCon-validity} +\title{PHGLocalCon validation} +\arguments{ +\item{object}{A \code{\linkS4class{PHGLocalCon}} object} +} +\description{ +Checks for correct data entry into \code{PHGLocalCon} class +} diff --git a/man/PHGLocalCon.Rd b/man/PHGLocalCon.Rd new file mode 100644 index 0000000..e5b015d --- /dev/null +++ b/man/PHGLocalCon.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con_local.R +\name{PHGLocalCon} +\alias{PHGLocalCon} +\title{Helper functio to construct a \code{PHGLocalCon} object} +\usage{ +PHGLocalCon(file) +} +\arguments{ +\item{file}{A path to a PHG configuration file} +} +\description{ +Creates a \code{\linkS4class{PHGLocalCon}} object to be used to read PHG +DB data for a given set of PHG-related methods. +} diff --git a/man/PHGMethod.Rd b/man/PHGMethod.Rd index fcad91e..093c083 100644 --- a/man/PHGMethod.Rd +++ b/man/PHGMethod.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_classes.R +% Please edit documentation in R/class_phg_method.R \name{PHGMethod} \alias{PHGMethod} \title{Helper function to construct BrapiConPHG object} diff --git a/man/availablePHGMethods.Rd b/man/availablePHGMethods.Rd deleted file mode 100644 index e776eb6..0000000 --- a/man/availablePHGMethods.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{availablePHGMethods} -\alias{availablePHGMethods} -\alias{availablePHGMethods,BrapiCon-method} -\title{Retrieve available PHG method data from BrAPI connection} -\usage{ -availablePHGMethods(object) - -\S4method{availablePHGMethods}{BrapiCon}(object) -} -\arguments{ -\item{object}{A \code{BrapiCon} object.} -} -\description{ -Retrieves data from the \code{variantTables} endpoint of a BrAPI - server. -} diff --git a/man/brapiURL.Rd b/man/brapiURL.Rd index 9b8197c..137c66b 100644 --- a/man/brapiURL.Rd +++ b/man/brapiURL.Rd @@ -1,18 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_getters_setters.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{brapiURL} \alias{brapiURL} \alias{brapiURL,BrapiCon-method} -\title{The URL of a \code{BrapiCon} object} +\title{Return URL path} \usage{ -brapiURL(x) +brapiURL(object, ...) -\S4method{brapiURL}{BrapiCon}(x) +\S4method{brapiURL}{BrapiCon}(object) } \arguments{ -\item{x}{a \linkS4class{BrapiCon} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object.} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -get or set the Uniform Resource Locator (URL) of a - \code{BrapiCon} object. +Returns the Uniform Resource Locator (URL) of a \code{BrapiCon} object. } diff --git a/man/brapiVersion.Rd b/man/brapiVersion.Rd new file mode 100644 index 0000000..7902db9 --- /dev/null +++ b/man/brapiVersion.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R +\name{brapiVersion} +\alias{brapiVersion} +\title{Return BrAPI version ID} +\usage{ +brapiVersion(object, ...) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the version ID for a BrAPI-compliant PHG server +} diff --git a/man/configCatcher.Rd b/man/configCatcher.Rd index 2bf00ad..7c01149 100644 --- a/man/configCatcher.Rd +++ b/man/configCatcher.Rd @@ -1,19 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/logic_support.R, R/utilities.R +% Please edit documentation in R/logic_support.R \name{configCatcher} \alias{configCatcher} \title{Logic support for config files} \usage{ -configCatcher(configFile) - configCatcher(configFile) } \arguments{ \item{configFile}{Path to a configuration file for your graph database.} } \description{ -Provides logic checking for config files used in PHG creation. - Provides logic checking for config files used in PHG creation. } \author{ diff --git a/man/createConfigFile.Rd b/man/createConfigFile.Rd deleted file mode 100644 index e62dda2..0000000 --- a/man/createConfigFile.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities.R -\name{createConfigFile} -\alias{createConfigFile} -\title{Create mock config file} -\usage{ -createConfigFile( - file, - host = "localhost", - user = "user", - password = "sqlite", - dbType = "sqlite", - dbPath = NULL -) -} -\arguments{ -\item{file}{User defined output file} - -\item{host}{Host service for database} - -\item{user}{User ID for database access} - -\item{password}{Password for database access} - -\item{dbType}{Database architecture used} - -\item{dbPath}{P} -} -\description{ -Creates a temporary PHG configuration file to access the - provided example database. Mainly for debugging and educational - purposes. -} diff --git a/man/filterRefRanges.Rd b/man/filterRefRanges.Rd deleted file mode 100644 index 0ef9fa3..0000000 --- a/man/filterRefRanges.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{filterRefRanges} -\alias{filterRefRanges} -\title{Filter reference ranges from given PHG method} -\usage{ -filterRefRanges(x, gr = NULL, chromosome = NULL, start = NULL, end = NULL) -} -\arguments{ -\item{x}{A \code{BrapiConPHG} object.} - -\item{gr}{A \code{GRanges} object. Houses genomic range information for -filter.} - -\item{chromosome}{A vector of chromosome ids of type \code{character}. Can -be of length one to size \code{n}. If used, this will return all reference -ranges within a given chromosome.} - -\item{start}{A vector of start positions of type \code{numeric}. If used, -an equal number of \code{end} elements will be needed to avoid error.} - -\item{end}{A vector of end positions of type \code{numeric}. These will -link up with the \code{start} positions. Must be equal to the \code{start} -parameter.} -} -\description{ -Filters reference ranges for a given PHG method by - manipulation of BrAPI samples URL call. For a given query, reference - ranges will be returned if they overlap with a user-defined range. - Uses 1-based coordinate information. -} diff --git a/man/filterSamples.Rd b/man/filterSamples.Rd deleted file mode 100644 index 20c862f..0000000 --- a/man/filterSamples.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{filterSamples} -\alias{filterSamples} -\title{Filter samples from given PHG method} -\usage{ -filterSamples(x, samples) -} -\arguments{ -\item{x}{A \code{BrapiConPHG} object.} - -\item{samples}{A vector of taxa ID of type \code{character}.} -} -\description{ -Filters samples for a given PHG method by manipulation of BrAPI - samples URL call. Returns exact matches only. If query is not exact match, - no data will be returned for that given sample. -} diff --git a/man/getVTList.Rd b/man/getVTList.Rd index df9ceae..94dde7a 100644 --- a/man/getVTList.Rd +++ b/man/getVTList.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_utilities.R +% Please edit documentation in R/utilities_brapi.R \name{getVTList} \alias{getVTList} \title{Retrieve variant table BrAPI URLs} diff --git a/man/hapIDMatrix.Rd b/man/hapIDMatrix.Rd deleted file mode 100644 index 5f24304..0000000 --- a/man/hapIDMatrix.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hap_id_matrix.R -\name{hapIDMatrix} -\alias{hapIDMatrix} -\title{Generate a haplotype ID matrix} -\usage{ -hapIDMatrix(phgObject) -} -\arguments{ -\item{phgObject}{A PHG object.} -} -\description{ -Generates a haplotype ID matrix from a PHG object. -} -\author{ -Brandon Monier - -Peter Bradbury -} diff --git a/man/host.Rd b/man/host.Rd new file mode 100644 index 0000000..e2a1e14 --- /dev/null +++ b/man/host.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R +\name{host} +\alias{host} +\alias{host,BrapiCon-method} +\title{Return host data} +\usage{ +host(object, ...) + +\S4method{host}{BrapiCon}(object) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the host information for a given object +} diff --git a/man/json2tibble.Rd b/man/json2tibble.Rd index bb2aa4b..f2bdfba 100644 --- a/man/json2tibble.Rd +++ b/man/json2tibble.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_utilities.R +% Please edit documentation in R/utilities_brapi.R \name{json2tibble} \alias{json2tibble} \title{JSON to tibble converter} diff --git a/man/parseJSON.Rd b/man/parseJSON.Rd index eec53a0..1b5357d 100644 --- a/man/parseJSON.Rd +++ b/man/parseJSON.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_utilities.R +% Please edit documentation in R/utilities_brapi.R \name{parseJSON} \alias{parseJSON} \title{URL checker} diff --git a/man/port.Rd b/man/port.Rd new file mode 100644 index 0000000..54879e7 --- /dev/null +++ b/man/port.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R +\name{port} +\alias{port} +\title{Return port value} +\usage{ +port(object, ...) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the port information for a given object +} diff --git a/man/readHaplotypeIds.Rd b/man/readHaplotypeIds.Rd new file mode 100644 index 0000000..05f9f76 --- /dev/null +++ b/man/readHaplotypeIds.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +\name{readHaplotypeIds} +\alias{readHaplotypeIds} +\alias{readHaplotypeIds,BrapiConPHG-method} +\title{Return haplotype IDs} +\usage{ +readHaplotypeIds(object, ...) + +\S4method{readHaplotypeIds}{BrapiConPHG}(object, numCores = NULL, transpose = TRUE) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} + +\item{numCores}{Number of processing cores for faster processing times.} + +\item{transpose}{Do you want to transpose table?} +} +\description{ +Gets haplotype ID for given samples and reference ranges for PHG method +} diff --git a/man/readPHGDataSet.Rd b/man/readPHGDataSet.Rd new file mode 100644 index 0000000..f69458d --- /dev/null +++ b/man/readPHGDataSet.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +\name{readPHGDataSet} +\alias{readPHGDataSet} +\alias{readPHGDataSet,BrapiConPHG-method} +\title{Return a PHGDataSet} +\usage{ +readPHGDataSet(object, ...) + +\S4method{readPHGDataSet}{BrapiConPHG}(object, ...) +} +\arguments{ +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Creates a \code{\linkS4class{PHGDataSet}} for a given PHG method. This will +return all 3 primary sources of data (samples, reference ranges, and +haplotype IDs). +} diff --git a/man/readPHGDatasetFromBrapi.Rd b/man/readPHGDatasetFromBrapi.Rd deleted file mode 100644 index c8423a5..0000000 --- a/man/readPHGDatasetFromBrapi.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{readPHGDatasetFromBrapi} -\alias{readPHGDatasetFromBrapi} -\title{Read PHGDataset object from BrAPI PHG method} -\usage{ -readPHGDatasetFromBrapi(object, ...) -} -\arguments{ -\item{object}{A \code{BrapiConPHG} object.} - -\item{...}{Additional arguments to be passed.} -} -\description{ -Creates a \code{PHGDataset} object by reading sample, - reference range, and feature data information. -} diff --git a/man/readRefRanges.Rd b/man/readRefRanges.Rd index 7544428..d572bd3 100644 --- a/man/readRefRanges.Rd +++ b/man/readRefRanges.Rd @@ -1,18 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R \name{readRefRanges} \alias{readRefRanges} \alias{readRefRanges,BrapiConPHG-method} -\title{Retrieve available ref range data from a given PHG method} +\title{Return reference ranges} \usage{ -readRefRanges(object) +readRefRanges(object, ...) \S4method{readRefRanges}{BrapiConPHG}(object) } \arguments{ -\item{object}{A \code{BrapiConPHG} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Retrieves reference range information from a given PHG method. - Data returned is (1) chromosome, (2) start, and (3) stop coordinates. +Get reference range data for a given PHG method } diff --git a/man/readSamples.Rd b/man/readSamples.Rd index 5d35031..5c045db 100644 --- a/man/readSamples.Rd +++ b/man/readSamples.Rd @@ -1,19 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R \name{readSamples} \alias{readSamples} \alias{readSamples,BrapiConPHG-method} -\title{Retrieve available sample data from a given PHG method} +\title{Return samples IDs} \usage{ -readSamples(object) +readSamples(object, ...) \S4method{readSamples}{BrapiConPHG}(object) } \arguments{ -\item{object}{A \code{BrapiConPHG} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Retrieves sample information from a given PHG method. - Data returned is (1) sample name, (2) sample DB ID, (3) description, - and (4) additional information. +Gets sample ID data for a given PHG method } diff --git a/man/readTable.Rd b/man/readTable.Rd deleted file mode 100644 index 2e6980d..0000000 --- a/man/readTable.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{readTable} -\alias{readTable} -\alias{readTable,BrapiConPHG-method} -\alias{readPHGDatasetFromBrapi,BrapiConPHG-method} -\title{Retrieve available table data from a given PHG method} -\usage{ -readTable(object, ...) - -\S4method{readTable}{BrapiConPHG}(object, numCores = NULL, transpose = TRUE) - -\S4method{readPHGDatasetFromBrapi}{BrapiConPHG}(object, ...) -} -\arguments{ -\item{object}{A \code{BrapiConPHG} object.} - -\item{...}{Additional arguments to be passed.} - -\item{numCores}{Number of processing cores for faster processing times.} - -\item{transpose}{Do you want to transpose table?} -} -\description{ -Retrieves table information from a given PHG method. - Data returned is a \code{matrix} object. -} diff --git a/man/referenceSets.Rd b/man/referenceSets.Rd deleted file mode 100644 index c165324..0000000 --- a/man/referenceSets.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{referenceSets} -\alias{referenceSets} -\alias{referenceSets,BrapiCon-method} -\title{Retrieve reference set data from BrAPI connection} -\usage{ -referenceSets(object) - -\S4method{referenceSets}{BrapiCon}(object) -} -\arguments{ -\item{object}{A \code{BrapiCon} object.} -} -\description{ -Retrieves data from the \code{referenceSets} endpoint of a BrAPI - server. -} diff --git a/man/references.Rd b/man/references.Rd deleted file mode 100644 index b6819a5..0000000 --- a/man/references.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R -\name{references} -\alias{references} -\alias{references,BrapiCon-method} -\title{Retrieve reference data from BrAPI connection} -\usage{ -references(object) - -\S4method{references}{BrapiCon}(object) -} -\arguments{ -\item{object}{A \code{BrapiCon} object.} -} -\description{ -Retrieves data from the \code{references} endpoint of a BrAPI - server. -} diff --git a/man/serverInfo.Rd b/man/serverInfo.Rd index 54b5e17..b1f7055 100644 --- a/man/serverInfo.Rd +++ b/man/serverInfo.Rd @@ -1,18 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{serverInfo} \alias{serverInfo} \alias{serverInfo,BrapiCon-method} -\title{Retrieve server info data from BrAPI connection} +\title{Return server information} \usage{ -serverInfo(object) +serverInfo(object, ...) \S4method{serverInfo}{BrapiCon}(object) } \arguments{ -\item{object}{A \code{BrapiCon} object.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Retrieves data from the \code{serverinfo} endpoint of a BrAPI - server. +Get avaiable BrAPI calls from BrAPI compliant PHG server } diff --git a/man/show.Rd b/man/show.Rd index 6e95b1e..bfbc86e 100644 --- a/man/show.Rd +++ b/man/show.Rd @@ -1,25 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/brapi_methods.R +% Please edit documentation in R/class_phg_method.R \docType{methods} \name{show} \alias{show} -\alias{show,BrapiCon-method} \alias{show,BrapiConPHG-method} -\title{Show method for BrapiCon objects} +\title{Show method for BrapiConPHG objects} \usage{ -\S4method{show}{BrapiCon}(object) - \S4method{show}{BrapiConPHG}(object) } \arguments{ \item{object}{a \code{\linkS4class{BrapiConPHG}} object.} } \description{ -Prints out the information from the BrAPI connection object - including server status codes. See this - \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} - for further details about what these codes mean. - Prints out the information from the BrAPI connection object including server status codes. See this \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} diff --git a/man/showPHGMethods.Rd b/man/showPHGMethods.Rd index 542d7f9..261bfa0 100644 --- a/man/showPHGMethods.Rd +++ b/man/showPHGMethods.Rd @@ -1,20 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/show_phg_methods.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{showPHGMethods} \alias{showPHGMethods} -\title{Get DB PHG methods for graph building} +\alias{showPHGMethods,BrapiCon-method} +\title{Return available PHG methods} \usage{ -showPHGMethods(configFile) +showPHGMethods(object, ...) + +\S4method{showPHGMethods}{BrapiCon}(object) } \arguments{ -\item{configFile}{Path to a configuration file for your graph database.} +\item{object}{a \code{\linkS4class{BrapiCon}} object} + +\item{...}{Additional arguments, for use in specific methods} } \description{ -Gets all available PHG methods from the graph database - using a path parameter to the database configuration file. -} -\author{ -Brandon Monier - -Peter Bradbury +Returns a collection of available PHG methods and metadata } From 40b379085f2579a8c1bda624174f1ea4512fab0d Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 18 Aug 2023 17:32:59 -0400 Subject: [PATCH 13/35] Add better config file and server logic --- NAMESPACE | 4 +- R/class_all_generics.R | 24 ++-- R/class_phg_con_local.R | 16 +-- R/class_phg_con_server.R | 134 +++++++++++++----- R/class_phg_method.R | 2 +- R/logic_support.R | 41 ------ R/utilities_brapi.R | 33 ++++- R/utilities_general.R | 54 +++++-- man/PHGLocalCon.Rd | 2 +- ...rapiCon-class.Rd => PHGServerCon-class.Rd} | 18 ++- ...n-validity.Rd => PHGServerCon-validity.Rd} | 8 +- man/{BrapiCon.Rd => PHGServerCon.Rd} | 14 +- man/brapiURL.Rd | 6 +- man/brapiVersion.Rd | 2 +- man/configCatcher.Rd | 17 --- man/host.Rd | 6 +- man/port.Rd | 2 +- man/readHaplotypeIds.Rd | 2 +- man/readPHGDataSet.Rd | 2 +- man/readRefRanges.Rd | 2 +- man/readSamples.Rd | 2 +- man/serverInfo.Rd | 6 +- man/showPHGMethods.Rd | 6 +- 23 files changed, 233 insertions(+), 170 deletions(-) delete mode 100644 R/logic_support.R rename man/{BrapiCon-class.Rd => PHGServerCon-class.Rd} (60%) rename man/{BrapiCon-validity.Rd => PHGServerCon-validity.Rd} (51%) rename man/{BrapiCon.Rd => PHGServerCon.Rd} (73%) delete mode 100644 man/configCatcher.Rd diff --git a/NAMESPACE b/NAMESPACE index 5ce343b..0477bf6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,8 @@ # Generated by roxygen2: do not edit by hand -export(BrapiCon) export(PHGLocalCon) export(PHGMethod) +export(PHGServerCon) export(brapiURL) export(brapiVersion) export(getVTList) @@ -27,10 +27,10 @@ export(serverInfo) export(showPHGMethods) export(startLogger) export(taxaByNode) -exportClasses(BrapiCon) exportClasses(BrapiConPHG) exportClasses(PHGDataSet) exportClasses(PHGLocalCon) +exportClasses(PHGServerCon) exportMethods(brapiURL) exportMethods(host) exportMethods(readHaplotypeIds) diff --git a/R/class_all_generics.R b/R/class_all_generics.R index 271dbdd..c63e282 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -4,7 +4,7 @@ #' @description #' Returns the Uniform Resource Locator (URL) of a \code{BrapiCon} object. #' -#' @param object a \code{\linkS4class{BrapiCon}} object. +#' @param object an \code{rPHG} local or server connection object. #' @param ... Additional arguments, for use in specific methods #' #' @rdname brapiURL @@ -18,7 +18,7 @@ setGeneric("brapiURL", function(object, ...) standardGeneric("brapiURL")) #' @description #' Returns the host information for a given object #' -#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' #' @rdname host @@ -32,7 +32,7 @@ setGeneric("host", function(object, ...) standardGeneric("host")) #' @description #' Returns the port information for a given object #' -#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' #' @rdname port @@ -46,7 +46,7 @@ setGeneric("port", function(object, ...) standardGeneric("port")) #' @description #' Returns the version ID for a BrAPI-compliant PHG server #' -#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' #' @rdname brapiVersion @@ -60,7 +60,7 @@ setGeneric("brapiVersion", function(object, ...) standardGeneric("brapiVersion") #' @description #' Returns a collection of available PHG methods and metadata #' -#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' #' @rdname showPHGMethods @@ -74,7 +74,7 @@ setGeneric("showPHGMethods", function(object, ...) standardGeneric("showPHGMetho #' @description #' Get avaiable BrAPI calls from BrAPI compliant PHG server #' -#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' #' @rdname serverInfo @@ -88,7 +88,7 @@ setGeneric("serverInfo", function(object, ...) standardGeneric("serverInfo")) #' @description #' Get reference range data for a given PHG method #' -#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' #' @rdname readRefRanges @@ -102,7 +102,7 @@ setGeneric("readRefRanges", function(object, ...) standardGeneric("readRefRanges #' @description #' Gets sample ID data for a given PHG method #' -#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' #' @rdname readSamples @@ -116,7 +116,7 @@ setGeneric("readSamples", function(object, ...) standardGeneric("readSamples")) #' @description #' Gets haplotype ID for given samples and reference ranges for PHG method #' -#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' #' @rdname readHaplotypeIds @@ -132,7 +132,7 @@ setGeneric("readHaplotypeIds", function(object, ...) standardGeneric("readHaplot #' return all 3 primary sources of data (samples, reference ranges, and #' haplotype IDs). #' -#' @param object a \code{\linkS4class{BrapiCon}} object +#' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' #' @rdname readPHGDataSet @@ -140,7 +140,3 @@ setGeneric("readHaplotypeIds", function(object, ...) standardGeneric("readHaplot setGeneric("readPHGDataSet", function(object, ...) standardGeneric("readPHGDataSet")) - - - - diff --git a/R/class_phg_con_local.R b/R/class_phg_con_local.R index 7f2ab6c..81867a3 100644 --- a/R/class_phg_con_local.R +++ b/R/class_phg_con_local.R @@ -16,15 +16,15 @@ setClass( Class = "PHGLocalCon", representation = representation( - host = "character", - dbName = "character", - dbType = "character", + host = "character", + dbName = "character", + dbType = "character", configFilePath = "character" ), prototype = prototype( - host = NA_character_, - dbName = NA_character_, - dbType = NA_character_, + host = NA_character_, + dbName = NA_character_, + dbType = NA_character_, configFilePath = NA_character_ ) ) @@ -85,7 +85,7 @@ setMethod( ## ---- -#' @title Helper functio to construct a \code{PHGLocalCon} object +#' @title Helper function to construct a \code{PHGLocalCon} object #' #' @description #' Creates a \code{\linkS4class{PHGLocalCon}} object to be used to read PHG @@ -102,7 +102,7 @@ PHGLocalCon <- function(file) { methods::new( Class = "PHGLocalCon", host = configProperties$host, - dbName = configProperties$DB |> basename(), + dbName = basename(configProperties$DB), dbType = configProperties$DBtype, configFilePath = normalizePath(file) ) diff --git a/R/class_phg_con_server.R b/R/class_phg_con_server.R index 8746c47..57f32d8 100644 --- a/R/class_phg_con_server.R +++ b/R/class_phg_con_server.R @@ -1,7 +1,7 @@ ## ---- -#' @title An S4 BrapiCon Class +#' @title An PHGServerCon Class #' -#' @description Class \code{BrapiCon} defines a \code{rPHG} +#' @description Class \code{PHGServerCon} defines a \code{rPHG} #' Class for storing BrAPI connection data. #' #' @slot host A URL to a BrAPI server. @@ -13,26 +13,26 @@ #' @slot token API authorization token. #' @slot url BrAPI server URL. #' -#' @name BrapiCon-class -#' @rdname BrapiCon-class -#' @exportClass BrapiCon +#' @name PHGServerCon-class +#' @rdname PHGServerCon-class +#' @exportClass PHGServerCon setClass( - Class = "BrapiCon", + Class = "PHGServerCon", representation = representation( - host = "character", - port = "numeric", + host = "character", + port = "numeric", protocol = "character", - version = "character", - token = "character", - url = "character" + version = "character", + token = "character", + url = "character" ), prototype = prototype( - host = NA_character_, - port = NA_integer_, + host = NA_character_, + port = NA_integer_, protocol = NA_character_, - version = NA_character_, - token = NA_character_, - url = NA_character_ + version = NA_character_, + token = NA_character_, + url = NA_character_ ) ) @@ -40,14 +40,14 @@ setClass( ## ---- #' @title BrAPI connection validation #' -#' @name BrapiCon-validity +#' @name PHGServerCon-validity #' -#' @description Checks if \code{BrapiCon} class objects are valid. +#' @description Checks if \code{PHGServerCon} class objects are valid. #' -#' @param object A \code{BrapiCon} object. +#' @param object A \code{PHGServerCon} object. #' #' @importFrom curl has_internet -setValidity("BrapiCon", function(object) { +setValidity("PHGServerCon", function(object) { errors <- character() port <- object@port @@ -79,9 +79,39 @@ setValidity("BrapiCon", function(object) { ## ---- -#' @title BrapiCon object and constructors +#' @title Show methods for PHGServerCon objects #' -#' @description \code{BrapiCon} is the primary container for housing BrAPI +#' @description +#' Prints out information regarding properties from the \code{PHGServerCon} +#' class to the console +#' +#' @param object A \code{\linkS4class{PHGServerCon}} object +#' +#' @docType methods +#' @rdname PHGServerCon-class +#' @aliases show,PHGServerCon-method +setMethod( + f = "show", + signature = "PHGServerCon", + definition = function(object) { + pointerSymbol <- cli::col_green(cli::symbol$pointer) + + stat <- httpResp(brapiURL(object)) + msg <- c( + paste0("A ", cli::style_bold("PHGServerCon"), " connection object"), + paste0(" ", pointerSymbol, " Host............: ", host(object)), + paste0(" ", pointerSymbol, " Server Status...: ", stat$status, " (", stat$msg, ")") + ) + + cat(msg, sep = "\n") + } +) + + +## ---- +#' @title PHGServerCon object constructor +#' +#' @description \code{PHGServerCon} is the primary container for housing BrAPI #' connection information. #' #' @param host A URL to a BrAPI server. @@ -92,20 +122,35 @@ setValidity("BrapiCon", function(object) { #' @param version BrAPI version number. Must be either \code{"v1"} or #' \code{"v2"}. Defaults to \code{v2}. #' -#' @return A \code{BrapiCon} object. +#' @return A \code{PHGServerCon} object. #' #' @export -BrapiCon <- function( +PHGServerCon <- function( host, port = NULL, - protocol = c("http", "https"), + protocol = c("https", "http"), version = c("v2", "v1") ) { - if (missing(host)) stop("A URL host is needed to make this class.") + respStat <- httpResp(host) + version <- match.arg(version) + protocol <- match.arg(protocol) + + # Check for http(s) prefix + httpReg <- "^http:\\/\\/" + httpsReg <- "^https:\\/\\/" + if (grepl(httpReg, host)) { + protocol <- "http" + host <- gsub(httpReg, "", host) + } + if (grepl(httpsReg, host)) { + protocol <- "https" + host <- gsub(httpsReg, "", host) + } - version <- match.arg(version) - protocol <- match.arg(protocol) + # Check for BrAPI suffix + brapiStart <- "\\/brapi\\/(v1|v2)$" + host <- gsub(brapiStart, "", host) if (is.null(port) && protocol == "http") port <- 80 if (is.null(port) && protocol == "https") port <- 443 @@ -115,22 +160,25 @@ BrapiCon <- function( url <- sprintf("%s://%s:%d/brapi/%s", protocol, host, port, version) new( - Class = "BrapiCon", - host = host, - port = port, + Class = "PHGServerCon", + host = host, + port = port, protocol = protocol, - version = version, - url = url + version = version, + url = url ) } + +# /// Methods /////////////////////////////////////////////////////// + ## ---- #' @rdname brapiURL #' @export setMethod( f = "brapiURL", - signature = signature(object = "BrapiCon"), + signature = signature(object = "PHGServerCon"), definition = function(object) { return(object@url) } @@ -142,19 +190,31 @@ setMethod( #' @export setMethod( f = "host", - signature = signature(object = "BrapiCon"), + signature = signature(object = "PHGServerCon"), definition = function(object) { return(object@host) } ) +## ---- +#' @rdname host +#' @export +setMethod( + f = "port", + signature = signature(object = "PHGServerCon"), + definition = function(object) { + return(object@port) + } +) + + ## ---- #' @rdname serverInfo #' @export setMethod( f = "serverInfo", - signature = signature(object = "BrapiCon"), + signature = signature(object = "PHGServerCon"), definition = function(object) { json2tibble(object, "serverinfo", "calls") } @@ -166,7 +226,7 @@ setMethod( #' @export setMethod( f = "showPHGMethods", - signature = signature(object = "BrapiCon"), + signature = signature(object = "PHGServerCon"), definition = function(object) { ## Temp fix to return proper methods fullTable <- json2tibble(object, "variantTables") diff --git a/R/class_phg_method.R b/R/class_phg_method.R index 57615cc..bf0d93b 100644 --- a/R/class_phg_method.R +++ b/R/class_phg_method.R @@ -13,7 +13,7 @@ #' @exportClass BrapiConPHG setClass( Class = "BrapiConPHG", - contains = "BrapiCon", + # contains = "BrapiCon", slots = c( methodID = "character", refRangeFilter = "character", diff --git a/R/logic_support.R b/R/logic_support.R deleted file mode 100644 index bf8f5ac..0000000 --- a/R/logic_support.R +++ /dev/null @@ -1,41 +0,0 @@ -#' @title Logic support for config files -#' -#' @description Provides logic checking for config files used in PHG creation. -#' -#' @author Brandon Monier -#' -#' @param configFile Path to a configuration file for your graph database. -configCatcher <- function(configFile) { - - if (!file.exists(configFile)) { - stop ("Path to config file does not exist.", call. = FALSE) - } - - tmpLines <- readLines(configFile) - dbParam <- tmpLines[grepl("DB=", tmpLines)] - credParam <- tmpLines[grepl("user=|password=", tmpLines)] - dbType <- tmpLines[grepl("DBtype=", tmpLines)] - - if (!grepl("=postgres$|=sqlite$", dbType)) { - stop("Only postgres or SQLite database types are allowed.", call. = FALSE) - } - - if (length(credParam) != 2) { - stop("Missing credentials (user= and/or password=) in config file.", call. = FALSE) - } - - if (length(dbParam) == 0) { - stop("Database parameter (DB=) in config file does not exist.", call. = FALSE) - } - - if (length(dbParam) > 1) { - stop("Config file contains more than one database path parameter (DB=).", call. = FALSE) - } - - dbParam <- gsub("DB=", "", dbParam) - - if (!file.exists(dbParam) && grepl("sqlite", dbType)) { - stop("Path to database (DB=) in SQLite config file does not exist.", call. = FALSE) - } -} - diff --git a/R/utilities_brapi.R b/R/utilities_brapi.R index 4e17d42..4451a42 100644 --- a/R/utilities_brapi.R +++ b/R/utilities_brapi.R @@ -1,4 +1,35 @@ -# === BrAPI utility and house-keeping methods ======================= +## ---- +# Get HTTP response status codes from PHG server +# +# @description +# By default, this will ping the `serverinfo` BrAPI endpoint on the server. +# +# @param url Host URL for PHG server +# @param endpoint What endpoint to append to URL +httpResp <- function(url, endpoint = "serverinfo") { + status <- tryCatch( + expr = { + httr::GET(file.path(url, endpoint))$status + }, + error = function(cond) NA + ) + + if (is.na(status)) { + stop("Cannot connect to server", call. = FALSE) + } + + statusMsg <- switch( + EXPR = floor(status / 100), + `1` = cli::col_yellow("Information"), + `2` = cli::col_green("OK"), + `3` = cli::col_blue("Redirection"), + `4` = cli::col_red("Client Error"), + `5` = cli::col_red("Server Error") + ) + + return(list(status = status, msg = cli::style_bold(statusMsg))) +} + ## ---- #' @title URL checker diff --git a/R/utilities_general.R b/R/utilities_general.R index 4cf2064..82d97c3 100644 --- a/R/utilities_general.R +++ b/R/utilities_general.R @@ -1,5 +1,3 @@ -# === Miscellaneous utilities for rPHG methods ====================== - ## ---- # @title Create mock config file # @@ -53,26 +51,52 @@ configCatcher <- function(configFile) { stop ("Path to config file does not exist.", call. = FALSE) } - tmpLines <- readLines(configFile) - dbParam <- tmpLines[grepl("DB=", tmpLines)] - credParam <- tmpLines[grepl("user=|password=", tmpLines)] - dbType <- tmpLines[grepl("DBtype=", tmpLines)] + configLines <- readLines(configFile) - if (!grepl("=postgres$|=sqlite$", dbType)) { - stop("Only postgres or SQLite database types are allowed.", call. = FALSE) - } + # Check for fields + # mandatoryFields <- c("host", "user", "password", "DB", "DBtype") + mandatoryFields <- c("DB", "DBtype", "host", "password", "user") + dbTypes <- c("sqlite", "postgres") + fieldPatterns <- paste0("^", mandatoryFields, "=") + + # Create logical matrix for given lines in file (i) and fields (j) + fcMatrix <- vapply(fieldPatterns, grepl, logical(length(configLines)), configLines) + + # Check for presence of each field + presentChecks <- apply(fcMatrix, 2, any) + + # Check for duplicates of each field + dupChecks <- apply(fcMatrix, 2, function(x) { + ifelse(sum(x, na.rm = TRUE) > 1, TRUE, FALSE) + }) - if (length(credParam) != 2) { - stop("Missing credentials (user= and/or password=) in config file.", call. = FALSE) + names(presentChecks) <- mandatoryFields + names(dupChecks) <- mandatoryFields + + if (!all(presentChecks)) { + stop( + "Some mandatory connection fields are missing. Missing fields:\n", + paste0(" * ", names(presentChecks[!presentChecks]), collapse = "\n"), + call. = FALSE + ) } - if (length(dbParam) > 1) { - stop("Config file contains more than one database path parameter (DB=).", call. = FALSE) + if (any(dupChecks)) { + stop( + "Some mandatory connection fields are duplicated. Duplicated fields:\n", + paste0(" * ", names(dupChecks[dupChecks]), collapse = "\n"), + call. = FALSE + ) } - dbParam <- gsub("DB=", "", dbParam) + dbParam <- trimws(gsub("^DB=|#.*$", "", configLines[grepl("^DB=", configLines)])) + dbTypeParam <- trimws(gsub("^DBtype=|#.*$", "", configLines[grepl("^DBtype=", configLines)])) + + if (!dbTypeParam %in% dbTypes) { + stop("Only PostgreSQL (DBtype=postgres) or SQLite (DBtype=sqlite) database types are allowed.", call. = FALSE) + } - if (!file.exists(dbParam) && grepl("sqlite", dbType)) { + if (!file.exists(dbParam) && dbTypeParam == "sqlite") { stop("Path to database (DB=) in SQLite config file does not exist.", call. = FALSE) } } diff --git a/man/PHGLocalCon.Rd b/man/PHGLocalCon.Rd index e5b015d..a6bb8bb 100644 --- a/man/PHGLocalCon.Rd +++ b/man/PHGLocalCon.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/class_phg_con_local.R \name{PHGLocalCon} \alias{PHGLocalCon} -\title{Helper functio to construct a \code{PHGLocalCon} object} +\title{Helper function to construct a \code{PHGLocalCon} object} \usage{ PHGLocalCon(file) } diff --git a/man/BrapiCon-class.Rd b/man/PHGServerCon-class.Rd similarity index 60% rename from man/BrapiCon-class.Rd rename to man/PHGServerCon-class.Rd index 7cbc30d..01ab3af 100644 --- a/man/BrapiCon-class.Rd +++ b/man/PHGServerCon-class.Rd @@ -1,12 +1,22 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_phg_con_server.R \docType{class} -\name{BrapiCon-class} -\alias{BrapiCon-class} -\title{An S4 BrapiCon Class} +\name{PHGServerCon-class} +\alias{PHGServerCon-class} +\alias{show,PHGServerCon-method} +\title{An PHGServerCon Class} +\usage{ +\S4method{show}{PHGServerCon}(object) +} +\arguments{ +\item{object}{A \code{\linkS4class{PHGServerCon}} object} +} \description{ -Class \code{BrapiCon} defines a \code{rPHG} +Class \code{PHGServerCon} defines a \code{rPHG} Class for storing BrAPI connection data. + +Prints out information regarding properties from the \code{PHGServerCon} +class to the console } \section{Slots}{ diff --git a/man/BrapiCon-validity.Rd b/man/PHGServerCon-validity.Rd similarity index 51% rename from man/BrapiCon-validity.Rd rename to man/PHGServerCon-validity.Rd index 69d85d4..60fa3f0 100644 --- a/man/BrapiCon-validity.Rd +++ b/man/PHGServerCon-validity.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_phg_con_server.R -\name{BrapiCon-validity} -\alias{BrapiCon-validity} +\name{PHGServerCon-validity} +\alias{PHGServerCon-validity} \title{BrAPI connection validation} \arguments{ -\item{object}{A \code{BrapiCon} object.} +\item{object}{A \code{PHGServerCon} object.} } \description{ -Checks if \code{BrapiCon} class objects are valid. +Checks if \code{PHGServerCon} class objects are valid. } diff --git a/man/BrapiCon.Rd b/man/PHGServerCon.Rd similarity index 73% rename from man/BrapiCon.Rd rename to man/PHGServerCon.Rd index ccb199a..77b31c3 100644 --- a/man/BrapiCon.Rd +++ b/man/PHGServerCon.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_phg_con_server.R -\name{BrapiCon} -\alias{BrapiCon} -\title{BrapiCon object and constructors} +\name{PHGServerCon} +\alias{PHGServerCon} +\title{PHGServerCon object and constructors} \usage{ -BrapiCon( +PHGServerCon( host, port = NULL, - protocol = c("http", "https"), + protocol = c("https", "http"), version = c("v2", "v1") ) } @@ -24,9 +24,9 @@ be either \code{http} or \code{https}. Defaults to \code{http}.} \code{"v2"}. Defaults to \code{v2}.} } \value{ -A \code{BrapiCon} object. +A \code{PHGServerCon} object. } \description{ -\code{BrapiCon} is the primary container for housing BrAPI +\code{PHGServerCon} is the primary container for housing BrAPI connection information. } diff --git a/man/brapiURL.Rd b/man/brapiURL.Rd index 137c66b..9b9811e 100644 --- a/man/brapiURL.Rd +++ b/man/brapiURL.Rd @@ -2,15 +2,15 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{brapiURL} \alias{brapiURL} -\alias{brapiURL,BrapiCon-method} +\alias{brapiURL,PHGServerCon-method} \title{Return URL path} \usage{ brapiURL(object, ...) -\S4method{brapiURL}{BrapiCon}(object) +\S4method{brapiURL}{PHGServerCon}(object) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiCon}} object.} +\item{object}{an \code{rPHG} local or server connection object.} \item{...}{Additional arguments, for use in specific methods} } diff --git a/man/brapiVersion.Rd b/man/brapiVersion.Rd index 7902db9..d323c4a 100644 --- a/man/brapiVersion.Rd +++ b/man/brapiVersion.Rd @@ -7,7 +7,7 @@ brapiVersion(object, ...) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiCon}} object} +\item{object}{an \code{rPHG} local or server connection object} \item{...}{Additional arguments, for use in specific methods} } diff --git a/man/configCatcher.Rd b/man/configCatcher.Rd deleted file mode 100644 index 7c01149..0000000 --- a/man/configCatcher.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/logic_support.R -\name{configCatcher} -\alias{configCatcher} -\title{Logic support for config files} -\usage{ -configCatcher(configFile) -} -\arguments{ -\item{configFile}{Path to a configuration file for your graph database.} -} -\description{ -Provides logic checking for config files used in PHG creation. -} -\author{ -Brandon Monier -} diff --git a/man/host.Rd b/man/host.Rd index e2a1e14..167c3cb 100644 --- a/man/host.Rd +++ b/man/host.Rd @@ -2,15 +2,15 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{host} \alias{host} -\alias{host,BrapiCon-method} +\alias{host,PHGServerCon-method} \title{Return host data} \usage{ host(object, ...) -\S4method{host}{BrapiCon}(object) +\S4method{host}{PHGServerCon}(object) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiCon}} object} +\item{object}{an \code{rPHG} local or server connection object} \item{...}{Additional arguments, for use in specific methods} } diff --git a/man/port.Rd b/man/port.Rd index 54879e7..a55a8e3 100644 --- a/man/port.Rd +++ b/man/port.Rd @@ -7,7 +7,7 @@ port(object, ...) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiCon}} object} +\item{object}{an \code{rPHG} local or server connection object} \item{...}{Additional arguments, for use in specific methods} } diff --git a/man/readHaplotypeIds.Rd b/man/readHaplotypeIds.Rd index 05f9f76..8f480b2 100644 --- a/man/readHaplotypeIds.Rd +++ b/man/readHaplotypeIds.Rd @@ -10,7 +10,7 @@ readHaplotypeIds(object, ...) \S4method{readHaplotypeIds}{BrapiConPHG}(object, numCores = NULL, transpose = TRUE) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiCon}} object} +\item{object}{an \code{rPHG} local or server connection object} \item{...}{Additional arguments, for use in specific methods} diff --git a/man/readPHGDataSet.Rd b/man/readPHGDataSet.Rd index f69458d..c944e33 100644 --- a/man/readPHGDataSet.Rd +++ b/man/readPHGDataSet.Rd @@ -10,7 +10,7 @@ readPHGDataSet(object, ...) \S4method{readPHGDataSet}{BrapiConPHG}(object, ...) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiCon}} object} +\item{object}{an \code{rPHG} local or server connection object} \item{...}{Additional arguments, for use in specific methods} } diff --git a/man/readRefRanges.Rd b/man/readRefRanges.Rd index d572bd3..f423bf1 100644 --- a/man/readRefRanges.Rd +++ b/man/readRefRanges.Rd @@ -10,7 +10,7 @@ readRefRanges(object, ...) \S4method{readRefRanges}{BrapiConPHG}(object) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiCon}} object} +\item{object}{an \code{rPHG} local or server connection object} \item{...}{Additional arguments, for use in specific methods} } diff --git a/man/readSamples.Rd b/man/readSamples.Rd index 5c045db..42ab02d 100644 --- a/man/readSamples.Rd +++ b/man/readSamples.Rd @@ -10,7 +10,7 @@ readSamples(object, ...) \S4method{readSamples}{BrapiConPHG}(object) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiCon}} object} +\item{object}{an \code{rPHG} local or server connection object} \item{...}{Additional arguments, for use in specific methods} } diff --git a/man/serverInfo.Rd b/man/serverInfo.Rd index b1f7055..7f84540 100644 --- a/man/serverInfo.Rd +++ b/man/serverInfo.Rd @@ -2,15 +2,15 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{serverInfo} \alias{serverInfo} -\alias{serverInfo,BrapiCon-method} +\alias{serverInfo,PHGServerCon-method} \title{Return server information} \usage{ serverInfo(object, ...) -\S4method{serverInfo}{BrapiCon}(object) +\S4method{serverInfo}{PHGServerCon}(object) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiCon}} object} +\item{object}{an \code{rPHG} local or server connection object} \item{...}{Additional arguments, for use in specific methods} } diff --git a/man/showPHGMethods.Rd b/man/showPHGMethods.Rd index 261bfa0..f7d5115 100644 --- a/man/showPHGMethods.Rd +++ b/man/showPHGMethods.Rd @@ -2,15 +2,15 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{showPHGMethods} \alias{showPHGMethods} -\alias{showPHGMethods,BrapiCon-method} +\alias{showPHGMethods,PHGServerCon-method} \title{Return available PHG methods} \usage{ showPHGMethods(object, ...) -\S4method{showPHGMethods}{BrapiCon}(object) +\S4method{showPHGMethods}{PHGServerCon}(object) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiCon}} object} +\item{object}{an \code{rPHG} local or server connection object} \item{...}{Additional arguments, for use in specific methods} } From af0c1f7b535590c66ff537bb10d49de1ff8b98dd Mon Sep 17 00:00:00 2001 From: Brandon Date: Tue, 22 Aug 2023 08:48:52 -0400 Subject: [PATCH 14/35] Update URL --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0042cc2..1c5f077 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,8 +47,8 @@ Description: for genomic selection models. This can in turn increase predictive accuracy and selection intensity in a breeding program. License: Apache License (>= 2) | file LICENSE -URL: https://bitbucket.org/bucklerlab/rphg/src/master/, - https://maize-genetics.github.io/rPHG/ +URL: https://github.com/maize-genetics/rPHG, + https://rphg.maizegenetics.net/ Imports: cli, corrplot, From dfa72c72c152e9ae7a8e23fea53b9965ece12843 Mon Sep 17 00:00:00 2001 From: Brandon Date: Tue, 22 Aug 2023 08:51:35 -0400 Subject: [PATCH 15/35] Add better PHG server connection checks --- R/utilities_brapi.R | 39 +++++++++++++++++++++++++++++++++------ 1 file changed, 33 insertions(+), 6 deletions(-) diff --git a/R/utilities_brapi.R b/R/utilities_brapi.R index 4451a42..10fb18a 100644 --- a/R/utilities_brapi.R +++ b/R/utilities_brapi.R @@ -1,12 +1,23 @@ ## ---- -# Get HTTP response status codes from PHG server +# Check if BrAPI `serverinfo` endpoint exists # # @description -# By default, this will ping the `serverinfo` BrAPI endpoint on the server. +# Checks if BrAPI compliant `serverinfo` endpoint can be reached. This +# presumption will imply that we can at least connect to this "mandatory" +# endpoint for the PHG Ktor server. # # @param url Host URL for PHG server # @param endpoint What endpoint to append to URL -httpResp <- function(url, endpoint = "serverinfo") { +brapiEndpointExists <- function(url, endpoint = "serverinfo") { + # # C1 - check for internet connectivity + # if (!curl::has_internet()) { + # stop( + # "Connection cannot be made due to no internet connectivity", + # call. = FALSE + # ) + # } + + # C2 - check for serverinfo endpoint status <- tryCatch( expr = { httr::GET(file.path(url, endpoint))$status @@ -14,9 +25,25 @@ httpResp <- function(url, endpoint = "serverinfo") { error = function(cond) NA ) - if (is.na(status)) { - stop("Cannot connect to server", call. = FALSE) - } + ifelse( + test = !is.na(status) && status >= 200 && status <= 299, + yes = return(TRUE), + no = return(FALSE) + ) +} + + +## ---- +# Get HTTP response status codes from PHG server +# +# @description +# By default, this will ping the `serverinfo` BrAPI endpoint on the server. +# +# @param url Host URL for PHG server +# @param endpoint What endpoint to append to URL +httpResp <- function(url, endpoint = "serverinfo") { + + status <- httr::GET(file.path(url, endpoint))$status statusMsg <- switch( EXPR = floor(status / 100), From f3f99a15649ed157abf1214da107b927b889093b Mon Sep 17 00:00:00 2001 From: Brandon Date: Tue, 22 Aug 2023 08:51:45 -0400 Subject: [PATCH 16/35] Add getters --- NAMESPACE | 7 ++++++ R/class_all_generics.R | 42 ++++++++++++++++++++++++++++++++++++ R/class_phg_con_local.R | 46 ++++++++++++++++++++++++++++++++++++++++ R/class_phg_con_server.R | 28 ++++++++++++++++++++---- man/PHGServerCon.Rd | 2 +- man/configFilePath.Rd | 19 +++++++++++++++++ man/dbName.Rd | 19 +++++++++++++++++ man/dbType.Rd | 19 +++++++++++++++++ man/host.Rd | 9 +++++++- 9 files changed, 185 insertions(+), 6 deletions(-) create mode 100644 man/configFilePath.Rd create mode 100644 man/dbName.Rd create mode 100644 man/dbType.Rd diff --git a/NAMESPACE b/NAMESPACE index 0477bf6..21987d4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,9 @@ export(PHGMethod) export(PHGServerCon) export(brapiURL) export(brapiVersion) +export(configFilePath) +export(dbName) +export(dbType) export(getVTList) export(graphBuilder) export(host) @@ -32,7 +35,11 @@ exportClasses(PHGDataSet) exportClasses(PHGLocalCon) exportClasses(PHGServerCon) exportMethods(brapiURL) +exportMethods(configFilePath) +exportMethods(dbName) +exportMethods(dbType) exportMethods(host) +exportMethods(port) exportMethods(readHaplotypeIds) exportMethods(readPHGDataSet) exportMethods(readRefRanges) diff --git a/R/class_all_generics.R b/R/class_all_generics.R index c63e282..1a8bf4a 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -54,6 +54,48 @@ setGeneric("port", function(object, ...) standardGeneric("port")) setGeneric("brapiVersion", function(object, ...) standardGeneric("brapiVersion")) +## ---- +#' @title Return name of DB +#' +#' @description +#' Returns the name for a given PHG database +#' +#' @param object an \code{rPHG} local or server connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname dbName +#' @export +setGeneric("dbName", function(object, ...) standardGeneric("dbName")) + + +## ---- +#' @title Return type of DB +#' +#' @description +#' Returns the type (e.g. postgres or sqlite) for a given PHG database +#' +#' @param object an \code{rPHG} local or server connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname dbType +#' @export +setGeneric("dbType", function(object, ...) standardGeneric("dbType")) + + +## ---- +#' @title Return file path of configuration file +#' +#' @description +#' Returns the file path for a configuration file to a PHG database +#' +#' @param object an \code{rPHG} local or server connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname configFilePath +#' @export +setGeneric("configFilePath", function(object, ...) standardGeneric("configFilePath")) + + ## ---- #' @title Return available PHG methods #' diff --git a/R/class_phg_con_local.R b/R/class_phg_con_local.R index 81867a3..4a823ae 100644 --- a/R/class_phg_con_local.R +++ b/R/class_phg_con_local.R @@ -110,8 +110,54 @@ PHGLocalCon <- function(file) { +# /// Methods /////////////////////////////////////////////////////// + +## ---- +#' @rdname host +#' @export +setMethod( + f = "host", + signature = signature(object = "PHGLocalCon"), + definition = function(object) { + return(object@host) + } +) + + +## ---- +#' @rdname dbName +#' @export +setMethod( + f = "dbName", + signature = signature(object = "PHGLocalCon"), + definition = function(object) { + return(object@dbName) + } +) +## ---- +#' @rdname dbType +#' @export +setMethod( + f = "dbType", + signature = signature(object = "PHGLocalCon"), + definition = function(object) { + return(object@dbType) + } +) + + +## ---- +#' @rdname configFilePath +#' @export +setMethod( + f = "configFilePath", + signature = signature(object = "PHGLocalCon"), + definition = function(object) { + return(object@configFilePath) + } +) diff --git a/R/class_phg_con_server.R b/R/class_phg_con_server.R index 57f32d8..437860c 100644 --- a/R/class_phg_con_server.R +++ b/R/class_phg_con_server.R @@ -132,7 +132,6 @@ PHGServerCon <- function( version = c("v2", "v1") ) { - respStat <- httpResp(host) version <- match.arg(version) protocol <- match.arg(protocol) @@ -155,10 +154,19 @@ PHGServerCon <- function( if (is.null(port) && protocol == "http") port <- 80 if (is.null(port) && protocol == "https") port <- 443 - if (port %% 1 != 0) stop("Invalid port number. Must be a whole number.") + if (port %% 1 != 0) { + stop("Invalid port number. Must be a whole number.", call. = FALSE) + } url <- sprintf("%s://%s:%d/brapi/%s", protocol, host, port, version) + if (!brapiEndpointExists(url)) { + stop( + "Cannot resolve mandatory endpoint: {serverinfo}", + call. = FALSE + ) + } + new( Class = "PHGServerCon", host = host, @@ -185,6 +193,18 @@ setMethod( ) +## ---- +#' @rdname brapiVersion +#' @export +setMethod( + f = "brapiVersion", + signature = signature(object = "PHGServerCon"), + definition = function(object) { + return(object@version) + } +) + + ## ---- #' @rdname host #' @export @@ -198,7 +218,7 @@ setMethod( ## ---- -#' @rdname host +#' @rdname port #' @export setMethod( f = "port", @@ -230,7 +250,7 @@ setMethod( definition = function(object) { ## Temp fix to return proper methods fullTable <- json2tibble(object, "variantTables") - filtTable <- fullTable[fullTable$numSamples > 100, ] # arbitrary n + # filtTable <- fullTable[fullTable$numSamples > 100, ] # arbitrary n return(filtTable) } ) diff --git a/man/PHGServerCon.Rd b/man/PHGServerCon.Rd index 77b31c3..a5bee1c 100644 --- a/man/PHGServerCon.Rd +++ b/man/PHGServerCon.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/class_phg_con_server.R \name{PHGServerCon} \alias{PHGServerCon} -\title{PHGServerCon object and constructors} +\title{PHGServerCon object constructor} \usage{ PHGServerCon( host, diff --git a/man/configFilePath.Rd b/man/configFilePath.Rd new file mode 100644 index 0000000..f361403 --- /dev/null +++ b/man/configFilePath.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_local.R +\name{configFilePath} +\alias{configFilePath} +\alias{configFilePath,PHGLocalCon-method} +\title{Return file path of configuration file} +\usage{ +configFilePath(object, ...) + +\S4method{configFilePath}{PHGLocalCon}(object) +} +\arguments{ +\item{object}{an \code{rPHG} local or server connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the file path for a configuration file to a PHG database +} diff --git a/man/dbName.Rd b/man/dbName.Rd new file mode 100644 index 0000000..84ba7b1 --- /dev/null +++ b/man/dbName.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_local.R +\name{dbName} +\alias{dbName} +\alias{dbName,PHGLocalCon-method} +\title{Return name of DB} +\usage{ +dbName(object, ...) + +\S4method{dbName}{PHGLocalCon}(object) +} +\arguments{ +\item{object}{an \code{rPHG} local or server connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the name for a given PHG database +} diff --git a/man/dbType.Rd b/man/dbType.Rd new file mode 100644 index 0000000..e921dd1 --- /dev/null +++ b/man/dbType.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_local.R +\name{dbType} +\alias{dbType} +\alias{dbType,PHGLocalCon-method} +\title{Return type of DB} +\usage{ +dbType(object, ...) + +\S4method{dbType}{PHGLocalCon}(object) +} +\arguments{ +\item{object}{an \code{rPHG} local or server connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the type (e.g. postgres or sqlite) for a given PHG database +} diff --git a/man/host.Rd b/man/host.Rd index 167c3cb..4291a50 100644 --- a/man/host.Rd +++ b/man/host.Rd @@ -1,13 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_local.R, +% R/class_phg_con_server.R \name{host} \alias{host} +\alias{host,PHGLocalCon-method} \alias{host,PHGServerCon-method} +\alias{port,PHGServerCon-method} \title{Return host data} \usage{ host(object, ...) +\S4method{host}{PHGLocalCon}(object) + \S4method{host}{PHGServerCon}(object) + +\S4method{port}{PHGServerCon}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} From 08054322174cea910f0e1d690663e45714cbc822 Mon Sep 17 00:00:00 2001 From: Brandon Date: Thu, 24 Aug 2023 15:16:34 -0400 Subject: [PATCH 17/35] Initial commit --- R/class_phg_con.R | 78 ++++++++++++++++++++++++++++++++++++++++ R/constants.R | 14 ++++++++ R/method_table.R | 82 ++++++++++++++++++++++++++++++++++++++++++ man/PHGCon-class.Rd | 18 ++++++++++ man/PHGCon-validity.Rd | 11 ++++++ man/phgConObj.Rd | 19 ++++++++++ man/phgType.Rd | 19 ++++++++++ 7 files changed, 241 insertions(+) create mode 100644 R/class_phg_con.R create mode 100644 R/constants.R create mode 100644 R/method_table.R create mode 100644 man/PHGCon-class.Rd create mode 100644 man/PHGCon-validity.Rd create mode 100644 man/phgConObj.Rd create mode 100644 man/phgType.Rd diff --git a/R/class_phg_con.R b/R/class_phg_con.R new file mode 100644 index 0000000..673cc64 --- /dev/null +++ b/R/class_phg_con.R @@ -0,0 +1,78 @@ +## ---- +#' @title A PHGCon Class +#' +#' @description +#' A \code{PHGCon} class is a parent class for +#' local config file data. +#' +#' @slot phgType What type of PHG connection is this? +#' @slot host Location path of local SQLite, Postgres, or server database +#' +#' @name PHGCon-class +#' @rdname PHGCon-class +#' @exportClass PHGCon +setClass( + Class = "PHGCon", + representation = representation( + phgType = "character", + host = "character" + ), + prototype = prototype( + phgType = NA_character_, + host = NA_character_ + ) +) + + +## ---- +#' @title PHGCon validation +#' +#' @name PHGCon-validity +#' +#' @description +#' Checks for correct data entry into \code{PHGCon} class +#' +#' @param object A \code{\linkS4class{PHGCon}} object +setValidity("PHGCon", function(object) { + validConTypes <- c("local", "server") + errors <- character() + + if (!object@phgType %in% validConTypes) { + msg <- "Given PHG connection type is not allowed" + errors <- c(errors, msg) + } + + if (length(errors) == 0) { + return(TRUE) + } else { + return(errors) + } +}) + + + +# /// Methods (general) ///////////////////////////////////////////// + +## ---- +#' @rdname host +#' @export +setMethod( + f = "host", + signature = signature(object = "PHGCon"), + definition = function(object) { + return(object@host) + } +) + +## ---- +#' @rdname phgType +#' @export +setMethod( + f = "phgType", + signature = signature(object = "PHGCon"), + definition = function(object) { + return(object@phgType) + } +) + + diff --git a/R/constants.R b/R/constants.R new file mode 100644 index 0000000..cb28ae4 --- /dev/null +++ b/R/constants.R @@ -0,0 +1,14 @@ +## ---- +# Specified BrAPI endpoints +BRAPI_ENDPOINTS <- list( + "METHOD_TABLE" = "allelematrix", + "SERVER_INFO" = "serverinfo" +) + + +## ---- +# TASSEL and PHG class calls for rJava +TASSEL_API <- list( + "DATA_SET" = "net/maizegenetics/plugindef/DataSet", + "METHOD_TABLE_REPORT_PLUGIN" = "net/maizegenetics/pangenome/api/MethodTableReportPlugin" +) diff --git a/R/method_table.R b/R/method_table.R new file mode 100644 index 0000000..fda588b --- /dev/null +++ b/R/method_table.R @@ -0,0 +1,82 @@ +## ---- +# Return method table from local PHG object via Java/Kotlin API +# +# @param configFile A configuration file for a local PHG DB +# @param showAdvancedMethods Do you want to return all possible method IDs +# from the database? Defaults to `FALSE`. +methodTableFromLocal <- function(configFile, showAdvancedMethods) { + # Get TableReport object from TASSEL jar and convert to data.frame + plugin <- rJava::new( + rJava::J(TASSEL_API$METHOD_TABLE_REPORT_PLUGIN) + ) + plugin <- plugin$configFile(configFile) + ds <- plugin$performFunction( + rJava::.jnull(TASSEL_API$DATA_SET) + ) + tabRep <- ds$getDataSet()$get(0L)$getData() + tabRepDf <- tableReportToDF(tabRep) + + # Convert description field to column of parsed lists (key = value) + tabRepDf$description <- lapply( + X = tabRepDf$description, + FUN = descriptionStringToList + ) + + # Remove method table DB ids (not relevant to user) + tabRepDf$num_refranges <- NA + tabRepDf$num_samples <- NA + colsToKeep <- c( + "type_name", + "method_name", + "num_refranges", + "num_samples", + "description" + ) + tabRepDf <- tabRepDf[, colsToKeep] + + # Return only PATHS or all data + if (showAdvancedMethods) { + return(tabRepDf) + } else { + return(tabRepDf[tabRepDf$type_name == "PATHS", ]) + } +} + + +## ---- +# Return method table from for PHG server using BrAPI endpoints +# +# @param url A URL to a PHG server +# @param showAdvancedMethods Do you want to return all possible method IDs +# from the database? Defaults to `FALSE`. +methodTableFromServer <- function(url, showAdvancedMethods) { + tableUrl <- file.path(url, BRAPI_ENDPOINTS$METHOD_TABLE) + jsonObj <- parseJSON(tableUrl) + methodDf <- jsonObj$result$data + + # Make consistent names with local method table call + methodDf$type_name <- NA + idOrderAndMapping <- c( + "type_name" = "type_name", + "variantTableDbId" = "method_name", + "numVariants" = "num_refranges", + "numSamples" = "num_samples", + "additionalInfo" = "description" + ) + for (oldName in names(methodDf)) { + if (oldName %in% names(idOrderAndMapping)) { + newName <- idOrderAndMapping[oldName] + names(methodDf)[names(methodDf) == oldName] <- newName + } + } + methodDf <- methodDf[, idOrderAndMapping] + + # @TODO - fix arbitrary method return (will be fixed with add. info) + if (showAdvancedMethods) { + return(tibble::as_tibble(methodDf)) + } else { + return(tibble::as_tibble(methodDf[methodDf$num_samples > 50, ])) + } +} + + diff --git a/man/PHGCon-class.Rd b/man/PHGCon-class.Rd new file mode 100644 index 0000000..af1abdc --- /dev/null +++ b/man/PHGCon-class.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con.R +\docType{class} +\name{PHGCon-class} +\alias{PHGCon-class} +\title{A PHGCon Class} +\description{ +A \code{PHGCon} class is a parent class for +local config file data. +} +\section{Slots}{ + +\describe{ +\item{\code{phgType}}{What type of PHG connection is this?} + +\item{\code{host}}{Location path of local SQLite, Postgres, or server database} +}} + diff --git a/man/PHGCon-validity.Rd b/man/PHGCon-validity.Rd new file mode 100644 index 0000000..99b22a8 --- /dev/null +++ b/man/PHGCon-validity.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_con.R +\name{PHGCon-validity} +\alias{PHGCon-validity} +\title{PHGCon validation} +\arguments{ +\item{object}{A \code{\linkS4class{PHGCon}} object} +} +\description{ +Checks for correct data entry into \code{PHGCon} class +} diff --git a/man/phgConObj.Rd b/man/phgConObj.Rd new file mode 100644 index 0000000..a77dd64 --- /dev/null +++ b/man/phgConObj.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +\name{phgConObj} +\alias{phgConObj} +\alias{phgConObj,PHGMethod-method} +\title{Return a PHG connection object} +\usage{ +phgConObj(object, ...) + +\S4method{phgConObj}{PHGMethod}(object) +} +\arguments{ +\item{object}{an \code{rPHG} method object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns an \code{rPHG} connection object +} diff --git a/man/phgType.Rd b/man/phgType.Rd new file mode 100644 index 0000000..bce022b --- /dev/null +++ b/man/phgType.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_con.R +\name{phgType} +\alias{phgType} +\alias{phgType,PHGCon-method} +\title{Return type of PHG connection} +\usage{ +phgType(object, ...) + +\S4method{phgType}{PHGCon}(object) +} +\arguments{ +\item{object}{an \code{rPHG} connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the PHG type for a given \code{rPHG} local or server connection object +} From 8fd7c9d00bb1cc34545c82d89d37f9a48bc0883c Mon Sep 17 00:00:00 2001 From: Brandon Date: Thu, 24 Aug 2023 15:16:56 -0400 Subject: [PATCH 18/35] Generalize method connection objects --- NAMESPACE | 22 +- R/class_all_generics.R | 128 ++++++---- R/class_phg_con_local.R | 96 ++++---- R/class_phg_con_server.R | 97 ++++---- R/class_phg_method.R | 505 +++++++++++++++++++++----------------- R/show_phg_methods.R | 59 ----- R/utilities_brapi.R | 37 ++- R/utilities_general.R | 39 ++- man/BrapiConPHG-class.Rd | 20 -- man/PHGLocalCon-class.Rd | 4 +- man/PHGMethod-class.Rd | 18 ++ man/PHGMethod.Rd | 12 +- man/PHGServerCon-class.Rd | 2 - man/PHGServerCon.Rd | 2 - man/brapiVersion.Rd | 5 +- man/host.Rd | 13 +- man/parseJSON.Rd | 16 -- man/port.Rd | 5 +- man/readHaplotypeIds.Rd | 9 +- man/readPHGDataSet.Rd | 5 +- man/readRefRanges.Rd | 4 +- man/readSamples.Rd | 5 +- man/show.Rd | 14 +- man/showPHGMethods.Rd | 13 +- 24 files changed, 567 insertions(+), 563 deletions(-) delete mode 100644 R/show_phg_methods.R delete mode 100644 man/BrapiConPHG-class.Rd create mode 100644 man/PHGMethod-class.Rd delete mode 100644 man/parseJSON.Rd diff --git a/NAMESPACE b/NAMESPACE index 21987d4..19a43ac 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,6 +13,9 @@ export(graphBuilder) export(host) export(numHaploPerRange) export(pathsForMethod) +export(phgConObj) +export(phgMethod) +export(phgType) export(plotGraph) export(plotMutualInfo) export(plotNumHaplo) @@ -30,20 +33,22 @@ export(serverInfo) export(showPHGMethods) export(startLogger) export(taxaByNode) -exportClasses(BrapiConPHG) +exportClasses(PHGCon) exportClasses(PHGDataSet) exportClasses(PHGLocalCon) +exportClasses(PHGMethod) exportClasses(PHGServerCon) exportMethods(brapiURL) +exportMethods(brapiVersion) exportMethods(configFilePath) exportMethods(dbName) exportMethods(dbType) exportMethods(host) +exportMethods(phgConObj) +exportMethods(phgMethod) +exportMethods(phgType) exportMethods(port) -exportMethods(readHaplotypeIds) -exportMethods(readPHGDataSet) exportMethods(readRefRanges) -exportMethods(readSamples) exportMethods(serverInfo) exportMethods(showPHGMethods) import(ggplot2) @@ -59,21 +64,12 @@ importFrom(SummarizedExperiment,assays) importFrom(SummarizedExperiment,ranges) importFrom(SummarizedExperiment,rowRanges) importFrom(SummarizedExperiment,seqnames) -importFrom(cli,cli_progress_bar) -importFrom(cli,cli_progress_done) -importFrom(cli,cli_progress_step) -importFrom(cli,cli_progress_update) importFrom(corrplot,corrplot) importFrom(curl,has_internet) -importFrom(httr,GET) -importFrom(httr,content) -importFrom(jsonlite,fromJSON) importFrom(magrittr,"%>%") importFrom(methods,new) importFrom(methods,setClass) -importFrom(parallel,mclapply) importFrom(rJava,.jcall) -importFrom(rJava,.jevalArray) importFrom(rJava,.jnew) importFrom(rJava,.jnull) importFrom(rJava,J) diff --git a/R/class_all_generics.R b/R/class_all_generics.R index 1a8bf4a..4bc897f 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -13,115 +13,159 @@ setGeneric("brapiURL", function(object, ...) standardGeneric("brapiURL")) ## ---- -#' @title Return host data +#' @title Return BrAPI version ID #' #' @description -#' Returns the host information for a given object +#' Returns the version ID for a BrAPI-compliant PHG server #' #' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' -#' @rdname host +#' @rdname brapiVersion #' @export -setGeneric("host", function(object, ...) standardGeneric("host")) +setGeneric("brapiVersion", function(object, ...) standardGeneric("brapiVersion")) ## ---- -#' @title Return port value +#' @title Return file path of configuration file #' #' @description -#' Returns the port information for a given object +#' Returns the file path for a configuration file to a PHG database #' #' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' -#' @rdname port +#' @rdname configFilePath #' @export -setGeneric("port", function(object, ...) standardGeneric("port")) +setGeneric("configFilePath", function(object, ...) standardGeneric("configFilePath")) ## ---- -#' @title Return BrAPI version ID +#' @title Return name of DB #' #' @description -#' Returns the version ID for a BrAPI-compliant PHG server +#' Returns the name for a given PHG database #' #' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' -#' @rdname brapiVersion +#' @rdname dbName #' @export -setGeneric("brapiVersion", function(object, ...) standardGeneric("brapiVersion")) +setGeneric("dbName", function(object, ...) standardGeneric("dbName")) ## ---- -#' @title Return name of DB +#' @title Return type of DB #' #' @description -#' Returns the name for a given PHG database +#' Returns the type (e.g. postgres or sqlite) for a given PHG database #' #' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' -#' @rdname dbName +#' @rdname dbType #' @export -setGeneric("dbName", function(object, ...) standardGeneric("dbName")) +setGeneric("dbType", function(object, ...) standardGeneric("dbType")) ## ---- -#' @title Return type of DB +#' @title Return host data #' #' @description -#' Returns the type (e.g. postgres or sqlite) for a given PHG database +#' Returns the host information for a given object #' #' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' -#' @rdname dbType +#' @rdname host #' @export -setGeneric("dbType", function(object, ...) standardGeneric("dbType")) +setGeneric("host", function(object, ...) standardGeneric("host")) ## ---- -#' @title Return file path of configuration file +#' @title Return a PHG connection object #' #' @description -#' Returns the file path for a configuration file to a PHG database +#' Returns an \code{rPHG} connection object +#' +#' @param object an \code{rPHG} method object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname phgConObj +#' @export +setGeneric("phgConObj", function(object, ...) standardGeneric("phgConObj")) + + +## ---- +#' @title Return method ID +#' +#' @description +#' Returns a method ID string for a given \code{rPHG} method class +#' +#' @param object an \code{rPHG} method object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname phgMethod +#' @export +setGeneric("phgMethod", function(object, ...) standardGeneric("phgMethod")) + + +## ---- +#' @title Return type of PHG connection +#' +#' @description +#' Returns the PHG type for a given \code{rPHG} local or server connection object +#' +#' @param object an \code{rPHG} connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname phgType +#' @export +setGeneric("phgType", function(object, ...) standardGeneric("phgType")) + + +## ---- +#' @title Return port value +#' +#' @description +#' Returns the port information for a given object #' #' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' -#' @rdname configFilePath +#' @rdname port #' @export -setGeneric("configFilePath", function(object, ...) standardGeneric("configFilePath")) +setGeneric("port", function(object, ...) standardGeneric("port")) ## ---- -#' @title Return available PHG methods +#' @title Return haplotype IDs #' #' @description -#' Returns a collection of available PHG methods and metadata +#' Gets haplotype ID for given samples and reference ranges for PHG method #' #' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' -#' @rdname showPHGMethods +#' @rdname readHaplotypeIds #' @export -setGeneric("showPHGMethods", function(object, ...) standardGeneric("showPHGMethods")) +setGeneric("readHaplotypeIds", function(object, ...) standardGeneric("readHaplotypeIds")) ## ---- -#' @title Return server information +#' @title Return a PHGDataSet #' #' @description -#' Get avaiable BrAPI calls from BrAPI compliant PHG server +#' Creates a \code{\linkS4class{PHGDataSet}} for a given PHG method. This will +#' return all 3 primary sources of data (samples, reference ranges, and +#' haplotype IDs). #' #' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' -#' @rdname serverInfo +#' @rdname readPHGDataSet #' @export -setGeneric("serverInfo", function(object, ...) standardGeneric("serverInfo")) +setGeneric("readPHGDataSet", function(object, ...) standardGeneric("readPHGDataSet")) ## ---- @@ -153,32 +197,32 @@ setGeneric("readSamples", function(object, ...) standardGeneric("readSamples")) ## ---- -#' @title Return haplotype IDs +#' @title Return server information #' #' @description -#' Gets haplotype ID for given samples and reference ranges for PHG method +#' Get avaiable BrAPI calls from BrAPI compliant PHG server #' #' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods #' -#' @rdname readHaplotypeIds +#' @rdname serverInfo #' @export -setGeneric("readHaplotypeIds", function(object, ...) standardGeneric("readHaplotypeIds")) +setGeneric("serverInfo", function(object, ...) standardGeneric("serverInfo")) ## ---- -#' @title Return a PHGDataSet +#' @title Return available PHG methods #' #' @description -#' Creates a \code{\linkS4class{PHGDataSet}} for a given PHG method. This will -#' return all 3 primary sources of data (samples, reference ranges, and -#' haplotype IDs). +#' Returns a collection of available PHG methods and metadata #' #' @param object an \code{rPHG} local or server connection object +#' @param showAdvancedMethods Do you want to return all possible method IDs +#' from the database? Defaults to \code{FALSE}. #' @param ... Additional arguments, for use in specific methods #' -#' @rdname readPHGDataSet +#' @rdname showPHGMethods #' @export -setGeneric("readPHGDataSet", function(object, ...) standardGeneric("readPHGDataSet")) +setGeneric("showPHGMethods", function(object, showAdvancedMethods = FALSE, ...) standardGeneric("showPHGMethods")) diff --git a/R/class_phg_con_local.R b/R/class_phg_con_local.R index 4a823ae..4945902 100644 --- a/R/class_phg_con_local.R +++ b/R/class_phg_con_local.R @@ -2,10 +2,9 @@ #' @title A PHGLocalCon Class #' #' @description -#' Class \code{PHGLocalCon} defines a \code{rPHG} class for storing +#' A \code{PHGLocalCon} class defines a \code{rPHG} class for storing #' local config file data. #' -#' @slot host Location path of local SQLite or Postgres database #' @slot dbName Name of database #' @slot dbType Type of database #' @slot configFilePath Path to configuration file @@ -14,15 +13,14 @@ #' @rdname PHGLocalCon-class #' @exportClass PHGLocalCon setClass( - Class = "PHGLocalCon", + Class = "PHGLocalCon", + contains = "PHGCon", representation = representation( - host = "character", dbName = "character", dbType = "character", configFilePath = "character" ), prototype = prototype( - host = NA_character_, dbName = NA_character_, dbType = NA_character_, configFilePath = NA_character_ @@ -55,35 +53,6 @@ setValidity("PHGLocalCon", function(object) { }) -## ---- -#' @title Show methods for PHGLocalCon objects -#' -#' @description -#' Prints out information regarding properties from the \code{PHGLocalCon} -#' class to the console -#' -#' @param object A \code{\linkS4class{PHGLocalCon}} object -#' -#' @docType methods -#' @rdname PHGLocalCon-class -#' @aliases show,PHGLocalCon-method -setMethod( - f = "show", - signature = "PHGLocalCon", - definition = function(object) { - pointerSymbol <- cli::col_green(cli::symbol$pointer) - msg <- c( - paste0("A ", cli::style_bold("PHGLocalCon"), " connection object"), - paste0(" ", pointerSymbol, " Host......: ", object@host), - paste0(" ", pointerSymbol, " DB Name...: ", object@dbName), - paste0(" ", pointerSymbol, " DB Type...: ", object@dbType) - ) - - cat(msg, sep = "\n") - } -) - - ## ---- #' @title Helper function to construct a \code{PHGLocalCon} object #' @@ -101,6 +70,7 @@ PHGLocalCon <- function(file) { methods::new( Class = "PHGLocalCon", + phgType = "local", host = configProperties$host, dbName = basename(configProperties$DB), dbType = configProperties$DBtype, @@ -110,20 +80,40 @@ PHGLocalCon <- function(file) { -# /// Methods /////////////////////////////////////////////////////// +# /// Methods (show) //////////////////////////////////////////////// ## ---- -#' @rdname host -#' @export +#' @title Show methods for PHGLocalCon objects +#' +#' @description +#' Prints out information regarding properties from the \code{PHGLocalCon} +#' class to the console +#' +#' @param object A \code{\linkS4class{PHGLocalCon}} object +#' +#' @docType methods +#' @rdname PHGLocalCon-class +#' @aliases show,PHGLocalCon-method setMethod( - f = "host", - signature = signature(object = "PHGLocalCon"), + f = "show", + signature = "PHGLocalCon", definition = function(object) { - return(object@host) + pointerSymbol <- cli::col_green(cli::symbol$pointer) + msg <- c( + paste0("A ", cli::style_bold("PHGLocalCon"), " connection object"), + paste0(" ", pointerSymbol, " Host......: ", object@host), + paste0(" ", pointerSymbol, " DB Name...: ", object@dbName), + paste0(" ", pointerSymbol, " DB Type...: ", object@dbType) + ) + + cat(msg, sep = "\n") } ) + +# /// Methods (general) ///////////////////////////////////////////// + ## ---- #' @rdname dbName #' @export @@ -160,16 +150,20 @@ setMethod( ) - - - - - - - - - - - +## ---- +#' @rdname showPHGMethods +#' @export +setMethod( + f = "showPHGMethods", + signature = signature(object = "PHGLocalCon"), + definition = function(object, showAdvancedMethods) { + return( + methodTableFromLocal( + configFilePath(object), + showAdvancedMethods + ) + ) + } +) diff --git a/R/class_phg_con_server.R b/R/class_phg_con_server.R index 437860c..ac28346 100644 --- a/R/class_phg_con_server.R +++ b/R/class_phg_con_server.R @@ -4,7 +4,6 @@ #' @description Class \code{PHGServerCon} defines a \code{rPHG} #' Class for storing BrAPI connection data. #' -#' @slot host A URL to a BrAPI server. #' @slot port The host port. #' @slot protocol Which protocol must be used to fetch the desired data? Must #' be either \code{http} or \code{https}. @@ -17,9 +16,9 @@ #' @rdname PHGServerCon-class #' @exportClass PHGServerCon setClass( - Class = "PHGServerCon", + Class = "PHGServerCon", + contains = "PHGCon", representation = representation( - host = "character", port = "numeric", protocol = "character", version = "character", @@ -27,7 +26,6 @@ setClass( url = "character" ), prototype = prototype( - host = NA_character_, port = NA_integer_, protocol = NA_character_, version = NA_character_, @@ -78,43 +76,12 @@ setValidity("PHGServerCon", function(object) { }) -## ---- -#' @title Show methods for PHGServerCon objects -#' -#' @description -#' Prints out information regarding properties from the \code{PHGServerCon} -#' class to the console -#' -#' @param object A \code{\linkS4class{PHGServerCon}} object -#' -#' @docType methods -#' @rdname PHGServerCon-class -#' @aliases show,PHGServerCon-method -setMethod( - f = "show", - signature = "PHGServerCon", - definition = function(object) { - pointerSymbol <- cli::col_green(cli::symbol$pointer) - - stat <- httpResp(brapiURL(object)) - msg <- c( - paste0("A ", cli::style_bold("PHGServerCon"), " connection object"), - paste0(" ", pointerSymbol, " Host............: ", host(object)), - paste0(" ", pointerSymbol, " Server Status...: ", stat$status, " (", stat$msg, ")") - ) - - cat(msg, sep = "\n") - } -) - - ## ---- #' @title PHGServerCon object constructor #' #' @description \code{PHGServerCon} is the primary container for housing BrAPI #' connection information. #' -#' @param host A URL to a BrAPI server. #' @param port The host port. If \code{NULL}, a default port (e.g. \code{80} or #' \code{443}) will be used depending on protocol. #' @param protocol Which protocol must be used to fetch the desired data? Must @@ -135,7 +102,7 @@ PHGServerCon <- function( version <- match.arg(version) protocol <- match.arg(protocol) - # Check for http(s) prefix + # Check for http(s) prefix and update protocol arg if needed httpReg <- "^http:\\/\\/" httpsReg <- "^https:\\/\\/" if (grepl(httpReg, host)) { @@ -147,7 +114,7 @@ PHGServerCon <- function( host <- gsub(httpsReg, "", host) } - # Check for BrAPI suffix + # Check for BrAPI suffix - does not check for v1 status - defaults to v2 brapiStart <- "\\/brapi\\/(v1|v2)$" host <- gsub(brapiStart, "", host) @@ -169,6 +136,7 @@ PHGServerCon <- function( new( Class = "PHGServerCon", + phgType = "server", host = host, port = port, protocol = protocol, @@ -179,40 +147,61 @@ PHGServerCon <- function( -# /// Methods /////////////////////////////////////////////////////// +# /// Methods (show) //////////////////////////////////////////////// ## ---- -#' @rdname brapiURL -#' @export +#' @title Show methods for PHGServerCon objects +#' +#' @description +#' Prints out information regarding properties from the \code{PHGServerCon} +#' class to the console +#' +#' @param object A \code{\linkS4class{PHGServerCon}} object +#' +#' @docType methods +#' @rdname PHGServerCon-class +#' @aliases show,PHGServerCon-method setMethod( - f = "brapiURL", - signature = signature(object = "PHGServerCon"), + f = "show", + signature = "PHGServerCon", definition = function(object) { - return(object@url) + pointerSymbol <- cli::col_green(cli::symbol$pointer) + + stat <- httpResp(brapiURL(object)) + msg <- c( + paste0("A ", cli::style_bold("PHGServerCon"), " connection object"), + paste0(" ", pointerSymbol, " Host............: ", host(object)), + paste0(" ", pointerSymbol, " Server Status...: ", stat$status, " (", stat$msg, ")") + ) + + cat(msg, sep = "\n") } ) + +# /// Methods (general) ///////////////////////////////////////////// + ## ---- -#' @rdname brapiVersion +#' @rdname brapiURL #' @export setMethod( - f = "brapiVersion", + f = "brapiURL", signature = signature(object = "PHGServerCon"), definition = function(object) { - return(object@version) + return(object@url) } ) ## ---- -#' @rdname host +#' @rdname brapiVersion #' @export setMethod( - f = "host", + f = "brapiVersion", signature = signature(object = "PHGServerCon"), definition = function(object) { - return(object@host) + return(object@version) } ) @@ -247,11 +236,11 @@ setMethod( setMethod( f = "showPHGMethods", signature = signature(object = "PHGServerCon"), - definition = function(object) { - ## Temp fix to return proper methods - fullTable <- json2tibble(object, "variantTables") - # filtTable <- fullTable[fullTable$numSamples > 100, ] # arbitrary n - return(filtTable) + definition = function(object, showAdvancedMethods) { + methodTableFromServer( + brapiURL(object), + showAdvancedMethods + ) } ) diff --git a/R/class_phg_method.R b/R/class_phg_method.R index bf0d93b..812b01c 100644 --- a/R/class_phg_method.R +++ b/R/class_phg_method.R @@ -1,295 +1,340 @@ ## ---- -#' @title An S4 BrapiConPHG Class +#' @title A PHGMethod Class #' -#' @description Class \code{BrapiConPHG} defines a \code{rPHG} -#' Class for storing BrAPI connection data plust PHG coordinate info. +#' @description +#' Class \code{PHGMethod} defines a \code{rPHG} Class for storing +#' a "committed" PHG method to return data against. #' #' @slot methodID A PHG method identifier. -#' @slot refRangeFilter Reference range selection URL parameters. -#' @slot sampleFilter Sample / taxa selection URL parameters. +#' @slot phgConObj A \code{\linkS4class{PHGCon}} object #' -#' @name BrapiConPHG-class -#' @rdname BrapiConPHG-class -#' @exportClass BrapiConPHG +#' @name PHGMethod-class +#' @rdname PHGMethod-class +#' @exportClass PHGMethod setClass( - Class = "BrapiConPHG", - # contains = "BrapiCon", + Class = "PHGMethod", slots = c( - methodID = "character", - refRangeFilter = "character", - sampleFilter = "character" + methodID = "character", + phgConObj = "PHGCon" ), prototype = list( - methodID = NA_character_, - refRangeFilter = NA_character_, - sampleFilter = NA_character_ + methodID = "test", + phgConObj = new("PHGCon", phgType = "local", host = "localHost") ) ) ## ---- -#' @title Helper function to construct BrapiConPHG object +#' @title Helper function to construct PHGMethod object #' -#' @description Creates a \code{BrapiConPHG} object to be used to read and -#' filter data from a given BrAPI endpoint given a verified PHG method. +#' @description +#' Creates a \code{\linkS4class{PHGMethod}} object to be used to read and +#' filter data from a given PHG connection object using a verified PHG method. #' -#' @param brapiObj A \code{BrapiCon} object. -#' @param x A PHG method identifier. +#' @param phgConObj A \code{\linkS4class{PHGCon}} object. +#' @param methodID A PHG method identifier. #' #' @export -PHGMethod <- function(brapiObj, x) { - - # For demo purposes only! - # if (x == "DEMO") x <- "NAM_GBS_Alignments_PATHS" +PHGMethod <- function(phgConObj, methodID) { + + # # For demo purposes only! (useful for workshops) + # if (methodID == "DEMO") methodID <- "NAM_GBS_Alignments_PATHS" + + methodIDs <- showPHGMethods(phgConObj)$method_name + if (!methodID %in% methodIDs) { + stop("Method ID not found in database", call. = FALSE) + } methods::new( - "BrapiConPHG", - brapiObj, - methodID = x + Class = "PHGMethod", + methodID = methodID, + phgConObj = phgConObj ) } + +# /// Methods (show) //////////////////////////////////////////////// + ## ---- -#' @title Show method for BrapiConPHG objects +#' @title Show method for PHGMethod objects #' -#' @description Prints out the information from the BrAPI connection object -#' including server status codes. See this -#' \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} -#' for further details about what these codes mean. +#' @description +#' Prints out information regarding properties from the \code{PHGMethod} +#' class to the console #' -#' @param object a \code{\linkS4class{BrapiConPHG}} object. +#' @param object a \code{\linkS4class{PHGMethod}} object. #' #' @docType methods #' @name show #' @rdname show -#' @aliases show,BrapiConPHG-method +#' @aliases show,PHGMethod-method setMethod( f = "show", - signature = "BrapiConPHG", + signature = "PHGMethod", definition = function(object) { - # cli::cli_div(theme = list(ul = list(`margin-left` = 2, before = ""))) - - # activeSlotMsg <- cli::symbol$square_small_filled - # inactiveSlotMsg <- cli::symbol$square_small - activeSlotMsg <- "[x]" - inactiveSlotMsg <- "[ ]" - - rrCheck <- ifelse( - test = is.na(object@refRangeFilter), - yes = inactiveSlotMsg, - no = activeSlotMsg + conType <- phgType(phgConObj(object)) + + conMsg <- switch (conType, + "server" = cli::style_bold(cli::col_green("PHGServerCon")), + "local" = cli::style_bold(cli::col_green("PHGLocalCon")) ) - sampleCheck <- ifelse( - test = is.na(object@sampleFilter), - yes = inactiveSlotMsg, - no = activeSlotMsg + + methodId <- cli::style_bold(cli::col_blue(phgMethod(object))) + + msg <- c( + paste0("A ", cli::style_bold("PHGMethod"), " promise object:"), + paste0(" <", conMsg, "> --- <", methodId, ">") ) - - cat(" PHG pointer object>\n") - cat(" method: ", object@methodID, "\n") - cat(" variant filter: ", rrCheck, "\n") - cat(" sample filter: ", sampleCheck, "\n") + + cat(msg, sep = "\n") } ) + +# /// Methods (general) ///////////////////////////////////////////// + ## ---- -#' @rdname readRefRanges -#' -#' @importFrom GenomicRanges GRanges -#' @importFrom IRanges IRanges -#' @importFrom rJava .jevalArray -#' @importFrom rJava .jnew -#' +#' @rdname phgConObj #' @export setMethod( - f = "readRefRanges", - signature = "BrapiConPHG", + f = "phgConObj", + signature = signature(object = "PHGMethod"), definition = function(object) { - urls <- getVTList(object) - - pageSize <- ifelse( - grepl("variants$", urls$rangeURL), - "?pageSize=", - "&pageSize=" - ) - - if (object@methodID == "DEMO") { - rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "1000")) - } else { - rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "150000")) - } - rrDF <- rrDF$result$data - - gr <- GenomicRanges::GRanges( - seqnames = rrDF$referenceName, - ranges = IRanges::IRanges( - start = rrDF$start, - end = rrDF$end - ), - variantDbId = rrDF$variantDbId - ) - - return(gr) - + return(object@phgConObj) } ) ## ---- -#' @rdname readSamples -#' -#' @importFrom tibble as_tibble -#' +#' @rdname phgMethod #' @export setMethod( - f = "readSamples", - signature = "BrapiConPHG", + f = "phgMethod", + signature = signature(object = "PHGMethod"), definition = function(object) { - urls <- getVTList(object) - - sampleDF <- parseJSON(urls$sampleURL) - sampleDF <- sampleDF$result$data - - if (object@methodID == "DEMO") { - return(utils::head(tibble::as_tibble(sampleDF), n = 25)) - } else{ - return(tibble::as_tibble(sampleDF)) - } + return(object@methodID) } ) ## ---- -#' @rdname readHaplotypeIds -#' -#' @param numCores Number of processing cores for faster processing times. -#' @param transpose Do you want to transpose table? -#' -#' @importFrom cli cli_progress_bar -#' @importFrom cli cli_progress_done -#' @importFrom cli cli_progress_step -#' @importFrom cli cli_progress_update -#' @importFrom httr content -#' @importFrom httr GET -#' @importFrom jsonlite fromJSON -#' @importFrom parallel mclapply -#' +#' @rdname readRefRanges #' @export setMethod( - f = "readHaplotypeIds", - signature = "BrapiConPHG", - definition = function(object, numCores = NULL, transpose = TRUE) { - # Logic checks - if (is.null(numCores)) { - numCores <- 1 - } - if (!is.numeric(numCores)) { - stop("numCores parameter must be numeric or NULL") - } - - # Get URLs - urls <- getVTList(object) - - # Calculate total pages - - if (object@methodID == "DEMO") { - totalVariants <- 1000 - totalPages <- ceiling(totalVariants / 250) - } else { - methods <- availablePHGMethods(object) - totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants - totalPages <- ceiling(totalVariants / 10000) - } - - # Download each page (iterative) - # TODO - can we async this? (e.g. futures) - allResp <- vector("list", totalPages) - # cli::cli_progress_step("Establishing connection") - message("Establishing connection") - # cli::cli_progress_bar(" - Downloading: ", total = totalPages) - message("Downloading:") - pb <- utils::txtProgressBar( - style = 3, - char = "=", - min = 1, - max = totalPages - ) - for (i in seq_len(totalPages)) { - currentUrl <- sprintf(urls$tableURL, i - 1, 0) - allResp[[i]] <- httr::GET(currentUrl) - utils::setTxtProgressBar(pb, i) - # cli::cli_progress_update() - } - close(pb) - # cli::cli_progress_done() - - # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) - brapiHapIdStringToInt <- function(x) { - id <- strsplit(x, "/")[[1]][1] - ifelse(id == ".", return(NA), return(as.integer(id))) - } - - # F2 - process matrix slices (convert from JSON to int matrix) - processMatrix <- function(x) { - xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") - xNew <- jsonlite::fromJSON(xNew) - xMat <- xNew$result$dataMatrices$dataMatrix[[1]] - colnames(xMat) <- xNew$result$callSetDbIds - rownames(xMat) <- xNew$result$variants - xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) - return(xMat) - } - - # Clean up data (parallel) - # cli::cli_progress_step("Cleaning data") - message("Cleaning data") - finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) - - # Bind all data into one matrix and return - # cli::cli_progress_step("Combining responses") - message("Combining responses") - if (transpose) { - unionMatrix <- t(do.call(rbind, finalMatrices)) - } else { - unionMatrix <- do.call(rbind, finalMatrices) + f = "readRefRanges", + signature = signature(object = "PHGMethod"), + definition = function(object) { + conType <- object |> phgConObj() |> phgType() + + if (conType == "local") { + cat("WIP for reading reference ranges from LOCAL connection\n") + } else if (conType == "server") { + cat("WIP for reading reference ranges from SERVER connection\n") } - - return(unionMatrix) } ) -## ---- -#' @rdname readPHGDataSet -#' -#' @export -setMethod( - f = "readPHGDataSet", - signature = "BrapiConPHG", - definition = function(object, ...) { - - urls <- getVTList(object) - - hapArray <- readTable(object, transpose = FALSE) - - # cli::cli_progress_step("Getting ref range data") - message("Getting ref range data") - rr <- readRefRanges(object) - # cli::cli_progress_step("Getting sample data") - message("Getting sample data") - samples <- readSamples(object) - - colnames(hapArray) <- samples$sampleName - - phgSE <- SummarizedExperiment::SummarizedExperiment( - assays = list(hapID = hapArray), - rowRanges = rr, - colData = samples - ) - - return(methods::new(Class = "PHGDataSet", phgSE)) - } -) +## ## ---- +## #' @rdname readRefRanges +## #' +## #' @importFrom GenomicRanges GRanges +## #' @importFrom IRanges IRanges +## #' @importFrom rJava .jevalArray +## #' @importFrom rJava .jnew +## #' +## #' @export +## setMethod( +## f = "readRefRanges", +## signature = "BrapiConPHG", +## definition = function(object) { +## urls <- getVTList(object) +## +## pageSize <- ifelse( +## grepl("variants$", urls$rangeURL), +## "?pageSize=", +## "&pageSize=" +## ) +## +## if (object@methodID == "DEMO") { +## rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "1000")) +## } else { +## rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "150000")) +## } +## rrDF <- rrDF$result$data +## +## gr <- GenomicRanges::GRanges( +## seqnames = rrDF$referenceName, +## ranges = IRanges::IRanges( +## start = rrDF$start, +## end = rrDF$end +## ), +## variantDbId = rrDF$variantDbId +## ) +## +## return(gr) +## +## } +## ) +## +## +## ## ---- +## #' @rdname readSamples +## #' +## #' @importFrom tibble as_tibble +## #' +## #' @export +## setMethod( +## f = "readSamples", +## signature = "BrapiConPHG", +## definition = function(object) { +## urls <- getVTList(object) +## +## sampleDF <- parseJSON(urls$sampleURL) +## sampleDF <- sampleDF$result$data +## +## if (object@methodID == "DEMO") { +## return(utils::head(tibble::as_tibble(sampleDF), n = 25)) +## } else{ +## return(tibble::as_tibble(sampleDF)) +## } +## } +## ) +## +## +## ## ---- +## #' @rdname readHaplotypeIds +## #' +## #' @param numCores Number of processing cores for faster processing times. +## #' @param transpose Do you want to transpose table? +## #' +## #' @importFrom cli cli_progress_bar +## #' @importFrom cli cli_progress_done +## #' @importFrom cli cli_progress_step +## #' @importFrom cli cli_progress_update +## #' @importFrom httr content +## #' @importFrom httr GET +## #' @importFrom jsonlite fromJSON +## #' @importFrom parallel mclapply +## #' +## #' @export +## setMethod( +## f = "readHaplotypeIds", +## signature = "BrapiConPHG", +## definition = function(object, numCores = NULL, transpose = TRUE) { +## # Logic checks +## if (is.null(numCores)) { +## numCores <- 1 +## } +## if (!is.numeric(numCores)) { +## stop("numCores parameter must be numeric or NULL") +## } +## +## # Get URLs +## urls <- getVTList(object) +## +## # Calculate total pages +## +## if (object@methodID == "DEMO") { +## totalVariants <- 1000 +## totalPages <- ceiling(totalVariants / 250) +## } else { +## methods <- availablePHGMethods(object) +## totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants +## totalPages <- ceiling(totalVariants / 10000) +## } +## +## # Download each page (iterative) +## # TODO - can we async this? (e.g. futures) +## allResp <- vector("list", totalPages) +## # cli::cli_progress_step("Establishing connection") +## message("Establishing connection") +## # cli::cli_progress_bar(" - Downloading: ", total = totalPages) +## message("Downloading:") +## pb <- utils::txtProgressBar( +## style = 3, +## char = "=", +## min = 1, +## max = totalPages +## ) +## for (i in seq_len(totalPages)) { +## currentUrl <- sprintf(urls$tableURL, i - 1, 0) +## allResp[[i]] <- httr::GET(currentUrl) +## utils::setTxtProgressBar(pb, i) +## # cli::cli_progress_update() +## } +## close(pb) +## # cli::cli_progress_done() +## +## # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) +## brapiHapIdStringToInt <- function(x) { +## id <- strsplit(x, "/")[[1]][1] +## ifelse(id == ".", return(NA), return(as.integer(id))) +## } +## +## # F2 - process matrix slices (convert from JSON to int matrix) +## processMatrix <- function(x) { +## xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") +## xNew <- jsonlite::fromJSON(xNew) +## xMat <- xNew$result$dataMatrices$dataMatrix[[1]] +## colnames(xMat) <- xNew$result$callSetDbIds +## rownames(xMat) <- xNew$result$variants +## xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) +## return(xMat) +## } +## +## # Clean up data (parallel) +## # cli::cli_progress_step("Cleaning data") +## message("Cleaning data") +## finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) +## +## # Bind all data into one matrix and return +## # cli::cli_progress_step("Combining responses") +## message("Combining responses") +## if (transpose) { +## unionMatrix <- t(do.call(rbind, finalMatrices)) +## } else { +## unionMatrix <- do.call(rbind, finalMatrices) +## } +## +## return(unionMatrix) +## } +## ) +## +## +## ## ---- +## #' @rdname readPHGDataSet +## #' +## #' @export +## setMethod( +## f = "readPHGDataSet", +## signature = "BrapiConPHG", +## definition = function(object, ...) { +## +## urls <- getVTList(object) +## +## hapArray <- readTable(object, transpose = FALSE) +## +## # cli::cli_progress_step("Getting ref range data") +## message("Getting ref range data") +## rr <- readRefRanges(object) +## # cli::cli_progress_step("Getting sample data") +## message("Getting sample data") +## samples <- readSamples(object) +## +## colnames(hapArray) <- samples$sampleName +## +## phgSE <- SummarizedExperiment::SummarizedExperiment( +## assays = list(hapID = hapArray), +## rowRanges = rr, +## colData = samples +## ) +## +## return(methods::new(Class = "PHGDataSet", phgSE)) +## } +## ) +## +## \ No newline at end of file diff --git a/R/show_phg_methods.R b/R/show_phg_methods.R deleted file mode 100644 index 79aad91..0000000 --- a/R/show_phg_methods.R +++ /dev/null @@ -1,59 +0,0 @@ -## #' @title Get DB PHG methods for graph building -## #' -## #' @description Gets all available PHG methods from the graph database -## #' using a path parameter to the database configuration file. -## #' -## #' @author Brandon Monier -## #' @author Peter Bradbury -## #' -## #' @param configFile Path to a configuration file for your graph database. -## #' -## #' @importFrom rJava .jcast -## #' @importFrom rJava .jnull -## #' @importFrom rJava J -## #' @importFrom rJava new -## #' @importFrom tibble tibble -## #' -## #' @export -## showPHGMethods <- function(configFile) { -## -## configCatcher(configFile) -## -## ## Get table report plugin and pull data from DB -## plugin <- rJava::new( -## rJava::J("net/maizegenetics/pangenome/api/MethodTableReportPlugin") -## ) -## plugin <- plugin$configFile(configFile) -## ds <- plugin$performFunction( -## rJava::.jnull("net/maizegenetics/plugindef/DataSet") -## ) -## datum <- ds$getData(0L) -## tabRep <- rJava::.jcast( -## datum$getData(), -## new.class = "net/maizegenetics/util/TableReport" -## ) -## resultVectors <- rJava::J( -## "net/maizegenetics/plugindef/GenerateRCode", -## "tableReportToVectors", -## tabRep -## ) -## -## ## Get data vectors -## data <- resultVectors$dataVector -## -## ## Convert to native R data frame -## dfMethods <- tibble::tibble( -## data$get(0L), -## data$get(1L), -## data$get(2L), -## data$get(3L), -## data$get(4L) -## ) -## -## ## Convert names -## names(dfMethods) <- resultVectors$columnNames -## -## ## Return object -## return(dfMethods) -## } -## \ No newline at end of file diff --git a/R/utilities_brapi.R b/R/utilities_brapi.R index 10fb18a..24ec582 100644 --- a/R/utilities_brapi.R +++ b/R/utilities_brapi.R @@ -8,23 +8,17 @@ # # @param url Host URL for PHG server # @param endpoint What endpoint to append to URL -brapiEndpointExists <- function(url, endpoint = "serverinfo") { - # # C1 - check for internet connectivity - # if (!curl::has_internet()) { - # stop( - # "Connection cannot be made due to no internet connectivity", - # call. = FALSE - # ) - # } - - # C2 - check for serverinfo endpoint +brapiEndpointExists <- function(url, endpoint = BRAPI_ENDPOINTS$SERVER_INFO) { + # Check specified BrAPI endpoint status <- tryCatch( expr = { httr::GET(file.path(url, endpoint))$status }, error = function(cond) NA ) - + + # NOTE: test currently negates `httResp` check for all status codes. Will + # keep in codebase for possible future debugging tests ifelse( test = !is.na(status) && status >= 200 && status <= 299, yes = return(TRUE), @@ -38,10 +32,12 @@ brapiEndpointExists <- function(url, endpoint = "serverinfo") { # # @description # By default, this will ping the `serverinfo` BrAPI endpoint on the server. +# NOTE: `url` needs `brapi/v2` or `brapi/v1` suffix. # # @param url Host URL for PHG server -# @param endpoint What endpoint to append to URL -httpResp <- function(url, endpoint = "serverinfo") { +# @param endpoint What endpoint to append to URL? Can be `""` for non BrAPI +# tests. +httpResp <- function(url, endpoint = BRAPI_ENDPOINTS$SERVER_INFO) { status <- httr::GET(file.path(url, endpoint))$status @@ -59,16 +55,11 @@ httpResp <- function(url, endpoint = "serverinfo") { ## ---- -#' @title URL checker -#' -#' @description Checks and parses URL inputs to list data from JSON text. -#' -#' @param url A BrAPI URL endpoint. -#' @param verbose Do you want messages shown? -#' -#' @importFrom httr GET -#' @importFrom httr content -#' @importFrom jsonlite fromJSON +# Parse JSON response to native R object +# +# +# @param url A BrAPI URL endpoint. +# @param verbose Do you want messages shown? parseJSON <- function(url, verbose = FALSE) { res <- tryCatch( expr = { diff --git a/R/utilities_general.R b/R/utilities_general.R index 82d97c3..0179324 100644 --- a/R/utilities_general.R +++ b/R/utilities_general.R @@ -54,7 +54,6 @@ configCatcher <- function(configFile) { configLines <- readLines(configFile) # Check for fields - # mandatoryFields <- c("host", "user", "password", "DB", "DBtype") mandatoryFields <- c("DB", "DBtype", "host", "password", "user") dbTypes <- c("sqlite", "postgres") fieldPatterns <- paste0("^", mandatoryFields, "=") @@ -131,3 +130,41 @@ getProperty <- function(configLines, x) { } +## ---- +# Convert TASSEL TableReport objects to native `data.frame` objects +# +# @param x A TASSEL `TableReport` object +tableReportToDF <- function(x) { + rJC <- rJava::J("net/maizegenetics/plugindef/GenerateRCode") + tabRep <- rJC$tableReportToVectors(x) + + tabRepCols <- lapply(tabRep$dataVector, rJava::.jevalArray) + + tabRepCols <- do.call("data.frame", c(tabRepCols, stringsAsFactors = FALSE)) + colnames(tabRepCols) <- tabRep$columnNames + colnames(tabRepCols) <- gsub(" ", "_", colnames(tabRepCols)) + + return(tibble::as_tibble(tabRepCols)) +} + + +## ---- +# Convert method description field string to list from local PHG method call +# +# @param df A PHG method table +descriptionStringToList <- function(s) { + sList <- lapply( + X = strsplit(unlist(strsplit(s, "\",\"")), "\":\""), + FUN = function(i) gsub("\"}|\\{\"", "", x = i) + ) + + names(sList) <- unlist(lapply(sList, function(i) i[1])) + sList <- lapply(sList, function(i) i[2]) + + return(sList) +} + + + + + diff --git a/man/BrapiConPHG-class.Rd b/man/BrapiConPHG-class.Rd deleted file mode 100644 index d92b979..0000000 --- a/man/BrapiConPHG-class.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_phg_method.R -\docType{class} -\name{BrapiConPHG-class} -\alias{BrapiConPHG-class} -\title{An S4 BrapiConPHG Class} -\description{ -Class \code{BrapiConPHG} defines a \code{rPHG} - Class for storing BrAPI connection data plust PHG coordinate info. -} -\section{Slots}{ - -\describe{ -\item{\code{methodID}}{A PHG method identifier.} - -\item{\code{refRangeFilter}}{Reference range selection URL parameters.} - -\item{\code{sampleFilter}}{Sample / taxa selection URL parameters.} -}} - diff --git a/man/PHGLocalCon-class.Rd b/man/PHGLocalCon-class.Rd index 11f4387..5812cb1 100644 --- a/man/PHGLocalCon-class.Rd +++ b/man/PHGLocalCon-class.Rd @@ -12,7 +12,7 @@ \item{object}{A \code{\linkS4class{PHGLocalCon}} object} } \description{ -Class \code{PHGLocalCon} defines a \code{rPHG} class for storing +A \code{PHGLocalCon} class defines a \code{rPHG} class for storing local config file data. Prints out information regarding properties from the \code{PHGLocalCon} @@ -21,8 +21,6 @@ class to the console \section{Slots}{ \describe{ -\item{\code{host}}{Location path of local SQLite or Postgres database} - \item{\code{dbName}}{Name of database} \item{\code{dbType}}{Type of database} diff --git a/man/PHGMethod-class.Rd b/man/PHGMethod-class.Rd new file mode 100644 index 0000000..fd53287 --- /dev/null +++ b/man/PHGMethod-class.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_method.R +\docType{class} +\name{PHGMethod-class} +\alias{PHGMethod-class} +\title{A PHGMethod Class} +\description{ +Class \code{PHGMethod} defines a \code{rPHG} Class for storing +a "committed" PHG method to return data against. +} +\section{Slots}{ + +\describe{ +\item{\code{methodID}}{A PHG method identifier.} + +\item{\code{phgConObj}}{A \code{\linkS4class{PHGCon}} object} +}} + diff --git a/man/PHGMethod.Rd b/man/PHGMethod.Rd index 093c083..f490366 100644 --- a/man/PHGMethod.Rd +++ b/man/PHGMethod.Rd @@ -2,16 +2,16 @@ % Please edit documentation in R/class_phg_method.R \name{PHGMethod} \alias{PHGMethod} -\title{Helper function to construct BrapiConPHG object} +\title{Helper function to construct PHGMethod object} \usage{ -PHGMethod(brapiObj, x) +PHGMethod(phgConObj, methodID) } \arguments{ -\item{brapiObj}{A \code{BrapiCon} object.} +\item{phgConObj}{A \code{\linkS4class{PHGCon}} object.} -\item{x}{A PHG method identifier.} +\item{methodID}{A PHG method identifier.} } \description{ -Creates a \code{BrapiConPHG} object to be used to read and - filter data from a given BrAPI endpoint given a verified PHG method. +Creates a \code{\linkS4class{PHGMethod}} object to be used to read and +filter data from a given PHG connection object using a verified PHG method. } diff --git a/man/PHGServerCon-class.Rd b/man/PHGServerCon-class.Rd index 01ab3af..e99b883 100644 --- a/man/PHGServerCon-class.Rd +++ b/man/PHGServerCon-class.Rd @@ -21,8 +21,6 @@ class to the console \section{Slots}{ \describe{ -\item{\code{host}}{A URL to a BrAPI server.} - \item{\code{port}}{The host port.} \item{\code{protocol}}{Which protocol must be used to fetch the desired data? Must diff --git a/man/PHGServerCon.Rd b/man/PHGServerCon.Rd index a5bee1c..19cea2e 100644 --- a/man/PHGServerCon.Rd +++ b/man/PHGServerCon.Rd @@ -12,8 +12,6 @@ PHGServerCon( ) } \arguments{ -\item{host}{A URL to a BrAPI server.} - \item{port}{The host port. If \code{NULL}, a default port (e.g. \code{80} or \code{443}) will be used depending on protocol.} diff --git a/man/brapiVersion.Rd b/man/brapiVersion.Rd index d323c4a..dc60414 100644 --- a/man/brapiVersion.Rd +++ b/man/brapiVersion.Rd @@ -1,10 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{brapiVersion} \alias{brapiVersion} +\alias{brapiVersion,PHGServerCon-method} \title{Return BrAPI version ID} \usage{ brapiVersion(object, ...) + +\S4method{brapiVersion}{PHGServerCon}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/host.Rd b/man/host.Rd index 4291a50..2856bb7 100644 --- a/man/host.Rd +++ b/man/host.Rd @@ -1,20 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_con_local.R, -% R/class_phg_con_server.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con.R \name{host} \alias{host} -\alias{host,PHGLocalCon-method} -\alias{host,PHGServerCon-method} -\alias{port,PHGServerCon-method} +\alias{host,PHGCon-method} \title{Return host data} \usage{ host(object, ...) -\S4method{host}{PHGLocalCon}(object) - -\S4method{host}{PHGServerCon}(object) - -\S4method{port}{PHGServerCon}(object) +\S4method{host}{PHGCon}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/parseJSON.Rd b/man/parseJSON.Rd deleted file mode 100644 index 1b5357d..0000000 --- a/man/parseJSON.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities_brapi.R -\name{parseJSON} -\alias{parseJSON} -\title{URL checker} -\usage{ -parseJSON(url, verbose = FALSE) -} -\arguments{ -\item{url}{A BrAPI URL endpoint.} - -\item{verbose}{Do you want messages shown?} -} -\description{ -Checks and parses URL inputs to list data from JSON text. -} diff --git a/man/port.Rd b/man/port.Rd index a55a8e3..453532c 100644 --- a/man/port.Rd +++ b/man/port.Rd @@ -1,10 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R \name{port} \alias{port} +\alias{port,PHGServerCon-method} \title{Return port value} \usage{ port(object, ...) + +\S4method{port}{PHGServerCon}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/readHaplotypeIds.Rd b/man/readHaplotypeIds.Rd index 8f480b2..cca6e3a 100644 --- a/man/readHaplotypeIds.Rd +++ b/man/readHaplotypeIds.Rd @@ -1,22 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R \name{readHaplotypeIds} \alias{readHaplotypeIds} -\alias{readHaplotypeIds,BrapiConPHG-method} \title{Return haplotype IDs} \usage{ readHaplotypeIds(object, ...) - -\S4method{readHaplotypeIds}{BrapiConPHG}(object, numCores = NULL, transpose = TRUE) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} \item{...}{Additional arguments, for use in specific methods} - -\item{numCores}{Number of processing cores for faster processing times.} - -\item{transpose}{Do you want to transpose table?} } \description{ Gets haplotype ID for given samples and reference ranges for PHG method diff --git a/man/readPHGDataSet.Rd b/man/readPHGDataSet.Rd index c944e33..131deb6 100644 --- a/man/readPHGDataSet.Rd +++ b/man/readPHGDataSet.Rd @@ -1,13 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R \name{readPHGDataSet} \alias{readPHGDataSet} -\alias{readPHGDataSet,BrapiConPHG-method} \title{Return a PHGDataSet} \usage{ readPHGDataSet(object, ...) - -\S4method{readPHGDataSet}{BrapiConPHG}(object, ...) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/readRefRanges.Rd b/man/readRefRanges.Rd index f423bf1..0a14d09 100644 --- a/man/readRefRanges.Rd +++ b/man/readRefRanges.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_method.R \name{readRefRanges} \alias{readRefRanges} -\alias{readRefRanges,BrapiConPHG-method} +\alias{readRefRanges,PHGMethod-method} \title{Return reference ranges} \usage{ readRefRanges(object, ...) -\S4method{readRefRanges}{BrapiConPHG}(object) +\S4method{readRefRanges}{PHGMethod}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/readSamples.Rd b/man/readSamples.Rd index 42ab02d..eb9acd6 100644 --- a/man/readSamples.Rd +++ b/man/readSamples.Rd @@ -1,13 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R \name{readSamples} \alias{readSamples} -\alias{readSamples,BrapiConPHG-method} \title{Return samples IDs} \usage{ readSamples(object, ...) - -\S4method{readSamples}{BrapiConPHG}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/show.Rd b/man/show.Rd index bfbc86e..59c03bf 100644 --- a/man/show.Rd +++ b/man/show.Rd @@ -3,17 +3,15 @@ \docType{methods} \name{show} \alias{show} -\alias{show,BrapiConPHG-method} -\title{Show method for BrapiConPHG objects} +\alias{show,PHGMethod-method} +\title{Show method for PHGMethod objects} \usage{ -\S4method{show}{BrapiConPHG}(object) +\S4method{show}{PHGMethod}(object) } \arguments{ -\item{object}{a \code{\linkS4class{BrapiConPHG}} object.} +\item{object}{a \code{\linkS4class{PHGMethod}} object.} } \description{ -Prints out the information from the BrAPI connection object - including server status codes. See this - \href{https://en.wikipedia.org/wiki/List_of_HTTP_status_codes}{Wikipedia link} - for further details about what these codes mean. +Prints out information regarding properties from the \code{PHGMethod} +class to the console } diff --git a/man/showPHGMethods.Rd b/man/showPHGMethods.Rd index f7d5115..632ae72 100644 --- a/man/showPHGMethods.Rd +++ b/man/showPHGMethods.Rd @@ -1,17 +1,24 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_local.R, +% R/class_phg_con_server.R \name{showPHGMethods} \alias{showPHGMethods} +\alias{showPHGMethods,PHGLocalCon-method} \alias{showPHGMethods,PHGServerCon-method} \title{Return available PHG methods} \usage{ -showPHGMethods(object, ...) +showPHGMethods(object, showAdvancedMethods = FALSE, ...) -\S4method{showPHGMethods}{PHGServerCon}(object) +\S4method{showPHGMethods}{PHGLocalCon}(object, showAdvancedMethods) + +\S4method{showPHGMethods}{PHGServerCon}(object, showAdvancedMethods) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} +\item{showAdvancedMethods}{Do you want to return all possible method IDs +from the database? Defaults to \code{FALSE}.} + \item{...}{Additional arguments, for use in specific methods} } \description{ From daca56cde6d400c92bce07e10426eabe124e4787 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 25 Aug 2023 07:02:41 -0400 Subject: [PATCH 19/35] Version bump --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1c5f077..6716635 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: rPHG -Version: 0.1.19 +Version: 0.2.0 Date: 2019-06-03 Title: R front-end for the practical haplotype graph Authors@R: c( From 03fd1e9eb81de15c88f9440c70b0b7accaa18fb5 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 25 Aug 2023 16:35:32 -0400 Subject: [PATCH 20/35] Initial commit --- R/read_hap_ids.R | 23 +++++++++++++ R/read_phg_dataset.R | 54 +++++++++++++++++++++++++++++ R/read_ref_ranges.R | 50 +++++++++++++++++++++++++++ R/read_samples.R | 55 ++++++++++++++++++++++++++++++ R/utilities_phg_api.R | 72 +++++++++++++++++++++++++++++++++++++++ man/PHGMethod-validity.Rd | 11 ++++++ man/httProtocol.Rd | 19 +++++++++++ man/phgMethodId.Rd | 19 +++++++++++ 8 files changed, 303 insertions(+) create mode 100644 R/read_hap_ids.R create mode 100644 R/read_phg_dataset.R create mode 100644 R/read_ref_ranges.R create mode 100644 R/read_samples.R create mode 100644 R/utilities_phg_api.R create mode 100644 man/PHGMethod-validity.Rd create mode 100644 man/httProtocol.Rd create mode 100644 man/phgMethodId.Rd diff --git a/R/read_hap_ids.R b/R/read_hap_ids.R new file mode 100644 index 0000000..630bdcf --- /dev/null +++ b/R/read_hap_ids.R @@ -0,0 +1,23 @@ +## ---- +# Get reference ranges from local connection +# +# @param conObj A PHG connection object +# @param conMethod A PHG database method ID +hapIdsFromLocal <- function(conObj, conMethod) { + pathsForMethod( + configFilePath(conObj), + conMethod + ) +} + + +## ---- +# Get reference ranges from server connection +# +# @param conObj A PHG connection object +# @param conMethod A PHG database method ID +hapIdsFromSever <- function(conObj, conMethod) { + print("WIP for `hapIdsFromServer`") +} + + diff --git a/R/read_phg_dataset.R b/R/read_phg_dataset.R new file mode 100644 index 0000000..8d90e81 --- /dev/null +++ b/R/read_phg_dataset.R @@ -0,0 +1,54 @@ +## ---- +# Get PHGDataSet from local connection +# +# @param conObj A PHG connection object +# @param conMethod A PHG database method ID +# @param verbose Show console log info +phgDataSetFromLocal <- function(conObj, conMethod, verbose) { + bullet <- cli::col_grey(cli::symbol$info) + verbInfo <- c( + paste0(bullet, " Getting reference range data..."), + paste0(bullet, " Getting haplotype matrix data..."), + paste0(bullet, " Constructing PHGDataSet...") + ) + + if (verbose) message(verbInfo[1]) + gr <- refRangesFromLocal(conObj, conMethod) + + if (verbose) message(verbInfo[2]) + hm <- hapIdsFromLocal(conObj, conMethod) + + if (verbose) message(verbInfo[3]) + phgSE <- SummarizedExperiment::SummarizedExperiment( + assays = list(pathMatrix = t(hm)), + rowRanges = gr + ) + + return(methods::new(Class = "PHGDataSet", phgSE)) +} + + +## ---- +# Get PHGDataSet from server connection +# +# @param conObj A PHG connection object +# @param conMethod A PHG database method ID +# @param verbose Show console log info +phgDataSetFromServer <- function(conObj, conMethod, verbose) { + bullet <- cli::col_red(cli::symbol$warning) + verbInfo <- c( + paste0(bullet, cli::style_bold(" (WIP)"), " Getting reference range data..."), + paste0(bullet, cli::style_bold(" (WIP)"), " Getting haplotype matrix data..."), + paste0(bullet, cli::style_bold(" (WIP)"), " Constructing PHGDataSet...") + ) + + if (verbose) message(verbInfo[1]) + + if (verbose) message(verbInfo[2]) + + if (verbose) message(verbInfo[3]) + + return(NULL) +} + + diff --git a/R/read_ref_ranges.R b/R/read_ref_ranges.R new file mode 100644 index 0000000..0fac06d --- /dev/null +++ b/R/read_ref_ranges.R @@ -0,0 +1,50 @@ +## ---- +# Get reference ranges from local connection +# +# @param conObj A PHG connection object +# @param conMethod A PHG database method ID +refRangesFromLocal <- function(conObj, conMethod) { + phgObj <- graphFromPaths(configFilePath(conObj), conMethod) + rrDf <- refRangesFromGraphObj(phgObj) + + gr <- GenomicRanges::GRanges( + seqnames = rrDf$chr, + ranges = IRanges::IRanges( + start = rrDf$start, + end = rrDf$end + ), + rr_id = rrDf$id + ) + + return(gr) +} + + +## ---- +# Get reference ranges from server connection +# +# @param conObj A PHG connection object +# @param conMethod A PHG database method ID +refRangesFromServer <- function(conObj, conMethod) { + finalUrl <- file.path( + brapiURL(conObj), + BRAPI_ENDPOINTS$VARIANT_TABLES, + conMethod, + sprintf("%s?pageSize=%i", BRAPI_ENDPOINTS$VARIANTS, 150000) + ) + + rrDf <- parseJSON(finalUrl)$result$data + + gr <- GenomicRanges::GRanges( + seqnames = rrDf$referenceName, + ranges = IRanges::IRanges( + start = rrDf$start, + end = rrDf$end + ), + rr_id = paste0("R", rrDf$variantDbId) + ) + + return(gr) +} + + diff --git a/R/read_samples.R b/R/read_samples.R new file mode 100644 index 0000000..93001c4 --- /dev/null +++ b/R/read_samples.R @@ -0,0 +1,55 @@ +## ---- +# Get samples from local connection +# +# @param conObj A PHG connection object +# @param conMethod A PHG database method ID +samplesFromLocal <- function(conObj, conMethod) { + dbConn <- rJava::.jnew(TASSEL_API$DB_LOADING_UTILS)$ + connection( + configFilePath(conObj), + FALSE + ) + + sqlQuery <- paste( + c("SELECT line_name, name FROM genotypes"), + c("JOIN paths on paths.genoid=genotypes.genoid"), + c("JOIN methods on methods.method_id=paths.method_id"), + sprintf("WHERE methods.name = '%s'", conMethod), + collapse = " " + ) + + rs <- dbConn$createStatement()$executeQuery(sqlQuery) + + taxa <- c() + i <- 1 + while (rs$`next`()) { + taxa[i] <- rs$getString("line_name") + i <- i + 1 + } + + rs$close() + dbConn$close() + + return(taxa) +} + + +## ---- +# Get samples from server connection +# +# @param conObj A PHG connection object +# @param conMethod A PHG database method ID +samplesFromServer <- function(conObj, conMethod) { + finalUrl <- file.path( + brapiURL(conObj), + BRAPI_ENDPOINTS$VARIANT_TABLES, + conMethod, + BRAPI_ENDPOINTS$SAMPLES + ) + + taxaDf <- parseJSON(finalUrl)$result$data + + return(taxaDf$sampleName) +} + + diff --git a/R/utilities_phg_api.R b/R/utilities_phg_api.R new file mode 100644 index 0000000..60d55d4 --- /dev/null +++ b/R/utilities_phg_api.R @@ -0,0 +1,72 @@ +## ---- +# Build graph object from path method(s) +# +# @param configFile Path to a config file +# @param method A path method string +graphFromPaths <- function(configFile, method) { + gbPlugin <- rJava::new( + rJava::J(TASSEL_API$BUILD_GRAPH_FROM_PATHS) + ) + rJava::J(TASSEL_API$PARAMETER_CACHE)$load( + toString(configFile) + ) + gbPlugin$pathMethod(toString(method)) + + graphObj <- gbPlugin$build() + + return(graphObj) +} + + +## ---- +# Get reference range data from graph objects +# +# @param phgObj A PHG `HaplotypeGraph` object +refRangesFromGraphObj <- function(phgObj) { + # Get reference range object from PHG object + refRangeObj <- rJava::J( + TASSEL_API$R_METHODS, + "referenceRanges", + phgObj + ) + + # Get data vectors and convert to tibble + refranges <- data.frame( + lapply( + X = seq_along(refRangeObj$columnNames) - 1, + FUN = function(i) { + refRangeObj$dataVectors$get(as.integer(i)) + } + ) + ) + names(refranges) <- refRangeObj$columnNames + + return(refranges) +} + + +## ---- +# Get hap ID matrix for a given path method +# +# @param configFile Path to a config file +# @param method A path method string +pathsForMethod <- function(configFile, method) { + + # Retrieve Java matrix object + pathObj <- rJava::J( + TASSEL_API$R_METHODS, + "pathsForMethod", + configFile, + method + ) + + # Configure for R + pathMat <- pathObj$matrix + rownames(pathMat) <- pathObj$rowNames + colnames(pathMat) <- paste0("R", pathObj$columnNames) + + # Return + return(pathMat) +} + + diff --git a/man/PHGMethod-validity.Rd b/man/PHGMethod-validity.Rd new file mode 100644 index 0000000..a490d60 --- /dev/null +++ b/man/PHGMethod-validity.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_method.R +\name{PHGMethod-validity} +\alias{PHGMethod-validity} +\title{PHGMethod validation} +\arguments{ +\item{object}{A \code{PHGMethod} object.} +} +\description{ +Checks if \code{PHGMethod} class objects are valid. +} diff --git a/man/httProtocol.Rd b/man/httProtocol.Rd new file mode 100644 index 0000000..cb7794b --- /dev/null +++ b/man/httProtocol.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_con_server.R +\name{httProtocol} +\alias{httProtocol} +\alias{httProtocol,PHGServerCon-method} +\title{Return protocol value} +\usage{ +httProtocol(object, ...) + +\S4method{httProtocol}{PHGServerCon}(object) +} +\arguments{ +\item{object}{an \code{rPHG} local or server connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the protocol information for a given object +} diff --git a/man/phgMethodId.Rd b/man/phgMethodId.Rd new file mode 100644 index 0000000..f3bc56e --- /dev/null +++ b/man/phgMethodId.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +\name{phgMethodId} +\alias{phgMethodId} +\alias{phgMethodId,PHGMethod-method} +\title{Return method ID} +\usage{ +phgMethodId(object, ...) + +\S4method{phgMethodId}{PHGMethod}(object) +} +\arguments{ +\item{object}{an \code{rPHG} method object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns a method ID string for a given \code{rPHG} method class +} From 7c4e22cf7ba920ad57c42fe29635dd219e01d201 Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 25 Aug 2023 16:35:53 -0400 Subject: [PATCH 21/35] Update getters for PHGMethod class --- NAMESPACE | 12 +- R/class_all_generics.R | 22 ++- R/class_phg_con_local.R | 18 +- R/class_phg_con_server.R | 12 ++ R/class_phg_method.R | 305 ++++++++++----------------------- R/constants.R | 25 ++- R/deprecated_brapi.R | 135 ++++++++++++++- R/method_table.R | 2 +- R/path_matrix.R | 133 -------------- R/ref_range_table.R | 35 ---- R/stats_and_visualization.R | 94 ++++++++++ man/pathsForMethod.Rd | 22 --- man/readHaplotypeIds.Rd | 5 +- man/readMappingTableInfo.Rd | 2 +- man/readMappingsForLineName.Rd | 2 +- man/readPHGDataSet.Rd | 10 +- man/readSamples.Rd | 5 +- man/refRangeTable.Rd | 19 -- 18 files changed, 408 insertions(+), 450 deletions(-) delete mode 100644 R/path_matrix.R delete mode 100644 R/ref_range_table.R delete mode 100644 man/pathsForMethod.Rd delete mode 100644 man/refRangeTable.Rd diff --git a/NAMESPACE b/NAMESPACE index 19a43ac..8c43d9a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,10 +11,10 @@ export(dbType) export(getVTList) export(graphBuilder) export(host) +export(httProtocol) export(numHaploPerRange) -export(pathsForMethod) export(phgConObj) -export(phgMethod) +export(phgMethodId) export(phgType) export(plotGraph) export(plotMutualInfo) @@ -26,7 +26,6 @@ export(readMappingsForLineName) export(readPHGDataSet) export(readRefRanges) export(readSamples) -export(refRangeTable) export(searchRecombination) export(searchSimilarGametes) export(serverInfo) @@ -44,11 +43,15 @@ exportMethods(configFilePath) exportMethods(dbName) exportMethods(dbType) exportMethods(host) +exportMethods(httProtocol) exportMethods(phgConObj) -exportMethods(phgMethod) +exportMethods(phgMethodId) exportMethods(phgType) exportMethods(port) +exportMethods(readHaplotypeIds) +exportMethods(readPHGDataSet) exportMethods(readRefRanges) +exportMethods(readSamples) exportMethods(serverInfo) exportMethods(showPHGMethods) import(ggplot2) @@ -73,7 +76,6 @@ importFrom(rJava,.jcall) importFrom(rJava,.jnew) importFrom(rJava,.jnull) importFrom(rJava,J) -importFrom(rJava,is.jnull) importFrom(rJava,new) importFrom(rlang,.data) importFrom(stats,median) diff --git a/R/class_all_generics.R b/R/class_all_generics.R index 4bc897f..ccb4682 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -82,6 +82,20 @@ setGeneric("dbType", function(object, ...) standardGeneric("dbType")) setGeneric("host", function(object, ...) standardGeneric("host")) +## ---- +#' @title Return protocol value +#' +#' @description +#' Returns the protocol information for a given object +#' +#' @param object an \code{rPHG} local or server connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname httProtocol +#' @export +setGeneric("httProtocol", function(object, ...) standardGeneric("httProtocol")) + + ## ---- #' @title Return a PHG connection object #' @@ -105,9 +119,9 @@ setGeneric("phgConObj", function(object, ...) standardGeneric("phgConObj")) #' @param object an \code{rPHG} method object #' @param ... Additional arguments, for use in specific methods #' -#' @rdname phgMethod +#' @rdname phgMethodId #' @export -setGeneric("phgMethod", function(object, ...) standardGeneric("phgMethod")) +setGeneric("phgMethodId", function(object, ...) standardGeneric("phgMethodId")) ## ---- @@ -161,11 +175,13 @@ setGeneric("readHaplotypeIds", function(object, ...) standardGeneric("readHaplot #' haplotype IDs). #' #' @param object an \code{rPHG} local or server connection object +#' @param verbose should retrieval information be printed? Defaults to +#' \code{FALSE} #' @param ... Additional arguments, for use in specific methods #' #' @rdname readPHGDataSet #' @export -setGeneric("readPHGDataSet", function(object, ...) standardGeneric("readPHGDataSet")) +setGeneric("readPHGDataSet", function(object, verbose = FALSE, ...) standardGeneric("readPHGDataSet")) ## ---- diff --git a/R/class_phg_con_local.R b/R/class_phg_con_local.R index 4945902..b284c3d 100644 --- a/R/class_phg_con_local.R +++ b/R/class_phg_con_local.R @@ -115,37 +115,37 @@ setMethod( # /// Methods (general) ///////////////////////////////////////////// ## ---- -#' @rdname dbName +#' @rdname configFilePath #' @export setMethod( - f = "dbName", + f = "configFilePath", signature = signature(object = "PHGLocalCon"), definition = function(object) { - return(object@dbName) + return(object@configFilePath) } ) ## ---- -#' @rdname dbType +#' @rdname dbName #' @export setMethod( - f = "dbType", + f = "dbName", signature = signature(object = "PHGLocalCon"), definition = function(object) { - return(object@dbType) + return(object@dbName) } ) ## ---- -#' @rdname configFilePath +#' @rdname dbType #' @export setMethod( - f = "configFilePath", + f = "dbType", signature = signature(object = "PHGLocalCon"), definition = function(object) { - return(object@configFilePath) + return(object@dbType) } ) diff --git a/R/class_phg_con_server.R b/R/class_phg_con_server.R index ac28346..b86f14b 100644 --- a/R/class_phg_con_server.R +++ b/R/class_phg_con_server.R @@ -218,6 +218,18 @@ setMethod( ) +## ---- +#' @rdname httProtocol +#' @export +setMethod( + f = "httProtocol", + signature = signature(object = "PHGServerCon"), + definition = function(object) { + return(object@protocol) + } +) + + ## ---- #' @rdname serverInfo #' @export diff --git a/R/class_phg_method.R b/R/class_phg_method.R index 812b01c..42417c2 100644 --- a/R/class_phg_method.R +++ b/R/class_phg_method.R @@ -24,6 +24,33 @@ setClass( ) +## ---- +#' @title PHGMethod validation +#' +#' @name PHGMethod-validity +#' +#' @description Checks if \code{PHGMethod} class objects are valid. +#' +#' @param object A \code{PHGMethod} object. +#' +#' @importFrom curl has_internet +setValidity("PHGMethod", function(object) { + errors <- character() + + methodIDs <- showPHGMethods( + object = phgConObj(object), + showAdvancedMethods = TRUE + )$method_name + methodID <- phgMethodId(object) + if (!methodID %in% methodIDs) { + msg <- "Method ID not found in database." + errors <- c(errors, msg) + } + + if (length(errors) == 0) TRUE else errors +}) + + ## ---- #' @title Helper function to construct PHGMethod object #' @@ -39,11 +66,6 @@ PHGMethod <- function(phgConObj, methodID) { # # For demo purposes only! (useful for workshops) # if (methodID == "DEMO") methodID <- "NAM_GBS_Alignments_PATHS" - - methodIDs <- showPHGMethods(phgConObj)$method_name - if (!methodID %in% methodIDs) { - stop("Method ID not found in database", call. = FALSE) - } methods::new( Class = "PHGMethod", @@ -80,7 +102,7 @@ setMethod( "local" = cli::style_bold(cli::col_green("PHGLocalCon")) ) - methodId <- cli::style_bold(cli::col_blue(phgMethod(object))) + methodId <- cli::style_bold(cli::col_blue(phgMethodId(object))) msg <- c( paste0("A ", cli::style_bold("PHGMethod"), " promise object:"), @@ -108,10 +130,10 @@ setMethod( ## ---- -#' @rdname phgMethod +#' @rdname phgMethodId #' @export setMethod( - f = "phgMethod", + f = "phgMethodId", signature = signature(object = "PHGMethod"), definition = function(object) { return(object@methodID) @@ -126,215 +148,76 @@ setMethod( f = "readRefRanges", signature = signature(object = "PHGMethod"), definition = function(object) { - conType <- object |> phgConObj() |> phgType() + conObj <- phgConObj(object) + conType <- phgType(conObj) + conMethod <- phgMethodId(object) if (conType == "local") { - cat("WIP for reading reference ranges from LOCAL connection\n") + refRangesFromLocal(conObj, conMethod) } else if (conType == "server") { - cat("WIP for reading reference ranges from SERVER connection\n") + refRangesFromServer(conObj, conMethod) } } ) +## ---- +#' @rdname readSamples +#' @export +setMethod( + f = "readSamples", + signature = signature(object = "PHGMethod"), + definition = function(object) { + conObj <- phgConObj(object) + conType <- phgType(conObj) + conMethod <- phgMethodId(object) + + if (conType == "local") { + samplesFromLocal(conObj, conMethod) + } else if (conType == "server") { + samplesFromServer(conObj, conMethod) + } + } +) + + +## ---- +#' @rdname readHaplotypeIds +#' @export +setMethod( + f = "readHaplotypeIds", + signature = signature(object = "PHGMethod"), + definition = function(object) { + conObj <- phgConObj(object) + conType <- phgType(conObj) + conMethod <- phgMethodId(object) + + if (conType == "local") { + hapIdsFromLocal(conObj, conMethod) + } else if (conType == "server") { + hapIdsFromSever(conObj, conMethod) + } + } +) + + +## ---- +#' @rdname readPHGDataSet +#' @export +setMethod( + f = "readPHGDataSet", + signature = signature(object = "PHGMethod"), + definition = function(object, verbose = TRUE) { + conObj <- phgConObj(object) + conType <- phgType(conObj) + conMethod <- phgMethodId(object) + + if (conType == "local") { + phgDataSetFromLocal(conObj, conMethod, verbose) + } else if (conType == "server") { + phgDataSetFromServer(conObj, conMethod, verbose) + } + } +) + -## ## ---- -## #' @rdname readRefRanges -## #' -## #' @importFrom GenomicRanges GRanges -## #' @importFrom IRanges IRanges -## #' @importFrom rJava .jevalArray -## #' @importFrom rJava .jnew -## #' -## #' @export -## setMethod( -## f = "readRefRanges", -## signature = "BrapiConPHG", -## definition = function(object) { -## urls <- getVTList(object) -## -## pageSize <- ifelse( -## grepl("variants$", urls$rangeURL), -## "?pageSize=", -## "&pageSize=" -## ) -## -## if (object@methodID == "DEMO") { -## rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "1000")) -## } else { -## rrDF <- parseJSON(paste0(urls$rangeURL, pageSize, "150000")) -## } -## rrDF <- rrDF$result$data -## -## gr <- GenomicRanges::GRanges( -## seqnames = rrDF$referenceName, -## ranges = IRanges::IRanges( -## start = rrDF$start, -## end = rrDF$end -## ), -## variantDbId = rrDF$variantDbId -## ) -## -## return(gr) -## -## } -## ) -## -## -## ## ---- -## #' @rdname readSamples -## #' -## #' @importFrom tibble as_tibble -## #' -## #' @export -## setMethod( -## f = "readSamples", -## signature = "BrapiConPHG", -## definition = function(object) { -## urls <- getVTList(object) -## -## sampleDF <- parseJSON(urls$sampleURL) -## sampleDF <- sampleDF$result$data -## -## if (object@methodID == "DEMO") { -## return(utils::head(tibble::as_tibble(sampleDF), n = 25)) -## } else{ -## return(tibble::as_tibble(sampleDF)) -## } -## } -## ) -## -## -## ## ---- -## #' @rdname readHaplotypeIds -## #' -## #' @param numCores Number of processing cores for faster processing times. -## #' @param transpose Do you want to transpose table? -## #' -## #' @importFrom cli cli_progress_bar -## #' @importFrom cli cli_progress_done -## #' @importFrom cli cli_progress_step -## #' @importFrom cli cli_progress_update -## #' @importFrom httr content -## #' @importFrom httr GET -## #' @importFrom jsonlite fromJSON -## #' @importFrom parallel mclapply -## #' -## #' @export -## setMethod( -## f = "readHaplotypeIds", -## signature = "BrapiConPHG", -## definition = function(object, numCores = NULL, transpose = TRUE) { -## # Logic checks -## if (is.null(numCores)) { -## numCores <- 1 -## } -## if (!is.numeric(numCores)) { -## stop("numCores parameter must be numeric or NULL") -## } -## -## # Get URLs -## urls <- getVTList(object) -## -## # Calculate total pages -## -## if (object@methodID == "DEMO") { -## totalVariants <- 1000 -## totalPages <- ceiling(totalVariants / 250) -## } else { -## methods <- availablePHGMethods(object) -## totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants -## totalPages <- ceiling(totalVariants / 10000) -## } -## -## # Download each page (iterative) -## # TODO - can we async this? (e.g. futures) -## allResp <- vector("list", totalPages) -## # cli::cli_progress_step("Establishing connection") -## message("Establishing connection") -## # cli::cli_progress_bar(" - Downloading: ", total = totalPages) -## message("Downloading:") -## pb <- utils::txtProgressBar( -## style = 3, -## char = "=", -## min = 1, -## max = totalPages -## ) -## for (i in seq_len(totalPages)) { -## currentUrl <- sprintf(urls$tableURL, i - 1, 0) -## allResp[[i]] <- httr::GET(currentUrl) -## utils::setTxtProgressBar(pb, i) -## # cli::cli_progress_update() -## } -## close(pb) -## # cli::cli_progress_done() -## -## # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) -## brapiHapIdStringToInt <- function(x) { -## id <- strsplit(x, "/")[[1]][1] -## ifelse(id == ".", return(NA), return(as.integer(id))) -## } -## -## # F2 - process matrix slices (convert from JSON to int matrix) -## processMatrix <- function(x) { -## xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") -## xNew <- jsonlite::fromJSON(xNew) -## xMat <- xNew$result$dataMatrices$dataMatrix[[1]] -## colnames(xMat) <- xNew$result$callSetDbIds -## rownames(xMat) <- xNew$result$variants -## xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) -## return(xMat) -## } -## -## # Clean up data (parallel) -## # cli::cli_progress_step("Cleaning data") -## message("Cleaning data") -## finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) -## -## # Bind all data into one matrix and return -## # cli::cli_progress_step("Combining responses") -## message("Combining responses") -## if (transpose) { -## unionMatrix <- t(do.call(rbind, finalMatrices)) -## } else { -## unionMatrix <- do.call(rbind, finalMatrices) -## } -## -## return(unionMatrix) -## } -## ) -## -## -## ## ---- -## #' @rdname readPHGDataSet -## #' -## #' @export -## setMethod( -## f = "readPHGDataSet", -## signature = "BrapiConPHG", -## definition = function(object, ...) { -## -## urls <- getVTList(object) -## -## hapArray <- readTable(object, transpose = FALSE) -## -## # cli::cli_progress_step("Getting ref range data") -## message("Getting ref range data") -## rr <- readRefRanges(object) -## # cli::cli_progress_step("Getting sample data") -## message("Getting sample data") -## samples <- readSamples(object) -## -## colnames(hapArray) <- samples$sampleName -## -## phgSE <- SummarizedExperiment::SummarizedExperiment( -## assays = list(hapID = hapArray), -## rowRanges = rr, -## colData = samples -## ) -## -## return(methods::new(Class = "PHGDataSet", phgSE)) -## } -## ) -## -## \ No newline at end of file diff --git a/R/constants.R b/R/constants.R index cb28ae4..b044c19 100644 --- a/R/constants.R +++ b/R/constants.R @@ -1,14 +1,31 @@ ## ---- # Specified BrAPI endpoints BRAPI_ENDPOINTS <- list( - "METHOD_TABLE" = "allelematrix", - "SERVER_INFO" = "serverinfo" + "METHOD_TABLE" = "allelematrix", + "SAMPLES" = "samples", + "SERVER_INFO" = "serverinfo", + "VARIANT_TABLES" = "variantTables", + "VARIANTS" = "variants" +) + + +## ---- +# Commonly used BrAPI parameters +BRAPI_PARAMS <- list( + "PAGE_SIZE" = "pageSize=%i" ) ## ---- # TASSEL and PHG class calls for rJava TASSEL_API <- list( - "DATA_SET" = "net/maizegenetics/plugindef/DataSet", - "METHOD_TABLE_REPORT_PLUGIN" = "net/maizegenetics/pangenome/api/MethodTableReportPlugin" + "BUILD_GRAPH_FROM_PATHS" = "net/maizegenetics/pangenome/api/BuildGraphFromPathsPlugin", + "DATA_SET" = "net/maizegenetics/plugindef/DataSet", + "DB_LOADING_UTILS" = "net/maizegenetics/pangenome/db_loading/DBLoadingUtils", + "FRAME" = "java/awt/Frame", + "HAPLOTYPE_GRAPH_BUILDER" = "net/maizegenetics/pangenome/api/HaplotypeGraphBuilderPlugin", + "METHOD_TABLE_REPORT" = "net/maizegenetics/pangenome/api/MethodTableReportPlugin", + "PARAMETER_CACHE" = "net/maizegenetics/plugindef/ParameterCache", + "R_METHODS" = "net/maizegenetics/pangenome/api/RMethods", + "RESULT_SET" = "java/sql/ResultSet" ) diff --git a/R/deprecated_brapi.R b/R/deprecated_brapi.R index 21cbd50..540585e 100644 --- a/R/deprecated_brapi.R +++ b/R/deprecated_brapi.R @@ -128,9 +128,140 @@ # ) +## ## ---- +## #' @rdname readHaplotypeIds +## #' +## #' @param numCores Number of processing cores for faster processing times. +## #' @param transpose Do you want to transpose table? +## #' +## #' @importFrom cli cli_progress_bar +## #' @importFrom cli cli_progress_done +## #' @importFrom cli cli_progress_step +## #' @importFrom cli cli_progress_update +## #' @importFrom httr content +## #' @importFrom httr GET +## #' @importFrom jsonlite fromJSON +## #' @importFrom parallel mclapply +## #' +## #' @export +## setMethod( +## f = "readHaplotypeIds", +## signature = "BrapiConPHG", +## definition = function(object, numCores = NULL, transpose = TRUE) { +## # Logic checks +## if (is.null(numCores)) { +## numCores <- 1 +## } +## if (!is.numeric(numCores)) { +## stop("numCores parameter must be numeric or NULL") +## } +## +## # Get URLs +## urls <- getVTList(object) +## +## # Calculate total pages +## +## if (object@methodID == "DEMO") { +## totalVariants <- 1000 +## totalPages <- ceiling(totalVariants / 250) +## } else { +## methods <- availablePHGMethods(object) +## totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants +## totalPages <- ceiling(totalVariants / 10000) +## } +## +## # Download each page (iterative) +## # TODO - can we async this? (e.g. futures) +## allResp <- vector("list", totalPages) +## # cli::cli_progress_step("Establishing connection") +## message("Establishing connection") +## # cli::cli_progress_bar(" - Downloading: ", total = totalPages) +## message("Downloading:") +## pb <- utils::txtProgressBar( +## style = 3, +## char = "=", +## min = 1, +## max = totalPages +## ) +## for (i in seq_len(totalPages)) { +## currentUrl <- sprintf(urls$tableURL, i - 1, 0) +## allResp[[i]] <- httr::GET(currentUrl) +## utils::setTxtProgressBar(pb, i) +## # cli::cli_progress_update() +## } +## close(pb) +## # cli::cli_progress_done() +## +## # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) +## brapiHapIdStringToInt <- function(x) { +## id <- strsplit(x, "/")[[1]][1] +## ifelse(id == ".", return(NA), return(as.integer(id))) +## } +## +## # F2 - process matrix slices (convert from JSON to int matrix) +## processMatrix <- function(x) { +## xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") +## xNew <- jsonlite::fromJSON(xNew) +## xMat <- xNew$result$dataMatrices$dataMatrix[[1]] +## colnames(xMat) <- xNew$result$callSetDbIds +## rownames(xMat) <- xNew$result$variants +## xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) +## return(xMat) +## } +## +## # Clean up data (parallel) +## # cli::cli_progress_step("Cleaning data") +## message("Cleaning data") +## finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) +## +## # Bind all data into one matrix and return +## # cli::cli_progress_step("Combining responses") +## message("Combining responses") +## if (transpose) { +## unionMatrix <- t(do.call(rbind, finalMatrices)) +## } else { +## unionMatrix <- do.call(rbind, finalMatrices) +## } +## +## return(unionMatrix) +## } +## ) - - +## +## +## ## ---- +## #' @rdname readPHGDataSet +## #' +## #' @export +## setMethod( +## f = "readPHGDataSet", +## signature = "BrapiConPHG", +## definition = function(object, ...) { +## +## urls <- getVTList(object) +## +## hapArray <- readTable(object, transpose = FALSE) +## +## # cli::cli_progress_step("Getting ref range data") +## message("Getting ref range data") +## rr <- readRefRanges(object) +## # cli::cli_progress_step("Getting sample data") +## message("Getting sample data") +## samples <- readSamples(object) +## +## colnames(hapArray) <- samples$sampleName +## +## phgSE <- SummarizedExperiment::SummarizedExperiment( +## assays = list(hapID = hapArray), +## rowRanges = rr, +## colData = samples +## ) +## +## return(methods::new(Class = "PHGDataSet", phgSE)) +## } +## ) +## +## diff --git a/R/method_table.R b/R/method_table.R index fda588b..2df2e6a 100644 --- a/R/method_table.R +++ b/R/method_table.R @@ -7,7 +7,7 @@ methodTableFromLocal <- function(configFile, showAdvancedMethods) { # Get TableReport object from TASSEL jar and convert to data.frame plugin <- rJava::new( - rJava::J(TASSEL_API$METHOD_TABLE_REPORT_PLUGIN) + rJava::J(TASSEL_API$METHOD_TABLE_REPORT) ) plugin <- plugin$configFile(configFile) ds <- plugin$performFunction( diff --git a/R/path_matrix.R b/R/path_matrix.R deleted file mode 100644 index ef275da..0000000 --- a/R/path_matrix.R +++ /dev/null @@ -1,133 +0,0 @@ -## ---- -#' @title Generate a matrix for all the paths for \code{pathMethod} -#' -#' @description Returns a \code{matrix} object of haplotype ids with taxa name -#' for row names and reference range id for the column name. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' @param pathMethod The name of the path method in the PHG DB -#' -#' @importFrom rJava J -#' -#' @export -pathsForMethod <- function(configFile, pathMethod) { - - configCatcher(configFile) - - # Retrieve Java matrix object - pathObj <- rJava::J( - "net.maizegenetics.pangenome.api/RMethods", - "pathsForMethod", - configFile, - pathMethod - ) - - # Configure for R - pathMat <- pathObj$matrix - rownames(pathMat) <- pathObj$rowNames - colnames(pathMat) <- pathObj$columnNames - - # Return - return(pathMat) -} - - -## ---- -#' @title Retrieve read mapping information from PHG database. -#' -#' @description Returns an \code{S4Vectors} \code{DataFrame} object of read -#' mapping information for a given line (i.e. taxon). -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' @param lineName The name of the line (taxon) for which the read mapping -#' information is to be retrieved. If there are multiple read mappings with -#' different \code{file_group_names}, they will be combined. -#' @param readMappingMethodName The method name for the read mappings -#' (only takes a single method). -#' @param haplotypeMethodName The haplotype method name. -#' @param fileGroup the name of the file group for the line from the database. -#' This parameter is only necessary if the line (taxon) has more than one -#' file group and only the reads for a specific file group are wanted. -#' -#' @importFrom rJava J -#' @importFrom S4Vectors DataFrame -#' -#' @export -readMappingsForLineName <- function(configFile, - lineName, - readMappingMethodName, - haplotypeMethodName, - fileGroup = NULL) { - - configCatcher(configFile) - - # Retrieve Java data vector object(s) - rmObj <- rJava::J( - "net.maizegenetics.pangenome.api/RMethods", - "readMappingsForLineName", - configFile, - lineName, - readMappingMethodName, - haplotypeMethodName, - fileGroup - ) - - # Configure for R - colNum <- rmObj$dataVectors$size() - rmDF <- lapply(seq_len(colNum), function(i) { - rmObj$dataVectors$get(as.integer(i - 1)) - }) - rmDF <- data.frame(rmDF) - colnames(rmDF) <- rmObj$columnNames - - # Return - return(S4Vectors::DataFrame(rmDF)) -} - - -## ---- -#' @title Retrieve read mapping records from PHG database. -#' -#' @description Returns an \code{S4Vectors} \code{DataFrame} object of read -#' mapping record information without \code{read_mapping} data. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' -#' @importFrom rJava J -#' @importFrom S4Vectors DataFrame -#' -#' @export -readMappingTableInfo <- function(configFile) { - - # Catch potential errors - configCatcher(configFile) - - # Retrieve Java data vector object(s) - rmObj <- rJava::J( - "net.maizegenetics.pangenome.api/RMethods", - "readMappingTableInfo", - configFile - ) - - # Configure for R - colNum <- rmObj$dataVectors$size() - rmDF <- lapply(seq_len(colNum), function(i) { - rmObj$dataVectors$get(as.integer(i - 1)) - }) - rmDF <- data.frame(rmDF) - colnames(rmDF) <- rmObj$columnNames - - # Return - return(S4Vectors::DataFrame(rmDF)) -} - - diff --git a/R/ref_range_table.R b/R/ref_range_table.R deleted file mode 100644 index 460b797..0000000 --- a/R/ref_range_table.R +++ /dev/null @@ -1,35 +0,0 @@ -#' @title Generate a reference range table -#' -#' @description Generates a reference range table from a PHG object. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param phgObject A PHG object. -#' -#' @importFrom rJava is.jnull -#' @importFrom rJava J -#' @importFrom tibble tibble -#' -#' @export -refRangeTable <- function(phgObject) { - - ## Get reference range object from PHG object - refRangeObj <- rJava::J( - "net.maizegenetics.pangenome.api/RMethods", - "referenceRanges", - phgObject - ) - - ## Get data vectors and convert to tibble - refranges <- data.frame( - lapply(X = seq_along(refRangeObj$columnNames) - 1, function(i) { - refRangeObj$dataVectors$get(as.integer(i)) - }) - ) - names(refranges) <- refRangeObj$columnNames - refranges <- tibble::as_tibble(refranges) - - ## Return the tibble refrange object - return(refranges) -} diff --git a/R/stats_and_visualization.R b/R/stats_and_visualization.R index 3c0b3a5..6dcc95c 100644 --- a/R/stats_and_visualization.R +++ b/R/stats_and_visualization.R @@ -498,3 +498,97 @@ plotGraph <- function( } +## ---- +#' @title Retrieve read mapping information from PHG database. +#' +#' @description Returns an \code{S4Vectors} \code{DataFrame} object of read +#' mapping information for a given line (i.e. taxon). +#' +#' @author Brandon Monier +#' @author Peter Bradbury +#' +#' @param configFile Path to a configuration file for your graph database. +#' @param lineName The name of the line (taxon) for which the read mapping +#' information is to be retrieved. If there are multiple read mappings with +#' different \code{file_group_names}, they will be combined. +#' @param readMappingMethodName The method name for the read mappings +#' (only takes a single method). +#' @param haplotypeMethodName The haplotype method name. +#' @param fileGroup the name of the file group for the line from the database. +#' This parameter is only necessary if the line (taxon) has more than one +#' file group and only the reads for a specific file group are wanted. +#' +#' @importFrom rJava J +#' @importFrom S4Vectors DataFrame +#' +#' @export +readMappingsForLineName <- function(configFile, + lineName, + readMappingMethodName, + haplotypeMethodName, + fileGroup = NULL) { + + configCatcher(configFile) + + # Retrieve Java data vector object(s) + rmObj <- rJava::J( + "net.maizegenetics.pangenome.api/RMethods", + "readMappingsForLineName", + configFile, + lineName, + readMappingMethodName, + haplotypeMethodName, + fileGroup + ) + + # Configure for R + colNum <- rmObj$dataVectors$size() + rmDF <- lapply(seq_len(colNum), function(i) { + rmObj$dataVectors$get(as.integer(i - 1)) + }) + rmDF <- data.frame(rmDF) + colnames(rmDF) <- rmObj$columnNames + + # Return + return(S4Vectors::DataFrame(rmDF)) +} + + +## ---- +#' @title Retrieve read mapping records from PHG database. +#' +#' @description Returns an \code{S4Vectors} \code{DataFrame} object of read +#' mapping record information without \code{read_mapping} data. +#' +#' @author Brandon Monier +#' @author Peter Bradbury +#' +#' @param configFile Path to a configuration file for your graph database. +#' +#' @importFrom rJava J +#' @importFrom S4Vectors DataFrame +#' +#' @export +readMappingTableInfo <- function(configFile) { + + # Catch potential errors + configCatcher(configFile) + + # Retrieve Java data vector object(s) + rmObj <- rJava::J( + "net.maizegenetics.pangenome.api/RMethods", + "readMappingTableInfo", + configFile + ) + + # Configure for R + colNum <- rmObj$dataVectors$size() + rmDF <- lapply(seq_len(colNum), function(i) { + rmObj$dataVectors$get(as.integer(i - 1)) + }) + rmDF <- data.frame(rmDF) + colnames(rmDF) <- rmObj$columnNames + + # Return + return(S4Vectors::DataFrame(rmDF)) +} \ No newline at end of file diff --git a/man/pathsForMethod.Rd b/man/pathsForMethod.Rd deleted file mode 100644 index 23cb8f2..0000000 --- a/man/pathsForMethod.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/path_matrix.R -\name{pathsForMethod} -\alias{pathsForMethod} -\title{Generate a matrix for all the paths for \code{pathMethod}} -\usage{ -pathsForMethod(configFile, pathMethod) -} -\arguments{ -\item{configFile}{Path to a configuration file for your graph database.} - -\item{pathMethod}{The name of the path method in the PHG DB} -} -\description{ -Returns a \code{matrix} object of haplotype ids with taxa name - for row names and reference range id for the column name. -} -\author{ -Brandon Monier - -Peter Bradbury -} diff --git a/man/readHaplotypeIds.Rd b/man/readHaplotypeIds.Rd index cca6e3a..f900106 100644 --- a/man/readHaplotypeIds.Rd +++ b/man/readHaplotypeIds.Rd @@ -1,10 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R \name{readHaplotypeIds} \alias{readHaplotypeIds} +\alias{readHaplotypeIds,PHGMethod-method} \title{Return haplotype IDs} \usage{ readHaplotypeIds(object, ...) + +\S4method{readHaplotypeIds}{PHGMethod}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/readMappingTableInfo.Rd b/man/readMappingTableInfo.Rd index 8d5e7ea..2bb3f23 100644 --- a/man/readMappingTableInfo.Rd +++ b/man/readMappingTableInfo.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/path_matrix.R +% Please edit documentation in R/stats_and_visualization.R \name{readMappingTableInfo} \alias{readMappingTableInfo} \title{Retrieve read mapping records from PHG database.} diff --git a/man/readMappingsForLineName.Rd b/man/readMappingsForLineName.Rd index 1e6a828..41e8aca 100644 --- a/man/readMappingsForLineName.Rd +++ b/man/readMappingsForLineName.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/path_matrix.R +% Please edit documentation in R/stats_and_visualization.R \name{readMappingsForLineName} \alias{readMappingsForLineName} \title{Retrieve read mapping information from PHG database.} diff --git a/man/readPHGDataSet.Rd b/man/readPHGDataSet.Rd index 131deb6..7ed4456 100644 --- a/man/readPHGDataSet.Rd +++ b/man/readPHGDataSet.Rd @@ -1,14 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R \name{readPHGDataSet} \alias{readPHGDataSet} +\alias{readPHGDataSet,PHGMethod-method} \title{Return a PHGDataSet} \usage{ -readPHGDataSet(object, ...) +readPHGDataSet(object, verbose = FALSE, ...) + +\S4method{readPHGDataSet}{PHGMethod}(object, verbose = TRUE) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} +\item{verbose}{should retrieval information be printed? Defaults to +\code{FALSE}} + \item{...}{Additional arguments, for use in specific methods} } \description{ diff --git a/man/readSamples.Rd b/man/readSamples.Rd index eb9acd6..2c80298 100644 --- a/man/readSamples.Rd +++ b/man/readSamples.Rd @@ -1,10 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R \name{readSamples} \alias{readSamples} +\alias{readSamples,PHGMethod-method} \title{Return samples IDs} \usage{ readSamples(object, ...) + +\S4method{readSamples}{PHGMethod}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/refRangeTable.Rd b/man/refRangeTable.Rd deleted file mode 100644 index 820e728..0000000 --- a/man/refRangeTable.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ref_range_table.R -\name{refRangeTable} -\alias{refRangeTable} -\title{Generate a reference range table} -\usage{ -refRangeTable(phgObject) -} -\arguments{ -\item{phgObject}{A PHG object.} -} -\description{ -Generates a reference range table from a PHG object. -} -\author{ -Brandon Monier - -Peter Bradbury -} From 2d980a0706a271a14a1a2789f1b4afa77a490b24 Mon Sep 17 00:00:00 2001 From: Brandon Date: Sun, 27 Aug 2023 16:08:35 -0400 Subject: [PATCH 22/35] Initial commit --- R/class_phg_graph.R | 331 ++++++++++++++ R/deprecated_stats_and_visualization.R | 594 +++++++++++++++++++++++++ R/stats_mutual_info.R | 25 ++ R/stats_num_haplotypes.R | 30 ++ R/utilities_stats.R | 42 ++ man/PHGraph-class.Rd | 39 ++ man/PHGraph-validity.Rd | 11 + man/buildPHGraph.Rd | 33 ++ man/javaMemoryAddress.Rd | 19 + man/javaRefObj.Rd | 19 + man/numHaploPerRefRange.Rd | 21 + man/numberOfChromosomes.Rd | 19 + man/numberOfNodes.Rd | 19 + man/numberOfRefRanges.Rd | 19 + man/numberOfTaxa.Rd | 19 + man/phgMethodType.Rd | 19 + 16 files changed, 1259 insertions(+) create mode 100644 R/class_phg_graph.R create mode 100644 R/deprecated_stats_and_visualization.R create mode 100644 R/stats_mutual_info.R create mode 100644 R/stats_num_haplotypes.R create mode 100644 R/utilities_stats.R create mode 100644 man/PHGraph-class.Rd create mode 100644 man/PHGraph-validity.Rd create mode 100644 man/buildPHGraph.Rd create mode 100644 man/javaMemoryAddress.Rd create mode 100644 man/javaRefObj.Rd create mode 100644 man/numHaploPerRefRange.Rd create mode 100644 man/numberOfChromosomes.Rd create mode 100644 man/numberOfNodes.Rd create mode 100644 man/numberOfRefRanges.Rd create mode 100644 man/numberOfTaxa.Rd create mode 100644 man/phgMethodType.Rd diff --git a/R/class_phg_graph.R b/R/class_phg_graph.R new file mode 100644 index 0000000..7dcef1c --- /dev/null +++ b/R/class_phg_graph.R @@ -0,0 +1,331 @@ +## ---- +#' @title A PHGraph Class +#' +#' @description +#' Class \code{PHGraph} defines a \code{rPHG} Class for storing +#' a \code{HaplotypeGraph} object defined in the PHG API +#' +#' @slot methodID A \code{\linkS4class{PHGMethod}} object +#' @slot nChrom Number of chromosomes +#' @slot nNodes Number of nodes +#' @slot nRefRanges Number of reference ranges +#' @slot nTaxa Number of taxa +#' @slot jHapGraph An \code{rJava} \code{jobjRef} object representing a +#' \code{HaplotypeGraph} class in the PHG API +#' @slot jMemAddress An identifier string to the JVM memory space +#' +#' @name PHGraph-class +#' @rdname PHGraph-class +#' @exportClass PHGraph +setClass( + Class = "PHGraph", + slots = c( + methodID = "character", + methodType = "character", + nChrom = "integer", + nNodes = "integer", + nRefRanges = "integer", + nTaxa = "integer", + jHapGraph = "jobjRef", + jMemAddress = "character" + ), + prototype = list( + methodID = NA_character_, + methodType = NA_character_, + nChrom = NA_integer_, + nNodes = NA_integer_, + nRefRanges = NA_integer_, + nTaxa = NA_integer_, + jHapGraph = rJava::.jnull(), + jMemAddress = NA_character_ + ) +) + + +## ---- +#' @title PHGraph validation +#' +#' @name PHGraph-validity +#' +#' @description Checks if \code{PHGraph} class objects are valid. +#' +#' @param object A \code{PHGraph} object. +#' +#' @importFrom curl has_internet +setValidity("PHGraph", function(object) { + errors <- character() + + jObjRef <- javaRefObj(object) + + if (!any(names(jObjRef) == "getClass()")) { + msg <- "Could not find `getClass()` getter from reference object" + errors <- c(errors, msg) + } + + jObjRefClass <- jObjRef$getClass()$getName() + if (jObjRefClass != "net.maizegenetics.pangenome.api.HaplotypeGraph") { + msg <- "Reference object is not of type `HaplotypeGraph`" + errors <- c(errors, msg) + } + + if (length(errors) == 0) TRUE else errors +}) + + +## ---- +#' @title Helper function to build PHGraph object +#' +#' @description +#' Creates a \code{\linkS4class{PHGraph}} object to be used to build and store +#' an \code{rJava} reference object pointing to a \code{HaplotypeGraph} object +#' from the PHG API. +#' +#' @param phgMethodObj A \code{\linkS4class{PHGMethod}} object. +#' @param chrom A vector of chromosomes to include in graph. If NULL, defaults +#' to all. To specify multiple chromosome, pass as a vector of strings (i.e. +#' \code{c("1", "2", "3")}). Is currently only used for haplotypes. +#' @param includeSequence Whether to include sequences in haplotype nodes. +#' Is currently only used for haplotypes. NOTE: this will greatly increase +#' memory consumption! +#' @param includeVariants Whether to include variant contexts in haplotype +#' nodes. Is currently only used for haplotypes. NOTE: this will greatly +#' increase memory consumption! +#' +#' @export +buildPHGraph <- function( + phgMethodObj, + chrom = NULL, + includeSequence = FALSE, + includeVariants = FALSE +) { + conMethod <- phgMethodId(phgMethodObj) + conObj <- phgConObj(phgMethodObj) + conType <- phgType(conObj) + + if (conType != "local") { + stop( + "Graphs can only be built using local PHG connection (`PHGLocalCon`) objects", + call. = FALSE + ) + } + + methMeta <- showPHGMethods(conObj, showAdvancedMethods = TRUE) + methodType <- methMeta[methMeta$method_name == conMethod, ]$type_name + + # NOTE - unresolved issues with ifelse, using conventional if/else instead + if (methodType == "PATHS") { + phgObj <- graphFromPaths( + configFilePath(conObj), + conMethod + ) + } else { + phgObj <- graphFromHaplotypes( + configFilePath(conObj), + conMethod, + chrom, + includeSequence, + includeVariants + ) + } + + pointer <- gsub(".*@", "", rJava::.jstrVal(phgObj)) + + methods::new( + Class = "PHGraph", + methodID = conMethod, + methodType = methodType, + nChrom = phgObj$numberOfChromosomes(), + nNodes = phgObj$numberOfNodes(), + nRefRanges = phgObj$numberOfRanges(), + nTaxa = phgObj$totalNumberTaxa(), + jHapGraph = phgObj, + jMemAddress = pointer + ) +} + + + +# /// Methods (show) //////////////////////////////////////////////// + +## ---- +#' @title Show methods for PHGraph objects +#' +#' @description +#' Prints out information regarding properties from the \code{PHGraph} +#' class to the console +#' +#' @param object A \code{\linkS4class{PHGraph}} object +#' +#' @docType methods +#' @rdname PHGraph-class +#' @aliases show,PHGraph-method +setMethod( + f = "show", + signature = "PHGraph", + definition = function(object) { + pointerSymbol <- cli::col_green(cli::symbol$pointer) + + msg <- c( + paste0( + "A ", cli::style_bold("PHGraph"), " object @ ", + cli::style_bold(cli::col_blue(javaMemoryAddress(object))) + ), + paste0(" ", pointerSymbol, " Method.............: ", cli::style_bold(phgMethodId(object))), + paste0(" ", pointerSymbol, " # of nodes.........: ", numberOfNodes(object)), + paste0(" ", pointerSymbol, " # of ref ranges....: ", numberOfRefRanges(object)), + paste0(" ", pointerSymbol, " # of taxa..........: ", numberOfTaxa(object)), + paste0(" ", pointerSymbol, " # of chromosomes...: ", numberOfChromosomes(object)) + ) + + cat(msg, sep = "\n") + } +) + + + +# /// Methods (general) ///////////////////////////////////////////// + +## ---- +#' @rdname javaMemoryAddress +#' @export +setMethod( + f = "javaMemoryAddress", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(object@jMemAddress) + } +) + + +## ---- +#' @rdname javaRefObj +#' @export +setMethod( + f = "javaRefObj", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(object@jHapGraph) + } +) + + +## ---- +#' @rdname numberOfChromosomes +#' @export +setMethod( + f = "numberOfChromosomes", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(object@nChrom) + } +) + + +## ---- +#' @rdname numberOfNodes +#' @export +setMethod( + f = "numberOfNodes", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(object@nNodes) + } +) + + +## ---- +#' @rdname numberOfRefRanges +#' @export +setMethod( + f = "numberOfRefRanges", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(object@nRefRanges) + } +) + + +## ---- +#' @rdname numberOfTaxa +#' @export +setMethod( + f = "numberOfTaxa", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(object@nTaxa) + } +) + + +## ---- +#' @rdname phgMethodId +#' @export +setMethod( + f = "phgMethodId", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(object@methodID) + } +) + + +## ---- +#' @rdname phgMethodType +#' @export +setMethod( + f = "phgMethodType", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(object@methodType) + } +) + + +## ---- +#' @rdname readHaplotypeIds +#' @export +setMethod( + f = "readHaplotypeIds", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(hapIdsFromGraphObj(javaRefObj(object))) + } +) + + +## ---- +#' @rdname readPHGDataSet +#' @export +setMethod( + f = "readPHGDataSet", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(phgDataSetFromGraphObj(javaRefObj(object), verbose = TRUE)) + } +) + + +## ---- +#' @rdname readRefRanges +#' @export +setMethod( + f = "readRefRanges", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(refRangesFromGraphObj(javaRefObj(object))) + } +) + + +## ---- +#' @rdname readSamples +#' @export +setMethod( + f = "readSamples", + signature = signature(object = "PHGraph"), + definition = function(object) { + return(samplesFromGraphObj(javaRefObj(object))) + } +) + + diff --git a/R/deprecated_stats_and_visualization.R b/R/deprecated_stats_and_visualization.R new file mode 100644 index 0000000..488aebf --- /dev/null +++ b/R/deprecated_stats_and_visualization.R @@ -0,0 +1,594 @@ +## # === rPHG Stats Visualization Functions (WIP) ====================== +## +## #' @title Get the number of haplotypes per range in physical position segment +## #' +## #' @author Jean-Luc Jannink +## #' +## #' @param phgObject A PHG object. +## #' @param chr What chromosome do you want to inspect? Defaults to \code{NULL}. +## #' If \code{NULL}, all chromsomes will be selected. +## #' @param start Start position of chromosome. Defaults to \code{0}. +## #' @param end End position of chromosome. Defaults to \code{NULL}. If +## #' \code{NULL}, the whole chromosome will be analyzed. +## #' +## #' @importFrom S4Vectors DataFrame +## #' @importFrom SummarizedExperiment as.data.frame +## #' @importFrom SummarizedExperiment assays +## #' @importFrom SummarizedExperiment ranges +## #' @importFrom SummarizedExperiment rowRanges +## #' @importFrom SummarizedExperiment seqnames +## #' +## #' @export +## numHaploPerRange <- function(phgObject, +## chr = NULL, +## start = 0, +## end = NULL) { +## +## # Get information about the reference ranges +## rr <- SummarizedExperiment::rowRanges(phgObject) +## +## # Logic +## if (is.null(end)) { +## end <- max(end(rr)) +## } +## +## allChr <- unique(SummarizedExperiment::seqnames(phgObject)) +## allChr <- as.vector(allChr) +## if (is.null(chr)) { +## chr <- allChr +## } else{ +## if (!all(chr %in% allChr)) { +## warning(paste(c("The following chromosomes are not found:", setdiff(chr, allChr)), collapse=" ")) +## } +## } +## +## # Which reference ranges on the chromosome within start and end positions +## tmp <- as.vector(SummarizedExperiment::seqnames(phgObject)) +## keepRanges <- which(tmp %in% chr & start <= start(rr) & end(rr) <= end) +## +## if (length(keepRanges) == 0) { +## stop("There are no ranges with requested start and end") +## } +## +## # How many haplotypes are in those reference ranges +## phgHapIDMat <- t(SummarizedExperiment::assays(phgObject)$hapID) +## +## if (dim(phgObject)[2] == 1) { +## phgFilt <- phgHapIDMat[, keepRanges] +## phgFilt <- t(as.matrix(phgFilt)) +## } else { +## phgFilt <- phgHapIDMat[, keepRanges] +## } +## nHaplo <- apply(phgFilt, 2, function(vec) { +## length(unique(vec)) +## }) +## +## # Return the numerical information +## rr <- SummarizedExperiment::as.data.frame(rr) +## rr <- cbind(rr[keepRanges,], numHaplotypes = nHaplo) +## rr <- rr[, c(6, 1, 2, 3, 4, 7)] +## return(S4Vectors::DataFrame(rr)) +## } + + + +## #' @title Plot the number of haplotypes +## #' +## #' @description This function will plot the number of haplotypes. Its input +## #' will be the output of the \code{numHaploPerRange()} function. +## #' +## #' @param haploData The output of \code{numHaploPerRange()} +## #' +## #' @import ggplot2 +## #' @importFrom rlang .data +## #' @importFrom stats median +## #' +## #' @export +## plotNumHaplo <- function(haploData) { +## # Coerce to data frame for ggplot2 +## tmp <- as.data.frame(haploData) +## +## # Shape proportions +## yfrac <- 0.1 +## xfrac <- 0.001 +## +## # Add shape data +## tmp$med <- apply(tmp[, 3:4], 1, stats::median) +## tmp$color <- "#91baff" +## tmp[seq(1, nrow(tmp), by = 2),]$color <- "#3e619b" +## +## # Get limit data +## xbeg <- min(tmp$start) +## xend <- max(tmp$end) +## yend <- max(tmp$numHaplotypes) +## +## # Visualize +## hapPlot <- ggplot(data = tmp) + +## ylim(-(yend * yfrac), yend) + +## scale_x_continuous(limits = c(xbeg, xend)) + +## geom_rect( +## mapping = aes( +## xmin = .data$start, +## xmax = .data$end, +## ymin = 0, +## ymax = -(yend * yfrac) +## ), +## fill = tmp$color +## ) + +## geom_path(aes(x = .data$med, y = .data$numHaplotypes)) + +## geom_point(aes(x = .data$med, y = .data$numHaplotypes), size = 1) + +## facet_grid(seqnames ~ .) + +## xlab("Physical Position (bp)") + +## ylab("Number of Haplotypes") +## +## return(hapPlot) +## } + + + +## #' @title Calculate the mutual information between a set of reference ranges +## #' +## #' @description Mutual information quantifies the "amount of information" +## #' obtained about one random variable through observing the other random +## #' variable. Specify the gamete names over which you want to calculate and +## #' reference ranges. +## #' +## #' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. +## #' @param phgObject A PHG object. +## #' @param gameteNames Specified gamete names. If \code{NULL}, gamete names will +## #' default to taxa IDs (haplottype ID matrix row names). +## #' @param refRanges What reference ranges you wan to specify? +## #' +## #' @importFrom S4Vectors metadata +## #' @importFrom stats model.matrix +## calcMutualInfo <- function(phgObject = NULL, +## refRanges, +## gameteNames = NULL, +## phgHapIDMat = NULL) { +## if (is.null(phgHapIDMat)) { +## if (is.null(phgObject)) { +## stop("Must supply phgHapIDMat or phgObject") +## } +## phgHapIDMat <- hapIDMatrix(phgObject = S4Vectors::metadata(phgObject)$jObj) +## } +## +## if (is.null(gameteNames)) { +## gameteNames <- rownames(phgHapIDMat) +## } +## +## phgHapIDMat <- phgHapIDMat[gameteNames, refRanges, drop = FALSE] +## # you can't do this with single gametes or ranges +## if (any(dim(phgHapIDMat) < 2)) { +## return(NULL) +## } +## +## # Calculate the mutual information across a pair of ranges +## # I(X;Y) = Sum p(x, y)log{p(x, y) / [p(x)p(y)]} +## mutualInfoPair <- function(phgHapIDMat, twoRanges) { +## hapID <- phgHapIDMat[, twoRanges] +## +## # Remove any rows that have missing data +## hapID <- hapID[!apply(hapID, 1, function(v) any(v == -1)), ] +## +## # Check if any columns have only one haplotype +## test1haplo <- apply(hapID, 2, function(v) length(unique(v)) == 1) +## if (any(test1haplo)) { +## return(0) +## } +## hapID <- apply(hapID, 2, as.character) +## nHap1 <- length(unique(hapID[, 1])) +## nHap2 <- length(unique(hapID[, 2])) +## mm1 <- model.matrix( ~ -1 + hapID[, 1]) %>% colMeans +## mm2 <- model.matrix( ~ -1 + hapID[, 2]) %>% colMeans +## mmm <- tcrossprod(mm1, mm2) +## mmi <- model.matrix( ~ -1 + hapID[, 1]:hapID[, 2]) %>% colMeans %>% matrix(nHap1, nHap2) +## mi <- mmi * log2(mmi / mmm) # Some of these will be NaN, removed by na.rm=T +## return(sum(mi, na.rm = T)) +## } +## # Calculate the mutual information across all pairs of ranges +## nRanges <- length(refRanges) +## miMat <- matrix(NA, nrow = nRanges, ncol = nRanges) +## rownames(miMat) <- colnames(miMat) <- refRanges +## for (range1 in 1:(nRanges - 1)) { +## for (range2 in (range1 + 1):nRanges) { +## miMat[range1, range2] <- +## mutualInfoPair(phgHapIDMat, c(refRanges[range1], refRanges[range2])) +## } +## } +## return(miMat) +## } + + + +## #' @title Calculate and plot mutual information between a set of reference ranges +## #' +## #' @description Mutual information quantifies the “amount of information” +## #' obtained about one random variable through observing the other random +## #' variable. +## #' +## #' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. +## #' @param phgObject A PHG object. +## #' @param gameteNames Specified gamete names. If \code{NULL}, gamete names will +## #' default to taxa IDs (haplottype ID matrix row names). +## #' @param refRanges What reference ranges you wan to specify? +## #' +## #' @importFrom corrplot corrplot +## #' +## #' @export +## plotMutualInfo <- function(phgObject = NULL, +## refRanges, +## gameteNames = NULL, +## phgHapIDMat = NULL) { +## mi <- calcMutualInfo( +## phgObject = phgObject, +## refRanges = refRanges, +## gameteNames = NULL, +## phgHapIDMat +## ) +## mi[is.na(mi)] <- 0 +## corrplot::corrplot(mi, type = "upper", is.corr = F) +## # return(mi) +## } + + + +## Function to say if haplotypes same, discarding comparisons with -1 +# gamHapIDs and targetHapIDs are both vectors of haplotype IDs. +# The output is the fraction of hapIDs that are different +# With ranges that contain -1 not included in the fraction +calcDiff <- function(gamHapIDs, targetHapIDs) { + keep <- which(gamHapIDs != -1 & targetHapIDs != -1) + if (length(keep) == 0) { + return(Inf) + } + return(sum(gamHapIDs[keep] != targetHapIDs[keep]) / length(keep)) +} + + + +#' @title Search for similar gamets +#' +#' @description Search for inbred lines (gametes) that are similar to a +#' specified gamete in specified reference ranges. Supply either a haplotype +#' ID matrix or a phgObject from which to extract it. Specify a gamete name +#' and reference ranges. The difference between haplotypes is either 0 (same) +#' or 1 (different). Fraction of ranges that are different has to be lower or +#' equal to fractionDiff. Ranges with unknown haplotypes (-1) do not count in +#' the fraction. If all pairwise range comparisons have -1 the lines are +#' considered dissimilar. +#' +#' @param gameteName A specified gamete name +#' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. If +#' \code{NULL}, A hap ID matrix will be generated (if you have supplied a +#' PHG object). +#' @param phgObject A PHG object. +#' @param refRanges Specifed reference ranges. +#' @param fractionDiff The difference between haplotypes (either 0 or 1). See +#' description for further details. +#' +#' @importFrom magrittr %>% +#' @importFrom S4Vectors metadata +#' +#' @export +searchSimilarGametes <- function(phgObject = NULL, + refRanges, + gameteName, + fractionDiff = 0, + phgHapIDMat = NULL) { + if (is.null(phgHapIDMat)) { + if (is.null(phgObject)) { + stop("Must supply phgHapIDMat or phgObject") + } + phgHapIDMat <- hapIDMatrix(phgObject = S4Vectors::metadata(phgObject)$jObj) + } + + # The row the target gamete is in + gameteRow <- which(rownames(phgHapIDMat) == gameteName) + if (length(gameteRow) == 0) { + stop(paste0("Gamete ", gameteName, " not in the PHG")) + } + + # Only deal with specified reference ranges + phgHapIDMat <- phgHapIDMat[, refRanges, drop = FALSE] + targetHapIDs <- phgHapIDMat[gameteRow, , drop = FALSE] + + # Calculate differences across all gametes in the table + fracDiffs <- apply(phgHapIDMat, 1, calcDiff, targetHapIDs = targetHapIDs) + areSimilar <- which(fracDiffs <= fractionDiff) %>% setdiff(gameteRow) + + # Return names of gametes that are similar to the target + return(rownames(phgHapIDMat)[areSimilar]) +} + + + +#' @title Search for recombination +#' +#' @description Search for inbred lines (gametes) that are the same in one +#' range but different in another. Such lines have experienced recombination +#' in the past relative to each other. Must specify a gamete name and +#' reference ranges. +#' +#' @param gameteName A specified gamete name +#' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. If +#' \code{NULL}, A hap ID matrix will be generated (if you have supplied a +#' PHG object). +#' @param phgObject A PHG object. +#' @param refRangeSame See description for further details. +#' @param refRangeDiff See description for further details. +#' +#' @importFrom magrittr %>% +#' @importFrom S4Vectors metadata +#' +#' @export +searchRecombination <- function(phgObject = NULL, + gameteName, + refRangeSame, + refRangeDiff, + phgHapIDMat = NULL) { + if (is.null(phgHapIDMat)) { + if (is.null(phgObject)) { + stop("Must supply phgHapIDMat or phgObject") + } + phgHapIDMat <- hapIDMatrix(phgObject = phgObject) + } + + gametesSame <- searchSimilarGametes( + gameteName, + phgHapIDMat, + refRanges = refRangeSame + ) %>% + setdiff(gameteName) + + targetDiff <- phgHapIDMat[gameteName, refRangeDiff] + + gametesDiff <- sapply( + phgHapIDMat[gametesSame, refRangeDiff], + calcDiff, + targetHapIDs = targetDiff + ) + + return(gametesSame[gametesDiff == 1]) +} + + +# ---- +#' @title Visualize Graph Data +#' +#' @description +#' Generates an interactive network plot for a given set of reference ranges +#' and a set of taxa. +#' +#' @param x A \code{PHGDataSet} object +#' @param samples Samples/taxa to include in plot +#' @param sampleHighlight Sample path to highlight +#' @param seqnames A sequence (e.g. chromosome) ID +#' @param start Start position for ref ranges +#' @param end End position for ref ranges +#' @param colMajor Highlight path color +#' @param colMinor Muted path color +#' @param ... Additional parameters to pass for ref range inclusion +#' +#' @importFrom IRanges subsetByOverlaps +#' @importFrom GenomicRanges GRanges +#' @importFrom SummarizedExperiment assay +#' @importFrom visNetwork visEdges +#' @importFrom visNetwork visHierarchicalLayout +#' @importFrom visNetwork visNetwork +#' +#' @export +plotGraph <- function( + x, + samples = NULL, + sampleHighlight = NULL, + seqnames = NULL, + start = NULL, + end = NULL, + colMajor = "maroon", + colMinor = "lightgrey", + ... +) { + # # Testing + # start <- 100 + # end <- 1000000 + # seqnames <- "1" + # # samples <- c("Z001E0001", "Z001E0028", "Z001E0080") + # # samples <- NULL + # set.seed(123) + # samples <- sample(colnames(x), 100) + # # sampleHighlight <- c("Z001E0001") + # sampleHighlight <- sample(samples, 1) + + # Filter by taxa and ref ranges + if (is.null(samples)) samples <- colnames(x) + hapTableMini <- x[, colnames(x) %in% samples] + hapTableMini <- IRanges::subsetByOverlaps( + hapTableMini, + GenomicRanges::GRanges(seqnames = seqnames, ranges = start:end) + ) + + # Get hap ID matrix + currentMatrix <- t(SummarizedExperiment::assay(hapTableMini)) + currentMatrix[is.na(currentMatrix)] <- -128 + colnames(currentMatrix) <- gsub("R", "", colnames(currentMatrix)) |> + as.numeric() + + # Get ref range data frame + refRangeDataMini <- rowRanges(hapTableMini) |> as.data.frame() + + # Group taxa by hap ID and ref range + taxaGroups <- lapply(seq_len(ncol(currentMatrix)), function(i) { + split(rownames(currentMatrix), currentMatrix[, i]) + }) + + # Generate distinct IDs (hap ID + ref range ID) + hapIds <- currentMatrix |> apply(2, unique, simplify = FALSE) + hapLevels <- rep(names(hapIds), vapply(hapIds, length, integer(1))) |> as.numeric() + fullHapIds <- paste0( + lapply(hapIds, function(i) i[order(i)]) |> unlist(), + "_", hapLevels + ) + + # HTML tooltip processing + taxaToHtml <- function(x) { + vapply(x, function(i) { + paste0("Taxa: ", paste(i, collapse = ", "), "

") + }, character(1)) + } + tooltipVec <- lapply(taxaGroups, taxaToHtml) |> unlist() + + refRangeHtml <- lapply(hapLevels, function(i) { + paste0( + "

Chr: ", + refRangeDataMini[i, ]$seqnames, + "
", + "Range: ", + refRangeDataMini[i, ]$start, + " - ", + refRangeDataMini[i, ]$end, + "
" + ) + }) |> unlist() + + # Final graph data (nodes) + nodes <- data.frame( + id = seq_along(fullHapIds), + label = fullHapIds, + level = hapLevels, + title = paste0(refRangeHtml, tooltipVec) + ) + + if (!is.null(sampleHighlight)) { + for (i in sampleHighlight) { + nodes$group <- ifelse(grepl(i, nodes$title), i, NA) + nodes$color <- ifelse(grepl(i, nodes$title), colMajor, colMinor) + } + nodes$title <- gsub(i, paste0("", i, ""), nodes$title) + } else { + nodes$color <- colMajor + } + + # Final graph data (edges) + lne <- c() + rne <- c() + for (i in seq_len(ncol(currentMatrix) - 1)) { + ln <- paste0(currentMatrix[, i], "_", i) + rn <- paste0(currentMatrix[, i + 1], "_", i + 1) + + cnxn <- paste0(ln, "+", rn) |> unique() + + for (c in cnxn) { + splits <- strsplit(c, "\\+") |> unlist() + f <- which(fullHapIds == splits[1]) + t <- which(fullHapIds == splits[2]) + lne <- c(lne, f) + rne <- c(rne, t) + } + } + + edges <- data.frame( + from = lne, + to = rne + ) + + # Return vis.js object + visNetwork::visNetwork(nodes, edges) |> + visNetwork::visEdges(arrows = "to") |> + visNetwork::visHierarchicalLayout(direction = "LR") +} + + +## ---- +#' @title Retrieve read mapping information from PHG database. +#' +#' @description Returns an \code{S4Vectors} \code{DataFrame} object of read +#' mapping information for a given line (i.e. taxon). +#' +#' @author Brandon Monier +#' @author Peter Bradbury +#' +#' @param configFile Path to a configuration file for your graph database. +#' @param lineName The name of the line (taxon) for which the read mapping +#' information is to be retrieved. If there are multiple read mappings with +#' different \code{file_group_names}, they will be combined. +#' @param readMappingMethodName The method name for the read mappings +#' (only takes a single method). +#' @param haplotypeMethodName The haplotype method name. +#' @param fileGroup the name of the file group for the line from the database. +#' This parameter is only necessary if the line (taxon) has more than one +#' file group and only the reads for a specific file group are wanted. +#' +#' @importFrom rJava J +#' @importFrom S4Vectors DataFrame +#' +#' @export +readMappingsForLineName <- function(configFile, + lineName, + readMappingMethodName, + haplotypeMethodName, + fileGroup = NULL) { + + configCatcher(configFile) + + # Retrieve Java data vector object(s) + rmObj <- rJava::J( + "net.maizegenetics.pangenome.api/RMethods", + "readMappingsForLineName", + configFile, + lineName, + readMappingMethodName, + haplotypeMethodName, + fileGroup + ) + + # Configure for R + colNum <- rmObj$dataVectors$size() + rmDF <- lapply(seq_len(colNum), function(i) { + rmObj$dataVectors$get(as.integer(i - 1)) + }) + rmDF <- data.frame(rmDF) + colnames(rmDF) <- rmObj$columnNames + + # Return + return(S4Vectors::DataFrame(rmDF)) +} + + +## ---- +#' @title Retrieve read mapping records from PHG database. +#' +#' @description Returns an \code{S4Vectors} \code{DataFrame} object of read +#' mapping record information without \code{read_mapping} data. +#' +#' @author Brandon Monier +#' @author Peter Bradbury +#' +#' @param configFile Path to a configuration file for your graph database. +#' +#' @importFrom rJava J +#' @importFrom S4Vectors DataFrame +#' +#' @export +readMappingTableInfo <- function(configFile) { + + # Catch potential errors + configCatcher(configFile) + + # Retrieve Java data vector object(s) + rmObj <- rJava::J( + "net.maizegenetics.pangenome.api/RMethods", + "readMappingTableInfo", + configFile + ) + + # Configure for R + colNum <- rmObj$dataVectors$size() + rmDF <- lapply(seq_len(colNum), function(i) { + rmObj$dataVectors$get(as.integer(i - 1)) + }) + rmDF <- data.frame(rmDF) + colnames(rmDF) <- rmObj$columnNames + + # Return + return(tibble::as_tibble(rmDF)) +} diff --git a/R/stats_mutual_info.R b/R/stats_mutual_info.R new file mode 100644 index 0000000..c00ba12 --- /dev/null +++ b/R/stats_mutual_info.R @@ -0,0 +1,25 @@ +## ---- +# Calculate mutual information from a `PHGDataSet` object +# +# @param phgObj A `PHGDataSet` object +calcMutualInfoFromPHGDataSet <- function(phgObj) { + phgHapIDMat <- t(assay(phgObj)) + refRanges <- colnames(phgHapIDMat) + nRanges <- length(refRanges) + miMat <- matrix(NA, nrow = nRanges, ncol = nRanges) + rownames(miMat) <- refRanges + colnames(miMat) <- refRanges + + for (range1 in seq_len(nRanges - 1)) { + for (range2 in (range1 + 1):nRanges) { + miMat[range1, range2] <- mutualInfoPair( + phgHapIDMat, + c(refRanges[range1], refRanges[range2]) + ) + } + } + + return(miMat) +} + + diff --git a/R/stats_num_haplotypes.R b/R/stats_num_haplotypes.R new file mode 100644 index 0000000..be0d1f8 --- /dev/null +++ b/R/stats_num_haplotypes.R @@ -0,0 +1,30 @@ +## ---- +# Return number of haplotypes per ref range from a `PHGDataSet` object +# +# @param phgObj A `PHGDataSet` object +nHaploPerRefRangeFromPHGDataSet <- function(phgObj) { + + # Get number of haplotypes and store as data frame + nHap <- apply( + X = SummarizedExperiment::assay(phgObj), + MARGIN = 1, + FUN = function(x) { + length(unique(na.omit(x))) + } + ) + nHapDf <- data.frame( + rr_id = names(nHap), + n_hap_ids = nHap + ) + + # Get reference range coordinates + grDf <- as.data.frame(SummarizedExperiment::rowRanges(phgObj)) + + # Combine both data frames and drop "strand" column (not relevant) + xRet <- merge(grDf, nHapDf, by = "rr_id", sort = FALSE) + colsToDrop <- "strand" + + return(tibble::as_tibble(xRet[, !names(xRet) %in% colsToDrop])) +} + + diff --git a/R/utilities_stats.R b/R/utilities_stats.R new file mode 100644 index 0000000..ff08221 --- /dev/null +++ b/R/utilities_stats.R @@ -0,0 +1,42 @@ +## ---- +# Calculate the mutual information across a pair of ranges +# I(X;Y) = Sum p(x, y)log{p(x, y) / [p(x)p(y)]} +# +# @param phgHapIDMat A haplotype ID matrix +# @param twoRanges A vector of length 2 containg two ref range elements +mutualInfoPair <- function(phgHapIDMat, twoRanges) { + hapID <- phgHapIDMat[, twoRanges] + + # Remove any rows that have missing data + completePHGCases <- function(x) { + any(x < 1) && all(!is.na(x)) + } + hapID <- hapID[!apply(hapID, 1, completePHGCases), ] + + # Check if any columns have only one haplotype + anyUnique <- apply(hapID, 2, function(x) length(unique(x)) == 1) + if (any(anyUnique)) { + return(0) + } + + # Calculate mutual info + hapID <- apply(hapID, 2, as.character) + nHap1 <- length(unique(hapID[, 1])) + nHap2 <- length(unique(hapID[, 2])) + + mmi <- matrix( + data = colMeans(model.matrix( ~ -1 + hapID[, 1]:hapID[, 2])), + nrow = nHap1, + ncol = nHap2 + ) + + mm1 <- colMeans(model.matrix( ~ -1 + hapID[, 1])) + mm2 <- colMeans(model.matrix( ~ -1 + hapID[, 2])) + mmm <- tcrossprod(mm1, mm2) + + # Some of these will be `NaN` (removed by `na.rm = TRUE`) + mi <- mmi * log2(mmi / mmm) + return(sum(mi, na.rm = TRUE)) +} + + diff --git a/man/PHGraph-class.Rd b/man/PHGraph-class.Rd new file mode 100644 index 0000000..18e9fd5 --- /dev/null +++ b/man/PHGraph-class.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_graph.R +\docType{class} +\name{PHGraph-class} +\alias{PHGraph-class} +\alias{show,PHGraph-method} +\title{A PHGraph Class} +\usage{ +\S4method{show}{PHGraph}(object) +} +\arguments{ +\item{object}{A \code{\linkS4class{PHGraph}} object} +} +\description{ +Class \code{PHGraph} defines a \code{rPHG} Class for storing +a \code{HaplotypeGraph} object defined in the PHG API + +Prints out information regarding properties from the \code{PHGraph} +class to the console +} +\section{Slots}{ + +\describe{ +\item{\code{methodID}}{A \code{\linkS4class{PHGMethod}} object} + +\item{\code{nChrom}}{Number of chromosomes} + +\item{\code{nNodes}}{Number of nodes} + +\item{\code{nRefRanges}}{Number of reference ranges} + +\item{\code{nTaxa}}{Number of taxa} + +\item{\code{jHapGraph}}{An \code{rJava} \code{jobjRef} object representing a +\code{HaplotypeGraph} class in the PHG API} + +\item{\code{jMemAddress}}{An identifier string to the JVM memory space} +}} + diff --git a/man/PHGraph-validity.Rd b/man/PHGraph-validity.Rd new file mode 100644 index 0000000..b4eb126 --- /dev/null +++ b/man/PHGraph-validity.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_graph.R +\name{PHGraph-validity} +\alias{PHGraph-validity} +\title{PHGraph validation} +\arguments{ +\item{object}{A \code{PHGraph} object.} +} +\description{ +Checks if \code{PHGraph} class objects are valid. +} diff --git a/man/buildPHGraph.Rd b/man/buildPHGraph.Rd new file mode 100644 index 0000000..73a6111 --- /dev/null +++ b/man/buildPHGraph.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_graph.R +\name{buildPHGraph} +\alias{buildPHGraph} +\title{Helper function to build PHGraph object} +\usage{ +buildPHGraph( + phgMethodObj, + chrom = NULL, + includeSequence = FALSE, + includeVariants = FALSE +) +} +\arguments{ +\item{phgMethodObj}{A \code{\linkS4class{PHGMethod}} object.} + +\item{chrom}{A vector of chromosomes to include in graph. If NULL, defaults +to all. To specify multiple chromosome, pass as a vector of strings (i.e. +\code{c("1", "2", "3")}). Is currently only used for haplotypes.} + +\item{includeSequence}{Whether to include sequences in haplotype nodes. +Is currently only used for haplotypes. NOTE: this will greatly increase +memory consumption!} + +\item{includeVariants}{Whether to include variant contexts in haplotype +nodes. Is currently only used for haplotypes. NOTE: this will greatly +increase memory consumption!} +} +\description{ +Creates a \code{\linkS4class{PHGraph}} object to be used to build and store +an \code{rJava} reference object pointing to a \code{HaplotypeGraph} object +from the PHG API. +} diff --git a/man/javaMemoryAddress.Rd b/man/javaMemoryAddress.Rd new file mode 100644 index 0000000..a21ffc8 --- /dev/null +++ b/man/javaMemoryAddress.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +\name{javaMemoryAddress} +\alias{javaMemoryAddress} +\alias{javaMemoryAddress,PHGraph-method} +\title{Return \code{rJava} reference object} +\usage{ +javaMemoryAddress(object, ...) + +\S4method{javaMemoryAddress}{PHGraph}(object) +} +\arguments{ +\item{object}{an \code{rPHG} local or server connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the \code{rJava} memory reference for a given \code{rPHG} object +} diff --git a/man/javaRefObj.Rd b/man/javaRefObj.Rd new file mode 100644 index 0000000..0ec40f9 --- /dev/null +++ b/man/javaRefObj.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +\name{javaRefObj} +\alias{javaRefObj} +\alias{javaRefObj,PHGraph-method} +\title{Return \code{rJava} reference object} +\usage{ +javaRefObj(object, ...) + +\S4method{javaRefObj}{PHGraph}(object) +} +\arguments{ +\item{object}{an \code{rPHG} local or server connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the \code{rJava} memory reference for a given \code{rPHG} object +} diff --git a/man/numHaploPerRefRange.Rd b/man/numHaploPerRefRange.Rd new file mode 100644 index 0000000..0057726 --- /dev/null +++ b/man/numHaploPerRefRange.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_dataset.R +\name{numHaploPerRefRange} +\alias{numHaploPerRefRange} +\alias{numHaploPerRefRange,PHGDataSet-method} +\title{Return number of haplotypes per reference range} +\usage{ +numHaploPerRefRange(object, ...) + +\S4method{numHaploPerRefRange}{PHGDataSet}(object) +} +\arguments{ +\item{object}{an \code{rPHG} dataset containing haplotype and reference +range information} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the number of unique haplotype IDs per reference range in an rPHG +dataset +} diff --git a/man/numberOfChromosomes.Rd b/man/numberOfChromosomes.Rd new file mode 100644 index 0000000..9e37791 --- /dev/null +++ b/man/numberOfChromosomes.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +\name{numberOfChromosomes} +\alias{numberOfChromosomes} +\alias{numberOfChromosomes,PHGraph-method} +\title{Return number of chromosomes} +\usage{ +numberOfChromosomes(object, ...) + +\S4method{numberOfChromosomes}{PHGraph}(object) +} +\arguments{ +\item{object}{an \code{rPHG} local or server connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the number of chromosomes for a given object +} diff --git a/man/numberOfNodes.Rd b/man/numberOfNodes.Rd new file mode 100644 index 0000000..2760f3f --- /dev/null +++ b/man/numberOfNodes.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +\name{numberOfNodes} +\alias{numberOfNodes} +\alias{numberOfNodes,PHGraph-method} +\title{Return number of nodes} +\usage{ +numberOfNodes(object, ...) + +\S4method{numberOfNodes}{PHGraph}(object) +} +\arguments{ +\item{object}{an \code{rPHG} local or server connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the number of nodes for a given object +} diff --git a/man/numberOfRefRanges.Rd b/man/numberOfRefRanges.Rd new file mode 100644 index 0000000..3189bfd --- /dev/null +++ b/man/numberOfRefRanges.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +\name{numberOfRefRanges} +\alias{numberOfRefRanges} +\alias{numberOfRefRanges,PHGraph-method} +\title{Return number of reference ranges} +\usage{ +numberOfRefRanges(object, ...) + +\S4method{numberOfRefRanges}{PHGraph}(object) +} +\arguments{ +\item{object}{an \code{rPHG} local or server connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the number of reference ranges for a given object +} diff --git a/man/numberOfTaxa.Rd b/man/numberOfTaxa.Rd new file mode 100644 index 0000000..8a44f14 --- /dev/null +++ b/man/numberOfTaxa.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +\name{numberOfTaxa} +\alias{numberOfTaxa} +\alias{numberOfTaxa,PHGraph-method} +\title{Return number of taxa} +\usage{ +numberOfTaxa(object, ...) + +\S4method{numberOfTaxa}{PHGraph}(object) +} +\arguments{ +\item{object}{an \code{rPHG} local or server connection object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns the number of taxa for a given object +} diff --git a/man/phgMethodType.Rd b/man/phgMethodType.Rd new file mode 100644 index 0000000..01df920 --- /dev/null +++ b/man/phgMethodType.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +\name{phgMethodType} +\alias{phgMethodType} +\alias{phgMethodType,PHGraph-method} +\title{Return method ID type} +\usage{ +phgMethodType(object, ...) + +\S4method{phgMethodType}{PHGraph}(object) +} +\arguments{ +\item{object}{an \code{rPHG} method object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns a method ID type for a given \code{rPHG} method class +} From 720a1a005da63dc68b96b8bedb94e3402d3d35f2 Mon Sep 17 00:00:00 2001 From: Brandon Date: Sun, 27 Aug 2023 16:09:22 -0400 Subject: [PATCH 23/35] Update getters for multiple classes --- NAMESPACE | 38 +- R/class_all_generics.R | 135 ++++- R/class_phg_dataset.R | 32 +- R/class_phg_method.R | 26 +- R/constants.R | 7 +- R/graph_builder.R | 110 ---- R/hap_id_matrix.R | 33 -- R/read_hap_ids.R | 27 + R/read_phg_dataset.R | 47 +- R/read_ref_ranges.R | 58 +- R/read_samples.R | 27 +- R/stats_and_visualization.R | 594 --------------------- R/{taxa_by_node.R => stats_taxa_by_node.R} | 0 R/taxa_by_node_utilities.R | 32 -- R/utilities_general.R | 37 +- R/utilities_phg_api.R | 80 +-- man/PHGDataSet-class.Rd | 4 +- man/PHGMethod-class.Rd | 2 +- man/calcMutualInfo.Rd | 33 +- man/graphBuilder.Rd | 41 -- man/numHaploPerRange.Rd | 25 - man/phgMethodId.Rd | 6 +- man/plotGraph.Rd | 2 +- man/plotMutualInfo.Rd | 28 - man/plotNumHaplo.Rd | 15 - man/readHaplotypeIds.Rd | 6 +- man/readMappingTableInfo.Rd | 2 +- man/readMappingsForLineName.Rd | 2 +- man/readPHGDataSet.Rd | 8 +- man/readRefRanges.Rd | 6 +- man/readSamples.Rd | 6 +- man/searchRecombination.Rd | 2 +- man/searchSimilarGametes.Rd | 2 +- man/tnHashMapToTibble.Rd | 14 - 34 files changed, 458 insertions(+), 1029 deletions(-) delete mode 100644 R/graph_builder.R delete mode 100644 R/hap_id_matrix.R delete mode 100644 R/stats_and_visualization.R rename R/{taxa_by_node.R => stats_taxa_by_node.R} (100%) delete mode 100644 R/taxa_by_node_utilities.R delete mode 100644 man/graphBuilder.Rd delete mode 100644 man/numHaploPerRange.Rd delete mode 100644 man/plotMutualInfo.Rd delete mode 100644 man/plotNumHaplo.Rd delete mode 100644 man/tnHashMapToTibble.Rd diff --git a/NAMESPACE b/NAMESPACE index 8c43d9a..4838e18 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,20 +5,26 @@ export(PHGMethod) export(PHGServerCon) export(brapiURL) export(brapiVersion) +export(buildPHGraph) +export(calcMutualInfo) export(configFilePath) export(dbName) export(dbType) export(getVTList) -export(graphBuilder) export(host) export(httProtocol) -export(numHaploPerRange) +export(javaMemoryAddress) +export(javaRefObj) +export(numHaploPerRefRange) +export(numberOfChromosomes) +export(numberOfNodes) +export(numberOfRefRanges) +export(numberOfTaxa) export(phgConObj) export(phgMethodId) +export(phgMethodType) export(phgType) export(plotGraph) -export(plotMutualInfo) -export(plotNumHaplo) export(port) export(readHaplotypeIds) export(readMappingTableInfo) @@ -37,15 +43,25 @@ exportClasses(PHGDataSet) exportClasses(PHGLocalCon) exportClasses(PHGMethod) exportClasses(PHGServerCon) +exportClasses(PHGraph) exportMethods(brapiURL) exportMethods(brapiVersion) +exportMethods(calcMutualInfo) exportMethods(configFilePath) exportMethods(dbName) exportMethods(dbType) exportMethods(host) exportMethods(httProtocol) +exportMethods(javaMemoryAddress) +exportMethods(javaRefObj) +exportMethods(numHaploPerRefRange) +exportMethods(numberOfChromosomes) +exportMethods(numberOfNodes) +exportMethods(numberOfRefRanges) +exportMethods(numberOfTaxa) exportMethods(phgConObj) exportMethods(phgMethodId) +exportMethods(phgMethodType) exportMethods(phgType) exportMethods(port) exportMethods(readHaplotypeIds) @@ -54,34 +70,20 @@ exportMethods(readRefRanges) exportMethods(readSamples) exportMethods(serverInfo) exportMethods(showPHGMethods) -import(ggplot2) importFrom(GenomicRanges,GRanges) importFrom(IRanges,IRanges) importFrom(IRanges,subsetByOverlaps) importFrom(S4Vectors,DataFrame) importFrom(S4Vectors,metadata) -importFrom(SummarizedExperiment,SummarizedExperiment) -importFrom(SummarizedExperiment,as.data.frame) importFrom(SummarizedExperiment,assay) -importFrom(SummarizedExperiment,assays) -importFrom(SummarizedExperiment,ranges) importFrom(SummarizedExperiment,rowRanges) -importFrom(SummarizedExperiment,seqnames) -importFrom(corrplot,corrplot) importFrom(curl,has_internet) importFrom(magrittr,"%>%") -importFrom(methods,new) importFrom(methods,setClass) importFrom(rJava,.jcall) importFrom(rJava,.jnew) -importFrom(rJava,.jnull) importFrom(rJava,J) -importFrom(rJava,new) -importFrom(rlang,.data) -importFrom(stats,median) -importFrom(stats,model.matrix) importFrom(tibble,as_tibble) -importFrom(tibble,tibble) importFrom(visNetwork,visEdges) importFrom(visNetwork,visHierarchicalLayout) importFrom(visNetwork,visNetwork) diff --git a/R/class_all_generics.R b/R/class_all_generics.R index ccb4682..ff3e3e1 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -26,6 +26,25 @@ setGeneric("brapiURL", function(object, ...) standardGeneric("brapiURL")) setGeneric("brapiVersion", function(object, ...) standardGeneric("brapiVersion")) +## ---- +#' @title Calculate mutual information for a given PHG data set +#' +#' @description +#' Calculates mutual information from an rPHG data set object containing +#' haplotype id and reference range information. Mutual information quantifies +#' the "amount of information" obtained about one random variable through +#' observing the other random variable. This will calcuate the the mutual +#' information across all pairs of reference ranges. +#' +#' @param object an \code{rPHG} dataset containing haplotype and reference +#' range information +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname calcMutualInfo +#' @export +setGeneric("calcMutualInfo", function(object, ...) standardGeneric("calcMutualInfo")) + + ## ---- #' @title Return file path of configuration file #' @@ -96,6 +115,106 @@ setGeneric("host", function(object, ...) standardGeneric("host")) setGeneric("httProtocol", function(object, ...) standardGeneric("httProtocol")) +## ---- +#' @title Return \code{rJava} reference object +#' +#' @description +#' Returns the \code{rJava} memory reference for a given \code{rPHG} object +#' +#' @param object an \code{rPHG} local or server connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname javaMemoryAddress +#' @export +setGeneric("javaMemoryAddress", function(object, ...) standardGeneric("javaMemoryAddress")) + + +## ---- +#' @title Return \code{rJava} reference object +#' +#' @description +#' Returns the \code{rJava} memory reference for a given \code{rPHG} object +#' +#' @param object an \code{rPHG} local or server connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname javaRefObj +#' @export +setGeneric("javaRefObj", function(object, ...) standardGeneric("javaRefObj")) + + +## ---- +#' @title Return number of chromosomes +#' +#' @description +#' Returns the number of chromosomes for a given object +#' +#' @param object an \code{rPHG} local or server connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname numberOfChromosomes +#' @export +setGeneric("numberOfChromosomes", function(object, ...) standardGeneric("numberOfChromosomes")) + + +## ---- +#' @title Return number of nodes +#' +#' @description +#' Returns the number of nodes for a given object +#' +#' @param object an \code{rPHG} local or server connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname numberOfNodes +#' @export +setGeneric("numberOfNodes", function(object, ...) standardGeneric("numberOfNodes")) + + +## ---- +#' @title Return number of reference ranges +#' +#' @description +#' Returns the number of reference ranges for a given object +#' +#' @param object an \code{rPHG} local or server connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname numberOfRefRanges +#' @export +setGeneric("numberOfRefRanges", function(object, ...) standardGeneric("numberOfRefRanges")) + + +## ---- +#' @title Return number of taxa +#' +#' @description +#' Returns the number of taxa for a given object +#' +#' @param object an \code{rPHG} local or server connection object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname numberOfTaxa +#' @export +setGeneric("numberOfTaxa", function(object, ...) standardGeneric("numberOfTaxa")) + + +## ---- +#' @title Return number of haplotypes per reference range +#' +#' @description +#' Returns the number of unique haplotype IDs per reference range in an rPHG +#' dataset +#' +#' @param object an \code{rPHG} dataset containing haplotype and reference +#' range information +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname numHaploPerRefRange +#' @export +setGeneric("numHaploPerRefRange", function(object, ...) standardGeneric("numHaploPerRefRange")) + + ## ---- #' @title Return a PHG connection object #' @@ -124,6 +243,20 @@ setGeneric("phgConObj", function(object, ...) standardGeneric("phgConObj")) setGeneric("phgMethodId", function(object, ...) standardGeneric("phgMethodId")) +## ---- +#' @title Return method ID type +#' +#' @description +#' Returns a method ID type for a given \code{rPHG} method class +#' +#' @param object an \code{rPHG} method object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname phgMethodType +#' @export +setGeneric("phgMethodType", function(object, ...) standardGeneric("phgMethodType")) + + ## ---- #' @title Return type of PHG connection #' @@ -175,7 +308,7 @@ setGeneric("readHaplotypeIds", function(object, ...) standardGeneric("readHaplot #' haplotype IDs). #' #' @param object an \code{rPHG} local or server connection object -#' @param verbose should retrieval information be printed? Defaults to +#' @param verbose should retrieval information be printed? Defaults to #' \code{FALSE} #' @param ... Additional arguments, for use in specific methods #' diff --git a/R/class_phg_dataset.R b/R/class_phg_dataset.R index 1f3db76..f4829a9 100644 --- a/R/class_phg_dataset.R +++ b/R/class_phg_dataset.R @@ -1,6 +1,7 @@ -#' @title phgDataSet +## ---- +#' @title A PHGDataSet class #' -#' @description A class to represent a practical haplotype graph which is +#' @description A class to represent practical haplotype graph data which is #' wrapped in a \code{RangedSummarizedExperiment} class. #' #' @importFrom methods setClass @@ -12,3 +13,30 @@ setClass( ) + +# /// Methods (general) ///////////////////////////////////////////// + +## ---- +#' @rdname calcMutualInfo +#' @export +setMethod( + f = "calcMutualInfo", + signature = signature(object = "PHGDataSet"), + definition = function(object) { + return(calcMutualInfoFromPHGDataSet(object)) + } +) + + +## ---- +#' @rdname numHaploPerRefRange +#' @export +setMethod( + f = "numHaploPerRefRange", + signature = signature(object = "PHGDataSet"), + definition = function(object) { + return(nHaploPerRefRangeFromPHGDataSet(object)) + } +) + + diff --git a/R/class_phg_method.R b/R/class_phg_method.R index 42417c2..baa977f 100644 --- a/R/class_phg_method.R +++ b/R/class_phg_method.R @@ -1,8 +1,8 @@ ## ---- #' @title A PHGMethod Class #' -#' @description -#' Class \code{PHGMethod} defines a \code{rPHG} Class for storing +#' @description +#' Class \code{PHGMethod} defines a \code{rPHG} Class for storing #' a "committed" PHG method to return data against. #' #' @slot methodID A PHG method identifier. @@ -36,7 +36,7 @@ setClass( #' @importFrom curl has_internet setValidity("PHGMethod", function(object) { errors <- character() - + methodIDs <- showPHGMethods( object = phgConObj(object), showAdvancedMethods = TRUE @@ -46,7 +46,7 @@ setValidity("PHGMethod", function(object) { msg <- "Method ID not found in database." errors <- c(errors, msg) } - + if (length(errors) == 0) TRUE else errors }) @@ -54,7 +54,7 @@ setValidity("PHGMethod", function(object) { ## ---- #' @title Helper function to construct PHGMethod object #' -#' @description +#' @description #' Creates a \code{\linkS4class{PHGMethod}} object to be used to read and #' filter data from a given PHG connection object using a verified PHG method. #' @@ -96,19 +96,19 @@ setMethod( signature = "PHGMethod", definition = function(object) { conType <- phgType(phgConObj(object)) - + conMsg <- switch (conType, "server" = cli::style_bold(cli::col_green("PHGServerCon")), "local" = cli::style_bold(cli::col_green("PHGLocalCon")) ) - + methodId <- cli::style_bold(cli::col_blue(phgMethodId(object))) - + msg <- c( paste0("A ", cli::style_bold("PHGMethod"), " promise object:"), paste0(" <", conMsg, "> --- <", methodId, ">") ) - + cat(msg, sep = "\n") } ) @@ -151,7 +151,7 @@ setMethod( conObj <- phgConObj(object) conType <- phgType(conObj) conMethod <- phgMethodId(object) - + if (conType == "local") { refRangesFromLocal(conObj, conMethod) } else if (conType == "server") { @@ -171,7 +171,7 @@ setMethod( conObj <- phgConObj(object) conType <- phgType(conObj) conMethod <- phgMethodId(object) - + if (conType == "local") { samplesFromLocal(conObj, conMethod) } else if (conType == "server") { @@ -191,7 +191,7 @@ setMethod( conObj <- phgConObj(object) conType <- phgType(conObj) conMethod <- phgMethodId(object) - + if (conType == "local") { hapIdsFromLocal(conObj, conMethod) } else if (conType == "server") { @@ -211,7 +211,7 @@ setMethod( conObj <- phgConObj(object) conType <- phgType(conObj) conMethod <- phgMethodId(object) - + if (conType == "local") { phgDataSetFromLocal(conObj, conMethod, verbose) } else if (conType == "server") { diff --git a/R/constants.R b/R/constants.R index b044c19..3166658 100644 --- a/R/constants.R +++ b/R/constants.R @@ -12,7 +12,7 @@ BRAPI_ENDPOINTS <- list( ## ---- # Commonly used BrAPI parameters BRAPI_PARAMS <- list( - "PAGE_SIZE" = "pageSize=%i" + "PAGE_SIZE" = "pageSize=%i" ) @@ -27,5 +27,8 @@ TASSEL_API <- list( "METHOD_TABLE_REPORT" = "net/maizegenetics/pangenome/api/MethodTableReportPlugin", "PARAMETER_CACHE" = "net/maizegenetics/plugindef/ParameterCache", "R_METHODS" = "net/maizegenetics/pangenome/api/RMethods", - "RESULT_SET" = "java/sql/ResultSet" + "RESULT_SET" = "java/sql/ResultSet", + "VECTOR" = "java/util/Vector" ) + + diff --git a/R/graph_builder.R b/R/graph_builder.R deleted file mode 100644 index fc73479..0000000 --- a/R/graph_builder.R +++ /dev/null @@ -1,110 +0,0 @@ -#' @title Test PHG builder function -#' -#' @description R wrapper to build a PHG graph object for downstream use. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' @param methods Pairs of method calls - passed as string. -#' @param chrom A vector of chromosomes to include in graph. If NULL, defaults -#' to all. To specify multiple chromosome, pass as a vector of strings (i.e. -#' \code{c("1", "2", "3")}). Is currently only used for haplotypes. -#' @param buildType How do you want to build the graph? Options are by -#' \code{haplotype} or by \code{path}. -#' @param includeSequence Whether to include sequences in haplotype nodes. -#' Is currently only used for haplotypes. (ADVANCED) -#' @param includeVariant Whether to include variant contexts in haplotype -#' nodes. Is currently only used for haplotypes. (ADVANCED) -#' -#' @importFrom methods new -#' @importFrom rJava .jnew -#' @importFrom rJava .jnull -#' @importFrom rJava J -#' @importFrom rJava new -#' -#' @export -graphBuilder <- function(configFile, - methods, - chrom = NULL, - buildType = c("haplotype", "path"), - includeSequence = FALSE, - includeVariant = FALSE) { - - configCatcher(configFile) - - buildType <- match.arg(buildType) - - ## Create PHG plugin object - if (buildType == "haplotype") { - phgPlugin <- rJava::new( - rJava::J("net/maizegenetics/pangenome/api/HaplotypeGraphBuilderPlugin"), - rJava::.jnull("java/awt/Frame"), - FALSE - ) - phgPlugin$configFile(toString(configFile)) - phgPlugin$methods(toString(methods)) - msg <- "Building the graph from haplotypes..." - - ### Add chromosome as vector - if (!is.null(chrom)) { - rv <- rJava::.jnew("java/util/Vector") - for (i in seq(chrom)) rv$add(chrom[i]) - phgPlugin$chromosomes(rv) - } else { - phgPlugin$chromosomes(chrom) - } - - ### ADVANCED - phgPlugin$setParameter("includeSequences", toString(includeSequence)) - phgPlugin$setParameter("includeVariantContexts", toString(includeVariant)) - } else if (buildType == "path") { - phgPlugin <- rJava::new( - rJava::J("net/maizegenetics/pangenome/api/BuildGraphFromPathsPlugin") - ) - rJava::J("net/maizegenetics/plugindef/ParameterCache")$load( - toString(configFile) - ) - phgPlugin$pathMethod(toString(methods)) - msg <- "Building the graph from paths..." - } - - ## Build the PHG... - message(msg) - phgObj <- phgPlugin$build() - phgObj <- sumExpBuilder(phgObj = phgObj) - phgObj <- methods::new(Class = "PHGDataSet", phgObj) - - ## Return PHG object - message("Finished!") - return(phgObj) -} - - -#' @importFrom GenomicRanges GRanges -#' @importFrom IRanges IRanges -#' @importFrom S4Vectors metadata -#' @importFrom SummarizedExperiment SummarizedExperiment -sumExpBuilder <- function(phgObj) { - hapIDMat <- hapIDMatrix(phgObject = phgObj) - phgRefRange <- refRangeTable(phgObject = phgObj) - - rr <- GenomicRanges::GRanges( - seqnames = phgRefRange$chr, - ranges = IRanges::IRanges( - start = phgRefRange$start, - end = phgRefRange$end - ), - refRange_id = phgRefRange$id - ) - - phgSE <- SummarizedExperiment::SummarizedExperiment( - assays = list(hapID = t(hapIDMat)), - rowRanges = rr - ) - S4Vectors::metadata(phgSE)$jObj <- phgObj - - return(phgSE) -} - - diff --git a/R/hap_id_matrix.R b/R/hap_id_matrix.R deleted file mode 100644 index 8331e8e..0000000 --- a/R/hap_id_matrix.R +++ /dev/null @@ -1,33 +0,0 @@ -## ---- -# @title Generate a haplotype ID matrix -# -# @description Generates a haplotype ID matrix from a PHG object. -# -# @author Brandon Monier -# @author Peter Bradbury -# -# @param phgObject A PHG object. -# -# @importFrom rJava is.jnull -# @importFrom rJava J -hapIDMatrix <- function(phgObject) { - - ## Pull hap ID matrix from phg object - hapids <- rJava::J( - "net.maizegenetics.pangenome.api/RMethods", - "hapidTableAsMatrix", - phgObject - ) - hapidMatrix <- hapids$matrix - - ## Get row and column names (if available) - if(!rJava::is.jnull(hapids$rowNames)) { - rownames(hapidMatrix) <- hapids$rowNames - } - if(!rJava::is.jnull(hapids$columnNames)) { - colnames(hapidMatrix) <- hapids$columnNames - } - - ## Return the matrix - return(hapidMatrix) -} diff --git a/R/read_hap_ids.R b/R/read_hap_ids.R index 630bdcf..4e9618f 100644 --- a/R/read_hap_ids.R +++ b/R/read_hap_ids.R @@ -21,3 +21,30 @@ hapIdsFromSever <- function(conObj, conMethod) { } +## ---- +# Return Hap ID matrix from `HaplotypeGraph` objects +# +# @param phgObj A PHG `HaplotypeGraph` object +hapIdsFromGraphObj <- function(phgObject) { + + # Pull hap ID matrix from phg object + hapids <- rJava::J( + TASSEL_API$R_METHODS, + "hapidTableAsMatrix", + phgObject + ) + hapidMatrix <- hapids$matrix + + # Get row and column names (if available) + if(!rJava::is.jnull(hapids$rowNames)) { + rownames(hapidMatrix) <- hapids$rowNames + } + if(!rJava::is.jnull(hapids$columnNames)) { + colnames(hapidMatrix) <- hapids$columnNames + } + + # Return the matrix + return(hapidMatrix) +} + + diff --git a/R/read_phg_dataset.R b/R/read_phg_dataset.R index 8d90e81..b9fa6dd 100644 --- a/R/read_phg_dataset.R +++ b/R/read_phg_dataset.R @@ -11,19 +11,19 @@ phgDataSetFromLocal <- function(conObj, conMethod, verbose) { paste0(bullet, " Getting haplotype matrix data..."), paste0(bullet, " Constructing PHGDataSet...") ) - + if (verbose) message(verbInfo[1]) gr <- refRangesFromLocal(conObj, conMethod) - + if (verbose) message(verbInfo[2]) hm <- hapIdsFromLocal(conObj, conMethod) - + if (verbose) message(verbInfo[3]) phgSE <- SummarizedExperiment::SummarizedExperiment( assays = list(pathMatrix = t(hm)), rowRanges = gr ) - + return(methods::new(Class = "PHGDataSet", phgSE)) } @@ -41,14 +41,45 @@ phgDataSetFromServer <- function(conObj, conMethod, verbose) { paste0(bullet, cli::style_bold(" (WIP)"), " Getting haplotype matrix data..."), paste0(bullet, cli::style_bold(" (WIP)"), " Constructing PHGDataSet...") ) - + if (verbose) message(verbInfo[1]) - + # TODO + if (verbose) message(verbInfo[2]) - + # TODO + if (verbose) message(verbInfo[3]) - + # TODO + return(NULL) } +## ---- +# Get PHGDataSet from `HaplotypeGraph` objects +# +# @param phgObj A PHG `HaplotypeGraph` object +phgDataSetFromGraphObj <- function(phgObj, verbose) { + bullet <- cli::col_grey(cli::symbol$info) + verbInfo <- c( + paste0(bullet, " Getting reference range data..."), + paste0(bullet, " Getting haplotype matrix data..."), + paste0(bullet, " Constructing PHGDataSet...") + ) + + if (verbose) message(verbInfo[1]) + gr <- refRangesFromGraphObj(phgObj) + + if (verbose) message(verbInfo[2]) + hm <- hapIdsFromGraphObj(phgObj) + + if (verbose) message(verbInfo[3]) + phgSE <- SummarizedExperiment::SummarizedExperiment( + assays = list(pathMatrix = t(hm)), + rowRanges = gr + ) + + return(methods::new(Class = "PHGDataSet", phgSE)) +} + + diff --git a/R/read_ref_ranges.R b/R/read_ref_ranges.R index 0fac06d..1bedb03 100644 --- a/R/read_ref_ranges.R +++ b/R/read_ref_ranges.R @@ -5,18 +5,8 @@ # @param conMethod A PHG database method ID refRangesFromLocal <- function(conObj, conMethod) { phgObj <- graphFromPaths(configFilePath(conObj), conMethod) - rrDf <- refRangesFromGraphObj(phgObj) - - gr <- GenomicRanges::GRanges( - seqnames = rrDf$chr, - ranges = IRanges::IRanges( - start = rrDf$start, - end = rrDf$end - ), - rr_id = rrDf$id - ) - - return(gr) + + return(refRangesFromGraphObj(phgObj)) } @@ -32,9 +22,9 @@ refRangesFromServer <- function(conObj, conMethod) { conMethod, sprintf("%s?pageSize=%i", BRAPI_ENDPOINTS$VARIANTS, 150000) ) - + rrDf <- parseJSON(finalUrl)$result$data - + gr <- GenomicRanges::GRanges( seqnames = rrDf$referenceName, ranges = IRanges::IRanges( @@ -43,8 +33,46 @@ refRangesFromServer <- function(conObj, conMethod) { ), rr_id = paste0("R", rrDf$variantDbId) ) - + + return(gr) +} + + +## ---- +# Get reference range data from `HaplotypeGraph` objects +# +# @param phgObj A PHG `HaplotypeGraph` object +refRangesFromGraphObj <- function(phgObj) { + + # Get reference range object from PHG object + refRangeObj <- rJava::J( + TASSEL_API$R_METHODS, + "referenceRanges", + phgObj + ) + + # Get data vectors and convert to tibble + rrDf <- data.frame( + lapply( + X = seq_along(refRangeObj$columnNames) - 1, + FUN = function(i) { + refRangeObj$dataVectors$get(as.integer(i)) + } + ) + ) + names(rrDf) <- refRangeObj$columnNames + + gr <- GenomicRanges::GRanges( + seqnames = rrDf$chr, + ranges = IRanges::IRanges( + start = rrDf$start, + end = rrDf$end + ), + rr_id = rrDf$id + ) + return(gr) } + diff --git a/R/read_samples.R b/R/read_samples.R index 93001c4..9332e7e 100644 --- a/R/read_samples.R +++ b/R/read_samples.R @@ -6,7 +6,7 @@ samplesFromLocal <- function(conObj, conMethod) { dbConn <- rJava::.jnew(TASSEL_API$DB_LOADING_UTILS)$ connection( - configFilePath(conObj), + configFilePath(conObj), FALSE ) @@ -17,19 +17,19 @@ samplesFromLocal <- function(conObj, conMethod) { sprintf("WHERE methods.name = '%s'", conMethod), collapse = " " ) - + rs <- dbConn$createStatement()$executeQuery(sqlQuery) - + taxa <- c() i <- 1 while (rs$`next`()) { taxa[i] <- rs$getString("line_name") i <- i + 1 } - + rs$close() dbConn$close() - + return(taxa) } @@ -46,10 +46,23 @@ samplesFromServer <- function(conObj, conMethod) { conMethod, BRAPI_ENDPOINTS$SAMPLES ) - + taxaDf <- parseJSON(finalUrl)$result$data - + return(taxaDf$sampleName) } +## ---- +# Get samples from `HaplotypeGraph` objects +# +# @param phgObj A PHG `HaplotypeGraph` object +samplesFromGraphObj <- function(phgObj) { + jArray <- rJava::.jevalArray(obj = phgObj$taxaInGraph()$toArray()) + + taxa <- unlist(lapply(jArray, function(x) x$getName())) + + return(taxa) +} + + diff --git a/R/stats_and_visualization.R b/R/stats_and_visualization.R deleted file mode 100644 index 6dcc95c..0000000 --- a/R/stats_and_visualization.R +++ /dev/null @@ -1,594 +0,0 @@ -# === rPHG Stats Visualization Functions (WIP) ====================== - -#' @title Get the number of haplotypes per range in physical position segment -#' -#' @author Jean-Luc Jannink -#' -#' @param phgObject A PHG object. -#' @param chr What chromosome do you want to inspect? Defaults to \code{NULL}. -#' If \code{NULL}, all chromsomes will be selected. -#' @param start Start position of chromosome. Defaults to \code{0}. -#' @param end End position of chromosome. Defaults to \code{NULL}. If -#' \code{NULL}, the whole chromosome will be analyzed. -#' -#' @importFrom S4Vectors DataFrame -#' @importFrom SummarizedExperiment as.data.frame -#' @importFrom SummarizedExperiment assays -#' @importFrom SummarizedExperiment ranges -#' @importFrom SummarizedExperiment rowRanges -#' @importFrom SummarizedExperiment seqnames -#' -#' @export -numHaploPerRange <- function(phgObject, - chr = NULL, - start = 0, - end = NULL) { - - # Get information about the reference ranges - rr <- SummarizedExperiment::rowRanges(phgObject) - - # Logic - if (is.null(end)) { - end <- max(end(rr)) - } - - allChr <- unique(SummarizedExperiment::seqnames(phgObject)) - allChr <- as.vector(allChr) - if (is.null(chr)) { - chr <- allChr - } else{ - if (!all(chr %in% allChr)) { - warning(paste(c("The following chromosomes are not found:", setdiff(chr, allChr)), collapse=" ")) - } - } - - # Which reference ranges on the chromosome within start and end positions - tmp <- as.vector(SummarizedExperiment::seqnames(phgObject)) - keepRanges <- which(tmp %in% chr & start <= start(rr) & end(rr) <= end) - - if (length(keepRanges) == 0) { - stop("There are no ranges with requested start and end") - } - - # How many haplotypes are in those reference ranges - phgHapIDMat <- t(SummarizedExperiment::assays(phgObject)$hapID) - - if (dim(phgObject)[2] == 1) { - phgFilt <- phgHapIDMat[, keepRanges] - phgFilt <- t(as.matrix(phgFilt)) - } else { - phgFilt <- phgHapIDMat[, keepRanges] - } - nHaplo <- apply(phgFilt, 2, function(vec) { - length(unique(vec)) - }) - - # Return the numerical information - rr <- SummarizedExperiment::as.data.frame(rr) - rr <- cbind(rr[keepRanges,], numHaplotypes = nHaplo) - rr <- rr[, c(6, 1, 2, 3, 4, 7)] - return(S4Vectors::DataFrame(rr)) -} - - - -#' @title Plot the number of haplotypes -#' -#' @description This function will plot the number of haplotypes. Its input -#' will be the output of the \code{numHaploPerRange()} function. -#' -#' @param haploData The output of \code{numHaploPerRange()} -#' -#' @import ggplot2 -#' @importFrom rlang .data -#' @importFrom stats median -#' -#' @export -plotNumHaplo <- function(haploData) { - # Coerce to data frame for ggplot2 - tmp <- as.data.frame(haploData) - - # Shape proportions - yfrac <- 0.1 - xfrac <- 0.001 - - # Add shape data - tmp$med <- apply(tmp[, 3:4], 1, stats::median) - tmp$color <- "#91baff" - tmp[seq(1, nrow(tmp), by = 2),]$color <- "#3e619b" - - # Get limit data - xbeg <- min(tmp$start) - xend <- max(tmp$end) - yend <- max(tmp$numHaplotypes) - - # Visualize - hapPlot <- ggplot(data = tmp) + - ylim(-(yend * yfrac), yend) + - scale_x_continuous(limits = c(xbeg, xend)) + - geom_rect( - mapping = aes( - xmin = .data$start, - xmax = .data$end, - ymin = 0, - ymax = -(yend * yfrac) - ), - fill = tmp$color - ) + - geom_path(aes(x = .data$med, y = .data$numHaplotypes)) + - geom_point(aes(x = .data$med, y = .data$numHaplotypes), size = 1) + - facet_grid(seqnames ~ .) + - xlab("Physical Position (bp)") + - ylab("Number of Haplotypes") - - return(hapPlot) -} - - - -#' @title Calculate the mutual information between a set of reference ranges -#' -#' @description Mutual information quantifies the "amount of information" -#' obtained about one random variable through observing the other random -#' variable. Specify the gamete names over which you want to calculate and -#' reference ranges. -#' -#' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. -#' @param phgObject A PHG object. -#' @param gameteNames Specified gamete names. If \code{NULL}, gamete names will -#' default to taxa IDs (haplottype ID matrix row names). -#' @param refRanges What reference ranges you wan to specify? -#' -#' @importFrom S4Vectors metadata -#' @importFrom stats model.matrix -calcMutualInfo <- function(phgObject = NULL, - refRanges, - gameteNames = NULL, - phgHapIDMat = NULL) { - if (is.null(phgHapIDMat)) { - if (is.null(phgObject)) { - stop("Must supply phgHapIDMat or phgObject") - } - phgHapIDMat <- hapIDMatrix(phgObject = S4Vectors::metadata(phgObject)$jObj) - } - - if (is.null(gameteNames)) { - gameteNames <- rownames(phgHapIDMat) - } - - phgHapIDMat <- phgHapIDMat[gameteNames, refRanges, drop = FALSE] - # you can't do this with single gametes or ranges - if (any(dim(phgHapIDMat) < 2)) { - return(NULL) - } - - # Calculate the mutual information across a pair of ranges - # I(X;Y) = Sum p(x, y)log{p(x, y) / [p(x)p(y)]} - mutualInfoPair <- function(phgHapIDMat, twoRanges) { - hapID <- phgHapIDMat[, twoRanges] - - # Remove any rows that have missing data - hapID <- hapID[!apply(hapID, 1, function(v) any(v == -1)), ] - - # Check if any columns have only one haplotype - test1haplo <- apply(hapID, 2, function(v) length(unique(v)) == 1) - if (any(test1haplo)) { - return(0) - } - hapID <- apply(hapID, 2, as.character) - nHap1 <- length(unique(hapID[, 1])) - nHap2 <- length(unique(hapID[, 2])) - mm1 <- model.matrix( ~ -1 + hapID[, 1]) %>% colMeans - mm2 <- model.matrix( ~ -1 + hapID[, 2]) %>% colMeans - mmm <- tcrossprod(mm1, mm2) - mmi <- model.matrix( ~ -1 + hapID[, 1]:hapID[, 2]) %>% colMeans %>% matrix(nHap1, nHap2) - mi <- mmi * log2(mmi / mmm) # Some of these will be NaN, removed by na.rm=T - return(sum(mi, na.rm = T)) - } - # Calculate the mutual information across all pairs of ranges - nRanges <- length(refRanges) - miMat <- matrix(NA, nrow = nRanges, ncol = nRanges) - rownames(miMat) <- colnames(miMat) <- refRanges - for (range1 in 1:(nRanges - 1)) { - for (range2 in (range1 + 1):nRanges) { - miMat[range1, range2] <- - mutualInfoPair(phgHapIDMat, c(refRanges[range1], refRanges[range2])) - } - } - return(miMat) -} - - - -#' @title Calculate and plot mutual information between a set of reference ranges -#' -#' @description Mutual information quantifies the “amount of information” -#' obtained about one random variable through observing the other random -#' variable. -#' -#' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. -#' @param phgObject A PHG object. -#' @param gameteNames Specified gamete names. If \code{NULL}, gamete names will -#' default to taxa IDs (haplottype ID matrix row names). -#' @param refRanges What reference ranges you wan to specify? -#' -#' @importFrom corrplot corrplot -#' -#' @export -plotMutualInfo <- function(phgObject = NULL, - refRanges, - gameteNames = NULL, - phgHapIDMat = NULL) { - mi <- calcMutualInfo( - phgObject = phgObject, - refRanges = refRanges, - gameteNames = NULL, - phgHapIDMat - ) - mi[is.na(mi)] <- 0 - corrplot::corrplot(mi, type = "upper", is.corr = F) - # return(mi) -} - - - -## Function to say if haplotypes same, discarding comparisons with -1 -# gamHapIDs and targetHapIDs are both vectors of haplotype IDs. -# The output is the fraction of hapIDs that are different -# With ranges that contain -1 not included in the fraction -calcDiff <- function(gamHapIDs, targetHapIDs) { - keep <- which(gamHapIDs != -1 & targetHapIDs != -1) - if (length(keep) == 0) { - return(Inf) - } - return(sum(gamHapIDs[keep] != targetHapIDs[keep]) / length(keep)) -} - - - -#' @title Search for similar gamets -#' -#' @description Search for inbred lines (gametes) that are similar to a -#' specified gamete in specified reference ranges. Supply either a haplotype -#' ID matrix or a phgObject from which to extract it. Specify a gamete name -#' and reference ranges. The difference between haplotypes is either 0 (same) -#' or 1 (different). Fraction of ranges that are different has to be lower or -#' equal to fractionDiff. Ranges with unknown haplotypes (-1) do not count in -#' the fraction. If all pairwise range comparisons have -1 the lines are -#' considered dissimilar. -#' -#' @param gameteName A specified gamete name -#' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. If -#' \code{NULL}, A hap ID matrix will be generated (if you have supplied a -#' PHG object). -#' @param phgObject A PHG object. -#' @param refRanges Specifed reference ranges. -#' @param fractionDiff The difference between haplotypes (either 0 or 1). See -#' description for further details. -#' -#' @importFrom magrittr %>% -#' @importFrom S4Vectors metadata -#' -#' @export -searchSimilarGametes <- function(phgObject = NULL, - refRanges, - gameteName, - fractionDiff = 0, - phgHapIDMat = NULL) { - if (is.null(phgHapIDMat)) { - if (is.null(phgObject)) { - stop("Must supply phgHapIDMat or phgObject") - } - phgHapIDMat <- hapIDMatrix(phgObject = S4Vectors::metadata(phgObject)$jObj) - } - - # The row the target gamete is in - gameteRow <- which(rownames(phgHapIDMat) == gameteName) - if (length(gameteRow) == 0) { - stop(paste0("Gamete ", gameteName, " not in the PHG")) - } - - # Only deal with specified reference ranges - phgHapIDMat <- phgHapIDMat[, refRanges, drop = FALSE] - targetHapIDs <- phgHapIDMat[gameteRow, , drop = FALSE] - - # Calculate differences across all gametes in the table - fracDiffs <- apply(phgHapIDMat, 1, calcDiff, targetHapIDs = targetHapIDs) - areSimilar <- which(fracDiffs <= fractionDiff) %>% setdiff(gameteRow) - - # Return names of gametes that are similar to the target - return(rownames(phgHapIDMat)[areSimilar]) -} - - - -#' @title Search for recombination -#' -#' @description Search for inbred lines (gametes) that are the same in one -#' range but different in another. Such lines have experienced recombination -#' in the past relative to each other. Must specify a gamete name and -#' reference ranges. -#' -#' @param gameteName A specified gamete name -#' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. If -#' \code{NULL}, A hap ID matrix will be generated (if you have supplied a -#' PHG object). -#' @param phgObject A PHG object. -#' @param refRangeSame See description for further details. -#' @param refRangeDiff See description for further details. -#' -#' @importFrom magrittr %>% -#' @importFrom S4Vectors metadata -#' -#' @export -searchRecombination <- function(phgObject = NULL, - gameteName, - refRangeSame, - refRangeDiff, - phgHapIDMat = NULL) { - if (is.null(phgHapIDMat)) { - if (is.null(phgObject)) { - stop("Must supply phgHapIDMat or phgObject") - } - phgHapIDMat <- hapIDMatrix(phgObject = phgObject) - } - - gametesSame <- searchSimilarGametes( - gameteName, - phgHapIDMat, - refRanges = refRangeSame - ) %>% - setdiff(gameteName) - - targetDiff <- phgHapIDMat[gameteName, refRangeDiff] - - gametesDiff <- sapply( - phgHapIDMat[gametesSame, refRangeDiff], - calcDiff, - targetHapIDs = targetDiff - ) - - return(gametesSame[gametesDiff == 1]) -} - - -# ---- -#' @title Visualize Graph Data -#' -#' @description -#' Generates an interactive network plot for a given set of reference ranges -#' and a set of taxa. -#' -#' @param x A \code{PHGDataSet} object -#' @param samples Samples/taxa to include in plot -#' @param sampleHighlight Sample path to highlight -#' @param seqnames A sequence (e.g. chromosome) ID -#' @param start Start position for ref ranges -#' @param end End position for ref ranges -#' @param colMajor Highlight path color -#' @param colMinor Muted path color -#' @param ... Additional parameters to pass for ref range inclusion -#' -#' @importFrom IRanges subsetByOverlaps -#' @importFrom GenomicRanges GRanges -#' @importFrom SummarizedExperiment assay -#' @importFrom visNetwork visEdges -#' @importFrom visNetwork visHierarchicalLayout -#' @importFrom visNetwork visNetwork -#' -#' @export -plotGraph <- function( - x, - samples = NULL, - sampleHighlight = NULL, - seqnames = NULL, - start = NULL, - end = NULL, - colMajor = "maroon", - colMinor = "lightgrey", - ... -) { - # # Testing - # start <- 100 - # end <- 1000000 - # seqnames <- "1" - # # samples <- c("Z001E0001", "Z001E0028", "Z001E0080") - # # samples <- NULL - # set.seed(123) - # samples <- sample(colnames(x), 100) - # # sampleHighlight <- c("Z001E0001") - # sampleHighlight <- sample(samples, 1) - - # Filter by taxa and ref ranges - if (is.null(samples)) samples <- colnames(x) - hapTableMini <- x[, colnames(x) %in% samples] - hapTableMini <- IRanges::subsetByOverlaps( - hapTableMini, - GenomicRanges::GRanges(seqnames = seqnames, ranges = start:end) - ) - - # Get hap ID matrix - currentMatrix <- t(SummarizedExperiment::assay(hapTableMini)) - currentMatrix[is.na(currentMatrix)] <- -128 - colnames(currentMatrix) <- gsub("R", "", colnames(currentMatrix)) |> - as.numeric() - - # Get ref range data frame - refRangeDataMini <- rowRanges(hapTableMini) |> as.data.frame() - - # Group taxa by hap ID and ref range - taxaGroups <- lapply(seq_len(ncol(currentMatrix)), function(i) { - split(rownames(currentMatrix), currentMatrix[, i]) - }) - - # Generate distinct IDs (hap ID + ref range ID) - hapIds <- currentMatrix |> apply(2, unique, simplify = FALSE) - hapLevels <- rep(names(hapIds), vapply(hapIds, length, integer(1))) |> as.numeric() - fullHapIds <- paste0( - lapply(hapIds, function(i) i[order(i)]) |> unlist(), - "_", hapLevels - ) - - # HTML tooltip processing - taxaToHtml <- function(x) { - vapply(x, function(i) { - paste0("Taxa: ", paste(i, collapse = ", "), "

") - }, character(1)) - } - tooltipVec <- lapply(taxaGroups, taxaToHtml) |> unlist() - - refRangeHtml <- lapply(hapLevels, function(i) { - paste0( - "

Chr: ", - refRangeDataMini[i, ]$seqnames, - "
", - "Range: ", - refRangeDataMini[i, ]$start, - " - ", - refRangeDataMini[i, ]$end, - "
" - ) - }) |> unlist() - - # Final graph data (nodes) - nodes <- data.frame( - id = seq_along(fullHapIds), - label = fullHapIds, - level = hapLevels, - title = paste0(refRangeHtml, tooltipVec) - ) - - if (!is.null(sampleHighlight)) { - for (i in sampleHighlight) { - nodes$group <- ifelse(grepl(i, nodes$title), i, NA) - nodes$color <- ifelse(grepl(i, nodes$title), colMajor, colMinor) - } - nodes$title <- gsub(i, paste0("", i, ""), nodes$title) - } else { - nodes$color <- colMajor - } - - # Final graph data (edges) - lne <- c() - rne <- c() - for (i in seq_len(ncol(currentMatrix) - 1)) { - ln <- paste0(currentMatrix[, i], "_", i) - rn <- paste0(currentMatrix[, i + 1], "_", i + 1) - - cnxn <- paste0(ln, "+", rn) |> unique() - - for (c in cnxn) { - splits <- strsplit(c, "\\+") |> unlist() - f <- which(fullHapIds == splits[1]) - t <- which(fullHapIds == splits[2]) - lne <- c(lne, f) - rne <- c(rne, t) - } - } - - edges <- data.frame( - from = lne, - to = rne - ) - - # Return vis.js object - visNetwork::visNetwork(nodes, edges) |> - visNetwork::visEdges(arrows = "to") |> - visNetwork::visHierarchicalLayout(direction = "LR") -} - - -## ---- -#' @title Retrieve read mapping information from PHG database. -#' -#' @description Returns an \code{S4Vectors} \code{DataFrame} object of read -#' mapping information for a given line (i.e. taxon). -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' @param lineName The name of the line (taxon) for which the read mapping -#' information is to be retrieved. If there are multiple read mappings with -#' different \code{file_group_names}, they will be combined. -#' @param readMappingMethodName The method name for the read mappings -#' (only takes a single method). -#' @param haplotypeMethodName The haplotype method name. -#' @param fileGroup the name of the file group for the line from the database. -#' This parameter is only necessary if the line (taxon) has more than one -#' file group and only the reads for a specific file group are wanted. -#' -#' @importFrom rJava J -#' @importFrom S4Vectors DataFrame -#' -#' @export -readMappingsForLineName <- function(configFile, - lineName, - readMappingMethodName, - haplotypeMethodName, - fileGroup = NULL) { - - configCatcher(configFile) - - # Retrieve Java data vector object(s) - rmObj <- rJava::J( - "net.maizegenetics.pangenome.api/RMethods", - "readMappingsForLineName", - configFile, - lineName, - readMappingMethodName, - haplotypeMethodName, - fileGroup - ) - - # Configure for R - colNum <- rmObj$dataVectors$size() - rmDF <- lapply(seq_len(colNum), function(i) { - rmObj$dataVectors$get(as.integer(i - 1)) - }) - rmDF <- data.frame(rmDF) - colnames(rmDF) <- rmObj$columnNames - - # Return - return(S4Vectors::DataFrame(rmDF)) -} - - -## ---- -#' @title Retrieve read mapping records from PHG database. -#' -#' @description Returns an \code{S4Vectors} \code{DataFrame} object of read -#' mapping record information without \code{read_mapping} data. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' -#' @importFrom rJava J -#' @importFrom S4Vectors DataFrame -#' -#' @export -readMappingTableInfo <- function(configFile) { - - # Catch potential errors - configCatcher(configFile) - - # Retrieve Java data vector object(s) - rmObj <- rJava::J( - "net.maizegenetics.pangenome.api/RMethods", - "readMappingTableInfo", - configFile - ) - - # Configure for R - colNum <- rmObj$dataVectors$size() - rmDF <- lapply(seq_len(colNum), function(i) { - rmObj$dataVectors$get(as.integer(i - 1)) - }) - rmDF <- data.frame(rmDF) - colnames(rmDF) <- rmObj$columnNames - - # Return - return(S4Vectors::DataFrame(rmDF)) -} \ No newline at end of file diff --git a/R/taxa_by_node.R b/R/stats_taxa_by_node.R similarity index 100% rename from R/taxa_by_node.R rename to R/stats_taxa_by_node.R diff --git a/R/taxa_by_node_utilities.R b/R/taxa_by_node_utilities.R deleted file mode 100644 index 907f37e..0000000 --- a/R/taxa_by_node_utilities.R +++ /dev/null @@ -1,32 +0,0 @@ -## ---- -#' Convert PHG HashMap to tibble (house-keeping) -#' -#' @param x HashMap to R list -#' -#' @importFrom tibble tibble -tnHashMapToTibble <- function(x) { - rrNames <- names(x) - hapNames <- lapply(x, names) - - rrNamesVec <- lapply(seq_along(hapNames), function(i) { - rep(rrNames[i], length(hapNames[[i]])) - }) |> unlist() - - hapNamesVec <- unlist(hapNames) - taxaIdVec <- lapply(seq_along(hapNames), function(i) { - tmpCache <- x[[i]] - lapply(seq_along(tmpCache), function(j) { - tmpCache[[j]] - }) - }) - - return( - tibble::tibble( - ref_range_id = rrNamesVec, - hap_id = hapNamesVec, - taxa_id = taxaIdVec |> unlist(recursive = FALSE) - ) - ) -} - - diff --git a/R/utilities_general.R b/R/utilities_general.R index 0179324..f25da19 100644 --- a/R/utilities_general.R +++ b/R/utilities_general.R @@ -137,13 +137,13 @@ getProperty <- function(configLines, x) { tableReportToDF <- function(x) { rJC <- rJava::J("net/maizegenetics/plugindef/GenerateRCode") tabRep <- rJC$tableReportToVectors(x) - + tabRepCols <- lapply(tabRep$dataVector, rJava::.jevalArray) - + tabRepCols <- do.call("data.frame", c(tabRepCols, stringsAsFactors = FALSE)) colnames(tabRepCols) <- tabRep$columnNames colnames(tabRepCols) <- gsub(" ", "_", colnames(tabRepCols)) - + return(tibble::as_tibble(tabRepCols)) } @@ -157,14 +157,41 @@ descriptionStringToList <- function(s) { X = strsplit(unlist(strsplit(s, "\",\"")), "\":\""), FUN = function(i) gsub("\"}|\\{\"", "", x = i) ) - + names(sList) <- unlist(lapply(sList, function(i) i[1])) sList <- lapply(sList, function(i) i[2]) - + return(sList) } +## ---- +# Convert PHG HashMap to tibble +# +# @param x HashMap to R list +tnHashMapToTibble <- function(x) { + rrNames <- names(x) + hapNames <- lapply(x, names) + + rrNamesVec <- lapply(seq_along(hapNames), function(i) { + rep(rrNames[i], length(hapNames[[i]])) + }) |> unlist() + + hapNamesVec <- unlist(hapNames) + taxaIdVec <- lapply(seq_along(hapNames), function(i) { + tmpCache <- x[[i]] + lapply(seq_along(tmpCache), function(j) { + tmpCache[[j]] + }) + }) + return( + tibble::tibble( + ref_range_id = rrNamesVec, + hap_id = hapNamesVec, + taxa_id = taxaIdVec |> unlist(recursive = FALSE) + ) + ) +} diff --git a/R/utilities_phg_api.R b/R/utilities_phg_api.R index 60d55d4..f3fb234 100644 --- a/R/utilities_phg_api.R +++ b/R/utilities_phg_api.R @@ -1,57 +1,71 @@ ## ---- -# Build graph object from path method(s) +# Build graph object from haplotype method(s) # # @param configFile Path to a config file # @param method A path method string -graphFromPaths <- function(configFile, method) { +graphFromHaplotypes <- function( + configFile, + method, + chrom, + includeSequence, + includeVariants +) { + gbPlugin <- rJava::new( - rJava::J(TASSEL_API$BUILD_GRAPH_FROM_PATHS) + rJava::J(TASSEL_API$HAPLOTYPE_GRAPH_BUILDER), + rJava::.jnull(TASSEL_API$FRAME), + FALSE ) - rJava::J(TASSEL_API$PARAMETER_CACHE)$load( - toString(configFile) - ) - gbPlugin$pathMethod(toString(method)) - + gbPlugin$configFile(toString(configFile)) + gbPlugin$methods(toString(method)) + + # Add chromosome as vector + if (!is.null(chrom)) { + rv <- rJava::.jnew(TASSEL_API$VECTOR) + for (i in seq(chrom)) rv$add(chrom[i]) + gbPlugin$chromosomes(rv) + } else { + gbPlugin$chromosomes(chrom) + } + + # Set sequence and variant return (ADVANCED) + gbPlugin$setParameter("includeSequences", toString(includeSequence)) + gbPlugin$setParameter("includeVariantContexts", toString(includeVariants)) + graphObj <- gbPlugin$build() - + return(graphObj) } ## ---- -# Get reference range data from graph objects +# Build graph object from path method(s) # -# @param phgObj A PHG `HaplotypeGraph` object -refRangesFromGraphObj <- function(phgObj) { - # Get reference range object from PHG object - refRangeObj <- rJava::J( - TASSEL_API$R_METHODS, - "referenceRanges", - phgObj +# @param configFile Path to a config file +# @param method A path method string +graphFromPaths <- function(configFile, method) { + + gbPlugin <- rJava::new( + rJava::J(TASSEL_API$BUILD_GRAPH_FROM_PATHS) ) - - # Get data vectors and convert to tibble - refranges <- data.frame( - lapply( - X = seq_along(refRangeObj$columnNames) - 1, - FUN = function(i) { - refRangeObj$dataVectors$get(as.integer(i)) - } - ) + rJava::J(TASSEL_API$PARAMETER_CACHE)$load( + toString(configFile) ) - names(refranges) <- refRangeObj$columnNames - - return(refranges) + gbPlugin$pathMethod(toString(method)) + + graphObj <- gbPlugin$build() + + return(graphObj) } ## ---- # Get hap ID matrix for a given path method -# +# # @param configFile Path to a config file # @param method A path method string pathsForMethod <- function(configFile, method) { - + # Retrieve Java matrix object pathObj <- rJava::J( TASSEL_API$R_METHODS, @@ -59,12 +73,12 @@ pathsForMethod <- function(configFile, method) { configFile, method ) - + # Configure for R pathMat <- pathObj$matrix rownames(pathMat) <- pathObj$rowNames colnames(pathMat) <- paste0("R", pathObj$columnNames) - + # Return return(pathMat) } diff --git a/man/PHGDataSet-class.Rd b/man/PHGDataSet-class.Rd index 801d37d..d629bb6 100644 --- a/man/PHGDataSet-class.Rd +++ b/man/PHGDataSet-class.Rd @@ -3,8 +3,8 @@ \docType{class} \name{PHGDataSet-class} \alias{PHGDataSet-class} -\title{phgDataSet} +\title{A PHGDataSet class} \description{ -A class to represent a practical haplotype graph which is +A class to represent practical haplotype graph data which is wrapped in a \code{RangedSummarizedExperiment} class. } diff --git a/man/PHGMethod-class.Rd b/man/PHGMethod-class.Rd index fd53287..469e363 100644 --- a/man/PHGMethod-class.Rd +++ b/man/PHGMethod-class.Rd @@ -5,7 +5,7 @@ \alias{PHGMethod-class} \title{A PHGMethod Class} \description{ -Class \code{PHGMethod} defines a \code{rPHG} Class for storing +Class \code{PHGMethod} defines a \code{rPHG} Class for storing a "committed" PHG method to return data against. } \section{Slots}{ diff --git a/man/calcMutualInfo.Rd b/man/calcMutualInfo.Rd index 900733a..2e5a62a 100644 --- a/man/calcMutualInfo.Rd +++ b/man/calcMutualInfo.Rd @@ -1,29 +1,24 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stats_and_visualization.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_dataset.R \name{calcMutualInfo} \alias{calcMutualInfo} -\title{Calculate the mutual information between a set of reference ranges} +\alias{calcMutualInfo,PHGDataSet-method} +\title{Calculate mutual information for a given PHG data set} \usage{ -calcMutualInfo( - phgObject = NULL, - refRanges, - gameteNames = NULL, - phgHapIDMat = NULL -) +calcMutualInfo(object, ...) + +\S4method{calcMutualInfo}{PHGDataSet}(object) } \arguments{ -\item{phgObject}{A PHG object.} - -\item{refRanges}{What reference ranges you wan to specify?} - -\item{gameteNames}{Specified gamete names. If \code{NULL}, gamete names will -default to taxa IDs (haplottype ID matrix row names).} +\item{object}{an \code{rPHG} dataset containing haplotype and reference +range information} -\item{phgHapIDMat}{The output of the \code{hapIDMatrix()} function.} +\item{...}{Additional arguments, for use in specific methods} } \description{ -Mutual information quantifies the "amount of information" - obtained about one random variable through observing the other random - variable. Specify the gamete names over which you want to calculate and - reference ranges. +Calculates mutual information from an rPHG data set object containing +haplotype id and reference range information. Mutual information quantifies +the "amount of information" obtained about one random variable through +observing the other random variable. This will calcuate the the mutual +information across all pairs of reference ranges. } diff --git a/man/graphBuilder.Rd b/man/graphBuilder.Rd deleted file mode 100644 index 727f3f2..0000000 --- a/man/graphBuilder.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/graph_builder.R -\name{graphBuilder} -\alias{graphBuilder} -\title{Test PHG builder function} -\usage{ -graphBuilder( - configFile, - methods, - chrom = NULL, - buildType = c("haplotype", "path"), - includeSequence = FALSE, - includeVariant = FALSE -) -} -\arguments{ -\item{configFile}{Path to a configuration file for your graph database.} - -\item{methods}{Pairs of method calls - passed as string.} - -\item{chrom}{A vector of chromosomes to include in graph. If NULL, defaults -to all. To specify multiple chromosome, pass as a vector of strings (i.e. -\code{c("1", "2", "3")}). Is currently only used for haplotypes.} - -\item{buildType}{How do you want to build the graph? Options are by -\code{haplotype} or by \code{path}.} - -\item{includeSequence}{Whether to include sequences in haplotype nodes. -Is currently only used for haplotypes. (ADVANCED)} - -\item{includeVariant}{Whether to include variant contexts in haplotype -nodes. Is currently only used for haplotypes. (ADVANCED)} -} -\description{ -R wrapper to build a PHG graph object for downstream use. -} -\author{ -Brandon Monier - -Peter Bradbury -} diff --git a/man/numHaploPerRange.Rd b/man/numHaploPerRange.Rd deleted file mode 100644 index 721daa0..0000000 --- a/man/numHaploPerRange.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stats_and_visualization.R -\name{numHaploPerRange} -\alias{numHaploPerRange} -\title{Get the number of haplotypes per range in physical position segment} -\usage{ -numHaploPerRange(phgObject, chr = NULL, start = 0, end = NULL) -} -\arguments{ -\item{phgObject}{A PHG object.} - -\item{chr}{What chromosome do you want to inspect? Defaults to \code{NULL}. -If \code{NULL}, all chromsomes will be selected.} - -\item{start}{Start position of chromosome. Defaults to \code{0}.} - -\item{end}{End position of chromosome. Defaults to \code{NULL}. If -\code{NULL}, the whole chromosome will be analyzed.} -} -\description{ -Get the number of haplotypes per range in physical position segment -} -\author{ -Jean-Luc Jannink -} diff --git a/man/phgMethodId.Rd b/man/phgMethodId.Rd index f3bc56e..43e1227 100644 --- a/man/phgMethodId.Rd +++ b/man/phgMethodId.Rd @@ -1,12 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R, +% R/class_phg_method.R \name{phgMethodId} \alias{phgMethodId} +\alias{phgMethodId,PHGraph-method} \alias{phgMethodId,PHGMethod-method} \title{Return method ID} \usage{ phgMethodId(object, ...) +\S4method{phgMethodId}{PHGraph}(object) + \S4method{phgMethodId}{PHGMethod}(object) } \arguments{ diff --git a/man/plotGraph.Rd b/man/plotGraph.Rd index 56fbe48..10af84c 100644 --- a/man/plotGraph.Rd +++ b/man/plotGraph.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stats_and_visualization.R +% Please edit documentation in R/deprecated_stats_and_visualization.R \name{plotGraph} \alias{plotGraph} \title{Visualize Graph Data} diff --git a/man/plotMutualInfo.Rd b/man/plotMutualInfo.Rd deleted file mode 100644 index f96a075..0000000 --- a/man/plotMutualInfo.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stats_and_visualization.R -\name{plotMutualInfo} -\alias{plotMutualInfo} -\title{Calculate and plot mutual information between a set of reference ranges} -\usage{ -plotMutualInfo( - phgObject = NULL, - refRanges, - gameteNames = NULL, - phgHapIDMat = NULL -) -} -\arguments{ -\item{phgObject}{A PHG object.} - -\item{refRanges}{What reference ranges you wan to specify?} - -\item{gameteNames}{Specified gamete names. If \code{NULL}, gamete names will -default to taxa IDs (haplottype ID matrix row names).} - -\item{phgHapIDMat}{The output of the \code{hapIDMatrix()} function.} -} -\description{ -Mutual information quantifies the “amount of information” - obtained about one random variable through observing the other random - variable. -} diff --git a/man/plotNumHaplo.Rd b/man/plotNumHaplo.Rd deleted file mode 100644 index 4199539..0000000 --- a/man/plotNumHaplo.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stats_and_visualization.R -\name{plotNumHaplo} -\alias{plotNumHaplo} -\title{Plot the number of haplotypes} -\usage{ -plotNumHaplo(haploData) -} -\arguments{ -\item{haploData}{The output of \code{numHaploPerRange()}} -} -\description{ -This function will plot the number of haplotypes. Its input - will be the output of the \code{numHaploPerRange()} function. -} diff --git a/man/readHaplotypeIds.Rd b/man/readHaplotypeIds.Rd index f900106..a9f2bc5 100644 --- a/man/readHaplotypeIds.Rd +++ b/man/readHaplotypeIds.Rd @@ -1,12 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R, +% R/class_phg_method.R \name{readHaplotypeIds} \alias{readHaplotypeIds} +\alias{readHaplotypeIds,PHGraph-method} \alias{readHaplotypeIds,PHGMethod-method} \title{Return haplotype IDs} \usage{ readHaplotypeIds(object, ...) +\S4method{readHaplotypeIds}{PHGraph}(object) + \S4method{readHaplotypeIds}{PHGMethod}(object) } \arguments{ diff --git a/man/readMappingTableInfo.Rd b/man/readMappingTableInfo.Rd index 2bb3f23..aa2f8b7 100644 --- a/man/readMappingTableInfo.Rd +++ b/man/readMappingTableInfo.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stats_and_visualization.R +% Please edit documentation in R/deprecated_stats_and_visualization.R \name{readMappingTableInfo} \alias{readMappingTableInfo} \title{Retrieve read mapping records from PHG database.} diff --git a/man/readMappingsForLineName.Rd b/man/readMappingsForLineName.Rd index 41e8aca..2ef1290 100644 --- a/man/readMappingsForLineName.Rd +++ b/man/readMappingsForLineName.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stats_and_visualization.R +% Please edit documentation in R/deprecated_stats_and_visualization.R \name{readMappingsForLineName} \alias{readMappingsForLineName} \title{Retrieve read mapping information from PHG database.} diff --git a/man/readPHGDataSet.Rd b/man/readPHGDataSet.Rd index 7ed4456..c26667d 100644 --- a/man/readPHGDataSet.Rd +++ b/man/readPHGDataSet.Rd @@ -1,18 +1,22 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R, +% R/class_phg_method.R \name{readPHGDataSet} \alias{readPHGDataSet} +\alias{readPHGDataSet,PHGraph-method} \alias{readPHGDataSet,PHGMethod-method} \title{Return a PHGDataSet} \usage{ readPHGDataSet(object, verbose = FALSE, ...) +\S4method{readPHGDataSet}{PHGraph}(object) + \S4method{readPHGDataSet}{PHGMethod}(object, verbose = TRUE) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} -\item{verbose}{should retrieval information be printed? Defaults to +\item{verbose}{should retrieval information be printed? Defaults to \code{FALSE}} \item{...}{Additional arguments, for use in specific methods} diff --git a/man/readRefRanges.Rd b/man/readRefRanges.Rd index 0a14d09..bba711d 100644 --- a/man/readRefRanges.Rd +++ b/man/readRefRanges.Rd @@ -1,12 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R, +% R/class_phg_method.R \name{readRefRanges} \alias{readRefRanges} +\alias{readRefRanges,PHGraph-method} \alias{readRefRanges,PHGMethod-method} \title{Return reference ranges} \usage{ readRefRanges(object, ...) +\S4method{readRefRanges}{PHGraph}(object) + \S4method{readRefRanges}{PHGMethod}(object) } \arguments{ diff --git a/man/readSamples.Rd b/man/readSamples.Rd index 2c80298..53a9f3e 100644 --- a/man/readSamples.Rd +++ b/man/readSamples.Rd @@ -1,12 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R, +% R/class_phg_method.R \name{readSamples} \alias{readSamples} +\alias{readSamples,PHGraph-method} \alias{readSamples,PHGMethod-method} \title{Return samples IDs} \usage{ readSamples(object, ...) +\S4method{readSamples}{PHGraph}(object) + \S4method{readSamples}{PHGMethod}(object) } \arguments{ diff --git a/man/searchRecombination.Rd b/man/searchRecombination.Rd index dad9be8..30d1af4 100644 --- a/man/searchRecombination.Rd +++ b/man/searchRecombination.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stats_and_visualization.R +% Please edit documentation in R/deprecated_stats_and_visualization.R \name{searchRecombination} \alias{searchRecombination} \title{Search for recombination} diff --git a/man/searchSimilarGametes.Rd b/man/searchSimilarGametes.Rd index b67a3f8..0bccbf4 100644 --- a/man/searchSimilarGametes.Rd +++ b/man/searchSimilarGametes.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stats_and_visualization.R +% Please edit documentation in R/deprecated_stats_and_visualization.R \name{searchSimilarGametes} \alias{searchSimilarGametes} \title{Search for similar gamets} diff --git a/man/tnHashMapToTibble.Rd b/man/tnHashMapToTibble.Rd deleted file mode 100644 index 74a8c0b..0000000 --- a/man/tnHashMapToTibble.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/taxa_by_node_utilities.R -\name{tnHashMapToTibble} -\alias{tnHashMapToTibble} -\title{Convert PHG HashMap to tibble (house-keeping)} -\usage{ -tnHashMapToTibble(x) -} -\arguments{ -\item{x}{HashMap to R list} -} -\description{ -Convert PHG HashMap to tibble (house-keeping) -} From 607061604bc1fd4a90d9e366fcc31526f9749ce3 Mon Sep 17 00:00:00 2001 From: Brandon Date: Mon, 28 Aug 2023 08:07:34 -0400 Subject: [PATCH 24/35] Rename file --- R/{utilities_brapi.R => utilities_api_brapi.R} | 0 R/{utilities_phg_api.R => utilities_api_phg.R} | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename R/{utilities_brapi.R => utilities_api_brapi.R} (100%) rename R/{utilities_phg_api.R => utilities_api_phg.R} (100%) diff --git a/R/utilities_brapi.R b/R/utilities_api_brapi.R similarity index 100% rename from R/utilities_brapi.R rename to R/utilities_api_brapi.R diff --git a/R/utilities_phg_api.R b/R/utilities_api_phg.R similarity index 100% rename from R/utilities_phg_api.R rename to R/utilities_api_phg.R From 7601699d031874de9bd728a806795c88b1274813 Mon Sep 17 00:00:00 2001 From: Brandon Date: Thu, 31 Aug 2023 07:58:07 -0400 Subject: [PATCH 25/35] Add comments --- R/utilities_stats.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/R/utilities_stats.R b/R/utilities_stats.R index ff08221..220bc87 100644 --- a/R/utilities_stats.R +++ b/R/utilities_stats.R @@ -1,7 +1,12 @@ ## ---- -# Calculate the mutual information across a pair of ranges +# Calculate the mutual information across a pair of reference ranges # I(X;Y) = Sum p(x, y)log{p(x, y) / [p(x)p(y)]} # +# NOTE: above equation is from: +# * Shannon and Weaver (1949) +# * Cover and Thomas (1991) +# NOTE: hap IDs are treated as categorical data (model.matrix) +# # @param phgHapIDMat A haplotype ID matrix # @param twoRanges A vector of length 2 containg two ref range elements mutualInfoPair <- function(phgHapIDMat, twoRanges) { @@ -24,16 +29,19 @@ mutualInfoPair <- function(phgHapIDMat, twoRanges) { nHap1 <- length(unique(hapID[, 1])) nHap2 <- length(unique(hapID[, 2])) + # Sum p(x, y) mmi <- matrix( data = colMeans(model.matrix( ~ -1 + hapID[, 1]:hapID[, 2])), nrow = nHap1, ncol = nHap2 ) + # p(x)p(y) mm1 <- colMeans(model.matrix( ~ -1 + hapID[, 1])) mm2 <- colMeans(model.matrix( ~ -1 + hapID[, 2])) mmm <- tcrossprod(mm1, mm2) + # Sum p(x, y) log{p(x, y) / [p(x)p(y)]} # Some of these will be `NaN` (removed by `na.rm = TRUE`) mi <- mmi * log2(mmi / mmm) return(sum(mi, na.rm = TRUE)) From b20e7db7bde0838a459aae733f41b464e26041d7 Mon Sep 17 00:00:00 2001 From: Brandon Date: Thu, 31 Aug 2023 15:57:30 -0400 Subject: [PATCH 26/35] Change class name --- NAMESPACE | 4 +- ...ss_phg_graph.R => class_haplotype_graph.R} | 68 +++++++++---------- R/method_table.R | 24 +++---- ...Graph-class.Rd => HaplotypeGraph-class.Rd} | 16 ++--- man/HaplotypeGraph-validity.Rd | 11 +++ man/PHGraph-validity.Rd | 11 --- ...buildPHGraph.Rd => buildHaplotypeGraph.Rd} | 10 +-- man/getVTList.Rd | 2 +- man/javaMemoryAddress.Rd | 4 +- man/javaRefObj.Rd | 4 +- man/json2tibble.Rd | 2 +- man/numberOfChromosomes.Rd | 4 +- man/numberOfNodes.Rd | 4 +- man/numberOfRefRanges.Rd | 4 +- man/numberOfTaxa.Rd | 4 +- man/phgMethodId.Rd | 4 +- man/phgMethodType.Rd | 4 +- man/readHaplotypeIds.Rd | 4 +- man/readPHGDataSet.Rd | 4 +- man/readRefRanges.Rd | 4 +- man/readSamples.Rd | 4 +- man/taxaByNode.Rd | 2 +- 22 files changed, 99 insertions(+), 99 deletions(-) rename R/{class_phg_graph.R => class_haplotype_graph.R} (80%) rename man/{PHGraph-class.Rd => HaplotypeGraph-class.Rd} (65%) create mode 100644 man/HaplotypeGraph-validity.Rd delete mode 100644 man/PHGraph-validity.Rd rename man/{buildPHGraph.Rd => buildHaplotypeGraph.Rd} (81%) diff --git a/NAMESPACE b/NAMESPACE index 4838e18..a097ed7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,7 +5,7 @@ export(PHGMethod) export(PHGServerCon) export(brapiURL) export(brapiVersion) -export(buildPHGraph) +export(buildHaplotypeGraph) export(calcMutualInfo) export(configFilePath) export(dbName) @@ -38,12 +38,12 @@ export(serverInfo) export(showPHGMethods) export(startLogger) export(taxaByNode) +exportClasses(HaplotypeGraph) exportClasses(PHGCon) exportClasses(PHGDataSet) exportClasses(PHGLocalCon) exportClasses(PHGMethod) exportClasses(PHGServerCon) -exportClasses(PHGraph) exportMethods(brapiURL) exportMethods(brapiVersion) exportMethods(calcMutualInfo) diff --git a/R/class_phg_graph.R b/R/class_haplotype_graph.R similarity index 80% rename from R/class_phg_graph.R rename to R/class_haplotype_graph.R index 7dcef1c..3740718 100644 --- a/R/class_phg_graph.R +++ b/R/class_haplotype_graph.R @@ -1,8 +1,8 @@ ## ---- -#' @title A PHGraph Class +#' @title A HaplotypeGraph Class #' #' @description -#' Class \code{PHGraph} defines a \code{rPHG} Class for storing +#' Class \code{HaplotypeGraph} defines a \code{rPHG} Class for storing #' a \code{HaplotypeGraph} object defined in the PHG API #' #' @slot methodID A \code{\linkS4class{PHGMethod}} object @@ -14,11 +14,11 @@ #' \code{HaplotypeGraph} class in the PHG API #' @slot jMemAddress An identifier string to the JVM memory space #' -#' @name PHGraph-class -#' @rdname PHGraph-class -#' @exportClass PHGraph +#' @name HaplotypeGraph-class +#' @rdname HaplotypeGraph-class +#' @exportClass HaplotypeGraph setClass( - Class = "PHGraph", + Class = "HaplotypeGraph", slots = c( methodID = "character", methodType = "character", @@ -43,16 +43,16 @@ setClass( ## ---- -#' @title PHGraph validation +#' @title HaplotypeGraph validation #' -#' @name PHGraph-validity +#' @name HaplotypeGraph-validity #' -#' @description Checks if \code{PHGraph} class objects are valid. +#' @description Checks if \code{HaplotypeGraph} class objects are valid. #' -#' @param object A \code{PHGraph} object. +#' @param object A \code{HaplotypeGraph} object. #' #' @importFrom curl has_internet -setValidity("PHGraph", function(object) { +setValidity("HaplotypeGraph", function(object) { errors <- character() jObjRef <- javaRefObj(object) @@ -73,10 +73,10 @@ setValidity("PHGraph", function(object) { ## ---- -#' @title Helper function to build PHGraph object +#' @title Helper function to build HaplotypeGraph object #' #' @description -#' Creates a \code{\linkS4class{PHGraph}} object to be used to build and store +#' Creates a \code{\linkS4class{HaplotypeGraph}} object to be used to build and store #' an \code{rJava} reference object pointing to a \code{HaplotypeGraph} object #' from the PHG API. #' @@ -92,7 +92,7 @@ setValidity("PHGraph", function(object) { #' increase memory consumption! #' #' @export -buildPHGraph <- function( +buildHaplotypeGraph <- function( phgMethodObj, chrom = NULL, includeSequence = FALSE, @@ -131,7 +131,7 @@ buildPHGraph <- function( pointer <- gsub(".*@", "", rJava::.jstrVal(phgObj)) methods::new( - Class = "PHGraph", + Class = "HaplotypeGraph", methodID = conMethod, methodType = methodType, nChrom = phgObj$numberOfChromosomes(), @@ -148,26 +148,26 @@ buildPHGraph <- function( # /// Methods (show) //////////////////////////////////////////////// ## ---- -#' @title Show methods for PHGraph objects +#' @title Show methods for HaplotypeGraph objects #' #' @description -#' Prints out information regarding properties from the \code{PHGraph} +#' Prints out information regarding properties from the \code{HaplotypeGraph} #' class to the console #' -#' @param object A \code{\linkS4class{PHGraph}} object +#' @param object A \code{\linkS4class{HaplotypeGraph}} object #' #' @docType methods -#' @rdname PHGraph-class -#' @aliases show,PHGraph-method +#' @rdname HaplotypeGraph-class +#' @aliases show,HaplotypeGraph-method setMethod( f = "show", - signature = "PHGraph", + signature = "HaplotypeGraph", definition = function(object) { pointerSymbol <- cli::col_green(cli::symbol$pointer) msg <- c( paste0( - "A ", cli::style_bold("PHGraph"), " object @ ", + "A ", cli::style_bold("HaplotypeGraph"), " object @ ", cli::style_bold(cli::col_blue(javaMemoryAddress(object))) ), paste0(" ", pointerSymbol, " Method.............: ", cli::style_bold(phgMethodId(object))), @@ -190,7 +190,7 @@ setMethod( #' @export setMethod( f = "javaMemoryAddress", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(object@jMemAddress) } @@ -202,7 +202,7 @@ setMethod( #' @export setMethod( f = "javaRefObj", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(object@jHapGraph) } @@ -214,7 +214,7 @@ setMethod( #' @export setMethod( f = "numberOfChromosomes", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(object@nChrom) } @@ -226,7 +226,7 @@ setMethod( #' @export setMethod( f = "numberOfNodes", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(object@nNodes) } @@ -238,7 +238,7 @@ setMethod( #' @export setMethod( f = "numberOfRefRanges", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(object@nRefRanges) } @@ -250,7 +250,7 @@ setMethod( #' @export setMethod( f = "numberOfTaxa", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(object@nTaxa) } @@ -262,7 +262,7 @@ setMethod( #' @export setMethod( f = "phgMethodId", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(object@methodID) } @@ -274,7 +274,7 @@ setMethod( #' @export setMethod( f = "phgMethodType", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(object@methodType) } @@ -286,7 +286,7 @@ setMethod( #' @export setMethod( f = "readHaplotypeIds", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(hapIdsFromGraphObj(javaRefObj(object))) } @@ -298,7 +298,7 @@ setMethod( #' @export setMethod( f = "readPHGDataSet", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(phgDataSetFromGraphObj(javaRefObj(object), verbose = TRUE)) } @@ -310,7 +310,7 @@ setMethod( #' @export setMethod( f = "readRefRanges", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(refRangesFromGraphObj(javaRefObj(object))) } @@ -322,7 +322,7 @@ setMethod( #' @export setMethod( f = "readSamples", - signature = signature(object = "PHGraph"), + signature = signature(object = "HaplotypeGraph"), definition = function(object) { return(samplesFromGraphObj(javaRefObj(object))) } diff --git a/R/method_table.R b/R/method_table.R index 2df2e6a..52a5fbf 100644 --- a/R/method_table.R +++ b/R/method_table.R @@ -15,25 +15,25 @@ methodTableFromLocal <- function(configFile, showAdvancedMethods) { ) tabRep <- ds$getDataSet()$get(0L)$getData() tabRepDf <- tableReportToDF(tabRep) - + # Convert description field to column of parsed lists (key = value) tabRepDf$description <- lapply( - X = tabRepDf$description, + X = tabRepDf$description, FUN = descriptionStringToList ) - + # Remove method table DB ids (not relevant to user) tabRepDf$num_refranges <- NA tabRepDf$num_samples <- NA colsToKeep <- c( - "type_name", - "method_name", - "num_refranges", - "num_samples", + "type_name", + "method_name", + # "num_refranges", + # "num_samples", "description" ) tabRepDf <- tabRepDf[, colsToKeep] - + # Return only PATHS or all data if (showAdvancedMethods) { return(tabRepDf) @@ -53,14 +53,14 @@ methodTableFromServer <- function(url, showAdvancedMethods) { tableUrl <- file.path(url, BRAPI_ENDPOINTS$METHOD_TABLE) jsonObj <- parseJSON(tableUrl) methodDf <- jsonObj$result$data - + # Make consistent names with local method table call methodDf$type_name <- NA idOrderAndMapping <- c( "type_name" = "type_name", "variantTableDbId" = "method_name", - "numVariants" = "num_refranges", - "numSamples" = "num_samples", + # "numVariants" = "num_refranges", + # "numSamples" = "num_samples", "additionalInfo" = "description" ) for (oldName in names(methodDf)) { @@ -70,7 +70,7 @@ methodTableFromServer <- function(url, showAdvancedMethods) { } } methodDf <- methodDf[, idOrderAndMapping] - + # @TODO - fix arbitrary method return (will be fixed with add. info) if (showAdvancedMethods) { return(tibble::as_tibble(methodDf)) diff --git a/man/PHGraph-class.Rd b/man/HaplotypeGraph-class.Rd similarity index 65% rename from man/PHGraph-class.Rd rename to man/HaplotypeGraph-class.Rd index 18e9fd5..655ffe0 100644 --- a/man/PHGraph-class.Rd +++ b/man/HaplotypeGraph-class.Rd @@ -1,21 +1,21 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_phg_graph.R \docType{class} -\name{PHGraph-class} -\alias{PHGraph-class} -\alias{show,PHGraph-method} -\title{A PHGraph Class} +\name{HaplotypeGraph-class} +\alias{HaplotypeGraph-class} +\alias{show,HaplotypeGraph-method} +\title{A HaplotypeGraph Class} \usage{ -\S4method{show}{PHGraph}(object) +\S4method{show}{HaplotypeGraph}(object) } \arguments{ -\item{object}{A \code{\linkS4class{PHGraph}} object} +\item{object}{A \code{\linkS4class{HaplotypeGraph}} object} } \description{ -Class \code{PHGraph} defines a \code{rPHG} Class for storing +Class \code{HaplotypeGraph} defines a \code{rPHG} Class for storing a \code{HaplotypeGraph} object defined in the PHG API -Prints out information regarding properties from the \code{PHGraph} +Prints out information regarding properties from the \code{HaplotypeGraph} class to the console } \section{Slots}{ diff --git a/man/HaplotypeGraph-validity.Rd b/man/HaplotypeGraph-validity.Rd new file mode 100644 index 0000000..4902677 --- /dev/null +++ b/man/HaplotypeGraph-validity.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_phg_graph.R +\name{HaplotypeGraph-validity} +\alias{HaplotypeGraph-validity} +\title{HaplotypeGraph validation} +\arguments{ +\item{object}{A \code{HaplotypeGraph} object.} +} +\description{ +Checks if \code{HaplotypeGraph} class objects are valid. +} diff --git a/man/PHGraph-validity.Rd b/man/PHGraph-validity.Rd deleted file mode 100644 index b4eb126..0000000 --- a/man/PHGraph-validity.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_phg_graph.R -\name{PHGraph-validity} -\alias{PHGraph-validity} -\title{PHGraph validation} -\arguments{ -\item{object}{A \code{PHGraph} object.} -} -\description{ -Checks if \code{PHGraph} class objects are valid. -} diff --git a/man/buildPHGraph.Rd b/man/buildHaplotypeGraph.Rd similarity index 81% rename from man/buildPHGraph.Rd rename to man/buildHaplotypeGraph.Rd index 73a6111..a84d657 100644 --- a/man/buildPHGraph.Rd +++ b/man/buildHaplotypeGraph.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_phg_graph.R -\name{buildPHGraph} -\alias{buildPHGraph} -\title{Helper function to build PHGraph object} +\name{buildHaplotypeGraph} +\alias{buildHaplotypeGraph} +\title{Helper function to build HaplotypeGraph object} \usage{ -buildPHGraph( +buildHaplotypeGraph( phgMethodObj, chrom = NULL, includeSequence = FALSE, @@ -27,7 +27,7 @@ nodes. Is currently only used for haplotypes. NOTE: this will greatly increase memory consumption!} } \description{ -Creates a \code{\linkS4class{PHGraph}} object to be used to build and store +Creates a \code{\linkS4class{HaplotypeGraph}} object to be used to build and store an \code{rJava} reference object pointing to a \code{HaplotypeGraph} object from the PHG API. } diff --git a/man/getVTList.Rd b/man/getVTList.Rd index 94dde7a..ebd8bdf 100644 --- a/man/getVTList.Rd +++ b/man/getVTList.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities_brapi.R +% Please edit documentation in R/utilities_api_brapi.R \name{getVTList} \alias{getVTList} \title{Retrieve variant table BrAPI URLs} diff --git a/man/javaMemoryAddress.Rd b/man/javaMemoryAddress.Rd index a21ffc8..4171751 100644 --- a/man/javaMemoryAddress.Rd +++ b/man/javaMemoryAddress.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R \name{javaMemoryAddress} \alias{javaMemoryAddress} -\alias{javaMemoryAddress,PHGraph-method} +\alias{javaMemoryAddress,HaplotypeGraph-method} \title{Return \code{rJava} reference object} \usage{ javaMemoryAddress(object, ...) -\S4method{javaMemoryAddress}{PHGraph}(object) +\S4method{javaMemoryAddress}{HaplotypeGraph}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/javaRefObj.Rd b/man/javaRefObj.Rd index 0ec40f9..ca9dcd3 100644 --- a/man/javaRefObj.Rd +++ b/man/javaRefObj.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R \name{javaRefObj} \alias{javaRefObj} -\alias{javaRefObj,PHGraph-method} +\alias{javaRefObj,HaplotypeGraph-method} \title{Return \code{rJava} reference object} \usage{ javaRefObj(object, ...) -\S4method{javaRefObj}{PHGraph}(object) +\S4method{javaRefObj}{HaplotypeGraph}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/json2tibble.Rd b/man/json2tibble.Rd index f2bdfba..e98022d 100644 --- a/man/json2tibble.Rd +++ b/man/json2tibble.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities_brapi.R +% Please edit documentation in R/utilities_api_brapi.R \name{json2tibble} \alias{json2tibble} \title{JSON to tibble converter} diff --git a/man/numberOfChromosomes.Rd b/man/numberOfChromosomes.Rd index 9e37791..1b9aa13 100644 --- a/man/numberOfChromosomes.Rd +++ b/man/numberOfChromosomes.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R \name{numberOfChromosomes} \alias{numberOfChromosomes} -\alias{numberOfChromosomes,PHGraph-method} +\alias{numberOfChromosomes,HaplotypeGraph-method} \title{Return number of chromosomes} \usage{ numberOfChromosomes(object, ...) -\S4method{numberOfChromosomes}{PHGraph}(object) +\S4method{numberOfChromosomes}{HaplotypeGraph}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/numberOfNodes.Rd b/man/numberOfNodes.Rd index 2760f3f..9771b6b 100644 --- a/man/numberOfNodes.Rd +++ b/man/numberOfNodes.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R \name{numberOfNodes} \alias{numberOfNodes} -\alias{numberOfNodes,PHGraph-method} +\alias{numberOfNodes,HaplotypeGraph-method} \title{Return number of nodes} \usage{ numberOfNodes(object, ...) -\S4method{numberOfNodes}{PHGraph}(object) +\S4method{numberOfNodes}{HaplotypeGraph}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/numberOfRefRanges.Rd b/man/numberOfRefRanges.Rd index 3189bfd..2633f98 100644 --- a/man/numberOfRefRanges.Rd +++ b/man/numberOfRefRanges.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R \name{numberOfRefRanges} \alias{numberOfRefRanges} -\alias{numberOfRefRanges,PHGraph-method} +\alias{numberOfRefRanges,HaplotypeGraph-method} \title{Return number of reference ranges} \usage{ numberOfRefRanges(object, ...) -\S4method{numberOfRefRanges}{PHGraph}(object) +\S4method{numberOfRefRanges}{HaplotypeGraph}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/numberOfTaxa.Rd b/man/numberOfTaxa.Rd index 8a44f14..7e09d3a 100644 --- a/man/numberOfTaxa.Rd +++ b/man/numberOfTaxa.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R \name{numberOfTaxa} \alias{numberOfTaxa} -\alias{numberOfTaxa,PHGraph-method} +\alias{numberOfTaxa,HaplotypeGraph-method} \title{Return number of taxa} \usage{ numberOfTaxa(object, ...) -\S4method{numberOfTaxa}{PHGraph}(object) +\S4method{numberOfTaxa}{HaplotypeGraph}(object) } \arguments{ \item{object}{an \code{rPHG} local or server connection object} diff --git a/man/phgMethodId.Rd b/man/phgMethodId.Rd index 43e1227..1f12afc 100644 --- a/man/phgMethodId.Rd +++ b/man/phgMethodId.Rd @@ -3,13 +3,13 @@ % R/class_phg_method.R \name{phgMethodId} \alias{phgMethodId} -\alias{phgMethodId,PHGraph-method} +\alias{phgMethodId,HaplotypeGraph-method} \alias{phgMethodId,PHGMethod-method} \title{Return method ID} \usage{ phgMethodId(object, ...) -\S4method{phgMethodId}{PHGraph}(object) +\S4method{phgMethodId}{HaplotypeGraph}(object) \S4method{phgMethodId}{PHGMethod}(object) } diff --git a/man/phgMethodType.Rd b/man/phgMethodType.Rd index 01df920..69db41f 100644 --- a/man/phgMethodType.Rd +++ b/man/phgMethodType.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R \name{phgMethodType} \alias{phgMethodType} -\alias{phgMethodType,PHGraph-method} +\alias{phgMethodType,HaplotypeGraph-method} \title{Return method ID type} \usage{ phgMethodType(object, ...) -\S4method{phgMethodType}{PHGraph}(object) +\S4method{phgMethodType}{HaplotypeGraph}(object) } \arguments{ \item{object}{an \code{rPHG} method object} diff --git a/man/readHaplotypeIds.Rd b/man/readHaplotypeIds.Rd index a9f2bc5..b5dacde 100644 --- a/man/readHaplotypeIds.Rd +++ b/man/readHaplotypeIds.Rd @@ -3,13 +3,13 @@ % R/class_phg_method.R \name{readHaplotypeIds} \alias{readHaplotypeIds} -\alias{readHaplotypeIds,PHGraph-method} +\alias{readHaplotypeIds,HaplotypeGraph-method} \alias{readHaplotypeIds,PHGMethod-method} \title{Return haplotype IDs} \usage{ readHaplotypeIds(object, ...) -\S4method{readHaplotypeIds}{PHGraph}(object) +\S4method{readHaplotypeIds}{HaplotypeGraph}(object) \S4method{readHaplotypeIds}{PHGMethod}(object) } diff --git a/man/readPHGDataSet.Rd b/man/readPHGDataSet.Rd index c26667d..af327cf 100644 --- a/man/readPHGDataSet.Rd +++ b/man/readPHGDataSet.Rd @@ -3,13 +3,13 @@ % R/class_phg_method.R \name{readPHGDataSet} \alias{readPHGDataSet} -\alias{readPHGDataSet,PHGraph-method} +\alias{readPHGDataSet,HaplotypeGraph-method} \alias{readPHGDataSet,PHGMethod-method} \title{Return a PHGDataSet} \usage{ readPHGDataSet(object, verbose = FALSE, ...) -\S4method{readPHGDataSet}{PHGraph}(object) +\S4method{readPHGDataSet}{HaplotypeGraph}(object) \S4method{readPHGDataSet}{PHGMethod}(object, verbose = TRUE) } diff --git a/man/readRefRanges.Rd b/man/readRefRanges.Rd index bba711d..90537e4 100644 --- a/man/readRefRanges.Rd +++ b/man/readRefRanges.Rd @@ -3,13 +3,13 @@ % R/class_phg_method.R \name{readRefRanges} \alias{readRefRanges} -\alias{readRefRanges,PHGraph-method} +\alias{readRefRanges,HaplotypeGraph-method} \alias{readRefRanges,PHGMethod-method} \title{Return reference ranges} \usage{ readRefRanges(object, ...) -\S4method{readRefRanges}{PHGraph}(object) +\S4method{readRefRanges}{HaplotypeGraph}(object) \S4method{readRefRanges}{PHGMethod}(object) } diff --git a/man/readSamples.Rd b/man/readSamples.Rd index 53a9f3e..b7742f8 100644 --- a/man/readSamples.Rd +++ b/man/readSamples.Rd @@ -3,13 +3,13 @@ % R/class_phg_method.R \name{readSamples} \alias{readSamples} -\alias{readSamples,PHGraph-method} +\alias{readSamples,HaplotypeGraph-method} \alias{readSamples,PHGMethod-method} \title{Return samples IDs} \usage{ readSamples(object, ...) -\S4method{readSamples}{PHGraph}(object) +\S4method{readSamples}{HaplotypeGraph}(object) \S4method{readSamples}{PHGMethod}(object) } diff --git a/man/taxaByNode.Rd b/man/taxaByNode.Rd index 3eb72d2..7acb689 100644 --- a/man/taxaByNode.Rd +++ b/man/taxaByNode.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/taxa_by_node.R +% Please edit documentation in R/stats_taxa_by_node.R \name{taxaByNode} \alias{taxaByNode} \title{Get taxa data for selected reference ranges} From 66a0383dceb4da99107349a2c36a7d2d52909bfe Mon Sep 17 00:00:00 2001 From: Brandon Date: Thu, 7 Sep 2023 16:01:52 -0400 Subject: [PATCH 27/35] Add new tests --- R/class_phg_con_server.R | 14 +---- R/method_table.R | 2 +- .../test_brapi_classes.R | 0 .../test_brapi_getters_and_setters.R | 0 .../test_brapi_methods.R | 0 .../test_brapi_utilities.R | 0 .../test_graph_builder.R | 0 .../test_logging_support.R | 0 .../{testthat => test_bak}/test_path_matrix.R | 0 .../test_show_phg_methods.R | 0 .../test_stats_and_visulization.R | 0 .../test_taxa_by_node.R | 0 tests/{testthat => test_bak}/test_utilities.R | 0 tests/{testthat => test_bak}/test_zzz.R | 0 tests/testthat/test_class_all_generics.R | 6 ++ tests/testthat/test_class_haplotype_graph.R | 56 ++++++++++++++++++ tests/testthat/test_class_phg_con.R | 23 ++++++++ tests/testthat/test_class_phg_con_local.R | 37 ++++++++++++ tests/testthat/test_phg_con_server.R | 59 +++++++++++++++++++ tests/testthat/test_phg_dataset.R | 4 ++ 20 files changed, 189 insertions(+), 12 deletions(-) rename tests/{testthat => test_bak}/test_brapi_classes.R (100%) rename tests/{testthat => test_bak}/test_brapi_getters_and_setters.R (100%) rename tests/{testthat => test_bak}/test_brapi_methods.R (100%) rename tests/{testthat => test_bak}/test_brapi_utilities.R (100%) rename tests/{testthat => test_bak}/test_graph_builder.R (100%) rename tests/{testthat => test_bak}/test_logging_support.R (100%) rename tests/{testthat => test_bak}/test_path_matrix.R (100%) rename tests/{testthat => test_bak}/test_show_phg_methods.R (100%) rename tests/{testthat => test_bak}/test_stats_and_visulization.R (100%) rename tests/{testthat => test_bak}/test_taxa_by_node.R (100%) rename tests/{testthat => test_bak}/test_utilities.R (100%) rename tests/{testthat => test_bak}/test_zzz.R (100%) create mode 100644 tests/testthat/test_class_all_generics.R create mode 100644 tests/testthat/test_class_haplotype_graph.R create mode 100644 tests/testthat/test_class_phg_con.R create mode 100644 tests/testthat/test_class_phg_con_local.R create mode 100644 tests/testthat/test_phg_con_server.R create mode 100644 tests/testthat/test_phg_dataset.R diff --git a/R/class_phg_con_server.R b/R/class_phg_con_server.R index b86f14b..ee136cf 100644 --- a/R/class_phg_con_server.R +++ b/R/class_phg_con_server.R @@ -57,11 +57,6 @@ setValidity("PHGServerCon", function(object) { errors <- c(errors, msg) } - if (!(port %in% 1:65535)) { - msg <- "Not a valid port number." - errors <- c(errors, msg) - } - if (!(protocol %in% c("http", "https"))) { msg <- "Protocols can only be 'http' or 'https'." errors <- c(errors, msg) @@ -121,17 +116,14 @@ PHGServerCon <- function( if (is.null(port) && protocol == "http") port <- 80 if (is.null(port) && protocol == "https") port <- 443 - if (port %% 1 != 0) { - stop("Invalid port number. Must be a whole number.", call. = FALSE) + if (!(port %in% 1:65535)) { + stop("Not a valid port number", call. = FALSE) } url <- sprintf("%s://%s:%d/brapi/%s", protocol, host, port, version) if (!brapiEndpointExists(url)) { - stop( - "Cannot resolve mandatory endpoint: {serverinfo}", - call. = FALSE - ) + stop("Cannot resolve mandatory endpoint: {serverinfo}", call. = FALSE) } new( diff --git a/R/method_table.R b/R/method_table.R index 52a5fbf..c2757bc 100644 --- a/R/method_table.R +++ b/R/method_table.R @@ -75,7 +75,7 @@ methodTableFromServer <- function(url, showAdvancedMethods) { if (showAdvancedMethods) { return(tibble::as_tibble(methodDf)) } else { - return(tibble::as_tibble(methodDf[methodDf$num_samples > 50, ])) + return(tibble::as_tibble(methodDf[grepl("_PATH$|_PATHS$", methodDf$method_name), ])) } } diff --git a/tests/testthat/test_brapi_classes.R b/tests/test_bak/test_brapi_classes.R similarity index 100% rename from tests/testthat/test_brapi_classes.R rename to tests/test_bak/test_brapi_classes.R diff --git a/tests/testthat/test_brapi_getters_and_setters.R b/tests/test_bak/test_brapi_getters_and_setters.R similarity index 100% rename from tests/testthat/test_brapi_getters_and_setters.R rename to tests/test_bak/test_brapi_getters_and_setters.R diff --git a/tests/testthat/test_brapi_methods.R b/tests/test_bak/test_brapi_methods.R similarity index 100% rename from tests/testthat/test_brapi_methods.R rename to tests/test_bak/test_brapi_methods.R diff --git a/tests/testthat/test_brapi_utilities.R b/tests/test_bak/test_brapi_utilities.R similarity index 100% rename from tests/testthat/test_brapi_utilities.R rename to tests/test_bak/test_brapi_utilities.R diff --git a/tests/testthat/test_graph_builder.R b/tests/test_bak/test_graph_builder.R similarity index 100% rename from tests/testthat/test_graph_builder.R rename to tests/test_bak/test_graph_builder.R diff --git a/tests/testthat/test_logging_support.R b/tests/test_bak/test_logging_support.R similarity index 100% rename from tests/testthat/test_logging_support.R rename to tests/test_bak/test_logging_support.R diff --git a/tests/testthat/test_path_matrix.R b/tests/test_bak/test_path_matrix.R similarity index 100% rename from tests/testthat/test_path_matrix.R rename to tests/test_bak/test_path_matrix.R diff --git a/tests/testthat/test_show_phg_methods.R b/tests/test_bak/test_show_phg_methods.R similarity index 100% rename from tests/testthat/test_show_phg_methods.R rename to tests/test_bak/test_show_phg_methods.R diff --git a/tests/testthat/test_stats_and_visulization.R b/tests/test_bak/test_stats_and_visulization.R similarity index 100% rename from tests/testthat/test_stats_and_visulization.R rename to tests/test_bak/test_stats_and_visulization.R diff --git a/tests/testthat/test_taxa_by_node.R b/tests/test_bak/test_taxa_by_node.R similarity index 100% rename from tests/testthat/test_taxa_by_node.R rename to tests/test_bak/test_taxa_by_node.R diff --git a/tests/testthat/test_utilities.R b/tests/test_bak/test_utilities.R similarity index 100% rename from tests/testthat/test_utilities.R rename to tests/test_bak/test_utilities.R diff --git a/tests/testthat/test_zzz.R b/tests/test_bak/test_zzz.R similarity index 100% rename from tests/testthat/test_zzz.R rename to tests/test_bak/test_zzz.R diff --git a/tests/testthat/test_class_all_generics.R b/tests/testthat/test_class_all_generics.R new file mode 100644 index 0000000..24d783e --- /dev/null +++ b/tests/testthat/test_class_all_generics.R @@ -0,0 +1,6 @@ +test_that("Basic tests", { + test <- "test" + + expect_equal(test, "test") +}) + diff --git a/tests/testthat/test_class_haplotype_graph.R b/tests/testthat/test_class_haplotype_graph.R new file mode 100644 index 0000000..2598c27 --- /dev/null +++ b/tests/testthat/test_class_haplotype_graph.R @@ -0,0 +1,56 @@ +test_that("Basic tests", { + logFile <- tempfile(fileext = ".txt") + configFile <- tempfile() + + startLogger(logFile) + createConfigFile(configFile) + + phgLocCon <- PHGLocalCon(configFile) + phgSrvCon <- PHGServerCon("phg.maizegdb.org") + + phgMethod1 <- PHGMethod(phgLocCon, "CONSENSUS") + phgMethod2 <- PHGMethod(phgLocCon, "PATH_METHOD") + phgMethod3 <- PHGMethod(phgSrvCon, "NAM_GBS_Alignments_PATHS") + + myGraph1 <- buildHaplotypeGraph(phgMethod1) + myGraph2 <- buildHaplotypeGraph(phgMethod2) + + expect_true(is(myGraph1, "HaplotypeGraph")) + expect_true(is(myGraph2, "HaplotypeGraph")) + expect_error(buildHaplotypeGraph(phgMethod3), regexp = "Graphs can only") + + myGraph1Output <- utils::capture.output(myGraph1) + expect_equal(length(myGraph1Output), 6) + + expect_true(is(javaMemoryAddress(myGraph1), "character")) + expect_true(is(javaRefObj(myGraph1), "jobjRef")) + + expect_true(is(numberOfChromosomes(myGraph1), "numeric")) + expect_equal(numberOfChromosomes(myGraph1), 1) + + expect_true(is(numberOfNodes(myGraph1), "numeric")) + expect_equal(numberOfNodes(myGraph1), 30) + + expect_true(is(numberOfRefRanges(myGraph1), "numeric")) + expect_equal(numberOfRefRanges(myGraph1), 10) + + expect_true(is(numberOfTaxa(myGraph1), "numeric")) + expect_equal(numberOfTaxa(myGraph1), 6) + + expect_true(is(phgMethodId(myGraph1), "character")) + expect_equal(phgMethodId(myGraph1), "CONSENSUS") + + expect_true(is(phgMethodType(myGraph1), "character")) + expect_equal(phgMethodType(myGraph1), "CONSENSUS_ANCHOR_SEQUENCE") + + expect_true(is(readHaplotypeIds(myGraph1), "matrix")) + expect_equal(dim(readHaplotypeIds(myGraph1)), c(6, 10)) + + expect_true(is(readSamples(myGraph1), "character")) + expect_equal(length(readSamples(myGraph1)), 6) + + expect_true(is(readRefRanges(myGraph1), "GRanges")) + expect_true(is(readPHGDataSet(myGraph1), "PHGDataSet")) +}) + + diff --git a/tests/testthat/test_class_phg_con.R b/tests/testthat/test_class_phg_con.R new file mode 100644 index 0000000..6fecf51 --- /dev/null +++ b/tests/testthat/test_class_phg_con.R @@ -0,0 +1,23 @@ +test_that("Basic tests", { + testPhgCon <- methods::new( + "PHGCon", + phgType = "local", + host = "localhost" + ) + + expect_true(is(testPhgCon, "PHGCon")) + expect_error( + object = methods::new( + "PHGCon", + phgType = "locallll", + host = "localhost" + ), + regexp = "Given PHG connection type is not allowed" + ) + + expect_true(is(host(testPhgCon), "character")) + expect_equal(host(testPhgCon), "localhost") + expect_true(is(phgType(testPhgCon), "character")) + expect_equal(phgType(testPhgCon), "local") +}) + diff --git a/tests/testthat/test_class_phg_con_local.R b/tests/testthat/test_class_phg_con_local.R new file mode 100644 index 0000000..b1a20dd --- /dev/null +++ b/tests/testthat/test_class_phg_con_local.R @@ -0,0 +1,37 @@ +test_that("Basic tests", { + logFile <- tempfile(fileext = ".txt") + configFile <- tempfile() + configFileBad <- "not/a/path" + # configFileBad <- tempfile() + # writeLines( + # c( + # "host=localhost", + # "DBtype=sqlite", + # "DB=phg_db", + # "user=user", + # "password=pass" + # ), + # con = configFileBad + # ) + + startLogger(logFile) + createConfigFile(configFile) + + phgLocCon <- PHGLocalCon(configFile) + phgLocConOutput <- utils::capture.output(phgLocCon) + + expect_true(inherits(phgLocCon, "PHGCon")) + expect_true(is(phgLocCon, "PHGLocalCon")) + expect_error( + object = PHGLocalCon(configFileBad), + regexp = "Path to config file does not exist" + ) + expect_equal(length(phgLocConOutput), 4) + + expect_true(is(configFilePath(phgLocCon), "character")) + expect_true(is(dbName(phgLocCon), "character")) + expect_true(is(dbType(phgLocCon), "character")) + expect_true(is(showPHGMethods(phgLocCon), "tbl")) +}) + + diff --git a/tests/testthat/test_phg_con_server.R b/tests/testthat/test_phg_con_server.R new file mode 100644 index 0000000..f4e082c --- /dev/null +++ b/tests/testthat/test_phg_con_server.R @@ -0,0 +1,59 @@ +test_that("Basic tests", { + logFile <- tempfile(fileext = ".txt") + startLogger(logFile) + + testUrl <- "phg.maizegdb.org" + + phgSrvCon <- PHGServerCon(testUrl) + phgSrvConOutput <- utils::capture.output(phgSrvCon) + + expect_true(is(phgSrvCon, "PHGServerCon")) + expect_true(inherits(phgSrvCon, "PHGCon")) + expect_true(is(brapiURL(phgSrvCon), "character")) + expect_true(is(brapiVersion(phgSrvCon), "character")) + expect_true(is(port(phgSrvCon), "numeric")) + expect_true(is(httProtocol(phgSrvCon), "character")) + expect_true(is(serverInfo(phgSrvCon), "tbl")) + expect_true(is(showPHGMethods(phgSrvCon), "tbl")) + + expect_equal(length(phgSrvConOutput), 3) + expect_equal( + object = httProtocol(PHGServerCon(testUrl, protocol = "https")), + expected = "https" + ) + expect_equal( + object = httProtocol(PHGServerCon(testUrl, protocol = "http")), + expected = "http" + ) + expect_equal( + object = httProtocol(phgSrvCon), + expected = "https" + ) + expect_equal( + object = port(PHGServerCon(testUrl, protocol = "https")), + expected = 443 + ) + expect_equal( + object = port(phgSrvCon), + expected = 443 + ) + expect_equal( + object = port(PHGServerCon(testUrl, protocol = "http")), + expected = 80 + ) + expect_error( + object = PHGServerCon(testUrl, port = -1), + regexp = "Not a valid port number" + ) + expect_error( + object = PHGServerCon(testUrl, protocol = "htp"), + regexp = "Protocols can only be 'http' or 'https'" + ) + expect_error( + object = PHGServerCon(testUrl, version = "v3"), + regexp = "Versions 1 or 2 are only allowed" + ) + +}) + + diff --git a/tests/testthat/test_phg_dataset.R b/tests/testthat/test_phg_dataset.R new file mode 100644 index 0000000..7437f52 --- /dev/null +++ b/tests/testthat/test_phg_dataset.R @@ -0,0 +1,4 @@ +test_that("Basic tests.", { + +}) + From ec97c43ba3335f7f922c8ce6b1d582b09ce396ee Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 8 Sep 2023 16:45:59 -0400 Subject: [PATCH 28/35] Add new tests --- NAMESPACE | 11 +- R/class_all_generics.R | 14 + R/class_phg_dataset.R | 42 + R/constants.R | 1 + R/deprecated_stats_and_visualization.R | 727 +++++++++--------- R/flapjack_export.R | 35 - R/logging_support.R | 28 +- R/vis_plot_graph.R | 131 ++++ README.md | 13 +- man/HaplotypeGraph-class.Rd | 2 +- man/HaplotypeGraph-validity.Rd | 2 +- man/buildHaplotypeGraph.Rd | 2 +- man/javaMemoryAddress.Rd | 2 +- man/javaRefObj.Rd | 2 +- man/numberOfChromosomes.Rd | 2 +- man/numberOfNodes.Rd | 2 +- man/numberOfRefRanges.Rd | 2 +- man/numberOfTaxa.Rd | 2 +- man/phgMethodId.Rd | 4 +- man/phgMethodType.Rd | 2 +- man/plotGraph.Rd | 34 +- man/readHaplotypeIds.Rd | 4 +- man/readMappingTableInfo.Rd | 20 - man/readMappingsForLineName.Rd | 39 - man/readPHGDataSet.Rd | 4 +- man/readRefRanges.Rd | 4 +- man/readSamples.Rd | 4 +- man/searchRecombination.Rd | 33 - man/searchSimilarGametes.Rd | 38 - man/startLogger.Rd | 4 +- tests/testthat/test_class_haplotype_graph.R | 5 +- ...n_server.R => test_class_phg_con_server.R} | 23 +- tests/testthat/test_class_phg_dataset.R | 34 + tests/testthat/test_class_phg_method.R | 40 + tests/testthat/test_logging_support.R | 9 + tests/testthat/test_phg_dataset.R | 4 - tests/testthat/test_zzz.R | 5 + vignettes/rphg_config_files.R | 10 + vignettes/rphg_config_files.Rmd | 77 ++ vignettes/rphg_installation.R | 23 + vignettes/rphg_installation.Rmd | 183 +++++ vignettes/rphg_walkthrough.R | 161 ++-- vignettes/rphg_walkthrough.Rmd | 679 +++------------- 43 files changed, 1162 insertions(+), 1301 deletions(-) delete mode 100644 R/flapjack_export.R create mode 100644 R/vis_plot_graph.R delete mode 100644 man/readMappingTableInfo.Rd delete mode 100644 man/readMappingsForLineName.Rd delete mode 100644 man/searchRecombination.Rd delete mode 100644 man/searchSimilarGametes.Rd rename tests/testthat/{test_phg_con_server.R => test_class_phg_con_server.R} (73%) create mode 100644 tests/testthat/test_class_phg_dataset.R create mode 100644 tests/testthat/test_class_phg_method.R create mode 100644 tests/testthat/test_logging_support.R delete mode 100644 tests/testthat/test_phg_dataset.R create mode 100644 tests/testthat/test_zzz.R create mode 100644 vignettes/rphg_config_files.R create mode 100644 vignettes/rphg_config_files.Rmd create mode 100644 vignettes/rphg_installation.R create mode 100644 vignettes/rphg_installation.Rmd diff --git a/NAMESPACE b/NAMESPACE index a097ed7..aa566ad 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,13 +27,9 @@ export(phgType) export(plotGraph) export(port) export(readHaplotypeIds) -export(readMappingTableInfo) -export(readMappingsForLineName) export(readPHGDataSet) export(readRefRanges) export(readSamples) -export(searchRecombination) -export(searchSimilarGametes) export(serverInfo) export(showPHGMethods) export(startLogger) @@ -63,6 +59,7 @@ exportMethods(phgConObj) exportMethods(phgMethodId) exportMethods(phgMethodType) exportMethods(phgType) +exportMethods(plotGraph) exportMethods(port) exportMethods(readHaplotypeIds) exportMethods(readPHGDataSet) @@ -73,17 +70,11 @@ exportMethods(showPHGMethods) importFrom(GenomicRanges,GRanges) importFrom(IRanges,IRanges) importFrom(IRanges,subsetByOverlaps) -importFrom(S4Vectors,DataFrame) importFrom(S4Vectors,metadata) -importFrom(SummarizedExperiment,assay) importFrom(SummarizedExperiment,rowRanges) importFrom(curl,has_internet) -importFrom(magrittr,"%>%") importFrom(methods,setClass) importFrom(rJava,.jcall) importFrom(rJava,.jnew) importFrom(rJava,J) importFrom(tibble,as_tibble) -importFrom(visNetwork,visEdges) -importFrom(visNetwork,visHierarchicalLayout) -importFrom(visNetwork,visNetwork) diff --git a/R/class_all_generics.R b/R/class_all_generics.R index ff3e3e1..a7a4a81 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -271,6 +271,20 @@ setGeneric("phgMethodType", function(object, ...) standardGeneric("phgMethodType setGeneric("phgType", function(object, ...) standardGeneric("phgType")) +## ---- +#' @title Plot a graph object +#' +#' @description +#' Generates a visualization of a recapitulated graph object +#' +#' @param object an \code{rPHG} data set object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname plotGraph +#' @export +setGeneric("plotGraph", function(object, ...) standardGeneric("plotGraph")) + + ## ---- #' @title Return port value #' diff --git a/R/class_phg_dataset.R b/R/class_phg_dataset.R index f4829a9..ccb0c1f 100644 --- a/R/class_phg_dataset.R +++ b/R/class_phg_dataset.R @@ -40,3 +40,45 @@ setMethod( ) +## ---- +#' @param object A \code{PHGDataSet} object +#' @param samples Samples/taxa to include in plot +#' @param sampleHighlight Sample path to highlight +#' @param seqnames A sequence (e.g. chromosome) ID +#' @param start Start position for ref ranges +#' @param end End position for ref ranges +#' @param colMajor Highlight path color +#' @param colMinor Muted path color +#' @param ... Additional parameters to pass for ref range inclusion +#' +#' @rdname plotGraph +#' @export +setMethod( + f = "plotGraph", + signature = signature(object = "PHGDataSet"), + definition = function( + object, + samples = NULL, + sampleHighlight = NULL, + seqnames = NULL, + start = NULL, + end = NULL, + colMajor = "maroon", + colMinor = "lightgrey" + ) { + return( + plotGraphCore( + object, + samples, + sampleHighlight, + seqnames, + start, + end, + colMajor, + colMinor + ) + ) + } +) + + diff --git a/R/constants.R b/R/constants.R index 3166658..26c46da 100644 --- a/R/constants.R +++ b/R/constants.R @@ -24,6 +24,7 @@ TASSEL_API <- list( "DB_LOADING_UTILS" = "net/maizegenetics/pangenome/db_loading/DBLoadingUtils", "FRAME" = "java/awt/Frame", "HAPLOTYPE_GRAPH_BUILDER" = "net/maizegenetics/pangenome/api/HaplotypeGraphBuilderPlugin", + "LOGGING_UTILS" = "net/maizegenetics/util/LoggingUtils", "METHOD_TABLE_REPORT" = "net/maizegenetics/pangenome/api/MethodTableReportPlugin", "PARAMETER_CACHE" = "net/maizegenetics/plugindef/ParameterCache", "R_METHODS" = "net/maizegenetics/pangenome/api/RMethods", diff --git a/R/deprecated_stats_and_visualization.R b/R/deprecated_stats_and_visualization.R index 488aebf..a25bc6b 100644 --- a/R/deprecated_stats_and_visualization.R +++ b/R/deprecated_stats_and_visualization.R @@ -232,363 +232,398 @@ -## Function to say if haplotypes same, discarding comparisons with -1 -# gamHapIDs and targetHapIDs are both vectors of haplotype IDs. -# The output is the fraction of hapIDs that are different -# With ranges that contain -1 not included in the fraction -calcDiff <- function(gamHapIDs, targetHapIDs) { - keep <- which(gamHapIDs != -1 & targetHapIDs != -1) - if (length(keep) == 0) { - return(Inf) - } - return(sum(gamHapIDs[keep] != targetHapIDs[keep]) / length(keep)) -} - - - -#' @title Search for similar gamets -#' -#' @description Search for inbred lines (gametes) that are similar to a -#' specified gamete in specified reference ranges. Supply either a haplotype -#' ID matrix or a phgObject from which to extract it. Specify a gamete name -#' and reference ranges. The difference between haplotypes is either 0 (same) -#' or 1 (different). Fraction of ranges that are different has to be lower or -#' equal to fractionDiff. Ranges with unknown haplotypes (-1) do not count in -#' the fraction. If all pairwise range comparisons have -1 the lines are -#' considered dissimilar. -#' -#' @param gameteName A specified gamete name -#' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. If -#' \code{NULL}, A hap ID matrix will be generated (if you have supplied a -#' PHG object). -#' @param phgObject A PHG object. -#' @param refRanges Specifed reference ranges. -#' @param fractionDiff The difference between haplotypes (either 0 or 1). See -#' description for further details. -#' -#' @importFrom magrittr %>% -#' @importFrom S4Vectors metadata -#' -#' @export -searchSimilarGametes <- function(phgObject = NULL, - refRanges, - gameteName, - fractionDiff = 0, - phgHapIDMat = NULL) { - if (is.null(phgHapIDMat)) { - if (is.null(phgObject)) { - stop("Must supply phgHapIDMat or phgObject") - } - phgHapIDMat <- hapIDMatrix(phgObject = S4Vectors::metadata(phgObject)$jObj) - } - - # The row the target gamete is in - gameteRow <- which(rownames(phgHapIDMat) == gameteName) - if (length(gameteRow) == 0) { - stop(paste0("Gamete ", gameteName, " not in the PHG")) - } - - # Only deal with specified reference ranges - phgHapIDMat <- phgHapIDMat[, refRanges, drop = FALSE] - targetHapIDs <- phgHapIDMat[gameteRow, , drop = FALSE] - - # Calculate differences across all gametes in the table - fracDiffs <- apply(phgHapIDMat, 1, calcDiff, targetHapIDs = targetHapIDs) - areSimilar <- which(fracDiffs <= fractionDiff) %>% setdiff(gameteRow) - - # Return names of gametes that are similar to the target - return(rownames(phgHapIDMat)[areSimilar]) -} - - - -#' @title Search for recombination -#' -#' @description Search for inbred lines (gametes) that are the same in one -#' range but different in another. Such lines have experienced recombination -#' in the past relative to each other. Must specify a gamete name and -#' reference ranges. -#' -#' @param gameteName A specified gamete name -#' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. If -#' \code{NULL}, A hap ID matrix will be generated (if you have supplied a -#' PHG object). -#' @param phgObject A PHG object. -#' @param refRangeSame See description for further details. -#' @param refRangeDiff See description for further details. -#' -#' @importFrom magrittr %>% -#' @importFrom S4Vectors metadata -#' -#' @export -searchRecombination <- function(phgObject = NULL, - gameteName, - refRangeSame, - refRangeDiff, - phgHapIDMat = NULL) { - if (is.null(phgHapIDMat)) { - if (is.null(phgObject)) { - stop("Must supply phgHapIDMat or phgObject") - } - phgHapIDMat <- hapIDMatrix(phgObject = phgObject) - } - - gametesSame <- searchSimilarGametes( - gameteName, - phgHapIDMat, - refRanges = refRangeSame - ) %>% - setdiff(gameteName) - - targetDiff <- phgHapIDMat[gameteName, refRangeDiff] - - gametesDiff <- sapply( - phgHapIDMat[gametesSame, refRangeDiff], - calcDiff, - targetHapIDs = targetDiff - ) - - return(gametesSame[gametesDiff == 1]) -} - - -# ---- -#' @title Visualize Graph Data -#' -#' @description -#' Generates an interactive network plot for a given set of reference ranges -#' and a set of taxa. -#' -#' @param x A \code{PHGDataSet} object -#' @param samples Samples/taxa to include in plot -#' @param sampleHighlight Sample path to highlight -#' @param seqnames A sequence (e.g. chromosome) ID -#' @param start Start position for ref ranges -#' @param end End position for ref ranges -#' @param colMajor Highlight path color -#' @param colMinor Muted path color -#' @param ... Additional parameters to pass for ref range inclusion -#' -#' @importFrom IRanges subsetByOverlaps -#' @importFrom GenomicRanges GRanges -#' @importFrom SummarizedExperiment assay -#' @importFrom visNetwork visEdges -#' @importFrom visNetwork visHierarchicalLayout -#' @importFrom visNetwork visNetwork -#' -#' @export -plotGraph <- function( - x, - samples = NULL, - sampleHighlight = NULL, - seqnames = NULL, - start = NULL, - end = NULL, - colMajor = "maroon", - colMinor = "lightgrey", - ... -) { - # # Testing - # start <- 100 - # end <- 1000000 - # seqnames <- "1" - # # samples <- c("Z001E0001", "Z001E0028", "Z001E0080") - # # samples <- NULL - # set.seed(123) - # samples <- sample(colnames(x), 100) - # # sampleHighlight <- c("Z001E0001") - # sampleHighlight <- sample(samples, 1) - - # Filter by taxa and ref ranges - if (is.null(samples)) samples <- colnames(x) - hapTableMini <- x[, colnames(x) %in% samples] - hapTableMini <- IRanges::subsetByOverlaps( - hapTableMini, - GenomicRanges::GRanges(seqnames = seqnames, ranges = start:end) - ) - - # Get hap ID matrix - currentMatrix <- t(SummarizedExperiment::assay(hapTableMini)) - currentMatrix[is.na(currentMatrix)] <- -128 - colnames(currentMatrix) <- gsub("R", "", colnames(currentMatrix)) |> - as.numeric() - - # Get ref range data frame - refRangeDataMini <- rowRanges(hapTableMini) |> as.data.frame() - - # Group taxa by hap ID and ref range - taxaGroups <- lapply(seq_len(ncol(currentMatrix)), function(i) { - split(rownames(currentMatrix), currentMatrix[, i]) - }) - - # Generate distinct IDs (hap ID + ref range ID) - hapIds <- currentMatrix |> apply(2, unique, simplify = FALSE) - hapLevels <- rep(names(hapIds), vapply(hapIds, length, integer(1))) |> as.numeric() - fullHapIds <- paste0( - lapply(hapIds, function(i) i[order(i)]) |> unlist(), - "_", hapLevels - ) - - # HTML tooltip processing - taxaToHtml <- function(x) { - vapply(x, function(i) { - paste0("Taxa: ", paste(i, collapse = ", "), "

") - }, character(1)) - } - tooltipVec <- lapply(taxaGroups, taxaToHtml) |> unlist() - - refRangeHtml <- lapply(hapLevels, function(i) { - paste0( - "

Chr: ", - refRangeDataMini[i, ]$seqnames, - "
", - "Range: ", - refRangeDataMini[i, ]$start, - " - ", - refRangeDataMini[i, ]$end, - "
" - ) - }) |> unlist() - - # Final graph data (nodes) - nodes <- data.frame( - id = seq_along(fullHapIds), - label = fullHapIds, - level = hapLevels, - title = paste0(refRangeHtml, tooltipVec) - ) - - if (!is.null(sampleHighlight)) { - for (i in sampleHighlight) { - nodes$group <- ifelse(grepl(i, nodes$title), i, NA) - nodes$color <- ifelse(grepl(i, nodes$title), colMajor, colMinor) - } - nodes$title <- gsub(i, paste0("", i, ""), nodes$title) - } else { - nodes$color <- colMajor - } - - # Final graph data (edges) - lne <- c() - rne <- c() - for (i in seq_len(ncol(currentMatrix) - 1)) { - ln <- paste0(currentMatrix[, i], "_", i) - rn <- paste0(currentMatrix[, i + 1], "_", i + 1) - - cnxn <- paste0(ln, "+", rn) |> unique() - - for (c in cnxn) { - splits <- strsplit(c, "\\+") |> unlist() - f <- which(fullHapIds == splits[1]) - t <- which(fullHapIds == splits[2]) - lne <- c(lne, f) - rne <- c(rne, t) - } - } +## ## Function to say if haplotypes same, discarding comparisons with -1 +## # gamHapIDs and targetHapIDs are both vectors of haplotype IDs. +## # The output is the fraction of hapIDs that are different +## # With ranges that contain -1 not included in the fraction +## calcDiff <- function(gamHapIDs, targetHapIDs) { +## keep <- which(gamHapIDs != -1 & targetHapIDs != -1) +## if (length(keep) == 0) { +## return(Inf) +## } +## return(sum(gamHapIDs[keep] != targetHapIDs[keep]) / length(keep)) +## } - edges <- data.frame( - from = lne, - to = rne - ) - # Return vis.js object - visNetwork::visNetwork(nodes, edges) |> - visNetwork::visEdges(arrows = "to") |> - visNetwork::visHierarchicalLayout(direction = "LR") -} +## #' @title Search for similar gamets +## #' +## #' @description Search for inbred lines (gametes) that are similar to a +## #' specified gamete in specified reference ranges. Supply either a haplotype +## #' ID matrix or a phgObject from which to extract it. Specify a gamete name +## #' and reference ranges. The difference between haplotypes is either 0 (same) +## #' or 1 (different). Fraction of ranges that are different has to be lower or +## #' equal to fractionDiff. Ranges with unknown haplotypes (-1) do not count in +## #' the fraction. If all pairwise range comparisons have -1 the lines are +## #' considered dissimilar. +## #' +## #' @param gameteName A specified gamete name +## #' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. If +## #' \code{NULL}, A hap ID matrix will be generated (if you have supplied a +## #' PHG object). +## #' @param phgObject A PHG object. +## #' @param refRanges Specifed reference ranges. +## #' @param fractionDiff The difference between haplotypes (either 0 or 1). See +## #' description for further details. +## #' +## #' @importFrom magrittr %>% +## #' @importFrom S4Vectors metadata +## #' +## #' @export +## searchSimilarGametes <- function(phgObject = NULL, +## refRanges, +## gameteName, +## fractionDiff = 0, +## phgHapIDMat = NULL) { +## if (is.null(phgHapIDMat)) { +## if (is.null(phgObject)) { +## stop("Must supply phgHapIDMat or phgObject") +## } +## phgHapIDMat <- hapIDMatrix(phgObject = S4Vectors::metadata(phgObject)$jObj) +## } +## +## # The row the target gamete is in +## gameteRow <- which(rownames(phgHapIDMat) == gameteName) +## if (length(gameteRow) == 0) { +## stop(paste0("Gamete ", gameteName, " not in the PHG")) +## } +## +## # Only deal with specified reference ranges +## phgHapIDMat <- phgHapIDMat[, refRanges, drop = FALSE] +## targetHapIDs <- phgHapIDMat[gameteRow, , drop = FALSE] +## +## # Calculate differences across all gametes in the table +## fracDiffs <- apply(phgHapIDMat, 1, calcDiff, targetHapIDs = targetHapIDs) +## areSimilar <- which(fracDiffs <= fractionDiff) %>% setdiff(gameteRow) +## +## # Return names of gametes that are similar to the target +## return(rownames(phgHapIDMat)[areSimilar]) +## } -## ---- -#' @title Retrieve read mapping information from PHG database. -#' -#' @description Returns an \code{S4Vectors} \code{DataFrame} object of read -#' mapping information for a given line (i.e. taxon). -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' @param lineName The name of the line (taxon) for which the read mapping -#' information is to be retrieved. If there are multiple read mappings with -#' different \code{file_group_names}, they will be combined. -#' @param readMappingMethodName The method name for the read mappings -#' (only takes a single method). -#' @param haplotypeMethodName The haplotype method name. -#' @param fileGroup the name of the file group for the line from the database. -#' This parameter is only necessary if the line (taxon) has more than one -#' file group and only the reads for a specific file group are wanted. -#' -#' @importFrom rJava J -#' @importFrom S4Vectors DataFrame -#' -#' @export -readMappingsForLineName <- function(configFile, - lineName, - readMappingMethodName, - haplotypeMethodName, - fileGroup = NULL) { - configCatcher(configFile) - # Retrieve Java data vector object(s) - rmObj <- rJava::J( - "net.maizegenetics.pangenome.api/RMethods", - "readMappingsForLineName", - configFile, - lineName, - readMappingMethodName, - haplotypeMethodName, - fileGroup - ) +## #' @title Search for recombination +## #' +## #' @description Search for inbred lines (gametes) that are the same in one +## #' range but different in another. Such lines have experienced recombination +## #' in the past relative to each other. Must specify a gamete name and +## #' reference ranges. +## #' +## #' @param gameteName A specified gamete name +## #' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. If +## #' \code{NULL}, A hap ID matrix will be generated (if you have supplied a +## #' PHG object). +## #' @param phgObject A PHG object. +## #' @param refRangeSame See description for further details. +## #' @param refRangeDiff See description for further details. +## #' +## #' @importFrom magrittr %>% +## #' @importFrom S4Vectors metadata +## #' +## #' @export +## searchRecombination <- function(phgObject = NULL, +## gameteName, +## refRangeSame, +## refRangeDiff, +## phgHapIDMat = NULL) { +## if (is.null(phgHapIDMat)) { +## if (is.null(phgObject)) { +## stop("Must supply phgHapIDMat or phgObject") +## } +## phgHapIDMat <- hapIDMatrix(phgObject = phgObject) +## } +## +## gametesSame <- searchSimilarGametes( +## gameteName, +## phgHapIDMat, +## refRanges = refRangeSame +## ) %>% +## setdiff(gameteName) +## +## targetDiff <- phgHapIDMat[gameteName, refRangeDiff] +## +## gametesDiff <- sapply( +## phgHapIDMat[gametesSame, refRangeDiff], +## calcDiff, +## targetHapIDs = targetDiff +## ) +## +## return(gametesSame[gametesDiff == 1]) +## } - # Configure for R - colNum <- rmObj$dataVectors$size() - rmDF <- lapply(seq_len(colNum), function(i) { - rmObj$dataVectors$get(as.integer(i - 1)) - }) - rmDF <- data.frame(rmDF) - colnames(rmDF) <- rmObj$columnNames - # Return - return(S4Vectors::DataFrame(rmDF)) -} +## # ---- +## #' @title Visualize Graph Data +## #' +## #' @description +## #' Generates an interactive network plot for a given set of reference ranges +## #' and a set of taxa. +## #' +## #' @param x A \code{PHGDataSet} object +## #' @param samples Samples/taxa to include in plot +## #' @param sampleHighlight Sample path to highlight +## #' @param seqnames A sequence (e.g. chromosome) ID +## #' @param start Start position for ref ranges +## #' @param end End position for ref ranges +## #' @param colMajor Highlight path color +## #' @param colMinor Muted path color +## #' @param ... Additional parameters to pass for ref range inclusion +## #' +## #' @importFrom IRanges subsetByOverlaps +## #' @importFrom GenomicRanges GRanges +## #' @importFrom SummarizedExperiment assay +## #' @importFrom visNetwork visEdges +## #' @importFrom visNetwork visHierarchicalLayout +## #' @importFrom visNetwork visNetwork +## #' +## #' @export +## plotGraph <- function( +## x, +## samples = NULL, +## sampleHighlight = NULL, +## seqnames = NULL, +## start = NULL, +## end = NULL, +## colMajor = "maroon", +## colMinor = "lightgrey", +## ... +## ) { +## # # Testing +## # start <- 100 +## # end <- 1000000 +## # seqnames <- "1" +## # # samples <- c("Z001E0001", "Z001E0028", "Z001E0080") +## # # samples <- NULL +## # set.seed(123) +## # samples <- sample(colnames(x), 100) +## # # sampleHighlight <- c("Z001E0001") +## # sampleHighlight <- sample(samples, 1) +## +## # Filter by taxa and ref ranges +## if (is.null(samples)) samples <- colnames(x) +## hapTableMini <- x[, colnames(x) %in% samples] +## hapTableMini <- IRanges::subsetByOverlaps( +## hapTableMini, +## GenomicRanges::GRanges(seqnames = seqnames, ranges = start:end) +## ) +## +## # Get hap ID matrix +## currentMatrix <- t(SummarizedExperiment::assay(hapTableMini)) +## currentMatrix[is.na(currentMatrix)] <- -128 +## colnames(currentMatrix) <- gsub("R", "", colnames(currentMatrix)) |> +## as.numeric() +## +## # Get ref range data frame +## refRangeDataMini <- rowRanges(hapTableMini) |> as.data.frame() +## +## # Group taxa by hap ID and ref range +## taxaGroups <- lapply(seq_len(ncol(currentMatrix)), function(i) { +## split(rownames(currentMatrix), currentMatrix[, i]) +## }) +## +## # Generate distinct IDs (hap ID + ref range ID) +## hapIds <- currentMatrix |> apply(2, unique, simplify = FALSE) +## hapLevels <- rep(names(hapIds), vapply(hapIds, length, integer(1))) |> as.numeric() +## fullHapIds <- paste0( +## lapply(hapIds, function(i) i[order(i)]) |> unlist(), +## "_", hapLevels +## ) +## +## # HTML tooltip processing +## taxaToHtml <- function(x) { +## vapply(x, function(i) { +## paste0("Taxa: ", paste(i, collapse = ", "), "

") +## }, character(1)) +## } +## tooltipVec <- lapply(taxaGroups, taxaToHtml) |> unlist() +## +## refRangeHtml <- lapply(hapLevels, function(i) { +## paste0( +## "

Chr: ", +## refRangeDataMini[i, ]$seqnames, +## "
", +## "Range: ", +## refRangeDataMini[i, ]$start, +## " - ", +## refRangeDataMini[i, ]$end, +## "
" +## ) +## }) |> unlist() +## +## # Final graph data (nodes) +## nodes <- data.frame( +## id = seq_along(fullHapIds), +## label = fullHapIds, +## level = hapLevels, +## title = paste0(refRangeHtml, tooltipVec) +## ) +## +## if (!is.null(sampleHighlight)) { +## for (i in sampleHighlight) { +## nodes$group <- ifelse(grepl(i, nodes$title), i, NA) +## nodes$color <- ifelse(grepl(i, nodes$title), colMajor, colMinor) +## } +## nodes$title <- gsub(i, paste0("", i, ""), nodes$title) +## } else { +## nodes$color <- colMajor +## } +## +## # Final graph data (edges) +## lne <- c() +## rne <- c() +## for (i in seq_len(ncol(currentMatrix) - 1)) { +## ln <- paste0(currentMatrix[, i], "_", i) +## rn <- paste0(currentMatrix[, i + 1], "_", i + 1) +## +## cnxn <- paste0(ln, "+", rn) |> unique() +## +## for (c in cnxn) { +## splits <- strsplit(c, "\\+") |> unlist() +## f <- which(fullHapIds == splits[1]) +## t <- which(fullHapIds == splits[2]) +## lne <- c(lne, f) +## rne <- c(rne, t) +## } +## } +## +## edges <- data.frame( +## from = lne, +## to = rne +## ) +## +## # Return vis.js object +## visNetwork::visNetwork(nodes, edges) |> +## visNetwork::visEdges(arrows = "to") |> +## visNetwork::visHierarchicalLayout(direction = "LR") +## } -## ---- -#' @title Retrieve read mapping records from PHG database. -#' -#' @description Returns an \code{S4Vectors} \code{DataFrame} object of read -#' mapping record information without \code{read_mapping} data. -#' -#' @author Brandon Monier -#' @author Peter Bradbury -#' -#' @param configFile Path to a configuration file for your graph database. -#' -#' @importFrom rJava J -#' @importFrom S4Vectors DataFrame -#' -#' @export -readMappingTableInfo <- function(configFile) { +## ## ---- +## #' @title Retrieve read mapping information from PHG database. +## #' +## #' @description Returns an \code{S4Vectors} \code{DataFrame} object of read +## #' mapping information for a given line (i.e. taxon). +## #' +## #' @author Brandon Monier +## #' @author Peter Bradbury +## #' +## #' @param configFile Path to a configuration file for your graph database. +## #' @param lineName The name of the line (taxon) for which the read mapping +## #' information is to be retrieved. If there are multiple read mappings with +## #' different \code{file_group_names}, they will be combined. +## #' @param readMappingMethodName The method name for the read mappings +## #' (only takes a single method). +## #' @param haplotypeMethodName The haplotype method name. +## #' @param fileGroup the name of the file group for the line from the database. +## #' This parameter is only necessary if the line (taxon) has more than one +## #' file group and only the reads for a specific file group are wanted. +## #' +## #' @importFrom rJava J +## #' @importFrom S4Vectors DataFrame +## #' +## #' @export +## readMappingsForLineName <- function(configFile, +## lineName, +## readMappingMethodName, +## haplotypeMethodName, +## fileGroup = NULL) { +## +## configCatcher(configFile) +## +## # Retrieve Java data vector object(s) +## rmObj <- rJava::J( +## "net.maizegenetics.pangenome.api/RMethods", +## "readMappingsForLineName", +## configFile, +## lineName, +## readMappingMethodName, +## haplotypeMethodName, +## fileGroup +## ) +## +## # Configure for R +## colNum <- rmObj$dataVectors$size() +## rmDF <- lapply(seq_len(colNum), function(i) { +## rmObj$dataVectors$get(as.integer(i - 1)) +## }) +## rmDF <- data.frame(rmDF) +## colnames(rmDF) <- rmObj$columnNames +## +## # Return +## return(S4Vectors::DataFrame(rmDF)) +## } - # Catch potential errors - configCatcher(configFile) - # Retrieve Java data vector object(s) - rmObj <- rJava::J( - "net.maizegenetics.pangenome.api/RMethods", - "readMappingTableInfo", - configFile - ) +## ## ---- +## #' @title Retrieve read mapping records from PHG database. +## #' +## #' @description Returns an \code{S4Vectors} \code{DataFrame} object of read +## #' mapping record information without \code{read_mapping} data. +## #' +## #' @author Brandon Monier +## #' @author Peter Bradbury +## #' +## #' @param configFile Path to a configuration file for your graph database. +## #' +## #' @importFrom rJava J +## #' @importFrom S4Vectors DataFrame +## #' +## #' @export +## readMappingTableInfo <- function(configFile) { +## +## # Catch potential errors +## configCatcher(configFile) +## +## # Retrieve Java data vector object(s) +## rmObj <- rJava::J( +## "net.maizegenetics.pangenome.api/RMethods", +## "readMappingTableInfo", +## configFile +## ) +## +## # Configure for R +## colNum <- rmObj$dataVectors$size() +## rmDF <- lapply(seq_len(colNum), function(i) { +## rmObj$dataVectors$get(as.integer(i - 1)) +## }) +## rmDF <- data.frame(rmDF) +## colnames(rmDF) <- rmObj$columnNames +## +## # Return +## return(tibble::as_tibble(rmDF)) +## } - # Configure for R - colNum <- rmObj$dataVectors$size() - rmDF <- lapply(seq_len(colNum), function(i) { - rmObj$dataVectors$get(as.integer(i - 1)) - }) - rmDF <- data.frame(rmDF) - colnames(rmDF) <- rmObj$columnNames - # Return - return(tibble::as_tibble(rmDF)) -} +## # === Methods to export to Flapjack format (DEPRECATED) ============= +## +## #' @title Export a PHG object to Flapjack file formats. +## #' +## #' @description This function will take a PHG object and export specified +## #' ranges to a Flapjack file format. Take note that in order for output to +## #' be generated, you will have to build your PHG with a the parameter +## #' \code{includeVariant} to \code{TRUE}. +## #' +## #' @param phgObject A PHG object. +## #' @param outputName A specified output name for your Flapjack files. Defaults +## #' to \code{NULL}. If \code{NULL} file name will be \code{phg_output} +## #' +## #' @importFrom rJava J +## #' +## #' @export +## flapjackExport <- function(phgObject, outputName = NULL) { +## ## Logic +## if (class(phgObject) != "PHGDataSet") { +## stop("Function needs a object of class 'PHGDataSet' to work.") +## } +## if (is.null(outputName)) { +## outputName <- "phg_output" +## } +## ## Get exporter and create Flapjack files +## rJava::J( +## "net.maizegenetics.pangenome.api/RMethods", +## "exportPHGToFlapjack", +## S4Vectors::metadata(phgObject)$jObj, +## outputName +## ) +## message("Flapjack files exported") +## } diff --git a/R/flapjack_export.R b/R/flapjack_export.R deleted file mode 100644 index 6d8e837..0000000 --- a/R/flapjack_export.R +++ /dev/null @@ -1,35 +0,0 @@ -# === Methods to export to Flapjack format (DEPRECATED) ============= - -# #' @title Export a PHG object to Flapjack file formats. -# #' -# #' @description This function will take a PHG object and export specified -# #' ranges to a Flapjack file format. Take note that in order for output to -# #' be generated, you will have to build your PHG with a the parameter -# #' \code{includeVariant} to \code{TRUE}. -# #' -# #' @param phgObject A PHG object. -# #' @param outputName A specified output name for your Flapjack files. Defaults -# #' to \code{NULL}. If \code{NULL} file name will be \code{phg_output} -# #' -# #' @importFrom rJava J -# #' -# #' @export -# flapjackExport <- function(phgObject, outputName = NULL) { -# -# ## Logic -# if (class(phgObject) != "PHGDataSet") { -# stop("Function needs a object of class 'PHGDataSet' to work.") -# } -# if (is.null(outputName)) { -# outputName <- "phg_output" -# } -# -# ## Get exporter and create Flapjack files -# rJava::J( -# "net.maizegenetics.pangenome.api/RMethods", -# "exportPHGToFlapjack", -# S4Vectors::metadata(phgObject)$jObj, -# outputName -# ) -# message("Flapjack files exported") -# } diff --git a/R/logging_support.R b/R/logging_support.R index 0a512dc..3b27513 100644 --- a/R/logging_support.R +++ b/R/logging_support.R @@ -1,5 +1,3 @@ -# === Logging Support =============================================== - ## ---- #' @title Start PHG logging information #' @@ -8,31 +6,23 @@ #' #' @param path full working path of log file location. If \code{NULL}, #' logging file will be added to current working directory. +#' @param verbose Print messages to console? Defaults \code{FALSE}. #' #' @export -startLogger <- function(path = NULL) { +startLogger <- function(path = NULL, verbose = TRUE) { if (is.null(path)) { path <- "rPHG_log" } - if (grepl(pattern = "^~", x = path)) { - stop( - paste0( - "It seems that you are using a '~' instead of your full", - " home directory path.\n", - " Consider using: ", Sys.getenv("HOME") - ) - ) - } + path <- suppressWarnings(normalizePath(path)) - rJava::.jcall( - "net.maizegenetics/util/LoggingUtils", - "V", - "setupLogfile", - path - ) + rJava::.jcall(TASSEL_API$LOGGING_UTILS, "V", "setupLogfile", path) - message("PHG logging file created at: ", path) + if (verbose) { + bullet <- cli::col_grey(cli::symbol$info) + msg <- paste0(bullet, " PHG logging file created at: ", path) + message(msg) + } } diff --git a/R/vis_plot_graph.R b/R/vis_plot_graph.R new file mode 100644 index 0000000..3687d1a --- /dev/null +++ b/R/vis_plot_graph.R @@ -0,0 +1,131 @@ +# ---- +# @title Visualize Graph Data +# +# @description +# Generates an interactive network plot for a given set of reference ranges +# and a set of taxa. +# +# @param x A \code{PHGDataSet} object +# @param samples Samples/taxa to include in plot +# @param sampleHighlight Sample path to highlight +# @param seqnames A sequence (e.g. chromosome) ID +# @param start Start position for ref ranges +# @param end End position for ref ranges +# @param colMajor Highlight path color +# @param colMinor Muted path color +# @param ... Additional parameters to pass for ref range inclusion +# +# @importFrom IRanges subsetByOverlaps +# @importFrom GenomicRanges GRanges +# @importFrom SummarizedExperiment assay +# @importFrom visNetwork visEdges +# @importFrom visNetwork visHierarchicalLayout +# @importFrom visNetwork visNetwork +plotGraphCore <- function( + x, + samples = NULL, + sampleHighlight = NULL, + seqnames = NULL, + start = NULL, + end = NULL, + colMajor = "maroon", + colMinor = "lightgrey", + ... +) { + # Filter by taxa and ref ranges + if (is.null(samples)) samples <- colnames(x) + hapTableMini <- x[, colnames(x) %in% samples] + hapTableMini <- IRanges::subsetByOverlaps( + hapTableMini, + GenomicRanges::GRanges(seqnames = seqnames, ranges = start:end) + ) + + # Get hap ID matrix + currentMatrix <- t(SummarizedExperiment::assay(hapTableMini)) + currentMatrix[is.na(currentMatrix)] <- -128 + colnames(currentMatrix) <- gsub("R", "", colnames(currentMatrix)) |> + as.numeric() + + # Get ref range data frame + refRangeDataMini <- rowRanges(hapTableMini) |> as.data.frame() + + # Group taxa by hap ID and ref range + taxaGroups <- lapply(seq_len(ncol(currentMatrix)), function(i) { + split(rownames(currentMatrix), currentMatrix[, i]) + }) + + # Generate distinct IDs (hap ID + ref range ID) + hapIds <- currentMatrix |> apply(2, unique, simplify = FALSE) + hapLevels <- rep(names(hapIds), vapply(hapIds, length, integer(1))) |> as.numeric() + fullHapIds <- paste0( + lapply(hapIds, function(i) i[order(i)]) |> unlist(), + "_", hapLevels + ) + + # HTML tooltip processing + taxaToHtml <- function(x) { + vapply(x, function(i) { + paste0("Taxa: ", paste(i, collapse = ", "), "

") + }, character(1)) + } + tooltipVec <- lapply(taxaGroups, taxaToHtml) |> unlist() + + refRangeHtml <- lapply(hapLevels, function(i) { + paste0( + "

Chr: ", + refRangeDataMini[i, ]$seqnames, + "
", + "Range: ", + refRangeDataMini[i, ]$start, + " - ", + refRangeDataMini[i, ]$end, + "
" + ) + }) |> unlist() + + # Final graph data (nodes) + nodes <- data.frame( + id = seq_along(fullHapIds), + label = fullHapIds, + level = hapLevels, + title = paste0(refRangeHtml, tooltipVec) + ) + + if (!is.null(sampleHighlight)) { + for (i in sampleHighlight) { + nodes$group <- ifelse(grepl(i, nodes$title), i, NA) + nodes$color <- ifelse(grepl(i, nodes$title), colMajor, colMinor) + } + nodes$title <- gsub(i, paste0("", i, ""), nodes$title) + } else { + nodes$color <- colMajor + } + + # Final graph data (edges) + lne <- c() + rne <- c() + for (i in seq_len(ncol(currentMatrix) - 1)) { + ln <- paste0(currentMatrix[, i], "_", i) + rn <- paste0(currentMatrix[, i + 1], "_", i + 1) + + cnxn <- paste0(ln, "+", rn) |> unique() + + for (c in cnxn) { + splits <- strsplit(c, "\\+") |> unlist() + f <- which(fullHapIds == splits[1]) + t <- which(fullHapIds == splits[2]) + lne <- c(lne, f) + rne <- c(rne, t) + } + } + + edges <- data.frame( + from = lne, + to = rne + ) + + # Return vis.js object + visNetwork::visNetwork(nodes, edges) |> + visNetwork::visEdges(arrows = "to") |> + visNetwork::visHierarchicalLayout(direction = "LR") +} diff --git a/README.md b/README.md index 4285730..75a70f1 100644 --- a/README.md +++ b/README.md @@ -1,21 +1,26 @@ -# rPHG +# rPHG [![Life Cycle Status](https://img.shields.io/badge/lifecycle-maturing-blue.svg)](https://www.tidyverse.org/lifecycle/#maturing) [![R-CMD-check](https://github.com/maize-genetics/rPHG/actions/workflows/check-standard.yaml/badge.svg)](https://github.com/maize-genetics/rPHG/actions/workflows/check-standard.yaml) [![codecov](https://codecov.io/gh/maize-genetics/rPHG/branch/master/graph/badge.svg?token=4D0JSKT0UC)](https://codecov.io/gh/maize-genetics/rPHG) [![DOI](https://img.shields.io/badge/Bioinformatics-10.1093%2Fbioinformatics%2Fbtac410-brightgreen)](https://doi.org/10.1093/bioinformatics/btac410) ## Objective -The main goal of developing this package is to construct an R-based front-end to connect to the Practical Haplotype Graph - a general, graph-based, computational framework for genotype inference. + +`rPHG` is a system to interact with and retrieve information from a Practical Haplotype Graph (PHG) - a general, graph-based, computational framework for genotype inference. This is accomplished by leveraging the [Breeding](https://brapi.org/) and [PHG](https://bitbucket.org/bucklerlab/practicalhaplotypegraph) APIs. ## Citation + To cite `rPHG`, please use the following citation: -> Bradbury et al. (2022). The Practical Haplotype Graph, a platform for storing and using pangenomes for imputation. Bioinformatics, 38(15), 3698–3702, https://doi.org/10.1093/bioinformatics/btac410 +> Bradbury et al. (2022). The Practical Haplotype Graph, a platform for storing and using pangenomes for imputation. Bioinformatics, 38(15), 3698--3702, ## Installation + If you do not have experience working with and setting up `rJava` with your R installation, *it is recommended that you read the long-form documentation*. This walkthrough can be found [here](https://rphg.maizegenetics.net/articles/rphg_walkthrough.html). If you are already fairly comfortable working with Java JDK and `rJava`, you can follow the following commands. Package source code can be installed directly from this BitBucket repository using the `devtools` package: -```{r} +``` r if (!require("devtools")) install.packages("devtools") devtools::install_github(repo = "maize-genetics/rPHG") ``` + + diff --git a/man/HaplotypeGraph-class.Rd b/man/HaplotypeGraph-class.Rd index 655ffe0..1f50b9f 100644 --- a/man/HaplotypeGraph-class.Rd +++ b/man/HaplotypeGraph-class.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_phg_graph.R +% Please edit documentation in R/class_haplotype_graph.R \docType{class} \name{HaplotypeGraph-class} \alias{HaplotypeGraph-class} diff --git a/man/HaplotypeGraph-validity.Rd b/man/HaplotypeGraph-validity.Rd index 4902677..ba19bef 100644 --- a/man/HaplotypeGraph-validity.Rd +++ b/man/HaplotypeGraph-validity.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_phg_graph.R +% Please edit documentation in R/class_haplotype_graph.R \name{HaplotypeGraph-validity} \alias{HaplotypeGraph-validity} \title{HaplotypeGraph validation} diff --git a/man/buildHaplotypeGraph.Rd b/man/buildHaplotypeGraph.Rd index a84d657..aca3460 100644 --- a/man/buildHaplotypeGraph.Rd +++ b/man/buildHaplotypeGraph.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_phg_graph.R +% Please edit documentation in R/class_haplotype_graph.R \name{buildHaplotypeGraph} \alias{buildHaplotypeGraph} \title{Helper function to build HaplotypeGraph object} diff --git a/man/javaMemoryAddress.Rd b/man/javaMemoryAddress.Rd index 4171751..655b983 100644 --- a/man/javaMemoryAddress.Rd +++ b/man/javaMemoryAddress.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +% Please edit documentation in R/class_all_generics.R, R/class_haplotype_graph.R \name{javaMemoryAddress} \alias{javaMemoryAddress} \alias{javaMemoryAddress,HaplotypeGraph-method} diff --git a/man/javaRefObj.Rd b/man/javaRefObj.Rd index ca9dcd3..1cd3584 100644 --- a/man/javaRefObj.Rd +++ b/man/javaRefObj.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +% Please edit documentation in R/class_all_generics.R, R/class_haplotype_graph.R \name{javaRefObj} \alias{javaRefObj} \alias{javaRefObj,HaplotypeGraph-method} diff --git a/man/numberOfChromosomes.Rd b/man/numberOfChromosomes.Rd index 1b9aa13..189d293 100644 --- a/man/numberOfChromosomes.Rd +++ b/man/numberOfChromosomes.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +% Please edit documentation in R/class_all_generics.R, R/class_haplotype_graph.R \name{numberOfChromosomes} \alias{numberOfChromosomes} \alias{numberOfChromosomes,HaplotypeGraph-method} diff --git a/man/numberOfNodes.Rd b/man/numberOfNodes.Rd index 9771b6b..a82c5da 100644 --- a/man/numberOfNodes.Rd +++ b/man/numberOfNodes.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +% Please edit documentation in R/class_all_generics.R, R/class_haplotype_graph.R \name{numberOfNodes} \alias{numberOfNodes} \alias{numberOfNodes,HaplotypeGraph-method} diff --git a/man/numberOfRefRanges.Rd b/man/numberOfRefRanges.Rd index 2633f98..a5e8f5b 100644 --- a/man/numberOfRefRanges.Rd +++ b/man/numberOfRefRanges.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +% Please edit documentation in R/class_all_generics.R, R/class_haplotype_graph.R \name{numberOfRefRanges} \alias{numberOfRefRanges} \alias{numberOfRefRanges,HaplotypeGraph-method} diff --git a/man/numberOfTaxa.Rd b/man/numberOfTaxa.Rd index 7e09d3a..f0fff4b 100644 --- a/man/numberOfTaxa.Rd +++ b/man/numberOfTaxa.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +% Please edit documentation in R/class_all_generics.R, R/class_haplotype_graph.R \name{numberOfTaxa} \alias{numberOfTaxa} \alias{numberOfTaxa,HaplotypeGraph-method} diff --git a/man/phgMethodId.Rd b/man/phgMethodId.Rd index 1f12afc..d81fbc6 100644 --- a/man/phgMethodId.Rd +++ b/man/phgMethodId.Rd @@ -1,6 +1,6 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R, -% R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R, +% R/class_haplotype_graph.R, R/class_phg_method.R \name{phgMethodId} \alias{phgMethodId} \alias{phgMethodId,HaplotypeGraph-method} diff --git a/man/phgMethodType.Rd b/man/phgMethodType.Rd index 69db41f..f791106 100644 --- a/man/phgMethodType.Rd +++ b/man/phgMethodType.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R +% Please edit documentation in R/class_all_generics.R, R/class_haplotype_graph.R \name{phgMethodType} \alias{phgMethodType} \alias{phgMethodType,HaplotypeGraph-method} diff --git a/man/plotGraph.Rd b/man/plotGraph.Rd index 10af84c..4ea4ad5 100644 --- a/man/plotGraph.Rd +++ b/man/plotGraph.Rd @@ -1,23 +1,28 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprecated_stats_and_visualization.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_dataset.R \name{plotGraph} \alias{plotGraph} -\title{Visualize Graph Data} +\alias{plotGraph,PHGDataSet-method} +\title{Plot a graph object} \usage{ -plotGraph( - x, - samples = NULL, - sampleHighlight = NULL, - seqnames = NULL, - start = NULL, - end = NULL, - colMajor = "maroon", - colMinor = "lightgrey", +plotGraph(object, ...) + +\S4method{plotGraph}{PHGDataSet}( + object, + samples, + sampleHighlight, + seqnames, + start, + end, + colMajor, + colMinor, ... ) } \arguments{ -\item{x}{A \code{PHGDataSet} object} +\item{object}{A \code{PHGDataSet} object} + +\item{...}{Additional parameters to pass for ref range inclusion} \item{samples}{Samples/taxa to include in plot} @@ -32,10 +37,7 @@ plotGraph( \item{colMajor}{Highlight path color} \item{colMinor}{Muted path color} - -\item{...}{Additional parameters to pass for ref range inclusion} } \description{ -Generates an interactive network plot for a given set of reference ranges -and a set of taxa. +Generates a visualization of a recapitulated graph object } diff --git a/man/readHaplotypeIds.Rd b/man/readHaplotypeIds.Rd index b5dacde..d6db8c0 100644 --- a/man/readHaplotypeIds.Rd +++ b/man/readHaplotypeIds.Rd @@ -1,6 +1,6 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R, -% R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R, +% R/class_haplotype_graph.R, R/class_phg_method.R \name{readHaplotypeIds} \alias{readHaplotypeIds} \alias{readHaplotypeIds,HaplotypeGraph-method} diff --git a/man/readMappingTableInfo.Rd b/man/readMappingTableInfo.Rd deleted file mode 100644 index aa2f8b7..0000000 --- a/man/readMappingTableInfo.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprecated_stats_and_visualization.R -\name{readMappingTableInfo} -\alias{readMappingTableInfo} -\title{Retrieve read mapping records from PHG database.} -\usage{ -readMappingTableInfo(configFile) -} -\arguments{ -\item{configFile}{Path to a configuration file for your graph database.} -} -\description{ -Returns an \code{S4Vectors} \code{DataFrame} object of read - mapping record information without \code{read_mapping} data. -} -\author{ -Brandon Monier - -Peter Bradbury -} diff --git a/man/readMappingsForLineName.Rd b/man/readMappingsForLineName.Rd deleted file mode 100644 index 2ef1290..0000000 --- a/man/readMappingsForLineName.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprecated_stats_and_visualization.R -\name{readMappingsForLineName} -\alias{readMappingsForLineName} -\title{Retrieve read mapping information from PHG database.} -\usage{ -readMappingsForLineName( - configFile, - lineName, - readMappingMethodName, - haplotypeMethodName, - fileGroup = NULL -) -} -\arguments{ -\item{configFile}{Path to a configuration file for your graph database.} - -\item{lineName}{The name of the line (taxon) for which the read mapping -information is to be retrieved. If there are multiple read mappings with -different \code{file_group_names}, they will be combined.} - -\item{readMappingMethodName}{The method name for the read mappings -(only takes a single method).} - -\item{haplotypeMethodName}{The haplotype method name.} - -\item{fileGroup}{the name of the file group for the line from the database. -This parameter is only necessary if the line (taxon) has more than one -file group and only the reads for a specific file group are wanted.} -} -\description{ -Returns an \code{S4Vectors} \code{DataFrame} object of read - mapping information for a given line (i.e. taxon). -} -\author{ -Brandon Monier - -Peter Bradbury -} diff --git a/man/readPHGDataSet.Rd b/man/readPHGDataSet.Rd index af327cf..1159297 100644 --- a/man/readPHGDataSet.Rd +++ b/man/readPHGDataSet.Rd @@ -1,6 +1,6 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R, -% R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R, +% R/class_haplotype_graph.R, R/class_phg_method.R \name{readPHGDataSet} \alias{readPHGDataSet} \alias{readPHGDataSet,HaplotypeGraph-method} diff --git a/man/readRefRanges.Rd b/man/readRefRanges.Rd index 90537e4..fab303f 100644 --- a/man/readRefRanges.Rd +++ b/man/readRefRanges.Rd @@ -1,6 +1,6 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R, -% R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R, +% R/class_haplotype_graph.R, R/class_phg_method.R \name{readRefRanges} \alias{readRefRanges} \alias{readRefRanges,HaplotypeGraph-method} diff --git a/man/readSamples.Rd b/man/readSamples.Rd index b7742f8..99e331a 100644 --- a/man/readSamples.Rd +++ b/man/readSamples.Rd @@ -1,6 +1,6 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class_all_generics.R, R/class_phg_graph.R, -% R/class_phg_method.R +% Please edit documentation in R/class_all_generics.R, +% R/class_haplotype_graph.R, R/class_phg_method.R \name{readSamples} \alias{readSamples} \alias{readSamples,HaplotypeGraph-method} diff --git a/man/searchRecombination.Rd b/man/searchRecombination.Rd deleted file mode 100644 index 30d1af4..0000000 --- a/man/searchRecombination.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprecated_stats_and_visualization.R -\name{searchRecombination} -\alias{searchRecombination} -\title{Search for recombination} -\usage{ -searchRecombination( - phgObject = NULL, - gameteName, - refRangeSame, - refRangeDiff, - phgHapIDMat = NULL -) -} -\arguments{ -\item{phgObject}{A PHG object.} - -\item{gameteName}{A specified gamete name} - -\item{refRangeSame}{See description for further details.} - -\item{refRangeDiff}{See description for further details.} - -\item{phgHapIDMat}{The output of the \code{hapIDMatrix()} function. If -\code{NULL}, A hap ID matrix will be generated (if you have supplied a -PHG object).} -} -\description{ -Search for inbred lines (gametes) that are the same in one - range but different in another. Such lines have experienced recombination - in the past relative to each other. Must specify a gamete name and - reference ranges. -} diff --git a/man/searchSimilarGametes.Rd b/man/searchSimilarGametes.Rd deleted file mode 100644 index 0bccbf4..0000000 --- a/man/searchSimilarGametes.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprecated_stats_and_visualization.R -\name{searchSimilarGametes} -\alias{searchSimilarGametes} -\title{Search for similar gamets} -\usage{ -searchSimilarGametes( - phgObject = NULL, - refRanges, - gameteName, - fractionDiff = 0, - phgHapIDMat = NULL -) -} -\arguments{ -\item{phgObject}{A PHG object.} - -\item{refRanges}{Specifed reference ranges.} - -\item{gameteName}{A specified gamete name} - -\item{fractionDiff}{The difference between haplotypes (either 0 or 1). See -description for further details.} - -\item{phgHapIDMat}{The output of the \code{hapIDMatrix()} function. If -\code{NULL}, A hap ID matrix will be generated (if you have supplied a -PHG object).} -} -\description{ -Search for inbred lines (gametes) that are similar to a - specified gamete in specified reference ranges. Supply either a haplotype - ID matrix or a phgObject from which to extract it. Specify a gamete name - and reference ranges. The difference between haplotypes is either 0 (same) - or 1 (different). Fraction of ranges that are different has to be lower or - equal to fractionDiff. Ranges with unknown haplotypes (-1) do not count in - the fraction. If all pairwise range comparisons have -1 the lines are - considered dissimilar. -} diff --git a/man/startLogger.Rd b/man/startLogger.Rd index b6ec737..bc9d86c 100644 --- a/man/startLogger.Rd +++ b/man/startLogger.Rd @@ -4,11 +4,13 @@ \alias{startLogger} \title{Start PHG logging information} \usage{ -startLogger(path = NULL) +startLogger(path = NULL, verbose = TRUE) } \arguments{ \item{path}{full working path of log file location. If \code{NULL}, logging file will be added to current working directory.} + +\item{verbose}{Print messages to console? Defaults \code{FALSE}.} } \description{ This function will create a file for storing logging output diff --git a/tests/testthat/test_class_haplotype_graph.R b/tests/testthat/test_class_haplotype_graph.R index 2598c27..ae0a8c8 100644 --- a/tests/testthat/test_class_haplotype_graph.R +++ b/tests/testthat/test_class_haplotype_graph.R @@ -5,8 +5,11 @@ test_that("Basic tests", { startLogger(logFile) createConfigFile(configFile) + # testUrl <- "phg.maizegdb.org" + testUrl <- "demo.hub.maizegenetics.net" + phgLocCon <- PHGLocalCon(configFile) - phgSrvCon <- PHGServerCon("phg.maizegdb.org") + phgSrvCon <- PHGServerCon(testUrl) phgMethod1 <- PHGMethod(phgLocCon, "CONSENSUS") phgMethod2 <- PHGMethod(phgLocCon, "PATH_METHOD") diff --git a/tests/testthat/test_phg_con_server.R b/tests/testthat/test_class_phg_con_server.R similarity index 73% rename from tests/testthat/test_phg_con_server.R rename to tests/testthat/test_class_phg_con_server.R index f4e082c..9ce0a95 100644 --- a/tests/testthat/test_phg_con_server.R +++ b/tests/testthat/test_class_phg_con_server.R @@ -2,7 +2,8 @@ test_that("Basic tests", { logFile <- tempfile(fileext = ".txt") startLogger(logFile) - testUrl <- "phg.maizegdb.org" + # testUrl <- "phg.maizegdb.org" + testUrl <- "demo.hub.maizegenetics.net" phgSrvCon <- PHGServerCon(testUrl) phgSrvConOutput <- utils::capture.output(phgSrvCon) @@ -41,18 +42,22 @@ test_that("Basic tests", { object = port(PHGServerCon(testUrl, protocol = "http")), expected = 80 ) - expect_error( - object = PHGServerCon(testUrl, port = -1), - regexp = "Not a valid port number" + expect_equal( + object = httProtocol(PHGServerCon(paste0("https://", testUrl))), + expected = "https" ) - expect_error( - object = PHGServerCon(testUrl, protocol = "htp"), - regexp = "Protocols can only be 'http' or 'https'" + expect_equal( + object = httProtocol(PHGServerCon(paste0("http://", testUrl))), + expected = "http" ) + expect_error( - object = PHGServerCon(testUrl, version = "v3"), - regexp = "Versions 1 or 2 are only allowed" + object = PHGServerCon(testUrl, port = -1), + regexp = "Not a valid port number" ) + expect_error(object = PHGServerCon(testUrl, protocol = "htp")) + expect_error(object = PHGServerCon(testUrl, version = "v3")) + expect_error(object = PHGServerCon("www.google.com")) }) diff --git a/tests/testthat/test_class_phg_dataset.R b/tests/testthat/test_class_phg_dataset.R new file mode 100644 index 0000000..3e4d966 --- /dev/null +++ b/tests/testthat/test_class_phg_dataset.R @@ -0,0 +1,34 @@ +test_that("Basic tests.", { + logFile <- tempfile(fileext = ".txt") + configFile <- tempfile() + + startLogger(logFile) + createConfigFile(configFile) + + testPDS <- readPHGDataSet( + PHGMethod( + PHGLocalCon(configFile), + "PATH_METHOD" + ) + ) + + expect_true(is(testPDS, "PHGDataSet")) + + expect_true(is(calcMutualInfo(testPDS), "matrix")) + expect_true(is(numHaploPerRefRange(testPDS), "tbl")) + + expect_equal( + object = dim(calcMutualInfo(testPDS)), + expected = c(10, 10) + ) + expect_equal( + object = colnames(numHaploPerRefRange(testPDS)), + expected = c("rr_id", "seqnames", "start", "end", "width", "n_hap_ids") + ) + expect_equal( + object = dim(numHaploPerRefRange(testPDS)), + expected = c(10, 6) + ) + +}) + diff --git a/tests/testthat/test_class_phg_method.R b/tests/testthat/test_class_phg_method.R new file mode 100644 index 0000000..ba0073a --- /dev/null +++ b/tests/testthat/test_class_phg_method.R @@ -0,0 +1,40 @@ +test_that("Basic tests.", { + logFile <- tempfile(fileext = ".txt") + configFile <- tempfile() + + startLogger(logFile) + createConfigFile(configFile) + + testUrl <- "demo.hub.maizegenetics.net" + + phgLocCon <- PHGLocalCon(configFile) + phgSrvCon <- PHGServerCon(testUrl) + + phgMethod1 <- PHGMethod(phgLocCon, "CONSENSUS") + phgMethod2 <- PHGMethod(phgLocCon, "PATH_METHOD") + phgMethod3 <- PHGMethod(phgSrvCon, "NAM_GBS_Alignments_PATHS") + + phgMethod1Output <- utils::capture.output(phgMethod1) + phgMethod2Output <- utils::capture.output(phgMethod2) + phgMethod3Output <- utils::capture.output(phgMethod3) + + expect_true(is(phgMethod1, "PHGMethod")) + expect_true(is(phgMethod2, "PHGMethod")) + expect_true(is(phgMethod3, "PHGMethod")) + expect_true(any(grepl("PHGLocalCon", phgMethod1Output))) + expect_true(any(grepl("PHGLocalCon", phgMethod2Output))) + expect_true(any(grepl("PHGServerCon", phgMethod3Output))) + expect_true(is(readSamples(phgMethod2), "character")) + expect_true(is(readRefRanges(phgMethod2), "GRanges")) + expect_true(is(readHaplotypeIds(phgMethod2), "matrix")) + expect_true(is(readPHGDataSet(phgMethod2), "PHGDataSet")) + + expect_equal(length(phgMethod1Output), 2) + expect_equal(length(phgMethod2Output), 2) + expect_equal(length(phgMethod3Output), 2) + expect_equal(phgMethodId(phgMethod1), "CONSENSUS") + expect_equal(phgMethodId(phgMethod2), "PATH_METHOD") + expect_equal(phgMethodId(phgMethod3), "NAM_GBS_Alignments_PATHS") + + +}) \ No newline at end of file diff --git a/tests/testthat/test_logging_support.R b/tests/testthat/test_logging_support.R new file mode 100644 index 0000000..2b58914 --- /dev/null +++ b/tests/testthat/test_logging_support.R @@ -0,0 +1,9 @@ +test_that("Basic tests.", { + expect_message( + object = startLogger(), + regexp = "PHG logging file created at" + ) + expect_no_message(object = startLogger(verbose = FALSE)) + +}) + diff --git a/tests/testthat/test_phg_dataset.R b/tests/testthat/test_phg_dataset.R deleted file mode 100644 index 7437f52..0000000 --- a/tests/testthat/test_phg_dataset.R +++ /dev/null @@ -1,4 +0,0 @@ -test_that("Basic tests.", { - -}) - diff --git a/tests/testthat/test_zzz.R b/tests/testthat/test_zzz.R new file mode 100644 index 0000000..99f1a79 --- /dev/null +++ b/tests/testthat/test_zzz.R @@ -0,0 +1,5 @@ +test_that("Basic tests.", { + expect_silent( + .onLoad(pkgname = "rPHG", libname = system.file(package = "rPHG")) + ) +}) diff --git a/vignettes/rphg_config_files.R b/vignettes/rphg_config_files.R new file mode 100644 index 0000000..e68ead1 --- /dev/null +++ b/vignettes/rphg_config_files.R @@ -0,0 +1,10 @@ +## ----setup, include=FALSE----------------------------------------------------- +knitr::opts_chunk$set( + fig.path = "figure/graphics-", + cache.path = "cache/graphics-", + fig.align = "center", + external = TRUE, + echo = TRUE, + warning = FALSE +) + diff --git a/vignettes/rphg_config_files.Rmd b/vignettes/rphg_config_files.Rmd new file mode 100644 index 0000000..b59e47a --- /dev/null +++ b/vignettes/rphg_config_files.Rmd @@ -0,0 +1,77 @@ +--- +title: "Overview of configuration files" +output: + BiocStyle::html_document: + toc: false + fig_caption: true + toc_float: true + number_sections: false +vignette: > + %\VignetteIndexEntry{Overview of configuration files} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} + %\usepackage[utf8]{inputenc} + %\usepackage{float} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + fig.path = "figure/graphics-", + cache.path = "cache/graphics-", + fig.align = "center", + external = TRUE, + echo = TRUE, + warning = FALSE +) +``` + +The idea behind the PHG is that in a given breeding program, all parental +genotypes can be sequenced at high coverage and loaded as parental haplotypes +in a relational database. Progeny can then be sequenced at low coverage and +used to infer which parental haplotypes/genotypes from the database are the most +likely present in a given progeny. + +In the following sections, we will give an overview of how to set up +configuration files to connect to local databases. + + +## Database types +Currently, the PHG can use SQLite or PostgreSQL to store data for the +pan-genomic graph. For more information about how data is stored within the +database schema, please refer to the +[PHG Wiki](https://bitbucket.org/bucklerlab/practicalhaplotypegraph/wiki/Home). + + +## Configuration files +Access to the PHG database, regardless of database type, requires a +configuration file. This file contains various metadata needed to access +relevant PHG data and/or calculate optimal graph paths: + +| **Field** | **Description** | +|:-----------|:---------------------------------------| +| `host` | database host and/or port number | +| `user` | username | +| `password` | password | +| `DB` | path to database | +| `DBtype` | database type (`sqlite` or `postgres`) | + +An example database configuration can be found below: + +**SQLite example** +``` +host=localHost +user=user +password=password +DB=/tempFileDir/outputDir/phgTestDB_mapq48.db +DBtype=sqlite +``` + +**PostgreSQL example** +``` +host=184.32.99.233:5422 +user=user +password=password +DB=phgdb +DBtype=postgres +``` + diff --git a/vignettes/rphg_installation.R b/vignettes/rphg_installation.R new file mode 100644 index 0000000..4bd13fe --- /dev/null +++ b/vignettes/rphg_installation.R @@ -0,0 +1,23 @@ +## ----setup, include=FALSE----------------------------------------------------- +knitr::opts_chunk$set( + fig.path = "figure/graphics-", + cache.path = "cache/graphics-", + fig.align = "center", + external = TRUE, + echo = TRUE, + warning = FALSE +) + +## ---- eval=FALSE, echo=TRUE--------------------------------------------------- +# # install.packages("pak") +# pak::pak("maize-genetics/rPHG") + +## ---- eval=FALSE, echo=TRUE--------------------------------------------------- +# library(rPHG) + +## ---- eval=FALSE, echo=TRUE--------------------------------------------------- +# options(java.parameters = c("-Xmx", "-Xms")) + +## ---- eval=FALSE, echo=TRUE--------------------------------------------------- +# startLogger(fullPath = NULL, fileName = NULL) + diff --git a/vignettes/rphg_installation.Rmd b/vignettes/rphg_installation.Rmd new file mode 100644 index 0000000..9e134d4 --- /dev/null +++ b/vignettes/rphg_installation.Rmd @@ -0,0 +1,183 @@ +--- +title: "Installing and setting up rPHG and rJava" +output: + BiocStyle::html_document: + toc: false + fig_caption: true + toc_float: true + number_sections: false +vignette: > + %\VignetteIndexEntry{Getting Start with rPHG} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} + %\usepackage[utf8]{inputenc} + %\usepackage{float} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + fig.path = "figure/graphics-", + cache.path = "cache/graphics-", + fig.align = "center", + external = TRUE, + echo = TRUE, + warning = FALSE +) +``` + +In contrast to other R packages, installing `rPHG` involves additional steps +that require linking the package to Java. This document will +show you how to set up `rJava` and properly load `rPHG`. + +# Installation + +## Prerequisite - installing `rJava` +Since the PHG API is written primarily in Java, a Java JDK will need to be +installed on your machine. Additionally, for R to communicate with Java, +the R package `rJava` will need to be installed. More info on the `rJava` +package can be found [here](https://www.rforge.net/rJava/). In order to load +`rJava` properly, ensure that you have: + +- A `JDK` (Java Development Kit $\geq$ `8`) installed on your system. +- Your system environment variable `JAVA_HOME` is configured + appropriately and points to your `JDK` of choice. This will usually + be included in your PATH environment variable as well. Options and + system environmental variables that are available from R can be seen + with `Sys.getenv()` and more specifically + `Sys.getenv("JAVA_HOME")`. + +**NOTE**: If you are using a UNIX system (e.g. Ubuntu) and are experiencing +issues, you may need to reconfigure R with Java. To perform this, open a +terminal and enter the command: + + R CMD javareconf + +You may need to have root privileges when performing this so you may +need to add `sudo` to the prior command. + +If you need additional steps on how to perform these actions, detailed +information can be found using the following links, depending on your +OS: + +- [Linux](https://datawookie.netlify.com/blog/2018/02/installing-rjava-on-ubuntu/) +- [macOS](https://zhiyzuo.github.io/installation-rJava/) +- [Windows](https://cimentadaj.github.io/blog/2018-05-25-installing-rjava-on-windows-10/installing-rjava-on-windows-10/) + + +## Install from GitHub +After you have `rJava` up and running on your machine, install the latest +version from GitHub: + +```{r, eval=FALSE, echo=TRUE} +# install.packages("pak") +pak::pak("maize-genetics/rPHG") +``` + +After the package has been installed, load `rPHG` using: + +```{r, eval=FALSE, echo=TRUE} +library(rPHG) +``` + +Or, if you want to use a function without violating your environment you can +use `rPHG::`, where `` is an `rPHG` function. + + + +# Set-up + +## Setting memory +Since certain analyses can possibly use up a lot of computational +resources, memory allocation to `rPHG` can be modified. To change the amount +of memory, use the base `options()` function and modify the following parameter: + +```{r, eval=FALSE, echo=TRUE} +options(java.parameters = c("-Xmx", "-Xms")) +``` + +| ⚠ This will need to be set before loading the `rPHG` package! | +|:--------------------------------------------------------------:| + +Replace `` with a specified unit of memory. For example, if I want to +allocate a maximum of 6 GB of memory for my operations, I would use the input +`"-Xmx6g"`, where `g` stands for gigabyte (GB). More information about memory +allocation can be found [here](https://stackoverflow.com/questions/14763079/what-are-the-xms-and-xmx-parameters-when-starting-jvm). + + +## Starting a logging file +Since the `rPHG` package is an interface to the +[PHG API](https://bitbucket.org/bucklerlab/practicalhaplotypegraph), we can +track internal API progress via a logging file. This file is beneficial +for debugging, tracking, and reproducing the progress of your workflow. + +| ⚠ It is _highly recommended_ to set up a logging file! | +|:-------------------------------------------------------:| + +To start a logging file, use the following command: + +```{r, eval=FALSE, echo=TRUE} +startLogger(fullPath = NULL, fileName = NULL) +``` + +If the `startLogger()` parameters are set to `NULL`, the logging file +will be created in your current working directory. If you are unsure of what +your working directory is in R, use the base `getwd()` command. + + + +# Commonly encountered issues with `rJava` + +## Problems installing rJava M1/M2/M$n$ CPU architecture (macOS) + +If you are running into issues with installing `rJava` using the newer +Mac chip architecture, Oracle JDK currently (as of writing this) does not +work. Consider an alternative JDK source such as [OpenJDK](https://openjdk.org/) +or [Azul JDK](https://www.azul.com/downloads/?version=java-8-lts&package=jdk). + +More detailed information about a possible workaround can be found in this +[Stack Overflow post](https://stackoverflow.com/questions/67849830/how-to-install-rjava-package-in-mac-with-m1-architecture). + + +## Problems with rJava if you have upgraded Java (macOS) +When using macOS, if you previously had `rJava` working through RStudio, then +you upgraded your Java and it now longer works, try the following: + +At the command line type: + +```{bash, eval=FALSE, echo=TRUE} +R CMD javareconf +``` + +Then check for a left over symbolic link via: + +```{bash, eval=FALSE, echo=TRUE} +ls -ltr /usr/local/lib/libjvm.dylib +``` + +If the link exists, remove it, then create it fresh via these commands: + +```{bash, eval=FALSE, echo=TRUE} +rm /usr/local/lib/libjvm.dylib +sudo ln -s $(/usr/libexec/java_home)/lib/server/libjvm.dylib /usr/local/lib +``` + +You should now be able to enter RStudio and setup rJava. + + +## Problems loading the `rJava` package (Linux) +If you are using a UNIX system (e.g. Ubuntu) and are experiencing +issues, you may need to reconfigure R with Java. To perform this, open a +terminal and enter the command: + +``` bash +R CMD javareconf +``` + +You may need to have root privileges when performing this so you may +need to add `sudo` to the prior command: + +``` bash +sudo R CMD javareconf +``` + + diff --git a/vignettes/rphg_walkthrough.R b/vignettes/rphg_walkthrough.R index da91908..4531a6d 100644 --- a/vignettes/rphg_walkthrough.R +++ b/vignettes/rphg_walkthrough.R @@ -8,121 +8,48 @@ knitr::opts_chunk$set( warning = FALSE ) -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# if (!require("devtools")) install.packages("devtools") -# devtools::install_github(repo = "maize-genetics/rPHG") - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# library(rPHG) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# options(java.parameters = c("-Xmx", "-Xms")) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# rPHG::startLogger(fullPath = NULL, fileName = NULL) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# # Example path location (not run) -# configPath <- "/home/bm646/Temporary/phg_tests/configSQLite.txt" -# -# phgMethods <- rPHG::showPHGMethods(configFile = configPath) -# phgMethods - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# phgObj <- graphBuilder( -# configFile = config_path, -# methods = "GATK_PIPELINE" -# ) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# phgObj - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# # Make a `GRanges` object -# rr <- SummarizedExperiment::rowRanges(phgObj) -# rr - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# GenomicRanges::ranges(rr) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# SummarizedExperiment::ranges(phgObj) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# SummarizedExperiment::assays(phgObj)$hapID - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# qTaxa <- taxaByNode(phgObj, start = 1, end = 35000, seqnames = "1") -# head(qTaxa) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# library(dplyr) -# qTaxa |> -# filter(hap_id == "112") |> -# pull(taxa_id) |> -# unlist() - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# # Get taxa set in reference ranges 1 and 5 -# taxaByNode(phgObj, rrSet = c(1, 5)) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# phgObj |> -# plotGraph( -# seqnames = 1, -# start = 1000, -# end = 100000, -# samples = c("Z001E0001", "Z001E0002", "Z001E0004", "Z001E0096") -# ) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# phgObj |> -# plotGraph( -# seqId = 1, -# start = 1000, -# end = 100000, -# samples = c("Z001E0001", "Z001E0002", "Z001E0004", "Z001E0096"), -# sampleHighlight = "Z001E0001" -# ) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# phgObj |> -# plotGraph( -# seqId = 1, -# start = 1000, -# end = 100000, -# samples = c("Z001E0001", "Z001E0002", "Z001E0004", "Z001E0096"), -# sampleHighlight = "Z001E0001", -# colMajor = "#4287f5", -# colMinor = "#818ea3" -# ) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# S4Vectors::metadata(phgObj)$jObj - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# rPHG::numHaploPerRange(phgObject = phgObj) - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# library(magrittr) -# -# # (1) Non-pipe example -# haploPlot <- plotNumHaplo(numHaploPerRange(phgObject = phgObj)) -# -# # (2) Pipe example. Need to load `magrittr` package first! -# haploPlot <- phgObj %>% -# rPHG::numHaploPerRange() %>% -# rPHG::plotNumHaplo() -# -# # Return visualization -# haploPlot - -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- -# library(magrittr) -# -# phgObj %>% -# rPHG::plotMutualInfo( -# refRanges = assays(phgObj)$hapID %>% -# rownames() -# ) +library(rPHG) +logFile <- tempfile(fileext = ".txt") +configFile <- tempfile() +rPHG:::createConfigFile(configFile) + +## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +configFile |> PHGLocalCon() + +## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +"demo.hub.maizegenetics.net" |> PHGServerCon() + +## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +configFile |> + PHGLocalCon() |> + showPHGMethods() + +## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +configFile |> + PHGLocalCon() |> + PHGMethod("PATH_METHOD") + +## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +configFile |> + PHGLocalCon() |> + PHGMethod("PATH_METHOD") |> + readSamples() + +## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +configFile |> + PHGLocalCon() |> + PHGMethod("PATH_METHOD") |> + readRefRanges() + +## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +configFile |> + PHGLocalCon() |> + PHGMethod("PATH_METHOD") |> + readHaplotypeIds() + +## ---- echo=TRUE, eval=TRUE, message=FALSE------------------------------------- +configFile |> + PHGLocalCon() |> + PHGMethod("PATH_METHOD") |> + readPHGDataSet() diff --git a/vignettes/rphg_walkthrough.Rmd b/vignettes/rphg_walkthrough.Rmd index 7bc39a3..4265dd7 100644 --- a/vignettes/rphg_walkthrough.Rmd +++ b/vignettes/rphg_walkthrough.Rmd @@ -1,7 +1,5 @@ --- -title: "Getting Started with rPHG" -author: "Brandon Monier" -date: "2019-12-05 at 13:21:26" +title: "Introduction to rPHG" output: BiocStyle::html_document: toc: false @@ -14,6 +12,9 @@ vignette: > %\VignetteEncoding{UTF-8} %\usepackage[utf8]{inputenc} %\usepackage{float} +editor_options: + markdown: + wrap: 70 --- ```{r setup, include=FALSE} @@ -25,638 +26,138 @@ knitr::opts_chunk$set( echo = TRUE, warning = FALSE ) -``` - - -# Introduction - -## Overview -Thanks for checking out rPHG! In this document, we will go over the -functionalities used to work with the practical haplotype graph (PHG) API -via R. - -The PHG is a trellis graph based representation of genic and -intergenic regions (called reference ranges or reference intervals) which -represent diversity across and between taxa. It can be used to: create -custom genomes for alignment, call rare alleles, impute genotypes, and -efficiently store genomic data from many lines (i.e. reference, assemblies, -and other lines). Skim sequences generated for a given taxon are aligned -to consensus sequences in the PHG to identify the haplotype node at a -given anchor. All the anchors for a given taxon are processed through a -Hidden Markov Model (HMM) to identify the most likely path through the -graph. Path information is used to identify the variants (SNPs). Low cost -sequencing technologies, coupled with the PHG, facilitate the genotyping -of large number of samples to increase the size of training populations -for genomic selection models. This can in turn increase predictive accuracy -and selection intensity in a breeding program. - -Detailed documentation and source code can be found on our website: - -https://rphg.maizegenetics.net/articles/rphg_walkthrough.html - -## Motivation -The main goal of developing this package is to construct an R-based front-end -to build and interact with the PHG API that implements commonly used -Biocondcutor classes, data structures, and accessor methods for downstream -analysis and integration with other packages. - - - -# Installation and Preliminary Steps - -## Prerequisites - installing rJava -Since the PHG is written in Java, Java JDK will need to be installed on your -machine. Additionally, for R to communicate with Java, the R package `rJava` -will need to be installed. Detailed information can be found using the -following links, depending on your OS: - -* [Linux](https://datawookie.netlify.com/blog/2018/02/installing-rjava-on-ubuntu/) -* [macOS](https://zhiyzuo.github.io/installation-rJava/) -* [Windows](https://cimentadaj.github.io/blog/2018-05-25-installing-rjava-on-windows-10/installing-rjava-on-windows-10/) - -## Problems with rJava if you have upgraded Java -When using macOS, if you previously had `rJava` working through RStudio, then -you upgraded your Java and it now longer works, try the following: - -At the command line type: - -``` -R CMD javareconf -``` -Then check for a left over symbolic link via: - -``` -ls -ltr /usr/local/lib/libjvm.dylib -``` - -If the link exists, remove it, then create it fresh via these commands: - -``` -rm /usr/local/lib/libjvm.dylib -sudo ln -s $(/usr/libexec/java_home)/lib/server/libjvm.dylib /usr/local/lib -``` - -You should now be able to enter RStudio and setup rJava. - -## Install from GitHub -After you have `rJava` up and running on your machine, install `rPHG` by -installing the source code from our GitHub repository: - -```{r, eval=FALSE, echo=TRUE} -if (!require("devtools")) install.packages("devtools") -devtools::install_github(repo = "maize-genetics/rPHG") -``` - -After source code has been compiled, the package can be loaded using: - -```{r, eval=FALSE, echo=TRUE} library(rPHG) +logFile <- tempfile(fileext = ".txt") +configFile <- tempfile() +rPHG:::createConfigFile(configFile) ``` -Or, if you want to use a function without violating your environment you can -use `rPHG::`, where `` is an `rPHG` function. - - -## Preliminary steps - -### Setting Memory -Since genome-wide association analyses can use up a lot of computational -resources, memory allocation to `rPHG` can be modified. To change the amount -of memory, use the base `options()` function and modify the following parameter: - -```{r, eval=FALSE, echo=TRUE} -options(java.parameters = c("-Xmx", "-Xms")) -``` - -Replace `` with a specified unit of memory. For example, if I want to -allocate a maximum of 6 GB of memory for my operations, I would use the input -`"-Xmx6g"`, where `g` stands for gigabyte (GB). More information about memory -allocation can be found [here](https://stackoverflow.com/questions/14763079/what-are-the-xms-and-xmx-parameters-when-starting-jvm). - -**NOTE:** Setting Java memory options for `rPHG` and any `rJava`-related packages -*needs* to be set *before* loading the `rPHG` package! - -### The importance of logging your progress -Before we begin analyzing data, optional parameters can be set up to make -`rPHG` more efficient. To prevent your R console from being overloaded with -PHG logging information, **it is highly recommended that you start a logging -file**. This file will house all of PHG's logging output which is -beneficial for debugging and tracking the progress of your analytical workflow. -To start a logging file, use the following command: - -```{r, eval=FALSE, echo=TRUE} -rPHG::startLogger(fullPath = NULL, fileName = NULL) -``` - -If the `rPHG::startLogger()` parameters are set to `NULL`, the logging file -will be created in your current working directory. If you are unsure of what -your working directory is in R, use the base `getwd()` command. - - -Additionally, since this is a general walkthrough, certain intricacies of each -function may glossed over. If you would like to study a function in full, -refer to the R documentation by using `?` in the console, where -`` is an `rPHG`-based function. - - - -# Databases and Configuration Files - -## Overview -The idea behind the PHG is that in a given breeding program, all parental -genotypes can be sequenced at high coverage, and loaded as parental haplotypes -in a relational database. Progeny can then be sequenced at low coverage and -used to infer which parental haplotypes/genotypes from the database are most -likely present in a given progeny. - -## Database types -Currently, the PHG can use SQLite or PostgreSQL to store data for the -pan-genomic graph. For more information about how data is stored within the -database schema, please refer to our [wiki](https://bitbucket.org/bucklerlab/practicalhaplotypegraph/wiki/Home). - -## Configuration files -Access to the PHG database, regardless of database type, requires a -configuration file. This file contains various metadata needed to access the -PHG db and calculate optimal graph paths: - -* host:port -* username -* password -* database name -* database type (sqlite or postgres) - -An example database configuration can be found below: - -**SQLite example** -``` -host=localHost -user=sqlite -password=sqlite -DB=/tempFileDir/outputDir/phgTestDB_mapq48.db -DBtype=sqlite -``` - - -**PostgreSQL example** -``` -host=172.17.0.2:5432 -user=postgres -password=phgP0stgr3s -DB=phgdb -DBtype=postgres -``` - - - -# Database Access and Graph Building - -## Method calling -Once you have a PHG database and configuration file, you can proceed to the -following steps. First, you can access all availabe PHG methods from the -database using a path parameter to the database configuration file: - -```{r, eval=FALSE, echo=TRUE} -# Example path location (not run) -configPath <- "/home/bm646/Temporary/phg_tests/configSQLite.txt" - -phgMethods <- rPHG::showPHGMethods(configFile = configPath) -phgMethods -``` - -``` -## # A tibble: 7 x 5 -## method_id method_type type_name method_name description -## -## 1 1 1 ANCHOR_HAPLOTYP~ B73Ref_method Test version for ~ -## 2 2 7 REF_RANGE_GROUP refRegionGroup Group consists of~ -## 3 3 7 REF_RANGE_GROUP refInterRegionG~ Group consists of~ -## 4 4 2 ASSEMBLY_HAPLOT~ mummer4 Assembly aligned ~ -## 5 5 1 ANCHOR_HAPLOTYP~ GATK_PIPELINE GATK_PIPELINE cre~ -## 6 6 1 ANCHOR_HAPLOTYP~ CONSENSUS CONSENSUS for cre~ -## 7 7 1 ANCHOR_HAPLOTYP~ consensusTest consensusTest;det~ -``` - -The above object will produce a `tibble`-based data frame that will contain -return method data from the PHG database. Method IDs and descriptions can be -viewed for additional information detailing the methods available to use when -building the PHG graph object. - -## Graph building -Next, we can build the optimal graph object. A single function, called -`graphBuilder`, will be used with subsequent parameters: - -```{r, eval=FALSE, echo=TRUE} -phgObj <- graphBuilder( - configFile = config_path, - methods = "GATK_PIPELINE" -) -``` - -Where: - -* `configFile`: the path to our PHG database configuration file; -* `methods`: one of the prior methods in the `showMethods()` function call, - specifically, the `method_name` column (*see prior output*). - -When the graph has finished building, we can then inspect the object: - -```{r, eval=FALSE, echo=TRUE} -phgObj -``` - -``` -## class: PHGDataSet -## dim: 20 6 -## metadata(1): jObj -## assays(1): hapID -## rownames(20): R1 R11 ... R10 R20 -## rowData names(1): refRange_id -## colnames(6): LineA LineA1 ... Ref RefA1 -## colData names(0): -``` - -When built, the object that is generated is of a `PHGDataSet` class. In the -next section, we will discuss how to extract specific data from this object. - - - -# Accessing data - -## Overview -When called, the `PHGDataSet` shows the similar output to a -`SummarizedExperiment` or `RangedSummarizedExperiment` class. More information -about this commonly used Bioconductor class can be found -[here](https://bioconductor.org/packages/release/bioc/html/SummarizedExperiment.html). -This is due to the `PHGDataSet` class inheriting all methods and slot -information from a `SummarizedExperiment` class. Therefore, we can use general -accessor methods from either the `SummarizedExperiment` or `S4Vectors` -packages. Some examples are as follows: - -* `assay()` -* `colData()` -* `rowData()` -* `rowRanges()` -* `metadata()` - -A more detailed example of how these methods can be used in a `PHGDataSet` are -shown below: - -![The layout of a `PHGDataSet` class.](img/rphg_data_structure.png)\ - -The three main data types that can be extracted is: - -* `rowRanges()`; `rowData()`: reference range data -* `colData()`; `colnames()`: taxa (i.e. genotype) data -* `assay()`: haplotype or path ID data in matrix form -* `metadata()`: access to the PHG API Java object (*for advanced use only*) - -## Getting reference range data -Reference range data can be accessed via the `rowRanges()` method. To use this, -simply call this function on the prior PHG object (e.g. `phgObj` from out -prior examples): - -```{r, eval=FALSE, echo=TRUE} -# Make a `GRanges` object -rr <- SummarizedExperiment::rowRanges(phgObj) -rr -``` - -``` -## GRanges object with 20 ranges and 1 metadata column: -## seqnames ranges strand | refRange_id -## | -## R1 1 1-3500 * | R1 -## R11 1 3501-7500 * | R11 -## R2 1 7501-11000 * | R2 -## R12 1 11001-15000 * | R12 -## R3 1 15001-18500 * | R3 -## ... ... ... ... . ... -## R18 1 56001-60000 * | R18 -## R9 1 60001-63500 * | R9 -## R19 1 63501-67500 * | R19 -## R10 1 67501-71000 * | R10 -## R20 1 71001-75000 * | R20 -## ------- -## seqinfo: 1 sequence from an unspecified genome; no seqlengths -``` - -What has been extracted is an object of `GRanges` class. This is another -commonly used class in the "Bioconductor universe" to represent genomic -intervals. More information about this package can be found -[here](https://bioconductor.org/packages/release/bioc/html/GenomicRanges.html). -Within this objecct, we get specified reference range information: - -* `seqnames`: the chromosome from which this reference range is found on -* `ranges`: an `IRanges` object that contains reference range coordinates -* `strand`: which strand for each reference range (`+`, `-`, `*`) -* `refRange_id`: given reference range ID within the PHG database - -From this object, we can then use additional methods to extract more specific -details such as start/stop coordinates and width of each reference range: - -```{r, eval=FALSE, echo=TRUE} -GenomicRanges::ranges(rr) -``` - -``` -IRanges object with 20 ranges and 0 metadata columns: - start end width - - R1 1 3500 3500 - R11 3501 7500 4000 - R2 7501 11000 3500 - R12 11001 15000 4000 - R3 15001 18500 3500 - ... ... ... ... - R18 56001 60000 4000 - R9 60001 63500 3500 - R19 63501 67500 4000 - R10 67501 71000 3500 - R20 71001 75000 4000 -``` - -Due to the wonderful world of "inheritance", we can also call this function -directly on `SummarizedExperiment` objects and therefore our main `PHGDataSet` -object: - -```{r, eval=FALSE, echo=TRUE} -SummarizedExperiment::ranges(phgObj) -``` +The basic workflow of the `rPHG` package is as follows: -``` -IRanges object with 20 ranges and 0 metadata columns: - start end width - - R1 1 3500 3500 - R11 3501 7500 4000 - R2 7501 11000 3500 - R12 11001 15000 4000 - R3 15001 18500 3500 - ... ... ... ... - R18 56001 60000 4000 - R9 60001 63500 3500 - R19 63501 67500 4000 - R10 67501 71000 3500 - R20 71001 75000 4000 -``` +1. Create a connection object +2. Select a PHG "method" +3. Read data into the R environment +4. Analyze and visualize data retrieval -## Getting haplotype data -Additionally, haplotype identifiers can also be acessed from this data object. -This is obtained using the `assays()` method, calling specifically, the -haplotype ID matrix (`$hapID`): +This document introduces you to `rPHG`'s methods and grammar, and +shows you how to apply them to the previously mentioned workflow. -```{r, eval=FALSE, echo=TRUE} -SummarizedExperiment::assays(phgObj)$hapID -``` +## Creating connection objects -``` -## LineA LineA1 LineB LineB1 Ref RefA1 -## R1 41 101 61 121 21 81 -## R11 51 111 71 131 31 91 -## R2 42 102 62 122 22 82 -## R12 52 112 72 132 32 92 -## R3 43 103 63 123 23 83 -## R13 53 113 73 133 33 93 -## R4 44 104 64 124 24 84 -## R14 54 114 74 134 34 94 -## R5 45 105 65 125 25 85 -## R15 55 115 75 135 35 95 -## R6 46 106 66 126 26 86 -## R16 56 116 76 136 36 96 -## R7 47 107 67 127 27 87 -## R17 57 117 77 137 37 97 -## R8 48 108 68 128 28 88 -## R18 58 118 78 138 38 98 -## R9 49 109 69 129 29 89 -## R19 59 119 79 139 39 99 -## R10 50 110 70 130 30 90 -## R20 60 120 80 140 40 100 -``` +PHG databases can be connected through two primary sources: -The above matrix represents a haplotype ID for each taxa (column names) within -the PHG database at each given reference range (row names). +- local +- server +Local connections are for databases set up to use PostgreSQL or SQLite +management systems, typically located either on a local machine or +hosted on a high performance compute cluster which are accessed via +the PHG API. -## Getting taxa information -We can also retrieve taxa (e.g. sample) information from a `PHGDataSet` -object for each reference range and haplotype IDs or for a given collection of -reference range IDs. This can be achieved using the `taxaByNode()` function. -We can retrieve taxa information by either passing a collection of reference -range IDs or for convenience sake, a genomic range consisting of three -elements: +Conversely, server connections are for databases served on publicly +available web services leveraging Breeding API (BrAPI) endpoints for +data retrieval. For example, +[demo.hub.maizegenetics.net](demo.hub.maizegenetics.net) is a publicly +available PHG database housing information many known diversity +populations in maize. -* `start` Start position (bp) of range -* `end` End position (bp) of range -* `seqname` A sequence name (e.g. chromosome ID) of query range +### Establishing a local connection -For example, if we would want to retrieve taxa information for reference -ranges that fall within bp `1` and `35000` of chromosome `1` in our graph, we -could enter the following: +To set up a local connection, prior knowledge about how configuration +files are set up is needed. If you would like more information about +this topic, please see the vignette "[Overview of configuration +files](rphg_config_files.html)" -```{r, eval=FALSE, echo=TRUE} -qTaxa <- taxaByNode(phgObj, start = 1, end = 35000, seqnames = "1") -head(qTaxa) -``` +We can supply a path to a valid configuration file to the constructor, +`PHGLocalCon()`: -``` -## # A tibble: 18 × 3 -## ref_range_id hap_id taxa_id -## -## 1 1 112 -## 2 1 113 -## 3 1 114 -## 4 2 103 -## 5 2 104 -## 6 2 105 +```{r, echo=TRUE, eval=TRUE} +configFile |> PHGLocalCon() ``` -...where `qTaxa` is a `tibble` object containing three columns: +Here, our configuration file path (`configFilePath`) is parsed to +create an object of type `PHGLocalCon`. -* `ref_range_id`: reference range ID -* `hap_id`: haplotype ID found within the given reference range -* `taxa_id`: a list of atomic vectors containing taxa IDs represented as - character. +### Establishing a server connection -If we would want to get taxa for a specific haplotype ID, we could use some -simple `dplyr` logic: +If you would like to use a PHG web service, we can use the following +similar method: -```{r, eval=FALSE, echo=TRUE} -library(dplyr) -qTaxa |> - filter(hap_id == "112") |> - pull(taxa_id) |> - unlist() +```{r, echo=TRUE, eval=TRUE} +"demo.hub.maizegenetics.net" |> PHGServerCon() ``` -If we know exactly what set of reference range IDs we want, we can override -the range parameters and use the `rrSet` parameter which takes a vector -of reference range IDs: - -```{r, eval=FALSE, echo=TRUE} -# Get taxa set in reference ranges 1 and 5 -taxaByNode(phgObj, rrSet = c(1, 5)) -``` +Here, a URL pointing to a PHG web service is supplied to the +constructor `PHGServerCon()` which will be parsed to create an object +of type `PHGServerCon`. -Additionally, users can visualize sections of the graph and highlighted -paths using the `plotGraph()` function: - -```{r, eval=FALSE, echo=TRUE} -phgObj |> - plotGraph( - seqnames = 1, - start = 1000, - end = 100000, - samples = c("Z001E0001", "Z001E0002", "Z001E0004", "Z001E0096") - ) -``` +## PHG Methods -![](img/visnetwork_01.png) -The `samples` parameter is a collection of sample IDs found in the PHG object. -This can be specified to NULL if you would like _all_ samples to be included -for each selected reference range. - -A path can be highlighted for a given taxa/sample ID by entering the ID in -the `sampleHighlight` parameter: - -```{r, eval=FALSE, echo=TRUE} -phgObj |> - plotGraph( - seqId = 1, - start = 1000, - end = 100000, - samples = c("Z001E0001", "Z001E0002", "Z001E0004", "Z001E0096"), - sampleHighlight = "Z001E0001" - ) +```{r, echo=TRUE, eval=TRUE} +configFile |> + PHGLocalCon() |> + showPHGMethods() ``` - -![](img/visnetwork_02.png) - -Highlight colors can also be defined with the `colMajor` and `colMinor` -parameters: - -```{r, eval=FALSE, echo=TRUE} -phgObj |> - plotGraph( - seqId = 1, - start = 1000, - end = 100000, - samples = c("Z001E0001", "Z001E0002", "Z001E0004", "Z001E0096"), - sampleHighlight = "Z001E0001", - colMajor = "#4287f5", - colMinor = "#818ea3" - ) +```{r, echo=TRUE, eval=TRUE} +configFile |> + PHGLocalCon() |> + PHGMethod("PATH_METHOD") ``` -![](img/visnetwork_03.png) +## Reading data +### Read samples (e.g. taxa) -## Access Java data -(**NOTE**: *for advanced use only!*) To access Java object data for the PHG API, -the `metadata()` method from `S4Vectors` can be used. Doing so will return a -Java reference object that can be used for defining you own potential functions -and methods that do not exist within the `rPHG` package: - -```{r, eval=FALSE, echo=TRUE} -S4Vectors::metadata(phgObj)$jObj -``` - -``` -## [1] "Java-Object{net.maizegenetics.pangenome.api.HaplotypeGraph@f381794}" +```{r, echo=TRUE, eval=TRUE} +configFile |> + PHGLocalCon() |> + PHGMethod("PATH_METHOD") |> + readSamples() ``` +### Read reference ranges - -# Summary Functions - -## Overview -Additionally, `rPHG` currently has several summary- and visualization-based -functions. These include ways to determine levels of similarity between -reference ranges and taxa. - -## Determine numbers of haplotypes per reference range -To see the total number of haplotypes at each given reference range, the -function, `numHaploPerRange()` can be used: - -```{r, eval=FALSE, echo=TRUE} -rPHG::numHaploPerRange(phgObject = phgObj) +```{r, echo=TRUE, eval=TRUE} +configFile |> + PHGLocalCon() |> + PHGMethod("PATH_METHOD") |> + readRefRanges() ``` -``` -## DataFrame with 20 rows and 5 columns -## names start end width numHaplotypes -## -## 1 R1 1 3500 3500 6 -## 2 R11 3501 7500 4000 6 -## 3 R2 7501 11000 3500 6 -## 4 R12 11001 15000 4000 6 -## 5 R3 15001 18500 3500 6 -## ... ... ... ... ... ... -## 16 R18 56001 60000 4000 6 -## 17 R9 60001 63500 3500 6 -## 18 R19 63501 67500 4000 6 -## 19 R10 67501 71000 3500 6 -## 20 R20 71001 75000 4000 6 -``` - -The data that is returned will contain each reference range coordinate, IDs, -and the number of haplotypes per range (`numHaplotypes`). This data can also -be passed to a plotting function, `plotNumHaplo()` which will display the -prior data as a linear genomic plot. If you are familiar with pipe (`%>%`) -operators in R via the `magrittr` package, this pipeline from `PHGDataSet` to -visualization can be used as well: - -```{r, eval=FALSE, echo=TRUE} -library(magrittr) - -# (1) Non-pipe example -haploPlot <- plotNumHaplo(numHaploPerRange(phgObject = phgObj)) +### Read haplotype ID matrix -# (2) Pipe example. Need to load `magrittr` package first! -haploPlot <- phgObj %>% - rPHG::numHaploPerRange() %>% - rPHG::plotNumHaplo() - -# Return visualization -haploPlot +```{r, echo=TRUE, eval=TRUE} +configFile |> + PHGLocalCon() |> + PHGMethod("PATH_METHOD") |> + readHaplotypeIds() ``` -![Visualize haplotype numbers per reference range.](img/num_hap_plot.png)\ - -Each reference range is displayed as blue-colored rectangle based on its -physical position within the genome while the y-axis denotes the total number -of unique haplotype IDs per reference range. - - -## Visualize mutual information between pairs of ranges -`plotMutualInfo()` plots the “amount of mutual information” obtained about one -random variable through observing the other random variable. The higher the -numeric value, the more related taxa for a given reference range. - -For this function, a `PHGDataSet` and reference range IDs in the form of a -vector (e.g. `c("R1", "R2", "R3")`) are needed. This function can also be piped -using the `%>%` operator from `magrittr`. +## `PHGDataSet` objects -```{r, eval=FALSE, echo=TRUE} -library(magrittr) - -phgObj %>% - rPHG::plotMutualInfo( - refRanges = assays(phgObj)$hapID %>% - rownames() - ) +```{r, echo=TRUE, eval=TRUE, message=FALSE} +configFile |> + PHGLocalCon() |> + PHGMethod("PATH_METHOD") |> + readPHGDataSet() ``` -![Visualize reference range "relatedness".](img/corrplot_example.png)\ - - - +## Analyzing and visualizing data +# +# +# +# +# +# +# +# From 5c9420516e30b3418107f241b592f43df0aa134f Mon Sep 17 00:00:00 2001 From: Brandon Date: Fri, 29 Sep 2023 19:37:48 -0400 Subject: [PATCH 29/35] Add tests --- R/class_all_generics.R | 14 ++++ R/class_phg_method.R | 67 +++++++++++---- R/constants.R | 15 +++- R/read_hap_ids.R | 91 ++++++++++++++++++++- R/read_phg_dataset.R | 13 +-- R/read_ref_ranges.R | 16 +++- R/read_samples.R | 35 ++++---- R/utilities_api_brapi.R | 88 ++++++++++---------- tests/testthat/test_class_haplotype_graph.R | 4 +- tests/testthat/test_class_phg_con_server.R | 4 +- tests/testthat/test_class_phg_dataset.R | 2 + tests/testthat/test_class_phg_method.R | 7 +- 12 files changed, 269 insertions(+), 87 deletions(-) diff --git a/R/class_all_generics.R b/R/class_all_generics.R index a7a4a81..e8ae83d 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -115,6 +115,20 @@ setGeneric("host", function(object, ...) standardGeneric("host")) setGeneric("httProtocol", function(object, ...) standardGeneric("httProtocol")) +## ---- +#' @title Return demo state +#' +#' @description +#' Returns logical of demo state for \code{rPHG} objects +#' +#' @param object an \code{rPHG} method object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname isDemo +#' @export +setGeneric("isDemo", function(object, ...) standardGeneric("isDemo")) + + ## ---- #' @title Return \code{rJava} reference object #' diff --git a/R/class_phg_method.R b/R/class_phg_method.R index baa977f..67ae941 100644 --- a/R/class_phg_method.R +++ b/R/class_phg_method.R @@ -15,11 +15,13 @@ setClass( Class = "PHGMethod", slots = c( methodID = "character", - phgConObj = "PHGCon" + phgConObj = "PHGCon", + isDemo = "logical" ), prototype = list( - methodID = "test", - phgConObj = new("PHGCon", phgType = "local", host = "localHost") + methodID = "test", + phgConObj = new("PHGCon", phgType = "local", host = "localHost"), + isDemo = FALSE ) ) @@ -37,16 +39,22 @@ setClass( setValidity("PHGMethod", function(object) { errors <- character() - methodIDs <- showPHGMethods( + methodIds <- showPHGMethods( object = phgConObj(object), showAdvancedMethods = TRUE )$method_name - methodID <- phgMethodId(object) - if (!methodID %in% methodIDs) { + methodId <- phgMethodId(object) + + if (!methodId %in% methodIds && !isDemo(object)) { msg <- "Method ID not found in database." errors <- c(errors, msg) } + if (phgType(phgConObj(object)) != "server" && isDemo(object)) { + msg <- "DEMO method can only be used for server connections" + errors <- c(errors, msg) + } + if (length(errors) == 0) TRUE else errors }) @@ -62,15 +70,22 @@ setValidity("PHGMethod", function(object) { #' @param methodID A PHG method identifier. #' #' @export -PHGMethod <- function(phgConObj, methodID) { +PHGMethod <- function(phgConObj, methodId) { - # # For demo purposes only! (useful for workshops) - # if (methodID == "DEMO") methodID <- "NAM_GBS_Alignments_PATHS" + demoMethodId <- "DEMO" + + # For demo purposes only! (useful for workshops) + trueMethodId <- ifelse( + test = methodId == demoMethodId, + yes = "NAM_GBS_Alignments_PATHS", + no = methodId + ) methods::new( Class = "PHGMethod", - methodID = methodID, - phgConObj = phgConObj + methodID = trueMethodId, + phgConObj = phgConObj, + isDemo = methodId == demoMethodId ) } @@ -102,7 +117,11 @@ setMethod( "local" = cli::style_bold(cli::col_green("PHGLocalCon")) ) - methodId <- cli::style_bold(cli::col_blue(phgMethodId(object))) + methodId <- cli::style_bold( + cli::col_blue( + if (isDemo(object)) "DEMO Method" else phgMethodId(object) + ) + ) msg <- c( paste0("A ", cli::style_bold("PHGMethod"), " promise object:"), @@ -117,6 +136,18 @@ setMethod( # /// Methods (general) ///////////////////////////////////////////// +## ---- +#' @rdname isDemo +#' @export +setMethod( + f = "isDemo", + signature = signature(object = "PHGMethod"), + definition = function(object) { + return(object@isDemo) + } +) + + ## ---- #' @rdname phgConObj #' @export @@ -151,11 +182,12 @@ setMethod( conObj <- phgConObj(object) conType <- phgType(conObj) conMethod <- phgMethodId(object) + conDemo <- isDemo(object) if (conType == "local") { refRangesFromLocal(conObj, conMethod) } else if (conType == "server") { - refRangesFromServer(conObj, conMethod) + refRangesFromServer(conObj, conMethod, conDemo) } } ) @@ -171,11 +203,12 @@ setMethod( conObj <- phgConObj(object) conType <- phgType(conObj) conMethod <- phgMethodId(object) + conDemo <- isDemo(object) if (conType == "local") { samplesFromLocal(conObj, conMethod) } else if (conType == "server") { - samplesFromServer(conObj, conMethod) + samplesFromServer(conObj, conMethod, conDemo) } } ) @@ -191,11 +224,12 @@ setMethod( conObj <- phgConObj(object) conType <- phgType(conObj) conMethod <- phgMethodId(object) + conDemo <- isDemo(object) if (conType == "local") { hapIdsFromLocal(conObj, conMethod) } else if (conType == "server") { - hapIdsFromSever(conObj, conMethod) + hapIdsFromSever(conObj, conMethod, conDemo) } } ) @@ -211,11 +245,12 @@ setMethod( conObj <- phgConObj(object) conType <- phgType(conObj) conMethod <- phgMethodId(object) + conDemo <- isDemo(object) if (conType == "local") { phgDataSetFromLocal(conObj, conMethod, verbose) } else if (conType == "server") { - phgDataSetFromServer(conObj, conMethod, verbose) + phgDataSetFromServer(conObj, conMethod, verbose, conDemo) } } ) diff --git a/R/constants.R b/R/constants.R index 26c46da..2a1eac4 100644 --- a/R/constants.R +++ b/R/constants.R @@ -12,7 +12,20 @@ BRAPI_ENDPOINTS <- list( ## ---- # Commonly used BrAPI parameters BRAPI_PARAMS <- list( - "PAGE_SIZE" = "pageSize=%i" + "DEMO_N_RR_SIZE" = 5, + "DEMO_N_RR_TOTAL" = 25, + "DEMO_N_SAMPLES" = 5, + "MAX_N_RR_SIZE" = 5000, + "MAX_N_RR_TOTAL" = 150000, + "MAX_N_SAMPLES" = 10000, + "PAGE_SIZE" = "pageSize=%i", + "REST_QUERY" = "?", + "REST_KV_SEP" = "&", + "METHOD_ID_KEY" = "variantSetDbId=%s", + "METHOD_RR_SIZE" = "dimensionCallSetPageSize=%i", + "METHOD_RR_PAGE" = "dimensionCallSetPage=%i", + "METHOD_SAMPLE_SIZE" = "dimensionVariantPageSize=%i", + "METHOD_SAMPLE_PAGE" = "dimensionVariantPagePage=%i" ) diff --git a/R/read_hap_ids.R b/R/read_hap_ids.R index 4e9618f..48f2948 100644 --- a/R/read_hap_ids.R +++ b/R/read_hap_ids.R @@ -16,8 +16,95 @@ hapIdsFromLocal <- function(conObj, conMethod) { # # @param conObj A PHG connection object # @param conMethod A PHG database method ID -hapIdsFromSever <- function(conObj, conMethod) { - print("WIP for `hapIdsFromServer`") +# @param conDemo Is this method of type 'DEMO' +hapIdsFromSever <- function(conObj, conMethod, conDemo) { + bullet <- cli::col_grey(cli::symbol$info) + verbInfo <- c( + paste0(" ", bullet, " Determining page size..."), + paste0(" ", bullet, " Retrieving data..."), + paste0(" ", bullet, " Cleaning up data...") + ) + + brapiUrl <- brapiURL(conObj) + + maxRRSize <- ifelse( + test = conDemo, + yes = BRAPI_PARAMS$DEMO_N_RR_SIZE, + no = BRAPI_PARAMS$MAX_N_RR_SIZE + ) + maxSampleSize <- ifelse( + test = conDemo, + yes = BRAPI_PARAMS$DEMO_N_SAMPLES, + no = BRAPI_PARAMS$MAX_N_SAMPLES + ) + + initRespUrl <- file.path( + brapiUrl, + amUrlContextStringBuilder( + methodId = conMethod, + rrPageSize = maxRRSize, + rrPage = 0, + samplePageSize = maxSampleSize, + samplePage = 0 + ) + ) + + message(verbInfo[1]) + initResp <- rPHG:::parseJSON(initRespUrl) + pageSizeDf <- initResp$result$pagination + + totalPages <- ifelse( + test = conDemo, + yes = BRAPI_PARAMS$DEMO_N_RR_TOTAL / BRAPI_PARAMS$DEMO_N_RR_SIZE, + no = pageSizeDf[pageSizeDf$dimension == "VARIANTS", "totalPages"] + ) + + respVector <- vector("list", length = totalPages) + respVector[[1]] <- initResp + + respUrls <- file.path( + brapiUrl, + amUrlContextStringBuilder( + methodId = conMethod, + rrPageSize = maxRRSize, + rrPage = seq(2, totalPages) - 1, + samplePageSize = maxSampleSize, + samplePage = 0 + ) + ) + + message(verbInfo[2]) + pb <- txtProgressBar( + min = 0, + max = totalPages, + initial = 1, + width = 30, + char = "=", + style = 3 + ) + i <- 2 + for (url in respUrls) { + respVector[[i]] <- rPHG:::parseJSON(url) + setTxtProgressBar(pb, i) + i <- i + 1 + } + close(pb) + + message(verbInfo[3]) + fullResp <- do.call( + what = "cbind", + args = lapply( + X = respVector, + FUN = function(x) { + x$result$dataMatrices$dataMatrix[[1]] + } + ) + ) + + colnames(fullResp) <- paste0("R", seq_len(ncol(fullResp))) + rownames(fullResp) <- rPHG:::samplesFromServer(conObj, conMethod, conDemo) + + return(fullResp) } diff --git a/R/read_phg_dataset.R b/R/read_phg_dataset.R index b9fa6dd..72e309a 100644 --- a/R/read_phg_dataset.R +++ b/R/read_phg_dataset.R @@ -34,7 +34,7 @@ phgDataSetFromLocal <- function(conObj, conMethod, verbose) { # @param conObj A PHG connection object # @param conMethod A PHG database method ID # @param verbose Show console log info -phgDataSetFromServer <- function(conObj, conMethod, verbose) { +phgDataSetFromServer <- function(conObj, conMethod, conDemo, verbose) { bullet <- cli::col_red(cli::symbol$warning) verbInfo <- c( paste0(bullet, cli::style_bold(" (WIP)"), " Getting reference range data..."), @@ -43,15 +43,18 @@ phgDataSetFromServer <- function(conObj, conMethod, verbose) { ) if (verbose) message(verbInfo[1]) - # TODO + gr <- refRangesFromServer(conObj, conMethod, conDemo) if (verbose) message(verbInfo[2]) - # TODO + hm <- hapIdsFromSever(conObj, conMethod, conDemo) if (verbose) message(verbInfo[3]) - # TODO + phgSE <- SummarizedExperiment::SummarizedExperiment( + assays = list(pathMatrix = t(hm)), + rowRanges = gr + ) - return(NULL) + return(methods::new(Class = "PHGDataSet", phgSE)) } diff --git a/R/read_ref_ranges.R b/R/read_ref_ranges.R index 1bedb03..b3bc74e 100644 --- a/R/read_ref_ranges.R +++ b/R/read_ref_ranges.R @@ -15,12 +15,24 @@ refRangesFromLocal <- function(conObj, conMethod) { # # @param conObj A PHG connection object # @param conMethod A PHG database method ID -refRangesFromServer <- function(conObj, conMethod) { +# @param conDemo Is this method of type 'DEMO' +refRangesFromServer <- function(conObj, conMethod, conDemo) { finalUrl <- file.path( brapiURL(conObj), BRAPI_ENDPOINTS$VARIANT_TABLES, conMethod, - sprintf("%s?pageSize=%i", BRAPI_ENDPOINTS$VARIANTS, 150000) + sprintf( + "%s?%s", + BRAPI_ENDPOINTS$VARIANTS, + sprintf( + BRAPI_PARAMS$PAGE_SIZE, + if (conDemo) { + BRAPI_PARAMS$DEMO_N_RR_TOTAL + } else { + BRAPI_PARAMS$MAX_N_RR_SIZE + } + ) + ) ) rrDf <- parseJSON(finalUrl)$result$data diff --git a/R/read_samples.R b/R/read_samples.R index 9332e7e..7609908 100644 --- a/R/read_samples.R +++ b/R/read_samples.R @@ -1,3 +1,16 @@ +## ---- +# Get samples from `HaplotypeGraph` objects +# +# @param phgObj A PHG `HaplotypeGraph` object +samplesFromGraphObj <- function(phgObj) { + jArray <- rJava::.jevalArray(obj = phgObj$taxaInGraph()$toArray()) + + taxa <- unlist(lapply(jArray, function(x) x$getName())) + + return(taxa) +} + + ## ---- # Get samples from local connection # @@ -39,7 +52,8 @@ samplesFromLocal <- function(conObj, conMethod) { # # @param conObj A PHG connection object # @param conMethod A PHG database method ID -samplesFromServer <- function(conObj, conMethod) { +# @param conDemo Is this method of type 'DEMO' +samplesFromServer <- function(conObj, conMethod, conDemo) { finalUrl <- file.path( brapiURL(conObj), BRAPI_ENDPOINTS$VARIANT_TABLES, @@ -49,20 +63,11 @@ samplesFromServer <- function(conObj, conMethod) { taxaDf <- parseJSON(finalUrl)$result$data - return(taxaDf$sampleName) -} - - -## ---- -# Get samples from `HaplotypeGraph` objects -# -# @param phgObj A PHG `HaplotypeGraph` object -samplesFromGraphObj <- function(phgObj) { - jArray <- rJava::.jevalArray(obj = phgObj$taxaInGraph()$toArray()) - - taxa <- unlist(lapply(jArray, function(x) x$getName())) - - return(taxa) + if (conDemo) { + return(taxaDf$sampleName[seq_len(BRAPI_PARAMS$DEMO_N_SAMPLES)]) + } else { + return(taxaDf$sampleName) + } } diff --git a/R/utilities_api_brapi.R b/R/utilities_api_brapi.R index 24ec582..b026cb4 100644 --- a/R/utilities_api_brapi.R +++ b/R/utilities_api_brapi.R @@ -1,3 +1,48 @@ +## ---- +# Build "alle matrix" URL strings +# +# @description +# Builds URL strings for "alleleMatrix" (i.e. path method table) BrAPI +# endpoints +# +# @param methodId +# Method ID for given path/graph in PHG +# @rrPageSize +# Max allowed number of ref ranges for a given web page +# @rrPage +# Current page for ref range page collection +# @samplePageSize +# Max allowed number of samples for a given web page +# @samplePage +# Current page for samples page collection +amUrlContextStringBuilder <- function( + methodId, + rrPageSize, + rrPage, + samplePageSize, + samplePage +) { + amContextString <- sprintf( + paste0( + BRAPI_ENDPOINTS$METHOD_TABLE, # allelematrix + BRAPI_PARAMS$REST_QUERY, # ? + BRAPI_PARAMS$METHOD_ID_KEY, # variantSetDbId= + BRAPI_PARAMS$REST_KV_SEP, + BRAPI_PARAMS$METHOD_RR_SIZE, + BRAPI_PARAMS$REST_KV_SEP, + BRAPI_PARAMS$METHOD_SAMPLE_SIZE, + BRAPI_PARAMS$REST_KV_SEP, + BRAPI_PARAMS$METHOD_RR_PAGE, + BRAPI_PARAMS$REST_KV_SEP, + BRAPI_PARAMS$METHOD_SAMPLE_PAGE + ), + methodId, rrPageSize, samplePageSize, rrPage, samplePage + ) + + return(amContextString) +} + + ## ---- # Check if BrAPI `serverinfo` endpoint exists # @@ -16,7 +61,7 @@ brapiEndpointExists <- function(url, endpoint = BRAPI_ENDPOINTS$SERVER_INFO) { }, error = function(cond) NA ) - + # NOTE: test currently negates `httResp` check for all status codes. Will # keep in codebase for possible future debugging tests ifelse( @@ -35,7 +80,7 @@ brapiEndpointExists <- function(url, endpoint = BRAPI_ENDPOINTS$SERVER_INFO) { # NOTE: `url` needs `brapi/v2` or `brapi/v1` suffix. # # @param url Host URL for PHG server -# @param endpoint What endpoint to append to URL? Can be `""` for non BrAPI +# @param endpoint What endpoint to append to URL? Can be `""` for non BrAPI # tests. httpResp <- function(url, endpoint = BRAPI_ENDPOINTS$SERVER_INFO) { @@ -109,45 +154,6 @@ json2tibble <- function(object, ep, returnCall = "data") { } -## (DEFUNCT) ---- -# # @title Parse graph data -# # -# # @description Parses graph information from JSON structures -# # -# # @param object A \code{BrapiCon} object. -# # @param dbID A PHG method. -# # -# # @importFrom httr content -# # @importFrom igraph graph_from_data_frame -# json2igraph <- function(object, dbID) { -# if (missing(dbID)) stop("PHG method required", call. = FALSE) -# -# endPoint <- paste0(brapiURL(object), "/graphs/", dbID) -# res <- parseJSON(endPoint) -# -# nodes <- res$result$nodes -# edges <- res$result$edges -# taxaList <- nodes$additionalInfo$taxaList -# taxaList <- unlist(lapply(taxaList, paste, collapse = "; ")) -# -# edges <- data.frame( -# from = edges$leftNodeDbId, -# to = edges$rightNodeDbId, -# weight = edges$weight -# ) -# nodes <- data.frame( -# id = nodes$nodeDbId, -# label = taxaList -# ) -# -# igraph::graph_from_data_frame( -# d = edges, -# vertices = nodes, -# directed = TRUE -# ) -# } - - ## ---- #' @title Retrieve variant table BrAPI URLs #' diff --git a/tests/testthat/test_class_haplotype_graph.R b/tests/testthat/test_class_haplotype_graph.R index ae0a8c8..0d9bc47 100644 --- a/tests/testthat/test_class_haplotype_graph.R +++ b/tests/testthat/test_class_haplotype_graph.R @@ -5,8 +5,8 @@ test_that("Basic tests", { startLogger(logFile) createConfigFile(configFile) - # testUrl <- "phg.maizegdb.org" - testUrl <- "demo.hub.maizegenetics.net" + testUrl <- "phg.maizegdb.org" + # testUrl <- "demo.hub.maizegenetics.net" phgLocCon <- PHGLocalCon(configFile) phgSrvCon <- PHGServerCon(testUrl) diff --git a/tests/testthat/test_class_phg_con_server.R b/tests/testthat/test_class_phg_con_server.R index 9ce0a95..1d5876b 100644 --- a/tests/testthat/test_class_phg_con_server.R +++ b/tests/testthat/test_class_phg_con_server.R @@ -2,8 +2,8 @@ test_that("Basic tests", { logFile <- tempfile(fileext = ".txt") startLogger(logFile) - # testUrl <- "phg.maizegdb.org" - testUrl <- "demo.hub.maizegenetics.net" + testUrl <- "phg.maizegdb.org" + # testUrl <- "demo.hub.maizegenetics.net" phgSrvCon <- PHGServerCon(testUrl) phgSrvConOutput <- utils::capture.output(phgSrvCon) diff --git a/tests/testthat/test_class_phg_dataset.R b/tests/testthat/test_class_phg_dataset.R index 3e4d966..53d15ec 100644 --- a/tests/testthat/test_class_phg_dataset.R +++ b/tests/testthat/test_class_phg_dataset.R @@ -30,5 +30,7 @@ test_that("Basic tests.", { expected = c(10, 6) ) + plotRes <- plotGraph(testPDS, start = 1, end = 350000, seqnames = "1") + expect_true(is(plotRes, "visNetwork")) }) diff --git a/tests/testthat/test_class_phg_method.R b/tests/testthat/test_class_phg_method.R index ba0073a..c8b8d13 100644 --- a/tests/testthat/test_class_phg_method.R +++ b/tests/testthat/test_class_phg_method.R @@ -5,7 +5,7 @@ test_that("Basic tests.", { startLogger(logFile) createConfigFile(configFile) - testUrl <- "demo.hub.maizegenetics.net" + testUrl <- "phg.maizegdb.org" phgLocCon <- PHGLocalCon(configFile) phgSrvCon <- PHGServerCon(testUrl) @@ -13,6 +13,7 @@ test_that("Basic tests.", { phgMethod1 <- PHGMethod(phgLocCon, "CONSENSUS") phgMethod2 <- PHGMethod(phgLocCon, "PATH_METHOD") phgMethod3 <- PHGMethod(phgSrvCon, "NAM_GBS_Alignments_PATHS") + phgMethod4 <- PHGMethod(phgSrvCon, "DEMO") phgMethod1Output <- utils::capture.output(phgMethod1) phgMethod2Output <- utils::capture.output(phgMethod2) @@ -28,6 +29,10 @@ test_that("Basic tests.", { expect_true(is(readRefRanges(phgMethod2), "GRanges")) expect_true(is(readHaplotypeIds(phgMethod2), "matrix")) expect_true(is(readPHGDataSet(phgMethod2), "PHGDataSet")) + expect_true(is(readSamples(phgMethod4), "character")) + expect_true(is(readRefRanges(phgMethod4), "GRanges")) + expect_true(is(readHaplotypeIds(phgMethod4), "matrix")) + expect_true(is(readPHGDataSet(phgMethod4), "PHGDataSet")) expect_equal(length(phgMethod1Output), 2) expect_equal(length(phgMethod2Output), 2) From 8ec312b689fd6dd5acd694fcb60880ba84f90376 Mon Sep 17 00:00:00 2001 From: Brandon Date: Tue, 10 Oct 2023 11:15:39 -0400 Subject: [PATCH 30/35] Add tests --- NAMESPACE | 12 +- R/class_all_generics.R | 29 ++- R/class_phg_dataset.R | 32 +++ R/read_phg_dataset.R | 8 +- R/stats_taxa_by_node.R | 134 +++-------- R/utilities_api_brapi.R | 75 ------ R/utilities_general.R | 35 +-- R/vis_plot_graph.R | 28 +-- man/PHGMethod.Rd | 2 +- man/getVTList.Rd | 15 -- man/isDemo.Rd | 19 ++ man/plotGraph.Rd | 15 +- man/serverInfo.Rd | 2 +- man/taxaByNode.Rd | 28 ++- tests/test_bak/test_brapi_classes.R | 24 -- .../test_bak/test_brapi_getters_and_setters.R | 13 - tests/test_bak/test_brapi_methods.R | 222 ------------------ tests/test_bak/test_brapi_utilities.R | 80 ------- tests/test_bak/test_graph_builder.R | 17 -- tests/test_bak/test_logging_support.R | 20 -- tests/test_bak/test_path_matrix.R | 49 ---- tests/test_bak/test_show_phg_methods.R | 20 -- tests/test_bak/test_stats_and_visulization.R | 142 ----------- tests/test_bak/test_taxa_by_node.R | 49 ---- tests/test_bak/test_utilities.R | 51 ---- tests/test_bak/test_zzz.R | 8 - tests/testthat/test_class_all_generics.R | 2 + tests/testthat/test_class_phg_con.R | 2 + tests/testthat/test_class_phg_con_server.R | 1 + tests/testthat/test_class_phg_dataset.R | 1 + tests/testthat/test_class_phg_method.R | 2 +- tests/testthat/test_logging_support.R | 2 + tests/testthat/test_stats_taxa_by_node.R | 17 ++ tests/testthat/test_utilities_api_brapi.R | 12 + tests/testthat/test_utilities_api_phg.R | 19 ++ tests/testthat/test_utilities_general.R | 67 ++++++ tests/testthat/test_utilities_stats.R | 15 ++ tests/testthat/test_vis_plot_graph.R | 20 ++ vignettes/rphg_installation.R | 8 +- vignettes/rphg_walkthrough.R | 16 +- 40 files changed, 334 insertions(+), 979 deletions(-) delete mode 100644 man/getVTList.Rd create mode 100644 man/isDemo.Rd delete mode 100644 tests/test_bak/test_brapi_classes.R delete mode 100644 tests/test_bak/test_brapi_getters_and_setters.R delete mode 100644 tests/test_bak/test_brapi_methods.R delete mode 100644 tests/test_bak/test_brapi_utilities.R delete mode 100644 tests/test_bak/test_graph_builder.R delete mode 100644 tests/test_bak/test_logging_support.R delete mode 100644 tests/test_bak/test_path_matrix.R delete mode 100644 tests/test_bak/test_show_phg_methods.R delete mode 100644 tests/test_bak/test_stats_and_visulization.R delete mode 100644 tests/test_bak/test_taxa_by_node.R delete mode 100644 tests/test_bak/test_utilities.R delete mode 100644 tests/test_bak/test_zzz.R create mode 100644 tests/testthat/test_stats_taxa_by_node.R create mode 100644 tests/testthat/test_utilities_api_brapi.R create mode 100644 tests/testthat/test_utilities_api_phg.R create mode 100644 tests/testthat/test_utilities_general.R create mode 100644 tests/testthat/test_utilities_stats.R create mode 100644 tests/testthat/test_vis_plot_graph.R diff --git a/NAMESPACE b/NAMESPACE index aa566ad..80523ce 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,9 +10,9 @@ export(calcMutualInfo) export(configFilePath) export(dbName) export(dbType) -export(getVTList) export(host) export(httProtocol) +export(isDemo) export(javaMemoryAddress) export(javaRefObj) export(numHaploPerRefRange) @@ -48,6 +48,7 @@ exportMethods(dbName) exportMethods(dbType) exportMethods(host) exportMethods(httProtocol) +exportMethods(isDemo) exportMethods(javaMemoryAddress) exportMethods(javaRefObj) exportMethods(numHaploPerRefRange) @@ -67,14 +68,7 @@ exportMethods(readRefRanges) exportMethods(readSamples) exportMethods(serverInfo) exportMethods(showPHGMethods) -importFrom(GenomicRanges,GRanges) -importFrom(IRanges,IRanges) -importFrom(IRanges,subsetByOverlaps) -importFrom(S4Vectors,metadata) -importFrom(SummarizedExperiment,rowRanges) +exportMethods(taxaByNode) importFrom(curl,has_internet) importFrom(methods,setClass) -importFrom(rJava,.jcall) -importFrom(rJava,.jnew) -importFrom(rJava,J) importFrom(tibble,as_tibble) diff --git a/R/class_all_generics.R b/R/class_all_generics.R index e8ae83d..a00d939 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -377,7 +377,7 @@ setGeneric("readSamples", function(object, ...) standardGeneric("readSamples")) #' @title Return server information #' #' @description -#' Get avaiable BrAPI calls from BrAPI compliant PHG server +#' Get available BrAPI calls from BrAPI compliant PHG server #' #' @param object an \code{rPHG} local or server connection object #' @param ... Additional arguments, for use in specific methods @@ -403,3 +403,30 @@ setGeneric("serverInfo", function(object, ...) standardGeneric("serverInfo")) setGeneric("showPHGMethods", function(object, showAdvancedMethods = FALSE, ...) standardGeneric("showPHGMethods")) +## ---- +#' @title Return taxa info for haplotype IDs +#' +#' @description +#' Returns taxa (e.g. sample) information for a select set of reference ranges. +#' Reference ranges are identified by a user defined genomic range consisting +#' of a sequence (e.g. chromosome) ID, and start and stop positions. +#' +#' @param object an \code{rPHG} dataset +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname taxaByNode +#' @export +setGeneric("taxaByNode", function(object, ...) standardGeneric("taxaByNode")) + + + + + + + + + + + + + diff --git a/R/class_phg_dataset.R b/R/class_phg_dataset.R index ccb0c1f..47c52b1 100644 --- a/R/class_phg_dataset.R +++ b/R/class_phg_dataset.R @@ -82,3 +82,35 @@ setMethod( ) +## ---- +#' @param object A \code{PHGDataSet} object +#' @param samples Samples/taxa to include in plot +#' @param seqnames A sequence (e.g. chromosome) ID +#' @param start Start position for ref ranges +#' @param end End position for ref ranges +#' +#' @rdname taxaByNode +#' @export +setMethod( + f = "taxaByNode", + signature = signature(object = "PHGDataSet"), + definition = function( + object, + samples = NULL, + seqnames, + start, + end + ) { + return( + taxaByNodeCore( + object, + samples, + seqnames, + start, + end + ) + ) + } +) + + diff --git a/R/read_phg_dataset.R b/R/read_phg_dataset.R index 72e309a..5160eea 100644 --- a/R/read_phg_dataset.R +++ b/R/read_phg_dataset.R @@ -35,11 +35,11 @@ phgDataSetFromLocal <- function(conObj, conMethod, verbose) { # @param conMethod A PHG database method ID # @param verbose Show console log info phgDataSetFromServer <- function(conObj, conMethod, conDemo, verbose) { - bullet <- cli::col_red(cli::symbol$warning) + bullet <- cli::style_bold(cli::symbol$tick) verbInfo <- c( - paste0(bullet, cli::style_bold(" (WIP)"), " Getting reference range data..."), - paste0(bullet, cli::style_bold(" (WIP)"), " Getting haplotype matrix data..."), - paste0(bullet, cli::style_bold(" (WIP)"), " Constructing PHGDataSet...") + paste0(bullet, " Getting reference range data..."), + paste0(bullet, " Getting haplotype matrix data..."), + paste0(bullet, " Constructing PHGDataSet...") ) if (verbose) message(verbInfo[1]) diff --git a/R/stats_taxa_by_node.R b/R/stats_taxa_by_node.R index 3a1cbb8..47396b3 100644 --- a/R/stats_taxa_by_node.R +++ b/R/stats_taxa_by_node.R @@ -1,110 +1,46 @@ ## ---- -#' @title Get taxa data for selected reference ranges -#' -#' @description -#' Base code to get assembly information from haplotype node objects -#' -#' @param phgObj An object of class \code{PHGDataSet}. -#' @param start Start position (bp) for reference range filtering. -#' @param end End position (bp) for reference range filtering. -#' @param seqnames Sequence name (e.g. chromosome ID) for reference range -#' filtering. -#' @param rrSet A collection of reference range IDs. Defaults to \code{NULL} -#' if specified with an integer vector, \code{start}, \code{end}, and -#' \code{seqnames} parameters will be ignored. -#' -#' @importFrom IRanges IRanges -#' @importFrom IRanges subsetByOverlaps -#' @importFrom GenomicRanges GRanges -#' @importFrom rJava J -#' @importFrom rJava .jnew -#' @importFrom rJava .jcall -#' @importFrom S4Vectors metadata -#' @importFrom SummarizedExperiment rowRanges -#' -#' @export -taxaByNode <- function( - phgObj, - start = NULL, - end = NULL, - seqnames = NULL, - rrSet = NULL +# @title Get taxa data for selected reference ranges +# +# @description +# Returns taxa (e.g. sample) information for a select set of reference ranges. +# Reference ranges are identified by a user defined genomic range consisting +# of a sequence (e.g. chromosome) ID, and start and stop positions. +# +# @param x A \code{PHGDataSet} object +# @param samples Samples/taxa to include in plot +# @param seqnames A sequence (e.g. chromosome) ID +# @param start Start position for ref ranges +# @param end End position for ref ranges +taxaByNodeCore <- function( + x, + samples = NULL, + seqnames, + start, + end ) { - # Get valid ref ranges from PHGDataSet - if (is.null(rrSet)) { - if (is.null(start)) { - stop("Genomic range parameters are needed") - } - if (is.null(end)) { - stop("Genomic range parameters are needed") - } - if (is.null(seqnames)) { - stop("Genomic range parameters are needed") - } - q <- GenomicRanges::GRanges( - seqnames = seqnames, - ranges = IRanges::IRanges( - start = start, - end = end - ) - ) - - rrSet <- gsub( - pattern = "R", - replacement = "", - x = IRanges::subsetByOverlaps( - SummarizedExperiment::rowRanges(phgObj), - q - )$refRange_id - ) - } - - jGObj <- S4Vectors::metadata(phgObj)$jObj - taxaBNDriver <- rJava::.jnew( - rJava::J("net.maizegenetics.pangenome.utils.TaxaByNodeByRangePlugin"), - rJava::.jnull("java/awt/Frame"), - FALSE + # Filter by taxa and ref ranges + if (is.null(samples)) samples <- colnames(x) + hapTableMini <- x[, colnames(x) %in% samples] + hapTableMini <- IRanges::subsetByOverlaps( + hapTableMini, + GenomicRanges::GRanges(seqnames = seqnames, ranges = start:end) ) - dataSet <- rJava::J("net.maizegenetics.plugindef.DataSet") - - sortSet <- .jnew("java.util.TreeSet") - for (rr in rrSet) { - sortSet$add(.jnew("java.lang.Integer", as.integer(rr))) - } - - taxaBNDriver$rangeIds(sortSet) - res <- taxaBNDriver$performFunction(dataSet$getDataSet(jGObj))$ - getData(0L)$ - getData() + # Get hap ID matrix + currentMatrix <- t(SummarizedExperiment::assay(hapTableMini)) + currentMatrix[is.na(currentMatrix)] <- -128 + colnames(currentMatrix) <- gsub("R", "", colnames(currentMatrix)) |> + as.numeric() - rrIds <- .jcall(res$keySet(), "[Ljava/lang/Object;", "toArray") |> - lapply(function(i) i$toString()) |> - unlist() + # Get ref range data frame + refRangeDataMini <- rowRanges(hapTableMini) |> as.data.frame() - rootValArr <- .jcall(res$values(), "[Ljava/lang/Object;", "toArray") - assemblies <- lapply(rootValArr, function(i) { - tmp <- .jcall(i$values(), "[Ljava/lang/Object;", "toArray") - lapply(tmp, function(j) { - j$toArray() |> - lapply(function(k) k$toString()) |> - unlist() - }) + # Group taxa by hap ID and ref range + taxaGroups <- lapply(seq_len(ncol(currentMatrix)), function(i) { + split(rownames(currentMatrix), currentMatrix[, i]) }) - nodeIds <- lapply(rootValArr, function(i) { - i$keySet() |> - .jcall("[Ljava/lang/Object;", "toArray") |> - lapply(function(j) j$toString()) |> - unlist() - }) - - for (i in seq_along(assemblies)) { - names(assemblies[[i]]) <- nodeIds[[i]] - } - - names(assemblies) <- rrIds - return(tnHashMapToTibble(assemblies)) + return(taxaGroups) } diff --git a/R/utilities_api_brapi.R b/R/utilities_api_brapi.R index b026cb4..a643ae9 100644 --- a/R/utilities_api_brapi.R +++ b/R/utilities_api_brapi.R @@ -154,78 +154,3 @@ json2tibble <- function(object, ep, returnCall = "data") { } -## ---- -#' @title Retrieve variant table BrAPI URLs -#' -#' @description Returns a list of three BrAPI endpoints: (1) sample, (2) -#' variants (i.e. reference ranges), and (3) table info. -#' -#' @param x A \code{BrapiConPHG} object. -#' @export -getVTList <- function(x) { - if (class(x) != "BrapiConPHG") { - stop("A `BrapiConPHG` object is needed for the LHS argument", call. = FALSE) - } - - if (x@methodID == "DEMO") { - baseURL <- paste0(x@url, "/variantTables/", "282_GBS_Alignments_PATHS") - } else { - baseURL <- paste0(x@url, "/variantTables/", x@methodID) - } - - ranges <- x@refRangeFilter - samples <- x@sampleFilter - - rangeURL <- paste0( - baseURL, - "/variants", - ifelse(is.na(ranges), "", paste0("?", ranges)) - ) - - sampleURL <- paste0( - baseURL, - "/samples", - ifelse(is.na(samples), "", paste0("?", samples)) - ) - - # tableURL <- paste0( - # baseURL, "/table", "?", - # ifelse(is.na(ranges), "", paste0(ranges)), "&", - # ifelse(is.na(samples), "", paste0(samples)) - # ) - # tableURL <- gsub("\\?$|\\?&$", "", tableURL) - # tableURL <- gsub("\\?&", "?", tableURL) - - if (x@methodID == "DEMO") { - tableURL <- paste0( - brapiURL(x), - "/allelematrix", - "?variantSetDbId=", "282_GBS_Alignments_PATHS", - "&dimensionVariantPageSize=250", # currently hardcoded - "&dimensionCallSetPageSize=25", # currently hardcoded - "&dimensionVariantPage=%i", - "&dimensionCallSetPage=%i" - ) - } else { - tableURL <- paste0( - brapiURL(x), - "/allelematrix", - "?variantSetDbId=", x@methodID, - "&dimensionVariantPageSize=10000", # currently hardcoded - "&dimensionCallSetPageSize=5000", # currently hardcoded - "&dimensionVariantPage=%i", - "&dimensionCallSetPage=%i" - ) - } - - - return( - list( - rangeURL = rangeURL, - sampleURL = sampleURL, - tableURL = tableURL - ) - ) -} - - diff --git a/R/utilities_general.R b/R/utilities_general.R index f25da19..fd9f4a3 100644 --- a/R/utilities_general.R +++ b/R/utilities_general.R @@ -123,8 +123,9 @@ parseConfigFile <- function(file) { getProperty <- function(configLines, x) { regexField <- paste0("^", x, "=") - property <- configLines[grepl(regexField, configLines)] |> - gsub("^.*=", "", x = _) + matchingLines <- configLines[grepl(regexField, configLines)] + + property <- gsub("^.*=", "", x = matchingLines) return(property) } @@ -165,33 +166,3 @@ descriptionStringToList <- function(s) { } -## ---- -# Convert PHG HashMap to tibble -# -# @param x HashMap to R list -tnHashMapToTibble <- function(x) { - rrNames <- names(x) - hapNames <- lapply(x, names) - - rrNamesVec <- lapply(seq_along(hapNames), function(i) { - rep(rrNames[i], length(hapNames[[i]])) - }) |> unlist() - - hapNamesVec <- unlist(hapNames) - taxaIdVec <- lapply(seq_along(hapNames), function(i) { - tmpCache <- x[[i]] - lapply(seq_along(tmpCache), function(j) { - tmpCache[[j]] - }) - }) - - return( - tibble::tibble( - ref_range_id = rrNamesVec, - hap_id = hapNamesVec, - taxa_id = taxaIdVec |> unlist(recursive = FALSE) - ) - ) -} - - diff --git a/R/vis_plot_graph.R b/R/vis_plot_graph.R index 3687d1a..1567f88 100644 --- a/R/vis_plot_graph.R +++ b/R/vis_plot_graph.R @@ -43,11 +43,10 @@ plotGraphCore <- function( # Get hap ID matrix currentMatrix <- t(SummarizedExperiment::assay(hapTableMini)) currentMatrix[is.na(currentMatrix)] <- -128 - colnames(currentMatrix) <- gsub("R", "", colnames(currentMatrix)) |> - as.numeric() + colnames(currentMatrix) <- as.numeric(gsub("R", "", colnames(currentMatrix))) # Get ref range data frame - refRangeDataMini <- rowRanges(hapTableMini) |> as.data.frame() + refRangeDataMini <- as.data.frame(rowRanges(hapTableMini)) # Group taxa by hap ID and ref range taxaGroups <- lapply(seq_len(ncol(currentMatrix)), function(i) { @@ -55,10 +54,10 @@ plotGraphCore <- function( }) # Generate distinct IDs (hap ID + ref range ID) - hapIds <- currentMatrix |> apply(2, unique, simplify = FALSE) - hapLevels <- rep(names(hapIds), vapply(hapIds, length, integer(1))) |> as.numeric() + hapIds <- apply(currentMatrix, 2, unique, simplify = FALSE) + hapLevels <- as.numeric(rep(names(hapIds), vapply(hapIds, length, integer(1)))) fullHapIds <- paste0( - lapply(hapIds, function(i) i[order(i)]) |> unlist(), + unlist(lapply(hapIds, function(i) i[order(i)])), "_", hapLevels ) @@ -68,9 +67,9 @@ plotGraphCore <- function( paste0("Taxa: ", paste(i, collapse = ", "), "

") }, character(1)) } - tooltipVec <- lapply(taxaGroups, taxaToHtml) |> unlist() + tooltipVec <- unlist(lapply(taxaGroups, taxaToHtml)) - refRangeHtml <- lapply(hapLevels, function(i) { + refRangeHtml <- unlist(lapply(hapLevels, function(i) { paste0( "

Chr: ", refRangeDataMini[i, ]$seqnames, @@ -81,7 +80,7 @@ plotGraphCore <- function( refRangeDataMini[i, ]$end, "
" ) - }) |> unlist() + })) # Final graph data (nodes) nodes <- data.frame( @@ -108,10 +107,10 @@ plotGraphCore <- function( ln <- paste0(currentMatrix[, i], "_", i) rn <- paste0(currentMatrix[, i + 1], "_", i + 1) - cnxn <- paste0(ln, "+", rn) |> unique() + cnxn <- unique(paste0(ln, "+", rn)) for (c in cnxn) { - splits <- strsplit(c, "\\+") |> unlist() + splits <- unlist(strsplit(c, "\\+")) f <- which(fullHapIds == splits[1]) t <- which(fullHapIds == splits[2]) lne <- c(lne, f) @@ -125,7 +124,8 @@ plotGraphCore <- function( ) # Return vis.js object - visNetwork::visNetwork(nodes, edges) |> - visNetwork::visEdges(arrows = "to") |> - visNetwork::visHierarchicalLayout(direction = "LR") + network <- visNetwork::visNetwork(nodes, edges) + edges <- visNetwork::visEdges(network, arrows = "to") + layout <- visNetwork::visHierarchicalLayout(network, direction = "LR") + return(layout) } diff --git a/man/PHGMethod.Rd b/man/PHGMethod.Rd index f490366..fabcfee 100644 --- a/man/PHGMethod.Rd +++ b/man/PHGMethod.Rd @@ -4,7 +4,7 @@ \alias{PHGMethod} \title{Helper function to construct PHGMethod object} \usage{ -PHGMethod(phgConObj, methodID) +PHGMethod(phgConObj, methodId) } \arguments{ \item{phgConObj}{A \code{\linkS4class{PHGCon}} object.} diff --git a/man/getVTList.Rd b/man/getVTList.Rd deleted file mode 100644 index ebd8bdf..0000000 --- a/man/getVTList.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities_api_brapi.R -\name{getVTList} -\alias{getVTList} -\title{Retrieve variant table BrAPI URLs} -\usage{ -getVTList(x) -} -\arguments{ -\item{x}{A \code{BrapiConPHG} object.} -} -\description{ -Returns a list of three BrAPI endpoints: (1) sample, (2) - variants (i.e. reference ranges), and (3) table info. -} diff --git a/man/isDemo.Rd b/man/isDemo.Rd new file mode 100644 index 0000000..b2b976c --- /dev/null +++ b/man/isDemo.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_method.R +\name{isDemo} +\alias{isDemo} +\alias{isDemo,PHGMethod-method} +\title{Return demo state} +\usage{ +isDemo(object, ...) + +\S4method{isDemo}{PHGMethod}(object) +} +\arguments{ +\item{object}{an \code{rPHG} method object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Returns logical of demo state for \code{rPHG} objects +} diff --git a/man/plotGraph.Rd b/man/plotGraph.Rd index 4ea4ad5..60c02d0 100644 --- a/man/plotGraph.Rd +++ b/man/plotGraph.Rd @@ -9,14 +9,13 @@ plotGraph(object, ...) \S4method{plotGraph}{PHGDataSet}( object, - samples, - sampleHighlight, - seqnames, - start, - end, - colMajor, - colMinor, - ... + samples = NULL, + sampleHighlight = NULL, + seqnames = NULL, + start = NULL, + end = NULL, + colMajor = "maroon", + colMinor = "lightgrey" ) } \arguments{ diff --git a/man/serverInfo.Rd b/man/serverInfo.Rd index 7f84540..697bb75 100644 --- a/man/serverInfo.Rd +++ b/man/serverInfo.Rd @@ -15,5 +15,5 @@ serverInfo(object, ...) \item{...}{Additional arguments, for use in specific methods} } \description{ -Get avaiable BrAPI calls from BrAPI compliant PHG server +Get available BrAPI calls from BrAPI compliant PHG server } diff --git a/man/taxaByNode.Rd b/man/taxaByNode.Rd index 7acb689..16e8194 100644 --- a/man/taxaByNode.Rd +++ b/man/taxaByNode.Rd @@ -1,25 +1,29 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stats_taxa_by_node.R +% Please edit documentation in R/class_all_generics.R, R/class_phg_dataset.R \name{taxaByNode} \alias{taxaByNode} -\title{Get taxa data for selected reference ranges} +\alias{taxaByNode,PHGDataSet-method} +\title{Return taxa info for haplotype IDs} \usage{ -taxaByNode(phgObj, start = NULL, end = NULL, seqnames = NULL, rrSet = NULL) +taxaByNode(object, ...) + +\S4method{taxaByNode}{PHGDataSet}(object, samples = NULL, seqnames, start, end) } \arguments{ -\item{phgObj}{An object of class \code{PHGDataSet}.} +\item{object}{A \code{PHGDataSet} object} + +\item{...}{Additional arguments, for use in specific methods} -\item{start}{Start position (bp) for reference range filtering.} +\item{samples}{Samples/taxa to include in plot} -\item{end}{End position (bp) for reference range filtering.} +\item{seqnames}{A sequence (e.g. chromosome) ID} -\item{seqnames}{Sequence name (e.g. chromosome ID) for reference range -filtering.} +\item{start}{Start position for ref ranges} -\item{rrSet}{A collection of reference range IDs. Defaults to \code{NULL} -if specified with an integer vector, \code{start}, \code{end}, and -\code{seqnames} parameters will be ignored.} +\item{end}{End position for ref ranges} } \description{ -Base code to get assembly information from haplotype node objects +Returns taxa (e.g. sample) information for a select set of reference ranges. +Reference ranges are identified by a user defined genomic range consisting +of a sequence (e.g. chromosome) ID, and start and stop positions. } diff --git a/tests/test_bak/test_brapi_classes.R b/tests/test_bak/test_brapi_classes.R deleted file mode 100644 index 25d3120..0000000 --- a/tests/test_bak/test_brapi_classes.R +++ /dev/null @@ -1,24 +0,0 @@ -# === Tests for BrAPI-related classes =============================== - -test_that("BrapiCon() constructuor returns correct exceptions and data", { - expect_error( - object = BrapiCon(), - regexp = "A URL host is needed to make this class.", - fixed = TRUE - ) - - - expect_error( - object = BrapiCon(host = "test-server.brapi.org", port = 80.5), - regexp = "Invalid port number. Must be a whole number.", - fixed = TRUE - ) -}) - - -test_that("PHGMethod() constructure returns correct expections and data", { - tmpBrapiCon <- BrapiCon(host = "test-server.brapi.org") - expect_no_message(PHGMethod(tmpBrapiCon, "custom-method")) -}) - - diff --git a/tests/test_bak/test_brapi_getters_and_setters.R b/tests/test_bak/test_brapi_getters_and_setters.R deleted file mode 100644 index d60b975..0000000 --- a/tests/test_bak/test_brapi_getters_and_setters.R +++ /dev/null @@ -1,13 +0,0 @@ -# === Test getter and setter methods for BrAPI classes ============== - -testCon <- BrapiCon("test-server.brapi.org", protocol = "https") - -test_that("getters return correct data", { - expect_equal(host(testCon), "test-server.brapi.org") - expect_equal(port(testCon), 443) - expect_equal(protocol(testCon), "https") - expect_equal(version(testCon), "v2") - expect_true(is.na(token(testCon))) -}) - - diff --git a/tests/test_bak/test_brapi_methods.R b/tests/test_bak/test_brapi_methods.R deleted file mode 100644 index b7a7f90..0000000 --- a/tests/test_bak/test_brapi_methods.R +++ /dev/null @@ -1,222 +0,0 @@ -# === Test BrAPI methods ============================================ - -test_that("BrapiCon() constructor returns correct data", { - testObj <- capture.output(BrapiCon(host = "test-server.brapi.org")) - expect_equal(length(testObj), 5) - - testCon <- BrapiCon(host = "test-server.brapi.org") - - testObj <- serverInfo(testCon) - expect_true(inherits(testObj, "data.frame")) - - testObj <- references(testCon) - expect_true(inherits(testObj, "data.frame")) - - testObj <- referenceSets(testCon) - expect_true(inherits(testObj, "data.frame")) -}) - - -test_that("availablePHGMethods() returns correct data", { - urlTest <- "phg.maizegdb.org" - testCon <- BrapiCon(urlTest) - - expect_true(is(availablePHGMethods(testCon), "tbl")) - expect_true(is(availablePHGMethods(testCon), "tbl_df")) - expect_true(is(availablePHGMethods(testCon), "data.frame")) - - expect_equal( - object = colnames(availablePHGMethods(testCon)), - expected = c("variantTableDbId","numVariants", "numSamples", "additionalInfo") - ) -}) - - -test_that("BrapiConPHG() constructor returns correct data", { - urlTest <- "test-server.brapi.org" - testCon <- BrapiCon(urlTest) - bcPHG <- capture.output(PHGMethod(testCon, "test_method")) - expect_equal(length(bcPHG), 4) -}) - - -test_that("filterRefRanges() returns correct data", { - urlTest <- "test-server.brapi.org" - testMethod <- "test_method" - - testCon <- BrapiCon(urlTest) - bcPHG <- PHGMethod(testCon, testMethod) - - testGR <- GenomicRanges::GRanges( - seqnames = "1", - ranges = IRanges::IRanges(5, 10) - ) - - # Equality - expect_equal( - object = filterRefRanges(bcPHG, chromosome = 1)@refRangeFilter, - expected = "ranges=1" - ) - - expect_equal( - object = filterRefRanges( - x = bcPHG, - chromosome = 1, - start = 10, - end = 50 - )@refRangeFilter, - expected = "ranges=1:10-50" - ) - - expect_equal( - object = filterRefRanges( - x = bcPHG, - chromosome = c(1, 2), - start = c(10, 23), - end = c(50, 70) - )@refRangeFilter, - expected = "ranges=1:10-50,2:23-70" - ) - - - # Error checks - expect_error( - object = filterRefRanges(mtcars, chromosome = "1"), - regexp = "A `BrapiConPHG` object is needed" - ) - - expect_error( - object = filterRefRanges( - x = bcPHG, - start = c(10, 23), - end = c(50, 70) - ), - regexp = "Incorrect filtration" - ) - - expect_error( - object = filterRefRanges( - x = bcPHG, - chromosome = c(1, 2), - start = c(10, 23) - ), - regexp = "Incorrect filtration" - ) - - expect_error( - object = filterRefRanges( - x = bcPHG, - chromosome = c(1, 2), - start = c(10, 23), - end = c(50, 100, 150) - ), - regexp = "Range vectors do not have the same" - ) - - - # GRanges tests - expect_equal( - object = filterRefRanges( - x = bcPHG, - gr = testGR - )@refRangeFilter, - expected = "ranges=1:5-10" - ) - - expect_equal( - object = filterRefRanges( - x = bcPHG, - gr = testGR, - chromosome = "3" - )@refRangeFilter, - expected = "ranges=3,1:5-10" - ) - - expect_error( - object = filterRefRanges( - x = bcPHG, - gr = mtcars, - ), - regexp = "Not a valid GRanges" - ) -}) - - -test_that("filterSamples() returns correct data", { - urlTest <- "test-server.brapi.org" - testMethod <- "test_method" - - testCon <- BrapiCon(urlTest) - bcPHG <- PHGMethod(testCon, testMethod) - - expect_error( - object = filterSamples(mtcars, samples = "taxa_A"), - regexp = "A `BrapiConPHG` object is needed" - ) - - expect_error( - object = filterSamples(bcPHG, samples = mtcars), - regexp = "`samples` argument must be an" - ) -}) - - -test_that("readRefRanges() returns correct data", { - urlTest <- "cbsudc01.biohpc.cornell.edu" - testMethod <- "NonMergedReadMapping_AllNamParents_Haploid" - - testCon <- BrapiCon(urlTest) - bcPHGNoFilter <- PHGMethod(testCon, testMethod) - bcPHGFilter <- filterRefRanges( - x = PHGMethod(testCon, testMethod), - chromosome = "1", - start = "1", - end = "500000" - ) - - grRes <- readRefRanges(bcPHGFilter) - expect_true(inherits(grRes, "GRanges")) - - expect_true(all(as.data.frame(grRes)$seqnames == 1)) -}) - - -test_that("readSamples() returns correct data", { - urlTest <- "phg.maizegdb.org" - testMethod <- "anchorwave_gapfilled_assembly_PATH" - - testCon <- BrapiCon(urlTest) - bcPHGNoFilter <- PHGMethod(testCon, testMethod) - sampleRes <- readSamples(bcPHGNoFilter) - - expect_true(inherits(sampleRes, "data.frame")) - expect_equal(nrow(sampleRes), 5) -}) - - -test_that("readTable() returns correct data", { - urlTest <- "phg.maizegdb.org" - testMethod <- "DEMO" - - testCon <- BrapiCon(urlTest) - bcPHGNoFilter <- PHGMethod(testCon, testMethod) - # bcPHGFilter <- filterSamples( - # x = PHGMethod(testCon, testMethod), - # samples = c("Z001E0001-628NHAAXX_1", "Z001E0001-D10RTACXX_5") - # ) - - expect_message(readTable(bcPHGNoFilter)) -}) - - -test_that("readPHGDatasetFromBrapi() returns correct data", { - urlTest <- "phg.maizegdb.org" - testMethod <- "DEMO" - - testCon <- BrapiCon(urlTest) - bcPHGNoFilter <- PHGMethod(testCon, testMethod) - - expect_message(readPHGDatasetFromBrapi(bcPHGNoFilter)) -}) - - diff --git a/tests/test_bak/test_brapi_utilities.R b/tests/test_bak/test_brapi_utilities.R deleted file mode 100644 index ba702bd..0000000 --- a/tests/test_bak/test_brapi_utilities.R +++ /dev/null @@ -1,80 +0,0 @@ -# === Test rPHG/BrAPI utitlities ==================================== - -test_that("parseJSON() returns correct exceptions and data", { - urlGood <- "https://test-server.brapi.org/brapi/v2/serverinfo" - urlBad <- "fail" - - res <- parseJSON(urlGood) - expect_true(is.data.frame(res) || is.list(res)) - - expect_message( - object = parseJSON(urlGood, verbose = TRUE), - regexp = "Attempting to read endpoint" - ) - - expect_message( - object = parseJSON(urlBad, verbose = TRUE), - regexp = "URL could not be processed" - ) - - expect_silent(parseJSON(urlGood)) - - expect_equal( - object = length(parseJSON(urlGood)), - expected = 3 - ) - - expect_true(is.null(parseJSON(urlBad))) -}) - - -test_that("json2tible() returns correct expections and data", { - myCon <- BrapiCon( - host = "test-server.brapi.org" - ) - res <- class(json2tibble(myCon, "callsets")) - expect_equal( - object = res, - expected = c("tbl_df", "tbl", "data.frame") - ) -}) - - -test_that("getVTList() returns correct exceptions and data", { - testCon <- BrapiCon("test-server.brapi.org", protocol = "https") - bcPHG <- PHGMethod(testCon, "test_method") - - expect_error( - object = getVTList(mtcars), - regexp = "A `BrapiConPHG` object is needed" - ) - - expect_equal( - object = length(getVTList(bcPHG)), - expected = 3 - ) - - expect_equal( - object = names(getVTList(bcPHG)), - expected = c("rangeURL", "sampleURL", "tableURL") - ) - - expect_equal( - object = getVTList(bcPHG)$rangeURL, - expect = "https://test-server.brapi.org:443/brapi/v2/variantTables/test_method/variants" - ) - - expect_equal( - object = getVTList(bcPHG)$sampleURL, - expect = "https://test-server.brapi.org:443/brapi/v2/variantTables/test_method/samples" - ) - - expect_equal( - object = getVTList(bcPHG)$tableURL, - expect = "https://test-server.brapi.org:443/brapi/v2/allelematrix?variantSetDbId=test_method&dimensionVariantPageSize=10000&dimensionCallSetPageSize=5000&dimensionVariantPage=%i&dimensionCallSetPage=%i" - ) -}) - - - - diff --git a/tests/test_bak/test_graph_builder.R b/tests/test_bak/test_graph_builder.R deleted file mode 100644 index 0f7071b..0000000 --- a/tests/test_bak/test_graph_builder.R +++ /dev/null @@ -1,17 +0,0 @@ -# === Tests for building graph objects ============================== - -tmpFile <- tempfile(fileext = ".txt") -startLogger(tmpFile) - - -test_that("graphBuilder() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - createConfigFile(tmpFile) - - expect_error(graphBuilder("does/not/exist")) - - expect_message(graphBuilder(tmpFile, methods = "CONSENSUS")) - expect_message(graphBuilder(tmpFile, methods = "CONSENSUS", chrom = "1")) - expect_message(graphBuilder(tmpFile, methods = "PATH_METHOD", buildType = "path")) -}) - diff --git a/tests/test_bak/test_logging_support.R b/tests/test_bak/test_logging_support.R deleted file mode 100644 index 397c826..0000000 --- a/tests/test_bak/test_logging_support.R +++ /dev/null @@ -1,20 +0,0 @@ -# === Tests for logging support ===================================== - -test_that("startLogger() will return correct exceptions and data", { - tmpFile <- tempfile(fileext = ".txt") - - expect_message( - startLogger(tmpFile), - regexp = "PHG logging file created at: " - ) - - expect_error( - startLogger("~/test_log.txt"), - regexp = "It seems that you are using" - ) - - startLogger() - expect_true(file.exists("rPHG_log")) -}) - - diff --git a/tests/test_bak/test_path_matrix.R b/tests/test_bak/test_path_matrix.R deleted file mode 100644 index 4c06dd9..0000000 --- a/tests/test_bak/test_path_matrix.R +++ /dev/null @@ -1,49 +0,0 @@ -# === Tests for path retrieval methods ============================== - -tmpFile <- tempfile(fileext = ".txt") -startLogger(tmpFile) - -test_that("pathsForMethod() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - testPath <- "GATK_PIPELINE_PATH" - - expect_error(pathsForMethod(mtcars)) - - expect_true(inherits(pathsForMethod(tmpFile, testPath), "matrix")) - - expect_equal( - object = dim(pathsForMethod(tmpFile, testPath)), - expected = c(6, 10) - ) -}) - - -test_that("readMappingsForLineName() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - lineName <- "RefA1_gbs" - readMappingMethodName <- "HAP_COUNT_METHOD" - haplotypeMethodName <- "CONSENSUS" - - expect_true( - inherits( - readMappingsForLineName( - tmpFile, - lineName, - readMappingMethodName, - haplotypeMethodName - ), - "DataFrame" - ) - ) -}) - - -test_that("readMappingTableInfo() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - expect_true(inherits(readMappingTableInfo(tmpFile), "DataFrame")) -}) - - diff --git a/tests/test_bak/test_show_phg_methods.R b/tests/test_bak/test_show_phg_methods.R deleted file mode 100644 index 9d0d6b5..0000000 --- a/tests/test_bak/test_show_phg_methods.R +++ /dev/null @@ -1,20 +0,0 @@ -# === Tests to display available PHG methods ======================== - -tmpFile <- tempfile(fileext = ".txt") -startLogger(tmpFile) - - -test_that("showPHGMethods() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - - testReturn <- showPHGMethods(tmpFile) - - expect_true(inherits(testReturn, "data.frame")) - expect_equal( - object = colnames(testReturn), - expected = c("method_id", "method_type", "type_name", "method_name", "description") - ) -}) - - diff --git a/tests/test_bak/test_stats_and_visulization.R b/tests/test_bak/test_stats_and_visulization.R deleted file mode 100644 index 4b838a8..0000000 --- a/tests/test_bak/test_stats_and_visulization.R +++ /dev/null @@ -1,142 +0,0 @@ -# === Tests for stats and visualization ============================= - -tmpFile <- tempfile(fileext = ".txt") -startLogger(tmpFile) - - -test_that("numHaploPerRange() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - - testPhgObj <- graphBuilder(tmpFile, "CONSENSUS") - - testReturn <- numHaploPerRange(testPhgObj) - - expect_true(inherits(testReturn, "DataFrame")) - expect_equal( - object = colnames(testReturn), - expected = c("refRange_id", "seqnames", "start", "end", "width", "numHaplotypes") - ) - - expect_error(numHaploPerRange(testPhgObj, chr = "1", start = 1, end = 10)) -}) - - -test_that("plotNumHaplo() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - - testPhgObj <- graphBuilder(tmpFile, "CONSENSUS") - - testReturn <- numHaploPerRange(testPhgObj) - - expect_true(inherits(plotNumHaplo(testReturn), "ggplot")) - -}) - - -test_that("calcMutualInfo() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - - testPhgObj <- graphBuilder(tmpFile, "CONSENSUS") - - expect_error(calcMutualInfo(mtcars)) - expect_error(calcMutualInfo(phgObject = NULL, phgHapIDMat = NULL)) - expect_error(calcMutualInfo(testPhgObj)) - - expect_true(inherits(calcMutualInfo(testPhgObj, 1:10), "matrix")) -}) - - -test_that("plotMutualInfo() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - - testPhgObj <- graphBuilder(tmpFile, "CONSENSUS") - - expect_true(inherits(plotMutualInfo(testPhgObj, 1:10), "list")) -}) - - -test_that("calcDiff() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - - testPhgObj <- graphBuilder(tmpFile, "CONSENSUS") - - expect_equal(calcDiff(c(1, 5, 10), c(1, 5, 10)), 0) - -}) - - -test_that("searchSimilarGametes() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - - testPhgObj <- graphBuilder(tmpFile, "CONSENSUS") - - expect_error(searchSimilarGametes(mtcars)) - expect_error(searchSimilarGametes(phgObject = NULL, phgHapIDMat = NULL)) - expect_error(searchSimilarGametes(testPhgObj, 1:3, "LineA111")) - - expect_equal( - searchSimilarGametes(testPhgObj, 1:3, "LineA1"), - "LineA" - ) -}) - - -test_that("searchSimilarGametes() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - - testPhgObj <- graphBuilder(tmpFile, "CONSENSUS") - - expect_error(searchRecombination(mtcars)) - expect_error(searchRecombination(phgObject = NULL, phgHapIDMat = NULL)) -}) - - -test_that("plotGraph() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - rPHG:::createConfigFile(tmpFile) - - testPhgObj <- graphBuilder(tmpFile, "CONSENSUS") - testPathPhg <- graphBuilder(tmpFile, "PATH_METHOD", buildType = "path") - - conG <- plotGraph(testPhgObj, start = 1, end = 35000, seqnames = "1") - pathG <- plotGraph(testPathPhg, start = 1, end = 35000, seqnames = "1") - - pathGHighlight <- plotGraph( - x = testPathPhg, - start = 1, end = 35000, seqnames = "1", - sampleHighlight = "RecLineA1RefA1gco1_wgs" - ) - - expect_true(is(pathG, "visNetwork")) - expect_true(is(conG, "visNetwork")) - - expect_equal(length(unique(conG$x$nodes$color)), 1) - expect_equal(length(unique(pathGHighlight$x$nodes$color)), 2) - - -}) - - - - - - - - - - - - - - - - - - diff --git a/tests/test_bak/test_taxa_by_node.R b/tests/test_bak/test_taxa_by_node.R deleted file mode 100644 index f8388e6..0000000 --- a/tests/test_bak/test_taxa_by_node.R +++ /dev/null @@ -1,49 +0,0 @@ -# === Tests for taxaByNode() ======================================== - -tmpFile <- tempfile(fileext = ".txt") -startLogger(tmpFile) - - -test_that("graphBuilder() returns correct data", { - tmpFile <- tempfile(fileext = ".txt") - createConfigFile(tmpFile) - - myGraph <- graphBuilder(tmpFile, "CONSENSUS") - - rangeIds <- c(1, 3) - - qTaxa <- taxaByNode(myGraph, rrSet = rangeIds) - - expect_true(is(qTaxa, "tbl_df")) - expect_equal(nrow(qTaxa), 6) - expect_equal(colnames(qTaxa), c("ref_range_id", "hap_id", "taxa_id")) - expect_equal(unique(qTaxa$ref_range_id), c("1", "3")) - - expect_error( - object = taxaByNode(myGraph, start = NULL, end = 35000, seqnames = "1"), - regexp = "Genomic range parameters are needed" - ) - expect_error( - object = taxaByNode(myGraph, start = 1, end = NULL, seqnames = "1"), - regexp = "Genomic range parameters are needed" - ) - expect_error( - object = taxaByNode(myGraph, start = 1, end = 35000, seqnames = NULL), - regexp = "Genomic range parameters are needed" - ) - - qTaxa2 <- taxaByNode(myGraph, start = 1, end = 35000, seqnames = "1") - expect_equal(nrow(qTaxa2), 18) - expect_equal( - unique(qTaxa2$ref_range_id), - c("1", "2", "3", "4", "5", "6") - ) - - qTaxa3 <- taxaByNode(myGraph, 1, 35000, NULL, rrSet = rangeIds) - expect_true(is(qTaxa3, "tbl_df")) - expect_equal(nrow(qTaxa3), 6) - expect_equal(colnames(qTaxa3), c("ref_range_id", "hap_id", "taxa_id")) - expect_equal(unique(qTaxa3$ref_range_id), c("1", "3")) -}) - - diff --git a/tests/test_bak/test_utilities.R b/tests/test_bak/test_utilities.R deleted file mode 100644 index 6c64aea..0000000 --- a/tests/test_bak/test_utilities.R +++ /dev/null @@ -1,51 +0,0 @@ -# === Tests for utility methods ===================================== - -test_that("createConfigFile() generates correct output", { - tmpFile <- tempfile(fileext = ".txt") - createConfigFile(tmpFile) - - testObj <- readLines(tmpFile) - unlink(tmpFile) - - expect_equal(length(testObj), 5) -}) - - -test_that("configCatcher() returns correct data and exceptions", { - tmpFile <- tempfile(fileext = ".txt") - createConfigFile(tmpFile, dbType = "neo4j") - expect_error(configCatcher(tmpFile)) - - createConfigFile(tmpFile, user = NULL) - expect_error( - object = configCatcher(tmpFile), - regexp = "Missing credentials (user= and/or password=) in config file.", - fixed = TRUE - ) - - createConfigFile(tmpFile, password = NULL) - expect_error( - object = configCatcher(tmpFile), - regexp = "Missing credentials (user= and/or password=) in config file.", - fixed = TRUE - ) - - createConfigFile(tmpFile) - myFile <- file(tmpFile, "a") - writeLines("DB=another/path", myFile, sep = "\n") - close(myFile) - expect_error( - object = configCatcher(tmpFile), - regexp = "Config file contains more than one database path parameter (DB=).", - fixed = TRUE - ) - - createConfigFile(tmpFile, dbPath = "not/here", dbType = "sqlite") - expect_error( - object = configCatcher(tmpFile), - regexp = "Path to database (DB=) in SQLite config file does not exist.", - fixed = TRUE - ) -}) - - diff --git a/tests/test_bak/test_zzz.R b/tests/test_bak/test_zzz.R deleted file mode 100644 index 721ac89..0000000 --- a/tests/test_bak/test_zzz.R +++ /dev/null @@ -1,8 +0,0 @@ -# === Tests for initializer methods ================================= - -test_that("onLoad function is called without error", { - expect_silent( - .onLoad(pkgname = "rPHG", libname = system.file(package = "rPHG")) - ) -}) - diff --git a/tests/testthat/test_class_all_generics.R b/tests/testthat/test_class_all_generics.R index 24d783e..b1a38a4 100644 --- a/tests/testthat/test_class_all_generics.R +++ b/tests/testthat/test_class_all_generics.R @@ -4,3 +4,5 @@ test_that("Basic tests", { expect_equal(test, "test") }) + + diff --git a/tests/testthat/test_class_phg_con.R b/tests/testthat/test_class_phg_con.R index 6fecf51..e91cc99 100644 --- a/tests/testthat/test_class_phg_con.R +++ b/tests/testthat/test_class_phg_con.R @@ -21,3 +21,5 @@ test_that("Basic tests", { expect_equal(phgType(testPhgCon), "local") }) + + diff --git a/tests/testthat/test_class_phg_con_server.R b/tests/testthat/test_class_phg_con_server.R index 1d5876b..fa579b3 100644 --- a/tests/testthat/test_class_phg_con_server.R +++ b/tests/testthat/test_class_phg_con_server.R @@ -62,3 +62,4 @@ test_that("Basic tests", { }) + diff --git a/tests/testthat/test_class_phg_dataset.R b/tests/testthat/test_class_phg_dataset.R index 53d15ec..cccb088 100644 --- a/tests/testthat/test_class_phg_dataset.R +++ b/tests/testthat/test_class_phg_dataset.R @@ -34,3 +34,4 @@ test_that("Basic tests.", { expect_true(is(plotRes, "visNetwork")) }) + diff --git a/tests/testthat/test_class_phg_method.R b/tests/testthat/test_class_phg_method.R index c8b8d13..c9c6584 100644 --- a/tests/testthat/test_class_phg_method.R +++ b/tests/testthat/test_class_phg_method.R @@ -40,6 +40,6 @@ test_that("Basic tests.", { expect_equal(phgMethodId(phgMethod1), "CONSENSUS") expect_equal(phgMethodId(phgMethod2), "PATH_METHOD") expect_equal(phgMethodId(phgMethod3), "NAM_GBS_Alignments_PATHS") +}) -}) \ No newline at end of file diff --git a/tests/testthat/test_logging_support.R b/tests/testthat/test_logging_support.R index 2b58914..95a8eb1 100644 --- a/tests/testthat/test_logging_support.R +++ b/tests/testthat/test_logging_support.R @@ -7,3 +7,5 @@ test_that("Basic tests.", { }) + + diff --git a/tests/testthat/test_stats_taxa_by_node.R b/tests/testthat/test_stats_taxa_by_node.R new file mode 100644 index 0000000..d3ec626 --- /dev/null +++ b/tests/testthat/test_stats_taxa_by_node.R @@ -0,0 +1,17 @@ +test_that("Basic tests", { + logFile <- tempfile(fileext = ".txt") + configFile <- tempfile() + + startLogger(logFile) + createConfigFile(configFile) + phgLocCon <- PHGLocalCon(configFile) + phgMethod <- PHGMethod(phgLocCon, "PATH_METHOD") + phgDataSet <- readPHGDataSet(phgMethod) + + + tbnOutput <- taxaByNode(phgDataSet, seqnames = "1", start = 1, end = 350000) + + expect_true(is(tbnOutput, "list")) +}) + + diff --git a/tests/testthat/test_utilities_api_brapi.R b/tests/testthat/test_utilities_api_brapi.R new file mode 100644 index 0000000..a0af5c1 --- /dev/null +++ b/tests/testthat/test_utilities_api_brapi.R @@ -0,0 +1,12 @@ +test_that("Basic tests", { + testUrl1 <- "https://www.google.com" + testUrl2 <- "https://phg.maizegdb.org/brapi/v2/serverinfo" + + expect_null(parseJSON(testUrl1)) + expect_message(parseJSON(testUrl1, verbose = TRUE)) + expect_message(parseJSON(testUrl1, verbose = TRUE)) + expect_message(parseJSON(testUrl2, verbose = TRUE)) +}) + + + diff --git a/tests/testthat/test_utilities_api_phg.R b/tests/testthat/test_utilities_api_phg.R new file mode 100644 index 0000000..f222636 --- /dev/null +++ b/tests/testthat/test_utilities_api_phg.R @@ -0,0 +1,19 @@ +test_that("Basic tests", { + logFile <- tempfile(fileext = ".txt") + configFile <- tempfile() + + startLogger(logFile) + createConfigFile(configFile) + + testOutput <- graphFromHaplotypes( + configFile = configFile, + method = "CONSENSUS", + chrom = "1", + includeSequence = FALSE, + includeVariants = FALSE + ) + + expect_true(is(testOutput, "jobjRef")) +}) + + diff --git a/tests/testthat/test_utilities_general.R b/tests/testthat/test_utilities_general.R new file mode 100644 index 0000000..765d289 --- /dev/null +++ b/tests/testthat/test_utilities_general.R @@ -0,0 +1,67 @@ +test_that("Basic tests", { + configFile1 <- tempfile() + writeLines( + c( + "host=localhost", + "DBtype=sqlite", + "user=user", + "password=pass" + ), + con = configFile1 + ) + + expect_error( + object = rPHG:::configCatcher(configFile1), + regexp = "Some mandatory connection fields are missing" + ) + + configFile2 <- tempfile() + writeLines( + c( + "host=localhost", + "DBtype=postgres", + "DB=my_phg", + "user=user", + "user=user", + "password=pass", + "password=pass" + ), + con = configFile2 + ) + expect_error( + object = rPHG:::configCatcher(configFile2), + regexp = "Some mandatory connection fields are duplicated" + ) + + configFile3 <- tempfile() + writeLines( + c( + "host=localhost", + "DBtype=postgressss", + "DB=my_phg", + "user=user", + "password=pass" + ), + con = configFile3 + ) + expect_error( + object = rPHG:::configCatcher(configFile3), + ) + + configFile4 <- tempfile() + writeLines( + c( + "host=localhost", + "DBtype=sqlite", + "DB=/does/not/exist", + "user=user", + "password=pass" + ), + con = configFile4 + ) + expect_error( + object = rPHG:::configCatcher(configFile4) + ) +}) + + diff --git a/tests/testthat/test_utilities_stats.R b/tests/testthat/test_utilities_stats.R new file mode 100644 index 0000000..15609ab --- /dev/null +++ b/tests/testthat/test_utilities_stats.R @@ -0,0 +1,15 @@ +test_that("Basic tests", { + phgHapIDMat <- matrix( + data = "111/111", + nrow = 5, + ncol = 5 + ) + colnames(phgHapIDMat) <- paste0("R", seq_len(ncol(phgHapIDMat))) + rownames(phgHapIDMat) <- paste0("sample_", letters[seq_len(nrow(phgHapIDMat))]) + + miResults <- mutualInfoPair(phgHapIDMat, c("R1", "R2")) + + expect_equal(miResults, 0) +}) + + diff --git a/tests/testthat/test_vis_plot_graph.R b/tests/testthat/test_vis_plot_graph.R new file mode 100644 index 0000000..4e5e51a --- /dev/null +++ b/tests/testthat/test_vis_plot_graph.R @@ -0,0 +1,20 @@ +test_that("Basic tests", { + logFile <- tempfile(fileext = ".txt") + configFile <- tempfile() + + startLogger(logFile) + createConfigFile(configFile) + + testPDS <- readPHGDataSet( + PHGMethod( + PHGLocalCon(configFile), + "PATH_METHOD" + ) + ) + plotRes <- plotGraph(testPDS, start = 1, end = 350000, seqnames = "1") + expect_true(is(plotRes, "visNetwork")) + plotRes <- plotGraph(testPDS, start = 1, end = 350000, seqnames = "1", sampleHighlight = "RecLineB1RefA1gco4_wgs") + expect_true(is(plotRes, "visNetwork")) +}) + + diff --git a/vignettes/rphg_installation.R b/vignettes/rphg_installation.R index 4bd13fe..1e20838 100644 --- a/vignettes/rphg_installation.R +++ b/vignettes/rphg_installation.R @@ -8,16 +8,16 @@ knitr::opts_chunk$set( warning = FALSE ) -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- +## ----eval=FALSE, echo=TRUE---------------------------------------------------- # # install.packages("pak") # pak::pak("maize-genetics/rPHG") -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- +## ----eval=FALSE, echo=TRUE---------------------------------------------------- # library(rPHG) -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- +## ----eval=FALSE, echo=TRUE---------------------------------------------------- # options(java.parameters = c("-Xmx", "-Xms")) -## ---- eval=FALSE, echo=TRUE--------------------------------------------------- +## ----eval=FALSE, echo=TRUE---------------------------------------------------- # startLogger(fullPath = NULL, fileName = NULL) diff --git a/vignettes/rphg_walkthrough.R b/vignettes/rphg_walkthrough.R index 4531a6d..d20c03c 100644 --- a/vignettes/rphg_walkthrough.R +++ b/vignettes/rphg_walkthrough.R @@ -13,41 +13,41 @@ logFile <- tempfile(fileext = ".txt") configFile <- tempfile() rPHG:::createConfigFile(configFile) -## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +## ----echo=TRUE, eval=TRUE----------------------------------------------------- configFile |> PHGLocalCon() -## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +## ----echo=TRUE, eval=TRUE----------------------------------------------------- "demo.hub.maizegenetics.net" |> PHGServerCon() -## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +## ----echo=TRUE, eval=TRUE----------------------------------------------------- configFile |> PHGLocalCon() |> showPHGMethods() -## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +## ----echo=TRUE, eval=TRUE----------------------------------------------------- configFile |> PHGLocalCon() |> PHGMethod("PATH_METHOD") -## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +## ----echo=TRUE, eval=TRUE----------------------------------------------------- configFile |> PHGLocalCon() |> PHGMethod("PATH_METHOD") |> readSamples() -## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +## ----echo=TRUE, eval=TRUE----------------------------------------------------- configFile |> PHGLocalCon() |> PHGMethod("PATH_METHOD") |> readRefRanges() -## ---- echo=TRUE, eval=TRUE---------------------------------------------------- +## ----echo=TRUE, eval=TRUE----------------------------------------------------- configFile |> PHGLocalCon() |> PHGMethod("PATH_METHOD") |> readHaplotypeIds() -## ---- echo=TRUE, eval=TRUE, message=FALSE------------------------------------- +## ----echo=TRUE, eval=TRUE, message=FALSE-------------------------------------- configFile |> PHGLocalCon() |> PHGMethod("PATH_METHOD") |> From 91fdb15612582790e28df76fdb7bedb23e983df0 Mon Sep 17 00:00:00 2001 From: Brandon Date: Tue, 10 Oct 2023 11:22:22 -0400 Subject: [PATCH 31/35] Remove deprecated files --- R/deprecated_brapi.R | 268 ----------- R/deprecated_stats_and_visualization.R | 629 ------------------------- 2 files changed, 897 deletions(-) delete mode 100644 R/deprecated_brapi.R delete mode 100644 R/deprecated_stats_and_visualization.R diff --git a/R/deprecated_brapi.R b/R/deprecated_brapi.R deleted file mode 100644 index 540585e..0000000 --- a/R/deprecated_brapi.R +++ /dev/null @@ -1,268 +0,0 @@ -##################################################################### -## -## Overview: -## This file houses **DEFUNCT** methods and generics related to -## `BrapiCon` and `BrapiConPHG` classes. Keeping these functions -## to revise at a later date... -## -##################################################################### - -# ## Get taxa ---- -# #' @title Retrieve samples from BrAPI connection -# #' -# #' @description Retrieves data from the \code{samples} endpoint of a BrAPI -# #' server. -# #' -# #' @param object a \code{\linkS4class{BrapiCon}} object. -# #' -# #' @rdname samples -# #' -# #' @export -# setGeneric("samples", function(object) standardGeneric("samples")) -# -# #' @rdname samples -# #' @export -# setMethod( -# f = "samples", -# signature = "BrapiCon", -# definition = function(object) { -# json2tibble(object, "samples") -# } -# ) - - -# ## Get calls ---- -# #' @title Retrieve calls from BrAPI connection -# #' -# #' @description Retrieves data from the \code{calls} endpoint of a BrAPI -# #' server. -# #' -# #' @param object a \linkS4class{BrapiCon} object. -# #' -# #' @rdname calls -# #' -# #' @export -# setGeneric("calls", function(object) standardGeneric("calls")) -# -# #' @rdname calls -# #' @export -# setMethod( -# f = "calls", -# signature = "BrapiCon", -# definition = function(object) { -# json2tibble(object, "calls") -# } -# ) - - -# ## Get callsets ---- -# #' @title Retrieve callsets from BrAPI connection -# #' -# #' @description Retrieves data from the \code{callsets} endpoint of a BrAPI -# #' server. -# #' -# #' @param object A \code{BrapiCon} object. -# #' -# #' @rdname callsets -# #' -# #' @export -# setGeneric("callsets", function(object) standardGeneric("callsets")) -# -# #' @rdname callsets -# #' @export -# setMethod( -# f = "callsets", -# signature = "BrapiCon", -# definition = function(object) { -# json2tibble(object, "callsets") -# } -# ) - - -# ## Get graphs ---- -# #' @title Retrieve graph data from BrAPI connection -# #' -# #' @description Retrieves data from the \code{graphs} endpoint of a BrAPI -# #' server. -# #' -# #' @param object A \code{BrapiCon} object. -# #' @param dbID A PHG method. -# #' -# #' @rdname phGraph -# #' -# #' @export -# setGeneric("phGraph", function(object, dbID) standardGeneric("phGraph")) -# -# #' @rdname phGraph -# #' @export -# setMethod( -# f = "phGraph", -# signature = "BrapiCon", -# definition = function(object, dbID) { -# json2igraph(object, dbID) -# } -# ) - - -# ## Get studies ---- -# #' @title Retrieve study data from BrAPI connection -# #' -# #' @description Retrieves data from the \code{studies} endpoint of a BrAPI -# #' server. -# #' -# #' @param object A \code{BrapiCon} object. -# #' -# #' @rdname studies -# #' -# #' @export -# setGeneric("studies", function(object) standardGeneric("studies")) -# -# #' @rdname studies -# #' @export -# setMethod( -# f = "studies", -# signature = "BrapiCon", -# definition = function(object) { -# json2tibble(object, "studies") -# } -# ) - - -## ## ---- -## #' @rdname readHaplotypeIds -## #' -## #' @param numCores Number of processing cores for faster processing times. -## #' @param transpose Do you want to transpose table? -## #' -## #' @importFrom cli cli_progress_bar -## #' @importFrom cli cli_progress_done -## #' @importFrom cli cli_progress_step -## #' @importFrom cli cli_progress_update -## #' @importFrom httr content -## #' @importFrom httr GET -## #' @importFrom jsonlite fromJSON -## #' @importFrom parallel mclapply -## #' -## #' @export -## setMethod( -## f = "readHaplotypeIds", -## signature = "BrapiConPHG", -## definition = function(object, numCores = NULL, transpose = TRUE) { -## # Logic checks -## if (is.null(numCores)) { -## numCores <- 1 -## } -## if (!is.numeric(numCores)) { -## stop("numCores parameter must be numeric or NULL") -## } -## -## # Get URLs -## urls <- getVTList(object) -## -## # Calculate total pages -## -## if (object@methodID == "DEMO") { -## totalVariants <- 1000 -## totalPages <- ceiling(totalVariants / 250) -## } else { -## methods <- availablePHGMethods(object) -## totalVariants <- methods[which(methods$variantTableDbId == object@methodID), ]$numVariants -## totalPages <- ceiling(totalVariants / 10000) -## } -## -## # Download each page (iterative) -## # TODO - can we async this? (e.g. futures) -## allResp <- vector("list", totalPages) -## # cli::cli_progress_step("Establishing connection") -## message("Establishing connection") -## # cli::cli_progress_bar(" - Downloading: ", total = totalPages) -## message("Downloading:") -## pb <- utils::txtProgressBar( -## style = 3, -## char = "=", -## min = 1, -## max = totalPages -## ) -## for (i in seq_len(totalPages)) { -## currentUrl <- sprintf(urls$tableURL, i - 1, 0) -## allResp[[i]] <- httr::GET(currentUrl) -## utils::setTxtProgressBar(pb, i) -## # cli::cli_progress_update() -## } -## close(pb) -## # cli::cli_progress_done() -## -## # F1 - Convert hap ID string to integer (e.g. "21/21" -> 21) -## brapiHapIdStringToInt <- function(x) { -## id <- strsplit(x, "/")[[1]][1] -## ifelse(id == ".", return(NA), return(as.integer(id))) -## } -## -## # F2 - process matrix slices (convert from JSON to int matrix) -## processMatrix <- function(x) { -## xNew <- httr::content(x, as = "text", encoding = "ISO-8859-1") -## xNew <- jsonlite::fromJSON(xNew) -## xMat <- xNew$result$dataMatrices$dataMatrix[[1]] -## colnames(xMat) <- xNew$result$callSetDbIds -## rownames(xMat) <- xNew$result$variants -## xMat <- apply(xMat, c(1, 2), brapiHapIdStringToInt) -## return(xMat) -## } -## -## # Clean up data (parallel) -## # cli::cli_progress_step("Cleaning data") -## message("Cleaning data") -## finalMatrices <- parallel::mclapply(allResp, processMatrix, mc.cores = numCores) -## -## # Bind all data into one matrix and return -## # cli::cli_progress_step("Combining responses") -## message("Combining responses") -## if (transpose) { -## unionMatrix <- t(do.call(rbind, finalMatrices)) -## } else { -## unionMatrix <- do.call(rbind, finalMatrices) -## } -## -## return(unionMatrix) -## } -## ) - -## -## -## ## ---- -## #' @rdname readPHGDataSet -## #' -## #' @export -## setMethod( -## f = "readPHGDataSet", -## signature = "BrapiConPHG", -## definition = function(object, ...) { -## -## urls <- getVTList(object) -## -## hapArray <- readTable(object, transpose = FALSE) -## -## # cli::cli_progress_step("Getting ref range data") -## message("Getting ref range data") -## rr <- readRefRanges(object) -## # cli::cli_progress_step("Getting sample data") -## message("Getting sample data") -## samples <- readSamples(object) -## -## colnames(hapArray) <- samples$sampleName -## -## phgSE <- SummarizedExperiment::SummarizedExperiment( -## assays = list(hapID = hapArray), -## rowRanges = rr, -## colData = samples -## ) -## -## return(methods::new(Class = "PHGDataSet", phgSE)) -## } -## ) -## -## - - - - diff --git a/R/deprecated_stats_and_visualization.R b/R/deprecated_stats_and_visualization.R deleted file mode 100644 index a25bc6b..0000000 --- a/R/deprecated_stats_and_visualization.R +++ /dev/null @@ -1,629 +0,0 @@ -## # === rPHG Stats Visualization Functions (WIP) ====================== -## -## #' @title Get the number of haplotypes per range in physical position segment -## #' -## #' @author Jean-Luc Jannink -## #' -## #' @param phgObject A PHG object. -## #' @param chr What chromosome do you want to inspect? Defaults to \code{NULL}. -## #' If \code{NULL}, all chromsomes will be selected. -## #' @param start Start position of chromosome. Defaults to \code{0}. -## #' @param end End position of chromosome. Defaults to \code{NULL}. If -## #' \code{NULL}, the whole chromosome will be analyzed. -## #' -## #' @importFrom S4Vectors DataFrame -## #' @importFrom SummarizedExperiment as.data.frame -## #' @importFrom SummarizedExperiment assays -## #' @importFrom SummarizedExperiment ranges -## #' @importFrom SummarizedExperiment rowRanges -## #' @importFrom SummarizedExperiment seqnames -## #' -## #' @export -## numHaploPerRange <- function(phgObject, -## chr = NULL, -## start = 0, -## end = NULL) { -## -## # Get information about the reference ranges -## rr <- SummarizedExperiment::rowRanges(phgObject) -## -## # Logic -## if (is.null(end)) { -## end <- max(end(rr)) -## } -## -## allChr <- unique(SummarizedExperiment::seqnames(phgObject)) -## allChr <- as.vector(allChr) -## if (is.null(chr)) { -## chr <- allChr -## } else{ -## if (!all(chr %in% allChr)) { -## warning(paste(c("The following chromosomes are not found:", setdiff(chr, allChr)), collapse=" ")) -## } -## } -## -## # Which reference ranges on the chromosome within start and end positions -## tmp <- as.vector(SummarizedExperiment::seqnames(phgObject)) -## keepRanges <- which(tmp %in% chr & start <= start(rr) & end(rr) <= end) -## -## if (length(keepRanges) == 0) { -## stop("There are no ranges with requested start and end") -## } -## -## # How many haplotypes are in those reference ranges -## phgHapIDMat <- t(SummarizedExperiment::assays(phgObject)$hapID) -## -## if (dim(phgObject)[2] == 1) { -## phgFilt <- phgHapIDMat[, keepRanges] -## phgFilt <- t(as.matrix(phgFilt)) -## } else { -## phgFilt <- phgHapIDMat[, keepRanges] -## } -## nHaplo <- apply(phgFilt, 2, function(vec) { -## length(unique(vec)) -## }) -## -## # Return the numerical information -## rr <- SummarizedExperiment::as.data.frame(rr) -## rr <- cbind(rr[keepRanges,], numHaplotypes = nHaplo) -## rr <- rr[, c(6, 1, 2, 3, 4, 7)] -## return(S4Vectors::DataFrame(rr)) -## } - - - -## #' @title Plot the number of haplotypes -## #' -## #' @description This function will plot the number of haplotypes. Its input -## #' will be the output of the \code{numHaploPerRange()} function. -## #' -## #' @param haploData The output of \code{numHaploPerRange()} -## #' -## #' @import ggplot2 -## #' @importFrom rlang .data -## #' @importFrom stats median -## #' -## #' @export -## plotNumHaplo <- function(haploData) { -## # Coerce to data frame for ggplot2 -## tmp <- as.data.frame(haploData) -## -## # Shape proportions -## yfrac <- 0.1 -## xfrac <- 0.001 -## -## # Add shape data -## tmp$med <- apply(tmp[, 3:4], 1, stats::median) -## tmp$color <- "#91baff" -## tmp[seq(1, nrow(tmp), by = 2),]$color <- "#3e619b" -## -## # Get limit data -## xbeg <- min(tmp$start) -## xend <- max(tmp$end) -## yend <- max(tmp$numHaplotypes) -## -## # Visualize -## hapPlot <- ggplot(data = tmp) + -## ylim(-(yend * yfrac), yend) + -## scale_x_continuous(limits = c(xbeg, xend)) + -## geom_rect( -## mapping = aes( -## xmin = .data$start, -## xmax = .data$end, -## ymin = 0, -## ymax = -(yend * yfrac) -## ), -## fill = tmp$color -## ) + -## geom_path(aes(x = .data$med, y = .data$numHaplotypes)) + -## geom_point(aes(x = .data$med, y = .data$numHaplotypes), size = 1) + -## facet_grid(seqnames ~ .) + -## xlab("Physical Position (bp)") + -## ylab("Number of Haplotypes") -## -## return(hapPlot) -## } - - - -## #' @title Calculate the mutual information between a set of reference ranges -## #' -## #' @description Mutual information quantifies the "amount of information" -## #' obtained about one random variable through observing the other random -## #' variable. Specify the gamete names over which you want to calculate and -## #' reference ranges. -## #' -## #' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. -## #' @param phgObject A PHG object. -## #' @param gameteNames Specified gamete names. If \code{NULL}, gamete names will -## #' default to taxa IDs (haplottype ID matrix row names). -## #' @param refRanges What reference ranges you wan to specify? -## #' -## #' @importFrom S4Vectors metadata -## #' @importFrom stats model.matrix -## calcMutualInfo <- function(phgObject = NULL, -## refRanges, -## gameteNames = NULL, -## phgHapIDMat = NULL) { -## if (is.null(phgHapIDMat)) { -## if (is.null(phgObject)) { -## stop("Must supply phgHapIDMat or phgObject") -## } -## phgHapIDMat <- hapIDMatrix(phgObject = S4Vectors::metadata(phgObject)$jObj) -## } -## -## if (is.null(gameteNames)) { -## gameteNames <- rownames(phgHapIDMat) -## } -## -## phgHapIDMat <- phgHapIDMat[gameteNames, refRanges, drop = FALSE] -## # you can't do this with single gametes or ranges -## if (any(dim(phgHapIDMat) < 2)) { -## return(NULL) -## } -## -## # Calculate the mutual information across a pair of ranges -## # I(X;Y) = Sum p(x, y)log{p(x, y) / [p(x)p(y)]} -## mutualInfoPair <- function(phgHapIDMat, twoRanges) { -## hapID <- phgHapIDMat[, twoRanges] -## -## # Remove any rows that have missing data -## hapID <- hapID[!apply(hapID, 1, function(v) any(v == -1)), ] -## -## # Check if any columns have only one haplotype -## test1haplo <- apply(hapID, 2, function(v) length(unique(v)) == 1) -## if (any(test1haplo)) { -## return(0) -## } -## hapID <- apply(hapID, 2, as.character) -## nHap1 <- length(unique(hapID[, 1])) -## nHap2 <- length(unique(hapID[, 2])) -## mm1 <- model.matrix( ~ -1 + hapID[, 1]) %>% colMeans -## mm2 <- model.matrix( ~ -1 + hapID[, 2]) %>% colMeans -## mmm <- tcrossprod(mm1, mm2) -## mmi <- model.matrix( ~ -1 + hapID[, 1]:hapID[, 2]) %>% colMeans %>% matrix(nHap1, nHap2) -## mi <- mmi * log2(mmi / mmm) # Some of these will be NaN, removed by na.rm=T -## return(sum(mi, na.rm = T)) -## } -## # Calculate the mutual information across all pairs of ranges -## nRanges <- length(refRanges) -## miMat <- matrix(NA, nrow = nRanges, ncol = nRanges) -## rownames(miMat) <- colnames(miMat) <- refRanges -## for (range1 in 1:(nRanges - 1)) { -## for (range2 in (range1 + 1):nRanges) { -## miMat[range1, range2] <- -## mutualInfoPair(phgHapIDMat, c(refRanges[range1], refRanges[range2])) -## } -## } -## return(miMat) -## } - - - -## #' @title Calculate and plot mutual information between a set of reference ranges -## #' -## #' @description Mutual information quantifies the “amount of information” -## #' obtained about one random variable through observing the other random -## #' variable. -## #' -## #' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. -## #' @param phgObject A PHG object. -## #' @param gameteNames Specified gamete names. If \code{NULL}, gamete names will -## #' default to taxa IDs (haplottype ID matrix row names). -## #' @param refRanges What reference ranges you wan to specify? -## #' -## #' @importFrom corrplot corrplot -## #' -## #' @export -## plotMutualInfo <- function(phgObject = NULL, -## refRanges, -## gameteNames = NULL, -## phgHapIDMat = NULL) { -## mi <- calcMutualInfo( -## phgObject = phgObject, -## refRanges = refRanges, -## gameteNames = NULL, -## phgHapIDMat -## ) -## mi[is.na(mi)] <- 0 -## corrplot::corrplot(mi, type = "upper", is.corr = F) -## # return(mi) -## } - - - -## ## Function to say if haplotypes same, discarding comparisons with -1 -## # gamHapIDs and targetHapIDs are both vectors of haplotype IDs. -## # The output is the fraction of hapIDs that are different -## # With ranges that contain -1 not included in the fraction -## calcDiff <- function(gamHapIDs, targetHapIDs) { -## keep <- which(gamHapIDs != -1 & targetHapIDs != -1) -## if (length(keep) == 0) { -## return(Inf) -## } -## return(sum(gamHapIDs[keep] != targetHapIDs[keep]) / length(keep)) -## } - - - -## #' @title Search for similar gamets -## #' -## #' @description Search for inbred lines (gametes) that are similar to a -## #' specified gamete in specified reference ranges. Supply either a haplotype -## #' ID matrix or a phgObject from which to extract it. Specify a gamete name -## #' and reference ranges. The difference between haplotypes is either 0 (same) -## #' or 1 (different). Fraction of ranges that are different has to be lower or -## #' equal to fractionDiff. Ranges with unknown haplotypes (-1) do not count in -## #' the fraction. If all pairwise range comparisons have -1 the lines are -## #' considered dissimilar. -## #' -## #' @param gameteName A specified gamete name -## #' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. If -## #' \code{NULL}, A hap ID matrix will be generated (if you have supplied a -## #' PHG object). -## #' @param phgObject A PHG object. -## #' @param refRanges Specifed reference ranges. -## #' @param fractionDiff The difference between haplotypes (either 0 or 1). See -## #' description for further details. -## #' -## #' @importFrom magrittr %>% -## #' @importFrom S4Vectors metadata -## #' -## #' @export -## searchSimilarGametes <- function(phgObject = NULL, -## refRanges, -## gameteName, -## fractionDiff = 0, -## phgHapIDMat = NULL) { -## if (is.null(phgHapIDMat)) { -## if (is.null(phgObject)) { -## stop("Must supply phgHapIDMat or phgObject") -## } -## phgHapIDMat <- hapIDMatrix(phgObject = S4Vectors::metadata(phgObject)$jObj) -## } -## -## # The row the target gamete is in -## gameteRow <- which(rownames(phgHapIDMat) == gameteName) -## if (length(gameteRow) == 0) { -## stop(paste0("Gamete ", gameteName, " not in the PHG")) -## } -## -## # Only deal with specified reference ranges -## phgHapIDMat <- phgHapIDMat[, refRanges, drop = FALSE] -## targetHapIDs <- phgHapIDMat[gameteRow, , drop = FALSE] -## -## # Calculate differences across all gametes in the table -## fracDiffs <- apply(phgHapIDMat, 1, calcDiff, targetHapIDs = targetHapIDs) -## areSimilar <- which(fracDiffs <= fractionDiff) %>% setdiff(gameteRow) -## -## # Return names of gametes that are similar to the target -## return(rownames(phgHapIDMat)[areSimilar]) -## } - - - -## #' @title Search for recombination -## #' -## #' @description Search for inbred lines (gametes) that are the same in one -## #' range but different in another. Such lines have experienced recombination -## #' in the past relative to each other. Must specify a gamete name and -## #' reference ranges. -## #' -## #' @param gameteName A specified gamete name -## #' @param phgHapIDMat The output of the \code{hapIDMatrix()} function. If -## #' \code{NULL}, A hap ID matrix will be generated (if you have supplied a -## #' PHG object). -## #' @param phgObject A PHG object. -## #' @param refRangeSame See description for further details. -## #' @param refRangeDiff See description for further details. -## #' -## #' @importFrom magrittr %>% -## #' @importFrom S4Vectors metadata -## #' -## #' @export -## searchRecombination <- function(phgObject = NULL, -## gameteName, -## refRangeSame, -## refRangeDiff, -## phgHapIDMat = NULL) { -## if (is.null(phgHapIDMat)) { -## if (is.null(phgObject)) { -## stop("Must supply phgHapIDMat or phgObject") -## } -## phgHapIDMat <- hapIDMatrix(phgObject = phgObject) -## } -## -## gametesSame <- searchSimilarGametes( -## gameteName, -## phgHapIDMat, -## refRanges = refRangeSame -## ) %>% -## setdiff(gameteName) -## -## targetDiff <- phgHapIDMat[gameteName, refRangeDiff] -## -## gametesDiff <- sapply( -## phgHapIDMat[gametesSame, refRangeDiff], -## calcDiff, -## targetHapIDs = targetDiff -## ) -## -## return(gametesSame[gametesDiff == 1]) -## } - - -## # ---- -## #' @title Visualize Graph Data -## #' -## #' @description -## #' Generates an interactive network plot for a given set of reference ranges -## #' and a set of taxa. -## #' -## #' @param x A \code{PHGDataSet} object -## #' @param samples Samples/taxa to include in plot -## #' @param sampleHighlight Sample path to highlight -## #' @param seqnames A sequence (e.g. chromosome) ID -## #' @param start Start position for ref ranges -## #' @param end End position for ref ranges -## #' @param colMajor Highlight path color -## #' @param colMinor Muted path color -## #' @param ... Additional parameters to pass for ref range inclusion -## #' -## #' @importFrom IRanges subsetByOverlaps -## #' @importFrom GenomicRanges GRanges -## #' @importFrom SummarizedExperiment assay -## #' @importFrom visNetwork visEdges -## #' @importFrom visNetwork visHierarchicalLayout -## #' @importFrom visNetwork visNetwork -## #' -## #' @export -## plotGraph <- function( -## x, -## samples = NULL, -## sampleHighlight = NULL, -## seqnames = NULL, -## start = NULL, -## end = NULL, -## colMajor = "maroon", -## colMinor = "lightgrey", -## ... -## ) { -## # # Testing -## # start <- 100 -## # end <- 1000000 -## # seqnames <- "1" -## # # samples <- c("Z001E0001", "Z001E0028", "Z001E0080") -## # # samples <- NULL -## # set.seed(123) -## # samples <- sample(colnames(x), 100) -## # # sampleHighlight <- c("Z001E0001") -## # sampleHighlight <- sample(samples, 1) -## -## # Filter by taxa and ref ranges -## if (is.null(samples)) samples <- colnames(x) -## hapTableMini <- x[, colnames(x) %in% samples] -## hapTableMini <- IRanges::subsetByOverlaps( -## hapTableMini, -## GenomicRanges::GRanges(seqnames = seqnames, ranges = start:end) -## ) -## -## # Get hap ID matrix -## currentMatrix <- t(SummarizedExperiment::assay(hapTableMini)) -## currentMatrix[is.na(currentMatrix)] <- -128 -## colnames(currentMatrix) <- gsub("R", "", colnames(currentMatrix)) |> -## as.numeric() -## -## # Get ref range data frame -## refRangeDataMini <- rowRanges(hapTableMini) |> as.data.frame() -## -## # Group taxa by hap ID and ref range -## taxaGroups <- lapply(seq_len(ncol(currentMatrix)), function(i) { -## split(rownames(currentMatrix), currentMatrix[, i]) -## }) -## -## # Generate distinct IDs (hap ID + ref range ID) -## hapIds <- currentMatrix |> apply(2, unique, simplify = FALSE) -## hapLevels <- rep(names(hapIds), vapply(hapIds, length, integer(1))) |> as.numeric() -## fullHapIds <- paste0( -## lapply(hapIds, function(i) i[order(i)]) |> unlist(), -## "_", hapLevels -## ) -## -## # HTML tooltip processing -## taxaToHtml <- function(x) { -## vapply(x, function(i) { -## paste0("Taxa: ", paste(i, collapse = ", "), "

") -## }, character(1)) -## } -## tooltipVec <- lapply(taxaGroups, taxaToHtml) |> unlist() -## -## refRangeHtml <- lapply(hapLevels, function(i) { -## paste0( -## "

Chr: ", -## refRangeDataMini[i, ]$seqnames, -## "
", -## "Range: ", -## refRangeDataMini[i, ]$start, -## " - ", -## refRangeDataMini[i, ]$end, -## "
" -## ) -## }) |> unlist() -## -## # Final graph data (nodes) -## nodes <- data.frame( -## id = seq_along(fullHapIds), -## label = fullHapIds, -## level = hapLevels, -## title = paste0(refRangeHtml, tooltipVec) -## ) -## -## if (!is.null(sampleHighlight)) { -## for (i in sampleHighlight) { -## nodes$group <- ifelse(grepl(i, nodes$title), i, NA) -## nodes$color <- ifelse(grepl(i, nodes$title), colMajor, colMinor) -## } -## nodes$title <- gsub(i, paste0("", i, ""), nodes$title) -## } else { -## nodes$color <- colMajor -## } -## -## # Final graph data (edges) -## lne <- c() -## rne <- c() -## for (i in seq_len(ncol(currentMatrix) - 1)) { -## ln <- paste0(currentMatrix[, i], "_", i) -## rn <- paste0(currentMatrix[, i + 1], "_", i + 1) -## -## cnxn <- paste0(ln, "+", rn) |> unique() -## -## for (c in cnxn) { -## splits <- strsplit(c, "\\+") |> unlist() -## f <- which(fullHapIds == splits[1]) -## t <- which(fullHapIds == splits[2]) -## lne <- c(lne, f) -## rne <- c(rne, t) -## } -## } -## -## edges <- data.frame( -## from = lne, -## to = rne -## ) -## -## # Return vis.js object -## visNetwork::visNetwork(nodes, edges) |> -## visNetwork::visEdges(arrows = "to") |> -## visNetwork::visHierarchicalLayout(direction = "LR") -## } - - -## ## ---- -## #' @title Retrieve read mapping information from PHG database. -## #' -## #' @description Returns an \code{S4Vectors} \code{DataFrame} object of read -## #' mapping information for a given line (i.e. taxon). -## #' -## #' @author Brandon Monier -## #' @author Peter Bradbury -## #' -## #' @param configFile Path to a configuration file for your graph database. -## #' @param lineName The name of the line (taxon) for which the read mapping -## #' information is to be retrieved. If there are multiple read mappings with -## #' different \code{file_group_names}, they will be combined. -## #' @param readMappingMethodName The method name for the read mappings -## #' (only takes a single method). -## #' @param haplotypeMethodName The haplotype method name. -## #' @param fileGroup the name of the file group for the line from the database. -## #' This parameter is only necessary if the line (taxon) has more than one -## #' file group and only the reads for a specific file group are wanted. -## #' -## #' @importFrom rJava J -## #' @importFrom S4Vectors DataFrame -## #' -## #' @export -## readMappingsForLineName <- function(configFile, -## lineName, -## readMappingMethodName, -## haplotypeMethodName, -## fileGroup = NULL) { -## -## configCatcher(configFile) -## -## # Retrieve Java data vector object(s) -## rmObj <- rJava::J( -## "net.maizegenetics.pangenome.api/RMethods", -## "readMappingsForLineName", -## configFile, -## lineName, -## readMappingMethodName, -## haplotypeMethodName, -## fileGroup -## ) -## -## # Configure for R -## colNum <- rmObj$dataVectors$size() -## rmDF <- lapply(seq_len(colNum), function(i) { -## rmObj$dataVectors$get(as.integer(i - 1)) -## }) -## rmDF <- data.frame(rmDF) -## colnames(rmDF) <- rmObj$columnNames -## -## # Return -## return(S4Vectors::DataFrame(rmDF)) -## } - - -## ## ---- -## #' @title Retrieve read mapping records from PHG database. -## #' -## #' @description Returns an \code{S4Vectors} \code{DataFrame} object of read -## #' mapping record information without \code{read_mapping} data. -## #' -## #' @author Brandon Monier -## #' @author Peter Bradbury -## #' -## #' @param configFile Path to a configuration file for your graph database. -## #' -## #' @importFrom rJava J -## #' @importFrom S4Vectors DataFrame -## #' -## #' @export -## readMappingTableInfo <- function(configFile) { -## -## # Catch potential errors -## configCatcher(configFile) -## -## # Retrieve Java data vector object(s) -## rmObj <- rJava::J( -## "net.maizegenetics.pangenome.api/RMethods", -## "readMappingTableInfo", -## configFile -## ) -## -## # Configure for R -## colNum <- rmObj$dataVectors$size() -## rmDF <- lapply(seq_len(colNum), function(i) { -## rmObj$dataVectors$get(as.integer(i - 1)) -## }) -## rmDF <- data.frame(rmDF) -## colnames(rmDF) <- rmObj$columnNames -## -## # Return -## return(tibble::as_tibble(rmDF)) -## } - - -## # === Methods to export to Flapjack format (DEPRECATED) ============= -## -## #' @title Export a PHG object to Flapjack file formats. -## #' -## #' @description This function will take a PHG object and export specified -## #' ranges to a Flapjack file format. Take note that in order for output to -## #' be generated, you will have to build your PHG with a the parameter -## #' \code{includeVariant} to \code{TRUE}. -## #' -## #' @param phgObject A PHG object. -## #' @param outputName A specified output name for your Flapjack files. Defaults -## #' to \code{NULL}. If \code{NULL} file name will be \code{phg_output} -## #' -## #' @importFrom rJava J -## #' -## #' @export -## flapjackExport <- function(phgObject, outputName = NULL) { -## ## Logic -## if (class(phgObject) != "PHGDataSet") { -## stop("Function needs a object of class 'PHGDataSet' to work.") -## } -## if (is.null(outputName)) { -## outputName <- "phg_output" -## } -## ## Get exporter and create Flapjack files -## rJava::J( -## "net.maizegenetics.pangenome.api/RMethods", -## "exportPHGToFlapjack", -## S4Vectors::metadata(phgObject)$jObj, -## outputName -## ) -## message("Flapjack files exported") -## } From 1108a8fe8f69570bfa118be0a95810802d4bcc15 Mon Sep 17 00:00:00 2001 From: Brandon Date: Tue, 10 Oct 2023 13:49:55 -0400 Subject: [PATCH 32/35] Add description field to method table --- R/method_table.R | 51 +++++++++++++++++++++++++++++++++++------------- 1 file changed, 37 insertions(+), 14 deletions(-) diff --git a/R/method_table.R b/R/method_table.R index c2757bc..6fe8569 100644 --- a/R/method_table.R +++ b/R/method_table.R @@ -52,30 +52,53 @@ methodTableFromLocal <- function(configFile, showAdvancedMethods) { methodTableFromServer <- function(url, showAdvancedMethods) { tableUrl <- file.path(url, BRAPI_ENDPOINTS$METHOD_TABLE) jsonObj <- parseJSON(tableUrl) - methodDf <- jsonObj$result$data + methodDf <- jsonObj$result$data$additionalInfo - # Make consistent names with local method table call - methodDf$type_name <- NA - idOrderAndMapping <- c( - "type_name" = "type_name", - "variantTableDbId" = "method_name", - # "numVariants" = "num_refranges", - # "numSamples" = "num_samples", - "additionalInfo" = "description" - ) + # Bandage before public PHG is updated... + if (any(is.na(methodDf))) { + methodDf <- jsonObj$result$data + methodDf$description <- NA + methodDf$type_name <- NA + + # Make consistent names with local method table call + idOrderAndMapping <- c( + "type_name" = "type_name", + "variantTableDbId" = "method_name", + "additionalInfo" = "description" + ) + } else { + idOrderAndMapping <- c( + "type_name" = "type_name", + "variantSetDbId" = "method_name", + "description" = "description" + ) + } + + # Process column names for (oldName in names(methodDf)) { if (oldName %in% names(idOrderAndMapping)) { newName <- idOrderAndMapping[oldName] names(methodDf)[names(methodDf) == oldName] <- newName } } - methodDf <- methodDf[, idOrderAndMapping] + methodDf <- tibble::as_tibble(methodDf[, idOrderAndMapping]) + + # Convert description field to column of parsed lists (key = value) + if (!any(is.na(jsonObj$result$data$additionalInfo))) { + methodDf$description <- lapply( + X = methodDf$description, + FUN = descriptionStringToList + ) + } - # @TODO - fix arbitrary method return (will be fixed with add. info) if (showAdvancedMethods) { - return(tibble::as_tibble(methodDf)) + return(methodDf) } else { - return(tibble::as_tibble(methodDf[grepl("_PATH$|_PATHS$", methodDf$method_name), ])) + if (!any(is.na(jsonObj$result$data$additionalInfo))) { + return(methodDf[methodDf$type_name == "PATHS", ]) + } else { + return(methodDf[grepl("_PATH$|_PATHS$", methodDf$method_name), ]) + } } } From 3b13b5450cd8a4d091423018f28b686119f49a02 Mon Sep 17 00:00:00 2001 From: Brandon Date: Tue, 10 Oct 2023 15:48:59 -0400 Subject: [PATCH 33/35] Add plot method for mutual information --- R/class_all_generics.R | 15 +++++++++++++++ R/class_phg_dataset.R | 18 ++++++++++++++++++ R/vis_mutual_info.R | 26 ++++++++++++++++++++++++++ tests/testthat/test_vis_mutual_info.R | 19 +++++++++++++++++++ 4 files changed, 78 insertions(+) create mode 100644 R/vis_mutual_info.R create mode 100644 tests/testthat/test_vis_mutual_info.R diff --git a/R/class_all_generics.R b/R/class_all_generics.R index a00d939..d71629d 100644 --- a/R/class_all_generics.R +++ b/R/class_all_generics.R @@ -299,6 +299,21 @@ setGeneric("phgType", function(object, ...) standardGeneric("phgType")) setGeneric("plotGraph", function(object, ...) standardGeneric("plotGraph")) +## ---- +#' @title Plot mutual information +#' +#' @description +#' Generates a visualization of calculated mutual information for a +#' given set of reference ranges +#' +#' @param object an \code{rPHG} data set object +#' @param ... Additional arguments, for use in specific methods +#' +#' @rdname plotMutualInfo +#' @export +setGeneric("plotMutualInfo", function(object, ...) standardGeneric("plotMutualInfo")) + + ## ---- #' @title Return port value #' diff --git a/R/class_phg_dataset.R b/R/class_phg_dataset.R index 47c52b1..e0dc25a 100644 --- a/R/class_phg_dataset.R +++ b/R/class_phg_dataset.R @@ -82,6 +82,24 @@ setMethod( ) +## ---- +#' @param object A \code{PHGDataSet} object +#' +#' @rdname plotMutualInfo +#' @export +setMethod( + f = "plotMutualInfo", + signature = signature(object = "PHGDataSet"), + definition = function(object) { + return( + plotMutualInfoFromPHGDataSet(object) + ) + } +) + + + + ## ---- #' @param object A \code{PHGDataSet} object #' @param samples Samples/taxa to include in plot diff --git a/R/vis_mutual_info.R b/R/vis_mutual_info.R new file mode 100644 index 0000000..3eb1bf9 --- /dev/null +++ b/R/vis_mutual_info.R @@ -0,0 +1,26 @@ +## ---- +# Plot mutual information from a `PHGDataSet` object +# +# @param phgObj A `PHGDataSet` object +plotMutualInfoFromPHGDataSet <- function(phgObj) { + m <- calcMutualInfo(phgObj) + xy <- t(utils::combn(colnames(m), 2)) + mDf <- data.frame(xy, mut = m[xy]) + mDf$X1 <- as.factor(as.numeric(gsub("R", "", mDf$X1))) + mDf$X2 <- as.factor(as.numeric(gsub("R", "", mDf$X2))) + + p <- ggplot2::ggplot(mDf) + + ggplot2::aes(x = X1, y = X2, fill = mut) + + ggplot2::geom_tile( + color = "white", + lwd = 0.5, + linetype = 1 + ) + + ggplot2::labs(fill = "Mutuality") + + ggplot2::theme(axis.title = ggplot2::element_blank()) + + ggplot2::coord_equal() + + return(p) +} + + diff --git a/tests/testthat/test_vis_mutual_info.R b/tests/testthat/test_vis_mutual_info.R new file mode 100644 index 0000000..f245db2 --- /dev/null +++ b/tests/testthat/test_vis_mutual_info.R @@ -0,0 +1,19 @@ +test_that("Basic tests", { + logFile <- tempfile(fileext = ".txt") + configFile <- tempfile() + + startLogger(logFile) + createConfigFile(configFile) + + testPDS <- readPHGDataSet( + PHGMethod( + PHGLocalCon(configFile), + "PATH_METHOD" + ) + ) + + plotResults <- plotMutualInfo(testPDS) + + expect_true(is(plotResults, "gg")) +}) + From a2c2b7f62917501ec0b363d058e96faa59de76f3 Mon Sep 17 00:00:00 2001 From: Brandon Date: Tue, 10 Oct 2023 15:52:48 -0400 Subject: [PATCH 34/35] Minor edit --- tests/testthat/test_vis_mutual_info.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test_vis_mutual_info.R b/tests/testthat/test_vis_mutual_info.R index f245db2..9a12e19 100644 --- a/tests/testthat/test_vis_mutual_info.R +++ b/tests/testthat/test_vis_mutual_info.R @@ -17,3 +17,4 @@ test_that("Basic tests", { expect_true(is(plotResults, "gg")) }) + From 12ce6aaa9f6deefa17d2f49a36c40b87a9208b38 Mon Sep 17 00:00:00 2001 From: Brandon Date: Wed, 11 Oct 2023 07:52:30 -0400 Subject: [PATCH 35/35] Add press release --- NAMESPACE | 2 ++ NEWS | 25 +++++++++++++++++++ NEWS.md | 25 +++++++++++++++++++ R/class_phg_dataset.R | 2 -- ...s_mutual_info.R => vis_plot_mutual_info.R} | 1 + man/plotMutualInfo.Rd | 20 +++++++++++++++ ...ual_info.R => test_vis_plot_mutual_info.R} | 0 7 files changed, 73 insertions(+), 2 deletions(-) rename R/{vis_mutual_info.R => vis_plot_mutual_info.R} (94%) create mode 100644 man/plotMutualInfo.Rd rename tests/testthat/{test_vis_mutual_info.R => test_vis_plot_mutual_info.R} (100%) diff --git a/NAMESPACE b/NAMESPACE index 80523ce..18fd45a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ export(phgMethodId) export(phgMethodType) export(phgType) export(plotGraph) +export(plotMutualInfo) export(port) export(readHaplotypeIds) export(readPHGDataSet) @@ -61,6 +62,7 @@ exportMethods(phgMethodId) exportMethods(phgMethodType) exportMethods(phgType) exportMethods(plotGraph) +exportMethods(plotMutualInfo) exportMethods(port) exportMethods(readHaplotypeIds) exportMethods(readPHGDataSet) diff --git a/NEWS b/NEWS index 809f3da..28da363 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,28 @@ +## CHANGES IN VERSION 0.2.0 +* Unified workflow for both local and server instances +* Added new class, `PHGServerCon` + + New object for connecting to remote public PHG servers using BrAPI + endpoints +* Added new class, `PHGLocalCon` + + New object for connecting to local SQLite or PostgreSQL database + instances +* Added new class, `HaplotypeGraph` + + Wrapper for PHG API Java graph object +* Prior objects now use method dispatch for singular set of methods to return + relevant PHG data: + + `PHGMethod()` + + `showPHGMethods()` + + `readSamples()` + + `readRefRanges()` + + `readHaplotypeIds()` + + `readPHGDataSet()` +* Updated summary methods: + + `numHaploPerRefRange()` + + `calcMutualInfo()` + + `plotGraph()` + + `plotMutualInfo()` + + ## CHANGES IN VERSION 0.1.18 * Fixed `availablePHGMethods()`: + Now returns only method IDs for graphs with more than 100 samples in the diff --git a/NEWS.md b/NEWS.md index 11b5436..0d5e7a9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,28 @@ +## rPHG 0.2.0 +* Unified workflow for both local and server instances +* Added new class, `PHGServerCon` + + New object for connecting to remote public PHG servers using BrAPI + endpoints +* Added new class, `PHGLocalCon` + + New object for connecting to local SQLite or PostgreSQL database + instances +* Added new class, `HaplotypeGraph` + + Wrapper for PHG API Java graph object +* Prior objects now use method dispatch for singular set of methods to return + relevant PHG data: + + `PHGMethod()` + + `showPHGMethods()` + + `readSamples()` + + `readRefRanges()` + + `readHaplotypeIds()` + + `readPHGDataSet()` +* Updated summary methods: + + `numHaploPerRefRange()` + + `calcMutualInfo()` + + `plotGraph()` + + `plotMutualInfo()` + + ## rPHG 0.1.18 * Modified `availablePHGMethods()`: + Now returns only method IDs for graphs with more than 100 samples in the diff --git a/R/class_phg_dataset.R b/R/class_phg_dataset.R index e0dc25a..e481917 100644 --- a/R/class_phg_dataset.R +++ b/R/class_phg_dataset.R @@ -98,8 +98,6 @@ setMethod( ) - - ## ---- #' @param object A \code{PHGDataSet} object #' @param samples Samples/taxa to include in plot diff --git a/R/vis_mutual_info.R b/R/vis_plot_mutual_info.R similarity index 94% rename from R/vis_mutual_info.R rename to R/vis_plot_mutual_info.R index 3eb1bf9..e2b869f 100644 --- a/R/vis_mutual_info.R +++ b/R/vis_plot_mutual_info.R @@ -17,6 +17,7 @@ plotMutualInfoFromPHGDataSet <- function(phgObj) { linetype = 1 ) + ggplot2::labs(fill = "Mutuality") + + ggplot2::scale_fill_viridis_c() + ggplot2::theme(axis.title = ggplot2::element_blank()) + ggplot2::coord_equal() diff --git a/man/plotMutualInfo.Rd b/man/plotMutualInfo.Rd new file mode 100644 index 0000000..1e28481 --- /dev/null +++ b/man/plotMutualInfo.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class_all_generics.R, R/class_phg_dataset.R +\name{plotMutualInfo} +\alias{plotMutualInfo} +\alias{plotMutualInfo,PHGDataSet-method} +\title{Plot mutual information} +\usage{ +plotMutualInfo(object, ...) + +\S4method{plotMutualInfo}{PHGDataSet}(object) +} +\arguments{ +\item{object}{A \code{PHGDataSet} object} + +\item{...}{Additional arguments, for use in specific methods} +} +\description{ +Generates a visualization of calculated mutual information for a +given set of reference ranges +} diff --git a/tests/testthat/test_vis_mutual_info.R b/tests/testthat/test_vis_plot_mutual_info.R similarity index 100% rename from tests/testthat/test_vis_mutual_info.R rename to tests/testthat/test_vis_plot_mutual_info.R