test_that("add_data_table() writes over tables", { overwrite_table_error <- "Cannot overwrite existing table with another table" df1 <- data.frame("X" = 1:10) wb <- wb_add_worksheet(wb_workbook(), "Sheet1") ## table covers rows 4->10 and cols 4->8 wb$add_data_table(sheet = 1, x = head(iris), start_col = 4, start_row = 4) ## should all run without error wb$add_data_table(sheet = 1, x = df1, start_col = 3, start_row = 2) wb$add_data_table(sheet = 1, x = df1, start_col = 9, start_row = 2) wb$add_data_table(sheet = 1, x = df1, start_col = 4, start_row = 11) wb$add_data_table(sheet = 1, x = df1, start_col = 5, start_row = 11) wb$add_data_table(sheet = 1, x = df1, start_col = 6, start_row = 11) wb$add_data_table(sheet = 1, x = df1, start_col = 7, start_row = 11) wb$add_data_table(sheet = 1, x = df1, start_col = 8, start_row = 11) wb$add_data_table(sheet = 1, x = head(iris, 2), start_col = 4, start_row = 1) ## Now error expect_error(wb$add_data_table(sheet = 1, x = df1, start_col = "H", start_row = 21), regexp = overwrite_table_error) expect_error(wb$add_data_table(sheet = 1, x = df1, start_col = 3, start_row = 12), regexp = overwrite_table_error) expect_error(wb$add_data_table(sheet = 1, x = df1, start_col = 9, start_row = 12), regexp = overwrite_table_error) expect_error(wb$add_data_table(sheet = 1, x = df1, start_col = "i", start_row = 12), regexp = overwrite_table_error) ## more errors expect_error(wb$add_data_table(sheet = 1, x = head(iris)), regexp = overwrite_table_error) expect_error(wb$add_data_table(sheet = 1, x = head(iris), start_col = 4, start_row = 21), regexp = overwrite_table_error) ## should work wb$add_data_table(sheet = 1, x = head(iris), start_col = 4, start_row = 22) wb$add_data_table(sheet = 1, x = head(iris), start_col = 4, start_row = 40) ## more errors expect_error(wb$add_data_table(sheet = 1, x = head(iris, 2), start_col = 4, start_row = 38), regexp = overwrite_table_error) expect_error(wb$add_data_table(sheet = 1, x = head(iris, 2), start_col = 4, start_row = 38, col_names = FALSE), regexp = overwrite_table_error) expect_error(wb$add_data_table(sheet = 1, x = head(iris), start_col = "H", start_row = 40), regexp = overwrite_table_error) wb$add_data_table(sheet = 1, x = head(iris), start_col = "I", start_row = 40) wb$add_data_table(sheet = 1, x = head(iris)[, 1:3], start_col = "A", start_row = 40) expect_error(wb$add_data_table(sheet = 1, x = head(iris, 2), start_col = 4, start_row = 38, col_names = FALSE), regexp = overwrite_table_error) expect_error(wb$add_data_table(sheet = 1, x = head(iris, 2), start_col = 1, start_row = 46, col_names = FALSE), regexp = overwrite_table_error) }) test_that("zero row data table works", { wb <- wb_workbook() %>% wb_add_worksheet() expect_warning( wb$add_data_table(x = data.frame(a = NA, b = NA)[0, ]), "Found data table with zero rows, adding one. Modify na with na.strings" ) exp <- "A1:B2" got <- wb$tables$tab_ref expect_equal(exp, got) }) test_that("write_data over tables", { overwrite_table_error <- "Cannot overwrite table headers. Avoid writing over the header row" df1 <- data.frame("X" = 1:10) wb <- wb_add_worksheet(wb_workbook(), "Sheet1") ## table covers rows 4->10 and cols 4->8 wb$add_data_table(sheet = 1, x = head(iris), start_col = 4, start_row = 4) ## Anywhere on row 5 is fine for (i in 1:10) { wb$add_data(sheet = 1, x = head(iris), start_row = 5, start_col = i) } ## Anywhere on col i is fine for (i in 1:10) { wb$add_data(sheet = 1, x = head(iris), start_row = i, start_col = "i") } ## Now errors on headers expect_error(wb$add_data(sheet = 1, x = head(iris), start_col = 4, start_row = 4), regexp = overwrite_table_error) wb$add_data(sheet = 1, x = head(iris), start_col = 4, start_row = 5) wb$add_data(sheet = 1, x = head(iris)[1:3]) wb$add_data(sheet = 1, x = head(iris, 2), start_col = 4) wb$add_data(sheet = 1, x = head(iris, 2), start_col = 4, col_names = FALSE) ## Example of how this should be used wb$add_data_table(sheet = 1, x = head(iris), start_col = 4, start_row = 30) wb$add_data(sheet = 1, x = head(iris), start_col = 4, start_row = 31, col_names = FALSE) wb$add_data_table(sheet = 1, x = head(iris), start_col = 10, start_row = 30) wb$add_data(sheet = 1, x = tail(iris), start_col = 10, start_row = 31, col_names = FALSE) wb$add_data_table(sheet = 1, x = head(iris)[, 1:3], start_col = 1, start_row = 30) wb$add_data(sheet = 1, x = tail(iris), start_col = 1, start_row = 31, col_names = FALSE) }) test_that("Validate Table Names", { wb <- wb_add_worksheet(wb_workbook(), "Sheet 1") ## case expect_equal(wb_validate_table_name(wb, "test"), "test") expect_equal(wb_validate_table_name(wb, "TEST"), "test") expect_equal(wb_validate_table_name(wb, "Test"), "test") ## length expect_error(wb_validate_table_name(wb, paste(sample(LETTERS, size = 300, replace = TRUE), collapse = "")), regexp = "`table_name` must be less than 255 characters") ## look like cell ref expect_error(wb_validate_table_name(wb, "R1C2"), regexp = "`table_name` cannot be the same as a cell reference, such as R1C1", fixed = TRUE) expect_error(wb_validate_table_name(wb, "A1"), regexp = "`table_name` cannot be the same as a cell reference", fixed = TRUE) expect_error(wb_validate_table_name(wb, "R06821C9682"), regexp = "`table_name` cannot be the same as a cell reference, such as R1C1", fixed = TRUE) expect_error(wb_validate_table_name(wb, "ABD918751"), regexp = "`table_name` cannot be the same as a cell reference", fixed = TRUE) expect_error(wb_validate_table_name(wb, "A$100"), regexp = "`table_name` cannot contain spaces or the '$' character", fixed = TRUE) expect_error(wb_validate_table_name(wb, "A12$100"), regexp = "`table_name` cannot contain spaces or the '$' character", fixed = TRUE) tbl_nm <- "性別" expect_equal(wb_validate_table_name(wb, tbl_nm), tbl_nm) }) test_that("Existing Table Names", { wb <- wb_add_worksheet(wb_workbook(), "Sheet 1") ## Existing names - case in-sensitive wb$add_data_table(sheet = 1, x = head(iris), table_name = "Table1") expect_error(wb_validate_table_name(wb, "Table1"), regexp = "`table_name = 'table1'` already exists", fixed = TRUE) expect_error(wb$add_data_table(sheet = 1, x = head(iris), table_name = "Table1", start_col = 10), regexp = "`table_name = 'table1'` already exists", fixed = TRUE) expect_error(wb_validate_table_name(wb, "TABLE1"), regexp = "`table_name = 'table1'` already exists", fixed = TRUE) expect_error(wb$add_data_table(sheet = 1, x = head(iris), table_name = "TABLE1", start_col = 20), regexp = "`table_name = 'table1'` already exists", fixed = TRUE) expect_error(wb_validate_table_name(wb, "table1"), regexp = "`table_name = 'table1'` already exists", fixed = TRUE) expect_error(wb$add_data_table(sheet = 1, x = head(iris), table_name = "table1", start_col = 30), regexp = "`table_name = 'table1'` already exists", fixed = TRUE) }) test_that("custom table styles work", { # at the moment we have no interface to add custom table styles wb <- wb_workbook() %>% wb_add_worksheet() # create dxf elements to be used in the table style tabCol1 <- create_dxfs_style(bg_fill = wb_color(theme = 7)) tabCol2 <- create_dxfs_style(bg_fill = wb_color(theme = 5)) tabBrd1 <- create_dxfs_style(border = TRUE) tabCol3 <- create_dxfs_style(bg_fill = wb_color(hex = "FFC00000"), font_color = wb_color("white")) # don't forget to assign them to the workbook wb$add_style(tabCol1) wb$add_style(tabCol2) wb$add_style(tabBrd1) wb$add_style(tabCol3) # tweak a working style with 4 elements tab_xml <- sprintf( " ", length(c(tabCol1, tabCol2, tabCol3, tabBrd1)), wb$styles_mgr$get_dxf_id("tabBrd1"), wb$styles_mgr$get_dxf_id("tabCol3"), wb$styles_mgr$get_dxf_id("tabCol1"), wb$styles_mgr$get_dxf_id("tabCol2") ) wb$add_style(tab_xml) expect_silent(wb$add_data_table(x = mtcars, table_style = "RedTableStyle")) wb$add_worksheet() expect_error(wb$add_data_table(x = mtcars, table_style = "RedTableStyle1"), "Invalid table style.") }) test_that("updating table works", { wb <- wb_workbook() wb$add_worksheet()$add_data_table(x = mtcars) wb$add_worksheet()$add_data_table(x = mtcars[1:2]) wb_to_df(wb, named_region = "Table2") wb$add_data(dims = "C1", x = mtcars[-1:-2], name = "test") wb <- wb_update_table(wb, "Table2", sheet = 2, dims = "A1:J4") exp <- mtcars[1:3, 1:10] got <- wb_to_df(wb, named_region = "Table2") expect_equal(exp, got, ignore_attr = TRUE) wb <- wb_workbook()$add_worksheet()$add_data_table(x = mtcars, with_filter = FALSE) wb$update_table(tabname = "Table1", dims = "A1:J4") got <- wb$tables$tab_ref expect_equal(got, "A1:J4") }) test_that("writing table headers with factor variables works", { df <- data.frame( fct = structure( 1:2, levels = c( "one", "two" ), class = "factor"), `1` = 1:2, check.names = FALSE ) wb <- wb_workbook()$add_worksheet()$add_data_table(x = df) exp <- "1" got <- wb$worksheets[[1]]$sheet_data$cc$is[[2]] expect_equal(exp, got) }) test_that("tables cannot have duplicated column names", { df1 <- data.frame( x = 1, x = 2, check.names = FALSE ) df2 <- data.frame( x = 1, X = 2, check.names = FALSE ) wb <- wb_workbook() expect_warning(wb$add_worksheet()$add_data_table(x = df1), "tables cannot have duplicated column names") expect_warning(wb$add_worksheet()$add_data_table(x = df2), "tables cannot have duplicated column names") exp <- c("", "") got <- xml_node(wb$tables$tab_xml[[1]], "table", "tableColumns", "tableColumn") expect_equal(exp, got) exp <- c("", "") got <- xml_node(wb$tables$tab_xml[[2]], "table", "tableColumns", "tableColumn") expect_equal(exp, got) }) test_that("make sure that table id is unique", { tmp <- temp_xlsx() wb <- write_xlsx(x = list(head(mtcars), head(iris)), as_table = TRUE) wb$remove_tables(sheet = 1, table = "Table1", remove_data = FALSE) wb$save(tmp) wb <- wb_load(tmp) wb$add_worksheet()$add_data_table(x = head(Orange)) exp <- data.frame(name = c("Table2", "Table3"), id = c("2", "3")) got <- rbindlist(xml_attr(wb$tables$tab_xml, "table"))[c("name", "id")] expect_equal(exp, got) }) test_that("wb_get_named_regions, works with removed tables", { wb <- wb_workbook()$ add_worksheet()$add_data_table(x = iris, table_name = "iris1")$ add_worksheet()$add_data_table(x = iris, table_name = "iris2")$ add_worksheet()$add_data_table(x = iris, table_name = "iris3") wb$remove_tables(table = "iris3") tabs <- wb$get_named_regions(tables = TRUE) expect_equal(2, nrow(tabs)) expect_equal(paste0("iris", 1:2), tabs$name) }) test_that("reading tables from file works", { tmp <- temp_xlsx() exp <- head(mtcars) write_xlsx(x = exp, file = tmp, as_table = TRUE) got <- wb_to_df(tmp, named_region = "Table1") expect_equal(exp, got, ignore_attr = TRUE) })