Added vertical bars

R/create_test_files.R

@@ -15,13 +15,13 @@ create_test_files_cars <- function(){
               sd_wt = sd(wt))
 
   tbl <- tablespan(data = summarized_table,
-                  formula = Cylinder:cyl + Engine:vs ~
-                    N +
-                    (`Horse Power` = Mean:mean_hp + SD:sd_hp) +
-                    (`Weight` = Mean:mean_wt + SD:sd_wt),
-                  title = "Motor Trend Car Road Tests",
-                  subtitle = "A table created with tablespan",
-                  footnote = "Data from the infamous mtcars data set.")
+                   formula = Cylinder:cyl + Engine:vs ~
+                     N +
+                     (`Horse Power` = Mean:mean_hp + SD:sd_hp) +
+                     (`Weight` = Mean:mean_wt + SD:sd_wt),
+                   title = "Motor Trend Car Road Tests",
+                   subtitle = "A table created with tablespan",
+                   footnote = "Data from the infamous mtcars data set.")
 
   wb <- to_excel(tbl = tbl)
 
@@ -59,29 +59,45 @@ create_test_files_cars <- function(){
 
   # Additional spanners
   tbl <- tablespan(data = summarized_table,
-                  formula = Cylinder:cyl + Engine:vs ~
-                    (Results = N +
-                       (`Horse Power` = (Mean = Mean:mean_hp) + (`Standard Deviation` = SD:sd_hp)) +
-                       (`Weight` = Mean:mean_wt + SD:sd_wt)),
-                  title = "Motor Trend Car Road Tests",
-                  subtitle = "A table created with tablespan",
-                  footnote = "Data from the infamous mtcars data set.")
+                   formula = Cylinder:cyl + Engine:vs ~
+                     (Results = N +
+                        (`Horse Power` = (Mean = Mean:mean_hp) + (`Standard Deviation` = SD:sd_hp)) +
+                        (`Weight` = Mean:mean_wt + SD:sd_wt)),
+                   title = "Motor Trend Car Road Tests",
+                   subtitle = "A table created with tablespan",
+                   footnote = "Data from the infamous mtcars data set.")
 
   wb <- to_excel(tbl = tbl)
 
   openxlsx::saveWorkbook(wb,
                          file = paste0(target_dir, "cars_additional_spanners.xlsx"),
                          overwrite = TRUE)
 
+  # Spanner where we need additional lines
+  tbl <- tablespan(data = summarized_table,
+                   formula = Cylinder:cyl + Engine:vs ~
+                     (Results = N +
+                        (`Inner result` = (`Horse Power` = (Mean = Mean:mean_hp) + (`Standard Deviation` = SD:sd_hp)) +
+                           (`Weight` = Mean:mean_wt + SD:sd_wt))),
+                   title = "Motor Trend Car Road Tests",
+                   subtitle = "A table created with tablespan",
+                   footnote = "Data from the infamous mtcars data set.")
+
+  wb <- to_excel(tbl = tbl)
+
+  openxlsx::saveWorkbook(wb,
+                         file = paste0(target_dir, "cars_additional_spanners_left_right.xlsx"),
+                         overwrite = TRUE)
+
   # no row names
   tbl <- tablespan(data = summarized_table,
-                  formula = 1 ~
-                    (Results = N +
-                       (`Horse Power` = (Mean = Mean:mean_hp) + (`Standard Deviation` = SD:sd_hp)) +
-                       (`Weight` = Mean:mean_wt + SD:sd_wt)),
-                  title = "Motor Trend Car Road Tests",
-                  subtitle = "A table created with tablespan",
-                  footnote = "Data from the infamous mtcars data set.")
+                   formula = 1 ~
+                     (Results = N +
+                        (`Horse Power` = (Mean = Mean:mean_hp) + (`Standard Deviation` = SD:sd_hp)) +
+                        (`Weight` = Mean:mean_wt + SD:sd_wt)),
+                   title = "Motor Trend Car Road Tests",
+                   subtitle = "A table created with tablespan",
+                   footnote = "Data from the infamous mtcars data set.")
 
   wb <- to_excel(tbl = tbl)
 
@@ -90,11 +106,11 @@ create_test_files_cars <- function(){
                          overwrite = TRUE)
   # no titles
   tbl <- tablespan(data = summarized_table,
-                  formula = 1 ~
-                    (Results = N +
-                       (`Horse Power` = (Mean = Mean:mean_hp) + (`Standard Deviation` = SD:sd_hp)) +
-                       (`Weight` = Mean:mean_wt + SD:sd_wt)),
-                  footnote = "Data from the infamous mtcars data set.")
+                   formula = 1 ~
+                     (Results = N +
+                        (`Horse Power` = (Mean = Mean:mean_hp) + (`Standard Deviation` = SD:sd_hp)) +
+                        (`Weight` = Mean:mean_wt + SD:sd_wt)),
+                   footnote = "Data from the infamous mtcars data set.")
 
   wb <- to_excel(tbl = tbl)
 
@@ -104,10 +120,10 @@ create_test_files_cars <- function(){
 
   # no titles, no footnote
   tbl <- tablespan(data = summarized_table,
-                  formula = 1 ~
-                    (Results = N +
-                       (`Horse Power` = (Mean = Mean:mean_hp) + (`Standard Deviation` = SD:sd_hp)) +
-                       (`Weight` = Mean:mean_wt + SD:sd_wt)))
+                   formula = 1 ~
+                     (Results = N +
+                        (`Horse Power` = (Mean = Mean:mean_hp) + (`Standard Deviation` = SD:sd_hp)) +
+                        (`Weight` = Mean:mean_wt + SD:sd_wt)))
 
   wb <- to_excel(tbl = tbl)
 

R/write_excel.R

@@ -326,7 +326,8 @@ write_header <- function(workbook,
                        max_level = max_level,
                        start_row = locations$row$start_row_header,
                        start_col = locations$col$start_col_header_lhs,
-                       header_style = styles$header_style)
+                       header_style = styles$header_style,
+                       vline_style = styles$vline_style)
 
   }else{
     max_level <- header$rhs$level
@@ -338,7 +339,8 @@ write_header <- function(workbook,
                      max_level = max_level,
                      start_row = locations$row$start_row_header,
                      start_col = locations$col$start_col_header_rhs,
-                     header_style = styles$header_style)
+                     header_style = styles$header_style,
+                     vline_style = styles$vline_style)
 
 }
 
@@ -354,6 +356,7 @@ write_header <- function(workbook,
 #' @param start_row integer specifying row to write to
 #' @param start_col integer specifying column to write to
 #' @param header_style openxlsx style for the header
+#' @param vline_style openxlsx style for the vertical lines in the header
 #' @import openxlsx
 #' @keywords internal
 write_header_entry <- function(workbook,
@@ -362,7 +365,8 @@ write_header_entry <- function(workbook,
                                max_level,
                                start_row,
                                start_col,
-                               header_style){
+                               header_style,
+                               vline_style){
 
   # write current entry name into table
   if(header_entry$name != "_BASE_LEVEL_"){
@@ -384,6 +388,23 @@ write_header_entry <- function(workbook,
                        cols = start_col:(start_col + header_entry$width - 1),
                        gridExpand = TRUE,
                        stack = TRUE)
+
+    # add vertical line to the left
+    openxlsx::addStyle(wb = workbook,
+                       sheet = sheet,
+                       style = vline_style,
+                       rows = (start_row + (max_level - header_entry$level) - 1):(start_row + max_level - 2),
+                       cols = start_col,
+                       gridExpand = TRUE,
+                       stack = TRUE)
+    # add vertical line to the right
+    openxlsx::addStyle(wb = workbook,
+                       sheet = sheet,
+                       style = vline_style,
+                       rows = (start_row + (max_level - header_entry$level) - 1):(start_row + max_level - 2),
+                       cols = (start_col + header_entry$width),
+                       gridExpand = TRUE,
+                       stack = TRUE)
   }
 
   # entries may have sub-entries, that also have to be written down
@@ -395,7 +416,8 @@ write_header_entry <- function(workbook,
                        max_level = max_level,
                        start_row = start_row,
                        start_col = start_col_entry,
-                       header_style = header_style)
+                       header_style = header_style,
+                       vline_style = vline_style)
     start_col_entry <- start_col_entry + entry$width
   }
 }

tests/testthat/test-cars.R

@@ -350,3 +350,48 @@ test_that("cars-no_titles_no_footnotes", {
   testthat::expect_true(all.equal(wb$worksheets,  wb_compare$worksheets))
 
 })
+
+
+test_that("cars-table_with_higher_spanner_left_right", {
+  library(tablespan)
+  library(testthat)
+  library(dplyr)
+  library(openxlsx)
+
+  comp_file_dir <- paste0(testthat::test_path(), "/xlsx_files/")
+
+  summarized_table <- mtcars |>
+    group_by(cyl, vs) |>
+    summarise(N = n(),
+              mean_hp = mean(hp),
+              sd_hp = sd(hp),
+              mean_wt = mean(wt),
+              sd_wt = sd(wt))
+
+  # Spanner where we need additional lines
+  tbl <- tablespan(data = summarized_table,
+                   formula = Cylinder:cyl + Engine:vs ~
+                     (Results = N +
+                        (`Inner result` = (`Horse Power` = (Mean = Mean:mean_hp) + (`Standard Deviation` = SD:sd_hp)) +
+                           (`Weight` = Mean:mean_wt + SD:sd_wt))),
+                   title = "Motor Trend Car Road Tests",
+                   subtitle = "A table created with tablespan",
+                   footnote = "Data from the infamous mtcars data set.")
+
+  wb <- to_excel(tbl = tbl)
+
+  # Compare just the data
+  xlsx_compare <- openxlsx::read.xlsx(xlsxFile = paste0(comp_file_dir, "cars_additional_spanners_left_right.xlsx"))
+  testthat::expect_true(all.equal(openxlsx::read.xlsx(wb), xlsx_compare))
+
+  # to compare workbooks, we have to write and reload the xlsx file
+  tmp_dir <- tempdir()
+  openxlsx::saveWorkbook(wb,
+                         file = paste0(tmp_dir, "/cars_test.xlsx"),
+                         overwrite = TRUE)
+
+  wb <- openxlsx::loadWorkbook(file = paste0(tmp_dir, "/cars_test.xlsx"))
+  wb_compare <- openxlsx::loadWorkbook(file = paste0(comp_file_dir, "cars_additional_spanners_left_right.xlsx"))
+  testthat::expect_true(all.equal(wb$worksheets,  wb_compare$worksheets))
+
+})