From 7a5759e47730072b225bae9c4c51d4a70a1023ad Mon Sep 17 00:00:00 2001 From: lilyclements Date: Fri, 1 Nov 2024 16:39:01 +0000 Subject: [PATCH] adding link.R --- NAMESPACE | 1 + R/data_book.R | 440 +++++++++++++++++++++++++++++++++++++- R/link.R | 81 +++++++ man/DataBook.Rd | 551 +++++++++++++++++++++++++++++++++++++++++++++++- man/link.Rd | 130 ++++++++++++ 5 files changed, 1199 insertions(+), 4 deletions(-) create mode 100644 R/link.R create mode 100644 man/link.Rd diff --git a/NAMESPACE b/NAMESPACE index 10965e9..3538b60 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,4 +4,5 @@ export("%>%") export(DataBook) export(DataSheet) export(instat_comment) +export(link) importFrom(magrittr,"%>%") diff --git a/R/data_book.R b/R/data_book.R index e4cb4e4..2fb121f 100644 --- a/R/data_book.R +++ b/R/data_book.R @@ -215,7 +215,22 @@ #' \item{\code{delete_comment(comment_id)}}{Deletes a comment from the data sheet based on the comment ID.} #' \item{\code{get_comment_ids()}}{Retrieves all comment IDs currently stored in the data sheet.} #' \item{\code{get_comments_as_data_frame()}}{Converts all comments in the data sheet to a data frame format for easier inspection and analysis.} -#' @export +#' \item{\code{update_links_rename_data_frame(old_data_name, new_data_name)}}{This function updates all links that reference a data frame with a specified old name, renaming it to a new name.} +#' \item{\code{update_links_rename_column(data_name, old_column_name, new_column_name)}}{This function updates all links referencing a column in a data frame with a specified old column name, renaming it to a new column name.} +#' \item{\code{add_link(from_data_frame, to_data_frame, link_pairs, type, link_name)}}{This function adds a new link between two data frames with the specified link pairs and type. It will check if the link already exists or if the link columns are keys.} +#' \item{\code{get_link_names(data_name, include_overall = TRUE, include, exclude, include_empty = FALSE, as_list = FALSE)}}{Retrieves the names of all links involving a specified data frame, with options to include or exclude specific types.} +#' \item{\code{link_exists_from(curr_data_frame, link_pairs)}}{Verifies if a link exists from a specific data frame with given link pairs.} +#' \item{\code{link_exists_between(from_data_frame, to_data_frame, ordered = FALSE)}}{This function checks if there is an ordered or unordered link between two specified data frames.} +#' \item{\code{get_link_between(from_data_frame, to_data_frame, ordered = FALSE)}}{Retrieves the link definition between two specified data frames.} +#' \item{\code{link_exists_from_by_to(first_data_frame, link_pairs, second_data_frame)}}{This function checks if a link exists from `first_data_frame` to `second_data_frame` using the specified `link_pairs` columns.} +#' \item{\code{get_linked_to_data_name(from_data_frame, link_cols = c(), include_self = FALSE)}}{This function returns the names of data frames linked to `from_data_frame`. Optionally, includes `from_data_frame` itself in the output if `include_self` is TRUE. Filters results by `link_cols`, if provided.} +#' \item{\code{get_linked_to_definition(from_data_frame, link_pairs)}}{This function returns a list of the target data frame and matched columns.} +#' \item{\code{get_possible_linked_to_definition(from_data_frame, link_pairs)}}{This function attempts to find a linked data frame that matches `link_pairs`. Recursively explores links between multiple data frames.} +#' \item{\code{get_equivalent_columns(from_data_name, columns, to_data_name)}}{This function returns columns in `to_data_name` equivalent to `columns` in `from_data_name`. Recursively searches links between multiple data frames.} +#' \item{\code{link_between_containing(from_data_frame, containing_columns, to_data_frame)}}{This function returns columns in `to_data_frame` corresponding to `containing_columns` in `from_data_frame` if a link exists between them.} +#' \item{\code{view_link(link_name)}}{Displays the details of a specified link.} +#' +#' @export DataBook <- R6::R6Class("DataBook", public = list( #' @description @@ -8588,8 +8603,7 @@ DataBook <- R6::R6Class("DataBook", } }, - #' @description - #' Generate ANOVA tables for specified columns in a dataset. + #' @description Generate ANOVA tables for specified columns in a dataset. #' @param data_name The name of the data table. #' @param x_col_names The names of the columns for the independent variables. #' @param y_col_name The name of the column for the dependent variable. @@ -8615,6 +8629,426 @@ DataBook <- R6::R6Class("DataBook", self$get_data_objects(data_name)$set_options_by_context_types(obyc_types = obyc_types, key_columns = key_columns) }, + #' Update links to rename data frame + #' + #' @description This function updates all links that reference a data frame with a specified old name, + #' renaming it to a new name. + #' + #' @param old_data_name The current name of the data frame in links + #' @param new_data_name The new name to replace the old data frame name in links + update_links_rename_data_frame = function(old_data_name, new_data_name) { + for(i in seq_along(private$.links)) { + private$.links[[i]]$rename_data_frame_in_link(old_data_name, new_data_name) + } + }, + + #' Update links to rename a column + #' + #' @description This function updates all links referencing a column in a data frame with a specified old column name, + #' renaming it to a new column name. + #' + #' @param data_name The name of the data frame containing the column + #' @param old_column_name The current name of the column in links + #' @param new_column_name The new name to replace the old column name in links + update_links_rename_column = function(data_name, old_column_name, new_column_name) { + for(i in seq_along(private$.links)) { + private$.links[[i]]$rename_column_in_link(data_name, old_column_name, new_column_name) + } + }, + + #' Add a new link between data frames + #' + #' @description This function adds a new link between two data frames with the specified link pairs and type. + #' It will check if the link already exists or if the link columns are keys. + #' + #' @param from_data_frame The name of the originating data frame in the link + #' @param to_data_frame The name of the target data frame in the link + #' @param link_pairs A named vector or list representing pairs of columns to link between data frames + #' @param type The type of the link (e.g., 'one-to-one', 'many-to-one') + #' @param link_name Optional; a name for the link. If not provided, a default name is assigned + add_link = function(from_data_frame, to_data_frame, link_pairs, type, link_name) { + if(length(names(link_pairs)) != length(link_pairs)) stop("link_pairs must be a named vector or list.") + if(!self$link_exists_between(from_data_frame, to_data_frame)) { + # This means when creating a link to single value data frame, there will be no key in to_data_frame + # Will this cause any issues? + if(length(link_pairs) > 0 && !self$is_key(to_data_frame, link_pairs)) { + message("link columns must be a key in the to_data_frame\nAttempting to create key...") + self$add_key(to_data_frame, as.character(link_pairs)) + message("New key created") + } + new_link <- link$new(from_data_frame = from_data_frame, to_data_frame = to_data_frame, link_columns = list(link_pairs), type = type) + if(missing(link_name)) link_name <- next_default_item("link", names(private$.links)) + if(link_name %in% names(private$.links)) warning("A link called ", link_name, " already exists. It wil be replaced.") + private$.links[[link_name]] <- new_link + } + else { + index <- integer(0) + for(i in 1:length(private$.links)) { + if(private$.links[[i]]$from_data_frame == from_data_frame && private$.links[[i]]$to_data_frame == to_data_frame) { + index <- i + from_on_left <- TRUE + break + } + else if(private$.links[[i]]$from_data_frame == to_data_frame && private$.links[[i]]$to_data_frame == from_data_frame) { + index <- i + from_on_left <- FALSE + break + } + } + # This should never happen because we are inside the Else of link_exists_between + if(length(index) == 0) stop("link not found") + + if(type != private$.links[[index]]$type) stop("Cannot add link of type ", type, ". These data frames are already linked by type: ", private$.links[[index]]$type) + curr_link_columns <- private$.links[[index]]$link_columns + curr_num_links <- length(curr_link_columns) + found <- FALSE + for(curr_link_pairs in curr_link_columns) { + # Are these the right checks on the link columns? + if(from_on_left && length(link_pairs) == length(curr_link_pairs) && setequal(names(link_pairs), names(curr_link_pairs))) { + message("A link with these columns already exists. A new link will not be added.") + found <- TRUE + break + } + else if(!from_on_left && length(link_pairs) == length(curr_link_pairs) && (setequal(link_pairs, names(curr_link_pairs)))) { + message("A link with these columns already exists. A new link will not be added.") + found <- TRUE + break + } + } + if(!found) { + if(!self$is_key(to_data_frame, link_pairs)) { + message("link columns must be a key in the to_data_frame\nAttempting to create key...") + self$add_key(to_data_frame, as.character(link_pairs)) + message("new key created") + } + if(from_on_left) private$.links[[index]]$link_columns[[curr_num_links + 1]] <- link_pairs + else { + new_link_pairs <- names(link_pairs) + names(new_link_pairs) <- link_pairs + private$.links[[index]]$link_columns[[curr_num_links + 1]] <- new_link_pairs + } + } + } + if (from_data_frame != to_data_frame){ + cat(paste("Link name:", link_name), + paste("From data frame:", from_data_frame), + paste("To data frame:", to_data_frame), + paste("Link columns:", paste(names(link_pairs), "=", link_pairs, collapse = ", ")), + sep = "\n") + } + }, + + #' Get link names + #' + #' @description Retrieves the names of all links involving a specified data frame, with options to include or exclude specific types. + #' + #' @param data_name The name of the data frame + #' @param include_overall Boolean; if TRUE, includes overall links + #' @param include Optional vector of link names to include + #' @param exclude Optional vector of link names to exclude + #' @param include_empty Boolean; if TRUE, includes links with no associated data + #' @param as_list Boolean; if TRUE, returns a list format + get_link_names = function(data_name, include_overall = TRUE, include, exclude, include_empty = FALSE, as_list = FALSE) { + if(exclude_self_links) { + out <- c() + i <- 1 + for(link in private$.links) { + if(link$from_data_frame != link$to_data_frame) out <- c(out, names(private$.links)[i]) + i <- i + 1 + } + } + else out <- names(private$.links) + if(as_list) { + lst <- list() + lst[[overall_label]] <- out + return(lst) + } + else return(out) + }, + + #' Check if a link exists from a data frame + #' + #' @description Verifies if a link exists from a specific data frame with given link pairs. + #' + #' @param curr_data_frame The name of the originating data frame + #' @param link_pairs The link pairs to check for existence + link_exists_from = function(curr_data_frame, link_pairs) { + link_exists <- FALSE + for(curr_link in private$.links) { + if(curr_link$from_data_frame == curr_data_frame) { + for(curr_link_pairs in curr_link$link_columns) { + if(length(link_pairs) == length(curr_link_pairs) && setequal(link_pairs, names(curr_link_pairs))) { + return(TRUE) + break + } + } + } + } + return(FALSE) + }, + + #' Check if a link exists between two data frames + #' + #' @description This function checks if there is an ordered or unordered link between two specified data frames. + #' + #' @param from_data_frame The name of the originating data frame + #' @param to_data_frame The name of the target data frame + #' @param ordered Boolean; if TRUE, checks for an ordered link + link_exists_between = function(from_data_frame, to_data_frame, ordered = FALSE) { + # If ordered = TRUE then from_data_frame must be from_data_frame in the link + # otherwise from_data_frame could be to_data_frame in the link + if(ordered) { + return(any(sapply(private$.links, function(link) link$from_data_frame == from_data_frame && link$to_data_frame == to_data_frame))) + } + else { + return(any(sapply(private$.links, function(link) link$from_data_frame == from_data_frame && link$to_data_frame == to_data_frame)) + || any(sapply(private$.links, function(link) link$from_data_frame == to_data_frame && link$to_data_frame == from_data_frame))) + } + }, + + #' Get the link definition between two data frames + #' + #' @description Retrieves the link definition between two specified data frames. + #' + #' @param from_data_frame The name of the originating data frame + #' @param to_data_frame The name of the target data frame + #' @param ordered Boolean; if TRUE, retrieves an ordered link + get_link_between = function(from_data_frame, to_data_frame, ordered = FALSE) { + if(ordered) { + for(curr_link in private$.links) { + if((curr_link$from_data_frame == from_data_frame && curr_link$to_data_frame == to_data_frame)) { + return(curr_link) + } + } + } + else { + for(curr_link in private$.links) { + if((curr_link$from_data_frame == from_data_frame && curr_link$to_data_frame == to_data_frame) || (curr_link$from_data_frame == to_data_frame && curr_link$to_data_frame == from_data_frame)) { + return(curr_link) + } + } + } + return(NULL) + }, + + #' Check if a Link Exists from One Data Frame to Another with Specified Columns + #' + #' @description This function checks if a link exists from `first_data_frame` to `second_data_frame` + #' using the specified `link_pairs` columns. + #' + #' @param first_data_frame Name of the starting data frame. + #' @param link_pairs Named vector of columns used in the link. + #' @param second_data_frame Name of the target data frame. + #' @return Boolean indicating whether the specified link exists. + link_exists_from_by_to = function(first_data_frame, link_pairs, second_data_frame) { + link_exists <- FALSE + for(curr_link in private$.links) { + if(curr_link$from_data_frame == first_data_frame && curr_link$to_data_frame == second_data_frame) { + for(curr_link_pairs in curr_link$link_columns) { + if(length(link_pairs) == length(curr_link_pairs) && setequal(link_pairs, names(curr_link_pairs))) { + return(TRUE) + break + } + } + } + } + return(FALSE) + }, + + #' Retrieve Names of Linked Data Frames + #' + #' @description This function returns the names of data frames linked to `from_data_frame`. + #' Optionally, includes `from_data_frame` itself in the output if `include_self` is TRUE. + #' Filters results by `link_cols`, if provided. + #' + #' @param from_data_frame Name of the source data frame. + #' @param link_cols Optional column names to filter links. + #' @param include_self Boolean indicating if `from_data_frame` should be included. + #' @return A character vector of data frame names. + get_linked_to_data_name = function(from_data_frame, link_cols = c(), include_self = FALSE) { + out <- c() + if(include_self) out <- c(out, from_data_frame) + for(curr_link in private$.links) { + if(curr_link$from_data_frame == from_data_frame) { + if(length(link_cols) == 0) { + out <- c(out, curr_link$to_data_frame) + } + else { + for(curr_link_pairs in curr_link$link_columns) { + if(length(link_cols) == length(curr_link_pairs) && setequal(link_cols, names(curr_link_pairs))) { + out <- c(out, curr_link$to_data_frame) + } + } + } + } + } + return(unique(out)) + }, + + #' Get the Linked Data Frame and Matching Columns for a Link + #' + #' @description This function returns a list of the target data frame and matched columns. + #' + #' @param from_data_frame Name of the source data frame. + #' @param link_pairs Named vector of link columns. + #' @return List with the target data frame name and matching column names. + get_linked_to_definition = function(from_data_frame, link_pairs) { + to_data_name <- self$get_linked_to_data_name(from_data_frame, link_pairs) + if(length(to_data_name) > 0) { + # TODO what happens if there is more than 1? + to_data_name <- to_data_name[1] + curr_link <- self$get_link_between(from_data_frame, to_data_name) + for(curr_link in private$.links) { + for(curr_link_pairs in curr_link$link_columns) { + if(length(link_pairs) == length(curr_link_pairs) && setequal(link_pairs, names(curr_link_pairs))) { + return(list(to_data_name, as.vector(curr_link_pairs[link_pairs]))) + } + } + } + } + return(list()) + }, + + #' Recursively Search for Linked Data Frame Definitions + #' + #' @description This function attempts to find a linked data frame that matches `link_pairs`. + #' Recursively explores links between multiple data frames. + #' + #' @param from_data_frame Name of the starting data frame. + #' @param link_pairs Named vector of columns used in the link. + #' @return List with the name and columns of a matching linked data frame, or an empty list. + get_possible_linked_to_definition = function(from_data_frame, link_pairs) { + def <- self$get_linked_to_definition(from_data_frame, link_pairs) + if(length(def) != 0) return(def) + else { + prev_data_links <- list(list(from_data_frame, link_pairs)) + continue <- TRUE + while(continue) { + curr_data_links <- prev_data_links + curr_data_names <- sapply(curr_data_links, function(x) x[[1]]) + for(to_data_name in self$get_data_names()) { + i = 1 + for(curr_from_data_frame in curr_data_names) { + curr_link_cols <- self$link_between_containing(curr_from_data_frame, curr_data_links[[i]][[2]], to_data_name) + # Is it enough to check unqiue data frames? + if(length(curr_link_cols) != 0 && !(to_data_name %in% sapply(curr_data_links, function(x) x[[1]]))) { + curr_data_links[[length(curr_data_links) + 1]] <- list(to_data_name, curr_link_cols) + } + i = i + 1 + } + } + if(length(prev_data_links) != length(curr_data_links)) { + curr_data_names <- sapply(curr_data_links, function(x) x[[1]]) + prev_data_names <- sapply(prev_data_links, function(x) x[[1]]) + for(i in seq_along(curr_data_names)) { + if(curr_data_names[i] %in% setdiff(curr_data_names, prev_data_names)) { + def <- self$get_linked_to_definition(curr_data_names[i], curr_data_links[[i]][[2]]) + if(length(def) > 0) return(def) + } + } + prev_data_links <- curr_data_links + } + else continue <- FALSE + } + return(c()) + } + }, + + #' Retrieve Equivalent Columns in Linked Data Frames + #' + #' @description This function returns columns in `to_data_name` equivalent to `columns` in `from_data_name`. + #' Recursively searches links between multiple data frames. + #' + #' @param from_data_name Name of the source data frame. + #' @param columns Columns to be matched. + #' @param to_data_name Name of the target data frame. + #' @return Character vector of equivalent column names in `to_data_name`, or an empty vector. + get_equivalent_columns = function(from_data_name, columns, to_data_name) { + if(from_data_name == to_data_name) equivalent_columns <- columns + else equivalent_columns <- self$link_between_containing(from_data_name, columns, to_data_name) + if(length(equivalent_columns) != 0) return(equivalent_columns) + else { + prev_data_links <- list(list(from_data_name, columns)) + continue <- TRUE + while(continue) { + curr_data_links <- prev_data_links + curr_data_names <- sapply(curr_data_links, function(x) x[[1]]) + for(temp_data_name in self$get_data_names()) { + i = 1 + for(curr_from_data_frame in curr_data_names) { + if(curr_from_data_frame == temp_data_name) curr_link_cols <- curr_data_links[[i]][[2]] + curr_link_cols <- self$link_between_containing(curr_from_data_frame, curr_data_links[[i]][[2]], temp_data_name) + if(length(curr_link_cols) != 0) { + if(temp_data_name == to_data_name) { + return(curr_link_cols) + } + else if(!(temp_data_name %in% sapply(curr_data_links, function(x) x[[1]]))) { + curr_data_links[[length(curr_data_links) + 1]] <- list(temp_data_name, curr_link_cols) + } + } + i = i + 1 + } + } + if(length(prev_data_links) == length(curr_data_links)) continue <- FALSE + else prev_data_links <- curr_data_links + } + return(c()) + } + }, + + #' Retrieve Columns in a Link Containing Specified Columns + #' + #' @description This function returns columns in `to_data_frame` corresponding to `containing_columns` in `from_data_frame` + #' if a link exists between them. + #' + #' @param from_data_frame Name of the source data frame. + #' @param containing_columns Columns to search for in the link. + #' @param to_data_frame Name of the target data frame. + #' @return Character vector of columns in `to_data_frame` if a matching link is found, otherwise an empty vector. + link_between_containing = function(from_data_frame, containing_columns, to_data_frame) { + if(self$link_exists_between(from_data_frame, to_data_frame)) { + curr_link <- self$get_link_between(from_data_frame, to_data_frame) + for(curr_link_pairs in curr_link$link_columns) { + if(curr_link$from_data_frame == from_data_frame) { + if(all(containing_columns %in% names(curr_link_pairs))) { + out <- c() + for(col in containing_columns) { + ind <- which(names(curr_link_pairs) == col) + out <- c(out, curr_link_pairs[[ind]]) + } + return(out) + } + } + else { + if(all(containing_columns %in% curr_link_pairs)) { + out <- c() + for(col in containing_columns) { + ind <- which(curr_link_pairs == col) + out <- c(out, names(curr_link_pairs)[ind]) + } + return(out) + } + } + } + } + return(c()) + }, + + #' View a specific link by name + #' @description Displays the details of a specified link. + #' @param link_name The name of the link to view + view_link = function(link_name) { + temp_link <- self$get_links(link_name) + out <- "" + if(length(temp_link) > 0) { + out <- cat(paste( + paste("Link name:", link_name), + paste("From data frame:", temp_link$from_data_frame), + paste("To data frame:", temp_link$to_data_frame), + paste("Link columns:", paste(names(temp_link$link_columns), "=", temp_link$link_columns, collapse = ", ")), sep = "\n")) + } + }, + #' @title Import SST #' @description Imports SST data and adds keys and links to the specified data tables. #' @param dataset The SST dataset. diff --git a/R/link.R b/R/link.R new file mode 100644 index 0000000..9f0b74a --- /dev/null +++ b/R/link.R @@ -0,0 +1,81 @@ +#' Link Class +#' +#' @description +#' The `link` R6 class represents a relationship between two data frames, defined by link attributes and the columns used to link them. +#' +#' @section Methods: +#' \describe{ +#' \item{\code{data_clone(...)}}{Creates a deep clone of the current `link` object, including all its fields.} +#' \item{\code{rename_data_frame_in_link(old_data_name, new_data_name)}}{Renames one of the data frames involved in the link.} +#' \item{\code{rename_column_in_link(data_name, old_column_name, new_column_name)}}{Renames a column involved in the link between data frames.} +#' } +#' @export +link <- R6::R6Class("link", + public = list( + + #' @description + #' Create a new `link` object. + #' Defines a relationship between two data frames and specifies linking columns. + #' + #' @param from_data_frame A character string representing the name of the first data frame in the link. + #' @param to_data_frame A character string representing the name of the second data frame in the link. + #' @param type A character string representing the type of link, e.g., "keyed". + #' @param link_columns A list where each element defines a way to link the data frames, with each element as a named character vector. The names are columns in `from_data_frame` and the values are corresponding columns in `to_data_frame`. + initialize = function(from_data_frame = "", + to_data_frame = "", + type = "", + link_columns = list()) { + self$from_data_frame <- from_data_frame + self$to_data_frame <- to_data_frame + self$type <- type + self$link_columns <- link_columns + }, + + from_data_frame = "", + to_data_frame = "", + type = "", + link_columns = list(), + + #' @title Clone `link` Object + #' @description Creates a deep clone of the current `link` object, including all its fields. + #' @return A new `link` object with the same field values as the original. + data_clone = function(...) { + ret <- link$new( + from_data_frame = self$from_data_frame, + to_data_frame = self$to_data_frame, + type = self$type, + link_columns = self$link_columns + ) + return(ret) + }, + + #' @title Rename Data Frame in Link + #' @description Renames the specified data frame in the link. + #' @param old_data_name The current name of the data frame to be renamed. + #' @param new_data_name The new name for the data frame. + rename_data_frame_in_link = function(old_data_name, new_data_name) { + if (self$from_data_frame == old_data_name) self$from_data_frame <- new_data_name + if (self$to_data_frame == old_data_name) self$to_data_frame <- new_data_name + }, + + #' @title Rename Column in Link + #' @description Renames a column involved in the link between data frames. + #' @param data_name The name of the data frame where the column is located. + #' @param old_column_name The current name of the column to be renamed. + #' @param new_column_name The new name for the column. + rename_column_in_link = function(data_name, old_column_name, new_column_name) { + if (self$from_data_frame == data_name) { + for (i in seq_along(self$link_columns)) { + names(self$link_columns[[i]])[which(old_column_name %in% names(self$link_columns[[i]]))] <- new_column_name + } + } + if (self$to_data_frame == data_name) { + for (i in seq_along(self$link_columns)) { + self$link_columns[[i]][which(old_column_name %in% self$link_columns[[i]])] <- new_column_name + } + } + } + ), + private = list(), + active = list() +) diff --git a/man/DataBook.Rd b/man/DataBook.Rd index d13cbd3..46f2934 100644 --- a/man/DataBook.Rd +++ b/man/DataBook.Rd @@ -449,6 +449,22 @@ An R6 class to manage a collection of data tables along with their metadata and \item{\code{delete_comment(comment_id)}}{Deletes a comment from the data sheet based on the comment ID.} \item{\code{get_comment_ids()}}{Retrieves all comment IDs currently stored in the data sheet.} \item{\code{get_comments_as_data_frame()}}{Converts all comments in the data sheet to a data frame format for easier inspection and analysis.} +\item{\code{update_links_rename_data_frame(old_data_name, new_data_name)}}{This function updates all links that reference a data frame with a specified old name, renaming it to a new name.} +\item{\code{update_links_rename_column(data_name, old_column_name, new_column_name)}}{This function updates all links referencing a column in a data frame with a specified old column name, renaming it to a new column name.} +\item{\code{add_link(from_data_frame, to_data_frame, link_pairs, type, link_name)}}{This function adds a new link between two data frames with the specified link pairs and type. It will check if the link already exists or if the link columns are keys.} +\item{\code{get_link_names(data_name, include_overall = TRUE, include, exclude, include_empty = FALSE, as_list = FALSE)}}{Retrieves the names of all links involving a specified data frame, with options to include or exclude specific types.} +\item{\code{link_exists_from(curr_data_frame, link_pairs)}}{Verifies if a link exists from a specific data frame with given link pairs.} +\item{\code{link_exists_between(from_data_frame, to_data_frame, ordered = FALSE)}}{This function checks if there is an ordered or unordered link between two specified data frames.} +\item{\code{get_link_between(from_data_frame, to_data_frame, ordered = FALSE)}}{Retrieves the link definition between two specified data frames.} +\item{\code{link_exists_from_by_to(first_data_frame, link_pairs, second_data_frame)}}{This function checks if a link exists from \code{first_data_frame} to \code{second_data_frame} using the specified \code{link_pairs} columns.} +\item{\code{get_linked_to_data_name(from_data_frame, link_cols = c(), include_self = FALSE)}}{This function returns the names of data frames linked to \code{from_data_frame}. Optionally, includes \code{from_data_frame} itself in the output if \code{include_self} is TRUE. Filters results by \code{link_cols}, if provided.} +\item{\code{get_linked_to_definition(from_data_frame, link_pairs)}}{This function returns a list of the target data frame and matched columns.} +\item{\code{get_possible_linked_to_definition(from_data_frame, link_pairs)}}{This function attempts to find a linked data frame that matches \code{link_pairs}. Recursively explores links between multiple data frames.} +\item{\code{get_equivalent_columns(from_data_name, columns, to_data_name)}}{This function returns columns in \code{to_data_name} equivalent to \code{columns} in \code{from_data_name}. Recursively searches links between multiple data frames.} +\item{\code{link_between_containing(from_data_frame, containing_columns, to_data_frame)}}{This function returns columns in \code{to_data_frame} corresponding to \code{containing_columns} in \code{from_data_frame} if a link exists between them.} +\item{\code{view_link(link_name)}}{Displays the details of a specified link.} + +@export \describe{ @@ -860,6 +876,20 @@ An R6 class to manage a collection of data tables along with their metadata and \item \href{#method-DataBook-wrap_or_unwrap_data}{\code{DataBook$wrap_or_unwrap_data()}} \item \href{#method-DataBook-anova_tables2}{\code{DataBook$anova_tables2()}} \item \href{#method-DataBook-define_as_options_by_context}{\code{DataBook$define_as_options_by_context()}} +\item \href{#method-DataBook-update_links_rename_data_frame}{\code{DataBook$update_links_rename_data_frame()}} +\item \href{#method-DataBook-update_links_rename_column}{\code{DataBook$update_links_rename_column()}} +\item \href{#method-DataBook-add_link}{\code{DataBook$add_link()}} +\item \href{#method-DataBook-get_link_names}{\code{DataBook$get_link_names()}} +\item \href{#method-DataBook-link_exists_from}{\code{DataBook$link_exists_from()}} +\item \href{#method-DataBook-link_exists_between}{\code{DataBook$link_exists_between()}} +\item \href{#method-DataBook-get_link_between}{\code{DataBook$get_link_between()}} +\item \href{#method-DataBook-link_exists_from_by_to}{\code{DataBook$link_exists_from_by_to()}} +\item \href{#method-DataBook-get_linked_to_data_name}{\code{DataBook$get_linked_to_data_name()}} +\item \href{#method-DataBook-get_linked_to_definition}{\code{DataBook$get_linked_to_definition()}} +\item \href{#method-DataBook-get_possible_linked_to_definition}{\code{DataBook$get_possible_linked_to_definition()}} +\item \href{#method-DataBook-get_equivalent_columns}{\code{DataBook$get_equivalent_columns()}} +\item \href{#method-DataBook-link_between_containing}{\code{DataBook$link_between_containing()}} +\item \href{#method-DataBook-view_link}{\code{DataBook$view_link()}} \item \href{#method-DataBook-import_SST}{\code{DataBook$import_SST()}} \item \href{#method-DataBook-clone}{\code{DataBook$clone()}} } @@ -5609,6 +5639,155 @@ A vector of CRI component column names. )}\if{html}{\out{}} } +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-update_links_rename_data_frame}{}}} +\subsection{Method \code{update_links_rename_data_frame()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$update_links_rename_data_frame(old_data_name, new_data_name)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-update_links_rename_column}{}}} +\subsection{Method \code{update_links_rename_column()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$update_links_rename_column( + data_name, + old_column_name, + new_column_name +)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-add_link}{}}} +\subsection{Method \code{add_link()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$add_link(from_data_frame, to_data_frame, link_pairs, type, link_name)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_link_names}{}}} +\subsection{Method \code{get_link_names()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_link_names( + data_name, + include_overall = TRUE, + include, + exclude, + include_empty = FALSE, + as_list = FALSE +)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-link_exists_from}{}}} +\subsection{Method \code{link_exists_from()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$link_exists_from(curr_data_frame, link_pairs)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-link_exists_between}{}}} +\subsection{Method \code{link_exists_between()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$link_exists_between(from_data_frame, to_data_frame, ordered = FALSE)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_link_between}{}}} +\subsection{Method \code{get_link_between()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_link_between(from_data_frame, to_data_frame, ordered = FALSE)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-link_exists_from_by_to}{}}} +\subsection{Method \code{link_exists_from_by_to()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$link_exists_from_by_to( + first_data_frame, + link_pairs, + second_data_frame +)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_linked_to_data_name}{}}} +\subsection{Method \code{get_linked_to_data_name()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_linked_to_data_name( + from_data_frame, + link_cols = c(), + include_self = FALSE +)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_linked_to_definition}{}}} +\subsection{Method \code{get_linked_to_definition()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_linked_to_definition(from_data_frame, link_pairs)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_possible_linked_to_definition}{}}} +\subsection{Method \code{get_possible_linked_to_definition()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_possible_linked_to_definition(from_data_frame, link_pairs)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_equivalent_columns}{}}} +\subsection{Method \code{get_equivalent_columns()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_equivalent_columns(from_data_name, columns, to_data_name)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-link_between_containing}{}}} +\subsection{Method \code{link_between_containing()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$link_between_containing( + from_data_frame, + containing_columns, + to_data_frame +)}\if{html}{\out{
}} +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-view_link}{}}} +\subsection{Method \code{view_link()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$view_link(link_name)}\if{html}{\out{
}} +} + } \if{html}{\out{
}} \if{html}{\out{}} @@ -5848,6 +6027,20 @@ The objects of this class are cloneable with this method. \item \href{#method-DataBook-wrap_or_unwrap_data}{\code{DataBook$wrap_or_unwrap_data()}} \item \href{#method-DataBook-anova_tables2}{\code{DataBook$anova_tables2()}} \item \href{#method-DataBook-define_as_options_by_context}{\code{DataBook$define_as_options_by_context()}} +\item \href{#method-DataBook-update_links_rename_data_frame}{\code{DataBook$update_links_rename_data_frame()}} +\item \href{#method-DataBook-update_links_rename_column}{\code{DataBook$update_links_rename_column()}} +\item \href{#method-DataBook-add_link}{\code{DataBook$add_link()}} +\item \href{#method-DataBook-get_link_names}{\code{DataBook$get_link_names()}} +\item \href{#method-DataBook-link_exists_from}{\code{DataBook$link_exists_from()}} +\item \href{#method-DataBook-link_exists_between}{\code{DataBook$link_exists_between()}} +\item \href{#method-DataBook-get_link_between}{\code{DataBook$get_link_between()}} +\item \href{#method-DataBook-link_exists_from_by_to}{\code{DataBook$link_exists_from_by_to()}} +\item \href{#method-DataBook-get_linked_to_data_name}{\code{DataBook$get_linked_to_data_name()}} +\item \href{#method-DataBook-get_linked_to_definition}{\code{DataBook$get_linked_to_definition()}} +\item \href{#method-DataBook-get_possible_linked_to_definition}{\code{DataBook$get_possible_linked_to_definition()}} +\item \href{#method-DataBook-get_equivalent_columns}{\code{DataBook$get_equivalent_columns()}} +\item \href{#method-DataBook-link_between_containing}{\code{DataBook$link_between_containing()}} +\item \href{#method-DataBook-view_link}{\code{DataBook$view_link()}} \item \href{#method-DataBook-import_SST}{\code{DataBook$import_SST()}} \item \href{#method-DataBook-clone}{\code{DataBook$clone()}} } @@ -11370,7 +11563,363 @@ Define options by context for a specified dataset. \item{\code{obyc_types}}{A named list of options by context types.} -\item{\code{key_columns}}{A vector of key columns relevant to the dataset.} +\item{\code{key_columns}}{A vector of key columns relevant to the dataset. +Update links to rename data frame} +} +\if{html}{\out{}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-update_links_rename_data_frame}{}}} +\subsection{Method \code{update_links_rename_data_frame()}}{ +This function updates all links that reference a data frame with a specified old name, +renaming it to a new name. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$update_links_rename_data_frame(old_data_name, new_data_name)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{old_data_name}}{The current name of the data frame in links} + +\item{\code{new_data_name}}{The new name to replace the old data frame name in links +Update links to rename a column} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-update_links_rename_column}{}}} +\subsection{Method \code{update_links_rename_column()}}{ +This function updates all links referencing a column in a data frame with a specified old column name, +renaming it to a new column name. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$update_links_rename_column( + data_name, + old_column_name, + new_column_name +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data_name}}{The name of the data frame containing the column} + +\item{\code{old_column_name}}{The current name of the column in links} + +\item{\code{new_column_name}}{The new name to replace the old column name in links +Add a new link between data frames} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-add_link}{}}} +\subsection{Method \code{add_link()}}{ +This function adds a new link between two data frames with the specified link pairs and type. +It will check if the link already exists or if the link columns are keys. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$add_link(from_data_frame, to_data_frame, link_pairs, type, link_name)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{from_data_frame}}{The name of the originating data frame in the link} + +\item{\code{to_data_frame}}{The name of the target data frame in the link} + +\item{\code{link_pairs}}{A named vector or list representing pairs of columns to link between data frames} + +\item{\code{type}}{The type of the link (e.g., 'one-to-one', 'many-to-one')} + +\item{\code{link_name}}{Optional; a name for the link. If not provided, a default name is assigned +Get link names} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_link_names}{}}} +\subsection{Method \code{get_link_names()}}{ +Retrieves the names of all links involving a specified data frame, with options to include or exclude specific types. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_link_names( + data_name, + include_overall = TRUE, + include, + exclude, + include_empty = FALSE, + as_list = FALSE +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data_name}}{The name of the data frame} + +\item{\code{include_overall}}{Boolean; if TRUE, includes overall links} + +\item{\code{include}}{Optional vector of link names to include} + +\item{\code{exclude}}{Optional vector of link names to exclude} + +\item{\code{include_empty}}{Boolean; if TRUE, includes links with no associated data} + +\item{\code{as_list}}{Boolean; if TRUE, returns a list format +Check if a link exists from a data frame} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-link_exists_from}{}}} +\subsection{Method \code{link_exists_from()}}{ +Verifies if a link exists from a specific data frame with given link pairs. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$link_exists_from(curr_data_frame, link_pairs)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{curr_data_frame}}{The name of the originating data frame} + +\item{\code{link_pairs}}{The link pairs to check for existence +Check if a link exists between two data frames} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-link_exists_between}{}}} +\subsection{Method \code{link_exists_between()}}{ +This function checks if there is an ordered or unordered link between two specified data frames. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$link_exists_between(from_data_frame, to_data_frame, ordered = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{from_data_frame}}{The name of the originating data frame} + +\item{\code{to_data_frame}}{The name of the target data frame} + +\item{\code{ordered}}{Boolean; if TRUE, checks for an ordered link +Get the link definition between two data frames} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_link_between}{}}} +\subsection{Method \code{get_link_between()}}{ +Retrieves the link definition between two specified data frames. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_link_between(from_data_frame, to_data_frame, ordered = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{from_data_frame}}{The name of the originating data frame} + +\item{\code{to_data_frame}}{The name of the target data frame} + +\item{\code{ordered}}{Boolean; if TRUE, retrieves an ordered link +Check if a Link Exists from One Data Frame to Another with Specified Columns} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-link_exists_from_by_to}{}}} +\subsection{Method \code{link_exists_from_by_to()}}{ +This function checks if a link exists from \code{first_data_frame} to \code{second_data_frame} +using the specified \code{link_pairs} columns. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$link_exists_from_by_to( + first_data_frame, + link_pairs, + second_data_frame +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{first_data_frame}}{Name of the starting data frame.} + +\item{\code{link_pairs}}{Named vector of columns used in the link.} + +\item{\code{second_data_frame}}{Name of the target data frame.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +Boolean indicating whether the specified link exists. +Retrieve Names of Linked Data Frames +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_linked_to_data_name}{}}} +\subsection{Method \code{get_linked_to_data_name()}}{ +This function returns the names of data frames linked to \code{from_data_frame}. +Optionally, includes \code{from_data_frame} itself in the output if \code{include_self} is TRUE. +Filters results by \code{link_cols}, if provided. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_linked_to_data_name( + from_data_frame, + link_cols = c(), + include_self = FALSE +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{from_data_frame}}{Name of the source data frame.} + +\item{\code{link_cols}}{Optional column names to filter links.} + +\item{\code{include_self}}{Boolean indicating if \code{from_data_frame} should be included.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A character vector of data frame names. +Get the Linked Data Frame and Matching Columns for a Link +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_linked_to_definition}{}}} +\subsection{Method \code{get_linked_to_definition()}}{ +This function returns a list of the target data frame and matched columns. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_linked_to_definition(from_data_frame, link_pairs)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{from_data_frame}}{Name of the source data frame.} + +\item{\code{link_pairs}}{Named vector of link columns.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +List with the target data frame name and matching column names. +Recursively Search for Linked Data Frame Definitions +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_possible_linked_to_definition}{}}} +\subsection{Method \code{get_possible_linked_to_definition()}}{ +This function attempts to find a linked data frame that matches \code{link_pairs}. +Recursively explores links between multiple data frames. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_possible_linked_to_definition(from_data_frame, link_pairs)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{from_data_frame}}{Name of the starting data frame.} + +\item{\code{link_pairs}}{Named vector of columns used in the link.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +List with the name and columns of a matching linked data frame, or an empty list. +Retrieve Equivalent Columns in Linked Data Frames +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-get_equivalent_columns}{}}} +\subsection{Method \code{get_equivalent_columns()}}{ +This function returns columns in \code{to_data_name} equivalent to \code{columns} in \code{from_data_name}. +Recursively searches links between multiple data frames. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$get_equivalent_columns(from_data_name, columns, to_data_name)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{from_data_name}}{Name of the source data frame.} + +\item{\code{columns}}{Columns to be matched.} + +\item{\code{to_data_name}}{Name of the target data frame.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +Character vector of equivalent column names in \code{to_data_name}, or an empty vector. +Retrieve Columns in a Link Containing Specified Columns +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-link_between_containing}{}}} +\subsection{Method \code{link_between_containing()}}{ +This function returns columns in \code{to_data_frame} corresponding to \code{containing_columns} in \code{from_data_frame} +if a link exists between them. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$link_between_containing( + from_data_frame, + containing_columns, + to_data_frame +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{from_data_frame}}{Name of the source data frame.} + +\item{\code{containing_columns}}{Columns to search for in the link.} + +\item{\code{to_data_frame}}{Name of the target data frame.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +Character vector of columns in \code{to_data_frame} if a matching link is found, otherwise an empty vector. +View a specific link by name +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-DataBook-view_link}{}}} +\subsection{Method \code{view_link()}}{ +Displays the details of a specified link. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{DataBook$view_link(link_name)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{link_name}}{The name of the link to view} } \if{html}{\out{
}} } diff --git a/man/link.Rd b/man/link.Rd new file mode 100644 index 0000000..69b4a51 --- /dev/null +++ b/man/link.Rd @@ -0,0 +1,130 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/link.R +\name{link} +\alias{link} +\title{Clone \code{link} Object} +\description{ +The \code{link} R6 class represents a relationship between two data frames, defined by link attributes and the columns used to link them. +} +\details{ +Link Class +} +\section{Methods}{ + +\describe{ +\item{\code{data_clone(...)}}{Creates a deep clone of the current \code{link} object, including all its fields.} +\item{\code{rename_data_frame_in_link(old_data_name, new_data_name)}}{Renames one of the data frames involved in the link.} +\item{\code{rename_column_in_link(data_name, old_column_name, new_column_name)}}{Renames a column involved in the link between data frames.} +} +} + +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-link-new}{\code{link$new()}} +\item \href{#method-link-data_clone}{\code{link$data_clone()}} +\item \href{#method-link-rename_data_frame_in_link}{\code{link$rename_data_frame_in_link()}} +\item \href{#method-link-rename_column_in_link}{\code{link$rename_column_in_link()}} +\item \href{#method-link-clone}{\code{link$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-link-new}{}}} +\subsection{Method \code{new()}}{ +Create a new \code{link} object. +Defines a relationship between two data frames and specifies linking columns. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{link$new( + from_data_frame = "", + to_data_frame = "", + type = "", + link_columns = list() +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{from_data_frame}}{A character string representing the name of the first data frame in the link.} + +\item{\code{to_data_frame}}{A character string representing the name of the second data frame in the link.} + +\item{\code{type}}{A character string representing the type of link, e.g., "keyed".} + +\item{\code{link_columns}}{A list where each element defines a way to link the data frames, with each element as a named character vector. The names are columns in \code{from_data_frame} and the values are corresponding columns in \code{to_data_frame}.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-link-data_clone}{}}} +\subsection{Method \code{data_clone()}}{ +Creates a deep clone of the current \code{link} object, including all its fields. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{link$data_clone(...)}\if{html}{\out{
}} +} + +\subsection{Returns}{ +A new \code{link} object with the same field values as the original. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-link-rename_data_frame_in_link}{}}} +\subsection{Method \code{rename_data_frame_in_link()}}{ +Renames the specified data frame in the link. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{link$rename_data_frame_in_link(old_data_name, new_data_name)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{old_data_name}}{The current name of the data frame to be renamed.} + +\item{\code{new_data_name}}{The new name for the data frame.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-link-rename_column_in_link}{}}} +\subsection{Method \code{rename_column_in_link()}}{ +Renames a column involved in the link between data frames. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{link$rename_column_in_link(data_name, old_column_name, new_column_name)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data_name}}{The name of the data frame where the column is located.} + +\item{\code{old_column_name}}{The current name of the column to be renamed.} + +\item{\code{new_column_name}}{The new name for the column.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-link-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{link$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +}