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 :-)
Related
These are the codes from the book "R Graphic"(Third Edition).
library(grid)
pushViewport(plotViewport(c(5,4,2,2)))
pushViewport(dataViewport(pressure$temperature,
pressure$pressure,
name = "plotRegion"))
grid.rect()
grid.xaxis()
grid.yaxis()
grid.points(pressure$temperature, pressure$pressure,
name = "dataSymbols")
grid.text("temperature", y = unit(-3, "line"))
grid.text("pressure", x = unit(-3, "line"), rot = 90)
#modify
grid.edit("dataSymbols", pch = 2)
upViewport(2)
grid.rect(gp = gpar(lty = "dashed"),draw = 1)
I am studying the grid package, and I am confused about the use of the grid.rect() function. My R version is 3.6.0.
The grid.rect function will always cover the previous image, what's the matter?
I really like the aesthetics of The Economist magazine and I use the theme_economist often. However, I am curious as to how they create the red lines in the top left in a lot of their charts. See image below and where I circled.
This question is a mix of "how to annotate outside the plot area" and "how to annotate in npc coordinates". Therefore, I offer two options.
Both unfortunately require a bit of trial and error in order to correctly place the segment. For option 1, it is the y coordinate which we have to "guess", and for option 2 it's x!
In order to make y slightly less guess work, I tried an approach to position is relative to the default axis breaks. using the fabulous information from this answer. This is of course not necessary, one can also simply trial and error.
For option 2, I modified a function from user Allan Cameron's answer here. He mentions a way to figure out x and y, I guess one could use the title, and then place the annotation based on that.
library(ggplot2)
p <-
ggplot(mtcars, aes(mpg, wt)) +
geom_point() +
ggtitle("lorem ipsum") +
theme(plot.margin = margin(t = 1.5, unit = "lines")) # this is always necessary
# OPTION 1
# semi-programmatic approach to figure out y coordinates
y_defaultticks <- with(mtcars, labeling::extended(range(wt)[1], range(wt)[2], m = 5))
y_default <- y_defaultticks[2] - y_defaultticks[1]
y_seg <- max(mtcars$wt) + 0.75 * y_default
p +
annotate(geom = "segment", x = - Inf, xend = 12, y = y_seg, yend = y_seg,
color = "red", size = 5) +
coord_cartesian(clip = "off", ylim = c(NA, max(mtcars$wt)),
xlim = c(min(mtcars$mpg), NA))
# OPTION 2
annotate_npc <- function(x, y, height, width, ...) {
grid::grid.draw(grid::rectGrob(
x = unit(x, "npc"), y = unit(y, "npc"), height = unit(height, "npc"), width = unit(width, "npc"),
gp = grid::gpar(...)
))
}
p
annotate_npc(x = 0.07, y = 1, height = 0.05, width = 0.05, fill = "red", col = NA)
Created on 2021-01-02 by the reprex package (v0.3.0)
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()
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")
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.