From 8e2740898ac0cd778ee8e71f7d4cb2699694054d Mon Sep 17 00:00:00 2001
From: Melkiades <davide.garolini@roche.com>
Date: Mon, 29 Jan 2024 16:01:43 +0100
Subject: [PATCH] fantastic as_is

---
 R/tt_export.R                           |  8 ++++++-
 R/tt_from_df.R                          | 30 ++++++++++++++++++++-----
 man/df_to_tt.Rd                         | 11 ++++++++-
 tests/testthat/test-result_data_frame.R | 25 ++++++++++++++++-----
 4 files changed, 60 insertions(+), 14 deletions(-)

diff --git a/R/tt_export.R b/R/tt_export.R
index 2265eea2a..1b8aaae1f 100644
--- a/R/tt_export.R
+++ b/R/tt_export.R
@@ -315,8 +315,14 @@ result_df_v0_experimental <- function(tt,
   
   # Using only labels for row names and losing information about paths
   if (as_is) {
-    rownames(ret) <- ret$label_name
+    tmp_rownames <- ret$label_name
     ret <- ret[, -seq_len(which(colnames(ret) == "node_class"))]
+    if (length(unique(tmp_rownames)) == length(tmp_rownames)) {
+      rownames(ret) <- tmp_rownames
+    } else {
+      ret <- cbind("label_name" = tmp_rownames, ret)
+      rownames(ret) <- NULL
+    }
   } else {
     rownames(ret) <- NULL
   }
diff --git a/R/tt_from_df.R b/R/tt_from_df.R
index 111255c7a..8cee6cc3b 100644
--- a/R/tt_from_df.R
+++ b/R/tt_from_df.R
@@ -1,23 +1,41 @@
 #' Create `ElementaryTable` from data.frame
-#' 
+#'
 #' @param df data.frame.
-#' 
+#'
 #' @return an \code{ElementaryTable} object with unnested columns corresponding to
-#' \code{names(df)} and row labels corresponding to \code{row.names(df)}
-#' 
+#' \code{names(df)} and row labels corresponding to \code{row.names(df)}.
+#'
+#' @details
+#' If row names are not defined in `df` (or they are simple numbers), then the 
+#' row names are taken from the column `label_name`, if exists. If `label_name` exists, 
+#' then it is also removed from the original data. Remember that this behavior is 
+#' compatible with [as_result_df()], when `as_is = TRUE` and the row names are not unique.
+#'
+#' @seealso [as_result_df()] for the inverse operation.
+#'
 #' @examples
 #' df_to_tt(mtcars)
-#' 
+#'
 #' @export
 df_to_tt <- function(df) {
   colnms <- colnames(df)
   cinfo <- manual_cols(colnms)
   rnames <- rownames(df)
   havern <- !is.null(rnames)
+
+  if ((!havern || all(grepl("[0-9]+", rnames))) &&
+    "label_name" %in% colnms) {
+    rnames <- df$label_name
+    df <- df[, -match("label_name", colnms)]
+    colnms <- colnames(df)
+    cinfo <- manual_cols(colnms)
+    havern <- TRUE
+  }
+
   kids <- lapply(seq_len(nrow(df)), function(i) {
     rni <- if (havern) rnames[i] else ""
     do.call(rrow, c(list(row.name = rni), unclass(df[i, ])))
   })
-  
+
   ElementaryTable(kids = kids, cinfo = cinfo)
 }
diff --git a/man/df_to_tt.Rd b/man/df_to_tt.Rd
index 6911d128c..a2f7518c7 100644
--- a/man/df_to_tt.Rd
+++ b/man/df_to_tt.Rd
@@ -11,12 +11,21 @@ df_to_tt(df)
 }
 \value{
 an \code{ElementaryTable} object with unnested columns corresponding to
-\code{names(df)} and row labels corresponding to \code{row.names(df)}
+\code{names(df)} and row labels corresponding to \code{row.names(df)}.
 }
 \description{
 Create \code{ElementaryTable} from data.frame
 }
+\details{
+If row names are not defined in \code{df} (or they are simple numbers), then the
+row names are taken from the column \code{label_name}, if exists. If \code{label_name} exists,
+then it is also removed from the original data. Remember that this behavior is
+compatible with \code{\link[=as_result_df]{as_result_df()}}, when \code{as_is = TRUE} and the row names are not unique.
+}
 \examples{
 df_to_tt(mtcars)
 
 }
+\seealso{
+\code{\link[=as_result_df]{as_result_df()}} for the inverse operation.
+}
diff --git a/tests/testthat/test-result_data_frame.R b/tests/testthat/test-result_data_frame.R
index 34188413d..0944331ab 100644
--- a/tests/testthat/test-result_data_frame.R
+++ b/tests/testthat/test-result_data_frame.R
@@ -198,12 +198,25 @@ test_that("as_result_df as_is is producing a data.frame that is compatible with
   lyt <- make_big_lyt()
   tbl <- build_table(lyt, rawdat)
   
-  # ard_out <- as_result_df(tbl, as_is = TRUE)
-  # mf_tbl <- matrix_form(tbl)
+  ard_out <- as_result_df(tbl, as_is = TRUE)
+  mf_tbl <- matrix_form(tbl)
   
   # Label works
-  # expect_identical(
-  #   ard_out$label_name,
-  #   mf_strings(mf_tbl)[-seq_len(mf_nrheader(mf_tbl)), 1]
-  # )
+  expect_identical(
+    ard_out$label_name,
+    mf_strings(mf_tbl)[-seq_len(mf_nrheader(mf_tbl)), 1]
+  )
+  
+  expect_identical(
+    ard_out$label_name,
+    df_to_tt(ard_out) %>% row.names()
+  )
+  
+  init_tbl <- df_to_tt(mtcars) 
+  end_tbl <- init_tbl %>% as_result_df(as_is = TRUE) %>% df_to_tt()
+  
+  expect_equal(
+    matrix_form(init_tbl)$strings, 
+    matrix_form(end_tbl)$strings
+  )
 })