1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
dotstackGrob <- function(
x = unit(0.5, "npc"), # x pos of the dotstack's origin
y = unit(0.5, "npc"), # y pos of the dotstack's origin
stackaxis = "y",
dotdia = unit(1, "npc"), # Dot diameter in the non-stack axis, should be in npc
stackposition = 0, # Position of each dot in the stack, relative to origin
stackdir = "up", # Stacking direction ("up", "down", "center", or "centerwhole")
stackratio = 1, # Stacking height of dots (.75 means 25% dot overlap)
default.units = "npc", name = NULL, gp = gpar(), vp = NULL)
{
if (!is.unit(x))
x <- unit(x, default.units)
if (!is.unit(y))
y <- unit(y, default.units)
if (!is.unit(dotdia))
dotdia <- unit(dotdia, default.units)
if (!is_npc(dotdia))
cli::cli_warn("Unit type of dotdia should be {.val npc}")
grob(x = x, y = y, stackaxis = stackaxis, dotdia = dotdia,
stackposition = stackposition, stackdir = stackdir, stackratio = stackratio,
name = name, gp = gp, vp = vp, cl = "dotstackGrob")
}
# Only cross-version reliable way to check the unit of a unit object
is_npc <- function(x) isTRUE(grepl('^[^+^-^\\*]*[^s]npc$', as.character(x)))
#' @export
makeContext.dotstackGrob <- function(x, recording = TRUE) {
# Need absolute coordinates because when using npc coords with circleGrob,
# the radius is in the _smaller_ of the two axes. We need the radius
# to instead be defined in terms of the non-stack axis.
xmm <- convertX(x$x, "mm", valueOnly = TRUE)
ymm <- convertY(x$y, "mm", valueOnly = TRUE)
# When stacking up (or down), stackratios != 1 will cause the bottom (top)
# edge of the first dot in a stack to no longer touch the origin, as
# stackpositions are expanded or contracted away from the dotstack's origin.
# The stackoffset corrects that misalignment so that the first dot just
# touches the dotstack's origin.
if (is.null(x$stackdir) || x$stackdir == "up") {
stackoffset <- (1 - x$stackratio) / 2
} else if (x$stackdir == "down") {
stackoffset <- -(1 - x$stackratio) / 2
} else {
stackoffset <- 0
}
if (x$stackaxis == "x") {
dotdiamm <- convertY(x$dotdia, "mm", valueOnly = TRUE)
xpos <- xmm + dotdiamm * (x$stackposition * x$stackratio + stackoffset)
ypos <- ymm
} else if (x$stackaxis == "y") {
dotdiamm <- convertX(x$dotdia, "mm", valueOnly = TRUE)
xpos <- xmm
ypos <- ymm + dotdiamm * (x$stackposition * x$stackratio + stackoffset)
}
circleGrob(
x = xpos, y = ypos, r = dotdiamm / 2, default.units = "mm",
name = x$name, gp = x$gp, vp = x$vp
)
}
|
