Improve speed of write_gmt

[TylerSagendorf]

Hello @tnat1031, I improved the speed of write_gmt() at the cost of extra memory allocation. Since file I/O is so expensive, this new version instead flattens the input list into a single string so that only one write() call is needed.

According to the benchmark results below, the new version is ~62x faster and uses 1.4x as much memory.

# Simulate list of gene sets ----
genes <- paste0("gene", seq_len(1e4L))

min_size <- 2L
max_size <- 500L
n_sets <- 1e4L
set_sizes <- rep(min_size:max_size, length.out = n_sets)

gene_sets <- lapply(seq_len(n_sets), function(i) {
  set.seed(i)
  
  list(
    "head" = paste0("set", i),
    "desc" = paste0("description", i),
    "len" = set_sizes[i],
    "entry" = sample(genes, size = set_sizes[i])
  )
})
names(gene_sets) <- paste0("set", seq_len(n_sets))


# Original ----
write_gmt_original <- function(lst, fname) {
  # assumes that each element of the list will have the fields
  # head, desc, entry
  if (file.exists(fname)) {
    message(paste(fname, "exists, deleting..."))
    file.remove(fname)
  }
  for (i in seq_along(lst)) {
    el <- lst[[i]]
    ncolumns <- 2 + length(el$entry)
    write(c(el$head, el$desc, el$entry), file=fname, sep="\t",
          append=TRUE, ncolumns=ncolumns)
  }
}

# New ----
write_gmt <- function(lst, fname) {
  # assumes that each element of the list will have the fields
  # head, desc, entry
  if (file.exists(fname)) {
    message(paste(fname, "exists, deleting..."))
    file.remove(fname)
  }
  lst <- vapply(lst, function(el) {
    paste(c(el$head, el$desc, el$entry), collapse = "\t")
  }, character(1L))
  lst <- paste(lst, collapse = "\n")
  write(lst, file=fname, sep="\t", append=FALSE)
}


# Benchmarking ----
res <- bench::mark(
  "original" = write_gmt_original(gene_sets, fname),
  "new" = write_gmt(gene_sets, fname),
  iterations = 10L,
  filter_gc = FALSE
)[1:9]

# Switch to relative values, exclude mem_alloc
for (i in c(2:4, 6L)) {
  res[i] <- lapply(res[i] / min(res[i]), as.numeric)
}

res

# # A tibble: 2 × 9
#   expression   min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
#   <bch:expr> <dbl>  <dbl>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
# 1 original    61.9   62.9       1      59.1MB      1      10    27      7.76m
# 2 new          1      1        60.5    82.7MB     31.4    10    14       7.7s

[tnat1031]

Looks good, thanks @TylerSagendorf !

[TylerSagendorf]

@tnat1031 No problem! Actually, hold off on merging. I have a fix for the increased memory usage that I will commit tonight.

[tnat1031]

ah ok, I will stand by

[TylerSagendorf]

Thank you for waiting, @tnat1031. The memory usage is now about the same as the original, but it is a bit slower than my first version. If you would prefer the faster version, I can revert the latest commit. Otherwise, I don't have any other changes to make.

# A tibble: 2 × 9
  expression   min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
  <bch:expr> <dbl>  <dbl>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
1 original    49.2   47.7       1        59MB      1      10    28      6.93m
2 new          1      1        47.8    61.4MB     32.4    10    19       8.7s