From cc00cd4f5e487fb5f6c419f9a31280d9f7b11d50 Mon Sep 17 00:00:00 2001 From: Richard Meitern Date: Fri, 18 Oct 2024 14:06:52 +0300 Subject: [PATCH] getting linked table subsets function exported --- R/getLinkedDataFromLevel.R | 69 ++++++++++++++++++++ R/getLowerTableSubsets.R | 16 +---- R/lowerTblData.R | 1 - R/upperTblData.R | 1 - tests/testthat/test-getLinkedDataFromLevel.R | 63 ++++++++++++++++++ tests/testthat/test-getLowerTableSubsets.R | 2 +- vignettes/manipulating-rdbesdataobjects.Rmd | 28 ++++++++ 7 files changed, 162 insertions(+), 18 deletions(-) create mode 100644 R/getLinkedDataFromLevel.R create mode 100644 tests/testthat/test-getLinkedDataFromLevel.R diff --git a/R/getLinkedDataFromLevel.R b/R/getLinkedDataFromLevel.R new file mode 100644 index 0000000..0926371 --- /dev/null +++ b/R/getLinkedDataFromLevel.R @@ -0,0 +1,69 @@ +#' Retrieve Linked Data Between RDBES Tables at a Specified Level +#' +#' The `getLinkedDataFromLevel` function facilitates the retrieval of linked data between different levels of RDBES tables. Depending on the relative positions of the source and target tables within the `RDBESDataObject`, the function determines whether to traverse "up" or "down" the data hierarchy to obtain the desired linked data. +#' +#' @param field A character string specifying the field name from which to retrieve linked data. The first two characters of this field indicate the source table. +#' @param values A vector of values corresponding to the specified `field` for which linked data is to be retrieved. +#' @param rdbesTables An `RDBESDataObject` containing the relevant RDBES tables. This object should include all tables that may be linked based on the provided `field` and `level`. +#' @param level A character string specifying the target table level from which to retrieve linked data. This must be one of the names within the `rdbesTables` object. +#' @param verbose Logical flag indicating whether to print detailed information about the data retrieval process. Default is `FALSE`. +#' +#' @return The subset of the table at the specified `level`. +#' +#' @examples +#' \dontrun{ +#' # Example 1: Going up in the table hierarchy to retrieve data from the DE table +#' # Retrieve data from the DE level based on BVid from the BV table +#' # This returns 1 row from the DE table +#' getLinkedDataFromLevel("BVid", c(1), H8ExampleEE1, "DE", TRUE) +#' +#' # Example 2: Going down in the table hierarchy to retrieve data from the SA table +#' # Retrieve data from the SA level based on DEid from the DE table +#' # This returns 15 rows from the SA table +#' getLinkedDataFromLevel("DEid", c(1), H8ExampleEE1, "SA", TRUE) +#' +#' # Example 3: Going up in the table hierarchy to see the Vessel that caught a specific fish +#' # Retrieve data from the VS level based on BVfishId from the BV table +#' getLinkedDataFromLevel("BVfishId", c("410472143", "410472144"), H8ExampleEE1, "VS", TRUE) +#' } +#' @export +getLinkedDataFromLevel <- function(field, values, rdbesTables, level, verbose = FALSE){ + + # Check if rdbesTables is of class "RDBESDataObject" + if(inherits(rdbesTables, "RDBESDataObject")) { + rdbesTables <- sort(rdbesTables) + } else { + stop("rdbesTables must be of class RDBESDataObject") + } + + # Check if the specified level exists within rdbesTables + if(!level %in% names(rdbesTables)){ + stop("Table ", level, " not found in the RDBESDataObject") + } + + # Extract the source table abbreviation from the field name + sourceTbl <- substr(field, 1, 2) + + # Get the list of table names + tblNames <- names(rdbesTables) + + # Determine the positions of sourceTbl and target level in the table list + sourcePos <- which(tblNames == sourceTbl) + targetPos <- which(tblNames == level) + + # Determine traversal direction based on table positions + res <- NULL + if(sourcePos > targetPos){ + if(verbose){ + cat("Traversing upwards in the table hierarchy from", sourceTbl, "to", level, "\n") + } + res <- upperTblData(field, values, rdbesTables, level, verbose) + } else { + if(verbose){ + cat("Traversing downwards in the table hierarchy from", sourceTbl, "to", level, "\n") + } + res <- lowerTblData(field, values, rdbesTables, level, verbose) + } + + return(res) +} diff --git a/R/getLowerTableSubsets.R b/R/getLowerTableSubsets.R index 05db061..830bfca 100644 --- a/R/getLowerTableSubsets.R +++ b/R/getLowerTableSubsets.R @@ -22,24 +22,10 @@ #' based on the ID column of the target table. #' getLowerTableSubsets <- function(subsets, tblName, rdbesTables, combineStrata = TRUE, verbose = FALSE) { - # Check if rdbesTables is of class "RDBESDataObject" - if(inherits(rdbesTables, "RDBESDataObject")) { - tableNames <- names(summary(rdbesTables)$data) - # Select only the relevant hierarchy table names - rdbesTables <- rdbesTables[tableNames] - } else { - stop("rdbesTables must be of class RDBESDataObject") - } - if(!tblName %in% names(rdbesTables)){ - stop("Table ", tblName, " not found in the RDBESData object") - } - res <- list() - if(verbose) print("Getting lower table data") - # Process each subset for(ss in names(subsets)){ - res[[ss]] <- lowerTblData(ss, subsets[[ss]], rdbesTables, tblName, verbose) + res[[ss]] <- getLinkedDataFromLevel(ss, subsets[[ss]], rdbesTables, tblName, verbose) } # Function to get the intersection of IDs diff --git a/R/lowerTblData.R b/R/lowerTblData.R index 479710c..017456d 100644 --- a/R/lowerTblData.R +++ b/R/lowerTblData.R @@ -27,7 +27,6 @@ #' tblsSprat <- list( DE = DE ,SD = SD, TE = TE, VS = VS, LE = LE ) #' #' lowerTblData("TEid", c(4), tblsSprat, "LE", T) -#'@export lowerTblData <- function(field, values, tbls, level, verbose = FALSE) { #check if tables are of correct type if(!is.list(tbls)) stop("tbls must be a list") diff --git a/R/upperTblData.R b/R/upperTblData.R index 2c99372..ff917a1 100644 --- a/R/upperTblData.R +++ b/R/upperTblData.R @@ -29,7 +29,6 @@ #' VS <- data.table(VSid = c(1, 2),SDid =c(1,2), value = c(10, 20)) #' tbls <- list(DE = DE, SD = SD, VS = VS) #' upperTblData("VSid", c(1), tbls, "DE") -#'@export upperTblData <- function(field, values, tbls, level, verbose = FALSE){ #check if tables are of correct type if(!is.list(tbls)) stop("tbls must be a list") diff --git a/tests/testthat/test-getLinkedDataFromLevel.R b/tests/testthat/test-getLinkedDataFromLevel.R new file mode 100644 index 0000000..362a9f1 --- /dev/null +++ b/tests/testthat/test-getLinkedDataFromLevel.R @@ -0,0 +1,63 @@ + +# Test for Example 1: Going up in the table hierarchy to retrieve data from the DE table +test_that("Retrieve data from DE based on BVid", { + result <- getLinkedDataFromLevel("BVid", c(1), H8ExampleEE1, "DE") + + # Check that the result is a data.table (or other expected data structure) + expect_s3_class(result, "data.table") + + # Check that the result has 1 row, as expected + expect_equal(nrow(result), 1) + +}) + +# Test for Example 2: Going down in the table hierarchy to retrieve data from the SA table +test_that("Retrieve data from SA based on DEid", { + result <- getLinkedDataFromLevel("DEid", c(1), H8ExampleEE1, "SA") + + # Check that the result is a data.table (or other expected data structure) + expect_s3_class(result, "data.table") + + # Check that the result has 15 rows, as expected + expect_equal(nrow(result), 15) + +}) + +# Test for Example 3: Going up in the table hierarchy to retrieve data from the VS table based on BVfishId +test_that("Retrieve data from VS based on BVfishId", { + result <- getLinkedDataFromLevel("BVfishId", c("410472143", "410472144"), H8ExampleEE1, "VS") + + # Check that the result is a data.table (or other expected data structure) + expect_s3_class(result, "data.table") + + # Check that the result contains data (you can adjust this depending on known expected results) + expect_equal(nrow(result), 1) + + # Optionally, check for specific values in the result + +}) + +test_that("Error when rdbesTables is not of class RDBESDataObject", { + # Pass an invalid class (e.g., a list) instead of RDBESDataObject + invalid_rdbesTables <- list() + + # Expect the function to throw an error + expect_error( + getLinkedDataFromLevel("BVid", c(1), invalid_rdbesTables, "DE"), + "rdbesTables must be of class RDBESDataObject" + ) +}) + +test_that("Error when level is not found in rdbesTables", { + # Assume H8ExampleEE1 is a valid RDBESDataObject, but "XX" is not a valid level + expect_error( + getLinkedDataFromLevel("BVid", c(1), H8ExampleEE1, "XX"), + "Table XX not found in the RDBESDataObject" + ) +}) + + + + + + diff --git a/tests/testthat/test-getLowerTableSubsets.R b/tests/testthat/test-getLowerTableSubsets.R index 76783c6..a8bcc50 100644 --- a/tests/testthat/test-getLowerTableSubsets.R +++ b/tests/testthat/test-getLowerTableSubsets.R @@ -21,7 +21,7 @@ test_that("Function throws error for missing table name", { subsets <- list(TEid = c(4)) expect_error(getLowerTableSubsets(subsets, "XYZ", H8ExampleEE1), - "Table XYZ not found in the RDBESData object") + "Table XYZ not found in the RDBESDataObject") }) test_that("Function returns correct data with valid inputs", { diff --git a/vignettes/manipulating-rdbesdataobjects.Rmd b/vignettes/manipulating-rdbesdataobjects.Rmd index f2fc265..93f9665 100644 --- a/vignettes/manipulating-rdbesdataobjects.Rmd +++ b/vignettes/manipulating-rdbesdataobjects.Rmd @@ -186,7 +186,35 @@ validateRDBESDataObject(myFilteredObjectValidSpeciesLinks, verbose = FALSE) ``` +## Getting Subsets of RDBESDataObject Tables +Sometimes it we want to see how a field or values in the **RDBESDataObject** are connected to otther tables. +One use case would be e.g. to see when a specific Landing Event (LE) occured.For this we can use the **getLinkedDataFromLevel()** function. + +```{r} +#get the TE table corresponding to the first LEid in the H8ExampleEE1 object +getLinkedDataFromLevel("LEid", c(1), H8ExampleEE1, "TE", verbose = TRUE) +``` +Similarly we can get the subset of the LE table corresponding to a specific value in the TE table. This does not have to be the *id* field, but can be any field in the table. + +```{r} +#get the TE table corresponding to the first LEid in the H8ExampleEE1 object +getLinkedDataFromLevel("TEstratumName", c("November"), H8ExampleEE1, "LE", verbose = TRUE) +``` +Several values can be used to get a subset of the table. + +```{r} +#get the SA table corresponding to the first 2 TEids in the H8ExampleEE1 object +getLinkedDataFromLevel("TEid", c(1,2), H8ExampleEE1, "SA", verbose = TRUE) +``` +Also lower hierarchy tables can be used to get the subset of the higher hierarchy tables. + +```{r} +#which vessel caught those fish? +getLinkedDataFromLevel("BVfishId", c("410472143", "410472144"), H8ExampleEE1, "VS", TRUE) +``` + +If some table is missing it is skipped if possible. If it is not possible to skip it, the function will return an error. See also other package vignettes: