I am using R to create a number of small graphics that will be saved as PNG files, typically at 50x50 pixels, which for eventual use in a much larger image as icons or markers. As the content changes frequently, it is desirable that these be created programmatically rather than manually.
Because the content is also simple - a few characters of text and some numbers - the grid functions seemed like a straightforward way to tackle this. I don't know grid at all well as I typically use higher-level libraries such as ggplot2. The MRE below lays out what I have already achieved.
This generates output, but I am having problems linking the sizes and scales of viewport and the various grobs to the ultimate PNG file. What I get is the below, which is fine at first glance, but is a 480x480 pixel image, most of which is unused, with the central graphic taking up only a third of the width and height.
That seems logical given the viewport sizing (=.3), but if I enlarge the viewport, then presumably I have to enlarge the text and so on. (I know how to change the png() parameters to adjust the density, number of pixels and so on, but at this point the image itself is the issue.)
The question boils down to how to best generate a decent-quality 50x50 pixel PNG or SVG file from a graphic such as this, created in R, either using grid or some other approach.
library(grid)
grid.newpage()
png(bg = "transparent")
pushViewport(viewport(width=.3, height=.3, clip="off"))
grid.rect(gp=gpar(lty=0, fill="#008000"))
grid.text("15.5", x = unit(0.5, "npc"), y = unit(0.75, "npc"),
just = "center", hjust = NULL, vjust = NULL, rot = 0,
check.overlap = FALSE, default.units = "npc",
name = NULL, gp = gpar(fontsize=48), draw = TRUE, vp = NULL)
grid.text("13h 20m", x = unit(0.5, "npc"), y = unit(0.25, "npc"),
just = "center", hjust = NULL, vjust = NULL, rot = 0,
check.overlap = FALSE, default.units = "npc",
name = NULL, gp = gpar(fontsize=32), draw = TRUE, vp = NULL)
lg <- linesGrob(x = unit(c(0, 1), "npc"),
y = unit(c(0.5, 0.5), "npc"),
gp = gpar(lwd=2))
grid.draw(lg)
dev.off()
magic library may be helpful for that. I used your starting codes to create an empty png file.
library(grid)
grid.newpage()
png(bg = "transparent")
pushViewport(viewport(width=.3, height=.3, clip="off"))
dev.off()
Then I read that png file to put inside the magic codes as below. Actually, there may exist a way to put the png file directly into the magic in your R session without making temporary write - read works. However ,if you have got a lot of files to create and save as png, it is not so important to read an empty png file once. Since it can be used as for all new outputs.
library(magick)
img <- image_read("./desktop/Rplot001.png")
output <- img %>% image_background("#008000") %>% image_resize("50x50") %>%
image_annotate("15.5", size = 17, gravity = "north", location = "+1+4",color = "black", boxcolor = NULL) %>%
image_annotate("13h 20m", size = 11, gravity = "south", location = "+0+7",color = "black", boxcolor = NULL)
image_write(output, path = "./desktop/output.png", format = "png")
It gives a 50x50 png file,
Related
I want to add image on 3D plot which is shown on RGL Device. I try add image with annotation_raster() and annotation_custom() but image include be 3D, i expect it be flat. are there code can i use? Thanks..
I try this code but image include 3D, not flat.
image <- magick::image_read("image.png")
image <- rasterGrob(image, interpolate = TRUE,
width=unit(1.5,'cm'),
x = unit(1,"npc"), y = unit(1,"npc"),
hjust = 1, vjust=1)
map <- sf::st_read('map/map.shp', quiet = TRUE)
gg <- ggplot(map) +
geom_sf()+
geom_sf(aes(fill =AREA),linewidth=0.7,colour='black') +
scale_fill_gradient('Area',low='skyblue',high = 'dodgerblue4',na.value = 'white')+
annotation_custom(image)+
theme_bw()+
theme(axis.line = element_blank(),axis.title = element_blank(),
axis.ticks = element_blank(), axis.text = element_blank()
)
plot_gg(gg, height = 8.5, width = 9,
multicore = TRUE,windowsize = c(1050, 600),
offset_edges = TRUE)
capture output my code
There could be some alternatives. One approach that I have used in my work is to use ggimage::geom_image(aes(x = 20, y = 30, image= "image.png"), size = 1) (adjust those numbers according to your data and original image size) to replace annotation_custom(image). This will give a 2D image instead of a 3D image on 3D graph. It worked on my machine with my data.
If it does not work on your side, please provide your data (reproducible example) so I would be able to test it on my side.
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")
For an online tutorial accompanying a workshop, I would like to highlight the use of the grid package (especially how to work with viewports). For this, I would like to build a plot step by step (i.e. chunk by chunk). Between each of the steps/chunks I would like to include some ordinary text in order to explain each of the steps in more detail.
How can I tell knitr to not evaluate a chunk separately, but to start the evaluation where the previous chunk ended? Basically, rather than a new evaluation of the chunk I want to add to the result of the previous chunk.
In the below code what happens is that I get 2 plots in the .html output when knitting to html. The first one showing the resutls of the first chunk (a pink rectangle and some text) and the second showing the results of the second chunk (a blue rectangle). What I would like to achieve is two plots - the first one showing the results of the first chunk (as above) and the second plot showing the results of the first chunk + the results of the second chunk (the blue rectangle within the pink rectangle).
Basically, I would like to reproduce the behavior of the two code chunks when run in the R console. The blue rectangle should be placed in the pink rectangle and not be plotted separately.
Here's the first chunk
```{r grid first vp, tidy = FALSE}
library(grid)
grid.newpage()
## draw a rectangle around the root vp and provide some text
grid.rect()
grid.text("this is the root vp", x = 0.5, y = 1, just = c("centre", "top"))
vp <- viewport(x = 0.5, y = 0.5,
height = 0.5, width = 0.5,
just = c("centre", "centre"))
pushViewport(vp)
grid.rect(gp = gpar(fill = "pink"))
grid.text("this is our first vp", x = 0.5, y = 1, just = c("centre", "top"))
```
Then some explanatory text in between:
"Ok, so now we have created a viewport in the middle of the root viewport at x = 0.5 and y = 0.5 - just = c("centre", "centre") that is half the height and half the width of the original viewport - height = 0.5 and width = 0.5.
Afterwards we navigated into this viewport - pushViewport(vp) and then we have drawn a rectangle that fills the entire viewport and filled it in pink colour - grid.rect(gp = gpar(fill = "pink"))
Note that we didn't leave the viewport yet. This means, whatever we do now, will happen in the currently active viewport (the pink one). To illustrate this, we will simply repeat the exact same code from above once more (we're only going to change the fill colour so we see the change better)."
And here's the second chunk
```{r grid second vp, tidy = FALSE}
vp <- viewport(x = 0.5, y = 0.5,
height = 0.5, width = 0.5,
just = c("centre", "centre"))
pushViewport(vp)
grid.rect(gp = gpar(fill = "cornflowerblue"))
```
Any ideas how I could tell knitr to 'keep' whatever has been done in previous chunks and take this as the 'starting point' for the current chunk evaluation?
It is not documented, but this feature has been there for almost a year. To keep a graphical device open throughout the compilation, you can set
knitr::opts_knit$set(global.device = TRUE)
I thought it would be very rare for anybody to use this feature, but it seems I was wrong.
More documentation at: https://bookdown.org/yihui/rmarkdown-cookbook/global-device.html
You could use grid.grab() to capture the scene at the end of a chunk, draw it in the new chunk, and navigate to the last viewport (needs to be named). Unfortunately, knitr thinks grid.grab() should result in a new plot, I'm not sure how to fix that.
```{r first, tidy = FALSE}
library(grid)
grid.newpage()
## draw a rectangle around the root vp and provide some text
grid.rect()
grid.text("this is the root vp", x = 0.5, y = 1, just = c("centre", "top"))
vp <- viewport(x = 0.5, y = 0.5,
height = 0.5, width = 0.5,
just = c("centre", "centre"),
name="first")
pushViewport(vp)
grid.rect(gp = gpar(fill = "pink"))
grid.text("this is our first vp", x = 0.5, y = 1, just = c("centre", "top"))
scene <- grid.grab()
```
```{r second, tidy = FALSE, fig.keep='last'}
grid.draw(scene)
seekViewport("first")
vp <- viewport(x = 0.5, y = 0.5,
height = 0.5, width = 0.5,
just = c("centre", "centre"))
pushViewport(vp)
grid.rect(gp = gpar(fill = "cornflowerblue"))
```
Of course, from a practical point of view, it is much easier to re-run the code from the first chunk,
```{r second, tidy = FALSE}
<<first>>
vp <- viewport(x = 0.5, y = 0.5,
height = 0.5, width = 0.5,
just = c("centre", "centre"))
pushViewport(vp)
grid.rect(gp = gpar(fill = "cornflowerblue"))
```
It doesn't seem to be possible to rotate the labels of an xaxis using grid.xaxis(at=, lab=) by e.g. 90 degrees using a gpar-option.
Anybody knows a workaround apart from creating separate viewports and using grid.text()?
Try this,
grid.xaxis(seq(0,1,by=0.1), vp=viewport(y=1),
edits = gEdit(gPath="labels", rot=90))
Check this document: An Example of Interactive Graphics Editing in Grid
library("grid")
gxa <- xaxisGrob(at = 1:4/5, vp = viewport(w = 0.5, h = 0.01))
gxa <- editGrob(gxa, gPath = "labels", gp = gpar(col = "black"), rot=90)
grid.draw(gxa)
I'm looking for a way to control the line thickness of text plotted in R without having the dimensions of the characters change. Here's an example (not using R):
The middle word has a thickness of twice the top, yet the dimensions are the same (so no scaling happened). The bottom word is actually two words: a red word overlain on a heavy white word, to create color separation (especially useful for annotating a busy plot).
Here's a set of commands I threw together to try and replicate the figure above:
png("font.png",width=1.02, height=1.02, units="in", res=150)
par(ps=10, font=1, bg="light gray", col="black", mai=rep(0.02,4), pin=c(1,1))
plot.new()
box()
text(0.5,0.85,"FONT",cex=1)
text(0.5,0.6,"FONT",cex=2)
text(0.5,0.3,"FONT",cex=2,col="white")
text(0.5,0.3,"FONT",cex=1,col="red")
text(0.5,0.1,"FONT",cex=1, font=2, col="white")
text(0.5,0.1,"FONT",cex=1, font=1, col="red")
dev.off()
giving:
So the effect is the same as changing the font-face to bold, but the size difference is not big enough to be noticeable when overlain. The par help page doesn't appear to have a specific setting for this. Anyone have any ideas?
Note changing size in ggplot2 doesn't produce the effect I want either, last time I checked.
You could try adding multiple versions of the text slightly shifted in a circular pattern,
library(grid)
stextGrob <- function (label, r=0.02, x = unit(0.5, "npc"), y = unit(0.5, "npc"),
just = "centre", hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE,
default.units = "npc", name = NULL, gp = gpar(), vp = NULL){
let <- textGrob("a", gp=gp, vp=vp)
wlet <- grobWidth(let)
hlet <- grobHeight(let)
tg <- textGrob(label=label, x=x, y=y, gp=gpar(col="red"),
just = just, hjust = hjust, vjust = vjust, rot = rot,
check.overlap = check.overlap,
default.units = default.units)
tgl <- c(lapply(seq(0, 2*pi, length=36), function(theta){
textGrob(label=label,x=x+cos(theta)*r*wlet,
y=y+sin(theta)*r*hlet, gp=gpar(col="white"),
just = just, hjust = hjust, vjust = vjust, rot = rot,
check.overlap = check.overlap,
default.units = default.units)
}), list(tg))
g <- gTree(children=do.call(gList, tgl), vp=vp, name=name, gp=gp)
}
grid.stext <- function(...){
g <- stextGrob(...)
grid.draw(g)
invisible(g)
}
grid.newpage()
grid.rect(gp=gpar(fill="grey"))
grid.stext("Yeah", gp=gpar(cex=4))
There's a version using base graphics lurking in the archives of R-help, from which this is inspired.
Another option using a temporary postscript file, converted to a shape by grImport,
library(grImport)
cat("%!PS
/Times-Roman findfont
100 scalefont
setfont
newpath
0 0 moveto
(hello) show", file="hello.ps")
PostScriptTrace("hello.ps", "hello.xml")
hello <- readPicture("hello.xml")
grid.rect(gp=gpar(fill="grey"))
grid.picture(hello,use.gc = FALSE, gp=gpar(fill="red", lwd=8, col="white"))
I imagine something similar could be done with a temporary raster graphic file, blurred by some image processing algorithm and displayed as raster below the text.
You could try:
text(...,"FONT", vfont = c('serif','bold'))
Although I'm not sure how you'd do the third version of FONT.