Related
My plot consists of three circles and two points. I am hoping to complete two, seemingly simple but proving difficult, tasks. I am hoping to 1) Create two legends & 2) change the household point's shape, size, and color. The circles generated using the following function...
circleFun <- function(center,diameter, npoints){
# recovered from
# https://stackoverflow.com/questions/6862742/draw-a-circle-with-ggplot2
r = diameter / 2
tt <- seq(0,2*pi,length.out = npoints)
xx <- center[1] + r * cos(tt)
yy <- center[2] + r * sin(tt)
return(data.frame(x = xx, y = yy))
}
I then call the function with 3 different inputs to generate 100 x-y points for each cirlce
A <- circleFun(c(0,0), 1, npoints=100) %>%
cbind("A") %>%
set_names(c("x", "y", "Neighborhood"))
B <- circleFun(c(.5, .5), 1, npoints=100) %>%
cbind("B") %>%
set_names(c("x", "y", "Neighborhood"))
C <- circleFun(c(1, 1), 1, npoints=100) %>%
cbind("C") %>%
set_names(c("x", "y", "Neighborhood"))
neigh <- rbind(A, B, C)
I then create my point data
hh <- as.data.frame(matrix(c(.25,.5,.25,.5,1,2), 2, 3)) %>%
set_names(c("x", "y", "Household"))
Thus far I have two different data sets, both points, both following aes(x,y). However, their grouping is different: the first data set is grouped by "Neighborhood", the second is grouped by "Household".
I then plot what I have thus far..
# Plot Neighborhoods and set up plot specifics
c <- ggplot(data=neigh, aes(x,y, group = Neighborhood, color = Neighborhood)) +
geom_path(size = 1.5) +
xlab("Quality of Public Amenities") +
ylab("Price of Housing") +
ggtitle("Figure 2.5") +
theme(panel.grid = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
plot.title = element_text(hjust=0.5, face = 'bold', size = 14))
# Add corresponding household points
c+geom_point(data=hh, aes(x=x,y=y,group = as.factor(Household), color = as.factor(Household)))
This is my output..
So why am I asking for help here? I am hoping to 1) Create two legends, one for Neighborhood and another for Households & 2) change the household point's shape, size, and color. Due to the fact that their both point plots, R is not letting me separate the aesthetics of the plots (aes()) which is causing me to not fulfill tasks 1 & 2. The example is fully replicable.
Try this. First I use only x and y as global aesthetics. Second instead of mapping Household in geom_point on color I map it on fill which adds a second legend. One drawback of this solution. You have to chose from the filled shapes, e.g. shape 21 for filled points. The size of the points can be set via the size argument, while the colors can be set e.g. via scale_fill_manual.
library(ggplot2)
library(dplyr)
library(purrr)
# Plot Neighborhoods and set up plot specifics
c <- ggplot(data=neigh, aes(x,y)) +
geom_path(aes(group = Neighborhood, color = Neighborhood), size = 1.5) +
xlab("Quality of Public Amenities") +
ylab("Price of Housing") +
ggtitle("Figure 2.5") +
theme(panel.grid = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
plot.title = element_text(hjust=0.5, face = 'bold', size = 14))
# Add corresponding household points
c +
geom_point(data=hh, aes(group = as.factor(Household), fill = as.factor(Household)), shape = 21, color = "transparent", size = 2) +
scale_fill_manual(name = "Household", values = c("black", "orange"))
Created on 2020-03-31 by the reprex package (v0.3.0)
I would like certain points I have created through ggplot to take labels at the side of the graph but I am not able to do that through my current code.
Ceplane1 is a matrix with two columns and 100 rows ( can take any random numbers). I want to plot column 2 on the x-axis and column 1 on the y-axis with. I have done this part using the below code. Now I want to make changes in the code so that I can put the label at the side of the graph and not on the graph area itself. Additionally, I want to represent the axis in a comma format. you can take result.table[1,1] and result.table[1,3] to be some number and suggest the solution.
ggplot(Ceplane1, aes(x = Ceplane1[,2], y = Ceplane1[,1])) +
geom_point(colour="blue")+geom_abline(slope = -results.table[5,1],intercept = 0,colour="darkred",size=1.25)+
geom_point(aes(mean(Ceplane1[,2]),mean(Ceplane1[,1])),colour="red")+
geom_point(aes(results.table[1,1],results.table[3,1],colour="darkred"))+ggtitle("CE-Plane: Drug A vs Drug P")+
xlab("QALY Difference")+ylab("Cost Difference")+xlim(-0.05,0.05)+ylim(-6000,6000)+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(),plot.background = element_rect(fill = "white", colour = "black", size = 0.5))+
geom_vline(xintercept = 0,colour="black")+geom_hline(yintercept = 0,colour="black")+
geom_label(aes(mean(Ceplane1[,2]),mean(Ceplane1[,1])),label="mean")+
geom_label(aes(results.table[1,1],results.table[3,1]),label="Base ICER")
I want to put the label at the side of the graph and not on the points of the graph itself. Please suggest me a way to do that.
I think the best way is to add the mean and Base ICER points to your dataset. Then add a column for the legend and you will see them show up as matching in the chart and the legend:
library(ggplot2)
set.seed(1)
Ceplane1 <- data.frame(y = rnorm(100),
x = rnorm(100))
results.table <- data.frame(z = rnorm(100))
Ceplane1$Legend <- "Data"
meanPoint <- data.frame(y = mean(Ceplane1[,1]), x = mean(Ceplane1[,2]), Legend = "Mean")
basePoint <- data.frame(y = results.table[3,1], x = results.table[1,1], Legend = "Base ICER")
Ceplane1 <- rbind(Ceplane1, meanPoint)
Ceplane1 <- rbind(Ceplane1, basePoint)
ggplot(Ceplane1, aes(x = x, y = y, color = Legend)) +
geom_point() +
geom_abline(slope = -results.table[5,1],intercept = 0,colour="darkred",size=1.25) +
ggtitle("CE-Plane: Drug A vs Drug P")+ xlab("QALY Difference")+ylab("Cost Difference") +
xlim(-3,3) + ylim(-3,3) +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(),plot.background = element_rect(fill = "white", colour = "black", size = 0.5)) +
geom_vline(xintercept = 0,colour="black") +
geom_hline(yintercept = 0,colour="black")
This gives me the following:
Note that I changed the xlim and ylim to match the random data I created.
Please check my reproducible example and the result chart.
X = t(USArrests)
plot_color_clust = function(X,N=N,
cols=c("red","blue", "orange", "darkgreen","green","yellow","grey","black","white")
){
library(ggplot2)
library(gridExtra)
library(gtable)
library(scales)
library(ggdendro)
library(grid)
library(plyr)
if(N>length(cols)) stop("N too big. Not enough colors in cols.")
if(N>ncol(X)) stop("N too big. Not enough columns in data.")
fit = ClustOfVar::hclustvar(X.quanti = X)
dd.row = as.dendrogram(fit)
ddata_x <- dendro_data(dd.row)
temp = cutree(fit,k=N)
lab <- ggdendro::label(ddata_x)
x=c()
for(i in 1:nrow(lab)){
x[i]= paste( "clust", as.vector(temp[ lab$label[i]==names(temp) ]) ,sep="")
}
lab$group <- x
p1 <- ggplot(segment(ddata_x)) +
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+coord_flip()+
geom_text(data=lab,
aes(label=label, x=x, y=0, colour=group),hjust=1) +
theme(legend.position="none",
axis.title.y=element_blank(),
axis.title.x=element_blank(),
axis.text.x = element_text(angle = 0, hjust = 0),
axis.title.x = element_text(angle = 0, hjust = 0))+
theme(axis.text = element_blank(), axis.title = element_blank(),
axis.ticks = element_blank(), axis.ticks.margin = unit(0, "lines"),
axis.ticks.length = unit(0, "cm"))+
scale_colour_manual(values=cols)+coord_flip()+
scale_y_continuous(limits = c(-0.1, 2.1))
df2<-data.frame(cluster=cutree(fit,N),states=factor(fit$labels,levels=fit$labels[fit$order]))
df3<-ddply(df2,.(cluster),summarise,pos=mean(as.numeric(states)))
p2 = ggplot(df2,aes(states,y=1,fill=factor(cluster)))+geom_tile()+
scale_y_continuous(expand=c(0,0))+
theme(axis.title=element_blank(),
axis.ticks=element_blank(),
axis.text=element_blank(),
legend.position="none")+coord_flip()+
geom_text(data=df3,aes(x=pos,label=cluster))+
scale_fill_manual(name = "This is my title", values = cols)
gp1<-ggplotGrob(p1)
gp2<-ggplotGrob(p2)
maxHeight = grid::unit.pmax(gp1$heights[2:5], gp2$heights[2:5])
gp1$heights[2:5] <- as.list(maxHeight)
gp2$heights[2:5] <- as.list(maxHeight)
#grid.arrange(gp2, gp1, ncol=2,widths=c(1/6,5/6))
R = arrangeGrob(gp2,gp1,ncol=2,widths=c(1/6,5/6))
R
}
plot_color_clust(X,6)
Questions:
These two parts (left colors tiles and right clustering tree) has inconsistent heights. How do we adjust their heights for them to match each other's?
How can we make the tree on the right side shorter so states names (clustered subjects) can have more space to be fully displayed?
Is there a way make the white space between those two parts smaller?
Your tweaking of the code is appreciated. Thanks.
One major change: Rather than matching heights of the two charts, I extract the plot panel from gp2, then insert it into column 2 of gp1. There are no margins surrounding the resultant gp2, and thus, partly takes care of your point 3.
With respect to point 2: expand the limits of the axis to make room of the labels. (See point 2. in the code below). The parameters for points 2 and 3 were set by trial-and-error. Adjusting one parameter means the other needs to be adjusted.
With respect to point 1: expand the axis using the additive component of exapnd to add half a unit to each end of the axis (See point 1. in the code below).
Minor edit: updating to ggplot2 2.2.0 and R 3.3.2
axis.ticks.margin is deprecated
X = t(USArrests)
plot_color_clust = function(X, N = N,
# cols=c("red","blue", "orange", "darkgreen","green","yellow","grey","black","white")
cols = rainbow(N) # Easier to pick colours
){
library(ggplot2)
library(gtable)
library(grid)
library(ggdendro)
library(plyr)
if(N > length(cols)) stop("N too big. Not enough colors in cols.")
if(N > ncol(X)) stop("N too big. Not enough columns in data.")
fit = ClustOfVar::hclustvar(X.quanti = X)
dd.row = as.dendrogram(fit)
ddata_x <- dendro_data(dd.row)
temp = cutree(fit, k = N)
lab <- ggdendro::label(ddata_x)
x = c()
for(i in 1:nrow(lab)){
x[i] = paste("clust", as.vector(temp[lab$label[i] == names(temp)]), sep = "")
}
lab$group <- x
p1 <- ggplot(segment(ddata_x)) +
geom_segment(aes(x = x, y = y, xend = xend, yend = yend)) +
geom_text(data = lab, aes(label = label, x = x, y = -.05, colour = group), # y = -.05 adds a little space between label and tree
size = 4, hjust = 1) +
scale_x_continuous(expand = c(0, .5)) + # 1. Add half a unit to each end of the vertical axis
expand_limits(y = -0.4) + # 2. Make room for labels
theme_classic() +
scale_colour_manual(values = cols) +
coord_flip() +
theme(legend.position = "none", axis.line = element_blank(),
axis.text = element_blank(), axis.title = element_blank(),
axis.ticks = element_blank(),
axis.ticks.length = unit(0, "cm"))
df2 <- data.frame(cluster = cutree(fit, N),
states = factor(fit$labels, levels = fit$labels[fit$order]))
df3 <- ddply(df2, .(cluster),summarise,pos=mean(as.numeric(states)))
p2 <- ggplot(df2, aes(states, y = 1,
fill = factor(as.character(cluster)))) + # 'as.character' - so that colours match with 10 or more clusters
geom_tile() +
scale_y_continuous(expand = c(0, 0)) +
scale_x_discrete(expand = c(0, 0)) +
coord_flip() +
geom_text(data = df3,aes(x = pos, label = cluster, size = 12)) +
scale_fill_manual(values = cols)
gp1 <- ggplotGrob(p1) # Get ggplot grobs
gp2 <- ggplotGrob(p2)
gp2 <- gp2[6, 4] # 3. Grab plot panel only from tiles plot (thus, no margins)
gp1 <- gtable_add_grob(gp1, gp2, t = 6, l = 2, name = "tiles") # 3. Insert it into dendrogram plot
gp1$widths[2] = unit(1, "cm") # 3. Set width of column containing tiles
grid.newpage()
grid.draw(gp1)
}
plot_color_clust(X, 6)
Follow up to:
Subgroup axes ggplot2 similar to Excel PivotChart
ggplot2 multiple sub groups of a bar chart
R version 3.1.1 (2014-07-10) Platform: i386-w64-mingw32/i386 (32-bit)
I am working on a plot with ggplot2. The aim is to tweak the axis into a look similar to Excels famous pivot graphs. I know, how I can achieve the look I want, but as soon as I use axis limits, the code is not sufficient any more.
Data:
library(reshape2)
library(ggplot2)
library(grid)
df=data.frame(year=rep(2010:2014,each=4),
quarter=rep(c("Q1","Q2","Q3","Q4"),5),
da=c(46,47,51,50,56.3,53.6,55.8,58.9,61.0,63,58.8,62.5,59.5,61.7,60.6,63.9,68.4,62.2,62,70.4))
df.m <- melt(data = df,id.vars = c("year","quarter"))
g1 <- ggplot(data = df.m, aes(x = interaction(quarter,year), y = value, group = variable)) +
geom_area(fill = "red")+
coord_cartesian(ylim = c(0, 75)) +
annotate(geom = "text", x = seq_len(nrow(df)), y = -1.5, label = df$quarter, size = 2, color = "gray48") +
annotate(geom = "text", x = 2.5 + 4 * (0:4), y = -3, label = unique(df$year), size = 3, color ="gray48") +
theme_grey(base_size = 10)+
theme(line = element_line(size = 0.2),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
legend.position= "none")
#remove clipping of x axis labels
g2 <- ggplot_gtable(ggplot_build(g1))
g2$layout$clip[g2$layout$name == "panel"] <- "off"
grid.draw(g2)
png(filename = "test.png",width = 14/2.54,height = 6/2.54, units = "in",res = 300)
grid.draw(g2)
dev.off()
The plot is fine and the axis lables are as wished. But as soon as you change the limits of the y axis everything is messed up.
I hope you have an idea, how to solve my problem!
Actually, it is plotting exactly what you are asking for. Check ?geom_area, and you will note that the minimum y is 0. So when you turn off clipping, ggplot will show as much of the area as it can within the limits of the lower margin. Instead use geom_ribbon(). It has ymax and ymin. Also, you need to take care setting the y-coordinates in the two annotate() functions.
library(reshape2)
library(ggplot2)
library(grid)
df=data.frame(year=rep(2010:2014,each=4),
quarter=rep(c("Q1","Q2","Q3","Q4"),5),
da=c(46,47,51,50,56.3,53.6,55.8,58.9,61.0,63,58.8,62.5,59.5,61.7,60.6,63.9,68.4,62.2,62,70.4))
df.m <- melt(data = df,id.vars = c("year","quarter"))
ymin <- 40
g1 <- ggplot(data = df.m, aes(x = interaction(quarter,year), ymax = value, group = variable)) +
geom_ribbon(aes(ymin=ymin), fill = "red")+
coord_cartesian(ylim = c(ymin, 75)) +
annotate(geom = "text", x = seq_len(nrow(df)), y = 37.5, label = df$quarter, size = 2, color = "gray48") +
annotate(geom = "text", x = 2.5 + 4 * (0:4), y = 36.5, label = unique(df$year), size = 3, color ="gray48") +
theme_grey(base_size = 10)+
theme(line = element_line(size = 0.2),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
legend.position= "none",
plot.margin = unit(c(1,1,3,1), "lines")) # The bottom margin is exaggerated a little
# turn off clipping of the panel
g2 <- ggplotGrob(g1)
g2$layout$clip[g2$layout$name == "panel"] <- "off"
grid.draw(g2)
I'm trying to create a framework for easy plotting of our data sets. The current idea is to initiate a ggplot graph, add layers to it, then display or save it. My code looks like this:
initPlot <- function(title = "", data = NULL){
if(is.null(data)) data <- GLOBDATA
plot <- ggplot(data, aes(jahr))
plot <- plot + scale_x_continuous(breaks = seq(2001, 2012, 1))
textTheme <- element_text(size=6, face="plain", color="black", family="AvantGarde")
lineTheme <- element_line(color="black", size=0)
plot <- plot + theme(
text = textTheme,
axis.text = textTheme,
axis.ticks = lineTheme,
axis.line = lineTheme,
axis.title = element_blank(),
plot.background = element_rect(fill="#f0f0f0"),
strip.background = element_rect(fill="#f0f0f0"),
panel.background = element_rect(fill="#f0f0f0"),
panel.grid = element_blank(),
legend.position = "bottom"
)
plot <- plot + guides(color = guide_legend(title = title))
PLOTGLOB <<- plot
plot
}
plotConfidence <- function(columns, color = "red", title = "", label = "", plot = NULL){
plot <- plotLine(columns, "black", label, plot, 1)
plot <- plot + geom_ribbon(columns, alpha = 0.3, fill = color, linetype=0)
PLOTGLOB <<- plot
plot
}
plotLine <- function(column, color = "black", label = "", plot = NULL, size = 1){
if(is.null(plot)) plot <- PLOTGLOB
plot <- plot + geom_line(column, color = color, size = size)
PLOTGLOB <<- plot
plot
}
I then call my code like this:
initPlot("title")
plotConfidence(
aes(
y = jSOEP_aqne_ip_fgt060_f_alle,
ymin = jSOEP_aqne_ip_lfgt060_f_alle,
ymax = jSOEP_aqne_ip_ufgt060_f_alle, color="Alle", fill="Alle"
),
"red")
plotConfidence(
aes(
y = jSOEP_aqne_ip_fgt060_f_mann,
ymin = jSOEP_aqne_ip_lfgt060_f_mann,
ymax = jSOEP_aqne_ip_ufgt060_f_mann, color="Männer", fill="Männer"
),
"blue", , label="Männer")
Which produces the following graphic:
As you can see, the legend colors don't match up with the corresponding geom_ribbons, in fact, both are of the color "blue" (found that out by setting the alpha to 1 temporarily). How do I fix this?
Here's the data I want to plot:
GLOBDATA <- structure(list(jSOEP_aqne_ip_fgt060_f_alle = c(0.117169998586178,
0.122670002281666, 0.131659999489784, 0.132029995322227, 0.140119999647141,
0.142869994044304, 0.136739999055862, 0.140990003943443, 0.146730005741119,
0.149069994688034, 0.141920000314713, 0.142879992723465), jSOEP_aqne_ip_lfgt060_f_alle = c(0.114249996840954,
0.119199998676777, 0.128110006451607, 0.12814000248909, 0.136230006814003,
0.139119997620583, 0.132400006055832, 0.137409999966621, 0.142560005187988,
0.14478999376297, 0.137840002775192, 0.138579994440079), jSOEP_aqne_ip_ufgt060_f_alle = c(0.120090000331402,
0.126139998435974, 0.135220006108284, 0.135920003056526, 0.143999993801117,
0.146630004048347, 0.141090005636215, 0.144580006599426, 0.15090000629425,
0.153359994292259, 0.146009996533394, 0.147180005908012), jSOEP_aqne_ip_fgt060_f_mann = c(0.100199997425079,
0.106820002198219, 0.117770001292229, 0.117349997162819, 0.126489996910095,
0.130469992756844, 0.12601999938488, 0.127340003848076, 0.132960006594658,
0.135379999876022, 0.132510006427765, 0.13782000541687), jSOEP_aqne_ip_lfgt060_f_mann = c(0.0951400026679039,
0.101929999887943, 0.112829998135567, 0.112510003149509, 0.121720001101494,
0.12372999638319, 0.120829999446869, 0.121650002896786, 0.127389997243881,
0.128470003604889, 0.12533999979496, 0.131980001926422), jSOEP_aqne_ip_ufgt060_f_mann = c(0.105259999632835,
0.111709997057915, 0.122720003128052, 0.122189998626709, 0.131270006299019,
0.137209996581078, 0.131219998002052, 0.133019998669624, 0.138539999723434,
0.142289996147156, 0.139679998159409, 0.143659994006157)), .Names = c("jSOEP_aqne_ip_fgt060_f_alle",
"jSOEP_aqne_ip_lfgt060_f_alle", "jSOEP_aqne_ip_ufgt060_f_alle",
"jSOEP_aqne_ip_fgt060_f_mann", "jSOEP_aqne_ip_lfgt060_f_mann",
"jSOEP_aqne_ip_ufgt060_f_mann"))
Thanks for sharing your data. Unfortunately as it stands it does not run. GlOBDATA is a list structure and there is no jahr amongst some other omissions.
This answer does not attempt to create a general function or amend yours but hopefully does suggest another way to structure your data.
By restructuring your data, you can map variables to colours and this will automatically produce the legend.
library(ggplot2)
# create dataframe from your list
temp <- do.call(cbind.data.frame, GLOBDATA)
# Change data format
# your data is organised in wide format as mean, upper CI, lower CI (i think)
# for both 'alle' and 'mann'. By stacking these after renaming for consistent
# column names, we can then easily map aesthetics in ggplot.
# create a grouping variable (grp) to map aesthetics to.
df1 <- setNames(temp[grepl('alle', names(temp))], c('mn', 'lower', 'upper'))
df1$grp <- 'alle'
df2 <- setNames(temp[grepl('mann', names(temp))], c('mn', 'lower', 'upper'))
df2$grp <- 'mann'
df <- rbind(df1, df2)
# add year
df$year <- 2000 + seq(nrow(temp))
# plot
p <- ggplot(df, aes(x=year, y=mn , ymin=lower, ymax=upper, colour=grp, fill=grp)) +
geom_line(size = 1, colour="black") +
geom_ribbon(alpha = 0.3, linetype=0) +
scale_x_continuous(breaks = seq(2001, 2012, 1)) +
scale_fill_manual(values=c('alle' = 'red', 'mann'='blue'))
p <- p +
theme(
text = element_text(size=6, face="plain", color="black", family="AvantGarde"),
axis.text = element_text(size=6, face="plain", color="black", family="AvantGarde"),
axis.ticks = element_line(color="black", size=0.5),
axis.line = element_line(color="black", size=0.5),
axis.title = element_blank(),
plot.background = element_rect(fill="#f0f0f0"),
strip.background = element_rect(fill="#f0f0f0"),
panel.background = element_rect(fill="#f0f0f0"),
panel.grid = element_blank(),
legend.position = "bottom",
legend.title=element_blank()
)
So by tweaking how your data is organised and your functions a little you should be able to map variables to aesthetics and automatically generate a legend.