Related
I'm currently working on a ggplot column chart and I'm trying to add a logo to the bottom right. This is the code to the chart:
df <- data.frame(Names = c("2001", "2004", "2008", "2012", "2018"),
Value = c(47053, 68117, 171535, 241214, 234365))
p <- ggplot(df, aes(x = Names, y = Value)) +
geom_col(fill = "#DB4D43") + theme_classic() +
geom_text(aes(label = Value, y = Value + 0.05),
position = position_dodge(0.9),
vjust = 0)
I followed this tutorial I found online, but for some reason, it won't let me adjust the size of the logo and it ends up looking too small no matter what I type on the image_scale function.
img <- image_read("Logo.png")
img <- image_scale(img,"200")
img <- image_scale(img, "x200")
g <- rasterGrob(img)
size = unit(4, "cm")
heights = unit.c(unit(1, "npc") - size,size)
widths = unit.c(unit(1, "npc") - size, size)
lo = grid.layout(2, 2, widths = widths, heights = heights)
grid.show.layout(lo)
grid.newpage()
pushViewport(viewport(layout = lo))
pushViewport(viewport(layout.pos.row=1:1, layout.pos.col = 1:2))
print(p, newpage=FALSE)
popViewport()
pushViewport(viewport(layout.pos.row=2:2, layout.pos.col = 2:2))
print(grid.draw(g), newpage=FALSE)
popViewport()
g = grid.grab()
grid.newpage()
grid.draw(g)
rm(list=ls())
I found another tutorial and, after trying this, it doesn't show anything at all when I run it.
mypng <- readPNG('Logo.png')
print(mypng)
logocomp <- p + annotation_raster(mypng, ymin = 4.5,ymax= 5,xmin = 30,xmax = 35)
You could use the cowplot package to easily add an image to any plot made with ggplot. I used the R logo as the image that needs to be added to the plot (using magick package to read it). One advantage of using cowplot is that you can easily specify the size and position of both the plot and the image.
library(cowplot)
library(magick)
img <- image_read("Logo.png")
# Set the canvas where you are going to draw the plot and the image
ggdraw() +
# Draw the plot in the canvas setting the x and y positions, which go from 0,0
# (lower left corner) to 1,1 (upper right corner) and set the width and height of
# the plot. It's advisable that x + width = 1 and y + height = 1, to avoid clipping
# the plot
draw_plot(p,x = 0, y = 0.15, width = 1, height = 0.85) +
# Draw image in the canvas using the same concept as for the plot. Might need to
# play with the x, y, width and height values to obtain the desired result
draw_image(img,x = 0.85, y = 0.02, width = 0.15, height = 0.15)
Try using grid.raster, something like:
grid::grid.raster(img, x = 0.15, y = 0.05, width = unit(0.5, 'inches'))
x and y to define location of the image.
Adjust the number in unit() to resize the plot.
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.
I need to draw a rectangle on my diagram to highlight different changes. I need to use grid package. I tried to use the grid.rect but it doesn't work. I want that my rectangle looks like on the picture.
On the left part of the picture you can see my diagram and of the right part of the picture I've added the rectangle (in Paint) like I want it will be.
library(grid)
library(lattice)
library(sandwich)
data("Investment")
Investment <- as.data.frame(Investment)
trellis.par.set(theme = canonical.theme("postscript", color=FALSE))
grid.newpage()
pushViewport(viewport(x=0, width=.4, just="left"))
print(barchart(table(Investment$Interest)),
newpage=FALSE)
popViewport()
pushViewport(viewport(x=.4, width=.5, just="left"))
print(xyplot(Investment ~ Price, data=Investment,
auto.key=list(space="right"),
par.settings=list(superpose.symbol=list(pch=c(1, 3, 16),
fill="white"))),
newpage=FALSE)
popViewport()
It is not completely clear where you are trying to draw the rectangle, but the code below will add the rectangle to approximately match your picture. You can tune the position.
Use your code just as you had it. I will start by repeating your print statement and then adding the rectangle.
print(xyplot(Investment ~ Price, data=Investment,
auto.key=list(space="right"),
par.settings=list(superpose.symbol=list(pch=c(1, 3, 16),
fill="white"))),
newpage=FALSE)
grid.rect(x = unit(0.42, "npc"), y = unit(0.35, "npc"),
width = unit(0.2, "npc"), height = unit(0.2, "npc"),
gp=gpar(col="red"))
popViewport()
I'm using the code below to generate the following chart.
# Setup
data(airquality)
# Device start
png(filename = "example.png", units = "cm", width = 20, height = 14, res = 300)
# Define chart
pairs.chrt <- ggpairs(airquality,
lower = list(continuous = "smooth"),
diag = list(continuous = "blank"),
upper = list(continuous = "blank")) +
theme(legend.position = "none",
panel.grid.major = element_blank(),
axis.ticks = element_blank(),
axis.title.x = element_text(angle = 180, vjust = 1, color = "black"),
panel.border = element_rect(fill = NA))
# Device off and print
print(pairs.chrt)
dev.off()
I'm currently trying to modify the display of the axis titles. In particular, I would like for the axis titles to be:
Placed at a further distance from axis labels
Placed at an angle
As an example, I would like to obtain axis titles similar to the ones pictured below (I'm interested in axis labels only, not in rest of the chart):
Taken from : Geovisualist
I' tried adjusting my syntax changing the axis.title.x to different values but it does not yield the desired results. For instance running the code with angle = 45.
axis.title.x = element_text(angle = 45, vjust = 1, color = "black"),
panel.border = element_rect(fill = NA))
returns the same chart. I was able to control the axis labels by changing the axis.text.x for instance but I can't find the answer how to control the axis titles in this plot. Any help will be much appreciated.
Short answer: There doesn't seem to be an elegant or easy way to do it, but here's a workaround.
I dug into the ggpairs source code (in the GGally package source available from CRAN) to see how the variable labels are actually drawn. The relevant function in ggpairs.R is print.ggpairs. It turns out the variable labels aren't part of the ggplot objects in each cell of the plot matrix -- i.e. they're not axis titles, which is why they aren't affected by using theme(axis.title.x = element_text(angle = 45) or similar.
Rather, they seem to be drawn as text annotations using grid.text (in package 'grid'). grid.text takes arguments including x, y, hjust, vjust, rot (where rot is angle of rotation), as well as font size, font family, etc. using gpar (see ?grid.text), but it looks like there is currently no way to pass in different values of those parameters to print.ggpairs -- they're fixed at default values.
You can work around it by leaving your variable labels blank to begin with, and then adding them on later with customized placement, rotation, and styling, using a modification of the relevant part of the print.ggpairs code. I came up with the following modification. (Incidentally, because the original GGally source code was released under a GPL-3 license, so is this modification.)
customize.labels <- function(
plotObj,
varLabels = NULL, #vector of variable labels
titleLabel = NULL, #string for title
leftWidthProportion = 0.2, #if you changed these from default...
bottomHeightProportion = 0.1, #when calling print(plotObj),...
spacingProportion = 0.03, #then change them the same way here so labels will line up with plot matrix.
left.opts = NULL, #see pattern in left.opts.default
bottom.opts = NULL, #see pattern in bottom.opts.default
title.opts = NULL) { #see pattern in title.opts.default
require('grid')
vplayout <- function(x, y) {
viewport(layout.pos.row = x, layout.pos.col = y)
}
numCol <- length(plotObj$columns)
if (is.null(varLabels)) {
varLabels <- colnames(plotObj$data)
#default to using the column names of the data
} else if (length(varLabels) != numCol){
stop('Length of varLabels must be equal to the number of columns')
}
#set defaults for left margin label style
left.opts.default <- list(x=0,
y=0.5,
rot=90,
just=c('centre', 'centre'), #first gives horizontal justification, second gives vertical
gp=list(fontsize=get.gpar('fontsize')))
#set defaults for bottom margin label style
bottom.opts.default <- list(x=0,
y=0.5,
rot=0,
just=c('centre', 'centre'),#first gives horizontal justification, second gives vertical
gp=list(fontsize=get.gpar('fontsize')))
#set defaults for title text style
title.opts.default <- list(x = 0.5,
y = 1,
just = c(.5,1),
gp=list(fontsize=15))
#if opts not provided, go with defaults
if (is.null(left.opts)) {
left.opts <- left.opts.default
} else{
not.given <- names(left.opts.default)[!names(left.opts.default) %in%
names(left.opts)]
if (length(not.given)>0){
left.opts[not.given] <- left.opts.default[not.given]
}
}
if (is.null(bottom.opts)) {
bottom.opts <- bottom.opts.default
} else{
not.given <- names(bottom.opts.default)[!names(bottom.opts.default) %in%
names(bottom.opts)]
if (length(not.given)>0){
bottom.opts[not.given] <- bottom.opts.default[not.given]
}
}
if (is.null(title.opts)) {
title.opts <- title.opts.default
} else{
not.given <- names(title.opts.default)[!names(title.opts.default) %in%
names(title.opts)]
if (length(not.given)>0){
title.opts[not.given] <- title.opts.default[not.given]
}
}
showLabels <- TRUE
viewPortWidths <- c(leftWidthProportion,
1,
rep(c(spacingProportion,1),
numCol - 1))
viewPortHeights <- c(rep(c(1,
spacingProportion),
numCol - 1),
1,
bottomHeightProportion)
viewPortCount <- length(viewPortWidths)
if(!is.null(titleLabel)){
pushViewport(viewport(height = unit(1,"npc") - unit(.4,"lines")))
do.call('grid.text', c(title.opts[names(title.opts)!='gp'],
list(label=titleLabel,
gp=do.call('gpar',
title.opts[['gp']]))))
popViewport()
}
# viewport for Left Names
pushViewport(viewport(width=unit(1, "npc") - unit(2,"lines"),
height=unit(1, "npc") - unit(3, "lines")))
## new for axis spacingProportion
pushViewport(viewport(layout = grid.layout(
viewPortCount, viewPortCount,
widths = viewPortWidths, heights = viewPortHeights
)))
# Left Side
for(i in 1:numCol){
do.call('grid.text',
c(left.opts[names(left.opts)!='gp'],
list(label=varLabels[i],
vp = vplayout(as.numeric(i) * 2 - 1 ,1),
gp=do.call('gpar',
left.opts[['gp']]))))
}
popViewport()# layout
popViewport()# spacing
# viewport for Bottom Names
pushViewport(viewport(width=unit(1, "npc") - unit(3,"lines"),
height=unit(1, "npc") - unit(2, "lines")))
## new for axis spacing
pushViewport(viewport(layout = grid.layout(
viewPortCount, viewPortCount,
widths = viewPortWidths, heights = viewPortHeights)))
# Bottom Side
for(i in 1:numCol){
do.call('grid.text',
c(bottom.opts[names(bottom.opts)!='gp'],
list(label=varLabels[i],
vp = vplayout(2*numCol, 2*i),
gp=do.call('gpar',
bottom.opts[['gp']]))))
}
popViewport() #layout
popViewport() #spacing
}
And here's an example of calling that function:
require('data.table')
require('GGally')
require('grid')
fake.data <- data.table(test.1=rnorm(50), #make some fake data for demonstration
test.2=rnorm(50),
test.3=rnorm(50),
test.4=rnorm(50))
g <- ggpairs(data=fake.data,
columnLabels=rep('', ncol(fake.data)))
#Set columnLabels to a vector of blank column labels
#so that original variable labels will be blank.
print(g)
customize.labels(plotObj=g,
titleLabel = 'Test plot', #string for title
left.opts = list(x=-0.5, #moves farther to the left, away from vertical axis
y=0.5, #centered with respect to vertical axis
just=c('center', 'center'),
rot=90,
gp=list(col='red',
fontface='italic',
fontsize=12)),
bottom.opts = list(x=0.5,
y=0,
rot=45, #angle the text at 45 degrees
just=c('center', 'top'),
gp=list(col='red',
fontface='bold',
fontsize=10)),
title.opts = list(gp=list(col='green',
fontface='bold.italic'))
)
(This makes some very ugly labels -- for the purposes of demonstration only!)
I didn't tinker with placing the labels somewhere other than the left and bottom -- as in your Geovisualist example -- but I think you'd do it by changing the arguments to vplayout in the "Left Side" and "Bottom Side" pieces of code in customize.labels. The x and y coordinates in grid.text are defined relative to a viewport, which divides the display area into a grid in
pushViewport(viewport(layout = grid.layout(
viewPortCount, viewPortCount,
widths = viewPortWidths, heights = viewPortHeights
)))
The call to vplayout specifies which cell of the grid is being used to position each label.
Caveat: not a complete answer but perhaps suggests a way to approach it. You can do this by editing the grid objects.
# Plot in current window
# use left to add space at y axis and bottom for below xaxis
# see ?print.ggpairs
print(pairs.chrt, left = 1, bottom = 1)
# Get list of grobs in current window and extract the axis labels
# note if you add a title this will add another text grob,
# so you will need to tweak this so not to extract it
g <- grid.ls(print=FALSE)
idx <- g$name[grep("text", g$name)]
# Rotate yaxis labels
# change the rot value to the angle you want
for(i in idx[1:6]) {
grid.edit(gPath(i), rot=0, hjust=0.25, gp = gpar(col="red"))
}
# Remove extra ones if you want
n <- ncol(airquality)
lapply(idx[c(1, 2*n)], grid.remove)
My answer won't fix the diagonal label issue but it will fix the overlay one.
I had this issue with the report I am currently writing, where the axis titles were always over the axes, especially in ggpairs. I used a combination of adjusting the out.height/out.width in conjunction with fig.height/fig.width. Separately the problem was not fixed, but together it was. fig.height/fig.width took the labels away from the axis but made them too small to read, and out.height/out.width just made the plot bigger with the problem unchanged. The below gave me the results shown:
out.height="400px", out.width="400px",fig.height=10,fig.width=10
before:plot with issues
after:
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.