From d6201bae9aabd377bec38e73613dc5c365b5a46e Mon Sep 17 00:00:00 2001 From: Julien Blasco Date: Thu, 6 Jun 2024 14:40:26 +0200 Subject: [PATCH 1/3] Fix call of object and object name - replace df with df_name in loops in order to clarify that it is a string - remove get(df_name) and use original object instead --- R/toxlsx.R | 68 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 35 insertions(+), 33 deletions(-) diff --git a/R/toxlsx.R b/R/toxlsx.R index 66df37a..fbb7829 100644 --- a/R/toxlsx.R +++ b/R/toxlsx.R @@ -124,24 +124,24 @@ toxlsx <- function(object, Sheetslist <- output # Loop through each element in output_name - for (df in output_name) { - output[[df]][["sheet"]] <- + for (df_name in output_name) { + output[[df_name]][["sheet"]] <- if (length(tosheet) == 0) { # If tosheet is not provided, use "Sheet #" as the sheet name - paste0("Sheet ", as.character(which(output_name == df))) + paste0("Sheet ", as.character(which(output_name == df_name))) } else { # Else use df as the sheet name - tosheet[[df]] + tosheet[[df_name]] } - Sheetslist[which(output_name == df)] <- output[[df]][["sheet"]] - output[[df]][["title"]] <- if (length(title) == 0) df else title[[df]] - output[[df]][["column"]] <- if (paste(names(columnstyle), collapse = "") %in% "default") list() else columnstyle[[df]] - output[[df]][["footnote1"]] <- if (length(footnote1) == 0) "" else footnote1[[df]] - output[[df]][["footnote2"]] <- if (length(footnote2) == 0) "" else footnote2[[df]] - output[[df]][["footnote3"]] <- if (length(footnote3) == 0) "" else footnote3[[df]] - output[[df]][["mergecol"]] <- if (length(mergecol) == 0) character(0) else mergecol[[df]] - output[[df]][["bygroup"]] <- if (length(bygroup) == 0) character(0) else bygroup[[df]] - output[[df]][["groupname"]] <- if (length(groupname) == 0) logical(0) else groupname[[df]] + Sheetslist[which(output_name == df_name)] <- output[[df_name]][["sheet"]] + output[[df_name]][["title"]] <- if (length(title) == 0) df_name else title[[df_name]] + output[[df_name]][["column"]] <- if (paste(names(columnstyle), collapse = "") %in% "default") list() else columnstyle[[df_name]] + output[[df_name]][["footnote1"]] <- if (length(footnote1) == 0) "" else footnote1[[df_name]] + output[[df_name]][["footnote2"]] <- if (length(footnote2) == 0) "" else footnote2[[df_name]] + output[[df_name]][["footnote3"]] <- if (length(footnote3) == 0) "" else footnote3[[df_name]] + output[[df_name]][["mergecol"]] <- if (length(mergecol) == 0) character(0) else mergecol[[df_name]] + output[[df_name]][["bygroup"]] <- if (length(bygroup) == 0) character(0) else bygroup[[df_name]] + output[[df_name]][["groupname"]] <- if (length(groupname) == 0) logical(0) else groupname[[df_name]] } # Creation empty workbook @@ -150,14 +150,16 @@ toxlsx <- function(object, ### Fill workbook # loop for each df in output_name - for (df in output_name) { + for (i in seq_along(output_name)) { + df <- if (is_list) get_object[[i]] else get_object + df_name <- output_name[i] # If argument columnstyle is not filled in the function if (paste(names(columnstyle), collapse = "") %in% "default") { # Initialize empty named list to format columns (ColumnList) ColumnList <- as.list(setNames( - rep("character", length(names(get(df)))), - paste0("c", seq_along(names(get(df)))) + rep("character", length(names(df))), + paste0("c", seq_along(names(df))) )) # Fill ColumnList @@ -169,13 +171,13 @@ toxlsx <- function(object, } else { # Initialize empty named list to format columns (ColumnList) ColumnList <- setNames( - vector("list", length = length(output[[df]][["column"]])), - names(output[[df]][["column"]]) + vector("list", length = length(output[[df_name]][["column"]])), + names(output[[df_name]][["column"]]) ) # Fill ColumnList - for (i in seq_along(output[[df]][["column"]])) { - ColumnList[[i]] <- style[[output[[df]][["column"]][[paste0("c", i)]]]] + for (i in seq_along(output[[df_name]][["column"]])) { + ColumnList[[i]] <- style[[output[[df_name]][["column"]][[paste0("c", i)]]]] } } @@ -188,7 +190,7 @@ toxlsx <- function(object, listsplitted <- setNames(listsplitted, unique(unlist(tosheet))) # We create namecurrentsheet as the name where df must be written - namecurrentsheet <- names(listsplitted[[tosheet[[df]]]]) + namecurrentsheet <- names(listsplitted[[tosheet[[df_name]]]]) # We create multipledfinsheet of the same length as listsplitted # made up of booleans that indicate whether several df are in the same sheet multipledfinsheet <- lapply(listsplitted, function(x) length(x)>1) @@ -202,10 +204,10 @@ toxlsx <- function(object, # Use add_table() function to add each df in workbook add_table( - Table = get(df), + Table = df, WbTitle = wb, - SheetTitle = output[[df]][["sheet"]], - TableTitle = output[[df]][["title"]], + SheetTitle = output[[df_name]][["sheet"]], + TableTitle = output[[df_name]][["title"]], StartRow = # If the "tosheet" argument is not filled in # or if only one sheet is filled in "tosheet", @@ -214,25 +216,25 @@ toxlsx <- function(object, 1 # Else if at least two sheets are filled in "tosheet" argument # and each df must be in different sheets - } else if (length(tosheet) > 1 & isFALSE(multipledfinsheet[[tosheet[[df]]]])) { + } else if (length(tosheet) > 1 & isFALSE(multipledfinsheet[[tosheet[[df_name]]]])) { 1 # Else if at least two sheets are filled in "tosheet" argument # and at least two df must be in a same sheet - } else if (length(tosheet) > 1 & isTRUE(multipledfinsheet[[tosheet[[df]]]])) { + } else if (length(tosheet) > 1 & isTRUE(multipledfinsheet[[tosheet[[df_name]]]])) { # StartRow is equal to 1 for first df # StartRow is equal to 11 + nrow(first df) for second df # StartRow is equal to 21 + nrow(first df) + nrow(second df) for third df - calcstartrow(which(namecurrentsheet == df)) + calcskippedrow(mylist = get_object, x = which(namecurrentsheet == df)) + calcstartrow(which(namecurrentsheet == df_name)) + calcskippedrow(mylist = get_object, x = which(namecurrentsheet == df_name)) }, StartCol = 1, FormatList = ColumnList, HeightTableTitle = 2, - TableFootnote1 = output[[df]][["footnote1"]], - TableFootnote2 = output[[df]][["footnote2"]], - TableFootnote3 = output[[df]][["footnote3"]], - MergeCol = output[[df]][["mergecol"]], - ByGroup = output[[df]][["bygroup"]], - GroupName = output[[df]][["groupname"]], + TableFootnote1 = output[[df_name]][["footnote1"]], + TableFootnote2 = output[[df_name]][["footnote2"]], + TableFootnote3 = output[[df_name]][["footnote3"]], + MergeCol = output[[df_name]][["mergecol"]], + ByGroup = output[[df_name]][["bygroup"]], + GroupName = output[[df_name]][["groupname"]], asTable = asTable ) From 26dbfe73af0b30e29c352c57fbf5f42c11d6d6a7 Mon Sep 17 00:00:00 2001 From: Julien Blasco Date: Thu, 6 Jun 2024 14:52:13 +0200 Subject: [PATCH 2/3] update NEWS --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 102b9f1..1aaee99 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# tablexlsx (WIP) + +* (fix) `toxlsx()` no longer fails when the `object` argument is the result of a computation #18 + # tablexlsx 1.0.0 This release includes : From 11d6156b2429214a9ee41dbc8d9772230a882155 Mon Sep 17 00:00:00 2001 From: Julien Blasco Date: Thu, 6 Jun 2024 19:01:48 +0200 Subject: [PATCH 3/3] Fix handling of list objects When object is a list, output_name is now defined according to three possible scenarios: 1. object is a named list, then those names are used 2. object is a call to the list() function, then the arguments of list() are used 3. other cases: generic names ("Table 1", "Table 2"...) are used --- R/toxlsx.R | 36 +++++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/R/toxlsx.R b/R/toxlsx.R index fbb7829..3afde29 100644 --- a/R/toxlsx.R +++ b/R/toxlsx.R @@ -69,23 +69,36 @@ toxlsx <- function(object, magrittr_pipe <- any(is_magrittr_env) is_list <- inherits(object, "list") - # Before conversion to string, we store object in get_object - get_object <- object - + # object_name is a string containing the name of the first argument if (magrittr_pipe) { - object <- get("lhs", sys.frames()[[max(which(is_magrittr_env))]]) + object_name <- get("lhs", sys.frames()[[max(which(is_magrittr_env))]]) } else { - object <- substitute(object) + object_name <- substitute(object) } - # output_name is a string vector containing the name of all data frames passed in the object argument if (is_list) { - if (magrittr_pipe) { - object <- parse(text = object) + if (!is.null(names(object))) { + # First case: object is a named list -> we use those as output names + if (any(duplicated(names(object)))) { + stop("The names of the list must be unique.") + } else { + output_name <- names(object) + get_object <- object + } + } else if (is.call(object_name) && identical(object_name[[1]], as.name("list"))) { + # Second case: object is a call to the "list" function + output_name <- unlist(lapply(substitute(object_name), deparse)[-1]) + get_object <- object + names(get_object) <- output_name + } else { + # Third case: object is neither a named list nor a call to the "list" function + output_name <- paste("Table", seq_along(object)) + get_object <- object + names(get_object) <- output_name } - output_name <- unlist(lapply(substitute(object), deparse)[-1]) } else { - output_name <- deparse(object) + output_name <- deparse(object_name) + get_object <- object } tosheet <- if_atomic_to_list(tosheet, output_name) @@ -224,7 +237,8 @@ toxlsx <- function(object, # StartRow is equal to 1 for first df # StartRow is equal to 11 + nrow(first df) for second df # StartRow is equal to 21 + nrow(first df) + nrow(second df) for third df - calcstartrow(which(namecurrentsheet == df_name)) + calcskippedrow(mylist = get_object, x = which(namecurrentsheet == df_name)) + calcstartrow(which(namecurrentsheet == df_name)) + + calcskippedrow(mylist = get_object, x = which(namecurrentsheet == df_name)) }, StartCol = 1, FormatList = ColumnList,