diff --git a/NAMESPACE b/NAMESPACE index c146c31..28098b4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -45,6 +45,8 @@ S3method("records<-",database) S3method("records<-",relation) S3method("references<-",database) S3method("references<-",database_schema) +S3method(as.character,functional_dependency) +S3method(as.data.frame,functional_dependency) S3method(attrs,relation) S3method(attrs,relation_schema) S3method(attrs_order,functional_dependency) @@ -60,6 +62,7 @@ S3method(create,relation_schema) S3method(dependant,functional_dependency) S3method(detset,functional_dependency) S3method(duplicated,relation) +S3method(format,functional_dependency) S3method(gv,data.frame) S3method(gv,database) S3method(gv,database_schema) diff --git a/R/functional_dependency.r b/R/functional_dependency.r index 6c44171..e086a86 100644 --- a/R/functional_dependency.r +++ b/R/functional_dependency.r @@ -64,6 +64,9 @@ #' attrs_order(fds) #' ) #' stopifnot(identical(fds_recon, fds)) +#' +#' # can be a data frame column +#' data.frame(id = 1:2, fds = fds) #' @export functional_dependency <- function( FDs, @@ -210,21 +213,46 @@ c.functional_dependency <- function(..., unique = TRUE) { } #' @exportS3Method -print.functional_dependency <- function(x, ...) { +as.character.functional_dependency <- function( + x, + align_arrows = c("no", "left", "right"), + ... +) { + align_arrows <- match.arg(align_arrows) det_txt <- vapply(detset(x), toString, character(1)) - if (length(x) == 0L) - padding <- character() - else{ - det_nchar <- nchar(det_txt) - det_len <- max(det_nchar) - padding <- vapply( - det_len - det_nchar, - \(n) paste(rep(" ", n), collapse = ""), - character(1) - ) - } dep_txt <- dependant(x) - txt <- paste0(padding, det_txt, " -> ", dep_txt, recycle0 = TRUE) + switch( + align_arrows, + no = lpadding <- rpadding <- rep("", length(x)), + left = if (length(x) == 0) { + lpadding <- rpadding <- rep("", length(x)) + }else{ + det_nchar <- nchar(det_txt) + lpadding <- vapply( + max(det_nchar) - det_nchar, + \(n) paste(rep(" ", n), collapse = ""), + character(1) + ) + rpadding <- rep("", length(x)) + }, + right = if (length(x) == 0) { + lpadding <- rpadding <- rep("", length(x)) + }else{ + dep_nchar <- nchar(dep_txt) + rpadding <- vapply( + max(dep_nchar) - dep_nchar, + \(n) paste(rep(" ", n), collapse = ""), + character(1) + ) + lpadding <- rep("", length(x)) + } + ) + paste0(lpadding, det_txt, " -> ", dep_txt, rpadding, recycle0 = TRUE) +} + +#' @exportS3Method +print.functional_dependency <- function(x, ...) { + txt <- as.character(x, align_arrows = "left") cat(with_number(length(x), "functional dependenc", "y", "ies")) cat(paste0("\n", with_number(length(attrs_order(x)), "attribute", "", "s"))) if (length(attrs_order(x)) > 0) @@ -234,3 +262,24 @@ print.functional_dependency <- function(x, ...) { cat(txt, sep = "\n") } } + +#' @exportS3Method +format.functional_dependency <- function(x, ...) { + as.character(x, align_arrows = "right") +} + +#' @exportS3Method +as.data.frame.functional_dependency <- function( + x, + row.names = NULL, + optional = FALSE, + ..., + nm = deparse1(substitute(x))[[1L]] +) { + res <- data.frame(a = seq_along(x))[, FALSE, drop = FALSE] + res$x <- x + names(res) <- NULL + if (!optional) + names(res) <- nm + res +} diff --git a/man/functional_dependency.Rd b/man/functional_dependency.Rd index 67740b2..360935c 100644 --- a/man/functional_dependency.Rd +++ b/man/functional_dependency.Rd @@ -73,6 +73,9 @@ fds_recon <- functional_dependency( attrs_order(fds) ) stopifnot(identical(fds_recon, fds)) + +# can be a data frame column +data.frame(id = 1:2, fds = fds) } \seealso{ \code{\link{detset}}, \code{\link{dependant}}, and diff --git a/tests/testthat/test-functional_dependency.r b/tests/testthat/test-functional_dependency.r index 6e75930..e292bc9 100644 --- a/tests/testthat/test-functional_dependency.r +++ b/tests/testthat/test-functional_dependency.r @@ -317,4 +317,12 @@ describe("functional_dependency", { ) ) }) + it("can be added to a data frame as a column", { + fds <- functional_dependency( + list(list(c("a", "b"), "c"), list("a", "d")), + letters[1:4] + ) + expect_no_error(tb <- data.frame(id = 1:2, fd = fds)) + expect_identical(tb$fd, fds) + }) })