I am trying to duplicate/mirror y-axis tick-marks of different sizes for the secondary y-axis using ggplot2 and gtable libraries.
I have successfully shortened minor tick-marks for the primary(left) y-axis by referring to this answer.
Now, I am trying to duplicate or mirror them on secondary(right) y-axis.
I have tried two approaches but neither has produced the desired result.
In the first approach I apply the same method I used for the left axis:
library("ggplot2")
require("scales")
library("ggthemes")
library("grid")
library("gtable")
labs = seq(0,100,10)
labs[!!((seq_along(labs)-1)%%5)] = ''
g <- ggplot(data.frame(x = 1:10, y = (1:10)^2), aes(x,y)) +
geom_point() +
scale_y_continuous(breaks = seq(0,100,10), labels = labs, sec.axis = dup_axis(name = NULL, labels = NULL)) +
theme(axis.ticks.length=unit(10, "pt"), plot.margin = margin(10, 16, 0, 12),panel.grid = element_blank())
gg <- ggplotGrob(g)
yaxisR <- gg$grobs[[which(gg$layout$name == "axis-r")]]
yaxisL <- gg$grobs[[which(gg$layout$name == "axis-l")]]
ticksR <- yaxisR$children[[2]]
ticksL <- yaxisL$children[[2]]
marksR <- ticksR$grobs[[1]]
marksL <- ticksL$grobs[[2]]
marksR$x[c(2:5,7:10)*2-1] <- unit(1, "npc") - unit(5, "pt")
marksL$x[c(2:5,7:10)*2-1] <- unit(1, "npc") - unit(5, "pt")
ticksR$grobs[[1]] <- marksR
ticksL$grobs[[2]] <- marksL
yaxisR$children[[2]] <- ticksR
yaxisL$children[[2]] <- ticksL
gg$grobs[[which(gg$layout$name == "axis-r")]] <- yaxisR
gg$grobs[[which(gg$layout$name == "axis-l")]] <- yaxisL
grid.newpage()
grid.draw(gg)
But the right axis tick-marks get shortened from the wrong side: first result
In the second approach I try to mirror the primary y-axis tick-marks by using this answer :
library("ggplot2")
require("scales")
library("ggthemes")
library("grid")
library("gtable")
labs = seq(0,100,10)
labs[!!((seq_along(labs)-1)%%5)] = ''
g <- ggplot(data.frame(x = 1:10, y = (1:10)^2), aes(x,y)) +
geom_point() +
scale_y_continuous(breaks = seq(0,100,10), labels = labs) +
theme(axis.ticks.length=unit(10, "pt"), plot.margin = margin(10, 16, 0, 12), panel.grid = element_blank())
gg <- ggplotGrob(g)
panel <-c(subset(gg$layout, name=="panel", se=t:r))
yaxisL <- gg$grobs[[which(gg$layout$name == "axis-l")]]
ticksL <- yaxisL$children[[2]]
marksL <- ticksL$grobs[[2]]
marksL$x[c(2:5,7:10)*2-1] <- unit(1, "npc") - unit(5, "pt")
ticksL$grobs[[2]] <- marksL
yaxisL$children[[2]] <- ticksL
gg$grobs[[which(gg$layout$name == "axis-l")]] <- yaxisL
gg <- gtable_add_cols(gg, unit(0, "lines"), panel$r)
gg <- gtable_add_grob(gg, marksL, t = panel$t, l = panel$r+1, name = "ticks")
gg$layout[gg$layout$name == "ticks", ]$clip = "off"
grid.newpage()
grid.draw(gg)
This way results in the right axis tick marks pointing in the wrong direction: second result
Is there anything I can do to either code to have both y-axises identical and mirroring each other? Thank you!
I tried a few things, and I'm not sure I understand it fully, but here is a solution:
The object marksR$x consist of 2 elements per tick line. I think these are the left and right ends of the line. Which means, you only have to add:
marksR$x[c(2:5,7:10)*2] <- unit(0, "npc")
While also keeping
marksR$x[c(2:5,7:10)*2-1] <- unit(1, "npc") - unit(5, "pt")
Which works for me
Related
Anybody knows how to draw the X-axis tickmarks at the top of a single plot in R, using ggplot2? I ve been looking at tutorials and mail lists and Rhelp without success.
Thanks in advance.
Agus
Use position = 'top'
library(ggplot2)
# Generate some data
df = data.frame(x = 1:10, y = 1:10)
# x-axis breaks
breaks = 1:10
# base plot
p <- ggplot(df, aes(x,y)) + geom_point() +
scale_x_continuous(breaks = breaks, position = 'top') +
scale_y_continuous(limits = c(0, 11), expand = c(0,0)) +
theme_bw()
Original solution available using gtable (with some updating to ggplot 2.1.0). See here
library(ggplot2)
library(gtable)
library(grid)
# Generate some data
df = data.frame(x = 1:10, y = 1:10)
# x-axis breaks
breaks = 1:10
# base plot
p <- ggplot(df, aes(x,y)) + geom_point() +
scale_x_continuous(breaks = breaks) +
scale_y_continuous(limits = c(0, 11), expand = c(0,0)) +
theme_bw()
# Get ggplot grob
g1 <- ggplotGrob(p)
## Get the position of the plot panel in g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))
# Title grobs have margins.
# The margins need to be swapped.
# Function to swap margins -
# taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
vinvert_title_grob <- function(grob) {
heights <- grob$heights
grob$heights[1] <- heights[3]
grob$heights[3] <- heights[1]
grob$vp[[1]]$layout$heights[1] <- heights[3]
grob$vp[[1]]$layout$heights[3] <- heights[1]
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$y <- unit(1, "npc") - grob$children[[1]]$y
grob
}
# Get xlab and swap margins
index <- which(g1$layout$name == "xlab-b")
xlab <- g1$grobs[[index]]
xlab <- vinvert_title_grob(xlab)
# Put xlab at the top of g1
g1 <- gtable_add_rows(g1, g1$heights[g1$layout[index, ]$t], pp$t-1)
g1 <- gtable_add_grob(g1, xlab, pp$t, pp$l, pp$t, pp$r, clip = "off", name="topxlab")
# Get x axis (axis line, tick marks and tick mark labels)
index <- which(g1$layout$name == "axis-b")
xaxis <- g1$grobs[[index]]
# Swap axis ticks and tick mark labels
ticks <- xaxis$children[[2]]
ticks$heights <- rev(ticks$heights)
ticks$grobs <- rev(ticks$grobs)
# Move tick marks
# Get tick mark length
plot_theme <- function(p) {
plyr::defaults(p$theme, theme_get())
}
tml <- plot_theme(p)$axis.ticks.length # Tick mark length
ticks$grobs[[2]]$y <- ticks$grobs[[2]]$y - unit(1, "npc") + tml
# Swap tick mark labels' margins and justifications
ticks$grobs[[1]] <- vinvert_title_grob(ticks$grobs[[1]])
# Put ticks and tick mark labels back into xaxis
xaxis$children[[2]] <- ticks
# Add axis to top of g1
g1 <- gtable_add_rows(g1, g1$heights[g1$layout[index, ]$t], pp$t)
g1 <- gtable_add_grob(g1, xaxis, pp$t+1, pp$l, pp$t+1, pp$r, clip = "off", name = "axis-t")
# Remove original x axis and xlab
g1 = g1[-c(9,10), ]
# Draw it
grid.newpage()
grid.draw(g1)
Some time ago, I inquired about adding a secondary transformed x-axis in ggplot, and Nate Pope provided the excellent solution described at ggplot2: Adding secondary transformed x-axis on top of plot.
That solution worked great for me, and I returned to it hoping it would work for a new project. Unfortunately, the solution doesn't work correctly in the most recent version of ggplot2. Now, running the exact same code leads to a "clipping" of the axis title, as well as overlap of the tick marks and labels. Here is an example, with the problems highlighted in blue:
This example can be reproduced with the following code (this is an exact copy of Nate Pope's code that previously worked marvelously):
library(ggplot2)
library(gtable)
library(grid)
LakeLevels<-data.frame(Day=c(1:365),Elevation=sin(seq(0,2*pi,2*pi/364))*10+100)
## 'base' plot
p1 <- ggplot(data=LakeLevels) + geom_line(aes(x=Elevation,y=Day)) +
scale_x_continuous(name="Elevation (m)",limits=c(75,125)) +
ggtitle("stuff") +
theme(legend.position="none", plot.title=element_text(hjust=0.94, margin = margin(t = 20, b = -20)))
## plot with "transformed" axis
p2<-ggplot(data=LakeLevels)+geom_line(aes(x=Elevation, y=Day))+
scale_x_continuous(name="Elevation (ft)", limits=c(75,125),
breaks=c(90,101,120),
labels=round(c(90,101,120)*3.24084) ## labels convert to feet
)
## extract gtable
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
## overlap the panel of the 2nd plot on that of the 1st plot
pp <- c(subset(g1$layout, name=="panel", se=t:r))
g <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name=="panel")]], pp$t, pp$l, pp$b,
pp$l)
g <- gtable_add_grob(g1, g1$grobs[[which(g1$layout$name=="panel")]], pp$t, pp$l, pp$b, pp$l)
## steal axis from second plot and modify
ia <- which(g2$layout$name == "axis-b")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
## switch position of ticks and labels
ax$heights <- rev(ax$heights)
ax$grobs <- rev(ax$grobs)
ax$grobs[[2]]$y <- ax$grobs[[2]]$y - unit(1, "npc") + unit(0.15, "cm")
## modify existing row to be tall enough for axis
g$heights[[2]] <- g$heights[g2$layout[ia,]$t]
## add new axis
g <- gtable_add_grob(g, ax, 2, 4, 2, 4)
## add new row for upper axis label
g <- gtable_add_rows(g, g2$heights[1], 1)
g <- gtable_add_grob(g, g2$grob[[6]], 2, 4, 2, 4)
# draw it
grid.draw(g)
Running the above code leads to two critical problems, which I am trying to resolve:
1) How to adjust the x-axis added to the top of the plot to fix the "clipping" and overlap issues?
2) How to include the ggtitle("stuff") added to the first plot p1 in the final plot?
I've been trying to resolve these problems all afternoon, but cannot seem to solve them. Any help is much appreciated. Thanks!
Updated to ggplot2 v 2.2.1, but it is easier to use sec.axis - see here
Original
Moving axes in ggplot2 became more complex from version 2.1.0. This solution draws on code from older solutions and from code in the cowplot package.
With respect to your second issue, it was easier to construct a separate text grob for the "Stuff" title (rather than dealing with ggtitle with its margins).
library(ggplot2) #v 2.2.1
library(gtable) #v 0.2.0
library(grid)
LakeLevels <- data.frame(Day = c(1:365), Elevation = sin(seq(0, 2*pi, 2 * pi/364)) * 10 + 100)
## 'base' plot
p1 <- ggplot(data = LakeLevels) +
geom_path(aes(x = Elevation, y = Day)) +
scale_x_continuous(name = "Elevation (m)", limits = c(75, 125)) +
theme_bw()
## plot with "transformed" axis
p2 <- ggplot(data = LakeLevels) +
geom_path(aes(x = Elevation, y = Day))+
scale_x_continuous(name = "Elevation (ft)", limits = c(75, 125),
breaks = c(80, 90, 100, 110, 120),
labels = round(c(80, 90, 100, 110, 120) * 3.28084)) + ## labels convert to feet
theme_bw()
## Get gtable
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
## Get the position of the plot panel in g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))
# Title grobs have margins.
# The margins need to be swapped.
# Function to swap margins -
# taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
vinvert_title_grob <- function(grob) {
heights <- grob$heights
grob$heights[1] <- heights[3]
grob$heights[3] <- heights[1]
grob$vp[[1]]$layout$heights[1] <- heights[3]
grob$vp[[1]]$layout$heights[3] <- heights[1]
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$y <- unit(1, "npc") - grob$children[[1]]$y
grob
}
# Copy "Elevation (ft)" xlab from g2 and swap margins
index <- which(g2$layout$name == "xlab-b")
xlab <- g2$grobs[[index]]
xlab <- vinvert_title_grob(xlab)
# Put xlab at the top of g1
g1 <- gtable_add_rows(g1, g2$heights[g2$layout[index, ]$t], pp$t-1)
g1 <- gtable_add_grob(g1, xlab, pp$t, pp$l, pp$t, pp$r, clip = "off", name="topxlab")
# Get "feet" axis (axis line, tick marks and tick mark labels) from g2
index <- which(g2$layout$name == "axis-b")
xaxis <- g2$grobs[[index]]
# Move the axis line to the bottom (Not needed in your example)
xaxis$children[[1]]$y <- unit.c(unit(0, "npc"), unit(0, "npc"))
# Swap axis ticks and tick mark labels
ticks <- xaxis$children[[2]]
ticks$heights <- rev(ticks$heights)
ticks$grobs <- rev(ticks$grobs)
# Move tick marks
ticks$grobs[[2]]$y <- ticks$grobs[[2]]$y - unit(1, "npc") + unit(3, "pt")
# Sswap tick mark labels' margins
ticks$grobs[[1]] <- vinvert_title_grob(ticks$grobs[[1]])
# Put ticks and tick mark labels back into xaxis
xaxis$children[[2]] <- ticks
# Add axis to top of g1
g1 <- gtable_add_rows(g1, g2$heights[g2$layout[index, ]$t], pp$t)
g1 <- gtable_add_grob(g1, xaxis, pp$t+1, pp$l, pp$t+1, pp$r, clip = "off", name = "axis-t")
# Add "Stuff" title
titleGrob = textGrob("Stuff", x = 0.9, y = 0.95, gp = gpar(cex = 1.5, fontface = "bold"))
g1 <- gtable_add_grob(g1, titleGrob, pp$t+2, pp$l, pp$t+2, pp$r, name = "Title")
# Draw it
grid.newpage()
grid.draw(g1)
After some thought, I've confirmed that issue #1 originates from changes to recent versions of ggplot2, and I've also come up with a temporary workaround - installing an old version of ggplot2.
Following Installing older version of R package to install ggplot2 1.0.0, I installed ggplot2 1.0.0 using
packageurl <- "http://cran.r-project.org/src/contrib/Archive/ggplot2/ggplot2_1.0.0.tar.gz"
install.packages(packageurl, repos=NULL, type="source")
which I verified with
packageDescription("ggplot2")$Version
Then, re-running the exact code posted above, I was able to produce a plot with the added x-axis correctly displayed:
This is obviously not a very satisfying answer, but it at least works until someone smarter than I can explain why this approach doesn't work in recent versions of ggplot2. :)
So issue #1 from above has been resolved. I'm still haven't resolved issue #2 from above, so would appreciate any insight on that.
As suggested above, you can use sec_axis or dup_axis.
library(ggplot2)
LakeLevels <- data.frame(Day = c(1:365),
Elevation = sin(seq(0, 2*pi, 2 * pi/364)) * 10 + 100)
ggplot(data = LakeLevels) +
geom_path(aes(x = Elevation, y = Day)) +
scale_x_continuous(name = "Elevation (m)", limits = c(75, 125),
sec.axis = sec_axis(trans = ~ . * 3.28084, name = "Elevation (ft)"))
ggplot2 version 3.1.1
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()
Anybody knows how to draw the X-axis tickmarks at the top of a single plot in R, using ggplot2? I ve been looking at tutorials and mail lists and Rhelp without success.
Thanks in advance.
Agus
Use position = 'top'
library(ggplot2)
# Generate some data
df = data.frame(x = 1:10, y = 1:10)
# x-axis breaks
breaks = 1:10
# base plot
p <- ggplot(df, aes(x,y)) + geom_point() +
scale_x_continuous(breaks = breaks, position = 'top') +
scale_y_continuous(limits = c(0, 11), expand = c(0,0)) +
theme_bw()
Original solution available using gtable (with some updating to ggplot 2.1.0). See here
library(ggplot2)
library(gtable)
library(grid)
# Generate some data
df = data.frame(x = 1:10, y = 1:10)
# x-axis breaks
breaks = 1:10
# base plot
p <- ggplot(df, aes(x,y)) + geom_point() +
scale_x_continuous(breaks = breaks) +
scale_y_continuous(limits = c(0, 11), expand = c(0,0)) +
theme_bw()
# Get ggplot grob
g1 <- ggplotGrob(p)
## Get the position of the plot panel in g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))
# Title grobs have margins.
# The margins need to be swapped.
# Function to swap margins -
# taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
vinvert_title_grob <- function(grob) {
heights <- grob$heights
grob$heights[1] <- heights[3]
grob$heights[3] <- heights[1]
grob$vp[[1]]$layout$heights[1] <- heights[3]
grob$vp[[1]]$layout$heights[3] <- heights[1]
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$y <- unit(1, "npc") - grob$children[[1]]$y
grob
}
# Get xlab and swap margins
index <- which(g1$layout$name == "xlab-b")
xlab <- g1$grobs[[index]]
xlab <- vinvert_title_grob(xlab)
# Put xlab at the top of g1
g1 <- gtable_add_rows(g1, g1$heights[g1$layout[index, ]$t], pp$t-1)
g1 <- gtable_add_grob(g1, xlab, pp$t, pp$l, pp$t, pp$r, clip = "off", name="topxlab")
# Get x axis (axis line, tick marks and tick mark labels)
index <- which(g1$layout$name == "axis-b")
xaxis <- g1$grobs[[index]]
# Swap axis ticks and tick mark labels
ticks <- xaxis$children[[2]]
ticks$heights <- rev(ticks$heights)
ticks$grobs <- rev(ticks$grobs)
# Move tick marks
# Get tick mark length
plot_theme <- function(p) {
plyr::defaults(p$theme, theme_get())
}
tml <- plot_theme(p)$axis.ticks.length # Tick mark length
ticks$grobs[[2]]$y <- ticks$grobs[[2]]$y - unit(1, "npc") + tml
# Swap tick mark labels' margins and justifications
ticks$grobs[[1]] <- vinvert_title_grob(ticks$grobs[[1]])
# Put ticks and tick mark labels back into xaxis
xaxis$children[[2]] <- ticks
# Add axis to top of g1
g1 <- gtable_add_rows(g1, g1$heights[g1$layout[index, ]$t], pp$t)
g1 <- gtable_add_grob(g1, xaxis, pp$t+1, pp$l, pp$t+1, pp$r, clip = "off", name = "axis-t")
# Remove original x axis and xlab
g1 = g1[-c(9,10), ]
# Draw it
grid.newpage()
grid.draw(g1)
I would like to know how to make a plot in R where the y-axis is inverted such that the plotted data appears in what would be the fourth quadrant (IV) of a cartesian plane, as opposed to the first (I) quadrant.
For reference, the plot I am trying to make looks very similar to the following (source):
I have found a number of questions online pertaining to reversing the numbering on the y-axis, but these all still plot the data in the first quadrant. Can anyone suggest how I might produce a plot similar to that shown above?
Just to provide a worked out answer, following the comments of #timriffe and #joran...
Use the function for minor log ticks from this answer:
minor.ticks.axis <- function(ax,n,t.ratio=0.5,mn,mx,...){
lims <- par("usr")
if(ax %in%c(1,3)) lims <- lims[1:2] else lims[3:4]
major.ticks <- pretty(lims,n=5)
if(missing(mn)) mn <- min(major.ticks)
if(missing(mx)) mx <- max(major.ticks)
major.ticks <- major.ticks[major.ticks >= mn & major.ticks <= mx]
labels <- sapply(major.ticks,function(i)
as.expression(bquote(10^ .(i)))
)
axis(ax,at=major.ticks,labels=labels,...)
n <- n+2
minors <- log10(pretty(10^major.ticks[1:2],n))-major.ticks[1]
minors <- minors[-c(1,n)]
minor.ticks = c(outer(minors,major.ticks,`+`))
minor.ticks <- minor.ticks[minor.ticks > mn & minor.ticks < mx]
axis(ax,at=minor.ticks,tcl=par("tcl")*t.ratio,labels=FALSE)
}
Make some reproducible example data:
x <- 1:8
y <- 10^(sort(runif(8, 1, 10), decreasing = TRUE))
Plot without axes:
plot(x, log10(y), # function to plot
xlab="", # suppress x labels
type = 'l', # specify line graph
xlim = c(min(x), (max(x)*1.3)), # extend axis limits to give space for text annotation
ylim = c(0, max(log10(y))), # ditto
axes = FALSE) # suppress both axes
Add fancy log axis and turn tick labels right way up (thanks #joran!):
minor.ticks.axis(2, 9, mn=0, mx=10, las=1)
Add x-axis up the top:
axis(3)
Add x-axis label (thanks for the tip, #WojciechSobala)
mtext("x", side = 3, line = 2)
And add an annotation to the end of the line
text(max(x), min(log10(y)), "Example", pos = 1)
Here's the result:
Answering the question in the title, the best/easiest way to invert the axis is to flip the limit variables around:
> plot(1:10, xlim=c(1,10));
> plot(1:10, xlim=c(10,1));
> plot(1:10, ylim=c(10,1));
Doing it this way means that you don't need to mess around with axes that are different from the image coordinates.
This can be combined with the 'xaxt="n"' parameter and an additional axis command to place an axis on another side:
> plot(1:10, ylim=c(10,1), xaxt="n"); axis(3);
It's now quite easy to reverse the y-axis using scale_y_reverse and specify position = "top" for the x-axis in ggplot2
Example
library(ggplot2)
library(scales)
set.seed(99)
Date <- seq(from = as.Date("2017-12-01"), to = as.Date("2017-12-15"),
by = "days")
Flux <- runif(length(Date), 1, 10000)
Flux_df <- data.frame(Date, Flux)
p1 <- ggplot(Flux_df, aes(Date, Flux)) +
geom_col() +
xlab("") +
scale_x_date(position = "top", breaks = pretty_breaks(), expand = c(0, 0)) +
scale_y_reverse(expand = expand_scale(mult = c(0.2, 0))) +
theme_bw(base_size = 16) +
theme(panel.border = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line()) +
theme(legend.position = "none")
p1
If we want both logarithmic and reverse axis, we need a workaround suggested here as ggplot2 does not have that option atm
reverselog_trans <- function(base = exp(1)) {
trans <- function(x) -log(x, base)
inv <- function(x) base^(-x)
scales::trans_new(paste0("reverselog-", format(base)), trans, inv,
scales::log_breaks(base = base), domain = c(1e-100, Inf))
}
p1 + scale_y_continuous(trans = reverselog_trans(10),
breaks = scales::trans_breaks("log10", function(x) 10^x),
labels = scales::trans_format("log10", scales::math_format(10^.x)),
expand = expand_scale(mult = c(0.2, 0))) +
annotation_logticks()