Get aspect ratio of viewport at draw time with grid - r

I need to develop a new grid grob that is a customisation of segmentsGrob, but allows termination of the drawing at a specified length (i.e. cut 1 cm of the segment from the end). As the computations are a function of both the angle of the segment as well as the aspect ratio of the viewport (in absolute measures). The calculations needs to be pushed until drawing time using the drawDetails hook.
My question is how to get the absolute aspect ratio of the viewport in which the grob is being drawn? The context I'm using this in is ggplot2, and what I get if I query current.viewport().width or current.viewport().width is 1npc (thus not in absolute measures).
Example code
segmentsGrob2 <- function(x0 = unit(0, "npc"), y0 = unit(0, "npc"), x1 = unit(1, "npc"), y1 = unit(1, "npc"), startAdjust = unit(0, 'npc'), endAdjust = unit(0, 'npc'), default.units = "npc", arrow = NULL, name = NULL, gp = gpar(), vp = NULL) {
if (!is.unit(x0))
x0 <- unit(x0, default.units)
if (!is.unit(x1))
x1 <- unit(x1, default.units)
if (!is.unit(y0))
y0 <- unit(y0, default.units)
if (!is.unit(y1))
y1 <- unit(y1, default.units)
grid.draw(grob(x0 = x0, y0 = y0, x1 = x1, y1 = y1, startAdjust=startAdjust, endAdjust=endAdjust, arrow = arrow, name=name, gp=gp, vp=vp, cl="segments2"))
}
drawDetails.segments2 <- function(x, ...) {
asp <- getVpAspect() ### <-THIS IS WHAT I NEED
# Do some modifications to x relative to asp
grid:::drawDetails.segments(x, ...)
}

Related

Exact dimensions of linetype spacing and size

This is mostly a follow-up question on a previous one.
Given that in ggplot2 and grid there are different linetypes and spacings vary between line sizes, what is their relationship?
There are two things I do not quite understand.
How is the line size defined? If I were to draw a straight vertical line and substitute it by a rectangle, what should be the width of the rectangle to get the equivalent of the line's size? Especially, how does the lwd = 1 or lwd = 10 I pass to par()/gpar() relate to absolute dimensions (pixels, mm, inches, points)?
The gpar() documentation refers to the par() documentation which states the following:
The line width, a positive number, defaulting to 1. The interpretation is device-specific, and some devices do not implement line widths less than one.
Which is fair enough but I couldn't really find the necessary device specific documentation for common devices.
I think I might assume that the spacings of different linetypes are proportional to their size, but how exactly are the 'dotdash', 'dashed', 'dotted' etc. proportions of dash-length to spacing-length defined?
In the plot below, how can I predict or calculate the dash/spacing lengths in advance?
library(ggplot2)
df <- data.frame(
x = rep(c(0, 1), 4),
y = rep(1:4, each = 2),
size = rep(c(2, 10), each = 4),
linetype = rep(c(2,2,3,3), 2)
)
# The `I()` function automatically assigns identity scales
ggplot(df, aes(x, y, size = I(size), linetype = I(linetype))) +
geom_line(aes(group = y))
I think this is mostly a documentation question, so I'd be happy if you could point me to the correct pages. Otherwise, an answer to my two questions above or a demonstration thereof would also be nice.
EDIT: ggplot has a variable called .pt which they use often to multiply a line size with. That probably means that in grid the linesize is something / .pt, but in what units?
Another great question Teunbrand. I have a partial answer here which seems to give valid results but feels a bit imprecise.
The obvious way to get conversion between lwd and length units is to measure them programatically. For example, to check the lwd of the X11 device, you can do this:
library(grid)
x11()
grid.newpage()
# draw a thick black line that goes right across the page
grid.draw(linesGrob(x = unit(c(-0.1, 1.1), "npc"),
y = unit(c(0.5, 0.5), "npc"),
gp = gpar(lwd = 10)))
# Capture as a bitmap
bmp_line <- dev.capture()
# Work out the thickness of the line in pixels as proportion of page height
lwd_10_prop <- sum(bmp_line != "white")/length(bmp_line)
# Now draw a black rectGrob of known height with lwd of 0 and transparent for completeness
grid.newpage()
grid.draw(rectGrob(width = unit(1.1, "npc"),
height = unit(10, "mm"),
gp = gpar(lwd = 0, col = "#00000000", fill = "black")))
# Capture as a bitmap and measure the width as proportion of device pixels
bmp_rect <- dev.capture()
mm_10_prop <- sum(bmp_rect != "white")/length(bmp_rect)
# Get the ratio of lwd to mm
lwd_as_mm <- lwd_10_prop / mm_10_prop
dev.off()
lwd_as_mm
#> [1] 0.2702296
Which tells us that an lwd of 1 is 0.2702296 mm on this device
We can test this by plotting a red rectangle of our calculated width over a green line near the top of our page, then plotting the same green line over the same red rectangle near the bottom of the page. If and only if they are exactly the same width will we have a completely green line and a completely red line on our page:
grid.newpage()
grid.draw(linesGrob(x = unit(c(-0.1, 1.1), "npc"),
y = unit(c(0.75, 0.75), "npc"),
gp = gpar(lwd = 5, col = "green")))
grid.draw(rectGrob(y = unit(0.75, "npc"),
width = unit(1.1, "npc"),
height = unit(5 * lwd_as_mm, "mm"),
gp = gpar(lwd = 0, col = "#00000000", fill = "red")))
grid.draw(rectGrob(y = unit(0.25, "npc"),
width = unit(1.1, "npc"),
height = unit(5 * lwd_as_mm, "mm"),
gp = gpar(lwd = 0, col = "#00000000", fill = "red")))
grid.draw(linesGrob(x = unit(c(-0.1, 1.1), "npc"),
y = unit(c(0.25, 0.25), "npc"),
gp = gpar(lwd = 5, col = "green")))
Of course, we can improve precision by increasing the thickness of our lines when measuring how wide they are in pixels.
Although the result is supposed to be device-independent, it's worth noting that in the above example I took the results from the X11 device but plotted them in the rstudio device, so the equivalence seems to hold for both devices.

grid: stretching and rotating a raster

I have a matrix that would like to display as a raster, in a 45 degree rotated fashion and it should stretch along the x- and y- directions to fit the graphics device.
Questions that I've found that are somewhat related are here, here and here, but don't adress the stretching part.
Here is an example an unrotated raster that stretches with the graphics window:
library(grid)
# Make dummy raster
set.seed(1234)
x <- cumsum(rnorm(10))
x <- x %*% t(x)
x <- scales::rescale(x)
grid.newpage()
grid.raster(x, interpolate = F,
width = unit(1, "npc"),
height = unit(1, "npc"))
I can rotate this raster 45 degrees by adjusting the viewport. This works well if the aspect ratio of the graphics device is 1:1. However, this raster doesn't stretch if the graphics device is resized.
grid.newpage()
grid.rect(gp = gpar(col = "red")) # To illustrate boundaries
grid.raster(x, interpolate = F,
vp = viewport(angle = 45,
width = unit(1, "npc"),
height = unit(1, "npc")))
I can get the exact graphical output that I want by converting each pixel in the raster to polygons and applying a linear transformation to these coordinates.
df <- reshape2::melt(x)
# Convert pixels to vertex coordinates
coords <- matrix(
c(rep(df$Var1 - 0.5, 2),
rep(df$Var1 + 0.5, 2),
df$Var2 - 0.5,
rep(df$Var2 + 0.5, 2),
df$Var2 - 0.5),
ncol = 2
)
# Rotate coordinates
rotmat <- matrix(c(0.5, -1, 0.5, 1), ncol = 2)
coords <- t(rotmat %*% (t(coords)))
# Re-assemble data
df <- rbind(df, df, df, df)
df$Var1 <- scales::rescale(coords[, 1])
df$Var2 <- scales::rescale(coords[, 2])
df$id <- rep(seq_len(length(x)), 4)
df <- df[order(df$id), ]
grid.newpage()
grid.rect(gp = gpar(col = "red")) # To illustrate boundaries
grid.polygon(
x = df$Var1, y = df$Var2,
id = df$id,
gp = gpar(col = NA,
fill = rgb(df$value, df$value, df$value)[!duplicated(df$id)])
)
However, this seems like an inefficient way of doing this and it doesn't scale very well if the original raster gets quite large. Also, when exported to pngs and pdfs, you can sometimes notice the artifacts of these polygons. I would definitely like to stay within the realm of the grid package, because my end-goal is to build a ggplot2 geom that supports this rotation.
If there is no real solution within grid, that is fine as well, but I'd like to know. I'll just stick to the inefficient solution in that case.

ggplot2 geom_rug() produces different line length with wide plot

I posted this as follow up to a 'sibling' question with lattice (i.e. Lattice's `panel.rug` produces different line length with wide plot) but due to different graphical system it deserves to be separate.
When producing a wide plot in ggplot2 with margins that include geom_rug() from ggthemes, the length of the lines in rugged margins is longer in the y-axis than x-axis:
library(ggplot2)
library(ggthemes)
png(width=800, height=400)
ggplot(swiss, aes(Education, Fertility)) + geom_point() + geom_rug()
dev.off()
I would like those rug lines in x- and y-axes to be the same length regardless of the shape of a plot (note: right now the rug lines will only be the same length when the plot is square).
This followed hadley's current previous geom_rug code, but modified it to add (or subtract) an absolute amount for interior units of the rug-ticks. It's really an application of the grid::unit-function more than anything else, since it uses the fact that units can be added and subtracted with different bases. You could modify it to accept a "rug_len"-argument with a default of your choosing, say unit(0.5, "cm"). (Do need to remember to set the environment of the function, so that one closure, geom_rug2, can call the next closure, ggplot2::'+', correctly.)
geom_rug2 <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", sides = "bl", ...) {
GeomRug2$new(mapping = mapping, data = data, stat = stat, position = position, sides = sides, ...)
}
GeomRug2 <- proto(ggplot2:::Geom, {
objname <- "rug2"
draw <- function(., data, scales, coordinates, sides, ...) {
rugs <- list()
data <- coord_transform(coordinates, data, scales)
if (!is.null(data$x)) {
if(grepl("b", sides)) {
rugs$x_b <- segmentsGrob(
x0 = unit(data$x, "native"), x1 = unit(data$x, "native"),
y0 = unit(0, "npc"), y1 = unit(0, "npc")+unit(1, "cm"),
gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
)
}
if(grepl("t", sides)) {
rugs$x_t <- segmentsGrob(
x0 = unit(data$x, "native"), x1 = unit(data$x, "native"),
y0 = unit(1, "npc"), y1 = unit(1, "npc")-unit(1, "cm"),
gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
)
}
}
if (!is.null(data$y)) {
if(grepl("l", sides)) {
rugs$y_l <- segmentsGrob(
y0 = unit(data$y, "native"), y1 = unit(data$y, "native"),
x0 = unit(0, "npc"), x1 = unit(0, "npc")+unit(1, "cm"),
gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
)
}
if(grepl("r", sides)) {
rugs$y_r <- segmentsGrob(
y0 = unit(data$y, "native"), y1 = unit(data$y, "native"),
x0 = unit(1, "npc"), x1 = unit(1, "npc")-unit(1, "cm"),
gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
)
}
}
gTree(children = do.call("gList", rugs))
}
default_stat <- function(.) StatIdentity
default_aes <- function(.) aes(colour="black", size=0.5, linetype=1, alpha = NA)
guide_geom <- function(.) "path"
})
environment(geom_rug2) <- environment(ggplot)
p <- qplot(x,y)
p + geom_rug2(size=.1)
With your code creating a png I get:
I'm not sure if there's a way to control the rug segment length in geom_rug (I couldn't find one). However, you can create your own rug using geom_segment and hard-code the segment lengths or add some logic to programatically produce equal-length rug lines. For example:
# Aspect ratio
ar = 0.33
# Distance from lowest value to start of rug segment
dist = 2
# Rug length factor
rlf = 2.5
ggplot(swiss, aes(Education, Fertility)) + geom_point() +
geom_segment(aes(y=Fertility, yend=Fertility,
x=min(swiss$Education) - rlf*ar*dist, xend=min(swiss$Education) - ar*dist)) +
geom_segment(aes(y=min(swiss$Fertility) - rlf*dist, yend=min(swiss$Fertility) - dist,
x=Education, xend=Education)) +
coord_fixed(ratio=ar,
xlim=c(min(swiss$Education) - rlf*ar*dist, 1.03*max(swiss$Education)),
ylim=c(min(swiss$Fertility) - rlf*dist, 1.03*max(swiss$Fertility)))
Or if you just want to hard-code it:
ggplot(swiss, aes(Education, Fertility)) + geom_point() +
geom_segment(aes(y=Fertility, yend=Fertility,
x=min(swiss$Education) - 3, xend=min(swiss$Education) - 1.5)) +
geom_segment(aes(y=min(swiss$Fertility) - 6, yend=min(swiss$Fertility) - 3,
x=Education, xend=Education)) +
coord_cartesian(xlim=c(min(swiss$Education) - 3, 1.03*max(swiss$Education)),
ylim=c(min(swiss$Fertility) - 6, 1.03*max(swiss$Fertility)))
As of ggplot2 v3.2.0 you can pass a length argument to geom_rug() to specify the absolute length of the rug:
library(ggplot2)
library(ggthemes)
png(width=800, height=400)
ggplot(swiss, aes(Education, Fertility)) + geom_point() + geom_rug(length = unit(0.5,"cm"))
dev.off()
Delving into the structure of the ggplot grob:
Minor edit: updating to ggplot2 2.2.1
library(ggplot2)
p = ggplot(swiss, aes(Education, Fertility)) + geom_point() + geom_rug()
# Get the ggplot grob
gp = ggplotGrob(p)
# Set end points of rug segments
library(grid)
gp$grobs[[6]]$children[[4]]$children[[1]]$y1 = unit(0.03, "snpc")
gp$grobs[[6]]$children[[4]]$children[[2]]$x1 = unit(0.03, "snpc")
png(width=900, height=300)
grid.draw(gp)
dev.off()
Another under-the-hood solution. First, I get the ggplot grob, and then I use the editGrob function from the grid package. With editGrob, I simply name the grob to be edited; it's easier than having to follow the grob's structure all the way to the relevant parameters. Normally, editGrob can't see all of the ggplot grobs, but they can be exposed with grid.force().
library(ggplot2)
library(grid)
p = ggplot(swiss, aes(Education, Fertility)) + geom_point() + geom_rug()
# Get the ggplot grob
gp = ggplotGrob(p)
# Get names of relevant grobs.
# The grid.force function generates the gtable's at-drawing-time contents.
names.grobs = grid.ls(grid.force(gp))$name # We're interested in the children of rugs.gTree
segments = names.grobs[which(grepl("GRID.segments", names.grobs))]
# Check them out
str(getGrob(grid.force(gp), gPath(segments[1]))) # Note: y1 = 0.03 npc
str(getGrob(grid.force(gp), gPath(segments[2]))) # Note: x1 = 0.03 npc
# Set y1 and x1 to 0.03 snpc
gp = editGrob(grid.force(gp), gPath(segments[1]), y1 = unit(0.03, "snpc"))
gp = editGrob(grid.force(gp), gPath(segments[2]), x1 = unit(0.03, "snpc"))
png(width=900, height=300)
grid.draw(gp)
dev.off()

interaction with grob using grid and gridSVG

I actually have no idea with this does not work!
library(grid)
library(gridSVG)
grid.newpage()
vp <- viewport(width=0.7, height=0.7)
pushViewport(vp)
grid.rect(x = unit(0.5, "npc"), y = unit(0.5, "npc"),
width = unit(0.5, "npc"), height = unit(0.5, "npc"),
just = "centre", hjust = NULL, vjust = NULL,
default.units = "npc", name = "grid.rect.1",
gp=gpar(), draw = TRUE)
this works:
grid.garnish("grid.rect.1",onmousedown="alert('alert 1!')","pointer-events"="all")
grid.export("gridSVG1.svg")
this doesn't work
grid.garnish("grid.rect.1", onmouseover="allwhite()", redraw = TRUE)
grid.script("allwhite = function() {
anobject = document.getElementById('grid.rect.1.1');
anobject.setAttribute('style', 'fill:red');
}", name="allwhite")
grid.export("gridSVG2.svg") # saved to your current working directory
What I'm trying to achieve, is that the rectangle is filled with red if I'm hovering over the rectangle with my mouse.
Due to the fact, that this is my first encounter with js, I have to ask maybe this silly question. I'm aware of the fact, that I name the spline "grid.rect.1" but use "grid.rect.1.1" in the script part. This is just a matter of despair, due to the fact, that I realize that rect has this id, if I inspect the SVG object with Google Chrome.
I'm using Google Chrome (36.0.1985.125 m) to watch the SVG object and it seems that a somewhat simpler thing works
As always, any hint is appreciated.
I looks like you can't add attributes, so your rect needs a fill gpar. You'll also need to fix the id of the rect element. If you look at the source, you'll see that "grid.rect.1.1" is actually the grouping tag.
library(grid)
library(gridSVG)
grid.newpage()
vp <- viewport(width=0.7, height=0.7)
pushViewport(vp)
grid.rect(x = unit(0.5, "npc"), y = unit(0.5, "npc"),
width = unit(0.5, "npc"), height = unit(0.5, "npc"),
just = "centre", hjust = NULL, vjust = NULL,
default.units = "npc", name = "grid.rect.1",
gp=gpar(fill='white'), # add fill parameter
draw = TRUE)
grid.garnish("grid.rect.1", onmouseover="allwhite()", `pointer-events`='all')
grid.script("allwhite = function() {
anobject = document.getElementById('grid.rect.1.1.1');
anobject.setAttribute('style', 'fill:red');
}", name="allwhite")
grid.export("gridSVG2.svg")

How to use grid.gradientFill

I'm trying to use the function grid.gradientFill from the gridSVG package, but unfortunately I'm not able to see a gradient in my SVG output.
I'm not sure if my code is correct or my Browser does not work (Chrome: 35.0.1916.153 m), can you please give some advise?
Here is my R code:
library(grid)
library(gridSVG)
lg <- linearGradient(col = c("black", "white", "black"))
x <- c(0.2,0.2,0.35,0.5,0.65,0.8,0.8,0.65,0.5,0.35)
y <- c(0.5,0.6,0.61,0.7,0.81,0.8,0.7,0.71,0.6,0.51)
s <- c(0,0,-1,0,-1,0,0,-1,0,-1)
grid.newpage()
vp <- viewport(width=0.75, height=0.75)
pushViewport(vp)
grid.rect(gp=gpar(col="blue"))
pushViewport(viewport(layout.pos.col=1, layout.pos.row=1))
grid.rect(x = unit(0.5, "npc"), y = unit(0.5, "npc"),
width = unit(1, "npc"), height = unit(1, "npc"),
just = "centre",
default.units = "npc",
gp=gpar(col="green", fill = "blue"), draw = TRUE, name = "tom")
grid.xspline(x = x, y = y,shape=s, open=FALSE, gp=gpar(col=NA, fill="darkred"), name="spline")
grid.gradientFill("spline", lg)
grid.gradientFill("tom", lg)
grid.export("c:/#temp/somekindofgradient.SVG")
I'm very interested in giving the spline a gradient ...
Any hint is appreciated :-)
So, finally I found the solution :-)
If you want to use
grid.gradientFill(object, ...)
The object, in my question the grid.xspline(...) object called "spline" does not have to have a fill parameter, meaning ...
Replacing
grid.xspline(x = x, y = y,shape=s, open=FALSE, gp=gpar(col=NA, fill="darkred"), name="spline")
with
grid.xspline(x = x, y = y,shape=s, open=FALSE, gp=gpar(col=NA), name="spline")
And there is some beautiful gradient :-)

Resources