Skip to content

Commit

Permalink
Merge branch 'main' into fix-20-mergecol-exist-not
Browse files Browse the repository at this point in the history
  • Loading branch information
@ddotta
ddotta authored Jun 7, 2024
2 parents 0838386 + 47832f3 commit 4c62f93
Show file tree
Hide file tree
Showing 2 changed files with 60 additions and 43 deletions.
1 change: 1 addition & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# tablexlsx (WIP)

* (fix) `toxlsx()` no longer fails when the `object` argument is the result of a computation #18
* provide meaningful error message if merge cols don't exist #20

# tablexlsx 1.0.0
Expand Down
102 changes: 59 additions & 43 deletions R/toxlsx.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -124,24 +137,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
Expand All @@ -150,14 +163,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
Expand All @@ -169,13 +184,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)]]]]
}

}
Expand All @@ -188,7 +203,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)
Expand All @@ -202,10 +217,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",
Expand All @@ -214,25 +229,26 @@ 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
)

Expand Down

0 comments on commit 4c62f93

Please sign in to comment.