Related
I posted my original question yesterday which got solved perfectly here
Original post
I made a few addition to my code
library(lubridate)
library(ggplot2)
library(grid)
### Set up dummy data.
dayVec <- seq(ymd('2016-01-01'), ymd('2016-01-10'), by = '1 day')
dayCount <- length(dayVec)
dayValVec1 <- c(0,-0.22,0.15,0.3,0.4,0.10,0.17,0.22,0.50,0.89)
dayValVec2 <- c(0,0.2,-0.17,0.6,0.16,0.41,0.55,0.80,0.90,1.00)
dayValVec3 <- dayValVec2
dayDF <- data.frame(Date = rep(dayVec, 3),
DataType = factor(c(rep('A', dayCount), rep('B', dayCount), rep('C', dayCount))),
Value = c(dayValVec1, dayValVec2, dayValVec3))
ggplot(dayDF, aes(Date, Value, colour = DataType)) +
theme_bw() +
ggtitle("Cumulative Returns \n") +
scale_color_manual("",values = c("#033563", "#E1E2D2", "#4C633C"),
labels = c("Portfolio ", "Index ", "In-Sample ")) +
geom_rect(aes(xmin = ymd('2016-01-01'),
xmax = ymd('2016-01-06'),
ymin = -Inf,
ymax = Inf
), fill = "#E1E2D2", alpha = 0.03, colour = "#E1E2D2") +
geom_line(size = 2) +
scale_x_datetime(labels = date_format('%b-%d'),
breaks = date_breaks('1 day'),
expand = c(0,0)) +
scale_y_continuous( expand = c(0,0), labels = percent) +
theme(axis.text.x = element_text(angle = 90),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
axis.line = element_line(size = 1),
axis.ticks = element_line(size = 1),
axis.text = element_text(size = 20, colour = "#033563"),
axis.title.x = element_text(hjust = 2),
plot.title = element_text(size = 40, face = "bold", colour = "#033563"),
legend.position = 'bottom',
legend.text = element_text(colour = "#033563", size = 20),
legend.key = element_blank()
)
which produces this output
The only thing that I still cannot get working is the position of the x axis. I want the x axis to be at y = 0 but still keep the x axis labels under the chart, exactly as in the excel version of it. I know the data sets are not the same but I didn't have the original data at hand so I produced some dummy data. Hope this was worth a new question, thanks.
> grid.ls(grid.force())
GRID.gTableParent.12660
background.1-5-7-1
spacer.4-3-4-3
panel.3-4-3-4
grill.gTree.12619
panel.background.rect.12613
panel.grid.minor.y.zeroGrob.12614
panel.grid.minor.x.zeroGrob.12615
panel.grid.major.y.polyline.12617
panel.grid.major.x.zeroGrob.12618
geom_rect.rect.12607
GRID.polyline.12608
panel.border.rect.12610
axis-l.3-3-3-3
axis.line.y.polyline.12631
axis
axis-b.4-4-4-4
axis.line.x.polyline.12624
axis
xlab.5-4-5-4
ylab.3-2-3-2
guide-box.6-4-6-4
title.2-4-2-4
> grid.gget("axis.1-1-1-1", grep=T)
NULL
ggplot2 doesn't make this easy. Below is one-way to approach this interactively. Basically, you just grab the relevant part of the plot (the axis line and ticks) and reposition them.
If p is your plot
p
grid.force()
# grab the relevant parts - have a look at grid.ls()
tck <- grid.gget("axis.1-1-1-1", grep=T)[[2]] # tick marks
ax <- grid.gget("axis.line.x", grep=T) # x-axis line
# add them to the plot, this time suppressing the x-axis at its default position
p + lapply(list(ax, tck), annotation_custom, ymax=0) +
theme(axis.line.x=element_blank(),
axis.ticks.x=element_blank())
Which produces
A quick note: the more recent versions of ggplot2 have the design decision to not show the axis. Also changes to axis.line are not automatically passed down to the x and y axis. Therefore, I tweaked your theme to define axis.line.x and axis.line.y separately.
That siad, perhaps its easier (and more robust??) to use geom_hline as suggested in the comments, and geom_segment for the ticks.
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)
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:
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))
I am struggling to get the date format right. The data is already in the melt() format. There are four variables in the data which happened to share the same data. I just like to plot a simple line chart with four lines(each variable as an indidividual line) and to display Sep-12 as the latest data point? I am using the older ggplot. Feel free to I have two questions.
First question: How to display the data quarterly (the date intervals are Sep-11, Dec-11,
Mar-12, Jun-12 and Sep-12)?
Second question: How to suppress the grid lines and the grey background?
x4.1.m<-structure(list(Var.1=structure(c(1L,2L,3L,4L,5L,6L,1L,2L,3L,4L,5L,6L,1L,2L,3L,4L,5L,6L,1L,2L,3L,4L,5L,6L,1L,2L,3L,4L,5L,6L),.Label=c("I'vechangedforwork/anewjob/goneonaworkplan","Iwantaphonethat2degreesdoesn'toffer","IwantBestMates/Favourites","Iwasofferedorsawabetterofferonanothernetwork","Issueswiththe2degreesnetwork(poorcoverage)","Other"),class="factor"),YearQuarter=structure(c(1L,1L,1L,1L,1L,1L,2L,2L,2L,2L,2L,2L,3L,3L,3L,3L,3L,3L,4L,4L,4L,4L,4L,4L,5L,5L,5L,5L,5L,5L),.Label=c("2011-09-01","2011-12-01","2012-03-01","2012-06-01","2012-09-01"),class="factor"),value=c(0.23,0.23,0.121,0.25,0.223,0.14,0.39,0.22,0.05,0.37,0.25,0.2,0.09,0.14,0.05,0.3,0.4,0.12,0.13,0.1,0.26,0.38,0.28,0.15,0.33,0.05,0.06,0.44,0.32,0.43)),.Names=c("Var.1","YearQuarter","value"),row.names=c(NA,-30L),class="data.frame")
x4.1.m$YearQuarter <- format(as.Date(x4.1.m$YearQuarter),"%b-%y")
x4.line <- ggplot(data=x4.1.m, aes(x=factor(YearQuarter), y=value,colour=Var.1)) +
geom_smooth(se=F, size=1.5)+labs(y="Percentage",x="Year Quarter")
x4.line+geom_text(aes(label =paste(round(value*100,0), "%", sep=""),group=Var.1),
size = 3, hjust = 0.5, vjust =1.5) +
opts(axis.line = theme_segment(colour = "black"),
panel.grid.major = theme_blank(),
panel.background=theme_blank(),
panel.grid.minor = theme_blank(),
panel.border = theme_blank()) +
scale_y_continuous("Percentage",labels=percent, limits=c(0,0.5)) +
ggtitle("Percentages:Main Reasons for Leaving 2degrees by Quarter") +
theme(plot.title = element_text(size=rel(1.2)))
Unfortunatly, the question is not clear , I can't be sur for the answer. but the final result seems good.
I change your code because I ma using last version of ggplot2.
I don't find a problem with date format ,but you are a little bit confusing with ggplot2.
Notice I l added scales package for percent formatting.
library(scales)
library(ggplot2)
###data
x4.1.m$YearQuarter <- as.Date(x4.1.m$YearQuarter)
x4.1.m$label <- paste(round(x4.1.m$value*100,0), "%", sep="")
### plot
x4.line <- ggplot(data=x4.1.m, aes(x=YearQuarter, y=value,colour=Var.1,group = Var.1))
x4.line <- x4.line + geom_smooth(se=F, size=1.5)
x4.line <- x4.line + geom_text(aes(label = label),size = 3, hjust = 0.5, vjust =1.5)
### theme
x4.line <- x4.line + theme(axis.line = element_line(colour = "black"),
panel.grid.major = element_blank(),
panel.background=element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank())
x4.line <- x4.line + ggtitle("Percentages:Main Reasons for Leaving 2degrees by Quarter") +
theme(plot.title = element_text(size=rel(1.2)))+
scale_y_continuous(labels=percent, limits=c(0,0.5)) +
scale_x_date(labels = date_format("%b-%y"))+
labs(y="Percentage",x="Year Quarter")
x4.line