diff --git a/R/tt_export.R b/R/tt_export.R index 10fde5cd6..849a1c577 100644 --- a/R/tt_export.R +++ b/R/tt_export.R @@ -1,13 +1,11 @@ #' @importFrom tools file_ext NULL -### XXX is the stuff in this file correct or should we be exporting *formatted* values to -### meet the needs of consumers of this? Do we ened to support both? #' Create Enriched flat value table with paths #' -#' +#' @description #' This function creates a flat tabular file of cell values and -#' corresponding paths via \code{\link{path_enriched_df}}. I then +#' corresponding paths via [path_enriched_df()]. I then #' writes that data.frame out as a `tsv` file. #' #' By default (i.e. when \code{value_func} is not specified, @@ -20,25 +18,23 @@ NULL #' #' @inheritParams gen_args #' @param file character(1). The path of the file to written to or read from. -#' @inheritParams path_enriched_df +#' @inheritParams data.frame_export +#' #' @return \code{NULL} silently for \code{export_as_tsv}, a data.frame with #' re-constituted list values for \code{export_as_tsv}. -#' @export +#' +#' @seealso [path_enriched_df()] for the underlying function that does the work. +#' #' @rdname tsv_io #' @importFrom utils write.table read.table - +#' @export export_as_tsv <- function(tt, file = NULL, path_fun = collapse_path, value_fun = collapse_values) { df <- path_enriched_df(tt, path_fun = path_fun, value_fun = value_fun) write.table(df, file, sep = "\t") } - - -.collapse_char <- "|" -.collapse_char_esc <- "\\|" - -##' @export -##' @rdname tsv_io +#' @rdname tsv_io +#' @export import_from_tsv <- function(file) { rawdf <- read.table(file, header = TRUE, sep = "\t") as.data.frame(lapply( @@ -53,52 +49,129 @@ import_from_tsv <- function(file) { )) } -collapse_path <- function(paths) { - if (is.list(paths)) { - return(vapply(paths, collapse_path, "")) - } - paste(paths, collapse = .collapse_char) -} +### Migrated to formatters. -collapse_values <- function(colvals) { - if (!is.list(colvals)) { ## || all(vapply(colvals, length, 1L) == 1)) - return(colvals) - } else if (all(vapply(colvals, length, 1L) == 1)) { - return(unlist(colvals)) - } - vapply(colvals, paste, "", collapse = .collapse_char) -} +#' @importFrom formatters export_as_txt +#' +#' @examples +#' lyt <- basic_table() %>% +#' split_cols_by("ARM") %>% +#' analyze(c("AGE", "BMRKR2", "COUNTRY")) +#' +#' tbl <- build_table(lyt, ex_adsl) +#' +#' cat(export_as_txt(tbl, file = NULL, paginate = TRUE, lpp = 8)) +#' +#' \dontrun{ +#' tf <- tempfile(fileext = ".txt") +#' export_as_txt(tbl, file = tf) +#' system2("cat", tf) +#' } +#' +#' @export +formatters::export_as_txt + +# data.frame output ------------------------------------------------------------ -#' Transform `TableTree` object to Path-Enriched data.frame +#' Generate a Result Data Frame +#' +#' @description +#' Collection of utilities to exctract `data.frame` from `TableTree` objects. #' #' @inheritParams gen_args -#' @param path_fun function. Function to transform paths into single-string -#' row/column names. -#' @param value_fun function. Function to transform cell values into cells of -#' the data.frame. Defaults to \code{collapse_values} which creates strings -#' where multi-valued cells are collapsed together, separated by \code{|}. -#' @export -#' @return A data frame of \code{tt}'s cell values (processed by -#' \code{value_fun}, with columns named by the full column paths (processed by -#' \code{path_fun} and an additional \code{row_path} column with the row paths -#' (processed by by \code{path_fun}). -#' @examples +#' @param spec character(1). The specification to use to +#' extract the result data frame. See details +#' @param ... Passed to spec-specific result data frame conversion function. +#' +#' @details `as_result_df()`: Result data frame specifications may differ in the exact information +#' they include and the form in which they represent it. Specifications whose names end in "_experimental" +#' are subject to change without notice, but specifications without the "_experimental" +#' suffix will remain available \emph{including any bugs in their construction} indefinitely. #' +#' @examples #' lyt <- basic_table() %>% #' split_cols_by("ARM") %>% +#' split_rows_by("STRATA1") %>% #' analyze(c("AGE", "BMRKR2")) #' #' tbl <- build_table(lyt, ex_adsl) -#' path_enriched_df(tbl) -path_enriched_df <- function(tt, path_fun = collapse_path, value_fun = collapse_values) { +#' as_result_df(tbl) +#' +#' @name data.frame_export +#' @export +as_result_df <- function(tt, spec = "v0_experimental", ...) { + result_df_fun <- lookup_result_df_specfun(spec) + result_df_fun(tt, ...) +} + +# Not used in rtables +# .split_colwidths <- function(ptabs, nctot, colwidths) { +# ret <- list() +# i <- 1L +# +# rlw <- colwidths[1] +# colwidths <- colwidths[-1] +# donenc <- 0 +# while (donenc < nctot) { +# curnc <- NCOL(ptabs[[i]]) +# ret[[i]] <- c(rlw, colwidths[seq_len(curnc)]) +# colwidths <- colwidths[-1 * seq_len(curnc)] +# donenc <- donenc + curnc +# i <- i + 1 +# } +# ret +# } + +#' @describeIn data.frame_export list of functions that extract result data frames from \code{TableTree}s. +#' +#' @return `result_df_specs()`: returns a named list of result data frame extraction functions by "specification". +#' +#' @examples +#' result_df_specs() +#' +#' @export +result_df_specs <- function() { + list(v0_experimental = result_df_v0_experimental) +} + +lookup_result_df_specfun <- function(spec) { + if (!(spec %in% names(result_df_specs()))) { + stop( + "unrecognized result data frame specification: ", + spec, + "If that specification is correct you may need to update your version of rtables" + ) + } + result_df_specs()[[spec]] +} + +result_df_v0_experimental <- function(tt) { + raw_cvals <- cell_values(tt) + ## if the table has one row and multiple columns, sometimes the cell values returns a list of the cell values + ## rather than a list of length 1 reprsenting the single row. This is bad but may not be changable + ## at this point. + if (nrow(tt) == 1 && length(raw_cvals) > 1) { + raw_cvals <- list(raw_cvals) + } + cellvals <- as.data.frame(do.call(rbind, raw_cvals)) + row.names(cellvals) <- NULL rdf <- make_row_df(tt) - cdf <- make_col_df(tt) - cvs <- as.data.frame(do.call(rbind, cell_values(tt))) - cvs <- as.data.frame(lapply(cvs, value_fun)) - row.names(cvs) <- NULL - colnames(cvs) <- path_fun(cdf$path) - preppaths <- path_fun(rdf[rdf$node_class != "LabelRow", ]$path) - cbind.data.frame(row_path = preppaths, cvs) + df <- cbind( + rdf[ + rdf$node_class != "LabelRow", + c("name", "label", "abs_rownumber", "path", "reprint_inds", "node_class") + ], + cellvals + ) + maxlen <- max(lengths(df$path)) + metadf <- do.call(rbind.data.frame, lapply( + seq_len(NROW(df)), + function(ii) handle_rdf_row(df[ii, ], maxlen = maxlen) + )) + cbind( + metadf[metadf$node_class != "LabelRow", ], + cellvals + ) } do_label_row <- function(rdfrow, maxlen) { @@ -109,7 +182,6 @@ do_label_row <- function(rdfrow, maxlen) { ) } - make_result_df_md_colnames <- function(maxlen) { spllen <- floor((maxlen - 2) / 2) ret <- character() @@ -119,14 +191,13 @@ make_result_df_md_colnames <- function(maxlen) { ret <- c(ret, c("avar_name", "row_name", "row_num", "is_group_summary", "node_class")) } - do_content_row <- function(rdfrow, maxlen) { pth <- rdfrow$path[[1]] - + contpos <- which(pth == "@content") - + seq_before <- seq_len(contpos - 1) - + c( as.list(pth[seq_before]), replicate(maxlen - contpos, list(NA_character_)), list(tail(pth, 1)), @@ -150,7 +221,6 @@ do_data_row <- function(rdfrow, maxlen) { ) } - handle_rdf_row <- function(rdfrow, maxlen) { nclass <- rdfrow$node_class if (rdfrow$path[[1]][1] == "root") { @@ -158,134 +228,68 @@ handle_rdf_row <- function(rdfrow, maxlen) { maxlen <- maxlen - 1 } ret <- switch(nclass, - LabelRow = do_label_row(rdfrow, maxlen), - ContentRow = do_content_row(rdfrow, maxlen), - DataRow = do_data_row(rdfrow, maxlen), - stop("Unrecognized node type in row dataframe, unable to generate result data frame") + LabelRow = do_label_row(rdfrow, maxlen), + ContentRow = do_content_row(rdfrow, maxlen), + DataRow = do_data_row(rdfrow, maxlen), + stop("Unrecognized node type in row dataframe, unable to generate result data frame") ) setNames(ret, make_result_df_md_colnames(maxlen)) } - -#' Result Data Frame Specifications +#' @describeIn data.frame_export transform `TableTree` object to Path-Enriched `data.frame`. #' -#' @return a named list of result data frame extraction functions by "specification" -#' @export -#' @examples -#' result_df_specs() -result_df_specs <- function() { - list(v0_experimental = result_df_v0_experimental) -} - -lookup_result_df_specfun <- function(spec) { - if (!(spec %in% names(result_df_specs()))) { - stop( - "unrecognized result data frame specification: ", - spec, - "If that specification is correct you may need to update your version of rtables" - ) - } - result_df_specs()[[spec]] -} - -result_df_v0_experimental <- function(tt) { - raw_cvals <- cell_values(tt) - ## if the table has one row and multiple columns, sometimes the cell values returns a list of the cell values - ## rather than a list of length 1 reprsenting the single row. This is bad but may not be changable - ## at this point. - if (nrow(tt) == 1 && length(raw_cvals) > 1) { - raw_cvals <- list(raw_cvals) - } - cellvals <- as.data.frame(do.call(rbind, raw_cvals)) - row.names(cellvals) <- NULL - rdf <- make_row_df(tt) - df <- cbind( - rdf[ - rdf$node_class != "LabelRow", - c("name", "label", "abs_rownumber", "path", "reprint_inds", "node_class") - ], - cellvals - ) - maxlen <- max(lengths(df$path)) - metadf <- do.call(rbind.data.frame, lapply( - seq_len(NROW(df)), - function(ii) handle_rdf_row(df[ii, ], maxlen = maxlen) - )) - cbind( - metadf[metadf$node_class != "LabelRow", ], - cellvals - ) -} - -#' Generate a Result Data Frame -#' -#' @param tt `VTableTree`. The table. -#' @param spec character(1). The specification to use to -#' extract the result data frame. See details -#' @param ... Passed to spec-specific result data frame conversion function. +#' @param path_fun function. Function to transform paths into single-string +#' row/column names. +#' @param value_fun function. Function to transform cell values into cells of +#' the data.frame. Defaults to \code{collapse_values} which creates strings +#' where multi-valued cells are collapsed together, separated by \code{|}. #' -#' @details Result data frame specifications may differ in the exact information they include and -#' the form in which they represent it. Specifications whose names end in "_experimental" -#' are subject to change without notice, but specifications without the "_experimental" -#' suffix will remain available \emph{including any bugs in their construction} indefinitely. +#' @return `path_enriched_df()`: returns a data frame of \code{tt}'s cell values (processed by +#' \code{value_fun}, with columns named by the full column paths (processed by +#' \code{path_fun} and an additional \code{row_path} column with the row paths +#' (processed by by \code{path_fun}). #' -#' @note This function may eventually be migrated to a separate package, and so should -#' not be called via `::` -#' @export #' @examples -#' #' lyt <- basic_table() %>% #' split_cols_by("ARM") %>% -#' split_rows_by("STRATA1") %>% #' analyze(c("AGE", "BMRKR2")) #' #' tbl <- build_table(lyt, ex_adsl) -#' as_result_df(tbl) -as_result_df <- function(tt, spec = "v0_experimental", ...) { - result_df_fun <- lookup_result_df_specfun(spec) - result_df_fun(tt, ...) +#' path_enriched_df(tbl) +#' +#' @export +path_enriched_df <- function(tt, path_fun = collapse_path, value_fun = collapse_values) { + rdf <- make_row_df(tt) + cdf <- make_col_df(tt) + cvs <- as.data.frame(do.call(rbind, cell_values(tt))) + cvs <- as.data.frame(lapply(cvs, value_fun)) + row.names(cvs) <- NULL + colnames(cvs) <- path_fun(cdf$path) + preppaths <- path_fun(rdf[rdf$node_class != "LabelRow", ]$path) + cbind.data.frame(row_path = preppaths, cvs) } -.split_colwidths <- function(ptabs, nctot, colwidths) { - ret <- list() - i <- 1L - - rlw <- colwidths[1] - colwidths <- colwidths[-1] - donenc <- 0 - while (donenc < nctot) { - curnc <- NCOL(ptabs[[i]]) - ret[[i]] <- c(rlw, colwidths[seq_len(curnc)]) - colwidths <- colwidths[-1 * seq_len(curnc)] - donenc <- donenc + curnc - i <- i + 1 +.collapse_char <- "|" +.collapse_char_esc <- "\\|" + +collapse_path <- function(paths) { + if (is.list(paths)) { + return(vapply(paths, collapse_path, "")) } - ret + paste(paths, collapse = .collapse_char) } -### Migrated to formatters. - -#' @importFrom formatters export_as_txt -#' -#' @examples -#' lyt <- basic_table() %>% -#' split_cols_by("ARM") %>% -#' analyze(c("AGE", "BMRKR2", "COUNTRY")) -#' -#' tbl <- build_table(lyt, ex_adsl) -#' -#' cat(export_as_txt(tbl, file = NULL, paginate = TRUE, lpp = 8)) -#' -#' \dontrun{ -#' tf <- tempfile(fileext = ".txt") -#' export_as_txt(tbl, file = tf) -#' system2("cat", tf) -#' } -#' -#' @export -formatters::export_as_txt +collapse_values <- function(colvals) { + if (!is.list(colvals)) { ## || all(vapply(colvals, length, 1L) == 1)) + return(colvals) + } else if (all(vapply(colvals, length, 1L) == 1)) { + return(unlist(colvals)) + } + vapply(colvals, paste, "", collapse = .collapse_char) +} +# pdf output ------------------------------------------------------------------- #' Export as PDF #' #' The PDF output is based on the ASCII output created with `toString` @@ -462,6 +466,22 @@ export_as_pdf <- function(tt, lpp = lpp, cpp = cpp ) } + +# only used in pagination +.tab_to_colpath_set <- function(tt) { + vapply( + collect_leaves(coltree(tt)), + function(y) paste(pos_to_path(tree_pos(y)), collapse = " "), + "" + ) +} +.figure_out_colinds <- function(subtab, fulltab) { + match( + .tab_to_colpath_set(subtab), + .tab_to_colpath_set(fulltab) + ) +} + # Flextable and docx ----------------------------------------------------------- #' Export as word document #' @@ -1074,29 +1094,3 @@ apply_alignments <- function(flx, aligns_df, part) { flx } - -# only used in pagination -.tab_to_colpath_set <- function(tt) { - vapply( - collect_leaves(coltree(tt)), - function(y) paste(pos_to_path(tree_pos(y)), collapse = " "), - "" - ) -} -.figure_out_colinds <- function(subtab, fulltab) { - match( - .tab_to_colpath_set(subtab), - .tab_to_colpath_set(fulltab) - ) -} - -check_required_packages <- function(pkgs) { - for (pkgi in pkgs) { - if (!requireNamespace(pkgi)) { - stop( - "This function requires the ", pkgi, " package. ", - "Please install it if you wish to use it" - ) - } - } -} diff --git a/R/tt_from_df.R b/R/tt_from_df.R index 3e2a0dfa3..111255c7a 100644 --- a/R/tt_from_df.R +++ b/R/tt_from_df.R @@ -1,9 +1,13 @@ #' 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)} +#' #' @examples #' df_to_tt(mtcars) +#' #' @export df_to_tt <- function(df) { colnms <- colnames(df) @@ -14,5 +18,6 @@ df_to_tt <- function(df) { 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/R/utils.R b/R/utils.R index 0633cbecf..3b9cfc245 100644 --- a/R/utils.R +++ b/R/utils.R @@ -11,8 +11,6 @@ is_rtable <- function(x) { is(x, "VTableTree") } - - # nocov start ## is each object in a collection from a class are <- function(object_collection, class2) { @@ -51,7 +49,6 @@ is_logical_vector_modif <- function(x, min_length = 1) { } # nocov end - # Shorthand for functions that take df as first parameter .takes_df <- function(f) { func_takes(f, "df", is_first = TRUE) @@ -79,11 +76,11 @@ func_takes <- function(func, params, is_first = FALSE) { #' Translate spl_context to Path for display in error messages #' -#' #' @param ctx data.frame. The `spl_context` data.frame where the error occurred #' #' @return A character string containing a description of the row path corresponding #' to the `ctx` +#' #' @export spl_context_to_disp_path <- function(ctx) { ## this can happen in the first split in column space, but @@ -107,3 +104,16 @@ spl_context_to_disp_path <- function(ctx) { paste_vec <- function(vec) { paste0('c("', paste(vec, collapse = '", "'), '")') } + +# Utility for checking if a package is installed +check_required_packages <- function(pkgs) { + for (pkgi in pkgs) { + if (!requireNamespace(pkgi)) { + stop( + "This function requires the ", pkgi, " package. ", + "Please install it if you wish to use it" + ) + } + } +} + diff --git a/man/as_result_df.Rd b/man/as_result_df.Rd deleted file mode 100644 index 54768f5ec..000000000 --- a/man/as_result_df.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tt_export.R -\name{as_result_df} -\alias{as_result_df} -\title{Generate a Result Data Frame} -\usage{ -as_result_df(tt, spec = "v0_experimental", ...) -} -\arguments{ -\item{tt}{\code{VTableTree}. The table.} - -\item{spec}{character(1). The specification to use to -extract the result data frame. See details} - -\item{...}{Passed to spec-specific result data frame conversion function.} -} -\description{ -Generate a Result Data Frame -} -\details{ -Result data frame specifications may differ in the exact information they include and -the form in which they represent it. Specifications whose names end in "_experimental" -are subject to change without notice, but specifications without the "_experimental" -suffix will remain available \emph{including any bugs in their construction} indefinitely. -} -\note{ -This function may eventually be migrated to a separate package, and so should -not be called via \code{::} -} -\examples{ - -lyt <- basic_table() \%>\% - split_cols_by("ARM") \%>\% - split_rows_by("STRATA1") \%>\% - analyze(c("AGE", "BMRKR2")) - -tbl <- build_table(lyt, ex_adsl) -as_result_df(tbl) -} diff --git a/man/data.frame_export.Rd b/man/data.frame_export.Rd new file mode 100644 index 000000000..38a19d7a3 --- /dev/null +++ b/man/data.frame_export.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tt_export.R +\name{data.frame_export} +\alias{data.frame_export} +\alias{as_result_df} +\alias{result_df_specs} +\alias{path_enriched_df} +\title{Generate a Result Data Frame} +\usage{ +as_result_df(tt, spec = "v0_experimental", ...) + +result_df_specs() + +path_enriched_df(tt, path_fun = collapse_path, value_fun = collapse_values) +} +\arguments{ +\item{tt}{\code{TableTree} (or related class). A \code{TableTree} object representing a +populated table.} + +\item{spec}{character(1). The specification to use to +extract the result data frame. See details} + +\item{...}{Passed to spec-specific result data frame conversion function.} + +\item{path_fun}{function. Function to transform paths into single-string +row/column names.} + +\item{value_fun}{function. Function to transform cell values into cells of +the data.frame. Defaults to \code{collapse_values} which creates strings +where multi-valued cells are collapsed together, separated by \code{|}.} +} +\value{ +\code{result_df_specs()}: returns a named list of result data frame extraction functions by "specification". + +\code{path_enriched_df()}: returns a data frame of \code{tt}'s cell values (processed by +\code{value_fun}, with columns named by the full column paths (processed by +\code{path_fun} and an additional \code{row_path} column with the row paths +(processed by by \code{path_fun}). +} +\description{ +Collection of utilities to exctract \code{data.frame} from \code{TableTree} objects. +} +\details{ +\code{as_result_df()}: Result data frame specifications may differ in the exact information +they include and the form in which they represent it. Specifications whose names end in "_experimental" +are subject to change without notice, but specifications without the "_experimental" +suffix will remain available \emph{including any bugs in their construction} indefinitely. +} +\section{Functions}{ +\itemize{ +\item \code{result_df_specs()}: list of functions that extract result data frames from \code{TableTree}s. + +\item \code{path_enriched_df()}: transform \code{TableTree} object to Path-Enriched \code{data.frame}. + +}} +\examples{ +lyt <- basic_table() \%>\% + split_cols_by("ARM") \%>\% + split_rows_by("STRATA1") \%>\% + analyze(c("AGE", "BMRKR2")) + +tbl <- build_table(lyt, ex_adsl) +as_result_df(tbl) + +result_df_specs() + +lyt <- basic_table() \%>\% + split_cols_by("ARM") \%>\% + analyze(c("AGE", "BMRKR2")) + +tbl <- build_table(lyt, ex_adsl) +path_enriched_df(tbl) + +} diff --git a/man/df_to_tt.Rd b/man/df_to_tt.Rd index 51feb47fe..6911d128c 100644 --- a/man/df_to_tt.Rd +++ b/man/df_to_tt.Rd @@ -18,4 +18,5 @@ Create \code{ElementaryTable} from data.frame } \examples{ df_to_tt(mtcars) + } diff --git a/man/path_enriched_df.Rd b/man/path_enriched_df.Rd deleted file mode 100644 index d83da44cc..000000000 --- a/man/path_enriched_df.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tt_export.R -\name{path_enriched_df} -\alias{path_enriched_df} -\title{Transform \code{TableTree} object to Path-Enriched data.frame} -\usage{ -path_enriched_df(tt, path_fun = collapse_path, value_fun = collapse_values) -} -\arguments{ -\item{tt}{\code{TableTree} (or related class). A \code{TableTree} object representing a -populated table.} - -\item{path_fun}{function. Function to transform paths into single-string -row/column names.} - -\item{value_fun}{function. Function to transform cell values into cells of -the data.frame. Defaults to \code{collapse_values} which creates strings -where multi-valued cells are collapsed together, separated by \code{|}.} -} -\value{ -A data frame of \code{tt}'s cell values (processed by -\code{value_fun}, with columns named by the full column paths (processed by -\code{path_fun} and an additional \code{row_path} column with the row paths -(processed by by \code{path_fun}). -} -\description{ -Transform \code{TableTree} object to Path-Enriched data.frame -} -\examples{ - -lyt <- basic_table() \%>\% - split_cols_by("ARM") \%>\% - analyze(c("AGE", "BMRKR2")) - -tbl <- build_table(lyt, ex_adsl) -path_enriched_df(tbl) -} diff --git a/man/result_df_specs.Rd b/man/result_df_specs.Rd deleted file mode 100644 index 0715abdd3..000000000 --- a/man/result_df_specs.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tt_export.R -\name{result_df_specs} -\alias{result_df_specs} -\title{Result Data Frame Specifications} -\usage{ -result_df_specs() -} -\value{ -a named list of result data frame extraction functions by "specification" -} -\description{ -Result Data Frame Specifications -} -\examples{ -result_df_specs() -} diff --git a/man/tsv_io.Rd b/man/tsv_io.Rd index 50e58ec04..8149d469c 100644 --- a/man/tsv_io.Rd +++ b/man/tsv_io.Rd @@ -33,10 +33,9 @@ re-constituted list values for \code{export_as_tsv}. } \description{ This function creates a flat tabular file of cell values and -corresponding paths via \code{\link{path_enriched_df}}. I then +corresponding paths via \code{\link[=path_enriched_df]{path_enriched_df()}}. I then writes that data.frame out as a \code{tsv} file. -} -\details{ + By default (i.e. when \code{value_func} is not specified, List columns where at least one value has length > 1 are collapsed to character vectors by collapsing the list element with \code{"|"}. @@ -46,3 +45,6 @@ There is currently no round-trip capability for this type of export. You can read values exported this way back in via \code{import_from_tsv} but you will receive only the data.frame version back, NOT a \code{TableTree}. } +\seealso{ +\code{\link[=path_enriched_df]{path_enriched_df()}} for the underlying function that does the work. +}