Related
I'm trying to use the rayshader package in R to produce an elevation plot with points on the surface (or floating just above) that represent where samples were taken. However, I can't seem to get the points to show up on the map, or when they do, they don't show up where I expect them.
Here's a toy example:
library(raster)
set.seed(1)
x <- raster(ncol=50, nrow=50, xmn=-1, xmx=1, ymn=-1, ymx=1)
res(x) <- .5
x[] <- rnorm(16, -5, 10)
fakepoints <- data.frame(x = c(0, -.5),
y = c(0, 0))
fakepoints$elev <- (raster::extract(x, fakepoints))
x_dat <- data.frame(rasterToPoints(x, spatial = T))
library(rayshader)
library(ggplot2)
e_mat = raster_to_matrix(x)
a <- ggplot()+
geom_tile(data =x_dat, aes(x =x, y = y, fill = layer ))+
scale_fill_gradientn(colors = rev(topo.colors(10)))
height <- plot_gg(a, multicore = TRUE, raytrace = TRUE, width = 7, height = 4,
scale = 300, windowsize = c(1400, 866), zoom = .5, theta = 30, max_error = 0.001,save_height_matrix = T)
render_points(extent = attr(x,"extent"),
size = 10,
color = "black",
heightmap = height,
altitude = fakepoints$elev+.1,
zscale = 1,
offset = 0,
lat = fakepoints$y, long = fakepoints$x,
clear_previous = T)
The points should show up at (0,0) and (-.5, 0), but I can't see to make them appear anywhere.
I want to write multiple pieces of information in each y-axis label of a ggplot bar chart (or any similar kind of plot). The problem is having everything aligned nicely.
It's probably best explained with an example for what I want to have:
My primary issue is the formatting on the left side of the figure.
What I've tried so far includes using monospace fonts to write the labels. This basically works but I want to try and avoid the use of monospace fonts for aesthetic purposes.
I've also tried making several ggplots where the idea was to remove everything in two initial plots, except for the y-axis labels (so these "plots" would only be the y-axis labels). Then align the plots next to each other using grid.align. The problem I have here is that there doesn't seem to be a way to remove the plot part of a ggplot (or is there?). It also requires some tweaking since removing x-axis labels in one of the "empty" plots would result in the labels moving down (since no space is occupied by the x-axis labels/title anymore).
I've also tried an approach using geom_text and setting the appropriate distances using the hjust parameter. However, for some reason, the spacing does not seem to be equal for the different size labels (for example distances for the "Red" and "Turquoise" labels are different for the same hjust). As the real data has many more variations in label sizes this variation makes the table look very messy...
I'm not too concerned about the headers since they are easy to add to the figure manually. The values on the right are also not too much of a problem since they have a fixed width and I can use geom_text to set them. So my main problem is with the y-axis (left) labels.
Here's an example data set:
dt = data.frame(shirt = c('Red','Turquoise','Red','Turquoise','Red','Turquoise','Red','Turquoise'),
group = c('Group alpha','Group alpha','Group beta','Group beta','Group delta','Group delta','Group gamma','Group gamma'),
n = c(22,21,15,18,33,34,20,19),
mean = c(1, 4, 9, 2, 4, 5 , 1, 2),
p = c(0.1, 0.09, 0.2, 0.03, 0.05, 0.99, 0.81, 0.75))
The closest I could come to is to use guide_axis_nested() from ggh4x for formatting the left part. (Disclaimer: I'm the author of ggh4x). With this axis, you can't align spanning categories (e.g group) to the top, nor have titles for the different levels.
library(ggplot2)
library(ggh4x)
# Create some dummy data
df <- expand.grid(
group = paste("Group", c("alpha", "beta", "delta", "gamma")),
shirt = c("Red", "Turquoise")
)
df$N <- sample(1:100, nrow(df))
df$mean <- rlnorm(nrow(df), meanlog = 1)
df$pvalue <- runif(nrow(df))
ggplot(df, aes(x = mean, y = interaction(N, shirt, group, sep = "&"))) +
geom_col() +
guides(
y = guide_axis_nested(delim = "&"),
y.sec = guide_axis_manual(
breaks = interaction(df$N, df$shirt, df$group, sep = "&"),
labels = scales::number(df$pvalue, 0.001)
)
) +
theme(
axis.text.y.left = element_text(margin = margin(r = 5, l = 5)),
ggh4x.axis.nesttext.y = element_text(margin = margin(r = 5, l = 5)),
ggh4x.axis.nestline = element_blank()
)
Created on 2021-11-16 by the reprex package (v1.0.0)
I think #teunbrand provided a very neat solution and code-wise a lot cleaner than mine. However, I also tried another approach using annotation_custom() (based on this answer in another question). The result is quite nice and it should be fairly easy to customize.
dt = data.frame(shirt = c('Red','Turquoise','Red','Turquoise','Red','Turquoise','Red','Turquoise'),
group = c('Group alpha','Group alpha','Group beta','Group beta','Group delta','Group delta','Group gamma','Group gamma'),
n = c(22,21,15,18,33,34,20,19),
lvls = c(1,2,3,4,5,6,7,8),
mean = c(1, 4, 9, 2, 4, 5 , 1, 2),
p = c(0.1, 0.09, 0.2, 0.03, 0.05, 0.99, 0.81, 0.75))
dt$groups = paste(dt$group, dt$shirt)
dt$groups = factor(dt$groups, levels=rev(dt$groups))
p2 = ggplot(dt) +
geom_col(aes(x=groups, y=mean)) +
coord_flip(clip='off') +
theme_bw() +
theme(axis.text.y = element_blank(),
axis.title.y = element_blank(),
plot.margin = unit(c(0.5,1,0,3.5), "in") # top, right, bottom, left
)
# Compute the position on the X axis for each information column
# I wanted fixed widths for the margins, so I basically compute what the X value
# would be on a specific location of the figure.
x_size = ggplot_build(p2)$layout$panel_params[[1]]$x.range[2] - ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] # length of x-axis
p_width = par()$din[1] - 4.5 # width of plot minus the margins as defined above in: plot.margin = unit(c(0.5,1,0,3.5), "in")
rel_x_size = p_width / x_size # size of one unit X in inch
col1_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] - (3 / rel_x_size) # the Group column, 3 inch left of the start of the plot
col2_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] - (1.5 / rel_x_size) # the Shirt column, 1.5 inches left of the start of the plot
col3_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] - (0.25 / rel_x_size) # the N column, 0.25 inches left of the start of the plot
col4_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[2] + (0.2 / rel_x_size) # the P-val column, 0.2 inches right of the end of the plot
# Set the values for each "row"
i_range = 1:nrow(dt)
i_range_rev = rev(i_range) # Because we reversed the order of the groups
for (i in i_range) {
if(i %% 2 == 0) {
# Group
p2 = p2 + annotation_custom(grob = textGrob(label = dt$group[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col1_x, ymax=col1_x,
xmin=i,xmax=i)
}
# Shirt
p2 = p2 + annotation_custom(grob = textGrob(label = dt$shirt[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col2_x, ymax=col2_x,
xmin=i,xmax=i)
# N
p2 = p2 + annotation_custom(grob = textGrob(label = dt$n[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col3_x, ymax=col3_x,
xmin=i,xmax=i)
# P-val
p2 = p2 + annotation_custom(grob = textGrob(label = dt$p[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col4_x, ymax=col4_x,
xmin=i,xmax=i)
}
# Add the headers
i = i+1
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('Group')), hjust = 0, gp = gpar()),
ymin=col1_x, ymax=col1_x,
xmin=i,xmax=i)
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('Shirt')), hjust = 0, gp = gpar()),
ymin=col2_x, ymax=col2_x,
xmin=i,xmax=i)
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('N')), hjust = 0, gp = gpar()),
ymin=col3_x, ymax=col3_x,
xmin=i,xmax=i)
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('P-val')), hjust = 0, gp = gpar()),
ymin=col4_x, ymax=col4_x,
xmin=i,xmax=i)
p2
Output:
What is basically done, is that margins for the figure are set in plot.margin in the initial plot. Some computation is then performed to determine the correct location for each column of information. Subsequently we loop through the data set and set the values in each column using annotation_custom(). Finally, we can add the headers in a similar manner.
Note: if you resize the plot window (in RStudio for example), you need to re-run the code otherwise the layout will be messed up.
I am creating a lot of charts programmatically in R using ggplot2 and have everything working perfectly except the position of bar labels.
This requires inputs of the plot height, y axis scale and text size.
Example (stripped down) plot code:
testInput <- data.frame("xAxis" = c("first", "second", "third"), "yAxis" = c(20, 200, 60))
# Changeable variables
yMax <- 220
plotHeight <- 5
textSize <- 4
# Set up labels
geomTextList <- {
textHeightRatio <- textSize / height
maxHeightRatio <- yMax / height
values <- testInput[["yAxis"]]
### THIS IS THE FORMULA NEEDING UPDATING
testInput[["labelPositions"]] <- values + 5 # # Should instead be a formula eg. (x * height) + (y * textSize) + (z * yMax)?
list(
ggplot2::geom_text(data = testInput, ggplot2::aes_string(x = "xAxis", y = "labelPositions", label = "yAxis"), hjust = 0.5, size = textSize)
)
}
# Create plot
outputPlot <- ggplot2::ggplot(testInput) +
ggplot2::geom_bar(data = testInput, ggplot2::aes_string(x = "xAxis", y = "yAxis"), stat = "identity", position = "dodge", width = 0.5) +
geomTextList +
ggplot2::scale_y_continuous(breaks = seq(0, yMax, yInterval), limits = c(0, yMax))
ggplot2::ggsave(filename = "test.png", plot = outputPlot, width = 4, height = plotHeight, device = "png")
I have tried various combinations of coefficients for the formula, but suspect that at leat one of the factors isn't linear. If this is purely a statistical problem, I could take it to Cross-Validation, but I wondered whether anyone had already solved this?
If your problem is with offsetting the text to not overlap the bar while dealing with varying text sizes, just use vjust which is already proportional to the text size. A value of 0 will make the bottom of the text touch the bar, and a small negative value will give you some space between them:
testInput <- data.frame("xAxis" = c("first", "second", "third"), "yAxis" = c(20, 200, 60))
# Changeable variables
yMax <- 220
plotHeight <- 5
textSize <- 4
# Set up labels
geomTextList <- {
values <- testInput[["yAxis"]]
testInput[["labelPositions"]] <- values # Use the exact value
list(
ggplot2::geom_text(
data = testInput,
# vjust provides proportional offset
ggplot2::aes_string(x = "xAxis", y = "labelPositions", label = "yAxis"),
hjust = 0.5, vjust = -0.15, size = textSize
)
)
}
# Create plot
outputPlot <- ggplot2::ggplot(testInput) +
ggplot2::geom_bar(data = testInput, ggplot2::aes_string(x = "xAxis", y = "yAxis"), stat = "identity", position = "dodge", width = 0.5) +
geomTextList +
ggplot2::scale_y_continuous(limits = c(0, yMax))
ggplot2::ggsave(filename = "test.png", plot = outputPlot, width = 4, height = plotHeight, device = "png")
Thanks to the excellent answer in "Combine a ggplot2 object with a lattice object in one plot" and some further thoughts I could plot a lattice plot next to a ggplot:
library(ggplot2)
library(lattice)
library(gtools)
library(plyr)
library(grid)
library(gridExtra)
set.seed(1)
mdat <- data.frame(x = rnorm(100), y = rnorm(100), veryLongName = rnorm(100),
cluster = factor(sample(5, 100, TRUE)))
cols <- c("x", "y", "veryLongName")
allS <- adply(combinations(3, 2, cols), 1, function(r)
data.frame(cluster = mdat$cluster,
var.x = r[1],
x = mdat[[r[1]]],
var.y = r[2],
y = mdat[[r[2]]]))
sc <- ggplot(allS, aes(x = x, y = y, color = cluster)) + geom_point() +
facet_grid(var.x ~ var.y) + theme(legend.position = "top")
sc3d <- cloud(veryLongName ~ x + y, data = mdat, groups = cluster)
scG <- ggplotGrob(sc)
sc3dG <- gridExtra:::latticeGrob(sc3d)
ids <- grep("axis-(l|b)-(1|2)|panel", scG$layout$name)
scG$grobs[ids[c(2, 5, 8)]] <- list(nullGrob(), nullGrob(), nullGrob())
grid.newpage()
grid.draw(scG)
pushViewport(viewport(0, 0, width = .515, height = .46,
just = c("left", "bottom")))
grid.rect()
grid.draw(sc3dG)
As you can see in the picture there is quite some margin around the lattice plot and on top of it the axis label for the z-axis is cut (which is not the case is I plot the lattice plot alone).
So how can I get rid of this behaviour, thus how to solve the follwing two problems:
Get rid of the inner margin between the viewport and the lattice plot
Avoid that the label in the lattice plot is cut.
I tried to play with the clip option of the viewport but without success. So, what to do?
Update 2020
Edited code and answer to reflect new naming convention in the grob.
those settings are probably somewhere in ?xyplot, but I find it's faster to read the internet,
theme.novpadding <-
list(layout.heights =
list(top.padding = 0,
main.key.padding = 0,
key.axis.padding = 0,
axis.xlab.padding = 0,
xlab.key.padding = 0,
key.sub.padding = 0,
bottom.padding = 0),
axis.line = list(col = 0),
clip =list(panel="off"),
layout.widths =
list(left.padding = 0,
key.ylab.padding = 0,
ylab.axis.padding = 0,
axis.key.padding = 0,
right.padding = 0))
sc3d <- cloud(veryLongName ~ x + y, data = mdat, groups = cluster,
par.settings = theme.novpadding )
scG <- ggplotGrob(sc)
sc3dG <- grobTree(gridExtra:::latticeGrob(sc3d),
rectGrob(gp=gpar(fill=NA,lwd=1.2)))
ids <- grep("axis-(l|b)-(1|2)|panel", scG$layout$name)
scG$grobs[ids[c(5, 2, 8)]] <- list(nullGrob(), sc3dG, nullGrob())
grid.newpage()
grid.draw(scG)
Is there any chance to write text which is "wrapped" around the circle? I mean something like this:
Yes, and here is the code, free of charge :-) . I wrote this a while back but I don't think ever published it in any CRAN package.
# Plot symbols oriented to local slope.
# Interesting problem: if underlying plot has some arbitrary aspect ratio,
# retrieve by doing: Josh O'B via SO:
# myasp <- with(par(),(pin[2]/pin[1])/(diff(usr[3:4])/diff(usr[1:2])))
# so make that the default value of argument 'asp'
# Default is 'plotx' is vector of indices at which to
# plot symbols. If is_indices=FALSE, only then turn to splinefun to
# calculate y-values and slopes; and user beware.
#
# 6 Feb 2014: added default col arg so can stick in a color vector if desired
# TODO
#
slopetext<-function(x,y,plotx, mytext, is_indices=TRUE, asp=with(par(), (pin[1]/pin[2])*(diff(usr[3:4])/diff(usr[1:2]))),offsetit= 0, col='black', ...) {
if (length(x) != length(y)) stop('data length mismatch')
if (!is.numeric(c(x,y,plotx) ) ) stop('data not numeric')
if(is_indices) {
# plotting at existing points.
if(any(plotx<=1) | any(plotx>= length(x))) {
warning("can't plot endpoint; will remove")
plotx<-plotx[(plotx>1 & plotx<length(x))]
}
lows<-plotx-1
highs<-plotx+1
# then interpolate low[j],high[j] to get slope at x2[j]
slopes <- (y[highs]-y[lows])/(x[highs]-x[lows]) #local slopes
# sign(highlow) fix the rotation problem
angles <- 180/pi*atan(slopes/asp) + 180*(x[lows] > x[highs] )
intcpts <- y[highs]-slopes*x[highs]
ploty <- intcpts + x[plotx]*slopes
# change name, so to speak, to simplify common plotting code
plotx<-x[plotx]
}else{
#interpolating at plotx values
if (any(plotx<min(x)) | any(plotx>max(x)) ) {
warning("can't plot extrapolated point; will remove")
plotx<-plotx[(plotx>min(x) & plotx<max(x))]
}
spf<-splinefun(x,y)
ploty<-spf(plotx)
angles <- 180/pi * atan(spf(plotx,1)/asp) #getting first deriv, i.e. slope
} #end of else
xlen<-length(plotx) # better match y and mytext
# The trouble is: srt rotates about some non-centered value in the text cell
# Dunno what to do about that.
dely <- offsetit*cos(angles)
delx <- offsetit*sin(angles)
# srt must be scalar
mytext<-rep(mytext,length=xlen)
col <- rep(col,length=xlen)
for (j in 1:xlen) text(plotx[j], ploty[j], labels=mytext[j], srt= angles[j], adj=c(delx,dely),col=col[j], ...)
}
Edit: per David's excellent suggestion, a sample case:
x <- 1:100
y <- x/20 + sin(x/10)
plot(x,y,t='l')
slopetext(x=x,y=y,plotx=seq(10,70,by=10),mytext=letters[1:8])
The third argument in this example selects every tenth value of (x,y) for placement of the text.
I should warn that I haven't idiot-proofed the is_indices=FALSE case and the spline fit may in extreme cases place your text in funny ways.
plotrix::arctext
library(plotrix)
# set up a plot with a circle
plot(x = 0, y = 0, xlim = c(-2, 2), ylim = c(-2, 2))
draw.circle(x = 0, y = 0, radius = 1)
# add text
arctext(x = "wrap some text", center = c(0, 0), radius = 1.1, middle = pi/2)
arctext(x = "counterclockwise", center = c(0, 0), radius = 1.1, middle = 5*pi/4,
clockwise = FALSE, cex = 1.5)
arctext(x = "smaller & stretched", center = c(0, 0), radius = 1.1, middle = 2*pi ,
cex = 0.8, stretch = 1.2)
circlize
For greater opportunities of customization, check the circlize package (see the circlize book). By setting facing = "bending" in circos.text, the text wraps around a circle.
library(circlize)
# create some angles, labels and their corresponding factors
# which determine the sectors
deg <- seq(from = 0, to = 300, by = 60)
lab <- paste("some text", deg, "-", deg + 60)
factors <- factor(lab, levels = lab)
# initialize plot
circos.par(gap.degree = 10)
circos.initialize(factors = factors, xlim = c(0, 1))
circos.trackPlotRegion(ylim = c(0, 1))
# add text to each sector
lapply(factors, function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending")
})
circos.clear()
From circlize version 0.2.1, circos.text has two new options: bending.inside which is identical to original bending and bending.outside (see Figure 3.4 in the circlize book). Thus, it is easy to turn the text in the bottom half of the plot using bending.outside:
circos.par(gap.degree = 10)
circos.initialize(factors = factors, xlim = c(0, 1))
circos.trackPlotRegion(ylim = c(0, 1))
lapply(factors[1:3], function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending.outside")
})
lapply(factors[4:6], function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending.inside")
})
circos.clear()
The figure in the question can now be recreated quite easily in ggplot using the geomtextpath package:
library(geomtextpath)
df <- data.frame(x = c(0, 5.5, 6, 5.2, 0, 0.5, 0) + 8 * rep(0:5, each = 7),
y = rep(c(0, 0, 1, 2, 2, 1, 0), 6) + 8,
id = rep(1:6, each = 7))
df2 <- data.frame(x = c(3, 11, 19, 27, 35, 43), y = 9, id = 1:6,
z = paste("text", 0:5 * 60))
ggplot(df, aes(x, y, group = id)) +
geom_polygon(fill = "red", color = "black") +
geom_hline(yintercept = 9, color = "red", alpha = 0.3, size = 7) +
geom_textpath(data = df2, aes(label = z), size = 7, upright = FALSE) +
ylim(c(0, 10)) +
xlim(c(0, 48)) +
coord_polar(theta = "x", direction = -1, start = -pi/4) +
theme_void()
Disclaimer: I'm co-author of said package.