From f31a3bf8d2f6f5629cd1b1e4992021fb10c9a42e Mon Sep 17 00:00:00 2001
From: Mark Webster <markwebster204@yahoo.co.uk>
Date: Thu, 7 Nov 2024 12:41:00 +0000
Subject: [PATCH] Add format() for FDs, so they can go in a data frame column

Note that this is only for data frames specifically; for data.table it
sort-of works, but for tibble it causes an error, because vctrs doesn't
count a funcational_dependency object as a vector.
---
 NAMESPACE                                   |  3 +
 R/functional_dependency.r                   | 75 +++++++++++++++++----
 man/functional_dependency.Rd                |  3 +
 tests/testthat/test-functional_dependency.r |  8 +++
 4 files changed, 76 insertions(+), 13 deletions(-)

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)
+  })
 })