Merge pull request #468 from StevenHibble-Concurrence/master

Add `pair_rc()` to improve row/column pair lookups

R/WorkbookClass.R

@@ -3399,6 +3399,7 @@ Workbook$methods(
     }
 
 
+    prev_sheet <- 0L
     for (x in styleObjects) {
       if (length(x$rows) > 0 & length(x$cols) > 0) {
         this.sty <- x$style$copy()
@@ -3416,12 +3417,13 @@ Workbook$methods(
         sId <-
           .self$updateStyles(this.sty) ## this creates the XML for styles.XML
 
-        cells_to_style <- stri_join(x$rows, x$cols, sep = ",")
-        existing_cells <-
-          stri_join(worksheets[[sheet]]$sheet_data$rows,
-            worksheets[[sheet]]$sheet_data$cols,
-            sep = ","
-          )
+        cells_to_style <- pair_rc(x$rows, x$cols)
+
+        # Avoid recreating this if we're looking at the same sheet over and over
+        if (sheet != prev_sheet) {
+          existing_cells <- pair_rc(worksheets[[sheet]]$sheet_data$rows,
+                                    worksheets[[sheet]]$sheet_data$cols)  
+        }
 
         ## In here we create any style_ids that don't yet exist in sheet_data
         worksheets[[sheet]]$sheet_data$style_id[existing_cells %in% cells_to_style] <<-
@@ -3560,9 +3562,9 @@ Workbook$methods(
           ## toRemove are the elements that the new style doesn't apply to, we remove these from the style object as it
           ## is copied, merged with the new style and given the new data points
 
-          ex_row_cols <-
-            stri_join(styleObjects[[i]]$rows, styleObjects[[i]]$cols, sep = "-")
-          new_row_cols <- stri_join(rows, cols, sep = "-")
+          ex_row_cols  <- pair_rc(styleObjects[[i]]$rows, 
+                                  styleObjects[[i]]$cols)
+          new_row_cols <- pair_rc(rows, cols)
 
 
           ## mergeInds are the intersection of the two styles that will need to merge

R/sheet_data_class.R

@@ -33,7 +33,7 @@ Sheet_Data$methods(delete = function(rows_in, cols_in, grid_expand) {
     stop("Length of rows and cols must be equal.")
   }
 
-  inds <- which(paste(rows, cols, sep = ",") %in% paste(rows_in, cols_in, sep = ","))
+  inds <- which(pair_rc(rows, cols) %in% pair_rc(rows_in, cols_in))
 
   if (length(inds) > 0) { ## writing over existing data
 
@@ -80,7 +80,7 @@ Sheet_Data$methods(write = function(rows_in, cols_in, t_in, v_in, f_in, any_func
 
   inds <- integer(0)
   if (possible_overlap) {
-    inds <- which(paste(rows, cols, sep = ",") %in% paste(rows_in, cols_in, sep = ","))
+    inds <- which(pair_rc(rows, cols) %in% pair_rc(rows_in, cols_in))
   }
 
   if (length(inds) > 0) {

R/utils.R

@@ -22,6 +22,13 @@ is_true_false <- function(x) {
   is.logical(x) && length(x) == 1L && !is.na(x)
 }
 
+pair_rc <- function(r, c) {
+  # Assumes that there can't be more than 10M columns
+  # Excel allows 16,384
+  # Google Sheets allows 18,278
+  r+c*1e-7
+}
+
 do_call_params <- function(fun, params, ..., .map = FALSE) {
   fun <- match.fun(fun)
   call_params <- c(list(...), params[names(params) %in% names(formals(fun))])

R/workbook_column_widths.R

@@ -101,8 +101,9 @@ Workbook$methods(setColWidths = function(sheet) {
           all_merged_cells <- do.call("rbind", all_merged_cells)
 
           ## only want the sheet data in here
-          refs <- paste(all_merged_cells[[1]], all_merged_cells[[2]], sep = ",")
-          existing_cells <- paste(worksheets[[sheet]]$sheet_data$rows, worksheets[[sheet]]$sheet_data$cols, sep = ",")
+          refs <- pair_rc(all_merged_cells[[1]], all_merged_cells[[2]])
+          existing_cells <- pair_rc(worksheets[[sheet]]$sheet_data$rows, 
+                                    worksheets[[sheet]]$sheet_data$cols)
           keep <- which(!existing_cells %in% refs & !is.na(worksheets[[sheet]]$sheet_data$v))
 
           sd <- Sheet_Data$new()

R/workbook_read_workbook.R

@@ -320,7 +320,7 @@ read.xlsx.Workbook <- function(xlsxFile,
     if (length(sO) > 0) {
       style_rows <- unlist(lapply(sO, "[[", "rows"))
       style_cols <- unlist(lapply(sO, "[[", "cols"))
-      isDate <- paste(rows, cols, sep = ",") %in% paste(style_rows, style_cols, sep = ",")
+      isDate <- pair_rc(rows, cols) %in% pair_rc(style_rows, style_cols)
 
       ## check numbers are also integers
       not_an_integer <- suppressWarnings(as.numeric(v[isDate]))

R/wrappers.R

@@ -4498,7 +4498,7 @@ groupColumns <- function(wb, sheet, cols, hidden = FALSE, level = -1) {
     stop("First argument must be a Workbook.")
   }
 
-  if (any(cols) < 1L) {
+  if (any(cols < 1L)) {
     stop("Invalid columns selected (<= 0).")
   }