Skip to content

Commit

Permalink
backports of hashtable functionality
Browse files Browse the repository at this point in the history
  • Loading branch information
thomasp85 committed Jan 5, 2024
1 parent d3a763e commit 36557f3
Show file tree
Hide file tree
Showing 2 changed files with 30 additions and 7 deletions.
25 changes: 23 additions & 2 deletions R/collect_axes.R
Original file line number Diff line number Diff line change
Expand Up @@ -284,6 +284,28 @@ grob_layout <- function(gt, idx) {
new
}

# Backports of hash table functionality
hashtab <- function(type, size) {
new_environment()
}
gethash <- function(h, key, nomatch = NULL) {
get0(hash(key), envir = h, ifnotfound = nomatch)
}
sethash <- function(h, key, value) {
assign(hash(key), value, envir = h)
}
on_load({
if ("hashtab" %in% getNamespaceExports("utils")) {
hashtab <- utils::hashtab
}
if ("gethash" %in% getNamespaceExports("utils")) {
gethash <- utils::gethash
}
if ("sethash" %in% getNamespaceExports("utils")) {
sethash <- utils::sethash
}
})

# 2D equivalent of run-length encoding.
# Essentially, it tries to look for rectangular arrangements of cells in a
# matrix that have the same values, and reports back their positions.
Expand All @@ -307,7 +329,6 @@ grob_layout <- function(gt, idx) {
# #> 2 1 2 3 3 2
# #> 5 3 3 1 2 3
# #> 6 3 3 3 3 1
#' @importFrom utils hashtab gethash sethash
rle_2d <- function(m, byrow = FALSE) {

n <- length(m)
Expand Down Expand Up @@ -413,7 +434,7 @@ rle_2d <- function(m, byrow = FALSE) {
# Initialise hash table no longer than number of runs
# Inspiration for using hash tables for this problem taken from TimTaylor:
# https://fosstodon.org/@_TimTaylor/111266682218212785
htab <- hashtab(size = length(values))
htab <- hashtab("identical", size = length(values))

for (i in seq_along(values)) {

Expand Down
12 changes: 7 additions & 5 deletions R/zzz.R
Original file line number Diff line number Diff line change
@@ -1,15 +1,14 @@
.onLoad <- function(...) {
run_on_load()
}

print_plot.patchwork <- function(p, title = '') {
if (is.null(p$patches$annotation$title)) {
p <- p + plot_annotation(title = title)
}
print(p)
}

.onLoad <- function(...) {
register_s3_method("vdiffr", "print_plot", "patchwork")
invisible()
}

register_s3_method <- function(pkg, generic, class, fun = NULL) {
check_string(pkg)
check_string(generic)
Expand All @@ -33,3 +32,6 @@ register_s3_method <- function(pkg, generic, class, fun = NULL) {
}
)
}
on_load(
register_s3_method("vdiffr", "print_plot", "patchwork")
)

0 comments on commit 36557f3

Please sign in to comment.