This is currently my code for the figure above
ggplot(AllData, aes(Year, AGResiduals, fill=Type)) +
geom_boxplot(outlier.size=0) +
scale_fill_manual(values=c("skyblue4", "skyblue"),
name="Male Type",
labels=c("Guarders","Sneakers")) +
labs(x=NULL, y = "Residual of Accessory Gland Mass x Total Mass") +
scale_x_discrete(limits=c("2007","2008","2010","2011","2013","2014","2015"),
labels=str_wrap(c("2007 (nG=37, nS=8)","2008 (nG=4, nS=6)","2010 (nG=31, nS=6)","2011 (nG=55, nS=5)","2013 (nG=202, nS=24)","2014 (nG=63)","2015 (nG=59, nS=3)"),
width=6)) +
theme(plot.title = element_text(size = rel(1.4)),
axis.title = element_text(size = rel(1.2)),
axis.text.x = element_text(size = rel(1.5)),
axis.text.y = element_text(size = rel(1.5)),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black"))
I want to make the "G" and "S"'s in each x-axis tick labels subscript (they designate sample size for two different groups, G and S).
Writing
expression(2007 (n[G]=37, n[S]=8)
works, but only if I remove the preceding
str_wrap
code for some reason.
I need to constrain the width of the text for each x-axis tick label, so I need to retain str_wrap or use line breaks within the expression function somehow.
I also can't replace my list of labels with a factor since I have to set limits on the years I want to show.
Can someone please help on how to make a 3-line x-axis tick label that allows for subscript?
I couldn't find a way to display expressions on multiple lines, but you could try rotating the labels:
library(stringr)
library(ggplot2)
library(scales)
library(dplyr)
n <- 100
y <- as.character(sample(2007:2015,n,replace=T))
t <- sample(c("Guarders","Guarders","Sneakers"),n,replace=T)
r <- rnorm(n,10,20)
nsk <- sum(t=="Sneakers")
r[ t=="Sneakers" ] <- rnorm(nsk,1,5)
AllData <- data.frame(Year=y,AGResiduals=r,Type=t)
sdf <- AllData %>% group_by( Year ) %>%
summarize( n=n(), ng=sum(Type=="Guarders") )
fmts <- rep("%s (n[G]==%d) ~~ (n[S]==%d)",nrow(sdf))
labs2 <- do.call(sprintf,list(fmts,sdf$Year,sdf$ng, sdf$n-sdf$ng ) )
ex2 <- parse(text=labs2)
ggplot(AllData, aes(Year, AGResiduals, fill=Type)) +
geom_boxplot(outlier.size=0) +
scale_fill_manual(values=c("skyblue4", "skyblue"),
name="Male Type",
labels=c("Guarders","Sneakers")) +
labs(x=NULL, y = "Residual of Accessory Gland Mass x Total Mass") +
scale_x_discrete(limits=c("2007","2008","2010","2011","2013","2014","2015"),
labels=ex2) +
theme(plot.title = element_text(size = rel(1.4)),
axis.title = element_text(size = rel(1.2)),
axis.text.x = element_text(size = rel(1.0),angle=-30,hjust=0),
axis.text.y = element_text(size = rel(1.5)),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black"))
Yields this:
Rawr made a suggestion that allows you to get two, but not three lines. Since it doesn't require rotation, I am entering it as a second solution.
This:
library(stringr)
library(ggplot2)
library(scales)
library(dplyr)
set.seed(23456)
n <- 100
y <- as.character(sample(2007:2015,n,replace=T))
t <- sample(c("Guarders","Guarders","Sneakers"),n,replace=T)
r <- rnorm(n,10,20)
nsk <- sum(t=="Sneakers")
r[ t=="Sneakers" ] <- rnorm(nsk,1,5)
AllData <- data.frame(Year=y,AGResiduals=r,Type=t)
sdf <- AllData %>% group_by( Year ) %>%
summarize( n=n(), ng=sum(Type=="Guarders") )
fmts <- rep("atop(%s, n[G]==%d ~~ n[S]==%d)",nrow(sdf)) # two rows
labs2 <- do.call(sprintf,list(fmts,sdf$Year,sdf$ng, sdf$n-sdf$ng ) )
ex2 <- parse(text=labs2)
ggplot(AllData, aes(Year, AGResiduals, fill=Type)) +
geom_boxplot(outlier.size=0) +
scale_fill_manual(values=c("skyblue4", "skyblue"),
name="Male Type",
labels=c("Guarders","Sneakers")) +
labs(x=NULL, y = "Residual of Accessory Gland Mass x Total Mass") +
scale_x_discrete(limits=c("2007","2008","2010","2011","2013","2014","2015"),
labels=ex2) +
theme(plot.title = element_text(size = rel(1.4)),
axis.title = element_text(size = rel(1.2)),
axis.text.x = element_text(size = rel(1.0),angle=0,hjust=0),
axis.text.y = element_text(size = rel(1.5)),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black"))
yields this:
Related
I have the code of two graphs that I want to separate into two. I would like to see half of these results on one graph and the other half on another since the current plot contains too much information. Here is the code for my charts:
Medellin7 <- Medellin4 %>%
filter(Medellin4$AÑO_T %in% c("2019"))
Medellin7
Medellin8 <- Medellin7 %>%
filter(Medellin7$MES_TURNO %in% c("06"))
Medellin8
ATENCIONFUNCIONARIO <- Medellin8 %>%
group_by(NOMBRE_SERVICIO, NOMBRE, NOMBRE_SERVICIO) %>%
summarize(TIEMPO = mean(TIEMPO)) %>%
ungroup() %>%
mutate(NOMBRE_SERVICIO = factor(NOMBRE_SERVICIO, levels = unique(NOMBRE_SERVICIO)),
NOMBRE = as.factor(NOMBRE))
# First Chart
grafico5 <- ggplot(data = ATENCIONFUNCIONARIO,
aes(x = NOMBRE_SERVICIO, y = TIEMPO, group = NOMBRE, colour = NOMBRE)) +
xlab("SERVICIO") + ylab("CANTIDAD") +
ggtitle("TIEMPO PROMEDIO ATENCIÓN FUNCIONARIO")+
theme(axis.text.x=element_text(angle=90,hjust=1)) +
theme(plot.title = element_text(hjust = 0.5))+
theme(panel.border = element_blank(), panel.grid.major = element_blank(),
panel.grid.minor = element_blank(), axis.line = element_line(colour = "white"))+
geom_line(lwd=1)
grafico5
Second Chart:
FUNCIONARIO <- Medellin1 %>%
group_by(AÑO_T, NOMBRE) %>%
summarise(TIEMPO = length(TIEMPO))
FUNCIONARIO <- FUNCIONARIO\[order(FUNCIONARIO$NOMBRE, decreasing = TRUE),\]
M<- ggplot(FUNCIONARIO, aes(factor(NOMBRE), TIEMPO, fill = factor(AÑO_T))) +
geom_bar(stat="identity", position="dodge")+
theme(axis.text.x=element_text(angle=90,hjust=1))+
xlab("MES")+
ylab("CANTIDAD")+
labs(fill="AÑO")+
ggtitle("DEMANDA MES")+
theme(plot.title = element_text(hjust = 0.5))+
theme(panel.border = element_blank(), panel.grid.major = element_blank(),
panel.grid.minor = element_blank(), axis.line = element_line(colour = "gray"))]
Splitting the plot into two identical plots seems like a strange choice. One alternative would be to use facet_wrap using Nombre as the facet variable. This would give you a clear look at each line in the chart. Your code would look something like this:
grafico5 <- ggplot(data = ATENCIONFUNCIONARIO,
aes(x = NOMBRE_SERVICIO, y = TIEMPO)) +
xlab("SERVICIO") + ylab("CANTIDAD") +
ggtitle("TIEMPO PROMEDIO ATENCIÓN FUNCIONARIO")+
theme(axis.text.x=element_text(angle=90,hjust=1)) +
theme(plot.title = element_text(hjust = 0.5))+
theme(panel.border = element_blank(), panel.grid.major = element_blank(),
panel.grid.minor = element_blank(), axis.line = element_line(colour = "white"))+
geom_line(lwd=1) +
facet_wrap(~Nombre)
Here's a reproducible example:
data(iris)
library(ggplot2)
ggplot(iris, aes(x=Sepal.Width, y=Sepal.Length)) +
geom_line() +
facet_wrap(~Species)
Which gives you:
I find some R code to do forest plot using ggplot2, combining figure with text. However, when I run the code, there is an error reported and text frame did not come out, although the figure looks good. I will very appreciate any suggestions on how to correct the code. Thanks!
library(ggplot2)
library(gridExtra)
dat <- data.frame(group = factor(c("A","B","C","D","E","F","G"),
levels=c("F","E","D","C","B","A","G")),
cen = c(3.1,2.0,1.6,3.2,3.6,7.6,NA),
low = c(2,0.9,0.8,1.5,2,4.2,NA),
high = c(6,4,2,6,5,14.5,NA))
theme_set(theme_bw())
theme_update(
axis.line = element_line(colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
plot.margin = unit(c(0,0,0,0), "lines")
)
lab <- data.frame(
V0 = factor(c("A","B","C","D","E","F","G","A","B","C","D","E","F","G",
"A","B","C","D","E","F","G","A","B","C","D","E","F","G"),
levels=c("G","F","E","D","C","B","A")),
V05 = rep(c(1,2,3,4),each=7),
V1=c("Occuption","Active","","Inactive","","Inactive","","Recreation",
"Inactive","", "Active","","Inactive","",
"Gender","Men","Women","Men","Women","Men","Women",
"OR",3.1,2.0,1.6,3.2,3.6,7.6))
data_table <- ggplot(lab, aes(x = V05, y = V0,
label = format(V1, nsmall = 1))) +
geom_text(size = 4, hjust=0, vjust=0.5) + theme_bw() +
geom_hline(aes(yintercept=c(6.5,7.5))) +
theme(panel.grid.major = element_blank(),
legend.position = "none",
panel.border = element_blank(),
axis.text.x = element_text(colour="white"),#element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_line(colour="white"),#element_blank(),
plot.margin = unit(c(0,0,0,0), "lines")) +
labs(x="",y="") +
coord_cartesian(xlim=c(1,4.5))
p
data_table
##{r forest_plot_1, fig.width=8, fig.height=4, tidy=F}
grid.arrange(data_table, p, ncol=2)
Something wrong here as shown below:
Warning messages:
1: Removed 1 rows containing missing values (geom_point).
2: Removed 1 rows containing missing values (geom_errorbarh).
data_table
Error: Aesthetics must be either length 1 or the same as the data (28): yintercept
{r forest_plot_1, fig.width=8, fig.height=4, tidy=F}
grid.arrange(data_table, p, ncol=2)
Error: Aesthetics must be either length 1 or the same as the data (28): yintercept
I think the error is in the horizontal line layer. Here is the code that worked for me
data_table <- ggplot(lab, aes(x = lab$V05, y = lab$V0, label = format(V1, nsmall = 1))) +
geom_text(size = 4, hjust=0, vjust=0.5) + theme_bw() +
geom_hline(aes(yintercept=6.5)) +
geom_hline(aes(yintercept=3))
I'd like to make a forest plot for my project. Since it is not a typical forest plot built-in any R package, I found the first figure of this page is helpful to my goal, a side table accompanied with the forest plot:
https://mcfromnz.wordpress.com/2012/11/06/forest-plots-in-r-ggplot-with-side-table/
The code which produces that particular figure is pasted below (the original link:https://github.com/nzcoops/blog_code/blob/master/forest_plot.Rmd)
The problem that I ran into is in the "data_table" step. An error pop up when I type the following in R:
data_table
Error: Aesthetics must be either length 1 or the same as the data (28): yintercept
I guess the issue came from geom_hlinein data_table.
After some online search and some try-and-error, I still cannot get rid of that error message and wonder if I can get some help here. Thanks in advance for your help.
--Code that particular produce the first figure:
library(ggplot2)
library(gridExtra)
dat <- data.frame(group = factor(c("A","B","C","D","E","F","G"), levels=c("F","E","D","C","B","A","G")),
cen = c(3.1,2.0,1.6,3.2,3.6,7.6,NA),
low = c(2,0.9,0.8,1.5,2,4.2,NA),
high = c(6,4,2,6,5,14.5,NA))
theme_set(theme_bw())
theme_update(
axis.line = element_line(colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
plot.margin = unit(c(0,0,0,0), "lines"))
p <- ggplot(dat,aes(cen,group)) +
geom_point(size=5, shape=18) +
geom_errorbarh(aes(xmax = high, xmin = low), height = 0.15) +
geom_vline(xintercept = 1, linetype = "longdash") +
scale_x_continuous(breaks = seq(0,14,1), labels = seq(0,14,1)) +
labs(x="Adjusted Odds Ratio", y="")
data_table <- ggplot(lab, aes(x = V05, y = V0, label = format(V1, nsmall = 1))) +
geom_text(size = 4, hjust=0, vjust=0.5) + theme_bw() +
geom_hline(aes(yintercept=c(6.5,7.5))) +
theme(panel.grid.major = element_blank(),
legend.position = "none",
panel.border = element_blank(),
axis.text.x = element_text(colour="white"),#element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_line(colour="white"),#element_blank(),
plot.margin = unit(c(0,0,0,0), "lines")) +
labs(x="",y="") +
coord_cartesian(xlim=c(1,4.5))
lab <- data.frame(V0 = factor(c("A","B","C","D","E","F","G","A","B","C","D","E","F","G","A","B","C","D","E","F","G","A","B","C","D","E","F","G"),, levels=c("G","F","E","D","C","B","A")),
V05 = rep(c(1,2,3,4),each=7),
V1 = c("Occuption","Active","","Inactive","","Inactive","","Recreation","Inactive","","Active","","Inactive","","Gender","Men","Women","Men","Women","Men","Women","OR",3.1,2.0,1.6,3.2,3.6,7.6))
data_table <- ggplot(lab, aes(x = V05, y = V0, label = format(V1, nsmall = 1))) +
geom_text(size = 4, hjust=0, vjust=0.5) + theme_bw() +
geom_hline(aes(yintercept=c(6.5,7.5))) +
theme(panel.grid.major = element_blank(),
legend.position = "none",
panel.border = element_blank(),
axis.text.x = element_text(colour="white"),#element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_line(colour="white"),#element_blank(),
plot.margin = unit(c(0,0,0,0), "lines")) +
labs(x="",y="") +
coord_cartesian(xlim=c(1,4.5))
The easiest fix would be separating geom_hline into 2 different calls
data_table <- ggplot(lab, aes(x = V05, y = V0, label = format(V1, nsmall = 1))) +
geom_text(size = 4, hjust=0, vjust=0.5) + theme_bw() +
geom_hline(aes(yintercept=c(6.5))) +
geom_hline(aes(yintercept=c(7.5))) +
theme(panel.grid.major = element_blank(),
legend.position = "none",
panel.border = element_blank(),
axis.text.x = element_text(colour="white"),#element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_line(colour="white"),#element_blank(),
plot.margin = unit(c(0,0,0,0), "lines")) +
labs(x="",y="") +
coord_cartesian(xlim=c(1,4.5))
data_table
Created on 2018-03-31 by the reprex package (v0.2.0).
You don't need to use aes() with geom_hline (only use aes() if you want a horizontal line for every row of your data.) You can just do:
geom_hline(yintercept = c(6.5, 7.5))
This is explained in the help, see ?geom_hline for more details.
This question already has answers here:
Multirow axis labels with nested grouping variables
(7 answers)
Closed 6 years ago.
variable <- c("PM10","SO2","NO","NO2","PM10","SO2","NO","NO2","PM10","SO2","NO","NO2","PM10","SO2","NO","NO2","PM10","SO2","NO","NO2","PM10","SO2","NO","NO2")
sex <- c("male","male","male","male","female","female","female","female",
"male","male","male","male","female","female","female","female",
"male","male","male","male","female","female","female","female")
exposureperiod <- c("P1","P1","P1","P1","P1","P1","P1","P1",
"P2","P2","P2","P2","P2","P2","P2","P2",
"P3","P3","P3","P3","P3","P3","P3","P3")
set.seed(100)
coef <- runif(24, -2, 2)
coef_lb <- coef - 0.3
coef_ub <- coef + 0.3
df <- data.frame(variable,sex,exposureperiod,coef,coef_lb,coef_ub)
df$variable <- factor(df$variable,levels=c("PM10","SO2","NO","NO2"))
levels(df$variable) <- c("PM[10]","SO[2]", "NO", "NO[2]")
df$exposureperiod <- factor(df$exposureperiod,levels=c("P1","P2","P3"))
df$sex <- factor(df$sex,levels=c("male","female"))
df <- df[order(df$variable,df$sex),]
df$aux <- c(1,2,3,
5,6,7,
11,12,13,
15,16,17,
21,22,23,
25,26,27,
31,32,33,
35,36,37)
library(ggplot2)
plot <- ggplot(data = df, aes(x = aux, y = coef)) +
geom_pointrange(aes(ymin=coef_lb,ymax=coef_ub),shape="none") +
geom_point(aes(shape = exposureperiod)) +
scale_shape_discrete(name ="Exposure period",
breaks=c("P1", "P2","P3"),
labels=c("P1","P2","P3")) +
scale_x_continuous("Sex and Pollutant",breaks=c(2,6,12,16,22,26,32,36),
labels=c("Boys","Girls","Boys","Girls","Boys","Girls","Boys","Girls")) +
scale_y_continuous("Mean Difference in Tanner Stage",
limits=c(-3, 3),
breaks=round(seq(-3, 3, by = 0.5),1)) +
geom_hline(yintercept=0,alpha=1,linetype="dashed") +
theme(axis.text.x = element_text()) +
theme_bw(base_size = 16,base_family="Arial") +
theme(legend.text.align = 0,
legend.title = element_text(face="plain"),
legend.key = element_blank(),
legend.position = "bottom") +
guides(shape= guide_legend(nrow = 3,byrow = TRUE)) +
theme(text = element_text(colour = "black",face="plain"),
axis.title.y = element_text(face="plain"),
axis.title.x = element_text(face="plain"),
axis.text.x = element_text(face="plain",hjust = 0),
axis.text.y = element_text(face="plain")) +
theme(panel.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
axis.line = element_line(colour = "black"))+
theme(axis.ticks = element_line(size = 1))
plot
With the above script, I got the graph as below.
But I want to add another level of x-axis, which indicate the PM10, SO2, NO, and NO2, like the below graph. (To illustrate, I added those pollutants manually.) And of course, the x-axis title and legend should move down accordingly.
I used facet before, but I want to avoid the gap between pollutants generate by facet.
Thank you.
You could try faceting the plot
plot <- plot + facet_wrap(~variable)
I am using ggplot to plot a time series am running into a problem extending the extents of the x axis. I developed the following code to provide a reducible example.
#Dummy Data
Dates <- data.frame(Date = c("1992-11-21","1993-10-26","1995-05-12","1996-03-03","1999-05-22","2008-04-13"))
Volume <- data.frame(Volume = c("28947.548","29947.262","30842.333","27192.588","30209.414","24439.897"))
Errors <- data.frame(Errors = c("4118.903","1974.606","1843.382","1920.362","1905.469","1977.074"))
ID <- data.frame(ID = c("a","a","a","b","b","b"))
Merge_Data <- data.frame(Dates,Volume,Errors,ID)
#convert Dates to native format in R
Merge_Data$Date <- as.Date(Merge_Data$Date,"%Y-%m-%d")
#Convert Areas to numbers
Merge_Data$Volume <- as.numeric(as.character(Merge_Data$Volume))
Merge_Data$Errors <- as.numeric(as.character(Merge_Data$Errors))
#Plot the Data
ggplot(Merge_Data, aes(x = Date, y = Volume, color = ID)) +
scale_color_manual(values = c("#000000", "#0000BB")) +
geom_errorbar(aes(ymin=Volume-Errors,ymax=Volume+Errors), width=100,size=0.1) +
geom_point(size = 2) +
geom_line(size = 0.5)+
scale_x_date(labels = date_format("%Y"), breaks = date_breaks("2 year"))+
xlab("Date")+
ylab("Volume, in cubic meters")+
ylim(0,max(Merge_Data$Volume)+20000)+
theme(axis.line = element_line(colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_rect(colour="black",fill = "white",),
axis.text = element_text(colour = "black"),
legend.background = element_rect(colour = "black"),
legend.key = element_rect(color=NA, fill="white"),
legend.title = element_blank(),
legend.position=c(0.9,0.9))
I need to extend the extents of the x axis to begin at 1990 and end at 2014. I have experimented using the limits expression in the scale_x_Date line but not had any luck.
Thanks in advance,
dubbbdan
I figured it out!!
You just need to change the scale_x_date line to include a lim= expression.
#Dummy Data
Dates <- data.frame(Date = c("1992-11-21","1993-10-26","1995-05-12","1996-03-03","1999-05-22","2008-04-13"))
Volume <- data.frame(Volume = c("28947.548","29947.262","30842.333","27192.588","30209.414","24439.897"))
Errors <- data.frame(Errors = c("4118.903","1974.606","1843.382","1920.362","1905.469","1977.074"))
ID <- data.frame(ID = c("a","a","a","b","b","b"))
Merge_Data <- data.frame(Dates,Volume,Errors,ID)
#convert Dates to native format in R
Merge_Data$Date <- as.Date(Merge_Data$Date,"%Y-%m-%d")
#Convert Areas to numbers
Merge_Data$Volume <- as.numeric(as.character(Merge_Data$Volume))
Merge_Data$Errors <- as.numeric(as.character(Merge_Data$Errors))
#Plot the Data
ggplot(Merge_Data, aes(x = Date, y = Volume, color = ID)) +
scale_color_manual(values = c("#000000", "#0000BB")) +
geom_errorbar(aes(ymin=Volume-Errors,ymax=Volume+Errors), width=100,size=0.1) +
geom_point(size = 2) +
geom_line(size = 0.5)+
scale_x_date(lim = c(as.Date("1990-1-1"), as.Date("2014-1-1")),labels = date_format("%Y"), breaks = date_breaks("2 year"))+
xlab("Date")+
ylab("Volume, in cubic meters")+
ylim(0,max(Merge_Data$Volume)+20000)+
theme(axis.line = element_line(colour = "black"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_rect(colour="black",fill = "white",),
axis.text = element_text(colour = "black"),
legend.background = element_rect(colour = "black"),
legend.key = element_rect(color=NA, fill="white"),
legend.title = element_blank(),
legend.position=c(0.9,0.9))