test-grouped_rows.R
In openxlsx: Read, Write and Edit xlsx Files

context("Group visibility and nested Grouping")



test_that("row and column grouping", {
  # Test file has several worksheets:
  #   1. "simple visible grouping": One simple grouping (rows 1:2, columns 1:2), visible
  #   2. "simple hidden grouping": One simple grouping (rows 1:2, columns 1:2), hidden
  #   3. "multiple non-nested groupings": three groupings (rows/cols 1:2, 4:5 and 7:8 (hidden); table contents only until cell G6, so last grouping has no actual content)
  #   4. "nested grouping": cols rows 1:4 (outline level 1) and 2:3 (outline level 2), contents to cell F7 (spanning all groupings)
  #   4. "nested grouping 2": Like previous, but outline level 2 is hidden, contents only to cell B2
  
  # Potential issues with groupings:
  #   - Outline level not preserved
  #   - Hidden flag not set (or not correctly loaded)
  #   - When nesting goes beyond the cell contents, rows/cols need to be added manually to the xml for the grouping settings
  #   - Hidden flag for visible rows/cols not properly loaded, so subsequent hidden cols set the hidden flag for the wrong row/col
  #   - Non-overlapping groupings 

  
  wb <- loadWorkbook(file = system.file("extdata", "nested_grouped_rowscols.xlsx", package = "openxlsx"))
  fileName <- file.path(tempdir(), "nested_grouped_rowscols_out.xlsx")
  oL1 = c(`1` = "1", `2` = "1")
  oL3 = c(`1` = "1", `2` = "1", `4` = "1", `5` = "1", `7` = "1", `8` = "1")
  oL4 = c(`1` = "1", `2` = "2", `3` = "2", `4` = "1")
  
  stripAttributes <- function(x, attr = NA) {
    y = x
    if (is.na(attr)) {
      attributes(y) <- NULL
    } else {
      attr(y, attr) <- NULL
    }
    y
  }
  
  ### 1. Loading of outline level
  
  # First sheet has simple, visible groupings
  expect_equal(oL1, stripAttributes(wb$outlineLevels[[1]], "hidden"))
  expect_equal(oL1, stripAttributes(wb$colOutlineLevels[[1]], "hidden"))
  # Second sheet has simple, hidden groupings
  expect_equal(oL1, stripAttributes(wb$outlineLevels[[2]], "hidden"))
  expect_equal(oL1, stripAttributes(wb$colOutlineLevels[[2]], "hidden"))
  # Third sheet has simple, non-overlapping groupings
  expect_equal(oL3, stripAttributes(wb$outlineLevels[[3]], "hidden"))
  expect_equal(oL3, stripAttributes(wb$colOutlineLevels[[3]], "hidden"))
  # Fourth tab has nested, visible groupings
  expect_equal(oL4, stripAttributes(wb$outlineLevels[[4]], "hidden"))
  expect_equal(oL4, stripAttributes(wb$colOutlineLevels[[4]], "hidden"))

  
  ### 2. Loading of row/columng visibility of groupings (hidden attribute)
  
  # First tab has visible groupings, second tab has hidden groupings, third has visible, fourth has visible and hidden rows/cols
  expect_equal(rep(NA_character_, 2), attr(wb$outlineLevels[[1]], "hidden"))
  expect_equal(c("1", "1"), attr(wb$outlineLevels[[2]], "hidden"))
  expect_equal(c(rep(NA_character_, 4), "1", "1"), attr(wb$outlineLevels[[3]], "hidden"))
  expect_equal(rep(NA_character_, 4), attr(wb$outlineLevels[[4]], "hidden"))
  expect_equal(c(NA_character_, "1", "1", NA_character_), attr(wb$outlineLevels[[5]], "hidden"))
  
  expect_equal(rep("0", 2), attr(wb$colOutlineLevels[[1]], "hidden"))
  expect_equal(c("1", "1"), attr(wb$colOutlineLevels[[2]], "hidden"))
  expect_equal(c("0", "0", "0", "0", "1", "1"), attr(wb$colOutlineLevels[[3]], "hidden"))
  expect_equal(rep("0", 4), attr(wb$colOutlineLevels[[4]], "hidden"))
  expect_equal(c("0", "1", "1", "0"), attr(wb$colOutlineLevels[[5]], "hidden"))
  
  
  #### 3. Export xlsx file and read it in again to check if outlines are preserved
  # The test file has groupings beyond the actual file contents, so not all 
  # grouped rows/cols are available in the data and need to be added manually
  # for the grouping data!
  
  openxlsx::saveWorkbook(wb, file = fileName, overwrite = TRUE)
  wbout <- loadWorkbook(file = fileName)
  
  expect_equal(wb$outlineLevels[[1]], wbout$outlineLevels[[1]])
  expect_equal(wb$outlineLevels[[2]], wbout$outlineLevels[[2]])
  expect_equal(wb$outlineLevels[[3]], wbout$outlineLevels[[3]])
  expect_equal(wb$outlineLevels[[4]], wbout$outlineLevels[[4]])
  expect_equal(wb$outlineLevels[[5]], wbout$outlineLevels[[5]])
  
  expect_equal(wb$colOutlineLevels[[1]], wbout$colOutlineLevels[[1]])
  expect_equal(wb$colOutlineLevels[[2]], wbout$colOutlineLevels[[2]])
  expect_equal(wb$colOutlineLevels[[3]], wbout$colOutlineLevels[[3]]) # BUG: Ordering of entries not preserved
  expect_equal(wb$colOutlineLevels[[4]], wbout$colOutlineLevels[[4]]) # BUG: Ordering of entries not preserved
  expect_equal(wb$colOutlineLevels[[5]], wbout$colOutlineLevels[[5]]) # BUG: Ordering of entries not preserved
  
  
  #### 4. Manually create non-overlapping and nested groupings of rows / cols
  
  wb <- openxlsx::createWorkbook()
  wb$addWorksheet(sheetName = "Manually")
  writeData(wb, "Manually", matrix(1:225, 15, 15), 1, 1)
  # non-nested grouping (visible and hidden)
  groupRows(wb, "Manually", 2:3, FALSE)
  groupRows(wb, "Manually", 5:6, TRUE)
  # nested grouping
  groupRows(wb, "Manually", 9:15) # Outline level 1, next groupings will be level 2! 
  groupRows(wb, "Manually", 10:11)
  groupRows(wb, "Manually", 13:14)
  expect_equal(c(`2` = "1", `3` = "1", `5` = "1", `6` = "1", `9` = "1", `10` = "2", `11` = "2", `12` = "1", `13` = "2", `14` = "2", `15` = "1"),
               stripAttributes(wb$outlineLevels[[1]], "hidden"))

  # non-nested grouping (visible and hidden)
  groupColumns(wb, "Manually", 2:3, FALSE)
  groupColumns(wb, "Manually", 5:6, TRUE)
  # nested grouping
  groupColumns(wb, "Manually", 9:15)
  groupColumns(wb, "Manually", 10:11)
  groupColumns(wb, "Manually", 13:14)
  expect_equal(c(`2` = "1", `3` = "1", `5` = "1", `6` = "1", `9` = "1", `10` = "2", `11` = "2", `12` = "1", `13` = "2", `14` = "2", `15` = "1"),
               stripAttributes(wb$colOutlineLevels[[1]], "hidden"))
  
  
  #### 5. Ungrouping rows/cols simply decrements the level (and removes the entry if no longer grouped)
  ungroupRows(wb, "Manually", 11:13)
  expect_equal(c(`2` = "1", `3` = "1", `5` = "1", `6` = "1", `9` = "1", `10` = "2", `11` = "1", `13` = "1", `14` = "2", `15` = "1"),
               stripAttributes(wb$outlineLevels[[1]], "hidden"))
  
  ungroupColumns(wb, "Manually", 11:13)
  expect_equal(c(`2` = "1", `3` = "1", `5` = "1", `6` = "1", `9` = "1", `10` = "2", `11` = "1", `13` = "1", `14` = "2", `15` = "1"),
               stripAttributes(wb$colOutlineLevels[[1]], "hidden"))
  

  #### CLEANUP
  
  unlink(fileName, recursive = TRUE, force = TRUE)
  
})